Skip to content

Instantly share code, notes, and snippets.

@willtim
Created September 30, 2010 18:48
Show Gist options
  • Save willtim/605090 to your computer and use it in GitHub Desktop.
Save willtim/605090 to your computer and use it in GitHub Desktop.
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
Copy link

A couple of observations:

@willtim
Copy link
Author

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