Fixed escaped identifier and compiler directives support, also final …

…generation fix

Identifiers don't store the initial '\' anymore.
Compiler directive identifier part can be escaped identifier.
Also the number recursive attenuation is now a real thing
And insanely big lvalues are no longer generated thanks to recursive attenuation

src/Verismith/Verilog2005/AST.hs

@@ -146,11 +146,12 @@ import Control.Lens
 import Data.Functor.Compose
 import Data.Functor.Classes
 import Data.ByteString (ByteString)
-import Data.ByteString.Internal (packChars)
+import Data.ByteString.Internal (c2w, packChars)
 import Data.Data
 import Data.Data.Lens
 import Data.String (IsString (..))
 import Text.Show (showListWith)
+import Text.Printf (printf)
 import qualified Data.HashMap.Strict as HashMap
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Vector.Unboxed as V
@@ -177,7 +178,9 @@ newtype Identifier = Identifier ByteString
   deriving (Show, Eq, Data, Generic)
 
 instance IsString Identifier where
-  fromString = Identifier . packChars
+  fromString =
+    Identifier . packChars . concatMap
+      (\c -> if ' ' < c && c <= '~' then [c] else printf "\\%02x" c)
 
 -- | Quickly add an identifier to all members of a sum type, other uses are discouraged
 data Identified t = Identified {_identIdent :: !Identifier, _identData :: !t}

src/Verismith/Verilog2005/Generator.hs

@@ -92,12 +92,27 @@ applyAttenuation n x = x & gaoCurrent *~ _gaoDecrease x ** fromIntegral n
 tameExprRecursion :: Int -> GenM' a -> GenM' a
 tameExprRecursion n = local (_1 . goExpr . geoAttenuation %~ applyAttenuation n)
 
+repeatExprRecursive :: (GarbageOpts -> NumberProbability) -> GenM' a -> GenM' [a]
+repeatExprRecursive p m = do
+  n <- sampleAttenuatedNum (_geoAttenuation . _goExpr) p
+  tameExprRecursion n $ replicateM n m
+
 tameStmtRecursion :: Int -> GenM' a -> GenM' a
 tameStmtRecursion n = local (_1 . goStatement . gstoAttenuation %~ applyAttenuation n)
 
+repeatStmtRecursive :: (GarbageOpts -> NumberProbability) -> GenM' a -> GenM' [a]
+repeatStmtRecursive p m = do
+  n <- sampleAttenuatedNum (_gstoAttenuation . _goStatement) p
+  tameStmtRecursion n $ replicateM n m
+
 tameModGenRecursion :: Int -> GenM' a -> GenM' a
 tameModGenRecursion n = local (_1 . goGenerate . ggoAttenuation %~ applyAttenuation n)
 
+repeatModGenRecursive :: (GarbageOpts -> NumberProbability) -> GenM' a -> GenM' [a]
+repeatModGenRecursive p m = do
+  n <- sampleAttenuatedNum (_ggoAttenuation . _goGenerate) p
+  tameModGenRecursion n $ replicateM n m
+
 -- | Branching with attenuation
 sampleAttenuatedBranch ::
   (GarbageOpts -> GarbageAttenuationOpts)
@@ -110,6 +125,15 @@ sampleAttenuatedBranch f p l = do
   a <- asks $ _gaoCurrent . f . fst
   join $ sampleIn (toList $ NE.map snd l) gen (attenuateCat l a d)
 
+-- | Number with attenuation
+sampleAttenuatedNum ::
+  (GarbageOpts -> GarbageAttenuationOpts) -> (GarbageOpts -> NumberProbability) -> GenM' Int
+sampleAttenuatedNum f p = do
+  gen <- asks snd
+  d <- asks $ p . fst
+  a <- asks $ _gaoCurrent . f . fst
+  sampleNumberProbability gen $ attenuateNum a d
+
 -- | Letters available for simple identifiers
 idSimpleLetter :: B.ByteString -- 0-9$ are forbidden as first letters
 idSimpleLetter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_0123456789$"
@@ -135,8 +159,7 @@ garbageSimpleBS =
 
 garbageEscapedBS :: GenM' B.ByteString
 garbageEscapedBS =
-  fmap (B.pack . (c2w '\\' :)) $
-    sampleN (i _gioEscapedLetters) (toEnum <$> sampleSegment (i _gioEscapedLetter) 33 126)
+  B.pack <$> sampleN (i _gioEscapedLetters) (toEnum <$> sampleSegment (i _gioEscapedLetter) 33 126)
   where i x = x . _goIdentifier
 
 garbageBS :: GenM' B.ByteString
