Oops, attributes were wrong

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,26 +412,28 @@ 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
   | NIReal !ByteString
   | 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),

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

src/Verismith/Verilog2005/Parser.hs

@@ -59,15 +59,15 @@ 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]
 
 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

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

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