Commit 3597f4a6 by Zachary Snow

support for methods (no conversion) and interface TFs

parent 39f0e9b4
......@@ -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 []
......
......@@ -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) =
......
......@@ -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
......
......@@ -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 ()
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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 }
......
......@@ -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
......
interface Foo;
function bar;
input integer x;
return x * x;
endfunction
endinterface
module top;
Foo foo();
initial $display(foo.bar(3));
endmodule
module top;
function bar;
input integer x;
bar = x * x;
endfunction
initial $display(bar(3));
endmodule
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment