blob: a9a2d0e173eccbbaa30ded43c1dced608763dc13 (
plain) (
blame)
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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
implementation module ABC.Machine.BStack
import StdEnv
import ABC.Machine
import ABC.Misc
instance == Basic
where
(==) (Bool b) (Bool c) = b == c
(==) (Int m) (Int n) = m == n
(==) _ _ = False
instance toString Basic
where
toString (Bool b) = toString b
toString (Int i) = toString i
:: BStack :== [Basic]
instance toString BStack where toString xs = "[" <++ (",", xs) <+ "]"
bs_copy :: BSrc BStack -> BStack
bs_copy i s = [bs_get i s:s]
bs_get :: BSrc BStack -> Basic
bs_get _ [] = abortn "bs_get: index too large"
bs_get 0 [b:s] = b
bs_get i [_:s] = bs_get (i-1) s
bs_getB :: BSrc BStack -> Bool
bs_getB i s = case bs_get i s of
(Bool b) = b
_ = abortn "bs_getB on non-Bool value\n"
bs_getI :: BSrc BStack -> Int
bs_getI i s = case bs_get i s of
(Int i) = i
_ = abortn "bs_getI on non-Int value\n"
bs_init :: BStack
bs_init = []
bs_popn :: NrArgs BStack -> BStack
bs_popn 0 s = s
bs_popn _ [] = abortn "bs_popn: popping too many elements"
bs_popn i [_:s] = bs_popn (i - 1) s
bs_push :: Basic BStack -> BStack
bs_push d s = [d:s]
bs_pushB :: Bool BStack -> BStack
bs_pushB b s = [Bool b:s]
bs_pushI :: Int BStack -> BStack
bs_pushI i s = [Int i:s]
bs_update :: BDst Basic BStack -> BStack
bs_update 0 d [_:s] = [d:s]
bs_update _ _ [] = abortn "bs_update: index too large"
bs_update i d [e:s] = [e:bs_update (i - 1) d s]
bs_addI :: BStack -> BStack
bs_addI [Int m:Int n:s] = bs_pushI (m + n) s
bs_addI _ = abortn "bs_addI: no integers"
bs_decI :: BStack -> BStack
bs_decI [Int n:s] = bs_pushI (n-1) s
bs_decI _ = abortn "bs_decI: no integer"
bs_divI :: BStack -> BStack
bs_divI [Int m:Int n:s] = bs_pushI (m / n) s
bs_divI _ = abortn "bs_divI: no integers"
bs_incI :: BStack -> BStack
bs_incI [Int n:s] = bs_pushI (n + 1) s
bs_incI _ = abortn "bs_incI: no integer"
bs_eqB :: BStack -> BStack
bs_eqB [Bool b:Bool c:s] = bs_pushB (b == c) s
bs_eqB _ = abortn "bs_eqB: no booleans"
bs_eqI :: BStack -> BStack
bs_eqI [Int m:Int n:s] = bs_pushB (m == n) s
bs_eqI _ = abortn "bs_eqI: no integers"
bs_eqBi :: Bool BSrc BStack -> BStack
bs_eqBi b i s = bs_pushB (bs_getB i s == b) s
bs_eqIi :: Int BSrc BStack -> BStack
bs_eqIi n i s = bs_pushB (bs_getI i s == n) s
bs_gtI :: BStack -> BStack
bs_gtI [Int m:Int n:s] = bs_pushB (m > n) s
bs_gtI _ = abortn "bs_gtI: no integers"
bs_ltI :: BStack -> BStack
bs_ltI [Int m:Int n:s] = bs_pushB (m < n) s
bs_ltI _ = abortn "bs_ltI: no integers"
bs_mulI :: BStack -> BStack
bs_mulI [Int m:Int n:s] = bs_pushI (m * n) s
bs_mulI _ = abortn "bs_mulI: no integers"
bs_negI :: BStack -> BStack
bs_negI [Int n:s] = bs_pushI (~n) s
bs_negI _ = abortn "bs_negI: no integer"
bs_remI :: BStack -> BStack
bs_remI [Int m:Int n:s] = bs_pushI (m rem n) s
bs_remI _ = abortn "bs_remI: no integers"
bs_subI :: BStack -> BStack
bs_subI [Int m:Int n:s] = bs_pushI (m - n) s
bs_subI _ = abortn "bs_subI: no integers"
|
