support for interfaces; new "declaration parser"

src/Convert/Enum.hs

@@ -28,12 +28,12 @@ defaultType :: Type
 defaultType = Logic [(Number "31", Number "0")]
 
 convertDescription :: Description -> Description
-convertDescription (description @ (Module _ _ _)) =
-    Module name ports (enumItems ++ items)
+convertDescription (description @ (Part _ _ _ _)) =
+    Part kw name ports (enumItems ++ items)
     where
         enumPairs = concat $ map (uncurry enumVals) $ Set.toList enums
         enumItems = map (\(x, v) -> MIDecl $ Localparam (Implicit []) x v) enumPairs
-        (Module name ports items, enums) = runWriter $
+        (Part kw name ports items, enums) = runWriter $
             traverseModuleItemsM (traverseTypesM traverseType) description
         traverseType :: Type -> Writer Enums Type
         traverseType (Enum t v r) = do

src/Convert/Logic.hs

@@ -43,4 +43,5 @@ regIdents (AlwaysC _ stmt) = collectStmtLHSsM idents stmt
         idents (LHSBit    vx _) = tell $ Set.singleton vx
         idents (LHSRange  vx _) = tell $ Set.singleton vx
         idents (LHSConcat lhss) = mapM idents lhss >>= \_ -> return ()
+        idents (LHSDot   lhs _) = idents lhs
 regIdents _ = return ()

src/Convert/PackedArray.hs

@@ -52,7 +52,7 @@ convert :: AST -> AST
 convert = traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
-convertDescription (description @ (Module _ ports _)) =
+convertDescription (description @ (Part _ _ ports _)) =
     hoistPortDecls $
     traverseModuleItems (flattenModuleItem info . rewriteModuleItem info) description
     where
@@ -99,13 +99,14 @@ collectLHS (LHS       i  ) = recordSeqUsage i
 collectLHS (LHSRange  i _) = recordSeqUsage i
 collectLHS (LHSBit    i _) = recordIdxUsage i
 collectLHS (LHSConcat lhss) = mapM collectLHS lhss >>= \_ -> return ()
+collectLHS (LHSDot  lhs _) = collectLHS lhs
 
 -- VCS doesn't like port declarations inside of `generate` blocks, so we hoist
 -- them out with this function. This obviously isn't ideal, but it's a
 -- relatively straightforward transformation, and testing in VCS is important.
 hoistPortDecls :: Description -> Description
-hoistPortDecls (Module name ports items) =
-    Module name ports (concat $ map explode items)
+hoistPortDecls (Part kw name ports items) =
+    Part kw name ports (concat $ map explode items)
     where
         explode :: ModuleItem -> [ModuleItem]
         explode (Generate genItems) =
@@ -260,6 +261,7 @@ rewriteModuleItem info =
         rewriteLHS (LHSBit   x e) = LHSBit   (rewriteAsgnIdent x) e
         rewriteLHS (LHSRange x r) = LHSRange (rewriteAsgnIdent x) r
         rewriteLHS (LHSConcat ls) = LHSConcat $ map rewriteLHS ls
+        rewriteLHS (LHSDot lhs x) = LHSDot (rewriteLHS lhs) x
 
         rewriteStmt :: Stmt -> Stmt
         rewriteStmt (AsgnBlk lhs expr) = convertAssignment AsgnBlk lhs expr

src/Convert/SplitPortDecl.hs

@@ -14,8 +14,8 @@ convert :: AST -> AST
 convert = traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
-convertDescription (Module name ports items) =
-    Module name ports (concat $ map splitPortDecl items)
+convertDescription (Part kw name ports items) =
+    Part kw name ports (concat $ map splitPortDecl items)
 convertDescription other = other
 
 splitPortDecl :: ModuleItem -> [ModuleItem]

src/Convert/StarPort.hs

@@ -18,7 +18,7 @@ convert descriptions =
     where
         modulePorts = execWriter $ collectDescriptionsM getPorts descriptions
         getPorts :: Description -> Writer (Map.Map Identifier [Identifier]) ()
-        getPorts (Module name ports _) = tell $ Map.singleton name ports
+        getPorts (Part Module name ports _) = tell $ Map.singleton name ports
         getPorts _ = return ()
 
         mapInstance :: ModuleItem -> ModuleItem

src/Convert/Traverse.hs

@@ -66,8 +66,8 @@ maybeDo _ Nothing = return Nothing
 maybeDo fun (Just val) = fun val >>= return . Just
 
 traverseModuleItemsM :: Monad m => MapperM m ModuleItem -> MapperM m Description
-traverseModuleItemsM mapper (Module name ports items) =
-    mapM fullMapper items >>= return . Module name ports
+traverseModuleItemsM mapper (Part kw name ports items) =
+    mapM fullMapper items >>= return . Part kw name ports
     where
         fullMapper (Generate genItems) =
             mapM genItemMapper genItems >>= mapper . Generate
@@ -269,6 +269,7 @@ traverseExprsM mapper = moduleItemMapper
     moduleItemMapper (Comment  x) = return $ Comment  x
     moduleItemMapper (Genvar   x) = return $ Genvar   x
     moduleItemMapper (Generate x) = return $ Generate x
+    moduleItemMapper (Modport x l) = return $ Modport x l
 
 traverseExprs :: Mapper Expr -> Mapper ModuleItem
 traverseExprs = unmonad traverseExprsM

src/Convert/Typedef.hs

@@ -40,6 +40,7 @@ resolveType _ (Wire     rs) = Wire     rs
 resolveType _ (Logic    rs) = Logic    rs
 resolveType _ (Implicit rs) = Implicit rs
 resolveType _ (IntegerT   ) = IntegerT
+resolveType _ (InterfaceT x my rs) = InterfaceT x my rs
 resolveType _ (Enum Nothing vals rs) = Enum Nothing 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
@@ -47,12 +48,15 @@ resolveType types (Struct p items rs) = Struct p items' rs
         items' = map resolveItem items
         resolveItem (t, x) = (resolveType types t, x)
 resolveType types (Alias st rs1) =
-    case resolveType types $ types Map.! st of
+    if Map.notMember st types
+    then InterfaceT st Nothing rs1
+    else case resolveType types $ types Map.! st of
         (Reg      rs2) -> Reg      $ rs2 ++ rs1
         (Wire     rs2) -> Wire     $ rs2 ++ rs1
         (Logic    rs2) -> Logic    $ rs2 ++ rs1
         (Enum t v rs2) -> Enum t v $ rs2 ++ rs1
         (Struct p l rs2) -> Struct p l $ rs2 ++ rs1
+        (InterfaceT x my rs2) -> InterfaceT x my $ rs2 ++ rs1
         (Implicit rs2) -> Implicit $ rs2 ++ rs1
         (IntegerT    ) -> error $ "resolveType encountered packed `integer` on " ++ st
         (Alias    _ _) -> error $ "resolveType invariant failed on " ++ st

src/Language/SystemVerilog/AST.hs

