diff --git a/src/Convert.hs b/src/Convert.hs index 42a361f..a6809ae 100644 --- a/src/Convert.hs +++ b/src/Convert.hs @@ -64,6 +64,7 @@ phases excludes = , Convert.KWArgs.convert , Convert.LogOp.convert , Convert.MultiplePacked.convert + , Convert.TypeOf.convert , Convert.DimensionQuery.convert , Convert.ParamType.convert , Convert.SizeCast.convert @@ -73,7 +74,6 @@ phases excludes = , Convert.Stream.convert , Convert.Struct.convert , Convert.Typedef.convert - , Convert.TypeOf.convert , Convert.UnbasedUnsized.convert , Convert.Unique.convert , Convert.UnpackedArray.convert diff --git a/src/Convert/DimensionQuery.hs b/src/Convert/DimensionQuery.hs index e7b5ef9..b6c524e 100644 --- a/src/Convert/DimensionQuery.hs +++ b/src/Convert/DimensionQuery.hs @@ -11,22 +11,19 @@ - Functions on types are trivially elaborated based on the dimensions of that - type, so long as it has been resolved to a primitive type. - - - Functions on expressions requires a scoped traversal to determine the - - underlying type of expression. The conversion of `$bits` on expressions - - recursively breaks the expression into its subtypes and finds their sizes. + - Functions on expressions relies on the `type` operator and the `TypeOf` + - conversion to determine the underlying type of expression. The conversion of + - `$bits` on expressions recursively breaks the expression into its subtypes + - and finds their sizes. -} module Convert.DimensionQuery (convert) where -import Control.Monad.State import Data.List (elemIndex) -import qualified Data.Map.Strict as Map import Convert.Traverse import Language.SystemVerilog.AST -type Info = Map.Map Identifier (Type, [Range]) - convert :: [AST] -> [AST] convert files = if files == files' @@ -36,26 +33,7 @@ convert files = convertDescription :: Description -> Description convertDescription = - scopedConversion traverseDeclM traverseModuleItemM traverseStmtM Map.empty - -traverseDeclM :: Decl -> State Info Decl -traverseDeclM decl = do - case decl of - Variable _ t ident a _ -> modify $ Map.insert ident (elaborateType t, a) - Param _ t ident _ -> modify $ Map.insert ident (elaborateType t, []) - ParamType _ _ _ -> return () - item <- traverseModuleItemM (MIPackageItem $ Decl decl) - let MIPackageItem (Decl decl') = item - return decl' - -traverseModuleItemM :: ModuleItem -> State Info ModuleItem -traverseModuleItemM item = traverseExprsM traverseExprM item - -traverseStmtM :: Stmt -> State Info Stmt -traverseStmtM stmt = traverseStmtExprsM traverseExprM stmt - -traverseExprM :: Expr -> State Info Expr -traverseExprM = traverseNestedExprsM $ stately convertExpr + traverseModuleItems $ traverseExprs $ traverseNestedExprs convertExpr -- elaborate integer atom types to have explicit dimensions elaborateType :: Type -> Type @@ -74,33 +52,34 @@ elaborateType (IntegerAtom t sg) = atomSize TTime = 64 elaborateType other = other -convertExpr :: Info -> Expr -> Expr +convertExpr :: Expr -> Expr -- conversion for array dimensions functions -convertExpr info (DimsFn FnBits v) = - convertBits info v -convertExpr _ (DimsFn FnUnpackedDimensions (Left _)) = - Number "0" -convertExpr _ (DimsFn FnDimensions (Left t)) = - Number $ show $ +convertExpr (DimsFn FnBits v) = + convertBits v +convertExpr (DimsFn fn (Right e)) = + DimsFn fn $ Left $ TypeOf e +convertExpr (DimFn fn (Right e) d) = + DimFn fn (Left $ TypeOf e) d +convertExpr (orig @ (DimsFn FnUnpackedDimensions (Left t))) = case t of - IntegerAtom _ _ -> 1 - _ -> length $ snd $ typeRanges t -convertExpr info (DimsFn FnUnpackedDimensions (Right (Ident x))) = - case Map.lookup x info of - Nothing -> DimsFn FnUnpackedDimensions $ Right $ Ident x - Just (_, rs) -> Number $ show $ length rs -convertExpr info (DimsFn FnDimensions (Right (Ident x))) = - case Map.lookup x info of - Nothing -> DimsFn FnDimensions $ Right $ Ident x - Just (t, rs) -> DimsFn FnDimensions $ Left $ tf rsCombined - where - (tf, trs) = typeRanges t - rsCombined = rs ++ trs + UnpackedType _ rs -> Number $ show $ length rs + TypeOf{} -> orig + _ -> Number "0" +convertExpr (orig @ (DimsFn FnDimensions (Left t))) = + case t of + IntegerAtom{} -> Number "1" + Alias{} -> orig + TypeOf{} -> orig + UnpackedType t' rs -> + BinOp Add + (Number $ show $ length rs) + (DimsFn FnDimensions $ Left t') + _ -> Number $ show $ length $ snd $ typeRanges t -- conversion for array dimension functions on types -convertExpr _ (DimFn f (Left t) (Number str)) = - if dm == Nothing || isAlias t then +convertExpr (DimFn f (Left t) (Number str)) = + if dm == Nothing || isUnresolved t then DimFn f (Left t) (Number str) else if d <= 0 || d > length rs then Number "'x" @@ -112,80 +91,51 @@ convertExpr _ (DimFn f (Left t) (Number str)) = FnHigh -> endianCondExpr r (fst r) (snd r) FnSize -> rangeSize r where - (_, rs) = typeRanges $ elaborateType t + rs = case elaborateType t of + UnpackedType tInner rsOuter -> + rsOuter ++ (snd $ typeRanges $ elaborateType tInner) + _ -> snd $ typeRanges $ elaborateType t dm = readNumber str Just d = dm r = rs !! (d - 1) - isAlias :: Type -> Bool - isAlias (Alias _ _ _) = True - isAlias _ = False -convertExpr _ (DimFn f (Left t) d) = + isUnresolved :: Type -> Bool + isUnresolved (Alias{}) = True + isUnresolved (TypeOf{}) = True + isUnresolved _ = False +convertExpr (DimFn f (Left t) d) = DimFn f (Left t) d --- conversion for array dimension functions on expression -convertExpr info (DimFn f (Right (Ident x)) d) = - case Map.lookup x info of - Nothing -> DimFn f (Right (Ident x)) d - Just (t, rs) -> DimFn f (Left $ tf rsCombined) d - where - (tf, trs) = typeRanges t - rsCombined = rs ++ trs -convertExpr info (DimFn f (Right (Bit (Ident x) idx)) d) = - case Map.lookup x info of - Nothing -> DimFn f (Right $ Bit (Ident x) idx) d - Just (t, rs) -> DimFn f (Left t') d - where t' = popRange t rs -convertExpr _ (DimFn f (Right e) d) = - DimFn f (Right e) d +convertExpr other = other -convertExpr _ other = other - --- simplify a bits expression given scoped type information -convertBits :: Info -> TypeOrExpr -> Expr -convertBits _ (Left t) = +-- simplify a bits expression +convertBits :: TypeOrExpr -> Expr +convertBits (Left t) = case elaborateType t of IntegerVector _ _ rs -> dimensionsSize rs Implicit _ rs -> dimensionsSize rs Net _ _ rs -> dimensionsSize rs + UnpackedType t' rs -> + BinOp Mul + (dimensionsSize rs) + (DimsFn FnBits $ Left t') _ -> DimsFn FnBits $ Left t -convertBits info (Right e) = +convertBits (Right e) = case e of - Ident x -> - case Map.lookup x info of - Nothing -> DimsFn FnBits $ Right e - Just (t, rs) -> simplify $ BinOp Mul - (dimensionsSize rs) - (convertBits info $ Left t) Concat exprs -> foldl (BinOp Add) (Number "0") $ - map (convertBits info . Right) $ + map (convertBits . Right) $ exprs Range expr mode range -> simplify $ BinOp Mul size - (convertBits info $ Right $ Bit expr (Number "0")) + (convertBits $ Right $ Bit expr (Number "0")) where size = case mode of NonIndexed -> rangeSize range IndexedPlus -> snd range IndexedMinus -> snd range - Bit (Ident x) idx -> - case Map.lookup x info of - Nothing -> DimsFn FnBits $ Right $ Bit (Ident x) idx - Just (t, rs) -> - convertBits info $ Left t' - where t' = popRange t rs - Stream _ _ exprs -> convertBits info $ Right $ Concat exprs + Stream _ _ exprs -> convertBits $ Right $ Concat exprs Number n -> case elemIndex '\'' n of Nothing -> Number "32" Just idx -> Number $ take idx n - _ -> DimsFn FnBits $ Right e - --- combines the given type and dimensions and returns a new type with the --- innermost range removed -popRange :: Type -> [Range] -> Type -popRange t rs = - tf $ tail rsCombined - where - (tf, trs) = typeRanges t - rsCombined = rs ++ trs + _ -> DimsFn FnBits $ Left $ TypeOf e diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs index a6a8c20..d08d1eb 100644 --- a/src/Convert/Traverse.hs +++ b/src/Convert/Traverse.hs @@ -50,6 +50,9 @@ module Convert.Traverse , traverseNestedTypesM , traverseNestedTypes , collectNestedTypesM +, traverseExprTypesM +, traverseExprTypes +, collectExprTypesM , traverseTypesM , traverseTypes , collectTypesM @@ -422,10 +425,12 @@ traverseNestedExprsM :: Monad m => MapperM m Expr -> MapperM m Expr traverseNestedExprsM mapper = exprMapper where exprMapper e = mapper e >>= em + (_, _, _, _, typeMapper) = exprMapperHelpers exprMapper maybeExprMapper Nothing = return Nothing maybeExprMapper (Just e) = exprMapper e >>= return . Just - typeOrExprMapper (Left t) = return $ Left t + typeOrExprMapper (Left t) = + typeMapper t >>= return . Left typeOrExprMapper (Right e) = exprMapper e >>= return . Right exprOrRangeMapper (Left e) = @@ -861,6 +866,7 @@ traverseNestedTypesM mapper = fullMapper tm (IntegerVector kw sg rs) = return $ IntegerVector kw sg rs tm (IntegerAtom kw sg ) = return $ IntegerAtom kw sg tm (NonInteger kw ) = return $ NonInteger kw + tm (TypeOf expr ) = return $ TypeOf expr tm (InterfaceT x my r) = return $ InterfaceT x my r tm (Enum Nothing vals r) = return $ Enum Nothing vals r @@ -875,13 +881,35 @@ traverseNestedTypesM mapper = fullMapper types <- mapM fullMapper $ map fst fields let idents = map snd fields return $ Union p (zip types idents) r - tm (TypeOf expr) = return $ TypeOf expr + tm (UnpackedType t r) = do + t' <- fullMapper t + return $ UnpackedType t' r traverseNestedTypes :: Mapper Type -> Mapper Type traverseNestedTypes = unmonad traverseNestedTypesM collectNestedTypesM :: Monad m => CollectorM m Type -> CollectorM m Type collectNestedTypesM = collectify traverseNestedTypesM +traverseExprTypesM :: Monad m => MapperM m Type -> MapperM m Expr +traverseExprTypesM mapper = exprMapper + where + typeOrExprMapper (Right e) = return $ Right e + typeOrExprMapper (Left t) = + mapper t >>= return . Left + exprMapper (Cast (Left t) e) = + mapper t >>= \t' -> return $ Cast (Left t') e + exprMapper (DimsFn f tore) = + typeOrExprMapper tore >>= return . DimsFn f + exprMapper (DimFn f tore e) = do + tore' <- typeOrExprMapper tore + return $ DimFn f tore' e + exprMapper other = return other + +traverseExprTypes :: Mapper Type -> Mapper Expr +traverseExprTypes = unmonad traverseExprTypesM +collectExprTypesM :: Monad m => CollectorM m Type -> CollectorM m Expr +collectExprTypesM = collectify traverseExprTypesM + traverseTypesM :: Monad m => MapperM m Type -> MapperM m ModuleItem traverseTypesM mapper item = miMapper item >>= @@ -891,17 +919,7 @@ traverseTypesM mapper item = fullMapper = traverseNestedTypesM mapper maybeMapper Nothing = return Nothing maybeMapper (Just t) = fullMapper t >>= return . Just - typeOrExprMapper (Right e) = return $ Right e - typeOrExprMapper (Left t) = - fullMapper t >>= return . Left - exprMapper (Cast (Left t) e) = - fullMapper t >>= \t' -> return $ Cast (Left t') e - exprMapper (DimsFn f tore) = - typeOrExprMapper tore >>= return . DimsFn f - exprMapper (DimFn f tore e) = do - tore' <- typeOrExprMapper tore - return $ DimFn f tore' e - exprMapper other = return other + exprMapper = traverseExprTypesM fullMapper declMapper (Param s t x e) = fullMapper t >>= \t' -> return $ Param s t' x e declMapper (ParamType s x mt) = diff --git a/src/Convert/TypeOf.hs b/src/Convert/TypeOf.hs index 319c477..6330834 100644 --- a/src/Convert/TypeOf.hs +++ b/src/Convert/TypeOf.hs @@ -12,13 +12,13 @@ module Convert.TypeOf (convert) where import Control.Monad.State -import Data.Maybe (mapMaybe) +import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Map.Strict as Map import Convert.Traverse import Language.SystemVerilog.AST -type Info = Map.Map Identifier (Type, [Range]) +type Info = Map.Map Identifier Type convert :: [AST] -> [AST] convert = map $ traverseDescriptions convertDescription @@ -30,34 +30,37 @@ convertDescription (description @ Part{}) = where Part _ _ _ _ _ _ items = description initialState = Map.fromList $ mapMaybe returnType items - returnType :: ModuleItem -> Maybe (Identifier, (Type, [Range])) + returnType :: ModuleItem -> Maybe (Identifier, Type) returnType (MIPackageItem (Function _ t f _ _)) = - Just (f, (t', [])) - where t' = if t == Implicit Unspecified [] - then IntegerVector TLogic Unspecified [] - else t + if t == Implicit Unspecified [] + -- functions with no return type implicitly return a single bit + then Just (f, IntegerVector TLogic Unspecified []) + else Just (f, t) returnType _ = Nothing convertDescription other = other traverseDeclM :: Decl -> State Info Decl traverseDeclM decl = do - case decl of - Variable _ t ident a _ -> modify $ Map.insert ident (t, a) - Param _ t ident _ -> modify $ Map.insert ident (t, []) - ParamType _ _ _ -> return () item <- traverseModuleItemM (MIPackageItem $ Decl decl) let MIPackageItem (Decl decl') = item - return decl' + case decl' of + Variable d t ident a me -> do + let t' = injectRanges t a + modify $ Map.insert ident t' + return $ case t' of + UnpackedType t'' a' -> Variable d t'' ident a' me + _ -> Variable d t' ident [] me + Param _ t ident _ -> do + modify $ Map.insert ident t + return decl' + ParamType _ _ _ -> return decl' traverseModuleItemM :: ModuleItem -> State Info ModuleItem traverseModuleItemM item = traverseTypesM traverseTypeM item traverseStmtM :: Stmt -> State Info Stmt -traverseStmtM stmt = do - let item = Initial stmt - item' <- traverseModuleItemM item - let Initial stmt' = item' - return stmt' +traverseStmtM = + traverseStmtExprsM $ traverseNestedExprsM $ traverseExprTypesM traverseTypeM traverseTypeM :: Type -> State Info Type traverseTypeM (TypeOf expr) = typeof expr @@ -66,14 +69,23 @@ traverseTypeM other = return other typeof :: Expr -> State Info Type typeof (orig @ (Ident x)) = do res <- gets $ Map.lookup x - return $ maybe (TypeOf orig) injectRanges res + return $ fromMaybe (TypeOf orig) res typeof (orig @ (Call (Ident x) _)) = do res <- gets $ Map.lookup x - return $ maybe (TypeOf orig) injectRanges res + return $ fromMaybe (TypeOf orig) res +typeof (orig @ (Bit (Ident x) _)) = do + res <- gets $ Map.lookup x + return $ maybe (TypeOf orig) popRange res typeof other = return $ TypeOf other -- combines a type with unpacked ranges -injectRanges :: (Type, [Range]) -> Type -injectRanges (t, unpacked) = - tf $ packed ++ unpacked - where (tf, packed) = typeRanges t +injectRanges :: Type -> [Range] -> Type +injectRanges t [] = t +injectRanges (UnpackedType t rs) unpacked = UnpackedType t $ unpacked ++ rs +injectRanges t unpacked = UnpackedType t unpacked + +-- removes the outermost range of the given type +popRange :: Type -> Type +popRange t = + tf $ tail rs + where (tf, rs) = typeRanges t diff --git a/src/Convert/Typedef.hs b/src/Convert/Typedef.hs index 07180d3..a7d80af 100644 --- a/src/Convert/Typedef.hs +++ b/src/Convert/Typedef.hs @@ -51,6 +51,10 @@ convertDescription globalTypes description = MIPackageItem $ Comment $ "removed typedef: " ++ x removeTypedef other = other convertTypeOrExpr :: TypeOrExpr -> TypeOrExpr + convertTypeOrExpr (Left (TypeOf (Ident x))) = + if Map.member x types + then Left $ resolveType types (Alias Nothing x []) + else Left $ TypeOf (Ident x) convertTypeOrExpr (Right (Ident x)) = if Map.member x types then Left $ resolveType types (Alias Nothing x []) @@ -80,6 +84,7 @@ resolveType _ (InterfaceT x my rs) = InterfaceT x my rs resolveType _ (Enum Nothing vals rs) = Enum Nothing vals rs resolveType _ (Alias (Just ps) st rs) = Alias (Just ps) st rs resolveType _ (TypeOf expr) = TypeOf expr +resolveType _ (UnpackedType t rs) = UnpackedType t rs resolveType types (Enum (Just t) vals rs) = Enum (Just $ resolveType types t) vals rs resolveType types (Struct p items rs) = Struct p (map (resolveItem types) items) rs resolveType types (Union p items rs) = Union p (map (resolveItem types) items) rs @@ -95,6 +100,7 @@ resolveType types (Alias Nothing st rs1) = (Union p l rs2) -> Union p l $ rs1 ++ rs2 (InterfaceT x my rs2) -> InterfaceT x my $ rs1 ++ rs2 (Alias ps x rs2) -> Alias ps x $ rs1 ++ rs2 + (UnpackedType t rs2) -> UnpackedType t $ rs1 ++ rs2 (IntegerAtom kw sg ) -> nullRange (IntegerAtom kw sg) rs1 (NonInteger kw ) -> nullRange (NonInteger kw ) rs1 (TypeOf expr) -> nullRange (TypeOf expr) rs1 diff --git a/src/Language/SystemVerilog/AST/Type.hs b/src/Language/SystemVerilog/AST/Type.hs index efad496..7e59b02 100644 --- a/src/Language/SystemVerilog/AST/Type.hs +++ b/src/Language/SystemVerilog/AST/Type.hs @@ -43,6 +43,7 @@ data Type | Union Packing [Field] [Range] | InterfaceT Identifier (Maybe Identifier) [Range] | TypeOf Expr + | UnpackedType Type [Range] -- used internally deriving (Eq, Ord) instance Show Type where @@ -62,6 +63,7 @@ instance Show Type where show (Struct p items r) = printf "struct %s{\n%s\n}%s" (showPad p) (showFields items) (showRanges r) show (Union p items r) = printf "union %s{\n%s\n}%s" (showPad p) (showFields items) (showRanges r) show (TypeOf expr) = printf "type(%s)" (show expr) + show (UnpackedType t rs) = printf "UnpackedType(%s, %s)" (show t) (showRanges rs) showFields :: [Field] -> String showFields items = itemsStr @@ -94,7 +96,8 @@ typeRanges (Enum t v r) = (Enum t v, r) typeRanges (Struct p l r) = (Struct p l, r) typeRanges (Union p l r) = (Union p l, r) typeRanges (InterfaceT x my r) = (InterfaceT x my, r) -typeRanges (TypeOf expr) = (nullRange $ TypeOf expr, []) +typeRanges (TypeOf expr) = (UnpackedType $ TypeOf expr, []) +typeRanges (UnpackedType t rs) = (UnpackedType t, rs) nullRange :: Type -> ([Range] -> Type) nullRange t [] = t diff --git a/test/basic/dimensions.sv b/test/basic/dimensions.sv index 4247bae..1100d85 100644 --- a/test/basic/dimensions.sv +++ b/test/basic/dimensions.sv @@ -12,6 +12,7 @@ module top; typedef logic [16:1] Word; Word Ram[0:9]; + type(Ram) RamPair [2]; integer ints [3:0]; typedef struct packed { logic x, y, z; } T; logic [$size(T)-1:0] foo; @@ -22,6 +23,8 @@ module top; $display($bits(foo)); `EXHAUST(Ram); + `EXHAUST(RamPair); + `EXHAUST(RamPair[0]); `EXHAUST(Word); `EXHAUST(integer); `EXHAUST(bit); diff --git a/test/basic/dimensions.v b/test/basic/dimensions.v index ef8e8eb..20a65bd 100644 --- a/test/basic/dimensions.v +++ b/test/basic/dimensions.v @@ -15,6 +15,26 @@ module top; $display(1); $display(160); + $display(2, 2, 10); + $display(0, 0, 0); + $display(1, 1, 9); + $display(1, 1, 9); + $display(0, 0, 0); + $display(-1, -1, -1); + $display(3); + $display(2); + $display(320); + + $display(10, 10, 16); + $display(0, 0, 16); + $display(9, 9, 1); + $display(9, 9, 16); + $display(0, 0, 1); + $display(-1, -1, 1); + $display(2); + $display(1); + $display(160); + $display(16, 16, 1'bx); $display(16, 16, 1'bx); $display(1, 1, 1'bx); diff --git a/test/basic/shadow_recurse.sv b/test/basic/shadow_recurse.sv new file mode 100644 index 0000000..ac3b91c --- /dev/null +++ b/test/basic/shadow_recurse.sv @@ -0,0 +1,55 @@ +module top; + + initial begin + logic x; + $display($bits(x)); + begin + logic [0:$bits(x)] x; + $display($bits(x)); + begin + logic [0:$bits(x)] x; + $display($bits(x)); + end + end + end + + initial begin + logic x; + $display($bits(type(x))); + begin + logic [0:$bits(type(x))] x; + $display($bits(type(x))); + begin + logic [0:$bits(type(x))] x; + $display($bits(type(x))); + end + end + end + + initial begin + logic x; + $display($bits(x)); + begin + logic [0:$bits(type(x))] x; + $display($bits(x)); + begin + logic [0:$bits(type(x))] x; + $display($bits(x)); + end + end + end + + initial begin + logic x; + $display($bits(type(x))); + begin + logic [0:$bits(x)] x; + $display($bits(type(x))); + begin + logic [0:$bits(x)] x; + $display($bits(type(x))); + end + end + end + +endmodule diff --git a/test/basic/shadow_recurse.v b/test/basic/shadow_recurse.v new file mode 100644 index 0000000..65b1ce8 --- /dev/null +++ b/test/basic/shadow_recurse.v @@ -0,0 +1,27 @@ +module top; + + initial begin + $display(1); + $display(2); + $display(3); + end + + initial begin + $display(1); + $display(2); + $display(3); + end + + initial begin + $display(1); + $display(2); + $display(3); + end + + initial begin + $display(1); + $display(2); + $display(3); + end + +endmodule