public
Created

  • Download Gist
gistfile1.hs
Haskell
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 50 51 52 53 54 55 56
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)

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.