Expression for defining letrec implementing little language in Haskell

320 views Asked by At

I'm writing an evaluator for a little expression language, but I'm stuck on the LetRec construct.

This is the language:

data Expr = Var Nm  | Lam (Nm,Ty) Expr | App Expr Expr
      | Val Int | Add Expr Expr | If Expr Expr Expr
      | Let Nm Expr Expr
      | LetRec [((Nm,Ty),Expr)] Expr

And this the evaluator so far:

type Env = [ (Nm, Value) ]
data Value = Clos Env Expr
           | Vint Int
       deriving Show

eval :: Env -> Expr -> Value
eval _   (Val n) = Vint n 
eval env (Add e1 e2) = Vint (n1 + n2)  
   where
     Vint n1 = eval env e1  
     Vint n2 = eval env e2
eval env (If e e1 e0) = if n==0 then eval env e0 else eval env e1
                          where 
                            Vint n = eval env e
eval env (Var x) = case lookup x env of
                      Nothing -> error (x)
                      Just v  -> v
eval env (Lam x e) = Clos env (Lam x e)
eval env (App e1 e2) = case v1 of
                        Clos env1 (Lam (x,t) e) -> eval ((x,v2):env1) e
                          where
                            v1 = eval env e1
                            v2 = eval env e2
eval env (Let x e1 e2) = eval env' e2
                        where 
                            env' = (x,v) : env
                            v = eval env e1
eval env (LetRec [((x,t),e)] e1) = eval env' e1
               where
                 env' = env ++ map (\(v,e) -> (v, eval env' e)) [(x,e)]

This is my test function I want to evaluate:

t1 = LetRec
    [ (("not",  INT:->INT), Lam ("i",INT) $ If (Var "i")
                                            (Val 0)
                                            (Val 1))
    , (("even", INT:->INT), Lam ("i",INT) $ If (Var "i")
                                            (App (Var "not")
                                                 (App (Var "odd") 
                                                      (Var "i" `Add` Val (-1))))
                                            (Val 1))
    , (("odd",  INT:->INT), Lam ("i",INT) $ If (Var "i")
                                            (App (Var "not") 
                                                 (App (Var "even") 
                                                      (Var "i" `Add` Val (-1))))
                                            (Val 0))
    ]
    (App (Var "odd") (Val 7))
1

There are 1 answers

6
K. A. Buhr On BEST ANSWER

Note that your test program is wrong. You don't want to apply "not". A number n is even if n-1 IS odd, not if it ISN'T odd. So, it should be:

t1 = LetRec
    [ (("even", INT:->INT), Lam ("i",INT) $ If (Var "i")
                                            (App (Var "odd") 
                                                 (Var "i" `Add` Val (-1)))
                                            (Val 1))
    , (("odd",  INT:->INT), Lam ("i",INT) $ If (Var "i")
                                            (App (Var "even") 
                                                 (Var "i" `Add` Val (-1)))
                                            (Val 0))
    ]
  (App (Var "odd") (Val 7))

Your LetRec case is almost right. You've just written it to only handle singleton lists for some reason. Also, you want to put the letrec bindings at the start of the environment bindings list, not the end, otherwise bindings outside the letrec will take precedence. Try:

eval env (LetRec bnds body) = v
  where v = eval env' body
        env' = [(n, eval env' e) | ((n,_),e) <- bnds] ++ env

Here is the complete program. When run, it should print Vint 1:

type Nm = String
data Ty = INT | Ty :-> Ty
  deriving (Show)

data Expr = Var Nm  | Lam (Nm,Ty) Expr | App Expr Expr
          | Val Int | Add Expr Expr | If Expr Expr Expr
          | Let Nm Expr Expr
          | LetRec [((Nm,Ty),Expr)] Expr
          deriving (Show)

type Env = [ (Nm, Value) ]
data Value = Clos Env Expr
           | Vint Int
       deriving (Show)

eval :: Env -> Expr -> Value
eval _   (Val n) = Vint n
eval env (Add e1 e2) = Vint (n1 + n2)
  where
    Vint n1 = eval env e1
    Vint n2 = eval env e2
eval env (If e e1 e0) = if n==0 then eval env e0 else eval env e1
  where
    Vint n = eval env e
eval env (Var x) = case lookup x env of
  Nothing -> error (x ++ " not defined")
  Just v  -> v
eval env e@(Lam _ _) = Clos env e
eval env (App e1 e2) = case v1 of
  Clos env1 (Lam (x,t) e) -> eval ((x,v2):env1) e
  where
    v1 = eval env e1
    v2 = eval env e2
eval env (Let x e1 e2) = eval env' e2
  where
    env' = (x,v) : env
    v = eval env e1
eval env (LetRec bnds body) = eval env' body
  where env' = [(n, eval env' e) | ((n,_),e) <- bnds] ++ env

t1 :: Expr
t1 = LetRec
    [ (("even", INT:->INT), Lam ("i",INT) $ If (Var "i")
                                            (App (Var "odd")
                                                 (Var "i" `Add` Val (-1)))
                                            (Val 1))
    , (("odd",  INT:->INT), Lam ("i",INT) $ If (Var "i")
                                            (App (Var "even")
                                                 (Var "i" `Add` Val (-1)))
                                            (Val 0))
    ]
  (App (Var "odd") (Val 7))

main :: IO ()
main = print (eval [] t1)