-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathOps.hs
154 lines (130 loc) · 4.42 KB
/
Ops.hs
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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
-- Common data types
module Ops where
import Text.PrettyPrint
import Data.Bits
import Data.List
import PP
data Radix = Rad2
| Rad8
| Rad10
| Rad16
deriving (Eq)
data UOp = UMinus
| Not
| BNeg
| Deref
| AddrOf
deriving (Eq, Ord)
instance PP UOp where
pp UMinus = char '-'
pp Not = char '!'
pp BNeg = char '~'
pp Deref = char '*'
pp AddrOf = char '&'
instance Show UOp where
show = render . pp
data BOp = Eq
| Neq
| Lt
| Gt
| Lte
| Gte
| And
| Or
| Imp
| BAnd
| BOr
| BXor
| BConcat
| Plus
| BinMinus
| Mod
| Mul
deriving(Eq,Ord)
isRelBOp :: BOp -> Bool
isRelBOp op = elem op [Eq,Neq,Lt,Gt,Lte,Gte]
isBoolBOp :: BOp -> Bool
isBoolBOp op = elem op [And,Or,Imp]
isArithBOp :: BOp -> Bool
isArithBOp op = elem op [BAnd,BOr,BXor,BConcat,Plus,BinMinus,Mod,Mul]
isArithUOp :: UOp -> Bool
isArithUOp op = elem op [UMinus,BNeg]
isBitWiseBOp :: BOp -> Bool
isBitWiseBOp op = elem op [BAnd,BOr,BXor]
instance PP BOp where
pp Eq = text "=="
pp Neq = text "!="
pp Lt = text "<"
pp Gt = text ">"
pp Lte = text "<="
pp Gte = text ">="
pp And = text "&&"
pp Or = text "||"
pp Imp = text "->"
pp BAnd = text "&"
pp BOr = text "|"
pp BXor = text "^"
pp BConcat = text "++"
pp Plus = text "+"
pp BinMinus = text "-"
pp Mod = text "%"
pp Mul = text "*"
instance Show BOp where
show = render . pp
-- Determine type of result of arith expression.
-- Type of each operand and the result is described as (signed?, width)
arithBOpType :: BOp -> (Bool,Int) -> (Bool,Int) -> (Bool,Int)
arithBOpType op (s1,w1) (s2,w2) | elem op [BAnd,BOr,BXor] = (s1,w1)
arithBOpType BConcat (s1,w1) (s2,w2) = (False, w1 + w2)
arithBOpType op (s1,w1) (s2,w2) | elem op [Plus,Mul,BinMinus] = case (s1, s2) of
(False, False) -> (False, max w1 w2)
_ -> (True, max w1 w2)
arithBOpType Mod (s1,w1) (s2,w2) = (s1,w1)
arithUOpType :: UOp -> (Bool,Int) -> (Bool,Int)
arithUOpType BNeg (s,w) = (s,w)
arithUOpType UMinus (s,w) = (True,w)
-- Perform binary arithmetic operation
-- Takes integer arguments and their widths
arithBOp :: BOp -> (Integer,Bool,Int) -> (Integer,Bool,Int) -> (Integer,Bool,Int)
arithBOp op (i1,s1,w1) (i2,s2,w2) | elem op [BAnd,BOr,BXor] = (i,s,w)
where (s,w) = arithBOpType op (s1,w1) (s2,w2)
f = case op of
BAnd -> (&&)
BOr -> (||)
BXor -> (\b1 b2 -> (b1 && not b2) || (b2 && not b1))
i = foldl' (\v idx -> case f (testBit i1 idx) (testBit i2 idx) of
True -> setBit v idx
False -> v)
0 [0..w - 1]
arithBOp BConcat (i1,s1,w1) (i2,s2,w2) = (i,s,w)
where (s,w) = arithBOpType BConcat (s1,w1) (s2,w2)
i1' = abs i1
i2' = abs i2
i = i1' + (i2' `shiftL` w1)
arithBOp op (i1,s1,w1) (i2,s2,w2) | elem op [Plus,BinMinus,Mod,Mul] = (i',s,w)
where (s,w) = arithBOpType op (s1,w1) (s2,w2)
i = case op of
Plus -> i1 + i2
BinMinus -> i1 - i2
Mod -> mod i1 i2
Mul -> i1 * i2
.&.
(sum $ map bit [0..w - 1])
i' = if s && testBit i (w-1)
then - ((foldl' (\x idx -> complementBit x idx) i [0..w-1]) + 1)
else i
-- Perform unary arithmetic operation
-- Takes integer argument and width
arithUOp :: UOp -> (Integer, Bool, Int) -> (Integer, Bool, Int)
arithUOp BNeg (i,s,w) = (foldl' (\v idx -> complementBit v idx) i [0..w - 1], s, w)
arithUOp UMinus (i,s,w) = ((-i) .&. (sum $ map bit [0..w - 1]), True, w)
data LogicOp = Implies
| Implied
| Iff
deriving(Eq, Ord)
instance PP LogicOp where
pp Implies = text "==>"
pp Implied = text "<=="
pp Iff = text "<=>"
instance Show LogicOp where
show = render . pp