haskellevaluationlanguage-implementationmutual-recursionletrec

Expression for defining letrec implementing little language in Haskell


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))

Solution

  • 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)