first half of interface conversion

src/Convert.hs

@@ -14,6 +14,7 @@ import qualified Convert.AsgnOp
 import qualified Convert.CaseKW
 import qualified Convert.Enum
 import qualified Convert.FuncRet
+import qualified Convert.Interface
 import qualified Convert.Logic
 import qualified Convert.PackedArray
 import qualified Convert.Return
@@ -28,6 +29,7 @@ type Phase = AST -> AST
 phases :: Target -> [Phase]
 phases YOSYS =
     [ Convert.AsgnOp.convert
+    , Convert.Interface.convert
     , Convert.FuncRet.convert
     , Convert.Enum.convert
     , Convert.PackedArray.convert

src/Convert/Interface.hs

+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Conversion for interfaces
+ -}
+
+module Convert.Interface (convert) where
+
+import Data.Maybe (isJust)
+import Control.Monad.Writer
+import qualified Data.Map.Strict as Map
+
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+type Instances = Map.Map Identifier Identifier
+type Interface = ([Identifier], [ModuleItem])
+type Interfaces = Map.Map Identifier Interface
+type Modports = Map.Map Identifier [ModportDecl]
+
+convert :: AST -> AST
+convert descriptions =
+    filter (not . isInterface) $
+    traverseDescriptions (convertDescription interfaces) $
+    descriptions
+    where
+        interfaces = execWriter $ collectDescriptionsM collectDesc descriptions
+        collectDesc :: Description -> Writer Interfaces ()
+        collectDesc (Part Interface name ports items) =
+            tell $ Map.singleton name (ports, items)
+        collectDesc _ = return ()
+        isInterface :: Description -> Bool
+        isInterface (Part Interface _ _ _) = True
+        isInterface _ = False
+
+-- TODO FIXME XXX: We should probably extract out/flatten the needless generate
+-- blocks we make during covnersion...
+
+convertDescription :: Interfaces -> Description -> Description
+convertDescription interfaces (orig @ (Part Module name _ _)) =
+    Part Module name ports' items'
+    where
+        Part Module _ ports items = traverseModuleItems mapInstance orig
+        ports' = ports
+        items' = items
+
+        -- collect the interface type of all interface instances in this module
+        instances = execWriter $ collectModuleItemsM collectInstance orig
+        collectInstance :: ModuleItem -> Writer Instances ()
+        collectInstance (Instance part _ ident _) =
+            if Map.member part interfaces
+                then tell $ Map.singleton ident part
+                else return ()
+        collectInstance _ = return ()
+
+        -- TODO: We don't yet handle interfaces with parameter bindings.
+        mapInstance :: ModuleItem -> ModuleItem
+        mapInstance (Instance part params ident (Just instancePorts)) =
+            case Map.lookup part interfaces of
+                Just interface ->
+                    Generate $ map GenModuleItem $
+                    inlineInterface interface (ident, expandedPorts)
+                Nothing -> Instance part params ident (Just expandedPorts)
+            where expandedPorts = concatMap expandPortBinding instancePorts
+        mapInstance other = other
+
+        expandPortBinding :: PortBinding -> [PortBinding]
+        expandPortBinding (origBinding @ (portName, Just (Access (Ident instanceName) modportName))) =
+            case Map.lookup instanceName instances of
+                Nothing -> [origBinding]
+                Just interfaceName ->
+                    map mapper modportDecls
+                    where
+                        modportDecls = lookupModport instanceName interfaceName modportName
+                        mapper (_, x, me) = (portName ++ "_" ++ x, me)
+        expandPortBinding other = [other]
+
+        lookupModport :: Identifier -> Identifier -> Identifier -> [ModportDecl]
+        lookupModport instanceName interfaceName = (Map.!) modportMap
+            where
+                interfaceItems =
+                    map (prefixModuleItems $ instanceName ++ "_") $
+                    snd $ interfaces Map.! interfaceName
+                modportMap = execWriter $
+                    mapM (collectNestedModuleItemsM collectModport) $
+                    interfaceItems
+                collectModport :: ModuleItem -> Writer Modports ()
+                collectModport (Modport x l) = tell $ Map.singleton x l
+                collectModport _ = return ()
+
+convertDescription _ other = other
+
+
+-- add a prefix to all standard identifiers in a module item
+prefixModuleItems :: Identifier -> ModuleItem -> ModuleItem
+prefixModuleItems prefix =
+    traverseDecls prefixDecl .
+    traverseExprs prefixExpr .
+    traverseLHSs  prefixLHS
+    where
+        prefixDecl :: Decl -> Decl
+        prefixDecl (Variable d t x a me) = Variable d t (prefix ++ x) a me
+        prefixDecl (Parameter  t x e) = Parameter  t (prefix ++ x) e
+        prefixDecl (Localparam t x e) = Localparam t (prefix ++ x) e
+        prefixExpr :: Expr -> Expr
+        prefixExpr (Ident x) = Ident (prefix ++ x)
+        prefixExpr other = other
+        prefixLHS :: LHS -> LHS
+        prefixLHS (LHSIdent x) = LHSIdent (prefix ++ x)
+        prefixLHS other = other
+
+-- convert an interface instantiation into a series of equivalent module items
+inlineInterface :: Interface -> (Identifier, [PortBinding]) -> [ModuleItem]
+inlineInterface (ports, items) (instanceName, instancePorts) =
+    (:) (Comment $ "expanded instance: " ++ instanceName) $
+    (++) portBindings $
+    map (traverseNestedModuleItems removeModport) $
+    map (traverseNestedModuleItems removeMIDeclDir) $
+    map (prefixModuleItems prefix) $
+    items
+    where
+        prefix = instanceName ++ "_"
+        origInstancePortNames = map fst instancePorts
+        instancePortExprs = map snd instancePorts
+        instancePortNames =
+            map (prefix ++) $
+            if all ("" ==) origInstancePortNames
+                then ports
+                else origInstancePortNames
+        portBindings =
+            map (\(ident, Just expr) -> Assign (LHSIdent ident) expr) $
+            filter (isJust . snd) $
+            zip instancePortNames instancePortExprs
+
+        removeMIDeclDir :: ModuleItem -> ModuleItem
+        removeMIDeclDir (MIDecl (Variable _ t x a me)) =
+            MIDecl $ Variable Local t x a me
+        removeMIDeclDir other = other
+        removeModport :: ModuleItem -> ModuleItem
+        removeModport (Modport x _) = Comment $ "removed modport " ++ x
+        removeModport other = other