+{-# LANGUAGE FlexibleInstances #-}
 module Language.SystemVerilog.AST
   ( Identifier
   , Description(..)
@@ -13,9 +14,11 @@ module Language.SystemVerilog.AST
   , GenItem    (..)
   , AlwaysKW   (..)
   , CaseKW     (..)
+  , PartKW     (..)
   , Decl       (..)
   , AST
   , PortBinding
+  , ModportDecl
   , Case
   , Range
   , GenCase
@@ -41,16 +44,16 @@ type Identifier = String
 type AST = [Description]
 
 data Description
-  = Module Identifier [Identifier] [ModuleItem]
+  = Part PartKW Identifier [Identifier] [ModuleItem]
   | Typedef Type Identifier
   deriving Eq
 
 instance Show Description where
   showList descriptions _ = intercalate "\n" $ map show descriptions
-  show (Module name ports items) = unlines
-    [ "module " ++ name ++ portsStr ++ ";"
+  show (Part kw name ports items) = unlines
+    [ (show kw) ++ " " ++ name ++ portsStr ++ ";"
     , indent $ unlines' $ map show items
-    , "endmodule" ]
+    , "end" ++ (show kw) ]
     where
       portsStr =
         if null ports
@@ -58,6 +61,15 @@ instance Show Description where
           else indentedParenList ports
   show (Typedef t x) = printf "typedef %s %s;" (show t) x
 
+data PartKW
+  = Module
+  | Interface
+  deriving Eq
+
+instance Show PartKW where
+  show Module    = "module"
+  show Interface = "interface"
+
 data Direction
   = Input
   | Output
@@ -80,6 +92,7 @@ data Type
   | IntegerT
   | Enum (Maybe Type) [(Identifier, Maybe Expr)] [Range]
   | Struct Bool [(Type, Identifier)] [Range]
+  | InterfaceT Identifier (Maybe Identifier) [Range]
   deriving (Eq, Ord)
 
 instance Show Type where
@@ -89,6 +102,8 @@ instance Show Type where
   show (Alias t  r) = t       ++ (showRanges r)
   show (Implicit r) =            (showRanges r)
   show (IntegerT  ) = "integer"
+  show (InterfaceT x my r) = x ++ yStr ++ (showRanges r)
+    where yStr = maybe "" ("."++) my
   show (Enum mt vals r) = printf "enum %s{%s}%s" tStr (commas $ map showVal vals) (showRanges r)
     where
       tStr = maybe "" showPad mt
@@ -100,6 +115,12 @@ instance Show Type where
       itemsStr = indent $ unlines' $ map showItem items
       showItem (t, x) = printf "%s %s;" (show t) x
 
+instance Show ([Range] -> Type) where
+    show tf = show (tf [])
+
+instance Eq ([Range] -> Type) where
+    (==) tf1 tf2 = (show $ tf1 []) == (show $ tf2 [])
+
 typeRanges :: Type -> ([Range] -> Type, [Range])
 typeRanges (Reg      r) = (Reg     , r)
 typeRanges (Wire     r) = (Wire    , r)
@@ -109,6 +130,7 @@ typeRanges (Implicit r) = (Implicit, r)
 typeRanges (IntegerT  ) = (error "ranges cannot be applied to IntegerT", [])
 typeRanges (Enum t v r) = (Enum t v, r)
 typeRanges (Struct p l r) = (Struct p l, r)
+typeRanges (InterfaceT x my r) = (InterfaceT x my, r)
 
 data Decl
   = Parameter            Type Identifier Expr
@@ -131,6 +153,7 @@ data ModuleItem
   | Function   Type Identifier [Decl] Stmt
   | Genvar     Identifier
   | Generate   [GenItem]
+  | Modport    Identifier [ModportDecl]
   deriving Eq
 
 -- "function inputs and outputs are inferred to be of type reg if no internal
@@ -150,6 +173,7 @@ instance Show AlwaysKW where
   show AlwaysLatch = "always_latch"
 
 type PortBinding = (Identifier, Maybe Expr)
+type ModportDecl = (Direction, Identifier, Maybe Expr)
 
 instance Show ModuleItem where
   show thing = case thing of
@@ -163,6 +187,7 @@ instance Show ModuleItem where
     Function   t x i b -> printf "function %s%s;\n%s\n%s\nendfunction" (showPad t) x (indent $ show i) (indent $ 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)
     where
     showMaybePorts = maybe "(.*)" showPorts
     showPorts :: [PortBinding] -> String
@@ -172,6 +197,11 @@ instance Show ModuleItem where
       if i == ""
         then show (fromJust arg)
         else printf ".%s(%s)" i (if isJust arg then show $ fromJust arg else "")
+    showModportDecl :: ModportDecl -> String
+    showModportDecl (dir, ident, me) =
+      if me == Just (Ident ident)
+        then printf "%s %s" (show dir) ident
+        else printf "%s .%s(%s)" (show dir) ident (maybe "" show me)
 
 showAssignment :: Maybe Expr -> String
 showAssignment Nothing = ""
@@ -323,6 +353,7 @@ data LHS
   = LHS       Identifier
   | LHSBit    Identifier Expr
   | LHSRange  Identifier Range
+  | LHSDot    LHS Identifier
   | LHSConcat [LHS]
   deriving Eq
 
@@ -331,6 +362,7 @@ instance Show LHS where
   show (LHSBit     a b     ) = printf "%s[%s]"    a (show b)
   show (LHSRange   a (b, c)) = printf "%s[%s:%s]" a (show b) (show c)
   show (LHSConcat  a       ) = printf "{%s}" (commas $ map show a)
+  show (LHSDot     a b     ) = printf "%s.%s" (show a) b
 
 data CaseKW
   = CaseN
@@ -375,7 +407,7 @@ instance Show Stmt where
   show (For (a,b) c (d,e) f) = printf "for (%s = %s; %s; %s = %s)\n%s" a (show b) (show c) d (show e) $ indent $ show f
   show (AsgnBlk v e) = printf "%s = %s;"  (show v) (show e)
   show (Asgn    v e) = printf "%s <= %s;" (show v) (show e)
-  show (If a b Null) = printf "if (%s)\n%s"         (show a) (show b)
+  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 (Timing t s ) = printf "@(%s)%s" (show t) rest
     where

src/Language/SystemVerilog/Parser/Lex.x

@@ -68,6 +68,7 @@ tokens :-
   "endmodule"        { tok KW_endmodule  }
   "endfunction"      { tok KW_endfunction}
   "endgenerate"      { tok KW_endgenerate}
+  "endinterface"     { tok KW_endinterface}
   "enum"             { tok KW_enum       }
   "function"         { tok KW_function   }
   "for"              { tok KW_for        }
@@ -77,10 +78,12 @@ tokens :-
   "initial"          { tok KW_initial    }
   "inout"            { tok KW_inout      }
   "input"            { tok KW_input      }
+  "interface"        { tok KW_interface  }
   "integer"          { tok KW_integer    }
   "localparam"       { tok KW_localparam }
   "logic"            { tok KW_logic      }
   "module"           { tok KW_module     }
+  "modport"          { tok KW_modport    }
   "negedge"          { tok KW_negedge    }
   "or"               { tok KW_or         }
   "output"           { tok KW_output     }

src/Language/SystemVerilog/Parser/Parse.y

@@ -5,6 +5,7 @@ import Data.List
 import Data.Maybe
 
 import Language.SystemVerilog.AST
+import Language.SystemVerilog.Parser.ParseDecl
 import Language.SystemVerilog.Parser.Tokens
 }
 
@@ -31,6 +32,7 @@ import Language.SystemVerilog.Parser.Tokens
 "endcase"          { Token KW_endcase    _ _ }
 "endfunction"      { Token KW_endfunction _ _ }
 "endgenerate"      { Token KW_endgenerate _ _ }
+"endinterface"     { Token KW_endinterface _ _ }
 "endmodule"        { Token KW_endmodule  _ _ }
 "enum"             { Token KW_enum       _ _ }
 "function"         { Token KW_function   _ _ }
@@ -42,9 +44,11 @@ import Language.SystemVerilog.Parser.Tokens
 "inout"            { Token KW_inout      _ _ }
 "input"            { Token KW_input      _ _ }
 "integer"          { Token KW_integer    _ _ }
+"interface"        { Token KW_interface  _ _ }
 "localparam"       { Token KW_localparam _ _ }
 "logic"            { Token KW_logic      _ _ }
 "module"           { Token KW_module     _ _ }
+"modport"          { Token KW_modport    _ _ }
 "negedge"          { Token KW_negedge    _ _ }
 "or"               { Token KW_or         _ _ }
 "output"           { Token KW_output     _ _ }
@@ -175,21 +179,22 @@ Descriptions :: { [Description] }
   | Descriptions Description { $1 ++ [$2] }
 
 Description :: { Description }
-  : Module  opt(";") { $1 }
+  : Part    opt(";") { $1 }
   | Typedef opt(";") { $1 }
 
 Typedef :: { Description }
   : "typedef" Type Identifier ";" { Typedef $2 $3 }
 
-TypeNonAlias :: { Type }
-  : "wire"  Dimensions { Wire  $2 }
-  | "reg"   Dimensions { Reg   $2 }
-  | "logic" Dimensions { Logic $2 }
-  | "enum"   opt(Type) "{" EnumItems   "}" Dimensions { Enum   $2 $4 $6 }
-  | "struct" Packed    "{" StructItems "}" Dimensions { Struct $2 $4 $6 }
 Type :: { Type }
-  : TypeNonAlias          { $1 }
-  | Identifier Dimensions { Alias $1 $2 }
+  : PartialType Dimensions { $1 $2 }
+  | Identifier  Dimensions { Alias $1 $2 }
+PartialType :: { [Range] -> Type }
+  : "wire"                                  { Wire }
+  | "reg"                                   { Reg }
+  | "logic"                                 { Logic }
+  | "enum"   opt(Type) "{" EnumItems   "}"  { Enum   $2 $4 }
+  | "struct" Packed    "{" StructItems "}"  { Struct $2 $4 }
+  | "integer"                               { \[] -> IntegerT }
 
 EnumItems :: { [(Identifier, Maybe Expr)] }
   : VariablePortIdentifiers { $1 }
@@ -204,10 +209,12 @@ Packed :: { Bool }
   : "packed"    { True }
   | {- empty -} { False }
 
-Module :: { Description }
-  : "module" Identifier Params           ";" ModuleItems "endmodule" { Module $2 [] ($3 ++ $5) }
-  | "module" Identifier Params PortNames ";" ModuleItems "endmodule" { Module $2 $4 ($3 ++ $6) }
-  | "module" Identifier Params PortDecls ";" ModuleItems "endmodule" { Module $2 (getPortNames $4) ($3 ++ $4 ++ $6) }
+Part :: { Description }
+  : "module"    Identifier Params PortDecls ";" ModuleItems "endmodule"    opt(Tag) { Part Module    $2 (fst $4) ($3 ++ (snd $4) ++ $6) }
+  | "interface" Identifier Params PortDecls ";" ModuleItems "endinterface" opt(Tag) { Part Interface $2 (fst $4) ($3 ++ (snd $4) ++ $6) }
+
+Tag :: { Identifier }
+  : ":" Identifier { $2 }
 
 Params :: { [ModuleItem] }
   : {- empty -}        { [] }
@@ -218,6 +225,29 @@ ParamDecls :: { [ModuleItem] }
 ParamDecl(delim) :: { [ModuleItem] }
   : "parameter" ParamType DeclAsgns delim { map (MIDecl . (uncurry $ Parameter $2)) $3 }
 
+PortDecls :: { ([Identifier], [ModuleItem]) }
+  : "(" DeclTokens(")") { parseDTsAsPortDecls $2 }
+  | {- empty -}         { ([], []) }
+
+ModportItems :: { [(Identifier, [ModportDecl])] }
+  : ModportItem                  { [$1] }
+  | ModportItems "," ModportItem { $1 ++ [$3] }
+ModportItem :: { (Identifier, [ModportDecl]) }
+  : Identifier "(" ModportPortsDeclarations { ($1, $3) }
+ModportPortsDeclarations :: { [ModportDecl] }
+  : ModportPortsDeclaration(")")                          { $1 }
+  | ModportPortsDeclaration(",") ModportPortsDeclarations { $1 ++ $2 }
+ModportPortsDeclaration(delim) :: { [ModportDecl] }
+  : ModportSimplePortsDeclaration(delim) { $1 }
+ModportSimplePortsDeclaration(delim) :: { [ModportDecl] }
+  : Direction ModportSimplePorts delim { map (\(a, b) -> ($1, a, b)) $2 }
+ModportSimplePorts :: { [(Identifier, Maybe Expr)] }
+  : ModportSimplePort                        { [$1] }
+  | ModportSimplePorts "," ModportSimplePort { $1 ++ [$3] }
+ModportSimplePort :: { (Identifier, Maybe Expr) }
+  : "." Identifier "(" opt(Expr) ")" { ($2, $4) }
+  | Identifier                       { ($1, Just $ Ident $1) }
+
 Identifier :: { Identifier }
   : simpleIdentifier  { tokenString $1 }
   | escapedIdentifier { tokenString $1 }
@@ -227,18 +257,21 @@ Identifiers :: { [Identifier] }
   :                 Identifier { [$1] }
   | Identifiers "," Identifier { $1 ++ [$3] }
 
-PortNames :: { [Identifier] }
-  : "(" Identifiers ")" { $2 }
-
--- abuses delimiter propogation hack to avoid conflicts
-PortDecls :: { [ModuleItem] }
-  : "(" PortDeclsFollow { $2 }
-PortDeclsFollow :: { [ModuleItem] }
-  : ")"                           { [] }
-  | PortDecl(")")                 { $1 }
-  | PortDecl(",") PortDeclsFollow { $1 ++ $2 }
-PortDecl(delim) :: { [ModuleItem] }
-  : Direction TypedVariablePortIdentifiers(delim) { portDeclToModuleItems $1 $2 }
+-- 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 :: { DeclToken }
+  : ","                       { DTComma }
+  | Range                     { DTRange    $1 }
+  | Identifier                { DTIdent    $1 }
+  | Direction                 { DTDir      $1 }
+  | ParameterBindings         { DTParams   $1 }
+  | ModuleInstantiation       { DTInstance $1 }
+  | PartialType               { DTType $1 }
+  | Identifier "." Identifier { DTType $ InterfaceT $1 (Just $3) }
 
 VariablePortIdentifiers :: { [(Identifier, Maybe Expr)] }
   : VariablePortIdentifier                             { [$1] }
@@ -247,13 +280,6 @@ VariablePortIdentifier :: { (Identifier, Maybe Expr) }
   : Identifier          { ($1, Nothing) }
   | Identifier "=" Expr { ($1, Just $3) }
 
--- Note that this allows for things like `input reg` which are not valid.
-TypedVariablePortIdentifiers(delim) :: { (Type, [PortBinding]) }
-  : TypeNonAlias                  VariablePortIdentifiers delim { ($1,    $2) }
-  | Identifier DimensionsNonEmpty VariablePortIdentifiers delim { (Alias $1 $2, $3) }
-  | Identifier                    VariablePortIdentifiers delim { (Alias $1 [], $2) }
-  |            DimensionsNonEmpty VariablePortIdentifiers delim { (Implicit $1, $2) }
-  |                               VariablePortIdentifiers delim { (Implicit [], $1) }
 Direction :: { Direction }
   : "inout"  { Inout  }
   | "input"  { Input  }
@@ -264,18 +290,18 @@ ModuleItems :: { [ModuleItem] }
   | ModuleItems ModuleItem { $1 ++ $2 }
 
 ModuleItem :: { [ModuleItem] }
-  : PortDecl(";")                                        { $1 }
-  | Identifier                    VariableIdentifiers ";" { map (\(x, a, e) -> MIDecl $ Variable Local (Alias $1 []) x a e) $2 }
-  | Identifier DimensionsNonEmpty VariableIdentifiers ";" { map (\(x, a, e) -> MIDecl $ Variable Local (Alias $1 $2) x a e) $3 }
-  | TypeNonAlias                  VariableIdentifiers ";" { map (\(x, a, e) -> MIDecl $ Variable Local $1            x a e) $2 }
-  | Declaration                                          { map MIDecl $1 }
+  -- This item covers module instantiations and all declarations
+  : 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] }
-  | Identifier                   ModuleInstantiations ";" { map (uncurry $ Instance $1 []) $2 }
-  | Identifier ParameterBindings ModuleInstantiations ";" { map (uncurry $ Instance $1 $2) $3 }
-  | "function" ParamType Identifier FunctionItems Stmt "endfunction" { [Function $2 $3 $4 $5] }
+  | "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 }
 
 AlwaysKW :: { AlwaysKW }
   : "always"       { Always      }
