１．数式から木構造を作成する機械
「Haskellで数式をビジュアルに」のところでも説明したが、一次元に書かれた数式を二次元の木構造に変換することができる。例は以下のとおりである。
２．命令の集合
最初に決めるのは、命令の集合である。ここでは、ノードとリーフを作成する命令に分け、前者をInsOp、後者をInsValとする。InsOpは加算か乗算を引数として取り、InsValは整数を引数として取ることとし、型コンストラクタTreeIを次のように定める。
data TreeI a where InsOp :: Char -> TreeI () InsVal :: Int -> TreeI ()
なお、ここでaは型引数、InsOp,InsValは値コンストラクタである。
また、命令ツリーで構成されるプログラムTreePを次のように用意する。
type TreeP a = Program TreeI a
また、それぞれの命令をプログラムの内で使えるようにするため、関数singletonを適応し、その名前を次のように用意する。
命令InsOpに対して、
insOp :: Char -> TreeP () insOp = singleton.InsOp
命令InsValに対して、
insVal :: Int -> TreeP () insVal = singleton.InsVal
３．プログラムの実行
プログラムの解釈実行は次のように定義する。
interpret :: TreeP a -> Tree -> Tree interpret = eval . view where eval :: ProgramView TreeI a -> Tree -> Tree eval (InsOp x :>>= is) tree = interpret (is ()) $ operation x tree eval (InsVal x :>>= is) tree = interpret (is ()) $ number x tree eval (Return _) tree = tree
それぞれの命令に対して、命令を実行した後の木構造を求めればよい。従って、これは、「Haskellで数式をビジュアルに」のところで説明したものと同じである。ただ、演算に対する部分が、前の説明ではそれぞれ別々になっていたが、今回のプルグラムでは、演算が引数で渡されるので、場合分けする必要がある。その結果、次のようになる。
operation :: Char -> Tree -> Tree operation x tree | x == '+' = plus tree | x == '*' = mult tree | otherwise = tree plus :: Tree -> Tree plus tree = Node Plus tree Empty number :: Int -> Tree -> Tree number x Empty = Leaf x number x (Node op t1 t2) | t2 == Empty = Node op t1 $ Leaf x | otherwise = Node op t1 $ number x t2 mult :: Tree -> Tree mult (Leaf t2) = Node Mult (Leaf t2) Empty mult (Node op t1 t2) = Node op t1 $ mult t2
４．利用する
スタックマシンが出来上がってので、早速利用してみる。命令ツリーを関数transformで次のように用意する。
transform :: TreeP () transform = do insVal 3 insOp '+' insVal 5 insOp '*'suta insVal 9 insOp '+' insVal 7 insOp '*' insVal 6 insOp '*' insVal 5 insOp '+' insVal 3 insOp '*' insVal 2
これを関数mainで次のように実行する
main :: IO () main = (putStrLn . show) $ interpret transform Empty
なお、これに先立って、前回定義したTreeちOpをdataで定義しておく必要がある。
５．プルグラムコード
最後にプログラム全体を提示する。
{-# LANGUAGE GADTs #-} import Control.Monad import Control.Monad.Operational data Tree = Empty | Leaf Int | Node Op Tree Tree deriving (Eq, Show) data Op = Plus | Mult deriving (Eq, Ord, Show) data TreeI a where InsOp :: Char -> TreeI () InsVal :: Int -> TreeI () type TreeP a = Program TreeI a insOp :: Char -> TreeP () insOp = singleton.InsOp insVal :: Int -> TreeP () insVal = singleton.InsVal interpret :: TreeP a -> Tree -> Tree interpret = eval . view where eval :: ProgramView TreeI a -> Tree -> Tree eval (InsOp x :>>= is) tree = interpret (is ()) $ operation x tree eval (InsVal x :>>= is) tree = interpret (is ()) $ number x tree eval (Return _) tree = tree operation :: Char -> Tree -> Tree operation x tree | x == '+' = plus tree | x == '*' = mult tree | otherwise = tree plus :: Tree -> Tree plus tree = Node Plus tree Empty number :: Int -> Tree -> Tree number x Empty = Leaf x number x (Node op t1 t2) | t2 == Empty = Node op t1 $ Leaf x | otherwise = Node op t1 $ number x t2 mult :: Tree -> Tree mult (Leaf t2) = Node Mult (Leaf t2) Empty mult (Node op t1 t2) = Node op t1 $ mult t2 --exp ="3+5*9+7*6*5+3*2" transform :: TreeP () transform = do insVal 3 insOp '+' insVal 5 insOp '*'suta insVal 9 insOp '+' insVal 7 insOp '*' insVal 6 insOp '*' insVal 5 insOp '+' insVal 3 insOp '*' insVal 2 main :: IO () main = (putStrLn . show) $ interpret transform Empty
