unpacked array conversion supports generate scoped data

- added type class for looking up elements in scoped conversions

src/Convert/Logic.hs

@@ -99,7 +99,7 @@ traverseModuleItem ports scopes =
                 isRegType _ = False
                 isReg' :: LHS -> Writer [Bool] ()
                 isReg' lhs =
-                    case lookupLHS scopes lhs of
+                    case lookupElem scopes lhs of
                         Just (_, _, t) -> tell [isRegType t]
                         _ -> tell [False]
 
@@ -167,7 +167,7 @@ rewriteDeclM (Variable d t x a e) = do
     (d', t') <- case t of
         IntegerVector TLogic sg rs -> do
             insertElem x t
-            details <- lookupIdentM x
+            details <- lookupElemM x
             let Just (accesses, _, _) = details
             let location = map accessName accesses
             usedAsReg <- lift $ gets $ Set.member location
@@ -205,7 +205,7 @@ traverseStmtM stmt = do
 
 collectLHSM :: LHS -> ST ()
 collectLHSM lhs = do
-    details <- lookupLHSM lhs
+    details <- lookupElemM lhs
     case details of
         Just (accesses, _, _) -> do
             let location = map accessName accesses

src/Convert/MultiplePacked.hs

@@ -188,7 +188,7 @@ convertExpr scopes =
         fallbackLevels expr =
             fmap ((, expr) . thd3) res
             where
