functional parameter type conversion

src/Convert/ParamType.hs

@@ -10,6 +10,7 @@ import Control.Monad.Writer
 import Data.Either (isLeft)
 import Data.Maybe (isJust, isNothing, fromJust)
 import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
 
 import Convert.Traverse
 import Language.SystemVerilog.AST
@@ -20,14 +21,17 @@ type Info = Map.Map Identifier ([Identifier], MaybeTypeMap)
 type Instance = Map.Map Identifier Type
 type Instances = [(Identifier, Instance)]
 
+type IdentSet = Set.Set Identifier
+type UsageMap = [(Identifier, Set.Set Identifier)]
+
 convert :: [AST] -> [AST]
 convert files =
-    concatMap (map explodeDescription) files'
+    files'''
     where
         info = execWriter $
             mapM (collectDescriptionsM collectDescriptionM) files
         (files', instancesRaw) = runWriter $ mapM
-            (mapM $ traverseModuleItemsM $ mapInstance info) files
+            (mapM $ traverseModuleItemsM $ convertModuleItemM info) files
         instances = reverse $ uniq [] instancesRaw
         -- TODO: use the unique package
         uniq curr [] = curr
@@ -36,24 +40,113 @@ convert files =
                 then uniq curr xs
                 else uniq (x : curr) xs
 
+        -- add type parameter instantiations
+        files'' = map (concatMap explodeDescription) files'
         explodeDescription :: Description -> [Description]
         explodeDescription (part @ (Part _ _ _ name _ _)) =
-            if null theseInstances
-                then [part]
-                else map (rewriteModule part) theseInstances
-            where theseInstances = map snd $ filter ((== name) . fst) instances
+            if null theseInstances then
+                [part]
+            else
+                (:) part $
+                filter (not . alreadyExists) $
+                filter isNonDefault $
+                map (rewriteModule part) theseInstances
+            where
+                theseInstances = map snd $ filter ((== name) . fst) instances
+                isNonDefault = (name /=) . moduleName
+                alreadyExists = (flip Map.member info) . moduleName
+                moduleName :: Description -> Identifier
+                moduleName (Part _ _ _ x _ _) = x
+                moduleName _ = error "not possible"
         explodeDescription other = [other]
 
-        -- TODO FIXME: Need to keep around the default instance and not perform
-        -- substitutions in it.
+        -- remove or rewrite source modules that are no longer needed
+        files''' = map (reverse . uniq [] . concatMap replaceDefault) 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 ()
+        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 _ = return ()
+        replaceDefault :: Description -> [Description]
+        replaceDefault (part @ (Part _ _ _ name _ _)) =
+            if Map.notMember name info then
+                [part]
+            else if Map.null maybeTypeMap then
+                [part]
+            else if Map.member name usedTypedModules && isUsed name then
+                [part]
+            else if all isNothing maybeTypeMap then
+                []
+            else
+                (:) (removeDefaultTypeParams part) $
+                if isNothing typeMap
+                    then []
+                    else [rewriteModule part $ fromJust typeMap]
+            where
+                maybeTypeMap = snd $ info Map.! name
+                typeMap = defaultInstance maybeTypeMap
+        replaceDefault other = [other]
+
+        removeDefaultTypeParams :: Description -> Description
+        removeDefaultTypeParams (part @ (Part _ _ _ _ _ _)) =
+            Part extern kw ml (moduleDefaultName name) p items
+            where
+                Part extern kw ml name p items =
+                    traverseModuleItems (traverseDecls rewriteDecl) part
+                rewriteDecl :: Decl -> Decl
+                rewriteDecl (ParamType Parameter x _) =
+                    ParamType Parameter x Nothing
+                rewriteDecl other = other
+        removeDefaultTypeParams _ = error "not possible"
+
+        isUsed :: Identifier -> Bool
+        isUsed name =
+            any (flip Map.notMember usedTypedModules) used
+            where
+                used = usageSet $ expandSet name
+                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
 
-        -- substitute in a particular instance's paramter types
+        -- substitute in a particular instance's parameter types
         rewriteModule :: Description -> Instance -> Description
         rewriteModule part typeMap =
             Part extern kw ml m' p items'
             where
                 Part extern kw ml m p items = part
-                m' = renameModule info m typeMap
+                m' = moduleInstanceName m typeMap
                 items' = map rewriteDecl items
                 rewriteDecl :: ModuleItem -> ModuleItem
                 rewriteDecl (MIPackageItem (Decl (ParamType Parameter x _))) =
@@ -67,7 +160,6 @@ convert files =
                 -----    ParamType Localparam x (Just $ typeMap Map.! x)
                 -----rewriteDecl other = other
 
-
 -- write down module parameter names and type parameters
 collectDescriptionM :: Description -> Writer Info ()
 collectDescriptionM (part @ (Part _ _ _ name _ _)) =
@@ -93,24 +185,65 @@ defaultInstance maybeTypeMap =
         else Just $ Map.map fromJust maybeTypeMap
 
 -- generate a "unique" name for a particular module type instance
