課題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が入ったが、それ以外は概ねいいと感じる。

あと残りは実行処理。