@@ -156,9 +179,8 @@ garbageSysIdent =
 
 garbageHierIdent :: GenM' HierIdent
 garbageHierIdent = do
-  n <- sampleNum _goPathDepth
-  hip <- tameExprRecursion n $
-      replicateM n $ mkpair garbageIdent $ sampleMaybe (_geoDimRange . _goExpr) garbageCExpr
+  hip <- repeatExprRecursive _goPathDepth $
+    mkpair garbageIdent $ sampleMaybe (_geoDimRange . _goExpr) garbageCExpr
   HierIdent hip <$> garbageIdent
 
 garbageInteger :: GenM' Natural
@@ -213,12 +235,12 @@ garbagePrim ident attrng grng gattr =
       (attrng, PrimIdent <$> ident <*> grng),
       ( True,
         do
-          n <- succ <$> sampleNum (e _geoConcatenations)
+          n <- succ <$> sNum (e _geoConcatenations)
           PrimConcat . NE.fromList <$> tameExprRecursion n (replicateM n gexpr)
       ),
       ( True,
         do
-          n <- succ <$> sampleNum (e _geoConcatenations)
+          n <- succ <$> sNum (e _geoConcatenations)
           tameExprRecursion (n + 1) $
             PrimMultConcat <$> garbageGenExpr
                 garbageIdent
@@ -229,18 +251,15 @@ garbagePrim ident attrng grng gattr =
       ),
       ( True,
         do
-          n <- succ <$> sampleNum (_ggoTaskFunPorts . _goGenerate)
+          n <- succ <$> sNum (_ggoTaskFunPorts . _goGenerate)
           tameExprRecursion n $ PrimFun <$> ident <*> gattr <*> replicateM n gexpr
       ),
-      ( True,
-        do
-          n <- sampleNum $ e _geoSysFunArgs
-          tameExprRecursion n $ PrimSysFun <$> garbageSysIdent <*> replicateM n gexpr
-      ),
+      (True, PrimSysFun <$> garbageSysIdent <*> repeatExprRecursive (e _geoSysFunArgs) gexpr),
       (True, PrimMinTypMax <$> garbageGenMinTypMax gexpr)
     ]
   where
     e x = x . _goExpr
