1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
-- 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)))
|