@@ -283,35 +309,13 @@ AlwaysKW :: { AlwaysKW }
   | "always_ff"    { AlwaysFF    }
   | "always_latch" { AlwaysLatch }
 
-ModuleInstantiations :: { [(Identifier, Maybe [PortBinding])] }
-  : ModuleInstantiation                          { [$1] }
-  | ModuleInstantiations "," ModuleInstantiation { $1 ++ [$3] }
 ModuleInstantiation :: { (Identifier, Maybe [PortBinding]) }
   : Identifier "(" Bindings ")" { ($1, Just $3) }
   | Identifier "(" ".*"     ")" { ($1, Nothing) }
 
 FunctionItems :: { [Decl] }
-  : "(" FunctionPortList ";" BlockItemDeclarations { $2 ++ $4 }
-  | "(" FunctionPortList ";"                       { $2 }
-  | ";" FunctionItemDeclarations                   { $2 }
-FunctionPortList :: { [Decl] }
-  : FunctionInputDeclaration(")")                  { $1 }
-  | FunctionInputDeclaration(",") FunctionPortList { $1 ++ $2 }
-FunctionItemDeclarations :: { [Decl] }
-  : FunctionItemDeclaration                          { $1 }
-  | FunctionItemDeclarations FunctionItemDeclaration { $1 ++ $2 }
-FunctionItemDeclaration :: { [Decl] }
-  : BlockItemDeclaration          { $1 }
-  | FunctionInputDeclaration(";") { $1 }
-FunctionInputDeclaration(delim) :: { [Decl] }
-  : "input"           Dimensions Identifiers delim { map (\x -> Variable Input (Implicit $2) x [] Nothing) $3 }
-  | "input" "reg"     Dimensions Identifiers delim { map (\x -> Variable Input (Reg $3)      x [] Nothing) $4 }
-  | "input" "integer"            Identifiers delim { map (\x -> Variable Input IntegerT      x [] Nothing) $3 }
-
-Declaration :: { [Decl] }
-  : "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 }
+  : "(" DeclTokens(")") ";" BlockItemDeclarations { (parseDTsAsDecls $2) ++ $4 }
+  |                     ";" BlockItemDeclarations { $2 }
 
 ParamType :: { Type }
   : Dimensions { Implicit $1 }
