From c7cb2d0971ce0485e370a8ae5deaab587e39e4d2 Mon Sep 17 00:00:00 2001 From: qcorradi Date: Mon, 29 Apr 2024 17:52:11 +0100 Subject: [PATCH] Removed recursive attributes as it's not standard compliant --- src/Verismith/Config.hs | 4 - src/Verismith/Verilog2005/AST.hs | 63 ++++++++------- src/Verismith/Verilog2005/Generator.hs | 65 +++++++++------- src/Verismith/Verilog2005/Parser.hs | 91 ++++++++++------------ src/Verismith/Verilog2005/PrettyPrinter.hs | 43 +++++----- src/Verismith/Verilog2005/Utils.hs | 47 +++++------ 6 files changed, 153 insertions(+), 160 deletions(-) diff --git a/src/Verismith/Config.hs b/src/Verismith/Config.hs index dc80d45..330c8f9 100644 --- a/src/Verismith/Config.hs +++ b/src/Verismith/Config.hs @@ -114,7 +114,6 @@ module Verismith.Config gaoCurrent, goExpr, goStatement, - goAttributeAttenuation, geoAttenuation, gstoAttenuation, parseConfigFile, @@ -353,7 +352,6 @@ uniformCP = CPBiasedUniform [] 1 data GarbageOpts = GarbageOpts { _goSeed :: !(Maybe (VU.Vector Word32)), - _goAttributeAttenuation :: !GarbageAttenuationOpts, _goConfig :: !GarbageConfigOpts, _goPrimitive :: !GarbagePrimitiveOpts, _goModule :: !GarbageModuleOpts, @@ -573,7 +571,6 @@ defGarbageOpts :: GarbageOpts defGarbageOpts = GarbageOpts { _goSeed = Nothing, - _goAttributeAttenuation = defAttenuationOpts, _goConfig = GarbageConfigOpts { _gcoBlocks = NPPoisson 0 1, _gcoDesigns = NPPoisson 0 1, @@ -1345,7 +1342,6 @@ garbageCodec :: TomlCodec GarbageOpts garbageCodec = GarbageOpts <$> Toml.dioptional (Toml.read "seed") .= _goSeed - <*> garbageAttenuationCodec "attribute.attenuation" .= _goAttributeAttenuation <*> tfield _goConfig "config" garbageConfigCodec <*> tfield _goPrimitive "primitive" garbagePrimitiveCodec <*> tfield _goModule "module" garbageModuleCodec diff --git a/src/Verismith/Verilog2005/AST.hs b/src/Verismith/Verilog2005/AST.hs index e6d39a4..af675b7 100644 --- a/src/Verismith/Verilog2005/AST.hs +++ b/src/Verismith/Verilog2005/AST.hs @@ -10,13 +10,13 @@ {-# LANGUAGE TemplateHaskell #-} -- TODO: --- ModGenSingleItem is useless? as they are implicitely in a block except `else if` +-- ModGenSingleItem is useless? as they are implicitely in a block except nested conditionals -- so one solution is GenerateBlock are (Identifier, [ModGenBlockedItem]) --- and MGIIf have a list of `if` branches --- dangling stuff is not well handled as inserting a block changes the hierarchy of `else if`s --- the correct solution is to add `else ;` --- This should simplify prettyprinting and complexify parsing... --- Also track the number of generate blocks when parsing and give the block a name when it's missing +-- and conditional use a ConditionalConstruct which is a GenerateBlock, an MGIIf or an MGICase +-- Dangling stuff is not well handled as inserting a block changes the hierarchy of `else if`s +-- the correct solution is to add `else ;`, hopefully not that complicated with previous change +-- Two previous changes should simplify prettyprinting and complexify parsing... +-- Also number the generate blocks when parsing a generate block or module and give the block a name when it's missing -- Also do more grouping in pretty-printing and add flags to not group! -- Maybe eliminate generate blocks that have default name but that requires counting -- so fold or mapM with StateT @@ -297,7 +297,7 @@ data Number deriving (Show, Eq, Data, Generic) -- | Parametric primary expression -data GenPrim i r +data GenPrim i r a = PrimNumber { _pnSize :: !(Maybe Natural), _pnSigned :: !Bool, @@ -308,21 +308,21 @@ data GenPrim i r { _piIdent :: !i, _piSub :: !r } - | PrimConcat !(NonEmpty (GenExpr i r)) + | PrimConcat !(NonEmpty (GenExpr i r a)) | PrimMultConcat - { _pmcMul :: !CExpr, - _pmcExpr :: !(NonEmpty (GenExpr i r)) + { _pmcMul :: !(GenExpr Identifier (Maybe CRangeExpr) a), + _pmcExpr :: !(NonEmpty (GenExpr i r a)) } | PrimFun { _pfIdent :: !i, - _pfAttr :: ![Attribute], - _pfArg :: ![GenExpr i r] + _pfAttr :: !a, + _pfArg :: ![GenExpr i r a] } | PrimSysFun { _psfIdent :: !ByteString, - _psfArg :: ![GenExpr i r] + _psfArg :: ![GenExpr i r a] } - | PrimMinTypMax !(GenMinTypMax (GenExpr i r)) + | PrimMinTypMax !(GenMinTypMax (GenExpr i r a)) | PrimString !ByteString deriving (Show, Eq, Data, Generic) @@ -339,38 +339,41 @@ type DimRange = GenDimRange Expr type CDimRange = GenDimRange CExpr -- | Parametric expression -data GenExpr i r - = ExprPrim !(GenPrim i r) +data GenExpr i r a + = ExprPrim !(GenPrim i r a) | ExprUnOp { _euOp :: !UnaryOperator, - _euAttr :: ![Attribute], - _euPrim :: !(GenPrim i r) + _euAttr :: !a, + _euPrim :: !(GenPrim i r a) } | ExprBinOp - { _ebLhs :: !(GenExpr i r), + { _ebLhs :: !(GenExpr i r a), _ebOp :: !BinaryOperator, - _ebAttr :: ![Attribute], - _ebRhs :: !(GenExpr i r) + _ebAttr :: !a, + _ebRhs :: !(GenExpr i r a) } | ExprCond - { _ecCond :: !(GenExpr i r), - _ecAttr :: ![Attribute], - _ecTrue :: !(GenExpr i r), - _ecFalse :: !(GenExpr i r) + { _ecCond :: !(GenExpr i r a), + _ecAttr :: !a, + _ecTrue :: !(GenExpr i r a), + _ecFalse :: !(GenExpr i r a) } deriving (Show, Eq, Data, Generic) -instance (Data i, Data r) => Plated (GenExpr i r) where +instance (Data i, Data r, Data a) => Plated (GenExpr i r a) where plate = uniplate -newtype CExpr = CExpr (GenExpr Identifier (Maybe CRangeExpr)) +newtype CExpr = CExpr (GenExpr Identifier (Maybe CRangeExpr) [Attribute]) deriving (Show, Eq, Data, Generic) -newtype Expr = Expr (GenExpr HierIdent (Maybe DimRange)) +newtype Expr = Expr (GenExpr HierIdent (Maybe DimRange) [Attribute]) deriving (Show, Eq, Data, Generic) -- | Attributes which can be set to various nodes in the AST. -data Attribute = Attribute {_attrIdent :: !ByteString, _attrValue :: !(Maybe CExpr)} +data Attribute = Attribute + { _attrIdent :: !ByteString, + _attrValue :: !(Maybe (GenExpr Identifier (Maybe CRangeExpr) ())) + } deriving (Show, Eq, Data, Generic) data Attributed t = Attributed {_attrAttr :: ![Attribute], _attrData :: !t} @@ -834,7 +837,7 @@ data STCAddArgs = STCAddArgs -- | Module path condition data ModulePathCondition - = MPCCond !(GenExpr Identifier ()) + = MPCCond !(GenExpr Identifier () [Attribute]) | MPCNone | MPCAlways deriving (Show, Eq, Data, Generic) diff --git a/src/Verismith/Verilog2005/Generator.hs b/src/Verismith/Verilog2005/Generator.hs index 4ff4fbe..a414ca7 100644 --- a/src/Verismith/Verilog2005/Generator.hs +++ b/src/Verismith/Verilog2005/Generator.hs @@ -93,9 +93,6 @@ applyAttenuation x = x & gaoCurrent *~ _gaoDecrease x tameExprRecursion :: GenM' a -> GenM' a tameExprRecursion = local $ _1 . goExpr . geoAttenuation %~ applyAttenuation -tameAttrRecursion :: GenM' a -> GenM' a -tameAttrRecursion = local $ _1 . goAttributeAttenuation %~ applyAttenuation - tameStmtRecursion :: GenM' a -> GenM' a tameStmtRecursion = local $ _1 . goStatement . gstoAttenuation %~ applyAttenuation @@ -191,8 +188,8 @@ garbageNumIdent = NIIdent <$> garbageIdent ] -garbagePrim :: GenM' i -> GenM' r -> GenM' (GenPrim i r) -garbagePrim ident grng = +garbagePrim :: GenM' i -> GenM' r -> GenM' a -> GenM' (GenPrim i r a) +garbagePrim ident grng gattr = sampleAttenuatedBranch (e _geoAttenuation) (e _geoPrimary) @@ -215,9 +212,14 @@ garbagePrim ident grng = ), (0, PrimIdent <$> ident <*> tameExprRecursion grng), recurse $ PrimConcat <$> sampleNE (e _geoConcatenations) gexpr, - recurse $ PrimMultConcat <$> garbageCExpr <*> sampleNE (e _geoConcatenations) gexpr, + recurse $ PrimMultConcat + <$> garbageGenExpr + garbageIdent + (sampleMaybe (_geoDimRange . _goExpr) garbageCRangeExpr) + gattr + <*> sampleNE (e _geoConcatenations) gexpr, recurse $ PrimFun <$> ident - <*> garbageAttributes + <*> gattr <*> (toList <$> sampleNE (_ggoTaskFunPorts . _goGenerate) gexpr), recurse $ PrimSysFun <$> garbageSysIdent <*> sampleN (e _geoSysFunArgs) gexpr, recurse $ PrimMinTypMax <$> garbageGenMinTypMax gexpr @@ -232,28 +234,25 @@ garbagePrim ident grng = <$> sampleBernoulli (e _geoLiteralSigned) <*> x ) - gexpr = garbageGenExpr ident grng + gexpr = garbageGenExpr ident grng gattr recurse x = (1, tameExprRecursion x) -garbageGenExpr :: GenM' i -> GenM' r -> GenM' (GenExpr i r) -garbageGenExpr ident grng = +garbageGenExpr :: GenM' i -> GenM' r -> GenM' a -> GenM' (GenExpr i r a) +garbageGenExpr ident grng gattr = sampleAttenuatedBranch (e _geoAttenuation) (e _geoItem) - [ (0, ExprPrim <$> garbagePrim ident grng), + [ (0, ExprPrim <$> garbagePrim ident grng gattr), ( 0.5, tameExprRecursion $ - ExprUnOp <$> sampleEnum (e _geoUnary) <*> garbageAttributes <*> garbagePrim ident grng - ), - ( 1, - tameExprRecursion $ - ExprBinOp <$> gexpr <*> sampleEnum (e _geoBinary) <*> garbageAttributes <*> gexpr + ExprUnOp <$> sampleEnum (e _geoUnary) <*> gattr <*> garbagePrim ident grng gattr ), - (2, tameExprRecursion $ ExprCond <$> gexpr <*> garbageAttributes <*> gexpr <*> gexpr) + (1, tameExprRecursion $ ExprBinOp <$> gexpr <*> sampleEnum (e _geoBinary) <*> gattr <*> gexpr), + (2, tameExprRecursion $ ExprCond <$> gexpr <*> gattr <*> gexpr <*> gexpr) ] where e x = x . _goExpr - gexpr = garbageGenExpr ident grng + gexpr = garbageGenExpr ident grng gattr garbageGenMinTypMax :: GenM' e -> GenM' (GenMinTypMax e) garbageGenMinTypMax gexpr = @@ -282,12 +281,16 @@ garbageGenDimRange ge = garbageExpr :: GenM' Expr garbageExpr = Expr <$> garbageGenExpr - (tameExprRecursion garbageHierIdent) - (sampleMaybe (_geoDimRange . _goExpr) garbageDimRange) + (tameExprRecursion garbageHierIdent) + (sampleMaybe (_geoDimRange . _goExpr) garbageDimRange) + garbageAttributes garbageCExpr :: GenM' CExpr garbageCExpr = - CExpr <$> garbageGenExpr garbageIdent (sampleMaybe (_geoDimRange . _goExpr) garbageCRangeExpr) + CExpr <$> garbageGenExpr + garbageIdent + (sampleMaybe (_geoDimRange . _goExpr) garbageCRangeExpr) + garbageAttributes garbageRangeExpr :: GenM' RangeExpr garbageRangeExpr = garbageGenRangeExpr garbageExpr @@ -308,13 +311,14 @@ garbageCMinTypMax :: GenM' CMinTypMax garbageCMinTypMax = garbageGenMinTypMax garbageCExpr garbageAttributes :: GenM' [Attribute] -garbageAttributes = do - gen <- asks snd - attrn <- asks $ _goAttributes . fst - att <- asks $ _gaoCurrent . _goAttributeAttenuation . fst - n <- sampleNumberProbability gen $ attenuateNum att attrn - sequence $ replicate n $ Attribute <$> garbageBS - <*> sampleMaybe _goAttributeOptionalValue (tameAttrRecursion garbageCExpr) +garbageAttributes = + sampleN _goAttributes $ Attribute <$> garbageBS <*> sampleMaybe _goAttributeOptionalValue gattr + where + gattr = + garbageGenExpr + garbageIdent + (sampleMaybe (_geoDimRange . _goExpr) garbageCRangeExpr) + (pure ()) garbageAttributed :: GenM' x -> GenM' (Attributed x) garbageAttributed = liftA2 Attributed garbageAttributes @@ -726,7 +730,10 @@ garbageSpecifyItem = do cond <- sampleBranch (p _gspoCondition) - [pure MPCNone, pure MPCAlways, MPCCond <$> garbageGenExpr garbageIdent (pure ())] + [ pure MPCNone, + pure MPCAlways, + MPCCond <$> garbageGenExpr garbageIdent (pure ()) garbageAttributes + ] conn <- choice (p _gspoFull_Parallel) ( SPFull <$> sampleNE (p _gspoFullSources) garbageSpecTerm diff --git a/src/Verismith/Verilog2005/Parser.hs b/src/Verismith/Verilog2005/Parser.hs index 55a7bd2..ca1126d 100644 --- a/src/Verismith/Verilog2005/Parser.hs +++ b/src/Verismith/Verilog2005/Parser.hs @@ -316,15 +316,16 @@ dot1Ident = do s <- optionMaybe $ consume SymDot *> ident return $ case s of Nothing -> Dot1Ident Nothing $ Identifier f; Just s -> Dot1Ident (Just f) s --- | Attribute list -attribute :: Parser [Attribute] -attribute = - enclosed SymParenAster SymAsterParen $ - NE.toList <$> csl1 (Attribute <$> parseBS <*> optionMaybe (consume SymEq *> constExpr)) +attribute :: Parser Attribute +attribute = do + attr <- parseBS + value <- optionMaybe $ consume SymEq + *> genExpr (pure . Identifier) (optionMaybe constRangeExpr) (pure ()) Just constifyMaybeRange + return $ Attribute attr value -- | Flattened list of attributes attributes :: Parser [Attribute] -attributes = concat <$> many attribute +attributes = concat <$> many (enclosed SymParenAster SymAsterParen $ NE.toList <$> csl1 attribute) -- | Number after base number :: Base -> Parser Number @@ -337,29 +338,32 @@ number b = case b of _ -> Nothing BHex -> NHex <$> fproduce (\t -> case t of LitHex h -> Just $ NE.fromList h; _ -> Nothing) -type PGenExpr g i r = - (B.ByteString -> Parser i) -> Parser r -> (Expr -> Maybe (GenExpr i r)) -> Parser (g i r) +type PGenExpr g i r a = + (B.ByteString -> Parser i) -> + Parser r -> + Parser a -> + (i -> Maybe Identifier) -> + (Maybe DimRange -> Maybe r) -> + Parser (g i r a) -- | Parametric primary expression -genPrim :: PGenExpr GenPrim i r -genPrim pi pr constf = fpbranch $ \p t -> case t of +genPrim :: PGenExpr GenPrim i r a +genPrim pi pr pa ci cr = fpbranch $ \p t -> case t of -- try parse braceL and let that decide the path, otherwise it is wrong for constExpr SymBraceL -> Just $ do - e <- expr + e <- genExpr pi dimRange pa ci Just p2 <- getPosition b <- optConsume SymBraceL ee <- if b - then case constifyExpr e of + then case trConstifyGenExpr ci constifyMaybeRange e of Nothing -> hardfail "Replication takes a constant expression as multiplicity" - Just e -> - PrimMultConcat e <$> csl1 (genExpr pi pr constf) <* closeConsume p2 SymBraceL SymBraceR - else case constf e of + Just e -> PrimMultConcat e <$> csl1 parseExpr <* closeConsume p2 SymBraceL SymBraceR + else case trConstifyGenExpr Just cr e of Nothing -> hardfail "Invalid kind of expression" - Just e -> PrimConcat . (e :|) <$> option [] (consume SymComma *> csl (genExpr pi pr constf)) + Just e -> PrimConcat . (e :|) <$> option [] (consume SymComma *> csl parseExpr) closeConsume p SymBraceL SymBraceR return ee - SymParenL -> - Just $ PrimMinTypMax <$> mtm (genExpr pi pr constf) <* closeConsume p SymParenL SymParenR + SymParenL -> Just $ PrimMinTypMax <$> mtm parseExpr <* closeConsume p SymParenL SymParenR LitDecimal i -> Just $ option (PrimNumber Nothing True $ NDecimal i) $ fbranch $ \t -> case t of @@ -369,20 +373,18 @@ genPrim pi pr constf = fpbranch $ \p t -> case t of NumberBase s b -> Just $ PrimNumber Nothing s <$> number b LitString s -> Just $ return $ PrimString s IdSystem s -> - Just $ - PrimSysFun s - <$> option [] (parens $ wempty "system function argument" $ csl $ genExpr pi pr constf) + Just $ PrimSysFun s <$> option [] (parens $ wempty "system function argument" $ csl parseExpr) IdSimple s -> Just $ idp s IdEscaped s -> Just $ idp s _ -> Nothing where - fp s = - PrimFun s <$> attributes <*> parens (wempty "function argument" $ csl $ genExpr pi pr constf) + parseExpr = genExpr pi pr pa ci cr + fp s = PrimFun s <$> pa <*> parens (wempty "function argument" $ csl parseExpr) idp s = pi s >>= \ss -> fp ss <|> PrimIdent ss <$> pr -- | Unary operator can only be applied on primary expressions -genBase :: PGenExpr GenExpr i r -genBase pi pr constf = do +genBase :: PGenExpr GenExpr i r a +genBase pi pr pa ci cr = do op <- optionMaybe $ mkpair ( fproduce $ \t -> case t of @@ -398,13 +400,13 @@ genBase pi pr constf = do SymDash -> Just UnMinus _ -> Nothing ) - attributes - p <- genPrim pi pr constf + pa + p <- genPrim pi pr pa ci cr return $ maybe (ExprPrim p) (flip (uncurry ExprUnOp) p) op -- | Facility for expression parsing -genExprBuildParser :: PGenExpr GenExpr i r -genExprBuildParser pi pr constf = +genExprBuildParser :: PGenExpr GenExpr i r a +genExprBuildParser pi pr pa ci cr = buildExpressionParser [ infixop $ \t -> case t of BinAsterAster -> Just BinPower; _ -> Nothing, infixop $ \t -> case t of @@ -437,28 +439,21 @@ genExprBuildParser pi pr constf = infixop $ \t -> case t of BinAmpAmp -> Just BinLAnd; _ -> Nothing, infixop $ \t -> case t of BinBarBar -> Just BinLOr; _ -> Nothing ] - (genBase pi pr constf) + (genBase pi pr pa ci cr) where - infixop :: - (Token -> Maybe BinaryOperator) -> - [Operator [PosToken] LocalCompDir (Writer [String]) (GenExpr i r)] - infixop fp = [Infix ((\op a l -> ExprBinOp l op a) <$> fproduce fp <*> attributes) AssocLeft] + infixop fp = [Infix ((\op a l -> ExprBinOp l op a) <$> fproduce fp <*> pa) AssocLeft] -- | Parametric expression -genExpr :: PGenExpr GenExpr i r -genExpr pi pr constf = do - e <- genExprBuildParser pi pr constf +genExpr :: PGenExpr GenExpr i r a +genExpr pi pr pa ci cr = do + e <- genExprBuildParser pi pr pa ci cr b <- optConsume SymQuestion if b - then - ExprCond e <$> attributes - <*> genExpr pi pr constf - <* consume SymColon - <*> genExpr pi pr constf + then ExprCond e <$> pa <*> genExpr pi pr pa ci cr <* consume SymColon <*> genExpr pi pr pa ci cr else return e expr :: Parser Expr -expr = Expr <$> genExpr (trHierIdent True) dimRange (\(Expr e) -> Just e) +expr = Expr <$> genExpr (trHierIdent True) dimRange attributes constifyIdent Just constExpr :: Parser CExpr constExpr = @@ -466,7 +461,9 @@ constExpr = <$> genExpr (pure . Identifier) (optionMaybe constRangeExpr) - (fmap (\(CExpr e) -> e) . constifyExpr) + attributes + Just + constifyMaybeRange -- | Minimum, Typical, Maximum on a base type recognised by the argument parser mtm :: Parser a -> Parser (GenMinTypMax a) @@ -1322,7 +1319,6 @@ portsimple dnt fullspec d a = do t (NetProp (_srSign sr) ((,) Nothing <$> _srRange sr) Nothing) (Identity $ NetDecl i []) - pi :: Identifier -> PortInterface pi i = Identified i [Identified i Nothing] case nt of Just nt -> return $ (\i -> ([pd i, MIMGI $ nd nt i], pi i)) <$> sl @@ -1590,8 +1586,7 @@ specifyItem = fpbranch $ \p t -> case t of KWNoshowcancelled -> Just $ psi SINoshowcancelled KWIf -> Just $ do c <- parens $ - genExpr (pure . Identifier) (pure ()) $ - \(Expr e) -> trConstifyGenExpr constifyIdent (maybe (Just ()) $ const Nothing) e + genExpr (pure . Identifier) (pure ()) attributes Just $ maybe (Just ()) $ const Nothing pathDecl $ MPCCond c KWIfnone -> Just $ pathDecl MPCNone SymParenL -> Just $ trPathDecl p MPCAlways @@ -1835,7 +1830,7 @@ compDir = fbranch $ \t -> case t of topDecl :: Parser Verilog2005 topDecl = skipMany1 compDir *> return mempty <|> do - a <- concat <$> many (attribute <* skipMany compDir) + a <- concat <$> many (attributes <* skipMany compDir) st <- getState fpbranch $ \p t -> case (a, 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 d7f2aa0..baa3a36 100644 --- a/src/Verismith/Verilog2005/PrettyPrinter.hs +++ b/src/Verismith/Verilog2005/PrettyPrinter.hs @@ -185,7 +185,8 @@ prettyItemsid h f b = group h <=> gpadj (cslid1 $ mkng f) b <> semi prettyAttr :: [Attribute] -> Doc prettyAttr = nonEmpty mempty $ \l -> group $ "(* " <> fst (cslid1 pa l) <=> "*)" where - pa (Attribute i e) = maybe (prettyBS i) (prettyEq (raw i) . prettyCExpr) e + pa (Attribute i e) = maybe (prettyBS i) (prettyEq (raw i) . pca) e + pca = prettyGExpr prettyIdent (pm prettyCRangeExpr) (const mempty) 12 prettyHierIdent :: PrettyIdent HierIdent prettyHierIdent (HierIdent p i) = first (\i -> nest $ foldr addId i p) $ prettyIdent i @@ -214,8 +215,8 @@ prettyNumIdent x = case x of NIReal r -> mkid $ raw r NINumber n -> mkid $ viaShow n -prettyPrim :: PrettyIdent i -> (r -> Doc) -> PrettyIdent (GenPrim i r) -prettyPrim ppid ppr x = case x of +prettyPrim :: PrettyIdent i -> (r -> Doc) -> (a -> Doc) -> PrettyIdent (GenPrim i r a) +prettyPrim ppid ppr ppa x = case x of PrimNumber Nothing True (NDecimal i) -> mkid $ viaShow i PrimNumber w b n -> mkid $ @@ -225,13 +226,16 @@ prettyPrim ppid ppr x = case x of PrimReal r -> mkid $ raw r PrimIdent i r -> first nest $ padjWith ppid (group $ ppr r) i PrimConcat l -> mkid $ bcslid1 pexpr l - PrimMultConcat e l -> mkid $ brc $ nest $ gpadj prettyCExpr e <> bcslid1 pexpr l - PrimFun i a l -> (if null a then padjWith else pspWith) ppid (prettyAttr a pcslid pexpr l) i + PrimMultConcat e l -> + mkid $ brc $ nest $ + gpadj (prettyGExpr prettyIdent (pm prettyCRangeExpr) ppa 12) e <> bcslid1 pexpr l + PrimFun i a l -> + let da = ppa a in (if nullDoc da then padjWith else pspWith) ppid (da pcslid pexpr l) i PrimSysFun i l -> first (\x -> nest $ "$" <> x) $ padjWith prettyBS (pcslid pexpr l) i PrimMinTypMax m -> mkid $ par $ padj (prettyGMTM pexpr) m PrimString x -> mkid $ raw x where - pexpr = prettyGExpr ppid ppr 12 + pexpr = prettyGExpr ppid ppr ppa 12 preclevel :: BinaryOperator -> Int preclevel b = case b of @@ -260,35 +264,35 @@ preclevel b = case b of BinLAnd -> 10 BinLOr -> 11 -prettyGExpr :: PrettyIdent i -> (r -> Doc) -> Int -> PrettyIdent (GenExpr i r) -prettyGExpr ppid ppr l e = case e of - ExprPrim e -> first group $ prettyPrim ppid ppr e +prettyGExpr :: PrettyIdent i -> (r -> Doc) -> (a -> Doc) -> Int -> PrettyIdent (GenExpr i r a) +prettyGExpr ppid ppr ppa l e = case e of + ExprPrim e -> first group $ prettyPrim ppid ppr ppa e ExprUnOp op a e -> - first - (\x -> ng $ viaShow op <> (if null a then mempty else space <> prettyAttr a <> newline) <> x) - $ prettyPrim ppid ppr e + let da = ppa a + (x, s) = prettyPrim ppid ppr ppa e + in (ng $ viaShow op <> (if nullDoc da then mempty else space <> da <> newline) <> x, s) ExprBinOp el op a r -> let p = preclevel op x = psexpr p el <=> viaShow op - da = prettyAttr a + da = ppa a pp = pexpr $ p - 1 in case compare l p of LT -> mkid $ ng $ par $ x <+> (da padj pp r) EQ -> first (\y -> x <+> (da y)) $ pp r GT -> first (\y -> ng $ x <+> (da y)) $ pp r ExprCond ec a et ef -> - let pc c t f = nest $ group (c <=> nest ("?" prettyAttr a)) <=> group (t <=> colon <+> f) + let pc c t f = nest $ group (c <=> nest ("?" ppa a)) <=> group (t <=> colon <+> f) pp = first (pc (psexpr 11 ec) (psexpr 12 et)) $ pexpr 12 ef in if l < 12 then mkid $ gpar $ uncurry (<>) $ pp else pp where - pexpr = prettyGExpr ppid ppr + pexpr = prettyGExpr ppid ppr ppa psexpr n = fst . pexpr n prettyExpr :: PrettyIdent Expr -prettyExpr (Expr e) = prettyGExpr prettyHierIdent (pm prettyDimRange) 12 e +prettyExpr (Expr e) = prettyGExpr prettyHierIdent (pm prettyDimRange) prettyAttr 12 e prettyCExpr :: PrettyIdent CExpr -prettyCExpr (CExpr e) = prettyGExpr prettyIdent (pm prettyCRangeExpr) 12 e +prettyCExpr (CExpr e) = prettyGExpr prettyIdent (pm prettyCRangeExpr) prettyAttr 12 e prettyGMTM :: PrettyIdent et -> PrettyIdent (GenMinTypMax et) prettyGMTM pp x = case x of @@ -865,7 +869,8 @@ prettySpecifyItem x = SI'Noshowcancelled o -> prettyItemsid "noshowcancelled" prettySpecTerm o SI'PathDecl mpc p pol eds l -> ( case mpc of - MPCCond e -> group $ "if" <=> gpar (padj (prettyGExpr prettyIdent (const mempty) 12) e) + MPCCond e -> + group $ "if" <=> gpar (padj (prettyGExpr prettyIdent (const mempty) prettyAttr 12) e) MPCAlways -> mempty MPCNone -> "ifnone" ) @@ -1188,7 +1193,6 @@ prettyConfigItem (ConfigItem ci llu) = ) <> semi where - catid :: PrettyIdent a -> [a] -> Doc catid f = foldrMap1' mempty (gpadj f) $ (<=>) . fst . f prettyVerilog2005 :: Verilog2005 -> Doc @@ -1208,5 +1212,4 @@ prettyVerilog2005 (Verilog2005 mb pb cb) = cb where (<##>) = mkopt $ \a b -> a <#> mempty <#> b - catid :: PrettyIdent a -> [a] -> Doc catid f = foldrMap1' mempty (gpadj f) $ (<=>) . fst . f diff --git a/src/Verismith/Verilog2005/Utils.hs b/src/Verismith/Verilog2005/Utils.hs index b086a9a..77139bb 100644 --- a/src/Verismith/Verilog2005/Utils.hs +++ b/src/Verismith/Verilog2005/Utils.hs @@ -13,6 +13,7 @@ module Verismith.Verilog2005.Utils addAttributed, genexprnumber, constifyIdent, + constifyMaybeRange, trConstifyGenExpr, constifyExpr, constifyLV, @@ -55,7 +56,7 @@ addAttributed f (Attributed na x) (Attributed a y) = if a /= na then Nothing else Attributed a <$> f x y -- | Makes a Verilog2005 expression out of a number -genexprnumber :: Natural -> GenExpr i r +genexprnumber :: Natural -> GenExpr i r a genexprnumber = ExprPrim . PrimNumber Nothing False . NDecimal -- | converts HierIdent into Identifier @@ -68,10 +69,10 @@ unconstIdent = HierIdent [] -- | converts Prim into GenPrim i r constifyGenPrim :: - (HierIdent -> Maybe i) -> + (si -> Maybe di) -> (Maybe DimRange -> Maybe r) -> - GenPrim HierIdent (Maybe DimRange) -> - Maybe (GenPrim i r) + GenPrim si (Maybe DimRange) a -> + Maybe (GenPrim di r a) constifyGenPrim fi fr x = case x of PrimNumber s b n -> Just $ PrimNumber s b n PrimReal s -> Just $ PrimReal s @@ -87,7 +88,7 @@ constifyGenPrim fi fr x = case x of ce = trConstifyGenExpr fi fr -- | the other way -unconstPrim :: GenPrim Identifier (Maybe CRangeExpr) -> GenPrim HierIdent (Maybe DimRange) +unconstPrim :: GenPrim Identifier (Maybe CRangeExpr) a -> GenPrim HierIdent (Maybe DimRange) a unconstPrim x = case x of PrimNumber s b n -> PrimNumber s b n PrimReal s -> PrimReal s @@ -101,12 +102,12 @@ unconstPrim x = case x of PrimMinTypMax $ MTMFull (trUnconstExpr l) (trUnconstExpr t) (trUnconstExpr h) PrimString s -> PrimString s --- | converts Expr's `GenExpr` into `GenExpr i r` +-- | converts `GenExpr si (MaybeDimRange) a` into `GenExpr i r a` trConstifyGenExpr :: - (HierIdent -> Maybe i) -> + (si -> Maybe di) -> (Maybe DimRange -> Maybe r) -> - GenExpr HierIdent (Maybe DimRange) -> - Maybe (GenExpr i r) + GenExpr si (Maybe DimRange) a -> + Maybe (GenExpr di r a) trConstifyGenExpr fi fr x = case x of ExprPrim p -> ExprPrim <$> constifyGenPrim fi fr p ExprUnOp op a p -> ExprUnOp op a <$> constifyGenPrim fi fr p @@ -115,15 +116,18 @@ trConstifyGenExpr fi fr x = case x of where ce = trConstifyGenExpr fi fr +-- | converts Expr's `DimRange` into CExpr's `CRangeExpr` +constifyMaybeRange :: Maybe DimRange -> Maybe (Maybe CRangeExpr) +constifyMaybeRange = + maybe (Just Nothing) $ \(GenDimRange l r) -> if null l then Just <$> constifyRange r else Nothing + -- | converts Expr's `GenExpr` into CExpr `GenExpr` trConstifyExpr :: - GenExpr HierIdent (Maybe DimRange) -> Maybe (GenExpr Identifier (Maybe CRangeExpr)) -trConstifyExpr = trConstifyGenExpr constifyIdent $ - maybe (Just Nothing) $ - \(GenDimRange l r) -> if null l then Just <$> constifyRange r else Nothing + GenExpr HierIdent (Maybe DimRange) a -> Maybe (GenExpr Identifier (Maybe CRangeExpr) a) +trConstifyExpr = trConstifyGenExpr constifyIdent constifyMaybeRange -- | the other way -trUnconstExpr :: GenExpr Identifier (Maybe CRangeExpr) -> GenExpr HierIdent (Maybe DimRange) +trUnconstExpr :: GenExpr Identifier (Maybe CRangeExpr) a -> GenExpr HierIdent (Maybe DimRange) a trUnconstExpr x = case x of ExprPrim p -> ExprPrim (unconstPrim p) ExprUnOp op a p -> ExprUnOp op a (unconstPrim p) @@ -231,8 +235,6 @@ toMGIBlockDecl x = case x of BDEvent d -> conv BDEvent d BDLocalParam t d -> conv (BDLocalParam t) d where - conv :: - (Compose Identity f x -> BD Identity t) -> Compose NonEmpty f x -> NonEmpty (BD Identity t) conv f = fmap (f . Compose . Identity) . getCompose -- | Converts one ModGenBlockedItem's `BlockDecl` into ModGenSingleItem's `BlockDecl` @@ -246,7 +248,6 @@ fromMGIBlockDecl1 x = case x of BDEvent d -> conv BDEvent d BDLocalParam t d -> conv (BDLocalParam t) d where - conv :: (Compose NonEmpty f x -> BD NonEmpty t) -> Compose Identity f x -> BD NonEmpty t conv f = f . Compose . (:|[]) . runIdentity . getCompose -- | Merges one ModGenBlockedItem's `BlockDecl` with one ModGenSingleItem's `BlockDecl` @@ -261,11 +262,6 @@ fromMGIBlockDecl_add x y = case (x, y) of (BDLocalParam nt d, BDLocalParam t l) | nt == t -> add (BDLocalParam t) d l _ -> Nothing where - add :: - (Compose NonEmpty f x -> BD NonEmpty t) -> - Compose Identity f x -> - Compose NonEmpty f x -> - Maybe (BD NonEmpty t) add f x l = Just $ f $ Compose $ runIdentity (getCompose x) <| getCompose l -- | Converts ModGenSingleItem like `BlockDecl` into StdBlockDecl `BlockDecl` @@ -279,10 +275,6 @@ toStdBlockDecl x = case x of BDEvent d -> conv BDEvent d BDLocalParam t d -> conv (BDLocalParam t) d where - conv :: - (Identity x -> BlockDecl Identity t) -> - Compose NonEmpty Identified x -> - NonEmpty (Identified (BlockDecl Identity t)) conv f = fmap (fmap $ f . Identity) . getCompose -- | Converts ModGenBlockedItem's `BlockDecl` into ModGenSingleItem's `BlockDecl` @@ -315,7 +307,6 @@ toBlockedItem x = case x of MGIIf e t f -> [MGIIf e t f] MGICase e b d -> [MGICase e b d] where - conv :: (Identity x -> ModGenBlockedItem) -> NonEmpty x -> NonEmpty ModGenBlockedItem conv f = fmap (f . Identity) fromBlockedItem1 :: ModGenBlockedItem -> ModGenSingleItem @@ -347,7 +338,6 @@ fromBlockedItem1 x = case x of MGIIf e t f -> MGIIf e t f MGICase e b d -> MGICase e b d where - conv :: (NonEmpty x -> ModGenSingleItem) -> Identity x -> ModGenSingleItem conv f = f . (:|[]) . runIdentity fromBlockedItem_add :: ModGenBlockedItem -> ModGenSingleItem -> Maybe ModGenSingleItem @@ -384,7 +374,6 @@ fromBlockedItem_add x y = case (x, y) of add (MGIUnknownInst t p) i l _ -> Nothing where - add :: (NonEmpty x -> ModGenSingleItem) -> Identity x -> NonEmpty x -> Maybe ModGenSingleItem add f x y = Just $ f $ runIdentity x <| y fromBlockedItem :: NonEmpty (Attributed ModGenBlockedItem) -> NonEmpty (Attributed ModGenSingleItem)