src/Convert/StarPort.hs

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

src/Convert/Traverse.hs

@@ -39,6 +39,9 @@ module Convert.Traverse
 , traverseAsgnsM
 , traverseAsgns
 , collectAsgnsM
+, traverseNestedModuleItemsM
+, traverseNestedModuleItems
+, collectNestedModuleItemsM
 , traverseNestedStmts
 ) where
 
@@ -284,10 +287,16 @@ traverseExprsM mapper = moduleItemMapper
             else do
                 l <- mapM portBindingMapper (fromJust ml)
                 return $ Instance m params x (Just l)
+    moduleItemMapper (Modport x l) =
+        mapM modportDeclMapper l >>= return . Modport x
     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
+
+    modportDeclMapper (dir, ident, Just e) = do
+        e' <- exprMapper e
+        return (dir, ident, Just e')
+    modportDeclMapper other = return other
 
 traverseExprs :: Mapper Expr -> Mapper ModuleItem
 traverseExprs = unmonad traverseExprsM
@@ -444,5 +453,16 @@ traverseAsgns = unmonad traverseAsgnsM
 collectAsgnsM :: Monad m => CollectorM m (LHS, Expr) -> CollectorM m ModuleItem
 collectAsgnsM = collectify traverseAsgnsM
 
+traverseNestedModuleItemsM :: Monad m => MapperM m ModuleItem -> MapperM m ModuleItem
+traverseNestedModuleItemsM mapper item = do
+    Part Module "DNE" [] [item'] <-
+        traverseModuleItemsM mapper (Part Module "DNE" [] [item])
+    return item'
+
+traverseNestedModuleItems :: Mapper ModuleItem -> Mapper ModuleItem
+traverseNestedModuleItems = unmonad traverseNestedModuleItemsM
+collectNestedModuleItemsM :: Monad m => CollectorM m ModuleItem -> CollectorM m ModuleItem
+collectNestedModuleItemsM = collectify traverseNestedModuleItemsM
+
 traverseNestedStmts :: Mapper Stmt -> Mapper Stmt
 traverseNestedStmts = unmonad traverseNestedStmtsM

sv2v.cabal

@@ -45,6 +45,7 @@ executable sv2v
     Convert.CaseKW
     Convert.Enum
     Convert.FuncRet
+    Convert.Interface
     Convert.Logic
     Convert.PackedArray
     Convert.Return