additional param type conversion bug fixes

- general refactoring throughout
- improved metrics for dropping unneeded modules
- fix re-visiting a converted instance in the same pass

src/Convert/ParamType.hs

+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TupleSections #-}
 {- sv2v
  - Author: Zachary Snow <zach@zachjs.com>
@@ -8,15 +9,15 @@
 module Convert.ParamType (convert) where
 
 import Control.Monad.Writer.Strict
-import Data.Either (isRight)
+import Data.Either (isRight, lefts)
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
-type MaybeTypeMap = Map.Map Identifier (Maybe Type)
-type Info = Map.Map Identifier MaybeTypeMap
+type TypeMap = Map.Map Identifier Type
+type Modules = Map.Map Identifier TypeMap
 
 type Instance = Map.Map Identifier (Type, IdentSet)
 type Instances = Set.Set (Identifier, Instance)
@@ -28,106 +29,123 @@ convert :: [AST] -> [AST]
 convert files =
     files'''
     where
-        info = execWriter $
+        modules = execWriter $
             mapM (collectDescriptionsM collectDescriptionM) files
-        (files', instancesRaw) = runWriter $ mapM
-            (mapM $ traverseModuleItemsM $ convertModuleItemM info) files
+        (files', instancesRaw) =
+            runWriter $ mapM (mapM convertDescriptionM) files
         instances = Set.toList instancesRaw
 
         -- add type parameter instantiations
         files'' = map (concatMap explodeDescription) files'
         explodeDescription :: Description -> [Description]
         explodeDescription (part @ (Part _ _ _ _ name _ _)) =
-            if null theseInstances then
-                [part]
-            else
-                (:) part $
-                filter (not . alreadyExists) $
-                map (rewriteModule part) theseInstances
+            (part :) $
+            filter (not . alreadyExists) $
+            map (rewriteModule part) theseInstances
             where
                 theseInstances = map snd $ filter ((== name) . fst) instances
-                alreadyExists = (flip Map.member info) . moduleName
+                alreadyExists = flip Map.member modules . moduleName
                 moduleName :: Description -> Identifier
                 moduleName = \(Part _ _ _ _ x _ _) -> x
         explodeDescription other = [other]
 
-        -- remove source modules that are no longer needed
-        files''' = map (filter keepDescription) files''
-        (usageMapRaw, usedTypedModulesRaw) =
-            execWriter $ mapM (mapM collectUsageInfoM) files''
-        usageMap = Map.unionsWith Set.union $ map (uncurry Map.singleton)
-            usageMapRaw
-        usedTypedModules = Map.unionsWith Set.union $ map (uncurry
-            Map.singleton) usedTypedModulesRaw
-        collectUsageInfoM :: Description -> Writer (UsageMap, UsageMap) ()
-        collectUsageInfoM (part @ (Part _ _ _ _ name _ _)) =
-            tell (makeList used, makeList usedTyped)
-            where
-                makeList s = zip (Set.toList s) (repeat $ Set.singleton name)
-                (usedUntyped, usedTyped) =
-                    execWriter $ (collectModuleItemsM collectModuleItemM) part
-                used = Set.union usedUntyped usedTyped
-        collectUsageInfoM _ = return ()
+        -- remove or reduce source modules that are no longer needed
+        files''' = map (map reduceTypeDefaults . filter keepDescription) files''
+        -- produce a typed and untyped instantiation graph
+        (usedUntypedModules, usedTypedModules) =
+            both (Map.fromListWith Set.union) $
+            execWriter $ mapM (mapM collectUsageM) files''
+        collectUsageM :: Description -> Writer (UsageMap, UsageMap) ()
+        collectUsageM (part @ (Part _ _ _ _ name _ _)) =
+            tell $ both makeList $ execWriter $
+                (collectModuleItemsM collectModuleItemM) part
+            where makeList s = zip (Set.toList s) (repeat $ Set.singleton name)
+        collectUsageM _ = return ()
         collectModuleItemM :: ModuleItem -> Writer (IdentSet, IdentSet) ()
-        collectModuleItemM (Instance m bindings _ _ _) = do
-            case Map.lookup m info of
-                Nothing -> tell (Set.singleton m, Set.empty)
-                Just maybeTypeMap ->
-                    if any (flip Map.member maybeTypeMap) $ map fst bindings
-                        then tell (Set.empty, Set.singleton m)
-                        else tell (Set.singleton m, Set.empty)
+        collectModuleItemM (Instance m bindings _ _ _) =
+            if all (isRight . snd) bindings
+                then tell (Set.singleton m, Set.empty)
+                else tell (Set.empty, Set.singleton m)
         collectModuleItemM _ = return ()
+        both f (x, y) = (f x, f y) -- simple tuple map helper
+
+        -- identify if a module is still in use
         keepDescription :: Description -> Bool
         keepDescription (Part _ _ _ _ name _ _) =
-            Map.notMember name info ||
-            Map.null maybeTypeMap ||
-            (Map.member name usedTypedModules && isUsed name)
-            where maybeTypeMap = info Map.! name
+            isNewModule
+            || isntTyped
+            || isUsedAsUntyped
+            || isUsedAsTyped && isInstantiatedViaNonTyped
+            || allTypesHaveDefaults && notInstantiated
+            where
+                maybeTypeMap = Map.lookup name modules
+                Just typeMap = maybeTypeMap
+                isNewModule = maybeTypeMap == Nothing
+                isntTyped = Map.null typeMap
+                isUsedAsTyped = Map.member name usedTypedModules
+                isUsedAsUntyped = Map.member name usedUntypedModules
+                isInstantiatedViaNonTyped = untypedUsageSearch $ Set.singleton name
+                allTypesHaveDefaults = all (/= UnknownType) (Map.elems typeMap)
+                notInstantiated = lookup name instances == Nothing
         keepDescription _ = True
 
-        isUsed :: Identifier -> Bool
-        isUsed name =
-            any (flip Map.notMember usedTypedModules) used
+        -- instantiate the type parameters if this is a used default instance
+        reduceTypeDefaults :: Description -> Description
+        reduceTypeDefaults (part @ (Part _ _ _ _ name _ _)) =
+            if shouldntReduce
+                then part
+                else traverseModuleItems (traverseDecls rewriteDecl) part
+            where
+                shouldntReduce =
+                    Map.notMember name modules || Map.null typeMap ||
+                    isTemplateTagged name
+                typeMap = modules Map.! name
+                rewriteDecl :: Decl -> Decl
+                rewriteDecl (ParamType Parameter x t) =
+                    ParamType Localparam x t
+                rewriteDecl other = other
+        reduceTypeDefaults other = other
+
+        -- modules can be recursive; this checks if a typed module is not
+        -- connected to any modules which are themselves used as typed modules
+        untypedUsageSearch :: IdentSet -> Bool
+        untypedUsageSearch visited =
+            any (flip Map.notMember usedTypedModules) visited
+            || Set.size visited /= Set.size visited'
+                && untypedUsageSearch visited'
             where
-                used = usageSet $ expandSet name
+                visited' =
+                    Set.union visited $
+                    Set.unions $
+                    Set.map expandSet visited
                 expandSet :: Identifier -> IdentSet
                 expandSet ident =
-                    case ( Map.lookup ident usedTypedModules
-                         , Map.lookup name usageMap) of
-                        (Just x, _) -> x
-                        (Nothing, Just x) -> x
-                        _ -> Set.empty
-                usageSet :: IdentSet -> IdentSet
-                usageSet names =
-                    if names' == names
-                        then names
-                        else usageSet names'
-                    where names' =
-                            Set.union names $
-                            Set.unions $
-                            Set.map expandSet names
+                    Map.findWithDefault Set.empty ident usedTypedModules
 
         -- substitute in a particular instance's parameter types
         rewriteModule :: Description -> Instance -> Description
-        rewriteModule part typeMap =
+        rewriteModule part inst =
             Part attrs extern kw ml m' p (additionalParamItems ++ items')
             where
                 Part attrs extern kw ml m p items = part
-                m' = moduleInstanceName m typeMap
+                m' = moduleInstanceName m inst
                 items' = map rewriteModuleItem items
                 rewriteModuleItem = traverseNestedModuleItems $ traverseNodes
                     rewriteExpr rewriteDecl rewriteType rewriteLHS rewriteStmt
                 rewriteDecl :: Decl -> Decl
                 rewriteDecl (ParamType Parameter x t) =
-                    ParamType Localparam x $ rewriteType $
-                    case Map.lookup x typeMap of
+                    ParamType kind x $ rewriteType $
+                    case Map.lookup x inst of
                         Nothing -> t
                         Just (t', _) -> t'
+                    where kind = if Map.null inst
+                                    then Parameter
+                                    else Localparam
                 rewriteDecl other =
                     traverseDeclTypes rewriteType $
                     traverseDeclExprs rewriteExpr other
                 additionalParamItems = concatMap makeAddedParams $
-                    Map.toList $ Map.map snd typeMap
+                    Map.toList $ Map.map snd inst
                 rewriteExpr :: Expr -> Expr
                 rewriteExpr (orig @ (Dot (Ident x) y)) =
                     if x == m
@@ -171,23 +189,32 @@ convert files =
                     where name = addedParamTypeName paramName ident
 
 -- write down module parameter names and type parameters
-collectDescriptionM :: Description -> Writer Info ()
+collectDescriptionM :: Description -> Writer Modules ()
 collectDescriptionM (part @ (Part _ _ _ _ name _ _)) =
-    tell $ Map.singleton name maybeTypeMap
+    tell $ Map.singleton name typeMap
     where
-        maybeTypeMap = Map.fromList $ execWriter $
+        typeMap = Map.fromList $ execWriter $
             collectModuleItemsM (collectDeclsM collectDeclM) part
-        collectDeclM :: Decl -> Writer [(Identifier, Maybe Type)] ()
-        collectDeclM (ParamType Parameter x v) =
-            if v == UnknownType
-                then tell [(x, Nothing)]
-                else tell [(x, Just v)]
+        collectDeclM :: Decl -> Writer [(Identifier, Type)] ()
+        collectDeclM (ParamType Parameter x v) = tell [(x, v)]
         collectDeclM _ = return ()
 collectDescriptionM _ = return ()
 
 -- generate a "unique" name for a particular module type instance
 moduleInstanceName :: Identifier -> Instance -> Identifier
-moduleInstanceName m inst = m ++ "_" ++ shortHash (m, inst)
+moduleInstanceName (TemplateTag m) inst =
+    moduleInstanceName m inst
+moduleInstanceName m inst =
+    if Map.null inst
+        then TemplateTag m
+        else m ++ "_" ++ shortHash (m, inst)
+
+-- used to tag modules created for delayed type parameter instantiation
+pattern TemplateTag :: Identifier -> Identifier
+pattern TemplateTag x = '~' : x
+isTemplateTagged :: Identifier -> Bool
+isTemplateTagged TemplateTag{} = True
+isTemplateTagged _ = False
 
 -- checks where a type is sufficiently resolved to be substituted
 isSimpleType :: Type -> Bool
@@ -199,8 +226,8 @@ isSimpleType typ =
         NonInteger   {} -> True
         Net          {} -> True
         Implicit     {} -> True
-        Struct   _ fields _ -> all (isSimpleType . fst) fields
-        Union    _ fields _ -> all (isSimpleType . fst) fields
+        Struct _ fields _ -> all (isSimpleType . fst) fields
+        Union  _ fields _ -> all (isSimpleType . fst) fields
         _ -> False
 
 -- returns whether a top-level type contains any dimension queries or
@@ -239,21 +266,39 @@ addedParamName paramName var = paramName ++ '_' : var
 addedParamTypeName :: Identifier -> Identifier -> Identifier
 addedParamTypeName paramName var = paramName ++ '_' : var ++ "_type"
 
+convertDescriptionM :: Description -> Writer Instances Description
+convertDescriptionM (Part attrs extern kw liftetime name ports items) =
+    mapM convertModuleItemM items >>=
+        return . Part attrs extern kw liftetime name ports
+convertDescriptionM other = return other
+
+convertGenItemM :: GenItem -> Writer Instances GenItem
+convertGenItemM (GenModuleItem item) =
+    convertModuleItemM item >>= return . GenModuleItem
+convertGenItemM other =
+    traverseSinglyNestedGenItemsM convertGenItemM other
+
 -- attempt to rewrite instantiations with type parameters
-convertModuleItemM :: Info -> ModuleItem -> Writer Instances ModuleItem
-convertModuleItemM info (orig @ (Instance m bindings x r p)) =
-    if Map.notMember m info || Map.null maybeTypeMap then
+convertModuleItemM :: ModuleItem -> Writer Instances ModuleItem
+convertModuleItemM (orig @ (Instance m bindings x r p)) =
+    if hasOnlyExprs then
         return orig
-    else if any (not . isSimpleType . fst) resolvedTypes then
-        return orig
-    else do
+    else if not hasUnresolvedTypes then do
         tell $ Set.singleton (m, resolvedTypes)
         let m' = moduleInstanceName m resolvedTypes
         return $ Generate $ map GenModuleItem $
             map (MIPackageItem . Decl) addedDecls ++
             [Instance m' (additionalBindings ++ exprBindings) x r p]
+    else if isTemplateTagged m then
+        return orig
+    else do
+        let m' = TemplateTag m
+        tell $ Set.singleton (m, Map.empty)
+        return $ Instance m' bindings x r p
     where
-        maybeTypeMap = info Map.! m
+        hasOnlyExprs = all (isRight . snd) bindings
+        hasUnresolvedTypes = any (not . isSimpleType) (lefts $ map snd bindings)
+
         -- determine the types corresponding to each type parameter
         bindingsMap = Map.fromList bindings
         resolvedTypesWithDecls = Map.mapMaybeWithKey resolveType bindingsMap
@@ -283,4 +328,8 @@ convertModuleItemM info (orig @ (Instance m bindings x r p)) =
                 toTypeParam ident =
                     (addedParamTypeName paramName ident, Left $ TypeOf $ Ident ident)
 
-convertModuleItemM _ other = return other
+convertModuleItemM (Generate items) =
+    mapM convertGenItemM items >>= return . Generate
+convertModuleItemM (MIAttr attr item) =
+    convertModuleItemM item >>= return . MIAttr attr
+convertModuleItemM other = return other

test/basic/paramtype_delay.sv

@@ -15,7 +15,8 @@ module mod #(
 endmodule
 
 module top;
-    typedef struct packed { byte y; } W;
+    parameter type BASE = byte;
+    typedef struct packed { BASE y; } W;
     W w;
     typedef struct packed { type(w) x, y; } V;
     V v;

test/basic/paramtype_expr.sv

+module mod #(
+    parameter type T = logic
+);
+    initial $display("$bits(T) = %0d", $bits(T));
+endmodule
+
+module top;
+    parameter SIZE = 8;
+    mod #(logic [SIZE-1:0]) m();
+endmodule

test/basic/paramtype_expr.v

+module mod #(
+    parameter S = 1
+);
+    initial $display("$bits(T) = %0d", S);
+endmodule
+
+module top;
+    parameter SIZE = 8;
+    mod #(SIZE) m();
+endmodule

test/basic/paramtype_recurse.sv

@@ -28,4 +28,4 @@ module top_2; bar #(byte, 3) x(); endmodule
 module top_3; foo #(bit, 4) x(); endmodule
 module top_4; bar #(bit, 5) x(); endmodule
 
-module top; endmodule
+module top; foo x(); endmodule

test/basic/paramtype_recurse.v

@@ -48,4 +48,4 @@ module top_2; bar_byte #(3) x(); endmodule
 module top_3; foo_bit #(4) x(); endmodule
 module top_4; bar_bit #(5) x(); endmodule
 
-module top; endmodule
+module top; foo_bit #(0) x(); endmodule