-                res = lookupExpr scopes expr
+                res = lookupElem scopes expr
                 thd3 (_, _, c) = c
 
         -- given an expression, returns the two most significant (innermost,

src/Convert/Scoper.hs

 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleInstances #-}
 {- sv2v
  - Author: Zachary Snow <zach@zachjs.com>
  -
@@ -30,15 +31,10 @@ module Convert.Scoper
     , partScoperT
     , insertElem
     , injectItem
-    , lookupExpr
-    , lookupLHS
-    , lookupIdent
-    , lookupAccesses
-    , lookupExprM
-    , lookupLHSM
-    , lookupIdentM
-    , lookupAccessesM
+    , lookupElem
+    , lookupElemM
     , Access(..)
+    , ScopeKey
     , Scopes
     , embedScopes
     , withinProcedure
@@ -104,7 +100,7 @@ enterScope :: Monad m => Identifier -> Identifier -> ScoperT a m ()
 enterScope name index = do
     s <- get
     let current' = sCurrent s ++ [Tier name index]
-    existingResult <- lookupIdentM name
+    existingResult <- lookupElemM name
     let existingElement = fmap thd3 existingResult
     let entry = Entry existingElement index Map.empty
     let mapping' = setScope current' entry $ sMapping s
@@ -149,9 +145,6 @@ exprToAccesses (Dot e x) = do
     Just $ accesses ++ [Access x Nil]
 exprToAccesses _ = Nothing
 
-lhsToAccesses :: LHS -> Maybe [Access]
-lhsToAccesses = exprToAccesses . lhsToExpr
-
 insertElem :: Monad m => Identifier -> a -> ScoperT a m ()
 insertElem name element = do
     s <- get
@@ -191,26 +184,19 @@ attemptResolve mapping (Access x e : rest) = do
 
 type LookupResult a = Maybe ([Access], Replacements, a)
 
-lookupExprM :: Monad m => Expr -> ScoperT a m (LookupResult a)
-lookupExprM = embedScopes lookupExpr
-
-lookupLHSM :: Monad m => LHS -> ScoperT a m (LookupResult a)
-lookupLHSM = embedScopes lookupLHS
-
-lookupIdentM :: Monad m => Identifier -> ScoperT a m (LookupResult a)
-lookupIdentM = embedScopes lookupIdent
-
-lookupAccessesM :: Monad m => [Access] -> ScoperT a m (LookupResult a)
-lookupAccessesM = embedScopes lookupAccesses
+class ScopeKey k where
+    lookupElem :: Scopes a -> k -> LookupResult a
+    lookupElemM :: Monad m => k -> ScoperT a m (LookupResult a)
+    lookupElemM = embedScopes lookupElem
 
-lookupExpr :: Scopes a -> Expr -> LookupResult a
-lookupExpr scopes = join . fmap (lookupAccesses scopes) . exprToAccesses
+instance ScopeKey Expr where
+    lookupElem scopes = join . fmap (lookupAccesses scopes) . exprToAccesses
 
-lookupLHS :: Scopes a -> LHS -> LookupResult a
-lookupLHS scopes = join . fmap (lookupAccesses scopes) . lhsToAccesses
+instance ScopeKey LHS where
+    lookupElem scopes = lookupElem scopes . lhsToExpr
 
-lookupIdent :: Scopes a -> Identifier -> LookupResult a
-lookupIdent scopes ident = lookupAccesses scopes [Access ident Nil]
+instance ScopeKey Identifier where
+    lookupElem scopes ident = lookupAccesses scopes [Access ident Nil]
 
 lookupAccesses :: Scopes a -> [Access] -> LookupResult a
 lookupAccesses scopes accesses = do

src/Convert/SizeCast.hs

@@ -71,7 +71,7 @@ traverseExprM =
                 fallback = convertCastM (Number s) (Number n)
                 num = return . Number
         convertExprM (Cast (Right (Ident x)) e) = do
-            details <- lookupIdentM x
+            details <- lookupElemM x
             -- can't convert this cast yet because x could be a typename
             if details == Nothing
                 then return $ Cast (Right $ Ident x) e
@@ -102,7 +102,7 @@ traverseExprM =
 
         convertCastWithSigningM :: Expr -> Expr -> Signing -> Scoper Type Expr
         convertCastWithSigningM s e sg = do
-            details <- lookupIdentM $ castFnName s sg
+            details <- lookupElemM $ castFnName s sg
             when (details == Nothing) $ injectItem $ MIPackageItem $ castFn s sg
             let f = castFnName s sg
             let args = Args [e] []
@@ -164,7 +164,7 @@ exprSigning scopes (BinOp op e1 e2) =
             ShiftAR -> curry fst
             _ -> \_ _ -> Just Unspecified
 exprSigning scopes expr =
-    case lookupExpr scopes expr of
+    case lookupElem scopes expr of
         Just (_, _, t) -> typeSigning t
         Nothing -> Just Unspecified
 

src/Convert/Struct.hs

@@ -305,7 +305,7 @@ convertExpr _ other = other
 
 fallbackType :: Scopes Type -> Expr -> (Type, Expr)
 fallbackType scopes e =
-    case lookupExpr scopes e of
+    case lookupElem scopes e of
         Nothing -> (unknownType, e)
         Just (_, _, t) -> (t, e)
 
@@ -463,7 +463,7 @@ convertCall scopes fn (Args pnArgs kwArgs) =
         convertArg lhs (x, e) =
             (x, e')
             where
-                details = lookupLHS scopes $ LHSDot lhs x
+                details = lookupElem scopes $ LHSDot lhs x
                 typ = maybe unknownType thd3 details
                 thd3 (_, _, c) = c
                 (_, e') = convertSubExpr scopes $ convertExpr typ e

src/Convert/TypeOf.hs

@@ -55,7 +55,7 @@ traverseTypeM other = return other
 
 lookupTypeOf :: Expr -> Scoper Type Type
 lookupTypeOf expr = do
-    details <- lookupExprM expr
+    details <- lookupElemM expr
     case details of
         Nothing -> return $ TypeOf expr
         -- functions with no return type implicitly return a single bit

src/Convert/Typedef.hs

@@ -21,12 +21,12 @@ convert = map $ traverseDescriptions $ partScoper
 
 traverseTypeOrExprM :: TypeOrExpr -> Scoper Type TypeOrExpr
 traverseTypeOrExprM (Left (TypeOf (Ident x))) = do
-    details <- lookupIdentM x
+    details <- lookupElemM x
     return $ case details of
         Nothing -> Left $ TypeOf $ Ident x
         Just (_, _, typ) -> Left typ
 traverseTypeOrExprM (Right (Ident x)) = do
-    details <- lookupIdentM x
+    details <- lookupElemM x
     return $ case details of
         Nothing -> Right $ Ident x
         Just (_, _, typ) -> Left typ
@@ -84,7 +84,7 @@ traverseStmtM =
 
 traverseTypeM :: Type -> Scoper Type Type
 traverseTypeM (Alias st rs1) = do
-    details <- lookupIdentM st
+    details <- lookupElemM st
     return $ case details of
         Nothing -> Alias st rs1
         Just (_, _, typ) -> case typ of

src/Convert/UnpackedArray.hs

@@ -15,50 +15,56 @@
 module Convert.UnpackedArray (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.Scoper
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
-type DeclMap = Map.Map Identifier Decl
-type DeclSet = Set.Set Decl
-
-type ST = StateT DeclMap (Writer DeclSet)
+type Location = [Identifier]
+type Locations = Set.Set Location
+type ST = ScoperT Decl (State Locations)
 
 convert :: [AST] -> [AST]
 convert = map $ traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
-convertDescription description =
-    traverseModuleItems (traverseDecls $ packDecl declsToPack) description'
+convertDescription (description @ (Part _ _ Module _ _ _ _)) =
+    evalState (operation description) Set.empty
     where
-        (description', declsToPack) = runWriter $
-            scopedConversionM traverseDeclM traverseModuleItemM traverseStmtM
-            Map.empty description
+        operation =
+            partScoperT traverseDeclM traverseModuleItemM noop traverseStmtM >=>
+            partScoperT rewriteDeclM noop noop noop
+        noop = return
+convertDescription other = other
 
--- collects and converts multi-dimensional packed-array declarations
+-- tracks multi-dimensional unpacked array declarations
 traverseDeclM :: Decl -> ST Decl
-traverseDeclM (orig @ (Variable dir _ x _ e)) = do
-    modify $ Map.insert x orig
-    () <- if dir /= Local || e /= Nil
-        then lift $ tell $ Set.singleton orig
+traverseDeclM (decl @ (Variable _ _ _ [] _)) = return decl
+traverseDeclM (decl @ (Variable dir _ x _ e)) = do
+    insertElem x decl
+    if dir /= Local || e /= Nil
+        then flatUsageM x
         else return ()
-    return orig
+    return decl
 traverseDeclM other = return other
 
--- pack the given decls marked for packing
-packDecl :: DeclSet -> Decl -> Decl
-packDecl decls (orig @ (Variable d t x a e)) = do
-    if Set.member orig decls
+-- pack decls marked for packing
+rewriteDeclM :: Decl -> ST Decl
+rewriteDeclM (decl @ (Variable _ _ _ [] _)) = return decl
+rewriteDeclM (decl @ (Variable d t x a e)) = do
+    insertElem x decl
+    details <- lookupElemM x
+    let Just (accesses, _, _) = details
+    let location = map accessName accesses
+    usedAsPacked <- lift $ gets $ Set.member location
+    if usedAsPacked
         then do
             let (tf, rs) = typeRanges t
             let t' = tf $ a ++ rs
-            Variable d t' x [] e
-        else orig
-packDecl _ other = other
-
+            return $ Variable d t' x [] e
+        else return decl
+rewriteDeclM other = return other
 
 traverseModuleItemM :: ModuleItem -> ST ModuleItem
 traverseModuleItemM =
@@ -73,10 +79,9 @@ traverseModuleItemM' (Instance a b c d bindings) = do
     return $ Instance a b c d bindings'
     where
         collectBinding :: PortBinding -> ST PortBinding
-        collectBinding (y, Ident x) = do
+        collectBinding (y, x) = do
             flatUsageM x
-            return (y, Ident x)
-        collectBinding other = return other
+            return (y, x)
 traverseModuleItemM' other = return other
 
 traverseStmtM :: Stmt -> ST Stmt
@@ -86,40 +91,29 @@ traverseStmtM =
     traverseStmtAsgnsM traverseAsgnM
 
 traverseExprM :: Expr -> ST Expr
-traverseExprM (Range (Ident x) mode i) = do
-    flatUsageM x
-    return $ Range (Ident x) mode i
+traverseExprM (Range x mode i) =
+    flatUsageM x >> return (Range x mode i)
 traverseExprM other = return other
 
 traverseLHSM :: LHS -> ST LHS
-traverseLHSM (LHSIdent x) = do
-    flatUsageM x
-    return $ LHSIdent x
-traverseLHSM other = return other
+traverseLHSM x = flatUsageM x >> return x
 
 traverseAsgnM :: (LHS, Expr) -> ST (LHS, Expr)
-traverseAsgnM (LHSIdent x, Mux cond (Ident y) (Ident z)) = do
+traverseAsgnM (x, Mux cond y z) = do
     flatUsageM x
     flatUsageM y
     flatUsageM z
-    return (LHSIdent x, Mux cond (Ident y) (Ident z))
-traverseAsgnM (LHSIdent x, Mux cond y (Ident z)) = do
-    flatUsageM x
-    flatUsageM z
-    return (LHSIdent x, Mux cond y (Ident z))
-traverseAsgnM (LHSIdent x, Mux cond (Ident y) z) = do
-    flatUsageM x
-    flatUsageM y
-    return (LHSIdent x, Mux cond (Ident y) z)
-traverseAsgnM (LHSIdent x, Ident y) = do
+    return (x, Mux cond y z)
+traverseAsgnM (x, y) = do
     flatUsageM x
     flatUsageM y
-    return (LHSIdent x, Ident y)
-traverseAsgnM other = return other
+    return (x, y)
 
-flatUsageM :: Identifier -> ST ()
+flatUsageM :: ScopeKey e => e -> ST ()
 flatUsageM x = do
-    declMap <- get
-    case Map.lookup x declMap of
-        Just decl -> lift $ tell $ Set.singleton decl
+    details <- lookupElemM x
+    case details of
+        Just (accesses, _, _) -> do
+            let location = map accessName accesses
+            lift $ modify $ Set.insert location
         Nothing -> return ()

src/Convert/Wildcard.hs

@@ -63,7 +63,7 @@ traverseExprM = traverseNestedExprsM $ embedScopes convertExpr
 lookupPattern :: Scopes Number -> Expr -> Maybe Number
 lookupPattern _ (Number n) = Just n
 lookupPattern scopes e =
-    case lookupExpr scopes e of
+    case lookupElem scopes e of
         Nothing -> Nothing
         Just (_, _, n) -> Just n
 

test/basic/array.sv

@@ -9,4 +9,13 @@ module top;
     logic [1:0] e [3];
     initial x = 0;
     assign c = x ? d : e;
+
+    generate
+        begin : A
+            logic [1:0] c [3];
+            logic [1:0] d [3];
+        end
+    endgenerate
+    assign A.d = 0;
+    initial $display("%b %b", A.c[0], A.d[0]);
 endmodule

test/basic/array.v

@@ -9,4 +9,13 @@ module top;
     wire [5:0] e;
     initial x = 0;
     assign c = x ? d : e;
+
+    generate
+        begin : A
+            wire [1:0] c [0:2];
+            wire [5:0] d;
+        end
+    endgenerate
+    assign A.d = 0;
+    initial $display("%b %b", A.c[0], A.d[1:0]);
 endmodule