書いてみたプログラム
亀プログラム。
もともとは、「増補改訂版Java言語で学ぶデザインパターン入門」のInterpreterパターンの章で出てくる簡易言語(亀プログラム)の解釈をHaskellで書いたらどう書くのかという試み。
BNF参考
<program> ::= program <command list> <command list> ::= <command>*end <command> ::= <repeat command> | <primitive command> <repeat command> ::= repeat <number> <command list> <primitive command> ::= go | left | right
方針は、
結果として、
- 面倒だったから結果しか出力してない。途中経過が出力されない。
- データ構造に、処理の都合上、不本意なダミーのデータコンストラクタを入れた。
- Maybeを使ったのはいいが、結果が全部トップレベルに返ってしまうから、どこでどういうエラーが起こったのかわかる手段がない。
- Maybeで「>>=」を使っていないため、あまり恩恵を受けていると言えない
- 型クラスでインタフェースを切るコトによって、どれくらい恩恵を受けているのかが、よくわからなくなってきた(型クラスにしないで、ベタで関数を定義しても労力は一緒?)。
- Interpreterパターンの翻訳としては厳しいんじゃないか。
- コード量多すぎ。
という不満はあるけれど、概ね、最初目指していた目標は達成したように思う。
型クラスの恩恵については、ちょっともう一度頭の中を整理する必要がある。
それから、わざわざBNFに忠実な木構造を作るより、いきなり処理の木構造を作ったほうが早いけど、BNFの木構造を作る必要が本当にあるのか、いきなり処理の木構造を作るとどういうデメリットがあるのか考える必要がある。
使用例
*Main> turtle "test01.ttl" program : test01.ttl result : (-4,4)
ソース
import Char
import Maybe
{--------------------------------
メイン関数
使用例)
*Main> turtle "test01.ttl"
program : test01.ttl
result : (-4,4)
--------------------------------}
turtle fileName
= do
p <- readFile fileName
putStrLn ( "program : " ++ fileName ++ "\nresult : " ++ ((show_prog_result.words) p) )
{--------------------------------
TProgNode操作
プログラム全体の単語リストを引数に渡し、
結果の文字列を得る
--------------------------------}
show_prog_result :: [String] -> String
show_prog_result pwords
= case (expand_prog pwords) of
Just tnode -> show tnode
Nothing -> "*** ERROR ***"
{--------------------------------
プログラム全体の単語リスト
→ Maybe ("進行方向", "位置情報")
--------------------------------}
expand_prog :: [String] -> Maybe TNode
expand_prog pwords
= case (tParse (TProgNodeEmpty, pwords)) of
Just (prog_node, _) -> tExpand prog_node initData
Nothing -> Nothing
-- "進行方向"と"位置"の初期値
initData = MkTInitLeaf (0,1) (0,0)
{--------------------------------
処理木に対する実行型クラス
--------------------------------}
class TExec a where
tExec :: TPrimCmd -> a -> TNode
{--------------------------------
処理木構造定義
--------------------------------}
-- データ構築子
data TNode = MkTNode TPrimCmd TNode | MkTInitLeaf TPos TPos
-- Showクラス実装
instance Show TNode where
show (MkTInitLeaf _ pos) = show pos
show (MkTNode cmd node) = show (tExec cmd node)
-- TExecクラス実装
instance TExec TNode where
tExec TCmdGo (MkTInitLeaf dir pos)
= MkTInitLeaf (tPPrdG dir) (tPAdd (tPPrdG dir) pos)
tExec TCmdLeft (MkTInitLeaf dir pos)
= MkTInitLeaf (tPPrdL dir) (tPAdd (tPPrdL dir) pos)
tExec TCmdRight (MkTInitLeaf dir pos)
= MkTInitLeaf (tPPrdR dir) (tPAdd (tPPrdR dir) pos)
tExec cmd (MkTNode c_cmd node) = tExec cmd (tExec c_cmd node)
{--------------------------------
パース木に対する操作用型クラス
--------------------------------}
class TParser a where
tParse :: (a, [String]) -> Maybe (a, [String])
tExpand :: a -> TNode -> Maybe TNode
{--------------------------------
パース木構造定義
BNFにできるだけ近い
データ構造にする
--------------------------------}
-- データ構築子
data TProgNode = MkProgNode TCmdList | TProgNodeEmpty
data TCmdList = MkCmdList [TCmdNode] | TCmdListEmpty
data TCmdNode = MkPrimCmdNode TPrimCmd | MkRepCmdNode TRepCmd | TCmdNodeDummy
data TRepCmd = MkRepCmd Int TCmdList | TRepCmdDummy
data TPrimCmd = TCmdGo | TCmdLeft | TCmdRight
-- Showクラス実装
instance Show TPrimCmd where
show TCmdGo = "cmd_go"
show TCmdLeft = "cmd_left"
show TCmdRight = "cmd_right"
instance Show TRepCmd where
show TRepCmdDummy = "TRepCmdDummy"
show (MkRepCmd nInt cmd_list) = "(cmd_rep : " ++ (show nInt) ++ " x " ++ (show cmd_list) ++ ")"
instance Show TCmdNode where
show (MkPrimCmdNode prim_cmd) = show prim_cmd
show (MkRepCmdNode rep_cmd) = show rep_cmd
instance Show TCmdList where
show (MkCmdList nodes) = show nodes
show TCmdListEmpty = "[]"
-- TParserクラス実装
instance TParser TRepCmd where
tParse (TRepCmdDummy, (x:xs))
= case (toMaybeInt x) of
Just nInt -> case (tParse (TCmdListEmpty, xs)) of
Just (cmd_list, ys) -> Just ((MkRepCmd nInt cmd_list), ys)
Nothing -> Nothing
Nothing -> Nothing
tExpand TRepCmdDummy tnode = Nothing
tExpand (MkRepCmd nCnt cmd_list) tnode
= tExpand_iter(nCnt, cmd_list, tnode)
where tExpand_iter(cnt, clist, node)
= case cnt of
0 -> Just node
_ -> case (tExpand clist node) of
Just new_node -> tExpand_iter(cnt-1, clist, new_node)
Nothing -> Nothing
instance TParser TCmdNode where
tParse (_, []) = Nothing
tParse (_, (x:xs))
= case x of
"go" -> Just ((MkPrimCmdNode TCmdGo), xs)
"left" -> Just ((MkPrimCmdNode TCmdLeft), xs)
"right" -> Just ((MkPrimCmdNode TCmdRight), xs)
"repeat"-> case (tParse (TRepCmdDummy, xs)) of
Just (TRepCmdDummy, ys) -> Nothing
Just (rep_cmd, ys) -> Just ((MkRepCmdNode rep_cmd), ys)
Nothing -> Nothing
_ -> Nothing
tExpand TCmdNodeDummy tnode = Nothing
tExpand (MkPrimCmdNode cmd) tnode = Just (MkTNode cmd tnode)
tExpand (MkRepCmdNode cmd) tnode = tExpand cmd tnode
instance TParser TCmdList where
tParse (cmd_list, ("end":xs)) = Just(cmd_list, xs)
tParse (a, []) = Nothing
tParse (TCmdListEmpty, xs)
= case (tParse (TCmdNodeDummy, xs)) of
Just (TCmdNodeDummy, xs) -> Nothing
Just (cmd_node, ys) -> tParse ( (MkCmdList [cmd_node]), ys )
Nothing -> Nothing
tParse ((MkCmdList cmds), xs)
= case (tParse (TCmdNodeDummy, xs)) of
Just (TCmdNodeDummy, ys) -> Nothing
Just (cmd_node, ys) -> tParse ( (MkCmdList (cmds ++ [cmd_node])), ys )
Nothing -> Nothing
tExpand TCmdListEmpty tnode = Just tnode
tExpand (MkCmdList []) tnode = Just tnode
tExpand (MkCmdList (x:xs)) tnode
= case (tExpand x tnode) of
Just new_tnode -> tExpand (MkCmdList xs) new_tnode
Nothing -> Nothing
instance TParser TProgNode where
tParse (_, []) = Nothing
tParse (tpnode, ("program":xs))
= case (tParse (TCmdListEmpty, xs)) of
Just (cmd_list, ys) -> Just ((MkProgNode cmd_list), ys)
Nothing ->Nothing
tParse (tpnode, (_:xs)) = tParse (tpnode, xs)
tExpand TProgNodeEmpty tnode = Nothing
tExpand (MkProgNode cmd_list) tnode = tExpand cmd_list tnode
{--------------------------------
文字列->数字変換関数
--------------------------------}
toMaybeInt :: String -> Maybe Int
toMaybeInt str
= if( isInt str )
then Just (read str)
else Nothing
isInt :: String -> Bool
isInt str = (foldl1 (&&) (map isDigit str))
{--------------------------------
位置データ定義
--------------------------------}
type TPos = (Int,Int)
-- 足し算
tPAdd :: TPos->TPos->TPos
tPAdd (a1,b1) (a2,b2) = (a1+a2,b1+b2)
-- 恒等変換
tPPrdG :: TPos->TPos
tPPrdG p = p
-- +90度回転
tPPrdL :: TPos->TPos
tPPrdL (a,b) = (-b,a)
-- -90度回転
tPPrdR :: TPos->TPos
tPPrdR (a,b) = (b,-a)
