From bc23aebc55f53ec6f325bb99c151c5da4c66cda3 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Wed, 24 Apr 2019 03:37:47 -0400 Subject: [PATCH] added language support for package-scoped calls and typenames --- src/Convert/KWArgs.hs | 8 +++--- src/Convert/NestPI.hs | 8 +++--- src/Convert/Struct.hs | 19 +++++++------- src/Convert/Traverse.hs | 12 ++++----- src/Convert/Typedef.hs | 7 +++--- src/Language/SystemVerilog/AST/Expr.hs | 8 +++--- src/Language/SystemVerilog/AST/Stmt.hs | 4 +-- src/Language/SystemVerilog/AST/Type.hs | 6 ++--- src/Language/SystemVerilog/Parser/Parse.y | 25 ++++++++++++------- .../SystemVerilog/Parser/ParseDecl.hs | 7 ++++-- 10 files changed, 58 insertions(+), 46 deletions(-) diff --git a/src/Convert/KWArgs.hs b/src/Convert/KWArgs.hs index 38f4508..d6821d7 100644 --- a/src/Convert/KWArgs.hs +++ b/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 diff --git a/src/Convert/NestPI.hs b/src/Convert/NestPI.hs index 461493d..132ff7e 100644 --- a/src/Convert/NestPI.hs +++ b/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 diff --git a/src/Convert/Struct.hs b/src/Convert/Struct.hs index 6f40203..6c9629d 100644 --- a/src/Convert/Struct.hs +++ b/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 [] diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs index 329744f..9b26e7d 100644 --- a/src/Convert/Traverse.hs +++ b/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 diff --git a/src/Convert/Typedef.hs b/src/Convert/Typedef.hs index b58125d..b87cb3e 100644 --- a/src/Convert/Typedef.hs +++ b/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 diff --git a/src/Language/SystemVerilog/AST/Expr.hs b/src/Language/SystemVerilog/AST/Expr.hs index 1f54314..264ff4c 100644 --- a/src/Language/SystemVerilog/AST/Expr.hs +++ b/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 diff --git a/src/Language/SystemVerilog/AST/Stmt.hs b/src/Language/SystemVerilog/AST/Stmt.hs index 0562e3f..ebec897 100644 --- a/src/Language/SystemVerilog/AST/Stmt.hs +++ b/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) diff --git a/src/Language/SystemVerilog/AST/Type.hs b/src/Language/SystemVerilog/AST/Type.hs index ae3393e..4f5ca13 100644 --- a/src/Language/SystemVerilog/AST/Type.hs +++ b/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) diff --git a/src/Language/SystemVerilog/Parser/Parse.y b/src/Language/SystemVerilog/Parser/Parse.y index acce7d0..1d66c15 100644 --- a/src/Language/SystemVerilog/Parser/Parse.y +++ b/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 diff --git a/src/Language/SystemVerilog/Parser/ParseDecl.hs b/src/Language/SystemVerilog/Parser/ParseDecl.hs index 4800ef3..cf3bd5a 100644 --- a/src/Language/SystemVerilog/Parser/ParseDecl.hs +++ b/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])