expand type operator support

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

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

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,33 +881,45 @@ 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
 
-traverseTypesM :: Monad m => MapperM m Type -> MapperM m ModuleItem
-traverseTypesM mapper item =
-    miMapper item >>=
-    traverseDeclsM declMapper >>=
-    traverseExprsM (traverseNestedExprsM exprMapper)
+traverseExprTypesM :: Monad m => MapperM m Type -> MapperM m Expr
+traverseExprTypesM mapper = exprMapper
     where
-        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
+            mapper t >>= return . Left
         exprMapper (Cast (Left t) e) =
-            fullMapper t >>= \t' -> return $ 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 >>=
+    traverseDeclsM declMapper >>=
+    traverseExprsM (traverseNestedExprsM exprMapper)
+    where
+        fullMapper = traverseNestedTypesM mapper
+        maybeMapper Nothing = return Nothing
+        maybeMapper (Just t) = fullMapper t >>= return . Just
+        exprMapper = traverseExprTypesM fullMapper
         declMapper (Param s t x e) =
             fullMapper t >>= \t' -> return $ Param s t' x e
         declMapper (ParamType s x mt) =

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
+    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

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

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

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);

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);

test/basic/shadow_recurse.sv

+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

test/basic/shadow_recurse.v

+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