diff --git a/src/Convert/EmptyArgs.hs b/src/Convert/EmptyArgs.hs index 1b727eb..662b609 100644 --- a/src/Convert/EmptyArgs.hs +++ b/src/Convert/EmptyArgs.hs @@ -46,8 +46,8 @@ traverseFunctionsM (MIPackageItem (Function ml t f decls stmts)) = do traverseFunctionsM other = return other convertExpr :: Idents -> Expr -> Expr -convertExpr functions (Call Nothing func (Args [] [])) = - Call Nothing func (Args args []) +convertExpr functions (Call (Ident func) (Args [] [])) = + Call (Ident func) (Args args []) where args = if Set.member func functions then [Just $ Number "0"] else [] diff --git a/src/Convert/Interface.hs b/src/Convert/Interface.hs index eef569f..ba9ca66 100644 --- a/src/Convert/Interface.hs +++ b/src/Convert/Interface.hs @@ -186,6 +186,7 @@ convertDescription _ _ other = other -- add a prefix to all standard identifiers in a module item prefixModuleItems :: Identifier -> ModuleItem -> ModuleItem prefixModuleItems prefix = + prefixMIPackageItem . traverseDecls prefixDecl . traverseExprs (traverseNestedExprs prefixExpr) . traverseLHSs (traverseNestedLHSs prefixLHS ) @@ -200,6 +201,19 @@ prefixModuleItems prefix = prefixLHS :: LHS -> LHS prefixLHS (LHSIdent x) = LHSIdent (prefix ++ x) prefixLHS other = other + prefixMIPackageItem (MIPackageItem item) = + MIPackageItem $ prefixPackageItem prefix item + prefixMIPackageItem other = other + +-- add a prefix to all standard identifiers in a package item +prefixPackageItem :: Identifier -> PackageItem -> PackageItem +prefixPackageItem prefix (Function lifetime t x decls stmts) = + Function lifetime t x' decls stmts + where x' = prefix ++ x +prefixPackageItem prefix (Task lifetime x decls stmts) = + Task lifetime x' decls stmts + where x' = prefix ++ x +prefixPackageItem _ other = other lookupType :: [ModuleItem] -> Expr -> (Type, [Range]) lookupType items (Ident ident) = diff --git a/src/Convert/KWArgs.hs b/src/Convert/KWArgs.hs index d6821d7..dfe5173 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 Nothing _ (Args _ []))) = orig -convertExpr tfs (Call Nothing func (Args pnArgs kwArgs)) = +convertExpr _ (orig @ (Call _ (Args _ []))) = orig +convertExpr tfs (Call (Ident func) (Args pnArgs kwArgs)) = case tfs Map.!? func of - Nothing -> Call Nothing func (Args pnArgs kwArgs) - Just ordered -> Call Nothing func (Args args []) + Nothing -> Call (Ident func) (Args pnArgs kwArgs) + Just ordered -> Call (Ident 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 253db10..80365be 100644 --- a/src/Convert/NestPI.hs +++ b/src/Convert/NestPI.hs @@ -82,12 +82,12 @@ collectPIsM _ = return () -- writes down the names of subroutine invocations collectSubroutinesM :: Stmt -> Writer Idents () -collectSubroutinesM (Subroutine Nothing f _) = tell $ Set.singleton f +collectSubroutinesM (Subroutine (Ident f) _) = tell $ Set.singleton f collectSubroutinesM _ = return () -- writes down the names of function calls and identifiers collectIdentsM :: Expr -> Writer Idents () -collectIdentsM (Call Nothing x _) = tell $ Set.singleton x +collectIdentsM (Call (Ident x) _) = tell $ Set.singleton x collectIdentsM (Ident x) = tell $ Set.singleton x collectIdentsM _ = return () diff --git a/src/Convert/Package.hs b/src/Convert/Package.hs index a7fa1c1..5998c4e 100644 --- a/src/Convert/Package.hs +++ b/src/Convert/Package.hs @@ -154,22 +154,14 @@ traverseModuleItem existingItemNames packages (MIPackageItem (Import x y)) = items = map snd $ filter (filterer . fst) $ packageItems traverseModuleItem _ _ item = (traverseExprs $ traverseNestedExprs traverseExpr) $ - (traverseStmts traverseStmt) $ (traverseTypes $ traverseNestedTypes traverseType) $ item where traverseExpr :: Expr -> Expr traverseExpr (PSIdent x y) = Ident $ x ++ "_" ++ y - traverseExpr (Call (Just ps) f args) = - Call Nothing (ps ++ "_" ++ f) args traverseExpr other = other - traverseStmt :: Stmt -> Stmt - traverseStmt (Subroutine (Just ps) f args) = - Subroutine Nothing (ps ++ "_" ++ f) args - traverseStmt other = other - traverseType :: Type -> Type traverseType (Alias (Just ps) xx rs) = Alias Nothing (ps ++ "_" ++ xx) rs diff --git a/src/Convert/Simplify.hs b/src/Convert/Simplify.hs index e340841..3ee62b4 100644 --- a/src/Convert/Simplify.hs +++ b/src/Convert/Simplify.hs @@ -56,13 +56,13 @@ convertExpr info (DimFn f v e) = DimFn f v e' where e' = simplify $ substitute info e -convertExpr info (Call Nothing "$clog2" (Args [Just e] [])) = +convertExpr info (Call (Ident "$clog2") (Args [Just e] [])) = if clog2' == clog2 then clog2 else clog2' where e' = simplify $ substitute info e - clog2 = Call Nothing "$clog2" (Args [Just e'] []) + clog2 = Call (Ident "$clog2") (Args [Just e'] []) clog2' = simplify clog2 convertExpr info (Mux cc aa bb) = if before == after diff --git a/src/Convert/SizeCast.hs b/src/Convert/SizeCast.hs index eefca79..b5566de 100644 --- a/src/Convert/SizeCast.hs +++ b/src/Convert/SizeCast.hs @@ -65,7 +65,7 @@ traverseExprM = lift $ tell $ Set.singleton (s, sg) let f = castFnName s sg let args = Args [Just e] [] - return $ Call Nothing f args + return $ Call (Ident f) args _ -> return $ Cast (Right s) e convertExprM other = return other diff --git a/src/Convert/Struct.hs b/src/Convert/Struct.hs index 2f74cab..622d054 100644 --- a/src/Convert/Struct.hs +++ b/src/Convert/Struct.hs @@ -51,10 +51,10 @@ convertDescription (description @ Part{}) = traverseExprsM traverseExprM >>= traverseAsgnsM traverseAsgnM traverseStmtM :: Stmt -> State Types Stmt - traverseStmtM (Subroutine Nothing f args) = do + traverseStmtM (Subroutine expr args) = do stateTypes <- get - return $ uncurry (Subroutine Nothing) $ - convertCall structs stateTypes f args + return $ Subroutine expr $ + convertCall structs stateTypes expr args traverseStmtM stmt = traverseStmtLHSsM traverseLHSM stmt >>= traverseStmtExprsM traverseExprM >>= @@ -152,7 +152,7 @@ convertType structs t1 = -- writes down the names of called functions collectCallsM :: Expr -> Writer Idents () -collectCallsM (Call Nothing f _) = tell $ Set.singleton f +collectCallsM (Call (Ident f) _) = tell $ Set.singleton f collectCallsM _ = return () collectTFArgsM :: ModuleItem -> Writer Types () @@ -328,8 +328,8 @@ convertAsgn structs types (lhs, expr) = show (Set.toList extraNames) ++ " that are not in " ++ show structTf else if Map.member structTf structs then - Call Nothing - (packerFnName structTf) + Call + (Ident $ packerFnName structTf) (Args (map (Just . snd) items) []) else Pattern items @@ -464,14 +464,15 @@ convertAsgn structs types (lhs, expr) = (_, []) -> Implicit Unspecified [] (tf, rs) -> tf $ tail rs (_, i') = convertSubExpr i - convertSubExpr (Call Nothing f args) = - (retType, uncurry (Call Nothing) $ convertCall structs types f args) + convertSubExpr (Call e args) = + (retType, Call e $ convertCall structs types e' args) where - retType = case Map.lookup f types of - Nothing -> Implicit Unspecified [] - Just t -> t - convertSubExpr (Call (Just x) f args) = - (Implicit Unspecified [], Call (Just x) f args) + (_, e') = convertSubExpr e + retType = case e' of + Ident f -> case Map.lookup f types of + Nothing -> Implicit Unspecified [] + Just t -> t + _ -> Implicit Unspecified [] convertSubExpr (String s) = (Implicit Unspecified [], String s) convertSubExpr (Number n) = (Implicit Unspecified [], Number n) convertSubExpr (Time n) = (Implicit Unspecified [], Time n) @@ -536,10 +537,13 @@ convertAsgn structs types (lhs, expr) = where fieldMap = Map.fromList $ map swap fields -- attempts to convert based on the assignment-like contexts of TF arguments -convertCall :: Structs -> Types -> Identifier -> Args -> (Identifier, Args) -convertCall structs types f (Args pnArgs kwArgs) = - (f, args) +convertCall :: Structs -> Types -> Expr -> Args -> Args +convertCall structs types fn (Args pnArgs kwArgs) = + case fn of + Ident _ -> args + _ -> Args pnArgs kwArgs where + Ident f = fn idxs = map show ([0..] :: [Int]) args = Args (map snd $ map convertArg $ zip idxs pnArgs) diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs index 3fe851f..284d97e 100644 --- a/src/Convert/Traverse.hs +++ b/src/Convert/Traverse.hs @@ -257,7 +257,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 ps f exprs) = return $ Subroutine ps f exprs + cs (Subroutine expr exprs) = return $ Subroutine expr exprs cs (Trigger blocks x) = return $ Trigger blocks x cs (Assertion a) = traverseAssertionStmtsM fullMapper a >>= return . Assertion @@ -455,11 +455,12 @@ traverseNestedExprsM mapper = exprMapper e' <- exprMapper e l' <- mapM exprMapper l return $ Stream o e' l' - em (Call ps f (Args l p)) = do + em (Call e (Args l p)) = do + e' <- exprMapper e l' <- mapM maybeExprMapper l pes <- mapM maybeExprMapper $ map snd p let p' = zip (map fst p) pes - return $ Call ps f (Args l' p') + return $ Call e' (Args l' p') em (UniOp o e) = exprMapper e >>= return . UniOp o em (BinOp o e1 e2) = do @@ -711,11 +712,12 @@ 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 ps f (Args l p)) = do + flatStmtMapper (Subroutine e (Args l p)) = do + e' <- exprMapper e l' <- mapM maybeExprMapper l pes <- mapM maybeExprMapper $ map snd p let p' = zip (map fst p) pes - return $ Subroutine ps f (Args l' p') + return $ Subroutine e' (Args l' p') flatStmtMapper (Return expr) = exprMapper expr >>= return . Return flatStmtMapper (Trigger blocks x) = return $ Trigger blocks x diff --git a/src/Language/SystemVerilog/AST/Expr.hs b/src/Language/SystemVerilog/AST/Expr.hs index 4f54a1f..d9e5de0 100644 --- a/src/Language/SystemVerilog/AST/Expr.hs +++ b/src/Language/SystemVerilog/AST/Expr.hs @@ -46,7 +46,7 @@ data Expr | Repeat Expr [Expr] | Concat [Expr] | Stream StreamOp Expr [Expr] - | Call (Maybe Identifier) Identifier Args + | Call Expr Args | UniOp UniOp Expr | BinOp BinOp Expr Expr | Mux Expr Expr Expr @@ -75,7 +75,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 ps f l) = printf "%s%s%s" (maybe "" (++ "::") ps) f (show l) + show (Call e l ) = printf "%s%s" (show e) (show l) show (Cast tore e ) = printf "%s'(%s)" (showEither tore) (show e) show (DimsFn f v ) = printf "%s(%s)" (show f) (showEither v) show (DimFn f v e) = printf "%s(%s, %s)" (show f) (showEither v) (show e) @@ -184,7 +184,7 @@ simplify (orig @ (Repeat (Number n) exprs)) = simplify (Concat [expr]) = expr simplify (Concat exprs) = Concat $ filter (/= Concat []) exprs -simplify (orig @ (Call Nothing "$clog2" (Args [Just (Number n)] []))) = +simplify (orig @ (Call (Ident "$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 6a2dd87..4815f2a 100644 --- a/src/Language/SystemVerilog/AST/Stmt.hs +++ b/src/Language/SystemVerilog/AST/Stmt.hs @@ -48,7 +48,7 @@ data Stmt | If (Maybe UniquePriority) Expr Stmt Stmt | Timing Timing Stmt | Return Expr - | Subroutine (Maybe Identifier) Identifier Args + | Subroutine Expr Args | Trigger Bool Identifier | Assertion Assertion | Continue @@ -84,7 +84,7 @@ instance Show Stmt where where showInit (l, e) = showAssign (l, AsgnOpEq, e) showAssign :: (LHS, AsgnOp, Expr) -> String showAssign (l, op, e) = printf "%s %s %s" (show l) (show op) (show e) - show (Subroutine ps x a) = printf "%s%s%s;" (maybe "" (++ "::") ps) x aStr + show (Subroutine e a) = printf "%s%s;" (show e) aStr where aStr = if a == Args [] [] then "" else 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) diff --git a/src/Language/SystemVerilog/Parser/Parse.y b/src/Language/SystemVerilog/Parser/Parse.y index 357b214..7796e2d 100644 --- a/src/Language/SystemVerilog/Parser/Parse.y +++ b/src/Language/SystemVerilog/Parser/Parse.y @@ -592,7 +592,6 @@ DeclTokens(delim) :: { [DeclToken] } DeclToken :: { DeclToken } : DeclOrStmtToken { $1 } | ParameterBindings { DTParams $1 } - | PortBindings { DTInstance $1 } DeclOrStmtTokens(delim) :: { [DeclToken] } : DeclOrStmtToken delim { [$1] } @@ -612,6 +611,7 @@ DeclOrStmtToken :: { DeclToken } | LHSConcat { DTConcat $1 } | PartialType { DTType $1 } | "." Identifier { DTDot $2 } + | PortBindings { DTInstance $1 } | Signing { DTSigning $1 } | Lifetime { DTLifetime $1 } | Identifier "::" Identifier { DTPSIdent $1 $3 } @@ -904,8 +904,8 @@ StmtAsgn :: { Stmt } : LHS AsgnOp Expr ";" { AsgnBlk $2 $1 $3 } | LHS IncOrDecOperator ";" { AsgnBlk (AsgnOp $2) $1 (Number "1") } | LHS "<=" opt(DelayOrEventControl) Expr ";" { Asgn $3 $1 $4 } - | Identifier ";" { Subroutine (Nothing) $1 (Args [] []) } - | Identifier "::" Identifier ";" { Subroutine (Just $1) $3 (Args [] []) } + | LHS ";" { Subroutine (lhsToExpr $1) (Args [] []) } + | LHS CallArgs ";" { Subroutine (lhsToExpr $1) $2 } StmtNonAsgn :: { Stmt } : StmtBlock(BlockKWSeq, "end" ) { $1 } | StmtBlock(BlockKWPar, "join") { $1 } @@ -920,8 +920,6 @@ StmtNonBlock :: { Stmt } | Unique "if" "(" Expr ")" Stmt %prec NoElse { If $1 $4 $6 Null } | "for" "(" ForInit ForCond ForStep ")" Stmt { For $3 $4 $5 $7 } | Unique CaseKW "(" Expr ")" Cases "endcase" { Case $1 $2 $4 (fst $6) (snd $6) } - | Identifier CallArgs ";" { Subroutine (Nothing) $1 $2 } - | Identifier "::" Identifier CallArgs ";" { Subroutine (Just $1) $3 $4 } | TimingControl Stmt { Timing $1 $2 } | "return" Expr ";" { Return $2 } | "return" ";" { Return Nil } @@ -1102,8 +1100,7 @@ Expr :: { Expr } | String { String $1 } | Number { Number $1 } | Time { Time $1 } - | Identifier CallArgs { Call (Nothing) $1 $2 } - | Identifier "::" Identifier CallArgs { Call (Just $1) $3 $4 } + | Expr CallArgs { Call $1 $2 } | DimsFn "(" TypeOrExpr ")" { DimsFn $1 $3 } | DimFn "(" TypeOrExpr ")" { DimFn $1 $3 (Number "1") } | DimFn "(" TypeOrExpr "," Expr ")" { DimFn $1 $3 $5 } diff --git a/src/Language/SystemVerilog/Parser/ParseDecl.hs b/src/Language/SystemVerilog/Parser/ParseDecl.hs index d2cc208..9f01e7c 100644 --- a/src/Language/SystemVerilog/Parser/ParseDecl.hs +++ b/src/Language/SystemVerilog/Parser/ParseDecl.hs @@ -38,8 +38,8 @@ module Language.SystemVerilog.Parser.ParseDecl , parseDTsAsDeclsOrAsgns ) where -import Data.List (elemIndex, findIndex, findIndices) -import Data.Maybe (fromJust, mapMaybe) +import Data.List (elemIndex, findIndex, findIndices, partition) +import Data.Maybe (mapMaybe) import Language.SystemVerilog.AST @@ -202,22 +202,34 @@ 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 (Nothing) f (Args [] [])]) -parseDTsAsDeclOrAsgn [DTPSIdent p f] = ([], [Subroutine (Just p) f (Args [] [])]) +parseDTsAsDeclOrAsgn [DTIdent f] = ([], [Subroutine (Ident f) (Args [] [])]) +parseDTsAsDeclOrAsgn [DTPSIdent p f] = ([], [Subroutine (PSIdent p f) (Args [] [])]) parseDTsAsDeclOrAsgn tokens = - if (isAsgn (last tokens) || tripLookahead tokens) && lhs /= Nothing - then ([], [constructor (fromJust lhs) expr]) + if (isStmt (last tokens) || tripLookahead tokens) && maybeLhs /= Nothing + then ([], [stmt]) else (parseDTsAsDecl tokens, []) where - (constructor, expr) = case last tokens of - DTAsgn op e -> (AsgnBlk op, e) - DTAsgnNBlk mt e -> (Asgn mt, e) + stmt = case last tokens of + DTAsgn op e -> AsgnBlk op lhs e + DTAsgnNBlk mt e -> Asgn mt lhs e + DTInstance args -> Subroutine (lhsToExpr lhs) (instanceToArgs args) _ -> error $ "invalid block item decl or stmt: " ++ (show tokens) - lhs = takeLHS $ init tokens - isAsgn :: DeclToken -> Bool - isAsgn (DTAsgnNBlk _ _) = True - isAsgn (DTAsgn _ _) = True - isAsgn _ = False + maybeLhs = takeLHS $ init tokens + Just lhs = maybeLhs + isStmt :: DeclToken -> Bool + isStmt (DTAsgnNBlk{}) = True + isStmt (DTAsgn{}) = True + isStmt (DTInstance{}) = True + isStmt _ = False + +-- converts port bindings to call args +instanceToArgs :: [PortBinding] -> Args +instanceToArgs bindings = + Args pnArgs kwArgs + where + (pnBindings, kwBindings) = partition (null . fst) bindings + pnArgs = map snd pnBindings + kwArgs = kwBindings -- [PUBLIC]: parser for comma-separated declarations or assignment lists; this -- is only used for `for` loop initialization lists diff --git a/test/basic/interface_func.sv b/test/basic/interface_func.sv new file mode 100644 index 0000000..c8dca05 --- /dev/null +++ b/test/basic/interface_func.sv @@ -0,0 +1,11 @@ +interface Foo; + function bar; + input integer x; + return x * x; + endfunction +endinterface + +module top; + Foo foo(); + initial $display(foo.bar(3)); +endmodule diff --git a/test/basic/interface_func.v b/test/basic/interface_func.v new file mode 100644 index 0000000..2004673 --- /dev/null +++ b/test/basic/interface_func.v @@ -0,0 +1,7 @@ +module top; + function bar; + input integer x; + bar = x * x; + endfunction + initial $display(bar(3)); +endmodule