-- a simple interpreter for a language with assignments and prints -- implemented as semantic actions { import Char -- needed by the lexer -- update the environment: update e n v = \m -> if n==m then v else e m -- the empty environment: emptyEnv n = error ("Access to undefined variable "++n) } %name interpreter -- name of created function %tokentype { Token } -- type of accepted tokens -- parser :: [Token] -> t with t type of attribute of -- first rule %token ';' { SEMICOLON } '=' { ASSIGN } print { PRINT } '+' { PLUS } '*' { MULT } '(' { LPAREN } ')' { RPAREN } id { ID $$ } num { NUM $$ } %% -- as in yacc -- semantic action of statements have type (env,output) -> (env,output) program : stmts { snd ($1 (emptyEnv,"")) } stmts : stm ';' stmts { $3 . $1 } | stm { $1 } stm : id '=' exp { \(e,o)->(update e $1 ($3 e),o) } | print '(' exp ')' { \(e,o)->(e,o++show($3 e ::Int)++"\n") } exp : exp '+' term { \e->($1 e + $3 e)::Int } -- typing necessary (classes) | term { $1 } term : term '*' factor { \e->($1 e * $3 e)::Int } | factor { $1 } factor : id { \e->e $1 } | num { \_->$1 } | '(' exp ')' { $2 } { happyError :: [Token] -> a happyError _ = error "Parse error" data Token = ID String | NUM Int | PLUS | MULT | LPAREN | RPAREN | SEMICOLON | ASSIGN | PRINT deriving Show lexer :: String -> [Token] lexer [] = [] lexer (c:cs) | isSpace c = lexer cs | isAlpha c = lexId (c:cs) | isDigit c = lexNum (c:cs) lexer ('+':cs) = PLUS : lexer cs lexer ('*':cs) = MULT : lexer cs lexer ('(':cs) = LPAREN : lexer cs lexer (')':cs) = RPAREN : lexer cs lexer (';':cs) = SEMICOLON : lexer cs lexer ('=':cs) = ASSIGN : lexer cs lexNum cs = NUM (read num) : lexer rest where (num,rest) = span isDigit cs lexId cs = case span isAlpha cs of (var,rest) -> (if var=="print" then PRINT else ID var) : lexer rest runprog = interpreter . lexer -- putStr (runprog "x=2 ; print (3+x*5)") -- putStr (runprog "x=2 ; print(x); y=3+x*5; print(y)") }