5
\$\begingroup\$

This is my first nontrivial Haskell program:

module Main where
import qualified Data.Map as Map

type Env = Map.Map String Expression

data Expression =
  Constant Integer
  | Variable String
  | Add Expression Expression
  | Multiply Expression Expression
  | Let [(String, Expression)] Expression
  | Lambda String Expression
  | Call String Expression
  | Closure Env String Expression
  deriving Show

evaluate :: Env -> Expression -> Expression

evaluate env constant@(Constant _) = constant

evaluate env (Variable name) =
  case Map.lookup name env of
    Just expr -> expr
    _ -> error ("No such variable " ++ name ++ " in Variable expression")

evaluate env (Add aExpr bExpr) =
  let
    aValue = evaluate env aExpr
    bValue = evaluate env bExpr
  in
    case (aValue, bValue) of
      (Constant aInt, Constant bInt) -> Constant (aInt + bInt)
      _ -> error ("Add applied to non-integer")

evaluate env (Multiply aExpr bExpr) =
  let
    aValue = evaluate env aExpr
    bValue = evaluate env bExpr
  in
    case (aValue, bValue) of
      (Constant aInt, Constant bInt) -> Constant (aInt * bInt)
      _ -> error ("Multiply applied to non-integer")

evaluate env (Let bindings body) =
  let
    addBindingsToEnv acc [] = acc
    addBindingsToEnv acc (x : xs) =
      let acc' = Map.insert (fst x) (evaluate env (snd x)) acc
      in addBindingsToEnv acc' xs
  in evaluate (addBindingsToEnv env bindings) body

evaluate env (Lambda param body) = Closure env param body

evaluate env (Call name arg) =
  let
    evaluateClosure (Closure capturedEnv param body) =
      let
        argValue = evaluate env arg
        closureEnv = Map.insert param argValue capturedEnv
      in
        evaluate closureEnv body
  in
    case Map.lookup name env of
      Just x@(Closure _ _ _) -> evaluateClosure x
      Just x -> error ("Variable " ++ name ++ " is not closure in Call expression")
      _ -> error ("No such variable " ++ name ++ " in Call expression")

main :: IO ()
main = do
  let result = evaluate
                (Map.fromList [("x", Constant 5)])
                (Let [
                    ("f", (Lambda "p" (Add (Variable "p") (Constant 10)))),
                    ("y", (Constant 20))
                  ]
                  (Let [("temp", (Call "f" (Variable "x")))]
                    (Multiply (Variable "temp") (Variable "y"))))
  putStrLn . show $ result

It implements a simple evaluator for a minimal Scheme-like language. Programs are represented using nodes from the Expression type. The sample program in the main function is equivalent to the following Racket program:

#lang racket
(define x 5)
(define result
  (let ([f (lambda (p) (+ p 10))]
        [y 20])
    (let ([temp (f x)])
      (* temp y))))
(print result)

I would be interested to hear feedback about my Haskell style and use of idioms and any bugs you might find!

Update

Here's a heavily refactored version based on @Sean Perry's feedback:

module Main where
import qualified Data.Map as Map

type Env = Map.Map String Expression

data ArithmeticExpression = Add Expression Expression
                          | Multiply Expression Expression
                          deriving Show

data Expression = Constant Integer
                | Variable String
                | ArithmeticExpression ArithmeticExpression
                | Let [(String, Expression)] Expression
                | Lambda String Expression
                | Call String Expression
                | Closure Env String Expression
                deriving Show

evaluateArithmeticExpression :: Env -> ArithmeticExpression -> Either String Expression

evaluateArithmeticExpression env (Add aExpr bExpr) = do
  aValue <- evaluate env aExpr
  bValue <- evaluate env bExpr
  case (aValue, bValue) of
    (Constant aInt, Constant bInt) -> Right $ Constant (aInt + bInt)
    _ -> Left "Add applied to non-integer"

