From 69b2e86aeeda6d1d5c3e077e6973a00d282bffe2 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Thu, 9 Jul 2020 21:01:18 -0600 Subject: [PATCH] remove pattern synonyms which introduced excessive overhead --- src/Convert/DimensionQuery.hs | 8 ++++++-- src/Convert/Enum.hs | 4 ++++ src/Convert/NestPI.hs | 2 ++ src/Convert/Package.hs | 5 +---- src/Convert/ParamType.hs | 5 +++-- src/Convert/Simplify.hs | 1 - src/Convert/Traverse.hs | 2 ++ src/Convert/Typedef.hs | 2 ++ src/Language/SystemVerilog/AST/Expr.hs | 11 ++--------- src/Language/SystemVerilog/AST/Type.hs | 13 ++++--------- src/Language/SystemVerilog/Parser/Parse.y | 2 +- src/Language/SystemVerilog/Parser/ParseDecl.hs | 15 ++++++++++----- 12 files changed, 37 insertions(+), 33 deletions(-) diff --git a/src/Convert/DimensionQuery.hs b/src/Convert/DimensionQuery.hs index fffecd4..f81aee4 100644 --- a/src/Convert/DimensionQuery.hs +++ b/src/Convert/DimensionQuery.hs @@ -65,6 +65,8 @@ convertExpr (orig @ (DimsFn FnUnpackedDimensions (Left t))) = convertExpr (orig @ (DimsFn FnDimensions (Left t))) = case t of IntegerAtom{} -> Number "1" + Alias{} -> orig + PSAlias{} -> orig CSAlias{} -> orig TypeOf{} -> orig UnpackedType t' rs -> @@ -95,8 +97,10 @@ convertExpr (DimFn f (Left t) (Number str)) = Just d = dm r = rs !! (fromIntegral $ d - 1) isUnresolved :: Type -> Bool - isUnresolved (CSAlias{}) = True - isUnresolved (TypeOf{}) = True + isUnresolved Alias{} = True + isUnresolved PSAlias{} = True + isUnresolved CSAlias{} = True + isUnresolved TypeOf{} = True isUnresolved _ = False convertExpr (DimFn f (Left t) d) = DimFn f (Left t) d diff --git a/src/Convert/Enum.hs b/src/Convert/Enum.hs index 4ad1131..f893ba9 100644 --- a/src/Convert/Enum.hs +++ b/src/Convert/Enum.hs @@ -60,6 +60,10 @@ convertDescription' description = -- replace, but write down, enum types traverseType :: Type -> Writer Enums Type +traverseType (Enum (t @ Alias{}) v rs) = + return $ Enum t v rs -- not ready +traverseType (Enum (t @ PSAlias{}) v rs) = + return $ Enum t v rs -- not ready traverseType (Enum (t @ CSAlias{}) v rs) = return $ Enum t v rs -- not ready traverseType (Enum (Implicit sg rl) v rs) = diff --git a/src/Convert/NestPI.hs b/src/Convert/NestPI.hs index 1f21567..4ca537e 100644 --- a/src/Convert/NestPI.hs +++ b/src/Convert/NestPI.hs @@ -116,6 +116,8 @@ collectLHSIdentsM _ = return () -- writes down aliased typenames collectTypenamesM :: Type -> Writer Idents () +collectTypenamesM (Alias x _) = tell $ Set.singleton x +collectTypenamesM (PSAlias _ x _) = tell $ Set.singleton x collectTypenamesM (CSAlias _ _ x _) = tell $ Set.singleton x collectTypenamesM _ = return () diff --git a/src/Convert/Package.hs b/src/Convert/Package.hs index 70c265b..039cc8f 100644 --- a/src/Convert/Package.hs +++ b/src/Convert/Package.hs @@ -201,14 +201,11 @@ traverseModuleItem _ _ item = where traverseExpr :: Expr -> Expr - traverseExpr (Ident x) = Ident x traverseExpr (PSIdent x y) = Ident $ x ++ "_" ++ y traverseExpr other = other traverseType :: Type -> Type - traverseType (Alias xx rs) = Alias xx rs - traverseType (PSAlias ps xx rs) = - Alias (ps ++ "_" ++ xx) rs + traverseType (PSAlias ps xx rs) = Alias (ps ++ "_" ++ xx) rs traverseType other = other -- returns the "name" of a package item, if it has one diff --git a/src/Convert/ParamType.hs b/src/Convert/ParamType.hs index b9f4931..f1c8023 100644 --- a/src/Convert/ParamType.hs +++ b/src/Convert/ParamType.hs @@ -212,7 +212,9 @@ defaultTag = "_sv2v_default" -- attempt to convert an expression to syntactically equivalent type exprToType :: Expr -> Maybe Type -exprToType (CSIdent x p y) = Just $ CSAlias x p y [] +exprToType (Ident x) = Just $ Alias x [] +exprToType (PSIdent y x) = Just $ PSAlias y x [] +exprToType (CSIdent y p x) = Just $ CSAlias y p x [] exprToType (Range e NonIndexed r) = case exprToType e of Nothing -> Nothing @@ -248,7 +250,6 @@ typeHasQueries = (collectNestedExprsM collectUnresolvedExprM) where collectUnresolvedExprM :: Expr -> Writer [Expr] () - collectUnresolvedExprM Ident{} = return () collectUnresolvedExprM (expr @ PSIdent{}) = tell [expr] collectUnresolvedExprM (expr @ CSIdent{}) = tell [expr] collectUnresolvedExprM (expr @ DimsFn{}) = tell [expr] diff --git a/src/Convert/Simplify.hs b/src/Convert/Simplify.hs index 72c3439..4ccf63b 100644 --- a/src/Convert/Simplify.hs +++ b/src/Convert/Simplify.hs @@ -44,7 +44,6 @@ traverseDeclM decl = do isSimpleExpr :: Expr -> Bool isSimpleExpr Ident{} = True -isSimpleExpr PSIdent{} = True isSimpleExpr Number{} = True isSimpleExpr String{} = True isSimpleExpr (Dot e _ ) = isSimpleExpr e diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs index e4a1a59..db00b4b 100644 --- a/src/Convert/Traverse.hs +++ b/src/Convert/Traverse.hs @@ -869,6 +869,8 @@ traverseNestedTypesM :: Monad m => MapperM m Type -> MapperM m Type traverseNestedTypesM mapper = fullMapper where fullMapper = mapper >=> tm + tm (Alias xx rs) = return $ Alias xx rs + tm (PSAlias ps xx rs) = return $ PSAlias ps xx rs tm (CSAlias ps pm xx rs) = return $ CSAlias ps pm xx rs tm (Net kw sg rs) = return $ Net kw sg rs tm (Implicit sg rs) = return $ Implicit sg rs diff --git a/src/Convert/Typedef.hs b/src/Convert/Typedef.hs index 61d131c..8cc28ec 100644 --- a/src/Convert/Typedef.hs +++ b/src/Convert/Typedef.hs @@ -95,6 +95,8 @@ traverseTypeM (Alias st rs1) = do Struct p l rs2 -> Struct p l $ rs1 ++ rs2 Union p l rs2 -> Union p l $ rs1 ++ rs2 InterfaceT x my rs2 -> InterfaceT x my $ rs1 ++ rs2 + Alias xx rs2 -> Alias xx $ rs1 ++ rs2 + PSAlias ps xx rs2 -> PSAlias ps xx $ rs1 ++ rs2 CSAlias ps pm xx rs2 -> CSAlias ps pm xx $ rs1 ++ rs2 UnpackedType t rs2 -> UnpackedType t $ rs1 ++ rs2 IntegerAtom kw sg -> nullRange (IntegerAtom kw sg) rs1 diff --git a/src/Language/SystemVerilog/AST/Expr.hs b/src/Language/SystemVerilog/AST/Expr.hs index 238f4da..32e88da 100644 --- a/src/Language/SystemVerilog/AST/Expr.hs +++ b/src/Language/SystemVerilog/AST/Expr.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE PatternSynonyms #-} {- sv2v - Author: Zachary Snow - Initial Verilog AST Author: Tom Hawkins @@ -8,8 +7,6 @@ module Language.SystemVerilog.AST.Expr ( Expr (..) - , pattern Ident - , pattern PSIdent , Range , TypeOrExpr , ExprOrRange @@ -50,6 +47,8 @@ data Expr = String String | Number String | Time String + | Ident Identifier + | PSIdent Identifier Identifier | CSIdent Identifier [ParamBinding] Identifier | Range Expr PartSelectMode Range | Bit Expr Expr @@ -70,12 +69,6 @@ data Expr | Nil deriving (Eq, Ord) -pattern Ident :: Identifier -> Expr -pattern Ident x = PSIdent "" x - -pattern PSIdent :: Identifier -> Identifier -> Expr -pattern PSIdent x y = CSIdent x [] y - instance Show Expr where show (Nil ) = "" show (Number str ) = str diff --git a/src/Language/SystemVerilog/AST/Type.hs b/src/Language/SystemVerilog/AST/Type.hs index 49e2d96..cb26853 100644 --- a/src/Language/SystemVerilog/AST/Type.hs +++ b/src/Language/SystemVerilog/AST/Type.hs @@ -1,5 +1,4 @@ {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE PatternSynonyms #-} {- sv2v - Author: Zachary Snow - Initial Verilog AST Author: Tom Hawkins @@ -11,8 +10,6 @@ module Language.SystemVerilog.AST.Type ( Identifier , Field , Type (..) - , pattern Alias - , pattern PSAlias , Signing (..) , Packing (..) , NetType (..) @@ -45,6 +42,8 @@ data Type | NonInteger NonIntegerType | Net NetTypeAndStrength Signing [Range] | Implicit Signing [Range] + | Alias Identifier [Range] + | PSAlias Identifier Identifier [Range] | CSAlias Identifier [ParamBinding] Identifier [Range] | Enum Type [Item] [Range] | Struct Packing [Field] [Range] @@ -54,12 +53,6 @@ data Type | UnpackedType Type [Range] -- used internally deriving (Eq, Ord) -pattern Alias :: Identifier -> [Range] -> Type -pattern Alias x rs = PSAlias "" x rs - -pattern PSAlias :: Identifier -> Identifier -> [Range] -> Type -pattern PSAlias x y rs = CSAlias x [] y rs - instance Show Type where show (Alias xx rs) = printf "%s%s" xx (showRanges rs) show (PSAlias ps xx rs) = printf "%s::%s%s" ps xx (showRanges rs) @@ -102,6 +95,8 @@ instance Ord (Signing -> [Range] -> Type) where compare tf1 tf2 = compare (tf1 Unspecified) (tf2 Unspecified) typeRanges :: Type -> ([Range] -> Type, [Range]) +typeRanges (Alias xx rs) = (Alias xx , rs) +typeRanges (PSAlias ps xx rs) = (PSAlias ps xx , rs) typeRanges (CSAlias ps pm xx rs) = (CSAlias ps pm xx , rs) typeRanges (Net kw sg rs) = (Net kw sg, rs) typeRanges (Implicit sg rs) = (Implicit sg, rs) diff --git a/src/Language/SystemVerilog/Parser/Parse.y b/src/Language/SystemVerilog/Parser/Parse.y index 268ef4f..19fbfe7 100644 --- a/src/Language/SystemVerilog/Parser/Parse.y +++ b/src/Language/SystemVerilog/Parser/Parse.y @@ -634,7 +634,7 @@ DeclToken :: { DeclToken } | opt("var") "type" "(" Expr ")" {% posInject \p -> DTType p (\Unspecified -> \[] -> TypeOf $4) } | "<=" opt(DelayOrEvent) Expr {% posInject \p -> DTAsgn p AsgnOpNonBlocking $2 $3 } | IncOrDecOperator {% posInject \p -> DTAsgn p (AsgnOp $1) Nothing (Number "1") } - | Identifier "::" Identifier {% posInject \p -> DTCSIdent p $1 [] $3 } + | Identifier "::" Identifier {% posInject \p -> DTPSIdent p $1 $3 } | Identifier ParamBindings "::" Identifier {% posInject \p -> DTCSIdent p $1 $2 $4 } DeclTokenAsgn :: { DeclToken } : "=" opt(DelayOrEvent) Expr {% posInject \p -> DTAsgn p AsgnOpEq $2 $3 } diff --git a/src/Language/SystemVerilog/Parser/ParseDecl.hs b/src/Language/SystemVerilog/Parser/ParseDecl.hs index 58228c6..cb60e52 100644 --- a/src/Language/SystemVerilog/Parser/ParseDecl.hs +++ b/src/Language/SystemVerilog/Parser/ParseDecl.hs @@ -38,7 +38,6 @@ module Language.SystemVerilog.Parser.ParseDecl ( DeclToken (..) -, pattern DTIdent , parseDTsAsPortDecls , parseDTsAsModuleItems , parseDTsAsDecls @@ -58,6 +57,8 @@ data DeclToken | DTAutoDim Position | DTAsgn Position AsgnOp (Maybe Timing) Expr | DTRange Position (PartSelectMode, Range) + | DTIdent Position Identifier + | DTPSIdent Position Identifier Identifier | DTCSIdent Position Identifier [ParamBinding] Identifier | DTDir Position Direction | DTType Position (Signing -> [Range] -> Type) @@ -71,9 +72,6 @@ data DeclToken | DTLifetime Position Lifetime deriving (Show, Eq) -pattern DTIdent :: Position -> Identifier -> DeclToken -pattern DTIdent p x = DTCSIdent p "" [] x - -- entrypoints besides `parseDTsAsDeclOrStmt` use this to disallow `DTAsgn` with -- a non-blocking operator, binary assignment operator, or a timing control -- because we don't expect to see those assignment operators in declarations @@ -227,6 +225,10 @@ parseDTsAsDecl tokens = -- [PUBLIC]: parser for single block item declarations or assign or arg-less -- subroutine call statements parseDTsAsDeclOrStmt :: [DeclToken] -> ([Decl], [Stmt]) +parseDTsAsDeclOrStmt [DTIdent pos f] = + ([], [traceStmt pos, Subroutine (Ident f) (Args [] [])]) +parseDTsAsDeclOrStmt [DTPSIdent pos ps f] = + ([], [traceStmt pos, Subroutine (PSIdent ps f) (Args [] [])]) parseDTsAsDeclOrStmt [DTCSIdent pos ps pm f] = ([], [traceStmt pos, Subroutine (CSIdent ps pm f) (Args [] [])]) parseDTsAsDeclOrStmt (DTAsgn pos (AsgnOp op) mt e : tok : toks) = @@ -406,6 +408,8 @@ takeType (DTIdent _ a : DTDot _ b : rest) = (InterfaceT a (Just b), rest) takeType (DTType _ tf : DTSigning _ sg : rest) = (tf sg , rest) takeType (DTType _ tf : rest) = (tf Unspecified , rest) takeType (DTSigning _ sg : rest) = (Implicit sg , rest) +takeType (DTPSIdent _ ps tn : rest) = (PSAlias ps tn , rest) +takeType (DTCSIdent _ ps pm tn : rest) = (CSAlias ps pm tn , rest) takeType (DTIdent pos tn : rest) = if couldBeTypename then (Alias tn , rest) @@ -419,7 +423,6 @@ takeType (DTIdent pos tn : rest) = (_, Nothing) -> True -- if comma is first, then this ident is a declaration (Just a, Just b) -> a < b -takeType (DTCSIdent _ ps pm tn : rest) = (CSAlias ps pm tn , rest) takeType rest = (Implicit Unspecified, rest) takeRanges :: [DeclToken] -> ([Range], [DeclToken]) @@ -479,6 +482,8 @@ tokPos (DTComma p) = p tokPos (DTAutoDim p) = p tokPos (DTAsgn p _ _ _) = p tokPos (DTRange p _) = p +tokPos (DTIdent p _) = p +tokPos (DTPSIdent p _ _) = p tokPos (DTCSIdent p _ _ _) = p tokPos (DTDir p _) = p tokPos (DTType p _) = p