diff options
Diffstat (limited to 'src/Verismith/Verilog/Eval.hs')
| -rw-r--r-- | src/Verismith/Verilog/Eval.hs | 154 |
1 files changed, 81 insertions, 73 deletions
diff --git a/src/Verismith/Verilog/Eval.hs b/src/Verismith/Verilog/Eval.hs index cbc2563..eb65029 100644 --- a/src/Verismith/Verilog/Eval.hs +++ b/src/Verismith/Verilog/Eval.hs @@ -1,27 +1,25 @@ -{-| -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 +-- 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 - ) + ( 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 +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] @@ -32,25 +30,33 @@ paramValue_ :: Parameter -> ConstExpr paramValue_ (Parameter _ v) = v applyUnary :: (Num a, FiniteBits a) => UnaryOperator -> a -> a -applyUnary UnPlus a = a +applyUnary UnPlus a = a applyUnary UnMinus a = negate a -applyUnary UnLNot a | a == 0 = 0 - | otherwise = 1 +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 +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 @@ -62,55 +68,57 @@ 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 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 +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 + 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 +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 (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) + 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 + where + abv = applyBitVec f applyBitVec _ a = a -- | This probably could be implemented using some recursion scheme in the |