blob: cbc25635ca10378dbc329dfd14bed22d84519da2 (
plain)
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
|
{-|
Module : Verismith.Verilog.Eval
Description : Evaluation of Verilog expressions and statements.
Copyright : (c) 2019, Yann Herklotz Grave
License : GPL-3
Maintainer : yann [at] yannherklotz [dot] com
Stability : experimental
Portability : POSIX
Evaluation of Verilog expressions and statements.
-}
module Verismith.Verilog.Eval
( evaluateConst
, resize
)
where
import Data.Bits
import Data.Foldable (fold)
import Data.Functor.Foldable hiding (fold)
import Data.Maybe (listToMaybe)
import Verismith.Verilog.AST
import Verismith.Verilog.BitVec
type Bindings = [Parameter]
paramIdent_ :: Parameter -> Identifier
paramIdent_ (Parameter i _) = i
paramValue_ :: Parameter -> ConstExpr
paramValue_ (Parameter _ v) = v
applyUnary :: (Num a, FiniteBits a) => UnaryOperator -> a -> a
applyUnary UnPlus a = a
applyUnary UnMinus a = negate a
applyUnary UnLNot a | a == 0 = 0
| otherwise = 1
applyUnary UnNot a = complement a
applyUnary UnAnd a | finiteBitSize a == popCount a = 1
| otherwise = 0
applyUnary UnNand a | finiteBitSize a == popCount a = 0
| otherwise = 1
applyUnary UnOr a | popCount a == 0 = 0
| otherwise = 1
applyUnary UnNor a | popCount a == 0 = 1
| otherwise = 0
applyUnary UnXor a | popCount a `mod` 2 == 0 = 0
| otherwise = 1
applyUnary UnNxor a | popCount a `mod` 2 == 0 = 1
| otherwise = 0
applyUnary UnNxorInv a | popCount a `mod` 2 == 0 = 1
| otherwise = 0
compXor :: Bits c => c -> c -> c
compXor a = complement . xor a
toIntegral :: Num p => (t1 -> t2 -> Bool) -> t1 -> t2 -> p
toIntegral a b c = if a b c then 1 else 0
toInt :: (Integral a, Num t1) => (t2 -> t1 -> t3) -> t2 -> a -> t3
toInt a b c = a b $ fromIntegral c
applyBinary :: (Integral a, Bits a) => BinaryOperator -> a -> a -> a
applyBinary BinPlus = (+)
applyBinary BinMinus = (-)
applyBinary BinTimes = (*)
applyBinary BinDiv = quot
applyBinary BinMod = rem
applyBinary BinEq = toIntegral (==)
applyBinary BinNEq = toIntegral (/=)
applyBinary BinCEq = toIntegral (==)
applyBinary BinCNEq = toIntegral (/=)
applyBinary BinLAnd = undefined
applyBinary BinLOr = undefined
applyBinary BinLT = toIntegral (<)
applyBinary BinLEq = toIntegral (<=)
applyBinary BinGT = toIntegral (>)
applyBinary BinGEq = toIntegral (>=)
applyBinary BinAnd = (.&.)
applyBinary BinOr = (.|.)
applyBinary BinXor = xor
applyBinary BinXNor = compXor
applyBinary BinXNorInv = compXor
applyBinary BinPower = undefined
applyBinary BinLSL = toInt shiftL
applyBinary BinLSR = toInt shiftR
applyBinary BinASL = toInt shiftL
applyBinary BinASR = toInt shiftR
-- | Evaluates a 'ConstExpr' using a context of 'Bindings' as input.
evaluateConst :: Bindings -> ConstExprF BitVec -> BitVec
evaluateConst _ (ConstNumF b) = b
evaluateConst p (ParamIdF i) =
cata (evaluateConst p) . maybe 0 paramValue_ . listToMaybe $ filter
((== i) . paramIdent_)
p
evaluateConst _ (ConstConcatF c ) = fold c
evaluateConst _ (ConstUnOpF unop c ) = applyUnary unop c
evaluateConst _ (ConstBinOpF a binop b) = applyBinary binop a b
evaluateConst _ (ConstCondF a b c) = if a > 0 then b else c
evaluateConst _ (ConstStrF _ ) = 0
-- | Apply a function to all the bitvectors. Would be fixed by having a
-- 'Functor' instance for a polymorphic 'ConstExpr'.
applyBitVec :: (BitVec -> BitVec) -> ConstExpr -> ConstExpr
applyBitVec f (ConstNum b ) = ConstNum $ f b
applyBitVec f (ConstConcat c ) = ConstConcat $ fmap (applyBitVec f) c
applyBitVec f (ConstUnOp unop c) = ConstUnOp unop $ applyBitVec f c
applyBitVec f (ConstBinOp a binop b) =
ConstBinOp (applyBitVec f a) binop (applyBitVec f b)
applyBitVec f (ConstCond a b c) = ConstCond (abv a) (abv b) (abv c)
where abv = applyBitVec f
applyBitVec _ a = a
-- | This probably could be implemented using some recursion scheme in the
-- future. It would also be fixed by having a polymorphic expression type.
resize :: Int -> ConstExpr -> ConstExpr
resize n = applyBitVec (resize' n) where resize' n' (BitVec _ a) = BitVec n' a
|
