gistfile1.txt

module Expressions where

import qualified Data.Map as M
import Text.Printf
import Control.Monad
import qualified Control.Monad.Error as E

testExpr = (Op Sum (Val 1) (Symbol "x"))

type Value = Either Error Int
type Error = String
type Env a = M.Map String a

data Expr = Val Int | Symbol String | Op Operator Expr Expr
  deriving (Show, Eq)

data Operator = Sum | Mult | Sub | Div
  deriving (Show, Eq)
  
foldExpr :: (Int -> a) -> (Operator -> a -> a -> a) -> (String -> a) -> Expr -> a
foldExpr ft _ _ (Val i) = ft i
foldExpr _ _ fs (Symbol s) = fs s
foldExpr ft fo fs (Op o u v) = fo o (foldExpr ft fo fs u) (foldExpr ft fo fs v)

eval :: Env Int -> Expr -> Value
eval e = foldExpr Right getOp (resolve e)

-- resolve symbol
resolve :: Env Int -> String -> Value
resolve e s = maybe (Left ("Error "++s++" is unbound")) Right $ M.lookup s e

getOp :: Operator -> Value -> Value -> Value
getOp o = liftM2 $ case o of
  Sum  -> (+)
  Mult -> (*)
  Sub  -> (-)
  Div  -> div

printExpr :: Expr -> String
printExpr = foldExpr show (flip (printf "(%s %s %s)") . printOp) id

printOp o = case o of
  Sum  -> "+"
  Mult -> "*"
  Sub  -> "-"
  Div  -> "/"
  
countTerms :: Expr -> Int
countTerms = foldExpr (const 1) (const (+)) (const 1)

A couple of observations:

• the Prelude function "maybe" tidies up resolve nicely:

    resolve e s = maybe (Left $ "Error "++s++" is unbound") Right $ M.lookup s e
  

• The Monad instance for Either is defined in Control.Monad.Error. If you look in http://hackage.haskell.org/packages/archive/mtl/1.1.0.2/doc/html/src/Control-Monad-Error.htm, you'll see it is exactly as you have written.

Thanks Peter. Gist updated.