@@ -352,6 +356,7 @@ LHS :: { LHS }
 | Identifier Range        { LHSRange  $1 $2 }
 | Identifier "[" Expr "]" { LHSBit    $1 $3 }
 | "{" LHSs "}"            { LHSConcat $2 }
+| LHS "." Identifier      { LHSDot    $1 $3 }
 
 LHSs :: { [LHS] }
 :          LHS  { [$1] }
@@ -387,7 +392,6 @@ Stmts :: { [Stmt] }
 Stmt :: { Stmt }
   : ";" { Null }
   | "begin"                                      Stmts "end" { Block Nothing         $2 }
-  | "begin" ":" Identifier                       Stmts "end" { Block (Just ($3, [])) $4 }
   | "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      }
@@ -398,12 +402,17 @@ Stmt :: { Stmt }
   | EventControl Stmt                                { Timing $1 $2 }
 
 BlockItemDeclarations :: { [Decl] }
-  : BlockItemDeclaration                       { $1 }
+  : {- empty -}                                { [] }
   | BlockItemDeclarations BlockItemDeclaration { $1 ++ $2 }
-
 BlockItemDeclaration :: { [Decl] }
   : "reg" Dimensions BlockVariableIdentifiers ";" { map (\(x, rs) -> Variable Local (Reg $2) x rs Nothing) $3 }
