completed preliminary interface conversion

src/Convert/Interface.hs

@@ -6,7 +6,7 @@
 
 module Convert.Interface (convert) where
 
-import Data.Maybe (isJust)
+import Data.Maybe (isJust, mapMaybe)
 import Control.Monad.Writer
 import qualified Data.Map.Strict as Map
 
@@ -33,36 +33,54 @@ convert descriptions =
         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 _ _)) =
+convertDescription interfaces (Part Module name ports items) =
     Part Module name ports' items'
     where
-        Part Module _ ports items = traverseModuleItems mapInstance orig
+        items' =
-        ports' = ports
+            map (traverseNestedModuleItems $ traverseExprs convertExpr) $
-        items' = items
+            map (traverseNestedModuleItems $ traverseLHSs  convertLHS) $
+            map (traverseNestedModuleItems mapInterface) $
+            items
+        ports' = concatMap convertPort ports
 
         -- collect the interface type of all interface instances in this module
-        instances = execWriter $ collectModuleItemsM collectInstance orig
+        (instances, modports) = execWriter $ mapM
-        collectInstance :: ModuleItem -> Writer Instances ()
+            (collectNestedModuleItemsM collectInterface) items
-        collectInstance (Instance part _ ident _) =
+        collectInterface :: ModuleItem -> Writer (Instances, Modports)  ()
+        collectInterface (MIDecl (Variable Local t ident _ _)) =
+            case t of
+                InterfaceT interfaceName (Just modportName) [] ->
+                    tell (Map.empty, Map.singleton ident modportDecls)
+                    where modportDecls = lookupModport Nothing interfaceName modportName
+                _ -> return ()
+        collectInterface (Instance part _ ident _) =
             if Map.member part interfaces
-                then tell $ Map.singleton ident part
+                then tell (Map.singleton ident part, Map.empty)
                 else return ()
-        collectInstance _ = return ()
+        collectInterface _ = return ()
 
         -- TODO: We don't yet handle interfaces with parameter bindings.