-renameModule :: Info -> Identifier -> Instance -> Identifier
-renameModule info m inst =
-    if defaultInstance maybeTypeMap == Just inst
-        then m -- default instances keep the original module name
-        else m ++ "_" ++ shortHash (m, inst)
-    where maybeTypeMap = snd $ info Map.! m
+moduleInstanceName :: Identifier -> Instance -> Identifier
+moduleInstanceName m inst = m ++ "_" ++ shortHash (m, inst)
 
+-- name for the module without any default type parameters
+moduleDefaultName :: Identifier -> Identifier
+moduleDefaultName m = m ++ defaultTag
+isDefaultName :: Identifier -> Bool
+isDefaultName m =
+    defaultTag == (reverse $ (take $ length defaultTag) $ reverse m)
+defaultTag :: Identifier
+defaultTag = "_sv2v_default"
 
-mapInstance :: Info -> ModuleItem -> Writer Instances ModuleItem
-mapInstance info (orig @ (Instance m bindings x r p)) =
+-- attempt to convert an expression to syntactically equivalent type
+exprToType :: Expr -> Maybe Type
+exprToType (Ident x) = Just $ Alias Nothing x []
+exprToType (PSIdent x y) = Just $ Alias (Just x) y []
+exprToType (Range e NonIndexed r) =
+    case exprToType e of
+        Nothing -> Nothing
+        Just t -> Just $ tf (rs ++ [r])
+            where (tf, rs) = typeRanges t
+exprToType (Bit e i) =
+    case exprToType e of
+        Nothing -> Nothing
+        Just t -> Just $ tf (rs ++ [r])
+            where
+                (tf, rs) = typeRanges t
+                r = (simplify $ BinOp Sub i (Number "1"), Number "0")
+exprToType _ = Nothing
+
+-- checks where a type is sufficiently resolved to be substituted
+-- TODO: If a type parameter contains an expression, that expression should be
+-- substituted into the new module, or created as a new parameter.
+isSimpleType :: Type -> Bool
+isSimpleType (IntegerVector _ _ _) = True
+isSimpleType (IntegerAtom   _ _  ) = True
+isSimpleType (NonInteger    _    ) = True
+isSimpleType (Net           _ _  ) = True
+isSimpleType _ = False
+
+-- 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 then
         return orig
+    else if Map.null maybeTypeMap then
+        return $ Instance m bindingsNamed x r p
     else if any (isLeft . snd) bindings' then
         error $ "param type resolution left type params: " ++ show orig
             ++ " converted to: " ++ show bindings'
+    else if any (not . isSimpleType) resolvedTypes then do
+        let defaults = Map.map Left resolvedTypes
+        let bindingsDefaulted = Map.toList $ Map.union bindingsMap defaults
+        if isDefaultName m
+            then return $ Instance m bindingsNamed x r p
+            else return $ Instance (moduleDefaultName m) bindingsDefaulted x r p
     else do
         tell [(m, resolvedTypes)]
-        let m' = renameModule info m resolvedTypes
+        let m' = moduleInstanceName m resolvedTypes
         return $ Instance m' bindings' x r p
     where
         (paramNames, maybeTypeMap) = info Map.! m
@@ -134,12 +267,16 @@ mapInstance info (orig @ (Instance m bindings x r p)) =
                         " is missing a type parameter: " ++ paramName
                 (Just (Left t), _) -> t
                 (Just (Right e), _) ->
-                    -- TODO: Some types could have been parsed as an expression
-                    -- (i.e. aliases). Ideally we should have any such aliases
-                    -- resolved before applying this conversion.
-                    error $ "instantiation " ++ show orig ++ " has expr "
-                        ++ show e ++ " for type param: " ++ paramName
+                    -- Some types are parsed as expressions because of the
+                    -- ambiguities of defined type names.
+                    case exprToType e of
+                        Just t -> t
+                        Nothing ->
+                            error $ "instantiation " ++ show orig
+                                ++ " has expr " ++ show e
+                                ++ " for type param: " ++ paramName
+
         -- leave only the normal expression params behind
         isParamType = flip Map.member maybeTypeMap
         bindings' = filter (not . isParamType . fst) bindingsNamed
-mapInstance _ other = return other
+convertModuleItemM _ other = return other

src/Convert/Traverse.hs

@@ -849,6 +849,13 @@ traverseTypesM mapper item =
             fullMapper t >>= \t' -> return $ MIPackageItem $ Function l t' x d s
         miMapper (MIPackageItem (other @ (Task _ _ _ _))) =
             return $ MIPackageItem other
+        miMapper (Instance m params x r p) = do
+            params' <- mapM mapParam params
+            return $ Instance m params' x r p
+            where
+                mapParam (i, Left t) =
+                    fullMapper t >>= \t' -> return (i, Left t')
+                mapParam (i, Right e) = return $ (i, Right e)
         miMapper other = return other
 
 traverseTypes :: Mapper Type -> Mapper ModuleItem

src/Convert/Typedef.hs

@@ -36,6 +36,7 @@ convert =
 convertDescription :: Types -> Description -> Description
 convertDescription globalTypes description =
     traverseModuleItems removeTypedef $
+    traverseModuleItems convertModuleItem $
     traverseModuleItems (traverseExprs $ traverseNestedExprs $ convertExpr) $
     traverseModuleItems (traverseTypes $ resolveType types) $
     description
@@ -49,12 +50,20 @@ convertDescription globalTypes description =
         removeTypedef (MIPackageItem (Typedef _ x)) =
             MIPackageItem $ Comment $ "removed typedef: " ++ x
         removeTypedef other = other
-        convertExpr :: Expr -> Expr
-        convertExpr (Bits (Right (Ident x))) =
+        convertTypeOrExpr :: TypeOrExpr -> TypeOrExpr
+        convertTypeOrExpr (Right (Ident x)) =
             if Map.member x types
-                then Bits $ Left $ resolveType types (Alias Nothing x [])
-                else Bits $ Right $ Ident x
+                then Left $ resolveType types (Alias Nothing x [])
+                else Right $ Ident x
+        convertTypeOrExpr other = other
+        convertExpr :: Expr -> Expr
+        convertExpr (Bits v) = Bits $ convertTypeOrExpr v
         convertExpr other = other
+        convertModuleItem :: ModuleItem -> ModuleItem
+        convertModuleItem (Instance m params x r p) =
+            Instance m (map mapParam params) x r p
+            where mapParam (i, v) = (i, convertTypeOrExpr v)
+        convertModuleItem other = other
 
 resolveItem :: Types -> (Type, Identifier) -> (Type, Identifier)
 resolveItem types (t, x) = (resolveType types t, x)

test/basic/paramtype.sv

@@ -88,6 +88,7 @@ module d_1; n_def #(logic [1:0], logic [2:0]) x(); endmodule
 module d_2; n_def #(.T(logic [1:0])) x(); endmodule
 module d_3; n_def #(.U(logic [1:0])) x(); endmodule
 module d_4; n_def #(.U(logic), .T(logic [1:0])) x(); endmodule
+module d_5; n_def x(); endmodule
 
 module e_1; n_tdef #(logic [1:0], logic [2:0]) x(); endmodule
 module e_2; n_tdef #(.T(logic [1:0]), .U(logic)) x(); endmodule

test/basic/paramtype.v

@@ -20,6 +20,8 @@ module top;
 		$display("n_def 01 00000000000000000000000000000010           2");
 		$display("n_def 00 00000000000000000000000000000001           2");
 		$display("n_def 1 00000000000000000000000000000010           1");
+		$display("n_def 0 00000000000000000000000000000001           1");
+		$display("n_def 1 00000000000000000000000000000010           1");
 		$display("n_tdef 00 00000000000000000000000000000001           2");
 		$display("n_tdef 001 00000000000000000000000000000010           3");
 		$display("n_tdef 00 00000000000000000000000000000001           2");

test/basic/paramtype_recurse.sv

+module foo #(
+    parameter type T = logic,
+    parameter size = 0
+);
+    generate
+        if (size != 0) begin : foo
+            bar #(T, size - 1) x();
+        end
+    endgenerate
+    initial $display("foo %d %d", $bits(T), size);
+endmodule
+
+module bar #(
+    parameter type U = logic,
+    parameter size = 0
+);
+    generate
+        if (size != 0) begin : bar
+            foo #(U, size - 1) x();
+        end
+    endgenerate
+    initial $display("bar %d %d", $bits(U), size);
+endmodule
+
+module top_1; foo #(byte, 2) x(); endmodule
+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

test/basic/paramtype_recurse.v

+module foo_default #(
+    parameter size = 0
+);
+    initial $display("foo %d %d", 1, size);
+endmodule
+
+module bar_default #(
+    parameter size = 0
+);
+    initial $display("bar %d %d", 1, size);
+endmodule
+
+module foo_byte #(
+    parameter size = 0
+);
+    generate
+        if (size != 0) begin : foo
+            bar_byte #(size - 1) x();
+        end
+    endgenerate
+    initial $display("foo %d %d", 8, size);
+endmodule
+
+module bar_byte #(
+    parameter size = 0
+);
+    generate
+        if (size != 0) begin : bar
+            foo_byte #(size - 1) x();
+        end
+    endgenerate
+    initial $display("bar %d %d", 8, size);
+endmodule
+
+module foo_bit #(
+    parameter size = 0
+);
+    generate
+        if (size != 0) begin : foo
+            bar_bit #(size - 1) x();
+        end
+    endgenerate
+    initial $display("foo %d %d", 1, size);
+endmodule
+
+module bar_bit #(
+    parameter size = 0
+);
+    generate
+        if (size != 0) begin : bar
+            foo_bit #(size - 1) x();
+        end
+    endgenerate
+    initial $display("bar %d %d", 1, size);
+endmodule
+
+module top_1; foo_byte #(2) x(); endmodule
+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