アドレス情報を保持するコンパイラ

宣言された変数に対して，順番にアドレスを確保していくコンパイラ

Parse> r "var a; var b; a=3; b=a+2;"
Loading package parsec-2.0 ... linking ... done.
Found value[ ["VarDecl","0"],
["VarDecl","1"],
["0","3","=","POP"],
["1","0","Read","2","+","=","POP"] ]
Parse> 

昨日のMap.hsが別途必要です

module Parse where
import Text.ParserCombinators.Parsec
import Data.HashTable
import Map

 --main
r :: String -> IO ()
r input = 
   case runParser source (PStat 0 []) "lisp" input of
     Left err  -> putStrLn $ "No match: " 
                  ++ show err
     Right val -> putStrLn $ "Found value" 
                  ++ (show $ map (toCode RVal) val)

newSym = new (==) hashString :: IO (HashTable String Int)
 --util
data ParserState = PStat Int [(String,Int)]
getNum :: ParserState -> Int
getNum (PStat i _) = i
getSyms :: ParserState -> [(String,Int)]
getSyms (PStat _ h) = h

type SParser a = GenParser Char ParserState a

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

spc :: SParser ()
spc = skipMany space

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

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

vardecl :: SParser Decl

変数宣言をして，変数のアドレスを割り当てている部分．
ここで使っているlet は，ふつけるP279 にある「特別なlet節」．実はうっかりinを書き忘れたことで偶然みつけた．便利．

vardecl = do { tok "var" 
             ; name <- symbol; tok ";"
             ; st <- getState 
             ; let syms = getSyms st 
             ; let addr = getNum  st 
             ; setState (PStat (addr+1) 
                               (put syms name addr))
             ; return $ VarDecl name addr 
             } 

statement :: SParser Decl
statement = do { e <- expr
               ; tok ";"
               ; return $ StmtDecl $ ExprStmt e
               }


expr :: SParser 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 :: SParser String
operators = tok "+" <|> tok "-" 

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

ここは，変数を見て，その変数のアドレスを取り出しているところ

varRef :: SParser Expr
varRef = do {
   n <- symbol ;
   st <- getState ;
   return $ VarRef (defMaybe (-1) (get (getSyms st) n))
}
defMaybe:: a -> (Maybe a) -> a
defMaybe def (Just x) = x
defMaybe def Nothing = def 

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

symbol  :: SParser String
symbol  = toks1 letter
digits  :: SParser 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 Int  |
            StmtDecl Statement  -- !
            
data Statement = ExprStmt Expr
			
data Expr = BinOp Expr String Expr |
            IntConst Int  |
            VarRef Int 
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 addr )  = [show addr , "Read"];
  toCode LVal (VarRef addr )  = [show addr ];

instance ToCodable Decl where
  toCode c (StmtDecl st)  = toCode c st
  toCode c (VarDecl name addr) = ["VarDecl", show addr]