From 03dfbc90ca32d4e4ca31dc201490b65b1023a34a Mon Sep 17 00:00:00 2001 From: Yann Herklotz Grave Date: Tue, 26 Feb 2019 13:09:40 +0000 Subject: Add Ord to AST and fix reduction function --- src/VeriFuzz/AST.hs | 44 ++++++++++++++++++++++---------------------- src/VeriFuzz/Reduce.hs | 6 ++++-- 2 files changed, 26 insertions(+), 24 deletions(-) (limited to 'src/VeriFuzz') diff --git a/src/VeriFuzz/AST.hs b/src/VeriFuzz/AST.hs index a37fc61..e8d60bb 100644 --- a/src/VeriFuzz/AST.hs +++ b/src/VeriFuzz/AST.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} {-| Module : VeriFuzz.AST Description : Definition of the Verilog AST types. @@ -11,6 +10,7 @@ Poratbility : POSIX Defines the types to build a Verilog AST. -} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} @@ -132,7 +132,7 @@ positiveArb = QC.suchThat QC.arbitrary (> 0) -- 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, Data, IsString, Semigroup, Monoid) + deriving (Eq, Show, Ord, Data, IsString, Semigroup, Monoid) makeLenses ''Identifier @@ -143,7 +143,7 @@ instance QC.Arbitrary Identifier where -- | Verilog syntax for adding a delay, which is represented as @#num@. newtype Delay = Delay { _getDelay :: Int } - deriving (Eq, Show, Data, Num) + deriving (Eq, Show, Ord, Data, Num) makeLenses ''Delay @@ -156,7 +156,7 @@ data Event = EId Identifier | EAll | EPosEdge Identifier | ENegEdge Identifier - deriving (Eq, Show, Data) + deriving (Eq, Show, Ord, Data) instance QC.Arbitrary Event where arbitrary = EId <$> QC.arbitrary @@ -187,7 +187,7 @@ data BinaryOperator = BinPlus -- ^ @+@ | BinLSR -- ^ @>>@ | BinASL -- ^ @<<<@ | BinASR -- ^ @>>>@ - deriving (Eq, Show, Data) + deriving (Eq, Show, Ord, Data) instance QC.Arbitrary BinaryOperator where arbitrary = QC.elements @@ -230,7 +230,7 @@ data UnaryOperator = UnPlus -- ^ @+@ | UnXor -- ^ @^@ | UnNxor -- ^ @~^@ | UnNxorInv -- ^ @^~@ - deriving (Eq, Show, Data) + deriving (Eq, Show, Ord, Data) instance QC.Arbitrary UnaryOperator where arbitrary = QC.elements @@ -249,7 +249,7 @@ instance QC.Arbitrary UnaryOperator where data Function = SignedFunc | UnSignedFunc - deriving (Eq, Show, Data) + deriving (Eq, Show, Ord, Data) instance QC.Arbitrary Function where arbitrary = QC.elements @@ -279,7 +279,7 @@ data Expr = Number { _exprSize :: Int , _exprBody :: Expr } | Str { _exprStr :: Text } - deriving (Eq, Show, Data) + deriving (Eq, Show, Ord, Data) instance Num Expr where a + b = BinOp a BinPlus b @@ -353,13 +353,13 @@ makeLenses ''Expr -- | Constant expression, which are known before simulation at compilation time. newtype ConstExpr = ConstExpr { _constNum :: Int } - deriving (Eq, Show, Data, Num, QC.Arbitrary) + deriving (Eq, Show, Ord, Data, Num, QC.Arbitrary) makeLenses ''ConstExpr data Task = Task { _taskName :: Identifier , _taskExpr :: [Expr] - } deriving (Eq, Show, Data) + } deriving (Eq, Show, Ord, Data) makeLenses ''Task @@ -381,7 +381,7 @@ data LVal = RegId { _regId :: Identifier} , _regSizeLSB :: ConstExpr } | RegConcat { _regConc :: [Expr] } - deriving (Eq, Show, Data) + deriving (Eq, Show, Ord, Data) makeLenses ''LVal @@ -398,7 +398,7 @@ instance IsString LVal where data PortDir = PortIn -- ^ Input direction for port (@input@). | PortOut -- ^ Output direction for port (@output@). | PortInOut -- ^ Inout direction for port (@inout@). - deriving (Eq, Show, Data) + deriving (Eq, Show, Ord, Data) instance QC.Arbitrary PortDir where arbitrary = QC.elements [PortIn, PortOut, PortInOut] @@ -407,7 +407,7 @@ instance QC.Arbitrary PortDir where -- not that common and not a priority. data PortType = Wire | Reg - deriving (Eq, Show, Data) + deriving (Eq, Show, Ord, Data) instance QC.Arbitrary PortType where arbitrary = QC.elements [Wire, Reg] @@ -426,7 +426,7 @@ data Port = Port { _portType :: PortType , _portSigned :: Bool , _portSize :: Int , _portName :: Identifier - } deriving (Eq, Show, Data) + } deriving (Eq, Show, Ord, Data) makeLenses ''Port @@ -444,7 +444,7 @@ data ModConn = ModConn { _modConn :: Expr } | ModConnNamed { _modConnName :: Identifier , _modExpr :: Expr } - deriving (Eq, Show, Data) + deriving (Eq, Show, Ord, Data) makeLenses ''ModConn @@ -454,7 +454,7 @@ instance QC.Arbitrary ModConn where data Assign = Assign { _assignReg :: LVal , _assignDelay :: Maybe Delay , _assignExpr :: Expr - } deriving (Eq, Show, Data) + } deriving (Eq, Show, Ord, Data) makeLenses ''Assign @@ -463,7 +463,7 @@ instance QC.Arbitrary Assign where data ContAssign = ContAssign { _contAssignNetLVal :: Identifier , _contAssignExpr :: Expr - } deriving (Eq, Show, Data) + } deriving (Eq, Show, Ord, Data) makeLenses ''ContAssign @@ -483,7 +483,7 @@ data Stmnt = TimeCtrl { _statDelay :: Delay | StatCA { _stmntCA :: ContAssign } -- ^ Stmnt continuous assignment. May not be correct. | TaskEnable { _stmntTask :: Task} | SysTaskEnable { _stmntSysTask :: Task} - deriving (Eq, Show, Data) + deriving (Eq, Show, Ord, Data) makeLenses ''Stmnt @@ -531,7 +531,7 @@ data ModItem = ModCA { _modContAssign :: ContAssign} | Decl { _declDir :: Maybe PortDir , _declPort :: Port } - deriving (Eq, Show, Data) + deriving (Eq, Show, Ord, Data) makeLenses ''ModItem @@ -548,7 +548,7 @@ data ModDecl = ModDecl { _modId :: Identifier , _modOutPorts :: [Port] , _modInPorts :: [Port] , _modItems :: [ModItem] - } deriving (Eq, Show, Data) + } deriving (Eq, Show, Ord, Data) traverseModConn :: (Applicative f) => (Expr -> f Expr) -> ModConn -> f ModConn traverseModConn f (ModConn e ) = ModConn <$> f e @@ -571,12 +571,12 @@ instance QC.Arbitrary ModDecl where -- | Description of the Verilog module. newtype Description = Description { _getDescription :: ModDecl } - deriving (Eq, Show, Data, QC.Arbitrary) + deriving (Eq, Show, Ord, Data, QC.Arbitrary) makeLenses ''Description -- | The complete sourcetext for the Verilog module. newtype VerilogSrc = VerilogSrc { _getVerilogSrc :: [Description] } - deriving (Eq, Show, Data, QC.Arbitrary, Semigroup, Monoid) + deriving (Eq, Show, Ord, Data, QC.Arbitrary, Semigroup, Monoid) makeLenses ''VerilogSrc diff --git a/src/VeriFuzz/Reduce.hs b/src/VeriFuzz/Reduce.hs index 6f11767..a074627 100644 --- a/src/VeriFuzz/Reduce.hs +++ b/src/VeriFuzz/Reduce.hs @@ -41,10 +41,12 @@ reduce eval src = do reduce eval l (False, True) -> reduce eval r - (True, True) -> + (True, True) -> do lreduced <- reduce eval l rreduced <- reduce eval r - return lreduced + if lreduced < rreduced + then return lreduced + else return rreduced _ -> return src where -- cgit