implementing Abstract Stack Machine in Haskell

Question

I don't know what's wrong but when I tried to compile it, it will say "parse error on input 'deriving' ". when I tried to remove the deriving Show on the type Code the error will gone but I cant use the translate function. Why is this? I'm still new sorry.

> module Imp where
>
> import Parsing
>
> type Ide = String
> data Imp
>   = Skip
>   | Assign Ide Imp
>   | Begin Imp
>   | Seq Imp Imp
>   | Ifz Imp Imp Imp
>   | While Imp Imp
>   | Num Int
>   | Var Ide
>   | Add Imp Imp
>   | Sub Imp Imp
>   | Mul Imp Imp
>   | Div Imp Imp
>   | Eq Imp Imp
>   deriving Show

> type Binding = (String, Int)

> data StackVal = N Int | Bind Binding deriving Show

> type Stack = [StackVal]

> type Env = [Binding]

> data ASM  --Abstract Stack Machine
>   = Push StackVal
>   | Pop StackVal
>   | ADD | SUB | MUL | DIV | EQUIV
>   | Jmp Int
>   | Jnz Int
>   | Lab Int
>   | Halt
>   deriving Show

> type Code = [ASM]




Translator
----------

> translate :: Imp -> Env -> Code
> translate (Num n) m               = [Push (N n)]
> translate (Var x) m               = [Push (Bind (x, v))] where Just v = lookup x m
> translate (Skip) m                = []   
> translate (Assign x exp) m        = translate exp m ++ [Pop (Bind (x, v))] where Just v = lookup x m
> translate (Seq c1 c2) m           = translate c1 m ++ translate c2 m
> translate (Ifz exp c1 c2) m       = translate exp m ++ [Jmp 1] ++ translate c1 m ++ [Jnz 2] 
>                                     ++ [Lab 1] ++ translate c2 m ++ [Lab 2]
> translate (While exp c) m         = [Lab 1] ++ translate exp m ++ [Jmp 2] ++ translate c m ++ [Jnz 1] ++ [Lab 2]
> translate (Add x y) m             = translate x m ++ translate y m ++ [ADD]
> translate (Sub x y) m             = translate x m ++ translate y m ++ [SUB]
> translate (Mul x y) m             = translate x m ++ translate y m ++ [MUL]
> translate (Div x y) m             = translate x m ++ translate y m ++ [DIV]
> translate (Eq x y) m              = translate x m ++ translate y m ++ [EQUIV]






Grammar
--------

> asgn :: Parser Imp
> asgn = eqimp +++ expr
>
> expr :: Parser Imp
> expr = addimp +++ subimp +++ term
>
> term :: Parser Imp
> term = mulimp +++ divimp +++ factor
>
> factor :: Parser Imp
> factor = (do symbol "("; e <- expr; symbol ")"; return e)
>   +++ number +++ idnt
>
> number :: Parser Imp
> number = (do n <- natural; return (Num n))
>
> idnt :: Parser Imp
> idnt = (do i <- identifier; return (Var i))
> 
> ide :: Parser Ide
> ide = (do i <- identifier; return (i))


Expressions
-----------

> eqimp :: Parser Imp
> eqimp = (do i <- idnt; symbol "="; a <- asgn; return (Eq i a))
>   +++ (do i <- idnt; symbol "="; e <- expr; return (Eq i e))
>   +++ (do i <- idnt; symbol "="; i <- idnt; return (Eq i i))
>   +++ (do e1 <- expr; symbol "="; e2 <- expr; return (Eq e1 e2))

> addimp :: Parser Imp
> addimp = (do t <- term; symbol "+"; e <- expr; return (Add t e))
>           +++ (do i <- idnt; symbol "+"; t <- term; return (Add i t))

> subimp :: Parser Imp
> subimp = (do t <- term; symbol "-"; e <- expr; return (Sub t e))
>           +++ (do i <- idnt; symbol "-"; t <- term; return (Sub i t))

> mulimp :: Parser Imp
> mulimp = (do f <- factor; symbol "*"; t <- term; return (Mul f t))
>           +++ (do i <- idnt; symbol "*"; f <- factor; return (Mul i f))

> divimp :: Parser Imp
> divimp = (do f <- factor; symbol "/"; t <- term; return (Div f t))
>           +++ (do i <- idnt; symbol "/"; f <- factor; return (Div i f))


Commands
---------

