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/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