Parsec続き

代入式らしいものは書けるようになった．あと型クラスを使って toCode （コードを生成する関数）を実装してみる．うーんやっぱり 型なのに「instance」と書くのはまだ抵抗がある．

あと Foo {bar:: Int} という記法は扱いがすごい面倒なことがわかった．特に関数を書くときに

hoge Foo {bar:: b} = fuga b 

みたいに書かないといけないから．やっぱりこう書かせてよー(まだ言っている）

hoge f::Foo = fuga (f.bar) 

module Parse where
import Text.ParserCombinators.Parsec

 --main
r :: String -> String
r input = case parse source "lisp" input of
    Left err -> "No match: " ++ show err
    Right val -> "Found value" ++ (show $ map toCode val)

 --util
mny :: Parser a -> Parser [a] 
mny p = many (do { spc; p } )
toks1 :: Parser Char -> Parser String 
toks1 p = do {res<-many1 p ; spc; return res } 

spc :: Parser ()
spc = skipMany space

tok :: String -> Parser String
tok str = do { s <- string str; spc ; return s }

 --grammar
source :: Parser [Decl]
source = do { bodies <- mny ( vardecl <|> statement)
            ; return bodies 
            }

vardecl :: Parser Decl
vardecl = do { tok "var" 
             ; name <- symbol; tok ";"
             ; return $ VarDecl {vdName = name }
             } 
statement :: Parser Decl
statement = do { e <- expr
               ; tok ";"
               ; return $ StmtDecl $ ExprStmt e
               }


expr :: Parser Expr
expr = do {
         left <- add ;
         option left (do {
             tok "=" ; a<-add ;
             return (BinOp left "=" a) 
         })
       }
add = do { left <- element
          ; rights <- mny (do { op   <- operators 
                              ; e    <- element 
                              ; return (op,e) } )
          ; return (makeBinOp left rights)
          }
operators :: Parser String
operators = tok "+" <|> tok "-" 

element :: Parser Expr
element = intConst <|> varRef

varRef :: Parser Expr
varRef = do {
   n <- symbol ;
   return VarRef {vrName=n}
}

intConst :: Parser Expr
intConst = do { v <- digits 
              ; return $ IntConst v 
              }

symbol  :: Parser String
symbol  = toks1 letter
digits  :: Parser Int
digits  = do { d <- toks1 (oneOf "0123456789")
             ; return (read d::Int)  -- ???
             }

 --semantics
makeBinOp :: Expr -> [(String,Expr)] -> Expr
makeBinOp left [] = left
makeBinOp left ((op,elem):rest) = 
   makeBinOp (BinOp left op elem) rest

data Decl = VarDecl { vdName:: String } |
            StmtDecl Statement  -- !
			deriving Show
data Statement = ExprStmt Expr
			deriving Show
			
data Expr = BinOp Expr String Expr |
            IntConst Int  |
            VarRef { vrName:: String }
			deriving Show
			
class (Show a)=> Codable a where 
  toCode:: a -> String
  toCode a=show a

instance Codable Statement where
  toCode (ExprStmt e) = "STM "++ (toCode e) ++";"
  
instance Codable Expr where
  toCode (BinOp l o r) = 
     (toCode l) ++ (toCode r) ++ o
  toCode a=show a
instance Codable Decl where
  toCode (StmtDecl st) = toCode st
  toCode a=show a