>
> skipimp :: Parser Imp
> skipimp = (do symbol "skip"; return Skip)
>
> assignimp :: Parser Imp
> assignimp = (do i <- ide; symbol ":="; e <- expr; return (Assign i e))
>
> assignimp2 :: Parser Imp
> assignimp2 = (do i <- ide; symbol ":="; e <- expr; symbol ";"; return (Assign i e))
>            +++ (do i <- ide; symbol ":="; e <- expr; return (Assign i e))
>
> seqimp :: Parser Imp
> seqimp = (do w <- whileimp; symbol ";"; s2 <- seqimp; return (Seq w s2))
>           +++ (do w <- whileimp; symbol ";"; c2 <- com3; return (Seq w c2))
>           +++ (do i <- ifzimp; symbol ";"; s2 <- seqimp; return (Seq i s2))
>           +++ (do i <- ifzimp; symbol ";"; c2 <- com3; return (Seq i c2))
>           +++ (do c1 <- com2; symbol ";"; s2 <- seqimp; return (Seq c1 s2))
>           +++ (do c1 <- com2; symbol ";"; c2 <- com2; symbol ";"; return (Seq c1 c2))
>           +++ (do c1 <- com2; symbol ";"; c2 <- com2; return (Seq c1 c2))
>
> ifzimp :: Parser Imp
> ifzimp =  (do symbol "if"; e <- expr; symbol "then"; c1 <- com;  
>                    symbol "else"; symbol "("; c2 <- com; symbol ")"; return (Ifz e c1 c2))
>        +++ (do symbol "if"; e <- expr; symbol "then"; c1 <- com; 
>                    symbol "else"; c2 <- com; return (Ifz e c1 c2))
>
> whileimp :: Parser Imp
> whileimp = (do symbol "while"; e <- expr; symbol "do"; 
>                       symbol "("; c2 <- com; symbol ")"; return (While e c2))
>           +++ (do symbol "while"; e <- expr;
>                       symbol "do"; c2 <- com; return (While e c2))
>
> beginimp :: Parser Imp
> beginimp = (do symbol "begin"; c <- com; symbol "end"; return (Begin c))
>
>
> com :: Parser Imp
> com = seqimp 
>       +++ whileimp 
>       +++ ifzimp 
>       +++ beginimp
>       +++ assignimp 
>       +++ skipimp
>       +++ (do symbol "("; c <- com; symbol ")"; return c)
>
> com2 :: Parser Imp
> com2 = beginimp
>       +++ whileimp 
>       +++ ifzimp 
>       +++ assignimp 
>       +++ skipimp
>       +++ (do symbol "("; c <- com2; symbol ")"; return c)
>
> com3 :: Parser Imp
> com3 = beginimp
>       +++ whileimp 
>       +++ ifzimp
>       +++ assignimp2 
>       +++ skipimp
>       +++ (do symbol "("; c <- com2; symbol ")"; return c)


Parsers
-------

> parse_imp :: String -> Imp
> parse_imp str =
>   case parse com str of
>       [(result, [])] -> result
>       [(_, out)] -> error ("unused input: " ++ out)
>       [] -> error ("invalid input: " ++ str)
>
> parse_exp :: String -> Imp
> parse_exp str =
>   case parse asgn str of
>       [(result, [])] -> result
>       [(_, out)] -> error ("unused input: " ++ out)
>       [] -> error ("invalid input: " ++ str)

UPDATE: I removed the deriving Show at the type Code part. The translate function seems to be working if the parsed input does not involved variables...example: translate (parse_exp "1") [] results [Push (N 1)]. The remaining problem is that when I try something like translate (parse_exp "x + 1") because it will error about irrefutable pattern failed for pattern Just v. that line on translate (Assign x exp) m = ... where Just v = lookup x m I guess has the problem:

*Imp> translate (parse_exp "1 + 5") []
[Push (N 1), Push (N 5), ADD]
*Imp> translate (parse_exp "x + 1") []
[Push (Bind ("x",*** Exception: imp.lhs:50:66-84: Irrefutable pattern failed for pattern Just v

Answer 1

Notice the code Just v = lookup x m only works when the variable name referred to by x exists in map m. However, your translate function never adds variable to the environment so m is always empty and your Assign code will always throw an exception.

Solution? Well that depends on the specifics of your effort, but I'd add a way to bind variables such as lambda's. This won't make x +1 parse because x is still not in the environment, but it could make lambda x. x + 1 parse if you'd like. Notice you'll need to figure out how to get variables off the stack.