-        mapInstance :: ModuleItem -> ModuleItem
+        mapInterface :: ModuleItem -> ModuleItem
-        mapInstance (Instance part params ident (Just instancePorts)) =
+        mapInterface (orig @ (MIDecl (Variable Local t ident _ _))) =
+            case Map.lookup ident modports of
+                Just modportDecls -> Generate $
+                    map (GenModuleItem . MIDecl . mapper) modportDecls
+                Nothing -> orig
+            where
+                InterfaceT interfaceName (Just _) [] = t
+                interfaceItems = snd $ interfaces Map.! interfaceName
+                mapper = \(dir, port, Just expr) ->
+                    Variable dir (lookupType interfaceItems expr)
+                    (ident ++ "_" ++ port) [] Nothing
+        mapInterface (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
+        mapInterface other = other
 
         expandPortBinding :: PortBinding -> [PortBinding]
         expandPortBinding (origBinding @ (portName, Just (Access (Ident instanceName) modportName))) =
@@ -71,23 +89,42 @@ convertDescription interfaces (orig @ (Part Module name _ _)) =
                 Just interfaceName ->
                     map mapper modportDecls
                     where
-                        modportDecls = lookupModport instanceName interfaceName modportName
+                        modportDecls = lookupModport (Just instanceName) interfaceName modportName
                         mapper (_, x, me) = (portName ++ "_" ++ x, me)
         expandPortBinding other = [other]
 
-        lookupModport :: Identifier -> Identifier -> Identifier -> [ModportDecl]
+        lookupModport :: Maybe Identifier -> Identifier -> Identifier -> [ModportDecl]
         lookupModport instanceName interfaceName = (Map.!) modportMap
             where
+                prefix = maybe "" (++ "_") instanceName
                 interfaceItems =
-                    map (prefixModuleItems $ instanceName ++ "_") $
+                    map (prefixModuleItems prefix) $
                     snd $ interfaces Map.! interfaceName
                 modportMap = execWriter $
                     mapM (collectNestedModuleItemsM collectModport) $
                     interfaceItems
                 collectModport :: ModuleItem -> Writer Modports ()
-                collectModport (Modport x l) = tell $ Map.singleton x l
+                collectModport (Modport ident l) = tell $ Map.singleton ident l
                 collectModport _ = return ()
 
+        convertExpr :: Expr -> Expr
+        convertExpr (orig @ (Access (Ident x) y)) =
+            if Map.member x modports
+                then Ident (x ++ "_" ++ y)
+                else orig
+        convertExpr other = other
+        convertLHS :: LHS -> LHS
+        convertLHS (orig @ (LHSDot (LHSIdent x) y)) =
+            if Map.member x modports
+                then LHSIdent (x ++ "_" ++ y)
+                else orig
+        convertLHS other = other
+        convertPort :: Identifier -> [Identifier]
+        convertPort ident =
+            case Map.lookup ident modports of
+                Nothing -> [ident]
+                Just decls -> map (\(_, x, _) -> ident ++ "_" ++ x) decls
+
 convertDescription _ other = other
 
 
@@ -109,6 +146,18 @@ prefixModuleItems prefix =
         prefixLHS (LHSIdent x) = LHSIdent (prefix ++ x)
         prefixLHS other = other
 
+-- TODO: this is an incomplete attempt at looking up the type of an expression;
+-- there is definitely some overlap here with the Struct conversion
+lookupType :: [ModuleItem] -> Expr -> Type
+lookupType items (Ident ident) =
+    head $ mapMaybe findType items
+    where
+        findType :: ModuleItem -> Maybe Type
+        findType (MIDecl (Variable _ t x [] Nothing)) =
+            if x == ident then Just t else Nothing
+        findType _ = Nothing
+lookupType _ expr = error $ "lookupType on fancy expr: " ++ show expr
+
 -- convert an interface instantiation into a series of equivalent module items
 inlineInterface :: Interface -> (Identifier, [PortBinding]) -> [ModuleItem]
 inlineInterface (ports, items) (instanceName, instancePorts) =

src/Convert/PackedArray.hs

@@ -107,7 +107,9 @@ hoistPortDecls (Part kw name ports items) =
     where
         explode :: ModuleItem -> [ModuleItem]
         explode (Generate genItems) =
-            portDecls ++ [Generate rest]
+            if null rest
+                then portDecls
+                else portDecls ++ [Generate rest]
             where
                 (wrappedPortDecls, rest) = partition isPortDecl genItems
                 portDecls = map (\(GenModuleItem item) -> item) wrappedPortDecls

src/Convert/Struct.hs

@@ -149,7 +149,7 @@ convertAsgn structs types (lhs, expr) =
                             hi' = BinOp Add base $ BinOp Sub hi lo
                             lo' = base
                             tr = (simplify hi', simplify lo')
-                _ -> error $ "convertLHS encountered dot for bad type: " ++ show l
+                _ -> error $ "convertLHS encountered dot for bad type: " ++ show (t, l, x)
             where
                 (t, l') = convertLHS l
                 Struct p fields [] = t

src/Convert/Traverse.hs

@@ -147,9 +147,20 @@ traverseStmtLHSsM :: Monad m => MapperM m LHS -> MapperM m Stmt
 traverseStmtLHSsM mapper = traverseNestedStmtsM stmtMapper
     where
         fullMapper = traverseNestedLHSsM mapper
+        stmtMapper (Timing (Event sense) stmt) = do
+            sense' <- senseMapper sense
+            return $ Timing (Event sense') stmt
         stmtMapper (AsgnBlk lhs expr) = fullMapper lhs >>= \lhs' -> return $ AsgnBlk lhs' expr
         stmtMapper (Asgn    lhs expr) = fullMapper lhs >>= \lhs' -> return $ Asgn    lhs' expr
         stmtMapper other = return other
+        senseMapper (Sense        lhs) = fullMapper lhs >>= return . Sense
+        senseMapper (SensePosedge lhs) = fullMapper lhs >>= return . SensePosedge
+        senseMapper (SenseNegedge lhs) = fullMapper lhs >>= return . SenseNegedge
+        senseMapper (SenseOr    s1 s2) = do
+            s1' <- senseMapper s1
+            s2' <- senseMapper s2
+            return $ SenseOr s1' s2'
+        senseMapper (SenseStar       ) = return SenseStar
 
 traverseStmtLHSs :: Mapper LHS -> Mapper Stmt
 traverseStmtLHSs = unmonad traverseStmtLHSsM