added language support for package-scoped calls and typenames

src/Convert/KWArgs.hs

@@ -44,11 +44,11 @@ collectTFDecls name decls =
         getInput _ = Nothing
 
 convertExpr :: TFs -> Expr -> Expr
-convertExpr _ (orig @ (Call _ (Args _ []))) = orig
-convertExpr tfs (Call func (Args pnArgs kwArgs)) =
+convertExpr _ (orig @ (Call Nothing _ (Args _ []))) = orig
+convertExpr tfs (Call Nothing func (Args pnArgs kwArgs)) =
     case tfs Map.!? func of
-        Nothing -> Call func (Args pnArgs kwArgs)
-        Just ordered -> Call func (Args args [])
+        Nothing -> Call Nothing func (Args pnArgs kwArgs)
+        Just ordered -> Call Nothing func (Args args [])
             where
                 args = pnArgs ++ (map snd $ sortOn position kwArgs)
                 position (x, _) = elemIndex x ordered

src/Convert/NestPI.hs

@@ -70,18 +70,18 @@ collectPIsM _ = return ()
 
 -- writes down the names of subroutine invocations
 collectSubroutinesM :: Stmt -> Writer Idents ()
-collectSubroutinesM (Subroutine f _) = tell $ Set.singleton f
+collectSubroutinesM (Subroutine Nothing f _) = tell $ Set.singleton f
 collectSubroutinesM _ = return ()
 
 -- writes down the names of function calls and identifiers
 collectIdentsM :: Expr -> Writer Idents ()
-collectIdentsM (Call    x _) = tell $ Set.singleton x
-collectIdentsM (Ident   x  ) = tell $ Set.singleton x
+collectIdentsM (Call Nothing x _) = tell $ Set.singleton x
+collectIdentsM (Ident x)          = tell $ Set.singleton x
 collectIdentsM _ = return ()
 
 -- writes down aliased typenames
 collectTypenamesM :: Type -> Writer Idents ()
-collectTypenamesM (Alias x _) = tell $ Set.singleton x
+collectTypenamesM (Alias _ x _) = tell $ Set.singleton x
 collectTypenamesM (Enum (Just t) _ _) = collectTypenamesM t
 collectTypenamesM (Struct _ fields _) = do
     _ <- mapM collectTypenamesM $ map fst fields

src/Convert/Struct.hs

@@ -52,9 +52,10 @@ convertDescription (description @ (Part _ _ _ _ _ _)) =
             traverseExprsM traverseExprM item >>=
             traverseAsgnsM traverseAsgnM
         traverseStmtM :: Stmt -> State Types Stmt
-        traverseStmtM (Subroutine f args) = do
+        traverseStmtM (Subroutine Nothing f args) = do
             stateTypes <- get
-            return $ uncurry Subroutine $ convertCall structs stateTypes f args
+            return $ uncurry (Subroutine Nothing) $
+                convertCall structs stateTypes f args
         traverseStmtM stmt =
             traverseStmtExprsM traverseExprM stmt >>=
             traverseStmtAsgnsM traverseAsgnM
@@ -113,9 +114,9 @@ collectStructM (Struct (Packed sg) fields _) = do
         -- mixed `wire`/`logic` or `reg`/`logic`.
         fieldClasses = map (show . fst . typeRanges) fieldTypes
         isComplex :: Type -> Bool
-        isComplex (Struct _ _ _ ) = True
-        isComplex (Enum _ _ _ ) = True
-        isComplex (Alias _ _) = True
+        isComplex (Struct _ _ _) = True
+        isComplex (Enum   _ _ _) = True
+        isComplex (Alias  _ _ _) = True
         isComplex _ = False
         canUnstructure =
             all (head fieldClasses ==) fieldClasses &&
@@ -134,7 +135,7 @@ convertType structs t1 =
 
 -- writes down the names of called functions
 collectCallsM :: Expr -> Writer Idents ()
-collectCallsM (Call f _) = tell $ Set.singleton f
+collectCallsM (Call Nothing f _) = tell $ Set.singleton f
 collectCallsM _ = return ()
 
 collectTFArgsM :: ModuleItem -> Writer Types ()
@@ -293,7 +294,7 @@ convertAsgn structs types (lhs, expr) =
             else if Map.notMember structTf structs then
                 Pattern items
             else
-                Call fnName $ Args (map (Just . snd) items) []
+                Call Nothing fnName $ Args (map (Just . snd) items) []
             where
                 subMap = \(Just ident, subExpr) ->
                     (Just ident, convertExpr (lookupFieldType fields ident) subExpr)
