-- a simple interpreter for an assignment language -- implemented as semantic actions { import Data.Char -- needed by the lexer -- Environments: type Env = String -> Int -- the empty environment: emptyEnv :: Env emptyEnv n = error ("Access to undefined variable "++n) -- update the environment: update :: Env -> String -> Int -> Env update e n v = \m -> if n==m then v else e m } %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 } '+' { PLUS } '*' { MULT } '(' { LPAREN } ')' { RPAREN } id { ID $$ } num { NUM $$ } %% -- as in yacc program : stmts '(' exp ')' { $3 ($1 emptyEnv) } stmts : stm ';' stmts { \e -> $3 ($1 e) } | stm { $1 } stm : id '=' exp { \e -> update e $1 ($3 e) } exp : exp '+' term { \e -> ($1 e + $3 e)::Int } -- typing required | 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 -- Example calls: -- runprog "x=2 (3+x*5)" -- runprog "x=2 ; y=5 (3+x*y)" -- runprog "x=2 ; y=x+3 (3+x*y)" }