From 5667bdb589006ada4564961c25dde6b12c434c82 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Tue, 14 Jul 2020 22:22:41 -0600 Subject: [PATCH] unpacked array conversion supports generate scoped data - added type class for looking up elements in scoped conversions --- src/Convert/Logic.hs | 6 +-- src/Convert/MultiplePacked.hs | 2 +- src/Convert/Scoper.hs | 44 ++++++---------- src/Convert/SizeCast.hs | 6 +-- src/Convert/Struct.hs | 4 +- src/Convert/TypeOf.hs | 2 +- src/Convert/Typedef.hs | 6 +-- src/Convert/UnpackedArray.hs | 98 ++++++++++++++++------------------- src/Convert/Wildcard.hs | 2 +- test/basic/array.sv | 9 ++++ test/basic/array.v | 9 ++++ 11 files changed, 93 insertions(+), 95 deletions(-) diff --git a/src/Convert/Logic.hs b/src/Convert/Logic.hs index f9d9a22..2e54cfa 100644 --- a/src/Convert/Logic.hs +++ b/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 diff --git a/src/Convert/MultiplePacked.hs b/src/Convert/MultiplePacked.hs index 92f3cd0..4a90073 100644 --- a/src/Convert/MultiplePacked.hs +++ b/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, diff --git a/src/Convert/Scoper.hs b/src/Convert/Scoper.hs index 123e920..65a9837 100644 --- a/src/Convert/Scoper.hs +++ b/src/Convert/Scoper.hs @@ -1,5 +1,6 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleInstances #-} {- sv2v - Author: Zachary Snow - @@ -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 +class ScopeKey k where + lookupElem :: Scopes a -> k -> LookupResult a + lookupElemM :: Monad m => k -> ScoperT a m (LookupResult a) + lookupElemM = embedScopes lookupElem -lookupLHSM :: Monad m => LHS -> ScoperT a m (LookupResult a) -lookupLHSM = embedScopes lookupLHS +instance ScopeKey Expr where + lookupElem scopes = join . fmap (lookupAccesses scopes) . exprToAccesses -lookupIdentM :: Monad m => Identifier -> ScoperT a m (LookupResult a) -lookupIdentM = embedScopes lookupIdent +instance ScopeKey LHS where + lookupElem scopes = lookupElem scopes . lhsToExpr -lookupAccessesM :: Monad m => [Access] -> ScoperT a m (LookupResult a) -lookupAccessesM = embedScopes lookupAccesses - -lookupExpr :: Scopes a -> Expr -> LookupResult a -lookupExpr scopes = join . fmap (lookupAccesses scopes) . exprToAccesses - -lookupLHS :: Scopes a -> LHS -> LookupResult a -lookupLHS scopes = join . fmap (lookupAccesses scopes) . lhsToAccesses - -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 diff --git a/src/Convert/SizeCast.hs b/src/Convert/SizeCast.hs index e308b6c..568d763 100644 --- a/src/Convert/SizeCast.hs +++ b/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 diff --git a/src/Convert/Struct.hs b/src/Convert/Struct.hs index 3866159..9b84081 100644 --- a/src/Convert/Struct.hs +++ b/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 diff --git a/src/Convert/TypeOf.hs b/src/Convert/TypeOf.hs index 0b22d85..74fa35e 100644 --- a/src/Convert/TypeOf.hs +++ b/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 diff --git a/src/Convert/Typedef.hs b/src/Convert/Typedef.hs index 8cc28ec..02cd607 100644 --- a/src/Convert/Typedef.hs +++ b/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 diff --git a/src/Convert/UnpackedArray.hs b/src/Convert/UnpackedArray.hs index 247dd2a..f869a9a 100644 --- a/src/Convert/UnpackedArray.hs +++ b/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 + return (x, Mux cond y z) +traverseAsgnM (x, y) = do flatUsageM x flatUsageM y - return (LHSIdent x, Mux cond (Ident y) z) -traverseAsgnM (LHSIdent x, Ident 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 () diff --git a/src/Convert/Wildcard.hs b/src/Convert/Wildcard.hs index 4e1986c..68b596b 100644 --- a/src/Convert/Wildcard.hs +++ b/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 diff --git a/test/basic/array.sv b/test/basic/array.sv index dc31c9d..63ea843 100644 --- a/test/basic/array.sv +++ b/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 diff --git a/test/basic/array.v b/test/basic/array.v index 1d3145d..5a11dd5 100644 --- a/test/basic/array.v +++ b/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