-  | Declaration                                   { $1 }
+  | "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] }
@@ -528,28 +537,15 @@ GenCaseDefault :: { GenItem }
 
 
 {
+
 parseError :: [Token] -> a
 parseError a = case a of
   []              -> error "Parse error: no tokens left to parse."
   Token t s p : _ -> error $ "Parse error: unexpected token '" ++ s ++ "' (" ++ show t ++ ") at " ++ show p ++ "."
 
-portDeclToModuleItems :: Direction -> (Type, [PortBinding]) -> [ModuleItem]
-portDeclToModuleItems dir (t, l) =
-  map (\(x, me) -> MIDecl $ Variable dir t x [] me) l
-
-getPortNames :: [ModuleItem] -> [Identifier]
-getPortNames items =
-  mapMaybe getPortName items
-  where
-    getPortName :: ModuleItem -> Maybe Identifier
-    getPortName (MIDecl (Variable Local _ _     _ _)) = Nothing
-    getPortName (MIDecl (Variable _     _ ident _ _)) = Just ident
-    getPortName _ = Nothing
-
 genItemsToGenItem :: [GenItem] -> GenItem
 genItemsToGenItem [] = error "genItemsToGenItem given empty list!"
 genItemsToGenItem [x] = x
 genItemsToGenItem xs = GenBlock Nothing xs
 
 }
