From b95af2b6d12a19dad74ff68f5a55a9d4233602ee Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Mon, 4 Mar 2019 14:25:38 -0500 Subject: [PATCH] support for automatic functions --- src/Convert/Traverse.hs | 23 +++-- src/Language/SystemVerilog/AST.hs | 20 +++- src/Language/SystemVerilog/Parser/Lex.x | 3 + src/Language/SystemVerilog/Parser/Parse.y | 99 ++++++++++--------- .../SystemVerilog/Parser/ParseDecl.hs | 46 ++++++++- 5 files changed, 134 insertions(+), 57 deletions(-) diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs index a71a72e..ab827ed 100644 --- a/src/Convert/Traverse.hs +++ b/src/Convert/Traverse.hs @@ -104,8 +104,9 @@ traverseStmtsM mapper = moduleItemMapper where moduleItemMapper (AlwaysC kw stmt) = fullMapper stmt >>= return . AlwaysC kw - moduleItemMapper (Function ret name decls stmt) = - fullMapper stmt >>= return . Function ret name decls + moduleItemMapper (Function lifetime ret name decls stmts) = do + stmts' <- mapM fullMapper stmts + return $ Function lifetime ret name decls stmts' moduleItemMapper other = return $ other fullMapper = traverseNestedStmtsM mapper @@ -135,6 +136,7 @@ traverseNestedStmtsM mapper = fullMapper s2' <- fullMapper s2 return $ If e s1' s2' cs (Timing sense stmt) = fullMapper stmt >>= return . Timing sense + cs (Return expr) = return $ Return expr cs (Null) = return Null traverseStmtLHSsM :: Monad m => MapperM m LHS -> MapperM m Stmt @@ -245,6 +247,8 @@ traverseExprsM mapper = moduleItemMapper flatStmtMapper (If cc s1 s2) = exprMapper cc >>= \cc' -> return $ If cc' s1 s2 flatStmtMapper (Timing sense stmt) = return $ Timing sense stmt + flatStmtMapper (Return expr) = + exprMapper expr >>= return . Return flatStmtMapper (Null) = return Null portBindingMapper (p, me) = @@ -256,10 +260,10 @@ traverseExprsM mapper = moduleItemMapper exprMapper expr >>= return . Assign lhs moduleItemMapper (AlwaysC kw stmt) = stmtMapper stmt >>= return . AlwaysC kw - moduleItemMapper (Function ret f decls stmt) = do + moduleItemMapper (Function lifetime ret f decls stmts) = do decls' <- mapM declMapper decls - stmt' <- stmtMapper stmt - return $ Function ret f decls' stmt' + stmts' <- mapM stmtMapper stmts + return $ Function lifetime ret f decls' stmts' moduleItemMapper (Instance m params x ml) = do if ml == Nothing then return $ Instance m params x Nothing @@ -297,9 +301,9 @@ traverseDeclsM mapper item = do where miMapperA (MIDecl decl) = mapper decl >>= return . MIDecl - miMapperA (Function t x decls s) = do + miMapperA (Function l t x decls s) = do decls' <- mapM mapper decls - return $ Function t x decls' s + return $ Function l t x decls' s miMapperA other = return other miMapperB (Block (Just (name, decls)) stmts) = do decls' <- mapM mapper decls @@ -313,7 +317,7 @@ collectDeclsM = collectify traverseDeclsM traverseTypesM :: Monad m => MapperM m Type -> MapperM m ModuleItem traverseTypesM mapper item = - traverseDeclsM declMapper item >>= traverseExprsM exprMapper + miMapper item >>= traverseDeclsM declMapper >>= traverseExprsM exprMapper where exprMapper (Cast t e) = do t' <- mapper t @@ -330,6 +334,9 @@ traverseTypesM mapper item = mapper t >>= \t' -> return $ Localparam t' x e declMapper (Variable d t x a me) = mapper t >>= \t' -> return $ Variable d t' x a me + miMapper (Function l t x d s) = + mapper t >>= \t' -> return $ Function l t' x d s + miMapper other = return other traverseTypes :: Mapper Type -> Mapper ModuleItem traverseTypes = unmonad traverseTypesM diff --git a/src/Language/SystemVerilog/AST.hs b/src/Language/SystemVerilog/AST.hs index 7fd844b..cc33931 100644 --- a/src/Language/SystemVerilog/AST.hs +++ b/src/Language/SystemVerilog/AST.hs @@ -16,6 +16,7 @@ module Language.SystemVerilog.AST , CaseKW (..) , PartKW (..) , Decl (..) + , Lifetime (..) , AST , PortBinding , ModportDecl @@ -150,7 +151,7 @@ data ModuleItem | AlwaysC AlwaysKW Stmt | Assign LHS Expr | Instance Identifier [PortBinding] Identifier (Maybe [PortBinding]) -- `Nothing` represents `.*` - | Function Type Identifier [Decl] Stmt + | Function (Maybe Lifetime) Type Identifier [Decl] [Stmt] | Genvar Identifier | Generate [GenItem] | Modport Identifier [ModportDecl] @@ -184,7 +185,7 @@ instance Show ModuleItem where Instance m params i ports | null params -> printf "%s %s%s;" m i (showMaybePorts ports) | otherwise -> printf "%s #%s %s%s;" m (showPorts params) i (showMaybePorts ports) - Function t x i b -> printf "function %s%s;\n%s\n%s\nendfunction" (showPad t) x (indent $ show i) (indent $ show b) + Function ml t x i b -> printf "function %s%s%s;\n%s\n%s\nendfunction" (showLifetime ml) (showPad t) x (indent $ show i) (indent $ unlines' $ map show b) Genvar x -> printf "genvar %s;" x Generate b -> printf "generate\n%s\nendgenerate" (indent $ unlines' $ map show b) Modport x l -> printf "modport %s(\n%s\n);" x (indent $ intercalate ",\n" $ map showModportDecl l) @@ -383,6 +384,7 @@ data Stmt | Asgn LHS Expr | If Expr Stmt Stmt | Timing Sense Stmt + | Return Expr | Null deriving Eq @@ -409,6 +411,7 @@ instance Show Stmt where show (Asgn v e) = printf "%s <= %s;" (show v) (show e) show (If a b Null) = printf "if (%s) %s" (show a) (show b) show (If a b c ) = printf "if (%s) %s\nelse %s" (show a) (show b) (show c) + show (Return e ) = printf "return %s;" (show e) show (Timing t s ) = printf "@(%s)%s" (show t) rest where rest = case s of @@ -466,3 +469,16 @@ instance Show GenItem where show (GenFor (x1, e1) c (x2, e2) x is) = printf "for (%s = %s; %s; %s = %s) %s" x1 (show e1) (show c) x2 (show e2) (show $ GenBlock (Just x) is) show GenNull = ";" show (GenModuleItem item) = show item + +data Lifetime + = Static + | Automatic + deriving (Eq, Ord) + +instance Show Lifetime where + show Static = "static" + show Automatic = "automatic" + +showLifetime :: Maybe Lifetime -> String +showLifetime Nothing = "" +showLifetime (Just l) = show l ++ " " diff --git a/src/Language/SystemVerilog/Parser/Lex.x b/src/Language/SystemVerilog/Parser/Lex.x index 845ff59..04fc01f 100644 --- a/src/Language/SystemVerilog/Parser/Lex.x +++ b/src/Language/SystemVerilog/Parser/Lex.x @@ -57,6 +57,7 @@ tokens :- "always_ff" { tok KW_always_ff } "always_latch" { tok KW_always_latch } "assign" { tok KW_assign } + "automatic" { tok KW_automatic } "begin" { tok KW_begin } "case" { tok KW_case } "casex" { tok KW_casex } @@ -91,6 +92,8 @@ tokens :- "parameter" { tok KW_parameter } "posedge" { tok KW_posedge } "reg" { tok KW_reg } + "return" { tok KW_return } + "static" { tok KW_static } "struct" { tok KW_struct } "typedef" { tok KW_typedef } "unique" { tok KW_unique } diff --git a/src/Language/SystemVerilog/Parser/Parse.y b/src/Language/SystemVerilog/Parser/Parse.y index d06499f..80e414c 100644 --- a/src/Language/SystemVerilog/Parser/Parse.y +++ b/src/Language/SystemVerilog/Parser/Parse.y @@ -22,6 +22,7 @@ import Language.SystemVerilog.Parser.Tokens "always_ff" { Token KW_always_ff _ _ } "always_latch" { Token KW_always_latch _ _ } "assign" { Token KW_assign _ _ } +"automatic" { Token KW_automatic _ _ } "begin" { Token KW_begin _ _ } "case" { Token KW_case _ _ } "casex" { Token KW_casex _ _ } @@ -56,6 +57,8 @@ import Language.SystemVerilog.Parser.Tokens "parameter" { Token KW_parameter _ _ } "posedge" { Token KW_posedge _ _ } "reg" { Token KW_reg _ _ } +"return" { Token KW_return _ _ } +"static" { Token KW_static _ _ } "struct" { Token KW_struct _ _ } "typedef" { Token KW_typedef _ _ } "unique" { Token KW_unique _ _ } @@ -259,10 +262,12 @@ Identifiers :: { [Identifier] } -- uses delimiter propagation hack to avoid conflicts DeclTokens(delim) :: { [DeclToken] } - : DeclToken delim { [$1] } - | DeclToken DeclTokens(delim) { [$1] ++ $2 } - | "=" Expr "," DeclTokens(delim) { [DTAsgn $2, DTComma] ++ $4 } - | "=" Expr delim { [DTAsgn $2] } + : DeclToken delim { [$1] } + | DeclToken DeclTokens(delim) { [$1] ++ $2 } + | "=" Expr "," DeclTokens(delim) { [DTAsgn $2, DTComma] ++ $4 } + | "<=" Expr "," DeclTokens(delim) { [DTAsgnNBlk $2, DTComma] ++ $4 } + | "=" Expr delim { [DTAsgn $2] } + | "<=" Expr delim { [DTAsgnNBlk $2] } DeclToken :: { DeclToken } : "," { DTComma } | Range { DTRange $1 } @@ -272,6 +277,9 @@ DeclToken :: { DeclToken } | ModuleInstantiation { DTInstance $1 } | PartialType { DTType $1 } | Identifier "." Identifier { DTType $ InterfaceT $1 (Just $3) } + | "[" Expr "]" { DTBit $2 } + | "{" LHSs "}" { DTConcat $2 } + -- | LHS "." Identifier { LHSDot $1 $3 } VariablePortIdentifiers :: { [(Identifier, Maybe Expr)] } : VariablePortIdentifier { [$1] } @@ -294,14 +302,17 @@ ModuleItem :: { [ModuleItem] } : DeclTokens(";") { parseDTsAsModuleItems $1 } | "parameter" ParamType DeclAsgns ";" { map MIDecl $ map (uncurry $ Parameter $2) $3 } | "localparam" ParamType DeclAsgns ";" { map MIDecl $ map (uncurry $ Localparam $2) $3 } - | "assign" LHS "=" Expr ";" { [Assign $2 $4] } - | AlwaysKW Stmt { [AlwaysC $1 $2] } - | "function" Identifier FunctionItems Stmt "endfunction" opt(Tag) { [Function (Implicit []) $2 $3 $4] } - | "function" DimensionsNonEmpty Identifier FunctionItems Stmt "endfunction" opt(Tag) { [Function (Implicit $2) $3 $4 $5] } - | "function" Type Identifier FunctionItems Stmt "endfunction" opt(Tag) { [Function $2 $3 $4 $5] } - | "genvar" Identifiers ";" { map Genvar $2 } - | "generate" GenItems "endgenerate" { [Generate $2] } - | "modport" ModportItems ";" { map (uncurry Modport) $2 } + | "assign" LHS "=" Expr ";" { [Assign $2 $4] } + | AlwaysKW Stmt { [AlwaysC $1 $2] } + | "genvar" Identifiers ";" { map Genvar $2 } + | "generate" GenItems "endgenerate" { [Generate $2] } + | "modport" ModportItems ";" { map (uncurry Modport) $2 } + | "function" opt(Lifetime) FuncRetAndName FunctionItems DeclsAndStmts "endfunction" opt(Tag) { [Function $2 (fst $3) (snd $3) ($4 ++ fst $5) (snd $5)] } + +FuncRetAndName :: { (Type, Identifier) } + : {- empty -} Identifier { (Implicit [], $1) } + | DimensionsNonEmpty Identifier { (Implicit $1, $2) } + | Type Identifier { ($1 , $2) } AlwaysKW :: { AlwaysKW } : "always" { Always } @@ -309,13 +320,17 @@ AlwaysKW :: { AlwaysKW } | "always_ff" { AlwaysFF } | "always_latch" { AlwaysLatch } +Lifetime :: { Lifetime } + : "static" { Static } + | "automatic" { Automatic } + ModuleInstantiation :: { (Identifier, Maybe [PortBinding]) } : Identifier "(" Bindings ")" { ($1, Just $3) } | Identifier "(" ".*" ")" { ($1, Nothing) } FunctionItems :: { [Decl] } - : "(" DeclTokens(")") ";" BlockItemDeclarations { (parseDTsAsDecls $2) ++ $4 } - | ";" BlockItemDeclarations { $2 } + : "(" DeclTokens(")") ";" { map makeInput $ parseDTsAsDecls $2 } + | ";" { [] } ParamType :: { Type } : Dimensions { Implicit $1 } @@ -328,13 +343,6 @@ EventControl :: { Sense } | "@" "*" { SenseStar } | "@*" { SenseStar } -VariableIdentifiers :: { [(Identifier, [Range], Maybe Expr)] } - : VariableType { [$1] } - | VariableIdentifiers "," VariableType { $1 ++ [$3] } -VariableType :: { (Identifier, [Range], Maybe Expr) } - : Identifier Dimensions { ($1, $2, Nothing) } - | Identifier Dimensions "=" Expr { ($1, $2, Just $4) } - Dimensions :: { [Range] } : {- empty -} { [] } | DimensionsNonEmpty { $1 } @@ -390,34 +398,28 @@ Stmts :: { [Stmt] } | Stmts Stmt { $1 ++ [$2] } Stmt :: { Stmt } + : StmtNonAsgn { $1 } + | LHS "=" Expr ";" { AsgnBlk $1 $3 } + | LHS "<=" Expr ";" { Asgn $1 $3 } +StmtNonAsgn :: { Stmt } : ";" { Null } - | "begin" Stmts "end" { Block Nothing $2 } - | "begin" ":" Identifier BlockItemDeclarations Stmts "end" { Block (Just ($3, $4)) $5 } - | "if" "(" Expr ")" Stmt "else" Stmt { If $3 $5 $7 } - | "if" "(" Expr ")" Stmt %prec NoElse { If $3 $5 Null } + | "begin" Stmts "end" { Block Nothing $2 } + | "begin" ":" Identifier DeclsAndStmts "end" { Block (Just ($3, fst $4)) (snd $4) } + | "if" "(" Expr ")" Stmt "else" Stmt { If $3 $5 $7 } + | "if" "(" Expr ")" Stmt %prec NoElse { If $3 $5 Null } | "for" "(" Identifier "=" Expr ";" Expr ";" Identifier "=" Expr ")" Stmt { For ($3, $5) $7 ($9, $11) $13 } - | LHS "=" Expr ";" { AsgnBlk $1 $3 } - | LHS "<=" Expr ";" { Asgn $1 $3 } | CaseKW "(" Expr ")" Cases opt(CaseDefault) "endcase" { Case $1 $3 $5 $6 } - | EventControl Stmt { Timing $1 $2 } + | EventControl Stmt { Timing $1 $2 } + | "return" Expr ";" { Return $2 } -BlockItemDeclarations :: { [Decl] } - : {- empty -} { [] } - | BlockItemDeclarations BlockItemDeclaration { $1 ++ $2 } -BlockItemDeclaration :: { [Decl] } - : "reg" Dimensions BlockVariableIdentifiers ";" { map (\(x, rs) -> Variable Local (Reg $2) x rs Nothing) $3 } - | "parameter" ParamType DeclAsgns ";" { map (uncurry $ Parameter $2) $3 } - | "localparam" ParamType DeclAsgns ";" { map (uncurry $ Localparam $2) $3 } - | "integer" VariableIdentifiers ";" { map (\(x, a, e) -> Variable Local IntegerT x a e) $2 } - | "input" Dimensions Identifiers ";" { map (\x -> Variable Input (Implicit $2) x [] Nothing) $3 } - | "input" "reg" Dimensions Identifiers ";" { map (\x -> Variable Input (Reg $3) x [] Nothing) $4 } - | "input" "integer" Identifiers ";" { map (\x -> Variable Input IntegerT x [] Nothing) $3 } - -BlockVariableIdentifiers :: { [(Identifier, [Range])] } - : BlockVariableType { [$1] } - | BlockVariableIdentifiers "," BlockVariableType { $1 ++ [$3] } -BlockVariableType :: { (Identifier, [Range]) } - : Identifier Dimensions { ($1, $2) } +DeclsAndStmts :: { ([Decl], [Stmt]) } + : DeclOrStmt DeclsAndStmts { combineDeclsAndStmts $1 $2 } + | StmtNonAsgn Stmts { ([], $1 : $2) } + | {- empty -} { ([], []) } +DeclOrStmt :: { ([Decl], [Stmt]) } + : DeclTokens(";") { parseDTsAsDeclOrAsgn $1 } + | "parameter" ParamType DeclAsgns ";" { (map (uncurry $ Parameter $2) $3, []) } + | "localparam" ParamType DeclAsgns ";" { (map (uncurry $ Localparam $2) $3, []) } CaseKW :: { CaseKW } -- We just drop the unique keyword, for now. In the future, we should add it @@ -548,4 +550,11 @@ genItemsToGenItem [] = error "genItemsToGenItem given empty list!" genItemsToGenItem [x] = x genItemsToGenItem xs = GenBlock Nothing xs +combineDeclsAndStmts :: ([Decl], [Stmt]) -> ([Decl], [Stmt]) -> ([Decl], [Stmt]) +combineDeclsAndStmts (a1, b1) (a2, b2) = (a1 ++ a2, b1 ++ b2) + +makeInput :: Decl -> Decl +makeInput (Variable _ t x a me) = Variable Input t x a me +makeInput other = error $ "unexpected non-var decl: " ++ (show other) + } diff --git a/src/Language/SystemVerilog/Parser/ParseDecl.hs b/src/Language/SystemVerilog/Parser/ParseDecl.hs index d92ae26..8dc8ba6 100644 --- a/src/Language/SystemVerilog/Parser/ParseDecl.hs +++ b/src/Language/SystemVerilog/Parser/ParseDecl.hs @@ -35,6 +35,7 @@ module Language.SystemVerilog.Parser.ParseDecl , parseDTsAsModuleItems , parseDTsAsDecls , parseDTsAsDecl +, parseDTsAsDeclOrAsgn ) where import Data.List (findIndices) @@ -46,12 +47,15 @@ import Language.SystemVerilog.AST data DeclToken = DTComma | DTAsgn Expr + | DTAsgnNBlk Expr | DTRange Range | DTIdent Identifier | DTDir Direction | DTType ([Range] -> Type) | DTParams [PortBinding] | DTInstance (Identifier, Maybe [PortBinding]) + | DTBit Expr + | DTConcat [LHS] deriving (Show, Eq) @@ -136,6 +140,39 @@ parseDTsAsDecl tokens = where components = parseDTsAsComponents tokens +-- [PUBLIC]: parser for single block item declarations of assign statetments +parseDTsAsDeclOrAsgn :: [DeclToken] -> ([Decl], [Stmt]) +parseDTsAsDeclOrAsgn tokens = + if any isAsgnToken tokens || tripLookahead tokens + then ([], [constructor lhs expr]) + else (parseDTsAsDecl tokens, []) + where + (constructor, expr) = case last tokens of + DTAsgn e -> (AsgnBlk, e) + DTAsgnNBlk e -> (Asgn , e) + _ -> error $ "invalid block item decl or stmt: " ++ (show tokens) + (lhs, []) = takeLHS $ init tokens + isAsgnToken :: DeclToken -> Bool + isAsgnToken (DTBit _) = True + isAsgnToken (DTConcat _) = True + isAsgnToken _ = False + +-- TODO: It looks like our LHS type doesn't represent the full set of possible +-- LHSs, i.e., `foo[0][0]` isn't representable. When this is addressed, we'll +-- have to take another pass at this function. It will probably need to be +-- recursive. +takeLHS :: [DeclToken] -> (LHS, [DeclToken]) +takeLHS (DTConcat lhss : rest) = (LHSConcat lhss, rest) +takeLHS (DTIdent x : DTBit e : rest) = (LHSBit x e , rest) +takeLHS (DTIdent x : DTRange r : rest) = (LHSRange x r , rest) +takeLHS (DTIdent x : rest) = (LHS x , rest) +takeLHS (DTType tf : rest) = + case tf [] of + InterfaceT x (Just y) [] -> (LHSDot (LHS x) y, rest) + _ -> error $ "unexpected type in assignment: " ++ (show tf) +takeLHS tokens = error $ "missing LHS in assignment: " ++ (show tokens) + + -- batches together seperate declaration lists type Triplet = (Identifier, [Range], Maybe Expr) type Component = (Direction, Type, [Triplet]) @@ -207,9 +244,14 @@ takeRanges (DTRange r : rest) = (r : rs, rest') where (rs, rest') = takeRanges rest takeRanges rest = ([], rest) +-- TODO: entrypoints besides `parseDTsAsDeclOrAsgn` should disallow `DTAsgnNBlk` +-- Note: matching DTAsgnNBlk too is a bit of a hack to allow for tripLookahead +-- to work both for standard declarations and in `parseDTsAsDeclOrAsgn`, where +-- we're checking for an assignment takeAsgn :: [DeclToken] -> (Maybe Expr, [DeclToken]) -takeAsgn (DTAsgn e : rest) = (Just e , rest) -takeAsgn rest = (Nothing, rest) +takeAsgn (DTAsgn e : rest) = (Just e , rest) +takeAsgn (DTAsgnNBlk e : rest) = (Just e , rest) +takeAsgn rest = (Nothing, rest) takeComma :: [DeclToken] -> (Bool, [DeclToken]) takeComma [] = (False, [])