-- Evaluator in a monad: with execution counts
-- Phil Wadler, 11 October 1991

-- Types are optional.  Some must be commented out to
-- work around a bug in Gofer.

-- The count monad

type  M a               =  (a, Int)

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

bind                    :: M a -> (a -> M b) -> M b
m `bind` k              =  case m of
                             (a,i) -> case k a of
                                        (b,j) -> (b,i+j)

-- disp                 :: Text a => M a -> String
disp (a,i)              =  show a ++ "\nCount: " ++ show i

tick                    :: M ()
tick                    =  ((), 1)

-- The evaluator
-- Lines with * are only change from evalIdent

data  Op                =  Add | Sub | Mul | Quo
data  Term              =  Con Int | Bin Op Term Term

eval                    :: Term -> M Int
eval (Con i)            =  unit i
eval (Bin op u v)       =  eval u     `bind` (\a  ->
                           eval v     `bind` (\b  ->
                           go op a b  `bind` (\c  ->    -- *
                           tick       `bind` (\ () ->   -- *
                           unit c))))                   -- *

go                      :: Op -> Int -> Int -> M Int
go Add a b              =  unit (a+b)
go Sub a b              =  unit (a-b)
go Mul a b              =  unit (a*b)
go Quo a b              =  unit (a `quot` b) -- WDP: was "div"

test                    :: Term -> String
test t                  =  disp (eval t)

-- Test data

add, sub, mul, quo      :: Term -> Term -> Term
u `add` v               =  Bin Add u v
u `sub` v               =  Bin Sub u v
u `mul` v               =  Bin Mul u v
u `quo` v               =  Bin Quo u v

term0,term1,term2       :: Term
term0                   =  Con 6 `mul` Con 9
term1                   =  (Con 4 `mul` Con 13) `add` Con 2
term2                   =  (Con 1 `quo` Con 2) `add` Con 2
term3                   =  ((((((((((((((((((((((((((((((((
                           ((((((((((((((((((((((((((((((
                                 Con 7777 `mul` Con  13) `quo` Con  13)
                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
                           `quo` Con 755) `mul` Con 755) `mul` Con 333)

sb 0 = term2
sb n = if (n `mod` 2) == 0
       then term2 `add` (sb (n-1))
       else term2 `sub` (sb (n-1))

main = print (show (eval (sb 5000)))
