課題2 データ構造をBNFに合わせる
2006-11-29 - メモ日記の記事の課題2。
データ構造にダミーのデータコンストラクタが入ったのは、tParseというクラスメソッドをすべてのデータ型に対して実装しようとしたのが原因。これをしようとしたことで、tParseの引数と返り値が(a,[String])という型で規定されてしまう。引数としてaが必要ということは、パースする前からデータが必要ということを意味する。ダミーのデータコンストラクタは、この「パースする前のデータ」にあたる。
つまり、ダミーのデータコンストラクタを消すには、型クラスを用いてすべてのデータ型に対してtParseを定義するのをやめればよい。
各データ型に対するパース関数のインタフェースは、恐らく以下のものが必要最低限となる。
-- TProgNode tParseProgNode :: [String] -> PMaybe (TProgNode, [String]) -- TCmdList tParseCmdList :: (TCmdList, [String]) -> PMaybe (TCmdList, [String]) -- TCmdNode tParseCmdNode :: [String] -> PMaybe (TCmdNode, [String]) -- TRepCmd tParseRepCmd :: [String] -> PMaybe (TRepCmd, [String]) -- TPrimCmd tParsePrimCmd :: [String] -> PMaybe (TPrimCmd, [String])
CmdList以外は同じシグニチャなので、型クラスでまとめて共通のtParseという名前のクラスメソッドにしたいが、型によるシグニチャの違いは返り値であるので、同名の関数名にすると型判断がつかない。従ってどの関数が呼ばれるかが区別できないため、Haskell的に構文エラーとなる。なので、別名の関数として定義するしかない。
上記、実装する。また、PMaybeによる実装により、エラー文字列が返せるよう実装する。PMaybeの効果(特にbindのメリット)をなるべく生かし、caseは極力使わないようにする。
以下、書いたコード。
import Char {-------------------------------- メイン関数 使用例) *Main> turtle "test01.ttl" --------------------------------} turtle fileName = do p <- readFile fileName putStrLn ( "file : " ) putStrLn ( p ) putStrLn ( "" ) putStrLn ( "parse result : " ) putStrLn ( ((show_prog_result.words) p) ) {-------------------------------- 実行結果出力 プログラム全体の単語リストを引数に渡し、 結果の文字列を得る --------------------------------} show_prog_result :: [String] -> String show_prog_result pwords = case (tParseProgNode pwords) of PJust (progNode, _) -> show progNode PErr msg -> msg {-------------------------------- メッセージ付Maybe --------------------------------} -- データ構築子 data PMaybe a = PJust a | PErr String deriving Show -- モナド実装 instance Monad PMaybe where PJust x >>= f = f x PErr s >>= f = PErr s return x = PJust x fail s = PErr s {-------------------------------- パース木構造定義 BNFにできるだけ近い データ構造にする --------------------------------} -- データ構築子 data TProgNode = MkProgNode TCmdList data TCmdList = MkCmdList [TCmdNode] data TCmdNode = MkPrimCmdNode TPrimCmd | MkRepCmdNode TRepCmd data TRepCmd = MkRepCmd Int TCmdList data TPrimCmd = TCmdGo | TCmdLeft | TCmdRight {-------------------------------- Showクラス実装 --------------------------------} instance Show TProgNode where show (MkProgNode cmdlist) = "program" ++ (show cmdlist) instance Show TCmdList where show (MkCmdList nodes) = show nodes instance Show TCmdNode where show (MkPrimCmdNode prim_cmd) = show prim_cmd show (MkRepCmdNode rep_cmd) = show rep_cmd instance Show TRepCmd where show (MkRepCmd nInt cmd_list) = "(" ++ (show nInt) ++ " x " ++ (show cmd_list) ++ ")" instance Show TPrimCmd where show TCmdGo = "cmd_go" show TCmdLeft = "cmd_left" show TCmdRight = "cmd_right" {-------------------------------- 各データ構造に対する パース処理実装 --------------------------------} -- TProgNode tParseProgNode :: [String] -> PMaybe (TProgNode, [String]) tParseProgNode [] = PErr "*** ERROR ***\nThere is no program" tParseProgNode ("program":xs) = tParseCmdList ( (MkCmdList []), xs ) >>= return.(tMkNodeCntxt MkProgNode) tParseProgNode (_:xs) = tParseProgNode xs -- TCmdList tParseCmdList :: (TCmdList, [String]) -> PMaybe (TCmdList, [String]) tParseCmdList (cmdlist, ("end":xs)) = PJust (cmdlist, xs) tParseCmdList (cmdlist, xs) = (tParseCmdNode xs) >>= return.tAdd2List (cmdlist, xs) >>= tParseCmdList where tAdd2List ((MkCmdList cmds), xs) (cmdnode, ys) = ( (MkCmdList (cmds ++ [cmdnode])), ys ) -- TCmdNode tParseCmdNode :: [String] -> PMaybe (TCmdNode, [String]) tParseCmdNode ("repeat":xs) = (tParseRepCmd ("repeat":xs)) >>= return.(tMkNodeCntxt MkRepCmdNode) tParseCmdNode xs = (tParsePrimCmd xs) >>= return.(tMkNodeCntxt MkPrimCmdNode) -- TRepCmd tParseRepCmd :: [String] -> PMaybe (TRepCmd, [String]) tParseRepCmd [] = PErr "*** ERROR ***\n<end> not exists" tParseRepCmd ("repeat":[]) = PErr "*** ERROR ***\ninvalid [repeat] cmd" tParseRepCmd ("repeat":xs) = tParseRepNum xs where tParseRepNum (x:xs) = case (toMaybeInt x) of Just nInt -> tParseCmdList ((MkCmdList []), xs) >>= return.(tComposeRepCntxt nInt) Nothing -> PErr "*** ERROR ***\ninvalid [repeat] cmd" tComposeRepCntxt nInt (cmdlist, xs) = ((MkRepCmd nInt cmdlist), xs) -- TPrimCmd tParsePrimCmd :: [String] -> PMaybe (TPrimCmd, [String]) tParsePrimCmd [] = PErr "*** ERROR ***\n<end> not exists" tParsePrimCmd ("go":xs) = PJust (TCmdGo, xs) tParsePrimCmd ("left":xs) = PJust (TCmdLeft, xs) tParsePrimCmd ("right":xs) = PJust (TCmdRight, xs) tParsePrimCmd (x:xs) = PErr ("*** ERROR ***\nunknown cmd [" ++ x ++ "]") {-------------------------------- ユーティリティ関数 --------------------------------} tMkNodeCntxt f (cmd, xs) = ((f cmd), xs) {-------------------------------- 文字列->数字変換関数 --------------------------------} 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) -- 方向変換関数 tChangeDir :: TPrimCmd->TPos->TPos tChangeDir TCmdGo p = p -- 恒等変換 tChangeDir TCmdLeft (a,b) = (-b,a) -- +90度回転 tChangeDir TCmdRight (a,b) = (b,-a) -- -90度回転
TRepCmdの数字取得の部分だけcaseが入ったが、それ以外は概ねいいと感じる。
あと残りは実行処理。