public
Last active

  • Download Gist
gistfile1.txt
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49
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:

Thanks Peter. Gist updated.

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.