diff --git a/src/Verismith/Verilog2005/AST.hs b/src/Verismith/Verilog2005/AST.hs index cc8fdd9..46bf6ea 100644 --- a/src/Verismith/Verilog2005/AST.hs +++ b/src/Verismith/Verilog2005/AST.hs @@ -27,6 +27,7 @@ module Verismith.Verilog2005.AST CExpr (..), Expr (..), Attribute (..), + Attributes, Attributed (..), AttrIded (..), Range2 (..), @@ -355,10 +356,10 @@ data GenExpr i r a instance (Data i, Data r, Data a) => Plated (GenExpr i r a) where plate = uniplate -newtype CExpr = CExpr (GenExpr Identifier (Maybe CRangeExpr) [Attribute]) +newtype CExpr = CExpr (GenExpr Identifier (Maybe CRangeExpr) Attributes) deriving (Show, Eq, Data, Generic) -newtype Expr = Expr (GenExpr HierIdent (Maybe DimRange) [Attribute]) +newtype Expr = Expr (GenExpr HierIdent (Maybe DimRange) Attributes) deriving (Show, Eq, Data, Generic) -- | Attributes which can be set to various nodes in the AST. @@ -368,7 +369,9 @@ data Attribute = Attribute } deriving (Show, Eq, Data, Generic) -data Attributed t = Attributed {_attrAttr :: ![Attribute], _attrData :: !t} +type Attributes = [[Attribute]] + +data Attributed t = Attributed {_attrAttr :: !Attributes, _attrData :: !t} deriving (Show, Eq, Data, Generic) instance Functor Attributed where @@ -384,7 +387,7 @@ instance Foldable Attributed where instance Traversable Attributed where sequenceA (Attributed a x) = fmap (Attributed a) x -data AttrIded t = AttrIded {_aiAttr :: ![Attribute], _aiIdent :: !Identifier, _aiData :: !t} +data AttrIded t = AttrIded {_aiAttr :: !Attributes, _aiIdent :: !Identifier, _aiData :: !t} deriving (Show, Eq, Data, Generic) instance Functor AttrIded where @@ -409,6 +412,7 @@ type RangeExpr = GenRangeExpr Expr type CRangeExpr = GenRangeExpr CExpr +-- TODO? this can definitely be omitted and expressed as a MTM -- | Number or Identifier data NumIdent = NIIdent !Identifier @@ -416,19 +420,20 @@ data NumIdent | NINumber !Natural deriving (Show, Eq, Data, Generic) +-- TODO? Base and 1 can be expressed as 3, not 2 though, option delay means delay 0 -- | Delay3 data Delay3 = D3Base !NumIdent | D31 !MinTypMax - | D32 !MinTypMax !MinTypMax - | D33 !MinTypMax !MinTypMax !MinTypMax + | D32 { _d32Rise :: !MinTypMax, _d32Fall :: !MinTypMax } + | D33 { _d33Rise :: !MinTypMax, _d33Fall :: !MinTypMax, _d33HighZ :: !MinTypMax } deriving (Show, Eq, Data, Generic) -- | Delay2 data Delay2 = D2Base !NumIdent | D21 !MinTypMax - | D22 !MinTypMax !MinTypMax + | D22 { _d22Rise :: !MinTypMax, _d22Fall :: !MinTypMax } deriving (Show, Eq, Data, Generic) -- | Delay1 @@ -825,7 +830,7 @@ data STCAddArgs = STCAddArgs -- | Module path condition data ModulePathCondition - = MPCCond !(GenExpr Identifier () [Attribute]) + = MPCCond !(GenExpr Identifier () Attributes) | MPCNone | MPCAlways deriving (Show, Eq, Data, Generic) @@ -1174,7 +1179,7 @@ data ModuleItem | MIParameter !(AttrIded Parameter) | MIGenReg ![Attributed ModGenBlockedItem] | MISpecParam - { _mispAttribute :: ![Attribute], + { _mispAttribute :: !Attributes, _mispRange :: !(Maybe Range2), _mispDecl :: !SpecParamDecl } @@ -1184,8 +1189,9 @@ data ModuleItem type GenerateBlock = Identified [Attributed ModGenBlockedItem] -- | Module block +-- TODO: remember whether the module is a module or macromodule because implementation dependent data ModuleBlock = ModuleBlock - { _mbAttr :: ![Attribute], + { _mbAttr :: !Attributes, _mbIdent :: !Identifier, _mbPortInter :: ![Identified [Identified (Maybe CRangeExpr)]], _mbBody :: ![ModuleItem], @@ -1260,7 +1266,7 @@ data PrimPort -- | Primitive block data PrimitiveBlock = PrimitiveBlock - { _pbAttr :: ![Attribute], + { _pbAttr :: !Attributes, _pbIdent :: !Identifier, _pbOutput :: !Identifier, _pbInput :: !(NonEmpty Identifier), diff --git a/src/Verismith/Verilog2005/Generator.hs b/src/Verismith/Verilog2005/Generator.hs index 1bc78df..16a81fc 100644 --- a/src/Verismith/Verilog2005/Generator.hs +++ b/src/Verismith/Verilog2005/Generator.hs @@ -357,10 +357,11 @@ garbageBareCMTM = (MTMFull <$> garbageCExpr <*> garbageCExpr <*> garbageCExpr) (MTMSingle <$> garbageCExpr) -garbageAttributes :: GenM' [Attribute] +garbageAttributes :: GenM' Attributes garbageAttributes = repeatExprRecursive _goAttributes $ - Attribute <$> garbageBS <*> sampleMaybe _goAttributeOptionalValue gattr + repeatExprRecursive _goAttributes $ + Attribute <$> garbageBS <*> sampleMaybe _goAttributeOptionalValue gattr where gattr = garbageGenExpr diff --git a/src/Verismith/Verilog2005/Parser.hs b/src/Verismith/Verilog2005/Parser.hs index e267da7..60e4b14 100644 --- a/src/Verismith/Verilog2005/Parser.hs +++ b/src/Verismith/Verilog2005/Parser.hs @@ -59,7 +59,7 @@ type Branch a = Produce (Parser a) type LBranch a = [Branch a] -- | Same as above but parametrised by attributes -type AProduce a = Produce ([Attribute] -> a) +type AProduce a = Produce (Attributes -> a) type LAProduce a = [AProduce a] @@ -67,7 +67,7 @@ type ABranch a = AProduce (Parser a) type LABranch a = [ABranch a] -type APBranch a = Produce ([Attribute] -> SourcePos -> Parser a) +type APBranch a = Produce (Attributes -> SourcePos -> Parser a) type LAPBranch a = [APBranch a] @@ -323,12 +323,13 @@ attribute = do *> genExpr (pure . Identifier) (optionMaybe constRangeExpr) (pure ()) Just constifyMaybeRange return $ Attribute attr value +-- TODO: this is likely incorrectly used but I leave this bug on purpose atm attributeOne :: Parser [Attribute] attributeOne = enclosed SymParenAster SymAsterParen $ NE.toList <$> csl1 attribute -- | Flattened list of attributes -attributes :: Parser [Attribute] -attributes = concat <$> many attributeOne +attributes :: Parser Attributes +attributes = many attributeOne -- | Number after base number :: Base -> Parser Number @@ -864,7 +865,7 @@ statement = fpbranch $ \p t -> case t of attrStmt :: Parser AttrStmt attrStmt = Attributed <$> attributes <*> statement -trOptStmt :: [Attribute] -> Parser MybStmt +trOptStmt :: Attributes -> Parser MybStmt trOptStmt a = fmap (Attributed a) $ Just <$> statement <|> consume SymSemi *> return Nothing optStmt :: Parser MybStmt @@ -1334,7 +1335,7 @@ portsimple :: Maybe NetType -> Bool -> Dir -> - [Attribute] -> + Attributes -> Parser (NonEmpty (NonEmpty ModuleItem, PortInterface)) portsimple dnt fullspec d a = do nt <- optionMaybe $ lproduce netType @@ -1359,7 +1360,7 @@ portsimple dnt fullspec d a = do -- | Declaration of a port with a variable type portvariable :: Bool -> - [Attribute] -> + Attributes -> ( Compose Identity Identified (Either [Range2] CExpr) -> BlockDecl (Compose Identity Identified) (Either [Range2] CExpr) ) -> @@ -1646,7 +1647,7 @@ npmodItem = ] -- | Module -parseModule :: LocalCompDir -> [Attribute] -> Parser Verilog2005 +parseModule :: LocalCompDir -> Attributes -> Parser Verilog2005 parseModule (LocalCompDir ts cl pull dnt) a = do s <- lenientIdent params <- option [] $ do @@ -1757,7 +1758,7 @@ seqRow = do return res -- | Parses a primitive block -udp :: [Attribute] -> Parser Verilog2005 +udp :: Attributes -> Parser Verilog2005 udp attr = do udpid <- ident (out, ins, mpd) <- parens udpHead @@ -1864,7 +1865,7 @@ topDecl :: Parser Verilog2005 topDecl = skipMany1 compDir *> return mempty <|> do -- I'm not sure whether these compiler directives are allowed here - a <- concat <$> many (attributeOne <* skipMany compDir) + a <- many (attributeOne <* skipMany compDir) st <- getState fpbranch $ \p t -> case t of KWPrimitive -> Just $ udp a <* closeConsume p KWPrimitive KWEndprimitive diff --git a/src/Verismith/Verilog2005/PrettyPrinter.hs b/src/Verismith/Verilog2005/PrettyPrinter.hs index 3d8d5e8..abbb1a0 100644 --- a/src/Verismith/Verilog2005/PrettyPrinter.hs +++ b/src/Verismith/Verilog2005/PrettyPrinter.hs @@ -205,10 +205,10 @@ padjWith f d i = if nullDoc d then f i else (<> d) <$> padj f i >>= mkid prettyEq :: Doc -> (Doc, Doc) -> (Doc, Doc) prettyEq i = first $ \x -> ng $ group i <=> equals <+> group x -prettyAttrng :: [Attribute] -> Doc -> Print +prettyAttrng :: Attributes -> Doc -> Print prettyAttrng a x = ( ng x) <$> prettyAttr a -prettyItem :: [Attribute] -> Doc -> Print +prettyItem :: Attributes -> Doc -> Print prettyItem a x = (<> semi) <$> prettyAttrng a x prettyItems :: Doc -> (a -> Print) -> NonEmpty a -> Print @@ -217,11 +217,11 @@ prettyItems h f b = (\x -> group h <=> group x <> semi) <$> csl1 (fmap ng . f) b prettyItemsid :: Doc -> PrettyIdent a -> NonEmpty a -> Print prettyItemsid h f b = (\x -> group h <=> x <> semi) <$> gpadj (cslid1 $ mkng f) b -prettyAttrThen :: [Attribute] -> Print -> Print +prettyAttrThen :: Attributes -> Print -> Print prettyAttrThen = liftA2 () . prettyAttr -prettyAttr :: [Attribute] -> Print -prettyAttr = nonEmpty (pure mempty) $ fmap (\x -> group $ "(* " <> fst x <=> "*)") . cslid1 pa +prettyAttr :: Attributes -> Print +prettyAttr = pl (<=>) $ nonEmpty (pure mempty) $ fmap (\x -> group $ "(* " <> fst x <=> "*)") . cslid1 pa where pa (Attribute i e) = maybe (prettyBS i) (liftA2 prettyEq (rawId $ Identifier i) . pca) e pca = prettyGExpr prettyIdent (pm prettyCRangeExpr) (const $ pure mempty) 12 @@ -1101,10 +1101,10 @@ prettySpecifyItem x = data ModuleItem' = MI'MGI (Attributed ModGenSingleItem) - | MI'Port [Attribute] Dir SignRange (NonEmpty Identifier) - | MI'Parameter [Attribute] (ComType ()) (NonEmpty (Identified CMinTypMax)) + | MI'Port Attributes Dir SignRange (NonEmpty Identifier) + | MI'Parameter Attributes (ComType ()) (NonEmpty (Identified CMinTypMax)) | MI'GenReg [Attributed ModGenSingleItem] - | MI'SpecParam [Attribute] (Maybe Range2) (NonEmpty SpecParamDecl) + | MI'SpecParam Attributes (Maybe Range2) (NonEmpty SpecParamDecl) | MI'SpecBlock [SpecifySingleItem] prettyModuleItems :: [ModuleItem] -> Print @@ -1190,7 +1190,7 @@ prettyModuleBlock (LocalCompDir ts c p dn) (ModuleBlock a i pi b mts mc mp mdn) in case v of 0 -> "1"; 1 -> "10"; 2 -> "100" <> case u of 0 -> "s"; -1 -> "ms"; -2 -> "us"; -3 -> "ns"; -4 -> "ps"; -5 -> "fs" -prettyPrimPorts :: ([Attribute], PrimPort, NonEmpty Identifier) -> Print +prettyPrimPorts :: (Attributes, PrimPort, NonEmpty Identifier) -> Print prettyPrimPorts (a, d, l) = do (ids, s) <- cslid1 prettyIdent l ports <- case d of diff --git a/src/Verismith/Verilog2005/Randomness.hs b/src/Verismith/Verilog2005/Randomness.hs index fcc0411..fa49409 100644 --- a/src/Verismith/Verilog2005/Randomness.hs +++ b/src/Verismith/Verilog2005/Randomness.hs @@ -19,6 +19,7 @@ module Verismith.Verilog2005.Randomness sampleSegment, sampleEnum, sampleMaybeEnum, + sampleWeighted, sampleFrom, sampleFromString, sampleBranch, @@ -39,7 +40,6 @@ import qualified Data.ByteString as B import Data.List import Data.List.NonEmpty (NonEmpty (..), toList) import qualified Data.List.NonEmpty as NE -import qualified Data.Vector as V import Control.Monad.Primitive (PrimMonad, PrimState, RealWorld) import Data.Word import System.Random.MWC.Probability @@ -76,16 +76,16 @@ sampleCategoricalProbability t gen d = case d of let ll = NE.take (t + 1) l in case ll of [] -> error "Probability vector cannot be empty" - [x] -> return 0 + [x] -> pure 0 _ -> sample (categorical ll) gen CPBiasedUniform l b -> let ll = clean t l uw = fromIntegral (t + 1 - length ll) * b in nonEmpty - (return Nothing) + (pure Nothing) (flip sample gen . discrete . ((uw, Nothing) :) . map (\(x, y) -> (x, Just y)) . toList) ll - >>= maybe (avoid (map snd ll) <$> sample (uniformR (0, t - length ll)) gen) return + >>= maybe (avoid (map snd ll) <$> sample (uniformR (0, t - length ll)) gen) pure sampleNumberProbability :: PrimMonad m => Gen (PrimState m) -> NumberProbability -> m Int sampleNumberProbability gen d = case d of @@ -97,7 +97,7 @@ sampleNumberProbability gen d = case d of NPLinearComb l -> sample (discrete l) gen >>= sampleNumberProbability gen sampleIn :: (Functor m, PrimMonad m) => [a] -> Gen (PrimState m) -> CategoricalProbability -> m a -sampleIn l gen d = (V.fromList l V.!) <$> sampleCategoricalProbability (length l - 1) gen d +sampleIn l gen d = (l !!) <$> sampleCategoricalProbability (length l - 1) gen d sampleInString :: (Functor m, PrimMonad m) => @@ -139,6 +139,12 @@ sampleMaybeEnum p = mib = fromEnum (minBound :: a) mab = fromEnum (maxBound :: a) +sampleWeighted :: [(Double, a)] -> GenM p a +sampleWeighted l = case l of + [] -> error "Probability vector cannot be empty" + [(_, x)] -> pure x + _ -> asks snd >>= sample (discrete l) + sampleFrom :: (p -> CategoricalProbability) -> [a] -> GenM p a sampleFrom p l = sampleWrapper p $ sampleIn l @@ -198,6 +204,6 @@ sampleFiltered p t l = do ( avoid (merge ll $ map snd ll') <$> sample (uniformR (0, t - length ll - length ll')) gen ) - return + pure where ll = sort $ filter (<= t) l