evaluateArithmeticExpression env (Multiply aExpr bExpr) = do
  aValue <- evaluate env aExpr
  bValue <- evaluate env bExpr
  case (aValue, bValue) of
    (Constant aInt, Constant bInt) -> Right $ Constant (aInt * bInt)
    _ -> Left "Multiply applied to non-integer"

evaluateClosure :: Env -> String -> Expression -> Expression -> Either String Expression

evaluateClosure capturedEnv param body argValue = do
  evaluate (Map.insert param argValue capturedEnv) body

evaluate :: Env -> Expression -> Either String Expression

evaluate env constant@(Constant _) = Right constant

evaluate env (Variable name) =
  case Map.lookup name env of
    Just expr -> Right expr
    _ -> Left $ "No such variable " ++ name ++ " in Variable expression"

evaluate env (ArithmeticExpression e) =
  evaluateArithmeticExpression env e

evaluate env (Let bindings body) =
  let
    addBindingsToEnv :: Env -> [(String, Expression)] -> Either String Env
    addBindingsToEnv acc [] = Right acc
    addBindingsToEnv acc (x : xs) = do
      xValue <- evaluate env (snd x)
      addBindingsToEnv (Map.insert (fst x) xValue acc) xs
  in
    do
      letEnv <- addBindingsToEnv env bindings
      evaluate letEnv body

evaluate env (Lambda param body) = Right $ Closure env param body

evaluate env (Call name arg) =
  case Map.lookup name env of
    Just (Closure capturedEnv param body) -> do
      argValue <- evaluate env arg
      evaluateClosure capturedEnv param body argValue
    Just x -> Left $ "Variable " ++ name ++ " is not closure in Call expression"
    _ -> Left $ "No such variable " ++ name ++ " in Call expression"

main :: IO ()
main = do
  let result = evaluate
                (Map.fromList [("x", Constant 5)])
                (Let [
                    ("f", (Lambda "p" (ArithmeticExpression (Add (Variable "p") (Constant 10))))),
                    ("y", (Constant 20))
                  ]
                  (Let [("temp", (Call "f" (Variable "x")))]
                    (ArithmeticExpression (Multiply (Variable "temp") (Variable "y")))))
  putStrLn . show $ result
\$\endgroup\$
3
\$\begingroup\$

I would change the type of evaluate to return Either String Expression. This also leads to using the Monad to structure the functions.

As an example:

evaluate :: Env -> Expression -> Either String Expression
evaluate env (Add aExpr bExpr) = do
    aValue <- evaluate env aExpr  -- if either of these two evaluates fail this call
    bValue <- evaluate env bExpr  -- to evaluate will stop and return the failure 
    case (aValue, bValue) of
      (Constant aInt, Constant bInt) -> Right $ Constant (aInt + bInt)
      _ -> Left "Add applied to non-integer"

This way you can catch and handle the Left cases. error is typically not used in live code.

Personally, I would break the Number expressions out into a separate Math/Num Expression which would allow for focused optimizations, sub processing, etc.

data MathExpression = Add Expression Expression
                    | Multiply Expression Expression
  deriving (Show)

data Expression = Constant Integer
                | Variable String
                | MathExpression
                | Let [(String, Expression)] Expression
                | Lambda String Expression
                | Call String Expression
                | Closure Env String Expression
  deriving Show

I find the stacked let style really hard to follow and in most cases you do no need them. This is especially true once evaluate returns an Either.

evaluate env (Call name arg) =
    case Map.lookup name env of
      Just (Closure capturedEnv param body) -> do
        argValue <- evaluate env arg
        evaluateClosure param capturedEnv body argValue
      Just x -> Left ("Variable " ++ name ++ " is not closure in Call expression")
      _ -> Left ("No such variable " ++ name ++ " in Call expression")

-- move this out to facilitate unit testing
evaluateClosure :: String -> Env -> Expression -> Expression -> Either String Expression
evaluateClosure param capturedEnv body closure =
  let closureEnv = Map.insert param closure capturedEnv
   in evaluate closureEnv body
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.