@@ -374,8 +375,8 @@ convertAsgn structs types (lhs, expr) =
                     (_, []) -> Implicit Unspecified []
                     (tf, rs) -> tf $ tail rs
                 (_, i') = convertSubExpr i
-        convertSubExpr (Call f args) =
-            (retType, uncurry Call $ convertCall structs types f args)
+        convertSubExpr (Call Nothing f args) =
+            (retType, uncurry (Call Nothing) $ convertCall structs types f args)
             where
                 retType = case Map.lookup f types of
                     Nothing -> Implicit Unspecified []

src/Convert/Traverse.hs

@@ -235,7 +235,7 @@ traverseSinglyNestedStmtsM fullMapper = cs
             return $ If u e s1' s2'
         cs (Timing event stmt) = fullMapper stmt >>= return . Timing event
         cs (Return expr) = return $ Return expr
-        cs (Subroutine f exprs) = return $ Subroutine f exprs
+        cs (Subroutine ps f exprs) = return $ Subroutine ps f exprs
         cs (Trigger x) = return $ Trigger x
         cs (Assertion a) =
             traverseAssertionStmtsM fullMapper a >>= return . Assertion
@@ -424,11 +424,11 @@ traverseNestedExprsM mapper = exprMapper
             return $ Repeat e' l'
         em (Concat     l) =
             mapM exprMapper l >>= return . Concat
-        em (Call       f (Args l p)) = do
+        em (Call    ps f (Args l p)) = do
             l' <- mapM maybeExprMapper l
             pes <- mapM maybeExprMapper $ map snd p
             let p' = zip (map fst p) pes
-            return $ Call f (Args l' p')
+            return $ Call ps f (Args l' p')
         em (UniOp      o e) =
             exprMapper e >>= return . UniOp o
         em (BinOp      o e1 e2) = do
@@ -645,11 +645,11 @@ traverseStmtExprsM exprMapper = flatStmtMapper
     flatStmtMapper (If u cc s1 s2) =
         exprMapper cc >>= \cc' -> return $ If u cc' s1 s2
     flatStmtMapper (Timing event stmt) = return $ Timing event stmt
-    flatStmtMapper (Subroutine f (Args l p)) = do
+    flatStmtMapper (Subroutine ps f (Args l p)) = do
         l' <- mapM maybeExprMapper l
         pes <- mapM maybeExprMapper $ map snd p
         let p' = zip (map fst p) pes
-        return $ Subroutine f (Args l' p')
+        return $ Subroutine ps f (Args l' p')
     flatStmtMapper (Return expr) =
         exprMapper expr >>= return . Return
     flatStmtMapper (Trigger x) = return $ Trigger x
@@ -765,7 +765,7 @@ traverseTypesM mapper item =
     traverseExprsM (traverseNestedExprsM exprMapper)
     where
         fullMapper t = tm t >>= mapper
-        tm (Alias         xx    rs) = return $ Alias         xx    rs
+        tm (Alias      ps xx    rs) = return $ Alias      ps xx    rs
         tm (Net           kw    rs) = return $ Net           kw    rs
         tm (Implicit         sg rs) = return $ Implicit         sg rs
         tm (IntegerVector kw sg rs) = return $ IntegerVector kw sg rs

src/Convert/Typedef.hs

@@ -54,7 +54,7 @@ convertDescription globalTypes description =
         convertExpr :: Expr -> Expr
         convertExpr (Bits (Right (Ident x))) =
             if Map.member x types
-                then Bits $ Left $ resolveType types (Alias x [])
+                then Bits $ Left $ resolveType types (Alias Nothing x [])
                 else Bits $ Right $ Ident x
         convertExpr other = other
 
@@ -66,12 +66,13 @@ resolveType _ (IntegerAtom   kw sg   ) = IntegerAtom   kw sg
 resolveType _ (NonInteger    kw      ) = NonInteger    kw
 resolveType _ (InterfaceT     x my rs) = InterfaceT     x my rs
 resolveType _ (Enum Nothing   vals rs) = Enum Nothing   vals rs
+resolveType _ (Alias (Just ps)  st rs) = Alias (Just ps)  st rs
 resolveType types (Enum (Just t) vals rs) = Enum (Just $ resolveType types t) vals rs
 resolveType types (Struct p items rs) = Struct p items' rs
     where
         items' = map resolveItem items
         resolveItem (t, x) = (resolveType types t, x)
-resolveType types (Alias st rs1) =
+resolveType types (Alias Nothing st rs1) =
     if Map.notMember st types
     then InterfaceT st Nothing rs1
     else case resolveType types $ types Map.! st of
@@ -83,4 +84,4 @@ resolveType types (Alias st rs1) =
         (InterfaceT     x my rs2) -> InterfaceT     x my $ rs1 ++ rs2
         (IntegerAtom   kw _ ) -> error $ "resolveType encountered packed `" ++ (show kw) ++ "` on " ++ st
         (NonInteger    kw   ) -> error $ "resolveType encountered packed `" ++ (show kw) ++ "` on " ++ st
-        (Alias    _ _) -> error $ "resolveType invariant failed on " ++ st
+        (Alias  _ _ _) -> error $ "resolveType invariant failed on " ++ st

src/Language/SystemVerilog/AST/Expr.hs

@@ -39,7 +39,7 @@ data Expr
     | Bit     Expr Expr
     | Repeat  Expr [Expr]
     | Concat  [Expr]
-    | Call    Identifier Args
+    | Call    (Maybe Identifier) Identifier Args
     | UniOp   UniOp Expr
     | BinOp   BinOp Expr Expr
     | Mux     Expr Expr Expr
@@ -52,7 +52,7 @@ data Expr
 instance Show Expr where
     show (Number  str  ) = str
     show (Ident   str  ) = str
-    show (PSIdent   x y) = printf "%s::%s" x y
+    show (PSIdent x y  ) = printf "%s::%s" x y
     show (String  str  ) = printf "\"%s\"" str
     show (Bit     e b  ) = printf "%s[%s]"     (show e) (show b)
     show (Range   e m r) = printf "%s[%s%s%s]" (show e) (show $ fst r) (show m) (show $ snd r)
@@ -62,7 +62,7 @@ instance Show Expr where
     show (BinOp   o a b) = printf "(%s %s %s)" (show a) (show o) (show b)
     show (Dot     e n  ) = printf "%s.%s"      (show e) n
     show (Mux     c a b) = printf "(%s ? %s : %s)" (show c) (show a) (show b)
-    show (Call    f l  ) = printf "%s(%s)" f (show l)
+    show (Call   ps f l) = printf "%s%s(%s)" (maybe "" (++ "::") ps) f (show l)
     show (Cast tore e  ) = printf "%s'(%s)" (showEither tore) (show e)
     show (Bits tore    ) = printf "$bits(%s)" (showEither tore)
     show (Pattern l    ) =
@@ -121,7 +121,7 @@ readNumber n =
 -- basic expression simplfication utility to help us generate nicer code in the
 -- common case of ranges like `[FOO-1:0]`
 simplify :: Expr -> Expr
-simplify (orig @ (Call "$clog2" (Args [Just (Number n)] []))) =
+simplify (orig @ (Call Nothing "$clog2" (Args [Just (Number n)] []))) =
     case readNumber n of
         Nothing -> orig
         Just x -> Number $ show $ clog2 x

src/Language/SystemVerilog/AST/Stmt.hs

@@ -46,7 +46,7 @@ data Stmt
     | If      (Maybe UniquePriority) Expr Stmt Stmt
     | Timing  Timing Stmt
     | Return  Expr
-    | Subroutine Identifier Args
+    | Subroutine (Maybe Identifier) Identifier Args
     | Trigger Identifier
     | Assertion Assertion
     | Null
@@ -79,7 +79,7 @@ instance Show Stmt where
             showInit (Right (l, e)) = printf "%s = %s" (show l) (show e)
             showAssign :: (LHS, AsgnOp, Expr) -> String
             showAssign (l, op, e) = printf "%s %s %s" (show l) (show op) (show e)
-    show (Subroutine x a) = printf "%s(%s);" x (show a)
+    show (Subroutine ps x a) = printf "%s%s(%s);" (maybe "" (++ "::") ps) x (show a)
     show (AsgnBlk o v e) = printf "%s %s %s;" (show v) (show o) (show e)
     show (Asgn    t v e) = printf "%s <= %s%s;" (show v) (maybe "" showPad t) (show e)
     show (While   e s) = printf  "while (%s) %s" (show e) (show s)

src/Language/SystemVerilog/AST/Type.hs

@@ -34,14 +34,14 @@ data Type
     | NonInteger    NonIntegerType
     | Net           NetType                    [Range]
     | Implicit                         Signing [Range]
-    | Alias                 Identifier         [Range]
+    | Alias    (Maybe Identifier) Identifier   [Range]
     | Enum     (Maybe Type) [Item]             [Range]
     | Struct   Packing      [Field]            [Range]
     | InterfaceT Identifier (Maybe Identifier) [Range]
     deriving (Eq, Ord)
 
 instance Show Type where
-    show (Alias         xx    rs) = printf "%s%s"   xx                           (showRanges rs)
+    show (Alias      ps xx    rs) = printf "%s%s%s" (maybe "" (++ "::") ps)  xx  (showRanges rs)
     show (Net           kw    rs) = printf "%s%s"   (show kw)                    (showRanges rs)
     show (Implicit         sg rs) = printf "%s%s"             (showPad       sg) (dropWhile (== ' ') $ showRanges rs)
     show (IntegerVector kw sg rs) = printf "%s%s%s" (show kw) (showPadBefore sg) (showRanges rs)
@@ -74,7 +74,7 @@ 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 (Alias      ps xx    rs) = (Alias      ps xx   , rs)
 typeRanges (Net           kw    rs) = (Net           kw   , rs)
 typeRanges (Implicit         sg rs) = (Implicit         sg, rs)
 typeRanges (IntegerVector kw sg rs) = (IntegerVector kw sg, rs)

src/Language/SystemVerilog/Parser/Parse.y

@@ -245,7 +245,7 @@ string             { Token Lit_string      _ _ }
 %left  "*" "/" "%"
 %left  "**"
 %right REDUCE_OP "!" "~" "++" "--"
-%left  "(" ")" "[" "]" "." "'"
+%left  "(" ")" "[" "]" "." "'" "::"
 
 %%
 
@@ -266,7 +266,8 @@ Description :: { [Description] }
 
 Type :: { Type }
   : TypeNonIdent { $1 }
-  | Identifier Dimensions { Alias $1 $2 }
+  |                 Identifier Dimensions { Alias (Nothing) $1 $2 }
+  | Identifier "::" Identifier Dimensions { Alias (Just $1) $3 $4 }
 TypeNonIdent :: { Type }
   : PartialType OptSigning Dimensions { $1 $2 $3 }
 PartialType :: { Signing -> [Range] -> Type }
@@ -421,6 +422,7 @@ DeclOrStmtToken :: { DeclToken }
   | PartialType    { DTType    $1 }
   | "." Identifier { DTDot     $2 }
   | Signing        { DTSigning $1 }
+  | Identifier "::" Identifier { DTPSIdent $1 $3 }
 
 VariablePortIdentifiers :: { [(Identifier, Maybe Expr)] }
   : VariablePortIdentifier                             { [$1] }
@@ -670,7 +672,8 @@ Stmts :: { [Stmt] }
 Stmt :: { Stmt }
   : StmtNonAsgn         { $1 }
   | LHS AsgnOp Expr ";" { AsgnBlk $2 $1 $3 }
-  | Identifier      ";" { Subroutine $1 (Args [] []) }
+  |                 Identifier ";" { Subroutine (Nothing) $1 (Args [] []) }
+  | Identifier "::" Identifier ";" { Subroutine (Just $1) $3 (Args [] []) }
   | LHS "<=" opt(DelayOrEventControl) Expr ";" { Asgn $3 $1 $4 }
   | LHS IncOrDecOperator ";" { AsgnBlk (AsgnOp $2) $1 (Number "1") }
   | IncOrDecOperator LHS ";" { AsgnBlk (AsgnOp $1) $2 (Number "1") }
@@ -681,9 +684,10 @@ StmtNonAsgn :: { Stmt }
   | Unique "if" "(" Expr ")" Stmt %prec NoElse        { If $1 $4 $6 Null      }
   | "for" "(" DeclTokens(";") opt(Expr) ";" ForStep ")" Stmt { For (parseDTsAsDeclsAndAsgns $3) $4 $6 $8 }
   | Unique CaseKW "(" Expr ")" Cases opt(CaseDefault) "endcase" { Case $1 $2 $4 $6 $7 }
+  |                 Identifier "(" CallArgs ")" ";" { Subroutine (Nothing) $1 $3 }
+  | Identifier "::" Identifier "(" CallArgs ")" ";" { Subroutine (Just $1) $3 $5 }
   | TimingControl Stmt                         { Timing $1 $2 }
   | "return" Expr ";"                          { Return $2 }
-  | Identifier "(" CallArgs ")" ";"            { Subroutine $1 $3 }
   | "while"  "(" Expr ")" Stmt                 { While   $3 $5 }
   | "repeat" "(" Expr ")" Stmt                 { RepeatL $3 $5 }
   | "do"      Stmt "while" "(" Expr ")" ";"    { DoWhile $5 $2 }
@@ -718,9 +722,10 @@ DeclOrStmt :: { ([Decl], [Stmt]) }
   | ParameterDecl(ParameterDeclKW, ";") { ($1, []) }
 
 ParameterDecl(kw, delim) :: { [Decl] }
-  : kw            DeclAsgns delim { map (uncurry $ $1 (Implicit Unspecified [])) $2 }
-  | kw ParamType  DeclAsgns delim { map (uncurry $ $1 ($2                     )) $3 }
-  | kw Identifier DeclAsgns delim { map (uncurry $ $1 (Alias    $2          [])) $3 }
+  : kw                            DeclAsgns delim { map (uncurry $ $1 (Implicit Unspecified [])) $2 }
+  | kw                 ParamType  DeclAsgns delim { map (uncurry $ $1 ($2                     )) $3 }
+  | kw                 Identifier DeclAsgns delim { map (uncurry $ $1 (Alias (Nothing)   $2 [])) $3 }
+  | kw Identifier "::" Identifier DeclAsgns delim { map (uncurry $ $1 (Alias (Just $2)   $4 [])) $5 }
 ParameterDeclKW :: { Type -> Identifier -> Expr -> Decl }
   : "parameter"  { Parameter  }
   | "localparam" { Localparam }
@@ -811,7 +816,8 @@ Expr :: { Expr }
   : "(" Expr ")"                { $2 }
   | String                      { String $1 }
   | Number                      { Number $1 }
-  | Identifier "(" CallArgs ")" { Call $1 $3 }
+  |                 Identifier "(" CallArgs ")" { Call (Nothing) $1 $3 }
+  | Identifier "::" Identifier "(" CallArgs ")" { Call (Just $1) $3 $5 }
   | "$bits"    "(" BitsArg  ")" { Bits $3 }
   | Identifier                  { Ident $1 }
   | Identifier "::" Identifier  { PSIdent $1 $3 }
@@ -821,8 +827,9 @@ Expr :: { Expr }
   | "{" Exprs "}"               { Concat $2 }
   | Expr "?" Expr ":" Expr      { Mux $1 $3 $5 }
   | CastingType "'" "(" Expr ")" { Cast (Left            $1) $4 }
-  | Identifier  "'" "(" Expr ")" { Cast (Left $ Alias $1 []) $4 }
   | Number      "'" "(" Expr ")" { Cast (Right $ Number  $1) $4 }
+  |                 Identifier  "'" "(" Expr ")" { Cast (Left $ Alias (Nothing) $1 []) $4 }
+  | Identifier "::" Identifier  "'" "(" Expr ")" { Cast (Left $ Alias (Just $1) $3 []) $6 }
   | Expr "." Identifier         { Dot $1 $3 }
   | "'" "{" PatternItems "}"    { Pattern $3 }
   -- binary expressions

src/Language/SystemVerilog/Parser/ParseDecl.hs

@@ -51,6 +51,7 @@ data DeclToken
     | DTAsgnNBlk (Maybe Timing) Expr
     | DTRange    (PartSelectMode, Range)
     | DTIdent    Identifier
+    | DTPSIdent  Identifier Identifier
     | DTDir      Direction
     | DTType     (Signing -> [Range] -> Type)
     | DTParams   [PortBinding]
@@ -179,7 +180,8 @@ parseDTsAsDecl tokens =
 -- [PUBLIC]: parser for single block item declarations or assign or arg-less
 -- subroutine call statetments
 parseDTsAsDeclOrAsgn :: [DeclToken] -> ([Decl], [Stmt])
-parseDTsAsDeclOrAsgn [DTIdent f] = ([], [Subroutine f (Args [] [])])
+parseDTsAsDeclOrAsgn [DTIdent     f] = ([], [Subroutine (Nothing) f (Args [] [])])
+parseDTsAsDeclOrAsgn [DTPSIdent p f] = ([], [Subroutine (Just  p) f (Args [] [])])
 parseDTsAsDeclOrAsgn tokens =
     if any isAsgnToken tokens || tripLookahead tokens
         then ([], [constructor lhs expr])
@@ -317,7 +319,8 @@ takeType (DTType  tf                : rest) = (tf       Unspecified,
 takeType (DTSigning sg              : rest) = (Implicit sg         ,                        rest)
 takeType (DTIdent tn : DTComma      : rest) = (Implicit Unspecified, DTIdent tn : DTComma : rest)
 takeType (DTIdent tn                : [  ]) = (Implicit Unspecified, DTIdent tn           : [  ])
-takeType (DTIdent tn                : rest) = (Alias tn            ,                        rest)
+takeType (DTIdent tn                : rest) = (Alias (Nothing) tn  ,                        rest)
+takeType (DTPSIdent ps tn           : rest) = (Alias (Just ps) tn  ,                        rest)
 takeType                              rest  = (Implicit Unspecified,                        rest)
 
 takeRanges :: [DeclToken] -> ([Range], [DeclToken])