luke
/
sv2v
mirror of https://github.com/zachjs/sv2v.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

added language support for package-scoped calls and typenames

This commit is contained in:
Zachary Snow 2019-04-24 03:37:47 -04:00
parent 9373f3049a
commit bc23aebc55
10 changed files with 58 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Convert/KWArgs.hs
View File

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

8
src/Convert/NestPI.hs
View File

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

19
src/Convert/Struct.hs
View File

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

12
src/Convert/Traverse.hs
View File

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

7
src/Convert/Typedef.hs
View File

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

8
src/Language/SystemVerilog/AST/Expr.hs
View File

@ -39,7 +39,7 @@ data Expr
| Bit Expr Expr | Bit Expr Expr
| Repeat Expr [Expr] | Repeat Expr [Expr]
| Concat [Expr] | Concat [Expr]
| Call Identifier Args | Call (Maybe Identifier) Identifier Args
| UniOp UniOp Expr | UniOp UniOp Expr
| BinOp BinOp Expr Expr | BinOp BinOp Expr Expr
| Mux Expr Expr Expr | Mux Expr Expr Expr
@ -52,7 +52,7 @@ data Expr
instance Show Expr where instance Show Expr where
show (Number str ) = str show (Number str ) = str
show (Ident 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 (String str ) = printf "\"%s\"" str
show (Bit e b ) = printf "%s[%s]" (show e) (show b) 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) 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 (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 (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 (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 (Cast tore e ) = printf "%s'(%s)" (showEither tore) (show e)
show (Bits tore ) = printf "$bits(%s)" (showEither tore) show (Bits tore ) = printf "$bits(%s)" (showEither tore)
show (Pattern l ) = show (Pattern l ) =
@ -121,7 +121,7 @@ readNumber n =
-- basic expression simplfication utility to help us generate nicer code in the -- basic expression simplfication utility to help us generate nicer code in the
-- common case of ranges like `[FOO-1:0]` -- common case of ranges like `[FOO-1:0]`
simplify :: Expr -> Expr simplify :: Expr -> Expr
simplify (orig @ (Call "$clog2" (Args [Just (Number n)] []))) = simplify (orig @ (Call Nothing "$clog2" (Args [Just (Number n)] []))) =
case readNumber n of case readNumber n of
Nothing -> orig Nothing -> orig
Just x -> Number $ show $ clog2 x Just x -> Number $ show $ clog2 x

4
src/Language/SystemVerilog/AST/Stmt.hs
View File

@ -46,7 +46,7 @@ data Stmt
| If (Maybe UniquePriority) Expr Stmt Stmt | If (Maybe UniquePriority) Expr Stmt Stmt
| Timing Timing Stmt | Timing Timing Stmt
| Return Expr | Return Expr
| Subroutine Identifier Args | Subroutine (Maybe Identifier) Identifier Args
| Trigger Identifier | Trigger Identifier
| Assertion Assertion | Assertion Assertion
| Null | Null
@ -79,7 +79,7 @@ instance Show Stmt where
showInit (Right (l, e)) = printf "%s = %s" (show l) (show e) showInit (Right (l, e)) = printf "%s = %s" (show l) (show e)
showAssign :: (LHS, AsgnOp, Expr) -> String showAssign :: (LHS, AsgnOp, Expr) -> String
showAssign (l, op, e) = printf "%s %s %s" (show l) (show op) (show e) 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 (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 (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) show (While e s) = printf "while (%s) %s" (show e) (show s)

6
src/Language/SystemVerilog/AST/Type.hs
View File

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

21
src/Language/SystemVerilog/Parser/Parse.y
View File

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

7
src/Language/SystemVerilog/Parser/ParseDecl.hs
View File

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