upgraded size cast conversion

- support casts of generate scoped expressions
- support casts to sizes involving genvars

src/Convert/Scoper.hs

@@ -29,6 +29,7 @@ module Convert.Scoper
     , partScoper
     , partScoperT
     , insertElem
+    , injectItem
     , lookupExpr
     , lookupLHS
     , lookupIdent
@@ -81,6 +82,7 @@ data Scopes a = Scopes
     { sCurrent :: [Tier]
     , sMapping :: Mapping a
     , sProcedure :: Bool
+    , sInjected :: [ModuleItem]
     } deriving Show
 
 embedScopes :: Monad m => (Scopes a -> b -> c) -> b -> ScoperT a m c
@@ -100,46 +102,37 @@ setScope (Tier name _ : tiers) newEntry =
 
 enterScope :: Monad m => Identifier -> Identifier -> ScoperT a m ()
 enterScope name index = do
-    current <- gets sCurrent
-    let current' = current ++ [Tier name index]
+    s <- get
+    let current' = sCurrent s ++ [Tier name index]
     existingResult <- lookupIdentM name
     let existingElement = fmap thd3 existingResult
     let entry = Entry existingElement index Map.empty
-    mapping <- gets sMapping
-    let mapping' = setScope current' entry mapping
-    procedure <- gets sProcedure
-    put $ Scopes current' mapping' procedure
+    let mapping' = setScope current' entry $ sMapping s
+    put $ s { sCurrent = current', sMapping = mapping'}
     where thd3 (_, _, c) = c
 
 exitScope :: Monad m => Identifier -> Identifier -> ScoperT a m ()
 exitScope name index = do
     let tier = Tier name index
-    current <- gets sCurrent
-    mapping <- gets sMapping
-    procedure <- gets sProcedure
+    s <- get
+    let current = sCurrent s
     if null current || last current /= tier
         then error "exitScope invariant violated"
-        else do
-            let current' = init current
-            put $ Scopes current' mapping procedure
+        else put $ s { sCurrent = init current}
 
 enterProcedure :: Monad m => ScoperT a m ()
 enterProcedure = do
-    current <- gets sCurrent
-    mapping <- gets sMapping
-    procedure <- gets sProcedure
-    if procedure
+    s <- get
+    if sProcedure s
         then error "enterProcedure invariant failed"
-        else put $ Scopes current mapping True
+        else put $ s { sProcedure = True }
 
 exitProcedure :: Monad m => ScoperT a m ()
 exitProcedure = do
-    current <- gets sCurrent
-    mapping <- gets sMapping
-    procedure <- gets sProcedure
-    if not procedure
+    s <- get
+    if not (sProcedure s)
         then error "exitProcedure invariant failed"
-        else put $ Scopes current mapping False
+        else put $ s { sProcedure = False }
 
 tierToAccess :: Tier -> Access
 tierToAccess (Tier x "") = Access x Nil
@@ -161,12 +154,22 @@ lhsToAccesses = exprToAccesses . lhsToExpr
 
 insertElem :: Monad m => Identifier -> a -> ScoperT a m ()
 insertElem name element = do
-    current <- gets sCurrent
-    mapping <- gets sMapping
-    procedure <- gets sProcedure
+    s <- get
+    let current = sCurrent s
+    let mapping = sMapping s
     let entry = Entry (Just element) "" Map.empty
     let mapping' = setScope (current ++ [Tier name ""]) entry mapping
-    put $ Scopes current mapping' procedure
+    put $ s { sMapping = mapping' }
+
+injectItem :: Monad m => ModuleItem -> ScoperT a m ()
+injectItem item =
+    modify' $ \s -> s { sInjected = add $ sInjected s }
+    where
+        add :: [ModuleItem] -> [ModuleItem]
+        add items =
+            if elem item items
+                then items
+                else items ++ [item]
 
 type Replacements = Map.Map Identifier Expr
 
@@ -256,10 +259,10 @@ evalScoperT declMapper moduleItemMapper genItemMapper stmtMapper topName items =
         operation :: ScoperT a m [ModuleItem]
         operation = do
             enterScope topName ""
-            items' <- mapM fullModuleItemMapper items
+            items' <- mapM wrappedModuleItemMapper items
             exitScope topName ""
             return items'
-        initialState = Scopes [] Map.empty False
+        initialState = Scopes [] Map.empty False []
 
         fullStmtMapper :: Stmt -> ScoperT a m Stmt
         fullStmtMapper (Block kw name decls stmts) = do
@@ -298,6 +301,16 @@ evalScoperT declMapper moduleItemMapper genItemMapper stmtMapper topName items =
                 argIdxDecl ParamType{} = Nothing
                 argIdxDecl CommentDecl{} = Nothing
 
+        wrappedModuleItemMapper :: ModuleItem -> ScoperT a m ModuleItem
+        wrappedModuleItemMapper item = do
+            item' <- fullModuleItemMapper item
+            injected <- gets sInjected
+            if null injected
+                then return item'
+                else do
+                    modify' $ \s -> s { sInjected = [] }
+                    injected' <- mapM fullModuleItemMapper injected
+                    return $ Generate $ map GenModuleItem $ injected' ++ [item']
         fullModuleItemMapper :: ModuleItem -> ScoperT a m ModuleItem
         fullModuleItemMapper (MIPackageItem (Function ml t x decls stmts)) = do
             enterProcedure