-

src/Language/SystemVerilog/Parser/ParseDecl.hs

+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Advanced parser for declarations and module instantiations.
+ -
+ - This module exists because the SystemVerilog grammar has conflicts which
+ - cannot be resolved by an LALR(1) parser. This module provides an interface
+ - for parsing an list of "DeclTokens" into `Decl`s and/or `ModuleItem`s. This
+ - works through a series of functions which have an greater lookahead for
+ - resolving the conflicts.
+ -
+ - Consider the following two module declarations:
+ -  module Test(one two, three [1:0], four);
+ -  module Test(one two, three [1:0]  four);
+ -
+ - When `{one} two ,` is on the stack, it is impossible to know whether to A)
+ - shift `three` to add to the current declaration list; or B) to reduce the
+ - stack and begin a new port declaration; without looking ahead more than 1
+ - token (even ignoring the fact that a range is itself multiple tokens).
+ -
+ - While I previous had some success dealing with conflicts in the parser with
+ - increasingly convoluted grammars, this became more and more untenable as I
+ - added support for more SystemVerilog constructs.
+ -
+ - Because of how liberal this parser is, the parser will accept some
+ - syntactically invalid files. In the future, we may add some basic
+ - type-checking to complain about malformed input files. However, we generally
+ - assume that users have tested their code with commercial simulator before
+ - running it through our tool.
+ -}
+
+module Language.SystemVerilog.Parser.ParseDecl
+( DeclToken (..)
+, parseDTsAsPortDecls
+, parseDTsAsModuleItems
+, parseDTsAsDecls
+, parseDTsAsDecl
+) where
+
+import Data.List (findIndices)
+import Data.Maybe (mapMaybe)
+
+import Language.SystemVerilog.AST
+
+-- [PUBLIC]: combined (irregular) tokens for declarations
+data DeclToken
+    = DTComma
+    | DTAsgn     Expr
+    | DTRange    Range
+    | DTIdent    Identifier
+    | DTDir      Direction
+    | DTType     ([Range] -> Type)
+    | DTParams   [PortBinding]
+    | DTInstance (Identifier, Maybe [PortBinding])
+    deriving (Show, Eq)
+
+
+-- [PUBLIC]: parser for module port declarations, including interface ports
+-- Example: `input foo, bar, One inst`
+parseDTsAsPortDecls :: [DeclToken] -> ([Identifier], [ModuleItem])
+parseDTsAsPortDecls pieces =
+    if isSimpleList
+        then (simpleIdents, [])
+        else (portNames declarations, map MIDecl declarations)
+    where
+        commaIdxs = findIndices isComma pieces
+        identIdxs = findIndices isIdent pieces
+        isSimpleList =
+            all even identIdxs &&
+            all odd commaIdxs &&
+            odd (length pieces) &&
+            length pieces == length commaIdxs + length identIdxs
+
+        simpleIdents = map extractIdent $ filter isIdent pieces
+        declarations = parseDTsAsDecls pieces
+
+        isComma :: DeclToken -> Bool
+        isComma token = token == DTComma
+        extractIdent = \(DTIdent x) -> x
+
+        portNames :: [Decl] -> [Identifier]
+        portNames items = mapMaybe portName items
+        portName :: Decl -> Maybe Identifier
+        portName (Variable _ _ ident _ _) = Just ident
+        portName decl =
+            error $ "unexpected non-variable port declaration: " ++ (show decl)
+
+
+-- [PUBLIC]: parser for single (semicolon-terminated) declarations (including
+-- parameters) and module instantiations
+parseDTsAsModuleItems :: [DeclToken] -> [ModuleItem]
+parseDTsAsModuleItems tokens =
+    if any isInstance tokens
+        then parseDTsAsIntantiations tokens
+        else map MIDecl $ parseDTsAsDecl tokens
+    where
+        isInstance :: DeclToken -> Bool
+        isInstance (DTInstance _) = True
+        isInstance _ = False
+
+
+-- internal; parser for module instantiations
+parseDTsAsIntantiations :: [DeclToken] -> [ModuleItem]
+parseDTsAsIntantiations (DTIdent name : tokens) =
+    if not (all isInstance rest)
+        then error $ "instantiations mixed with other items: " ++ (show rest)
+        else map (uncurry $ Instance name params) instances
+    where
+        (params, rest) =
+            case head tokens of
+                DTParams ps -> (ps, tail tokens)
+                _           -> ([],      tokens)
+        instances = map (\(DTInstance inst) -> inst) rest
+        isInstance :: DeclToken -> Bool
+        isInstance (DTInstance _) = True
+        isInstance _ = False
+parseDTsAsIntantiations tokens =
+    error $
+        "DeclTokens contain instantiations, but start with non-ident: "
+        ++ (show tokens)
+
+
+-- [PUBLIC]: parser for generic, comma-separated declarations
+parseDTsAsDecls :: [DeclToken] -> [Decl]
+parseDTsAsDecls tokens =
+    concat $ map finalize $ parseDTsAsComponents tokens
+
+
+-- [PUBLIC]: used for "single" declarations, i.e., declarations appearing
+-- outside of a port list
+parseDTsAsDecl :: [DeclToken] -> [Decl]
+parseDTsAsDecl tokens =
+    if length components /= 1
+        then error $ "too many declarations: " ++ (show tokens)
+        else finalize $ head components
+    where components = parseDTsAsComponents tokens
+
+
+-- batches together seperate declaration lists
+type Triplet = (Identifier, [Range], Maybe Expr)
+type Component = (Direction, Type, [Triplet])
+finalize :: Component -> [Decl]
+finalize (dir, typ, trips) =
+    map (\(x, a, me) -> Variable dir typ x a me) trips
+
+
+-- internal; entrypoint of the critical portion of our parser
+parseDTsAsComponents :: [DeclToken] -> [Component]
+parseDTsAsComponents [] = []
+parseDTsAsComponents l0 =
+    component : parseDTsAsComponents l4
+    where
+        (dir, l1) = takeDir    l0
+        (tf , l2) = takeType   l1
+        (rs , l3) = takeRanges l2
+        (tps, l4) = takeTrips  l3 True
+        component = (dir, tf rs, tps)
+
+
+takeTrips :: [DeclToken] -> Bool -> ([Triplet], [DeclToken])
+takeTrips [] True = error "incomplete declaration"
+takeTrips [] False = ([], [])
+takeTrips l0 force =
+    if not force && not (tripLookahead l0)
+        then ([], l0)
+        else (trip : trips, l5)
+    where
+        (x , l1) = takeIdent  l0
+        (a , l2) = takeRanges l1
+        (me, l3) = takeAsgn   l2
+        (_ , l4) = takeComma  l3
+        trip = (x, a, me)
+        (trips, l5) = takeTrips l4 False
+
+tripLookahead :: [DeclToken] -> Bool
+tripLookahead [] = False
+tripLookahead l0 =
+    -- every triplet *must* begin with an identifier
+    if not (isIdent $ head l0) then
+        False
+    -- if the identifier is the last token, or if it assigned a value, then we
+    -- know we must have a valid triplet ahead
+    else if null l1 || asgn /= Nothing then
+        True
+    -- if there is a comma after the identifier (and optional ranges and
+    -- assignment) that we're looking at, then we know this identifier is not a
+    -- type name, as type names must be followed by a first identifier before a
+    -- comma or the end of the list
+    else
+        (not $ null l3) && (head l3 == DTComma)
+    where
+        (_   , l1) = takeIdent  l0
+        (_   , l2) = takeRanges l1
+        (asgn, l3) = takeAsgn   l2
+
+takeDir :: [DeclToken] -> (Direction, [DeclToken])
+takeDir (DTDir dir : rest) = (dir  , rest)
+takeDir              rest  = (Local, rest)
+
+takeType :: [DeclToken] -> ([Range] -> Type, [DeclToken])
+takeType (DTType  tf : rest) = (tf      , rest)
+takeType (DTIdent tn : rest) = (Alias tn, rest)
+takeType               rest  = (Implicit, rest)
+
+takeRanges :: [DeclToken] -> ([Range], [DeclToken])
+takeRanges (DTRange r : rest) = (r : rs, rest')
+    where (rs, rest') = takeRanges rest
+takeRanges rest = ([], rest)
+
+takeAsgn :: [DeclToken] -> (Maybe Expr, [DeclToken])
+takeAsgn (DTAsgn e : rest) = (Just e , rest)
+takeAsgn             rest  = (Nothing, rest)
+
+takeComma :: [DeclToken] -> (Bool, [DeclToken])
+takeComma [] = (False, [])
+takeComma (DTComma : rest) = (True, rest)
+takeComma _ = error "take comma encountered neither comma nor end of tokens"
+
+takeIdent :: [DeclToken] -> (Identifier, [DeclToken])
+takeIdent (DTIdent x : rest) = (x, rest)
+takeIdent _ = error "takeIdent didn't find identifier"
+
+
+isIdent :: DeclToken -> Bool
+isIdent (DTIdent _) = True
+isIdent _ = False

sv2v.cabal

@@ -35,6 +35,7 @@ executable sv2v
     Language.SystemVerilog.Parser
     Language.SystemVerilog.Parser.Lex
     Language.SystemVerilog.Parser.Parse
+    Language.SystemVerilog.Parser.ParseDecl
     Language.SystemVerilog.Parser.Preprocess
     Language.SystemVerilog.Parser.Tokens
     -- Conversion modules