gistfile1.hs

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)