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