+    sNum = sampleAttenuatedNum (e _geoAttenuation)
     mknum x =
       ( False,
         do
@@ -279,13 +298,13 @@ garbageRange2 :: GenM' Range2
 garbageRange2 = tameExprRecursion 2 $ Range2 <$> garbageCExpr <*> garbageCExpr
 
 garbageDims :: GenM' [Range2]
-garbageDims = sampleN (_gtoDimensions . _goType) garbageRange2
+garbageDims = repeatExprRecursive (_gtoDimensions . _goType) garbageRange2
 
 garbageGenRangeExpr :: GenM' e -> GenM' (GenRangeExpr e)
 garbageGenRangeExpr ge =
   sampleBranch
     (e _geoRange)
-    [ GRESingle <$> tameExprRecursion 1 ge,
+    [ GRESingle <$> ge,
       GREPair <$> garbageRange2,
       tameExprRecursion 2 $
         GREBaseOff <$> ge <*> sampleBernoulli (e _geoRangeOffsetPos_Neg) <*> garbageCExpr
@@ -294,8 +313,8 @@ garbageGenRangeExpr ge =
 
 garbageGenDimRange :: GenM' e -> GenM' (GenDimRange e)
 garbageGenDimRange ge = do
-  n <- sampleNum $ _gtoDimensions . _goType
-  tameExprRecursion n $ GenDimRange <$> replicateM n ge <*> garbageGenRangeExpr ge
+  n <- sampleAttenuatedNum (_geoAttenuation . _goExpr) (_gtoDimensions . _goType)
+  tameExprRecursion (n + 1) $ GenDimRange <$> replicateM n ge <*> garbageGenRangeExpr ge
 
 garbageExpr :: GenM' Expr
 garbageExpr =
@@ -340,7 +359,8 @@ garbageBareCMTM =
 
 garbageAttributes :: GenM' [Attribute]
 garbageAttributes =
-  sampleN _goAttributes $ Attribute <$> garbageBS <*> sampleMaybe _goAttributeOptionalValue gattr
+  repeatExprRecursive _goAttributes $
+    Attribute <$> garbageBS <*> sampleMaybe _goAttributeOptionalValue gattr
   where
     gattr =
       garbageGenExpr
@@ -383,8 +403,9 @@ garbageDelay3 =
     ]
 
 garbageLValue :: GenM' dr -> GenM' (LValue dr)
-garbageLValue gdr =
-  sampleN _goLValues (garbageLValue gdr) >>= \l -> case l of
+garbageLValue gdr = do
+  l <- repeatExprRecursive _goLValues $ garbageLValue gdr
+  case l of
     [] -> LVSingle <$> garbageHierIdent <*> sampleMaybe _goOptionalLValue gdr
     h : t -> return $ LVConcat $ h :| t
 
@@ -450,7 +471,7 @@ garbageFunctionStatement =
         do
           x <- sampleEnum $ s _gstoCase
           e <- garbageExpr 
-          pn <- sampleNum $ s _gstoCaseBranches
+          pn <- sampleAttenuatedNum (s _gstoAttenuation) (s _gstoCaseBranches)
           d <- tameStmtRecursion pn gmybfstmt
           let n = if d == Attributed [] Nothing then pn + 1 else pn
           c <-
@@ -463,11 +484,9 @@ garbageFunctionStatement =
       (False, FSDisable <$> garbageHierIdent),
       (True, FSLoop <$> garbageLoopStatement <*> tameStmtRecursion 1 gattrfstmt),
       ( True,
-        do
-          n <- sampleNum $ s _gstoItems
-          FSBlock <$> garbageStmtBlockHeader
-            <*> sampleBernoulli (s _gstoBlockPar_Seq)
-            <*> tameStmtRecursion n (replicateM n gattrfstmt)
+        FSBlock <$> garbageStmtBlockHeader
+          <*> sampleBernoulli (s _gstoBlockPar_Seq)
+          <*> repeatStmtRecursive (s _gstoItems) gattrfstmt
       )
     ]
   where
@@ -489,7 +508,7 @@ garbageStatement =
         do
           x <- sampleEnum $ s _gstoCase
           e <- garbageExpr 
-          pn <- sampleNum $ s _gstoCaseBranches
+          pn <- sampleAttenuatedNum (s _gstoAttenuation) (s _gstoCaseBranches)
           d <- tameStmtRecursion pn garbageMybStmt
           let n = if d == Attributed [] Nothing then pn + 1 else pn
           c <-
@@ -502,11 +521,9 @@ garbageStatement =
       (False, SDisable <$> garbageHierIdent),
       (True, SLoop <$> garbageLoopStatement <*> tameStmtRecursion 1 garbageAttrStmt),
       ( True,
-        do
-          n <- sampleNum $ s _gstoItems
-          SBlock <$> garbageStmtBlockHeader
-            <*> sampleBernoulli (s _gstoBlockPar_Seq)
-            <*> tameStmtRecursion n (replicateM n $ garbageAttrStmt)
+        SBlock <$> garbageStmtBlockHeader
+          <*> sampleBernoulli (s _gstoBlockPar_Seq)
+          <*> repeatStmtRecursive (s _gstoItems) garbageAttrStmt
       ),
       ( False,
         SEventTrigger <$> garbageHierIdent <*> sampleN (_gtoDimensions . _goType) garbageExpr
@@ -658,7 +675,7 @@ garbageGenIf =
 garbageGenCase :: GenM' ModGenCondItem
 garbageGenCase = do
   e <- garbageCExpr
-  pn <- sampleNum $ g _ggoCaseBranches
+  pn <- sampleAttenuatedNum (g _ggoAttenuation) (g _ggoCaseBranches)
   d <- tameModGenRecursion pn garbageGenCondBlock
   let n = if d == GCBEmpty then pn + 1 else pn
   c <-
@@ -765,9 +782,8 @@ garbageModGenBlockedItem :: GenM' (Attributed ModGenBlockedItem)
 garbageModGenBlockedItem = garbageAttributed $ garbageModGenItem $ fmap Identity
 
 garbageGenerateBlock :: GenM' GenerateBlock
-garbageGenerateBlock = do
-  n <- sampleNum $ _ggoItems . _goGenerate
-  tameModGenRecursion n $ garbageIdentified $ replicateM n garbageModGenBlockedItem
+garbageGenerateBlock =
+  garbageIdentified $ repeatModGenRecursive (_ggoItems . _goGenerate) $ garbageModGenBlockedItem
 
 garbageGenCondBlock :: GenM' GenerateCondBlock
 garbageGenCondBlock =

src/Verismith/Verilog2005/Lexer.x

@@ -52,10 +52,10 @@ $all = [\0-\255]
 -- | Identifiers
 $identifierFirstChar = [a-z A-Z _]
 $identifierChar      = [a-z A-Z 0-9 _ \$]
-@escapedIdentifier   = \\ [$all # $white]*
+@escapedIdentifier   = \\ [\!-\~]*
 @simpleIdentifier    = $identifierFirstChar $identifierChar*
 @systemIdentifier    = \$ $identifierChar+
-@compilerDirective   = ` $identifierChar+
+@compilerDirective   = ` ( @simpleIdentifier | @escapedIdentifier )
 
 -- | Table symbols, and edges
 $tableout  = [01 xX]
@@ -100,7 +100,7 @@ tokens :-
     @real   { to LitReal   }
     @string { to (LitString . SBS.tail . SBS.init) }
     @simpleIdentifier  { toa kwident }
-    @escapedIdentifier { to escSimpleIdent }
+    @escapedIdentifier { to (escSimpleIdent . SBS.tail) }
     @systemIdentifier  { to (IdSystem . SBS.tail) }
     \'[sS]?[bB] { toa (numberBase BBin) }
     \'[sS]?[oO] { toa (numberBase BOct) }
@@ -253,8 +253,8 @@ scan = get >>= \(AlexState sc inp kw d si) -> case alexScan inp sc of
     throwError $
       printf
         "lexical error between %s and %s"
-        (show p)
-        (helperShowPositions $ _aiPosition inp :| map fst si)
+        (show $ _aiPosition inp)
+        (helperShowPositions $ p :| map fst si)
   AlexSkip inp' _ -> modify' (\s -> s { _asInput = inp' }) >> scan
   AlexToken inp' n action -> do
     modify' $ \s -> s { _asInput = inp' }
@@ -418,18 +418,16 @@ kwident s = case SBS.stripPrefix "PATHPULSE$" s of
 
 isIdentSimple :: SBS.ByteString -> Bool
 isIdentSimple s = case SBS.uncons s of
-  Just (c, t)
-    | testfirst c
+  Just (c, t) ->
+    testfirst c
       && not (isKW s)
       && SBS.all (\c -> testfirst c || (c2w '0' <= c && c <= c2w '9') || c == c2w '$') t
-    -> True
   _ -> False
   where
     testfirst c = (c2w 'A' <= c && c <= c2w 'Z') || (c2w 'a' <= c && c <= c2w 'z') || c == c2w '_'
 
 escSimpleIdent :: SBS.ByteString -> Token
-escSimpleIdent s = if isIdentSimple ss then IdSimple ss else IdEscaped s
-  where ss = SBS.tail s
+escSimpleIdent s = if isIdentSimple s then IdSimple s else IdEscaped s
 
 makeString :: String -> SBS.ByteString
 makeString s = packChars $ concatMap esc s

src/Verismith/Verilog2005/Parser.hs

@@ -12,7 +12,7 @@ module Verismith.Verilog2005.Parser
   )
 where
 
-import Control.Applicative (liftA2, liftA3)
+import Control.Applicative (liftA2)
 import Control.Lens hiding ((<|))
 import Data.Functor.Compose
 import Control.Monad (join)
@@ -695,21 +695,21 @@ driveStrength = option dsDefault $ try $ parens comDriveStrength
 pathpulse :: Parser SpecParamDecl
 pathpulse = do
   imid <- fproduce $ \t -> case t of TknPP s -> Just s; _ -> Nothing
-  iid <- if B.null imid then option "" parseBS else return imid
-  c0 <- if B.null iid
-    then return $ Left Nothing
-    else do
+  miid <- if B.null imid then optionMaybe parseBS else return $ Just imid
+  c0 <- case miid of
+    Nothing -> return $ Left Nothing
+    Just iid -> do
       irng <- pMRE
       let ist = SpecTerm (Identifier iid) irng
-      option (Right irng) $ Left . Just . (,) ist <$> fbranch
+      option (Right (iid, irng)) $ Left . Just . (,) ist <$> fbranch
         ( \t -> case t of
             SymDollar -> Just $ specTerm
             IdSystem s -> Just $ SpecTerm (Identifier s) <$> pMRE
             _ -> Nothing
         )
   c1 <- case c0 of
     Left x -> return $ Left x
-    Right irng -> case reverse $ B.split (c2w '$') iid of
+    Right (iid, irng) -> case reverse $ B.split (c2w '$') iid of
       [_] -> failure
       h : t | B.null h && irng == Nothing ->
         Left . Just . (,) (SpecTerm (Identifier $ restore_id t) Nothing) <$> specTerm