From c2ada55bccc73cb604b77270049f0cfcc7e92bb8 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Mon, 29 Jul 2019 15:47:22 +0200 Subject: Use HashMap for context --- src/VeriFuzz/Verilog/AST.hs | 3 +- src/VeriFuzz/Verilog/Eval.hs | 119 ------------------------------------------- 2 files changed, 2 insertions(+), 120 deletions(-) delete mode 100644 src/VeriFuzz/Verilog/Eval.hs (limited to 'src/VeriFuzz/Verilog') diff --git a/src/VeriFuzz/Verilog/AST.hs b/src/VeriFuzz/Verilog/AST.hs index a85c365..23d773d 100644 --- a/src/VeriFuzz/Verilog/AST.hs +++ b/src/VeriFuzz/Verilog/AST.hs @@ -145,6 +145,7 @@ import Control.Lens hiding ((<|)) import Data.Data import Data.Data.Lens import Data.Functor.Foldable.TH (makeBaseFunctor) +import Data.Hashable (Hashable) import Data.List.NonEmpty (NonEmpty (..), (<|)) import Data.String (IsString, fromString) import Data.Text (Text, pack) @@ -156,7 +157,7 @@ import VeriFuzz.Verilog.BitVec -- be lowercase and uppercase for now. This might change in the future though, -- as Verilog supports many more characters in Identifiers. newtype Identifier = Identifier { getIdentifier :: Text } - deriving (Eq, Show, Ord, Data, Generic, NFData) + deriving (Eq, Show, Ord, Data, Generic, NFData, Hashable) instance IsString Identifier where fromString = Identifier . pack diff --git a/src/VeriFuzz/Verilog/Eval.hs b/src/VeriFuzz/Verilog/Eval.hs deleted file mode 100644 index c802267..0000000 --- a/src/VeriFuzz/Verilog/Eval.hs +++ /dev/null @@ -1,119 +0,0 @@ -{-| -Module : VeriFuzz.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 VeriFuzz.Verilog.Eval - ( evaluateConst - , resize - ) -where - -import Data.Bits -import Data.Foldable (fold) -import Data.Functor.Foldable hiding (fold) -import Data.Maybe (listToMaybe) -import VeriFuzz.Verilog.AST -import VeriFuzz.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 -- cgit