Create a gist now

Instantly share code, notes, and snippets.

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

A couple of observations:

@willtim
Owner
willtim commented Oct 1, 2010

Thanks Peter. Gist updated.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment