added conversion which moves top-level tasks and functions into modules

src/Convert.hs

@@ -19,6 +19,7 @@ import qualified Convert.Interface
 import qualified Convert.KWArgs
 import qualified Convert.Logic
 import qualified Convert.NamedBlock
+import qualified Convert.NestTF
 import qualified Convert.PackedArray
 import qualified Convert.Return
 import qualified Convert.StarPort
@@ -52,6 +53,7 @@ phases excludes =
     , Convert.Unique.convert
     , selectExclude (Job.Interface, Convert.Interface.convert)
     , selectExclude (Job.Always   , Convert.AlwaysKW.convert)
+    , Convert.NestTF.convert
     ]
     where
         selectExclude :: (Job.Exclude, Phase) -> Phase

src/Convert/NestTF.hs

+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Conversion for moving top-level tasks and functions into modules
+ -}
+
+module Convert.NestTF (convert) where
+
+import Control.Monad.State
+import Control.Monad.Writer
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+type TFs = Map.Map Identifier PackageItem
+type Idents = Set.Set Identifier
+
+convert :: AST -> AST
+convert ast =
+    filter (not . isTF) $ nest $ ast
+    where
+        nest :: AST -> AST
+        nest curr =
+            if next == curr
+                then curr
+                else nest next
+            where
+                next = evalState (traverseM curr) Map.empty
+                traverseM = traverseDescriptionsM traverseDescriptionM
+        isTF :: Description -> Bool
+        isTF (PackageItem (Function _ _ _ _ _)) = True
+        isTF (PackageItem (Task     _   _ _ _)) = True
+        isTF _ = False
+
+-- collects and nests in tasks and functions missing from modules
+traverseDescriptionM :: Description -> State TFs Description
+traverseDescriptionM (PackageItem item) = do
+    () <- case item of
+        Function _ _ ident _ _ -> modify $ Map.insert ident item
+        Task     _   ident _ _ -> modify $ Map.insert ident item
+        _ -> return ()
+    return $ PackageItem item
+traverseDescriptionM (orig @ (Part extern kw lifetime name ports items)) = do
+    tfs <- get
+    let newItems = map MIPackageItem $ Map.elems $
+            Map.restrictKeys tfs neededTFs
+    return $ Part extern kw lifetime name ports (items ++ newItems)
+    where
+        existingTFs = execWriter $ collectModuleItemsM collectTFsM orig
+        usedTFs = Set.union
+            (execWriter $ collectModuleItemsM (collectStmtsM collectSubroutinesM) orig)
+            (execWriter $ collectModuleItemsM (collectExprsM $ collectNestedExprsM collectCallsM) orig)
+        neededTFs = Set.difference usedTFs existingTFs
+traverseDescriptionM other = return other
+
+-- writes down the names of tasks and functions
+collectTFsM :: ModuleItem -> Writer Idents ()
+collectTFsM (MIPackageItem item) =
+    case item of
+        Function _ _ ident _ _ -> tell $ Set.singleton ident
+        Task     _   ident _ _ -> tell $ Set.singleton ident
+        _ -> return ()
+collectTFsM _ = return ()
+
+-- writes down the names of subroutine invocations
+collectSubroutinesM :: Stmt -> Writer Idents ()
+collectSubroutinesM (Subroutine f _) = tell $ Set.singleton f
+collectSubroutinesM _ = return ()
+
+-- writes down the names of function calls
+collectCallsM :: Expr -> Writer Idents ()
+collectCallsM (Call f _) = tell $ Set.singleton f
+collectCallsM _ = return ()

src/Convert/Struct.hs

@@ -27,22 +27,10 @@ convert :: AST -> AST
 convert = traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
-convertDescription description =
-    case description' of
-        Part extern kw lifetime name ports items ->
+convertDescription (description @ (Part _ _ _ _ _ _)) =
     Part extern kw lifetime name ports (items ++ funcs)
     where
-                funcs = map packerFn usedStructs
-                usedStructs = filter (isNeeded . fst) $ Map.toList structs
-                isNeeded tf = Set.member (packerFnName tf) calledPackedFuncs
-        other ->
-            if Set.null calledPackedFuncs
-                then other
-                -- TODO: Add support for top-level TFs which use struct literals
-                else error $ "top-level TF cannot use a struct literal, yet: "
-                        ++ show other
-    where
-        description' =
+        description' @ (Part extern kw lifetime name ports items) =
             traverseModuleItems (traverseExprs $ traverseNestedExprs $ convertOnlyExpr structs types) $
             traverseModuleItems (traverseTypes $ convertType structs) $
             traverseModuleItems (traverseAsgns $ convertAsgn structs types) $
@@ -60,6 +48,10 @@ convertDescription description =
             (collectExprsM $ collectNestedExprsM collectCalls) description'
         packerFuncs = Set.map packerFnName $ Map.keysSet structs
         calledPackedFuncs = Set.intersection calledFuncs packerFuncs
+        funcs = map packerFn usedStructs
+        usedStructs = filter (isNeeded . fst) $ Map.toList structs
+        isNeeded tf = Set.member (packerFnName tf) calledPackedFuncs
+convertDescription other = other
 
 -- writes down the names of called functions
 collectCalls :: Expr -> Writer Idents ()

sv2v.cabal

@@ -64,6 +64,7 @@ executable sv2v
     Convert.KWArgs
     Convert.Logic
     Convert.NamedBlock
+    Convert.NestTF
     Convert.PackedArray
     Convert.Return
     Convert.StarPort

test/basic/top_tf.sv

+task foo;
+    $display("task foo() called");
+endtask
+function bar;
+    input [2:0] n;
+    bar = baz(n + 1);
+endfunction
+function baz;
+    input [2:0] n;
+    baz = n * 2;
+endfunction
+module top;
+    initial foo();
+    initial $display("bar(0) = %d", bar(0));
+endmodule

test/basic/top_tf.v

+module top;
+    task foo;
+        $display("task foo() called");
+    endtask
+    function bar;
+        input [2:0] n;
+        bar = baz(n + 1);
+    endfunction
+    function baz;
+        input [2:0] n;
+        baz = n * 2;
+    endfunction
+    initial foo();
+    initial $display("bar(0) = %d", bar(0));
+endmodule

test/basic/top_tf_tb.v

+// intentionally empty