-- A simple interpreter for an assignment language
-- implemented as semantic actions

{
import Data.Char -- needed by the lexer
}

%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       { \env -> $3 ($1 env) }
      | stm                 { $1 }

stm : id '=' exp            { \env -> updateEnv env $1 ($3 env) }

exp : exp '+' term          { \env -> $1 env + $3 env }
    | term                  { $1 }

term : term '*' factor      { \env -> $1 env * $3 env }
     | factor               { $1 }

factor : id                 { \env -> env $1 }
       | num                { \env -> $1 }
       | '(' exp ')'        { $2 }

{
-- Environments:
type Env = String -> Int

-- The empty environment:
emptyEnv :: Env
emptyEnv n = error ("Access to undefined variable " ++ n)

-- Update the environment:
updateEnv :: Env -> String -> Int -> Env
updateEnv e n v = \m -> if n==m then v
                                else e m

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 :: String -> Int
runprog = interpreter . lexer

-- Example calls:
test1 = runprog "x=2 (3+x*5)"
test2 = runprog "x=2 ; y=5 (3+x*y)"
test3 = runprog "x=2 ; y=x+3 (3+x*y)"

}