diff options
Diffstat (limited to 'src/VeriFuzz/Eval.hs')
| -rw-r--r-- | src/VeriFuzz/Eval.hs | 117 |
1 files changed, 117 insertions, 0 deletions
diff --git a/src/VeriFuzz/Eval.hs b/src/VeriFuzz/Eval.hs new file mode 100644 index 0000000..f231772 --- /dev/null +++ b/src/VeriFuzz/Eval.hs @@ -0,0 +1,117 @@ +{-| +Module : VeriFuzz.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 VeriFuzz.Eval + ( evaluateConst + , resize + ) +where + +import Data.Bits +import Data.Foldable (fold) +import Data.Functor.Foldable hiding (fold) +import qualified Data.HashMap.Lazy as Map (lookup) +import Data.Maybe (listToMaybe) +import VeriFuzz.Context +import VeriFuzz.Verilog.AST +import VeriFuzz.Verilog.BitVec + +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 'ParamContext' as input. +evaluateConst :: ParamContext -> ConstExprF BitVec -> BitVec +evaluateConst _ (ConstNumF b) = b +evaluateConst p (ParamIdF i) = + cata (evaluateConst p) . maybe 0 paramValue_ $ Map.lookup i 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 |