-- 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)))