Skip to content

S
sv2v
Commit bc23aebc by Zachary Snow
Options

added language support for package-scoped calls and typenames

parent 9373f304
Showing with 58 additions and 46 deletions
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])
......
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