Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
module Expressions where
import Data.Map (Map)
import Data.Maybe
import Text.Printf
import qualified Data.Map as Map
data ExprF k = Term Int | Op Operator k k
deriving (Show, Eq, Functor)
data Operator = Sum | Mult | Sub | Div
deriving (Show, Eq)
type Expr = Free ExprF
term = I . Term
op o x y = I (Op o x y)
var = P
foldExpr :: (v -> a) -> (Int -> a) -> (Operator -> a -> a -> a) -> Expr v -> a
foldExpr fv ft fo = foldFree fi fv where
fi (Term i) = ft i
fi (Op o x y) = fo o x y
eval :: (Ord v, Show v) => Map v Int -> Expr v ->Int
eval env = foldExpr fv id getOp where
fv v = fromMaybe (error $ "Unbound variable: " ++ show v)
(Map.lookup v env)
getOp :: Operator -> Int -> Int -> Int
getOp o = case o of
Sum -> (+)
Mult -> (*)
Sub -> (-)
Div -> div
printExpr :: Show v => Expr v -> String
printExpr = foldExpr show show (flip printf "(%s %s %s)" . printOp)
printOp o = case o of
Sum -> "+"
Mult -> "*"
Sub -> "-"
Div -> "/"
countTerms :: Expr v -> Int
countTerms = foldExpr (const 1) (const 1) (const (+))
-- Free monads
data Free f a = I (f(Free f a)) | P a
foldFree fi fp = go where
go (P p) = fp p
go (I i) = fi (fmap go i)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment