support for automatic functions

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

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 ++ " "

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     }

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     _ _ }
@@ -262,7 +265,9 @@ DeclTokens(delim) :: { [DeclToken] }
   : 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] }
@@ -296,12 +304,15 @@ ModuleItem :: { [ModuleItem] }
   | "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 }
+  | "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 }
+  | "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 }
+  | "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)
+
 }

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,8 +244,13 @@ 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 (DTAsgnNBlk e : rest) = (Just e , rest)
 takeAsgn                 rest  = (Nothing, rest)
 
 takeComma :: [DeclToken] -> (Bool, [DeclToken])