コード生成部できた

Parsec で作る簡単なコンパイラ．

• 結局，字句解析のかわりに tok str というあやしいコンビネータ（str を読んで，その後ろのスペースをとばす） を定義
• コード生成部は toCodable クラスを使う．これで，命令のリストが作られる．
  • toCodable :: a -> CodeState -> [String]
  • CodeState は，現在打ち出しているコードが右辺値か左辺値かを示す．

module Parse where
import Text.ParserCombinators.Parsec

 --main
r :: String -> IO ()
r input = case parse source "lisp" input of
    Left err -> putStrLn $ "No match: " 
                 ++ show err
    Right val -> putStrLn $ "Found value" 
                 ++ (show $ map (toCode RVal) 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 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 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 String  |
            StmtDecl Statement  -- !
data Statement = ExprStmt Expr
data Expr = BinOp Expr String Expr |
            IntConst Int  |
            VarRef String 
data CodeState = LVal | RVal
class ToCodable a where
     toCode:: CodeState -> a -> [String]
instance ToCodable Statement where
  toCode c (ExprStmt e) = (toCode c e)  ++ ["POP"]   
instance ToCodable Expr where
  toCode c (BinOp l "=" r) =
     (toCode LVal l) ++ (toCode RVal r) ++ ["="]  
  toCode c (BinOp l o r)   = 
     (toCode RVal l) ++ (toCode RVal r) ++ [o]
  toCode c (IntConst i)    = [show i] 
  toCode RVal (VarRef name)  = [name , "Read"];
  toCode LVal (VarRef name)  = [name , "Addr"];
instance ToCodable Decl where
  toCode c (StmtDecl st)  = toCode c st
  toCode c (VarDecl name) = [ ]

実行例

Parse> r "var a; a=3; var b; b=a+3;"
Found value[ [ ],["a","Addr","3","=","POP"],[ ],
["b","Addr","a","Read","3","+","=","POP"] ]
Parse>