remove pattern synonyms which introduced excessive overhead

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

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) =

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 ()
 

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

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]

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

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

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

src/Language/SystemVerilog/AST/Expr.hs

-{-# LANGUAGE PatternSynonyms #-}
 {- sv2v
  - Author: Zachary Snow <zach@zachjs.com>
  - Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>
@@ -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

src/Language/SystemVerilog/AST/Type.hs

 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternSynonyms #-}
 {- sv2v
  - Author: Zachary Snow <zach@zachjs.com>
  - Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>
@@ -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)

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 }

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