@@ -353,13 +366,18 @@ evalScoperT declMapper moduleItemMapper genItemMapper stmtMapper topName items =
             genItems' <- mapM fullGenItemMapper genItems
             exitScope name index
             return $ GenFor (index, a) b c (GenBlock name genItems')
+        scopeGenItemMapper (GenFor (index, a) b c genItem) = do
+            enterScope "" index
+            genItem' <- fullGenItemMapper genItem
+            exitScope "" index
+            return $ GenFor (index, a) b c genItem'
         scopeGenItemMapper (GenBlock name genItems) = do
             enterScope name ""
             genItems' <- mapM fullGenItemMapper genItems
             exitScope name ""
             return $ GenBlock name genItems'
         scopeGenItemMapper (GenModuleItem moduleItem) =
-            fullModuleItemMapper moduleItem >>= return . GenModuleItem
+            wrappedModuleItemMapper moduleItem >>= return . GenModuleItem
         scopeGenItemMapper genItem =
             traverseSinglyNestedGenItemsM fullGenItemMapper genItem
 

src/Convert/SizeCast.hs

@@ -7,63 +7,49 @@
 
 module Convert.SizeCast (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.ExprUtils
+import Convert.Scoper
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
-type TypeMap = Map.Map Identifier Type
-type CastSet = Set.Set (Expr, Signing)
-
-type ST = StateT TypeMap (Writer CastSet)
-
 convert :: [AST] -> [AST]
-convert = map convertFile
-
-convertFile :: AST -> AST
-convertFile descriptions =
-    descriptions' ++ map (uncurry castFn) funcs
-    where
-        results = map convertDescription descriptions
-        descriptions' = map fst results
-        funcs = Set.toList $ Set.unions $ map snd results
+convert = map $ traverseDescriptions convertDescription
 
-convertDescription :: Description -> (Description, CastSet)
-convertDescription description =
-    (description', info)
-    where
-        (description', info) =
-            runWriter $
-                scopedConversionM traverseDeclM traverseModuleItemM traverseStmtM
-                Map.empty description
+convertDescription :: Description -> Description
+convertDescription = partScoper
+    traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
 
-traverseDeclM :: Decl -> ST Decl
+traverseDeclM :: Decl -> Scoper Type Decl
 traverseDeclM decl = do
     case decl of
-        Variable _ t x _ _ -> modify $ Map.insert x t
-        Param    _ t x   _ -> modify $ Map.insert x t
+        Variable _ t x _ _ -> insertElem x t
+        Param    _ t x   _ -> insertElem x t
         ParamType    _ _ _ -> return ()
         CommentDecl      _ -> return ()
-    return decl
+    traverseDeclExprsM traverseExprM decl
+
+traverseModuleItemM :: ModuleItem -> Scoper Type ModuleItem
+traverseModuleItemM (Genvar x) =
+    insertElem x (IntegerAtom TInteger Unspecified) >> return (Genvar x)
+traverseModuleItemM item =
+    traverseExprsM traverseExprM item
 
-traverseModuleItemM :: ModuleItem -> ST ModuleItem
-traverseModuleItemM item = traverseExprsM traverseExprM item
+traverseGenItemM :: GenItem -> Scoper Type GenItem
+traverseGenItemM = return
 
-traverseStmtM :: Stmt -> ST Stmt
-traverseStmtM stmt = traverseStmtExprsM traverseExprM stmt
+traverseStmtM :: Stmt -> Scoper Type Stmt
+traverseStmtM = traverseStmtExprsM traverseExprM
 
 pattern ConvertedUU :: Integer -> Integer -> Expr
 pattern ConvertedUU a b = Number (Based 1 True Binary a b)
 
-traverseExprM :: Expr -> ST Expr
+traverseExprM :: Expr -> Scoper Type Expr
 traverseExprM =
     traverseNestedExprsM convertExprM
     where
-        convertExprM :: Expr -> ST Expr
+        convertExprM :: Expr -> Scoper Type Expr
         convertExprM (Cast (Right (Number s)) (Number n)) =
             case n of
                 UnbasedUnsized{} -> fallback
@@ -85,9 +71,9 @@ traverseExprM =
                 fallback = convertCastM (Number s) (Number n)
                 num = return . Number
         convertExprM (Cast (Right (Ident x)) e) = do
-            typeMap <- get
+            details <- lookupIdentM x
             -- can't convert this cast yet because x could be a typename
-            if Map.notMember x typeMap
+            if details == Nothing
                 then return $ Cast (Right $ Ident x) e
                 else convertCastM (Ident x) e
         convertExprM (Cast (Right s) e) =
@@ -100,7 +86,7 @@ traverseExprM =
             convertExprM $ Cast (Right $ dimensionsSize rs) e
         convertExprM other = return other
 
-        convertCastM :: Expr -> Expr -> ST Expr
+        convertCastM :: Expr -> Expr -> Scoper Type Expr
         convertCastM (RawNum n) (ConvertedUU a b) =
             return $ Number $ Based (fromIntegral n) False Binary
                 (extend a) (extend b)
@@ -109,14 +95,15 @@ traverseExprM =
                 extend 1 = (2 ^ n) - 1
                 extend _ = error "not possible"
         convertCastM s e = do
-            typeMap <- get
-            case exprSigning typeMap e of
+            signing <- embedScopes exprSigning e
+            case signing of
                 Just sg -> convertCastWithSigningM s e sg
                 _ -> return $ Cast (Right s) e
 
-        convertCastWithSigningM :: Expr -> Expr -> Signing -> ST Expr
+        convertCastWithSigningM :: Expr -> Expr -> Signing -> Scoper Type Expr
         convertCastWithSigningM s e sg = do
-            lift $ tell $ Set.singleton (s, sg)
+            details <- lookupIdentM $ castFnName s sg
+            when (details == Nothing) $ injectItem $ MIPackageItem $ castFn s sg
             let f = castFnName s sg
             let args = Args [e] []
             return $ Call (Ident f) args
@@ -132,9 +119,8 @@ isSimpleExpr =
         collectUnresolvedExprM (expr @ DimFn {}) = tell [expr]
         collectUnresolvedExprM _ = return ()
 
-castFn :: Expr -> Signing -> Description
+castFn :: Expr -> Signing -> PackageItem
 castFn e sg =
-    PackageItem $
     Function Automatic t fnName [decl] [Return $ Ident inp]
     where
         inp = "inp"
@@ -157,16 +143,12 @@ castFnName e sg =
             _ -> shortHash e
         name = "sv2v_cast_" ++ sizeStr ++ "_" ++ show sg
 
-exprSigning :: TypeMap -> Expr -> Maybe Signing
-exprSigning typeMap (Ident x) =
-    case Map.lookup x typeMap of
-        Just t -> typeSigning t
-        Nothing -> Just Unspecified
-exprSigning typeMap (BinOp op e1 e2) =
+exprSigning :: Scopes Type -> Expr -> Maybe Signing
+exprSigning scopes (BinOp op e1 e2) =
     combiner sg1 sg2
     where
-        sg1 = exprSigning typeMap e1
-        sg2 = exprSigning typeMap e2
+        sg1 = exprSigning scopes e1
+        sg2 = exprSigning scopes e2
         combiner = case op of
             BitAnd  -> combineSigning
             BitXor  -> combineSigning
@@ -181,7 +163,10 @@ exprSigning typeMap (BinOp op e1 e2) =
             ShiftAL -> curry fst
             ShiftAR -> curry fst
             _ -> \_ _ -> Just Unspecified
-exprSigning _ _ = Just Unspecified
+exprSigning scopes expr =
+    case lookupExpr scopes expr of
+        Just (_, _, t) -> typeSigning t
+        Nothing -> Just Unspecified
 
 combineSigning :: Maybe Signing -> Maybe Signing -> Maybe Signing
 combineSigning Nothing _ = Nothing

test/basic/cast.sv

 module top;
 
     parameter WIDTH = 32;
+    generate
+        begin : A
+            int x = -235;
+        end
+    endgenerate
     initial begin
         logic [31:0] w = 1234;
-        int x = -235;
         int y = 1234;
         logic [4:0] z = y;
         $display("%0d %0d", w, 5'(w));
-        $display("%0d %0d", x, 5'(x));
+        $display("%0d %0d", A.x, 5'(A.x));
         $display("%0d %0d", y, 5'(y));
         $display("%0d %0d", z, 5'(z));
         $display("%0d %0d", w+1, 5'(w+1));
-        $display("%0d %0d", x+1, 5'(x+1));
+        $display("%0d %0d", A.x+1, 5'(A.x+1));
         $display("%0d %0d", y+1, 5'(y+1));
         $display("%0d %0d", z+1, 5'(z+1));
         $display("%b %b", w, 40'(w));
-        $display("%b %b", x, 40'(x));
+        $display("%b %b", A.x, 40'(A.x));
         $display("%b %b", y, 40'(y));
         $display("%b %b", z, 40'(z));
         $display("%0d %0d", w, ($clog2(WIDTH))'(w));
-        $display("%0d %0d", x, ($clog2(WIDTH))'(x));
+        $display("%0d %0d", A.x, ($clog2(WIDTH))'(A.x));
         $display("%0d %0d", y, ($clog2(WIDTH))'(y));
         $display("%0d %0d", z, ($clog2(WIDTH))'(z));
         $display("%b", 32'(4));

test/basic/cast.v

 module top;
 
+    generate
+        begin : A
+            reg signed [31:0] x;
+        end
+    endgenerate
     initial begin : foo_block
         reg [31:0] w;
-        reg signed [31:0] x;
         reg signed [31:0] y;
         reg [4:0] z;
         w = 1234;
-        x = -235;
+        A.x = -235;
         y = 1234;
         z = y;
         $display("%0d %0d", w, w[4:0]);
-        $display("%0d %0d", x, $signed(x[4:0]));
+        $display("%0d %0d", A.x, $signed(A.x[4:0]));
         $display("%0d %0d", y, $signed(y[4:0]));
         $display("%0d %0d", z, z[4:0]);
         $display("%0d %0d", w+1, w[4:0]+1);
-        $display("%0d %0d", x+1, $signed(x[4:0])+1);
+        $display("%0d %0d", A.x+1, $signed(A.x[4:0])+1);
         $display("%0d %0d", y+1, $signed(y[4:0])+1);
         $display("%0d %0d", z+1, z[4:0]+1);
         $display("%b %b", w, {8'b0, w});
-        $display("%b %b", x, {8'hFF, x});
+        $display("%b %b", A.x, {8'hFF, A.x});
         $display("%b %b", y, {8'b0, y});
         $display("%b %b", z, {35'b0, z});
         $display("%0d %0d", w, w[4:0]);
-        $display("%0d %0d", x, $signed(x[4:0]));
+        $display("%0d %0d", A.x, $signed(A.x[4:0]));
         $display("%0d %0d", y, $signed(y[4:0]));
         $display("%0d %0d", z, z[4:0]);
         $display("%b", 32'd4);

test/basic/local_cast.sv

+module top;
+    generate
+        for (genvar i = 1; i < 5; ++i) begin
+            initial begin
+                integer x, y;
+                x = $unsigned(i'(1'sb1));
+                y = $unsigned((i + 5)'(1'sb1));
+                $display("%0d %b %b", i, x, y);
+            end
+            for (genvar j = 3; j < 6; ++j) begin
+                initial begin
+                    integer x;
+                    x = $unsigned((i * j)'(1'sb1));
+                    $display("%0d %0d %b", i, j, x);
+                end
+            end
+        end
+    endgenerate
+endmodule

test/basic/local_cast.v

+module top;
+    generate
+        genvar i, j;
+        for (i = 1; i < 5; i = i + 1) begin
+            initial begin : foo
+                integer x, y;
+                x = $unsigned(cast_i(1'sb1));
+                y = (1 << (i + 5)) - 1;
+                $display("%0d %b %b", i, x, y);
+            end
+            for (j = 3; j < 6; j = j + 1) begin
+                initial begin : bar
+                    integer x;
+                    x = (1 << (i * j)) - 1;
+                    $display("%0d %0d %b", i, j, x);
+                end
+            end
+            function signed [i-1:0] cast_i;
+                input signed [i-1:0] inp;
+                cast_i = inp;
+            endfunction
+        end
+    endgenerate
+endmodule