Log Monad

gistfile1.hs

--
-- Excerpt from Monads for functional programming
-- http://homepages.inf.ed.ac.uk/wadler/papers/marktoberdorf/baastad.pdf
--

-- 2.1 Variation zero: The basic evaluator 
--
data Term = Con Int | Div Term Term deriving (Show)

eval :: Term -> Int
eval (Con a) = a 
eval (Div t v) = div (eval t) (eval v)

answer :: Term
answer = Div (Div (Con 1972) (Con 2)) (Con 23) 

err :: Term
err = Div (Con 1) (Con 0)

-- 2.3 Variation three: Output
--

type M a = (Output, a)
type Output = String

eval1 :: Term -> M Int
eval1 (Con a) = (line (Con a) a, a)
eval1 (Div t u) = let (x, a) = eval1 t in
                  let (y, b) = eval1 u in 
                  (x ++ y ++ line (Div t u) (div a b), div a b)
--                (line (Div t u) (div a b) ++ y ++ x, div a b)
line :: Term -> Int -> Output
line t a = "eval(" ++ (show t) ++ ") <- " ++ (show a) ++ "\n "

-- 2.9 Variation three, revisited: Outpu
--

unit :: a -> M a
unit a = ("", a)

bind :: M a -> (a -> M b) -> M b
bind m k = let (x, a) = m  in
           let (y, b) = k a in
           (x ++ y, b)

out :: Output -> M ()
out x = (x, ())

eval2 :: Term -> M Int
-- eval2 (Con a) = unit a
eval2 (Con a) = out (line (Con a) a) `bind` λx -> unit a
eval2 (Div t u) = (eval2 t) `bind` \a -> eval2 u `bind` \b -> out (line (Div t u) (div a b)) `bind` \x -> unit (div a b)