support type operator on simple expressions

src/Convert.hs

@@ -40,6 +40,7 @@ import qualified Convert.StmtBlock
 import qualified Convert.Stream
 import qualified Convert.Struct
 import qualified Convert.Typedef
+import qualified Convert.TypeOf
 import qualified Convert.UnbasedUnsized
 import qualified Convert.Unique
 import qualified Convert.UnpackedArray
@@ -72,6 +73,7 @@ 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/Traverse.hs

@@ -519,6 +519,8 @@ exprMapperHelpers exprMapper =
     maybeExprMapper (Just e) =
         exprMapper e >>= return . Just
 
+    typeMapper' (TypeOf expr) =
+        exprMapper expr >>= return . TypeOf
     typeMapper' t = do
         let (tf, rs) = typeRanges t
         rs' <- mapM rangeMapper rs
@@ -873,6 +875,7 @@ 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
 
 traverseNestedTypes :: Mapper Type -> Mapper Type
 traverseNestedTypes = unmonad traverseNestedTypesM

src/Convert/TypeOf.hs

+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Conversion for the `type` operator
+ -
+ - TODO: This conversion only supports the most basic expressions so far. We can
+ - add support for range and bit accesses, struct fields, and perhaps even
+ - arithmetic operations. Bits and pieces of similar logic exist in other
+ - conversion.
+ -}
+
+module Convert.TypeOf (convert) where
+
+import Control.Monad.State
+import Data.Maybe (mapMaybe)
+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 = map $ traverseDescriptions convertDescription
+
+convertDescription :: Description -> Description
+convertDescription (description @ Part{}) =
+    scopedConversion traverseDeclM traverseModuleItemM traverseStmtM
+        initialState description
+    where
+        Part _ _ _ _ _ _ items = description
+        initialState = Map.fromList $ mapMaybe returnType items
+        returnType :: ModuleItem -> Maybe (Identifier, (Type, [Range]))
+        returnType (MIPackageItem (Function _ t f _ _)) =
+            Just (f, (t', []))
+            where t' = if t == Implicit Unspecified []
+                    then IntegerVector TLogic Unspecified []
+                    else 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'
+
+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'
+
+traverseTypeM :: Type -> State Info Type
+traverseTypeM (TypeOf expr) = typeof expr
+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
+typeof (orig @ (Call (Ident x) _)) = do
+    res <- gets $ Map.lookup x
+    return $ maybe (TypeOf orig) injectRanges 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

src/Convert/Typedef.hs

@@ -79,6 +79,7 @@ resolveType _ (NonInteger    kw      ) = NonInteger    kw
 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 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
@@ -96,3 +97,4 @@ resolveType types (Alias Nothing st rs1) =
         (Alias          ps x rs2) -> Alias          ps x $ 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

@@ -42,6 +42,7 @@ data Type
     | Struct   Packing      [Field]            [Range]
     | Union    Packing      [Field]            [Range]
     | InterfaceT Identifier (Maybe Identifier) [Range]
+    | TypeOf Expr
     deriving (Eq, Ord)
 
 instance Show Type where
@@ -60,6 +61,7 @@ instance Show Type where
             showVal (x, e) = x ++ (showAssignment e)
     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)
 
 showFields :: [Field] -> String
 showFields items = itemsStr
@@ -92,6 +94,7 @@ 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, [])
 
 nullRange :: Type -> ([Range] -> Type)
 nullRange t [] = t

src/Language/SystemVerilog/Parser/Parse.y

@@ -434,6 +434,7 @@ Type :: { Type }
   | Identifier "::" Identifier Dimensions { Alias (Just $1) $3 $4 }
 TypeNonIdent :: { Type }
   : PartialType OptSigning Dimensions { $1 $2 $3 }
+  | "type" "(" Expr ")" { TypeOf $3 }
 PartialType :: { Signing -> [Range] -> Type }
   : NetType                                 {                        Net           $1    }
   | IntegerVectorType                       {                        IntegerVector $1    }
@@ -618,6 +619,7 @@ DeclOrStmtToken :: { DeclToken }
   | "const" PartialType { DTType $2 }
   | "{" StreamOp StreamSize Concat "}" { DTStream $2 $3           (map toLHS $4) }
   | "{" StreamOp            Concat "}" { DTStream $2 (Number "1") (map toLHS $3) }
+  | opt("var") "type" "(" Expr ")" { DTType $ \Unspecified -> \[] -> TypeOf $4 }
 
 VariablePortIdentifiers :: { [(Identifier, Maybe Expr)] }
   : VariablePortIdentifier                             { [$1] }

sv2v.cabal

@@ -88,6 +88,7 @@ executable sv2v
     Convert.Struct
     Convert.Traverse
     Convert.Typedef
+    Convert.TypeOf
     Convert.UnbasedUnsized
     Convert.Unique
     Convert.UnpackedArray

test/basic/typeof.sv

+module top;
+    function f;
+        input x;
+        f = 1'b1 ^ x;
+        $display("f(%b) called", x);
+    endfunction
+
+    initial begin
+        type(f(0)) x = f(0);
+        $display("%b", x);
+        $display("%b", $bits(x));
+        $display("%b", $bits(type(x)));
+        $display("%b", $bits(logic [0:1+$bits(type(x))]));
+    end
+endmodule

test/basic/typeof.v

+module top;
+    function f;
+        input x;
+        begin
+            f = 1'b1 ^ x;
+            $display("f(%b) called", x);
+        end
+    endfunction
+
+    initial begin : block
+        reg x;
+        x = f(0);
+        $display("%b", x);
+        $display("%b", 32'd1);
+        $display("%b", 32'd1);
+        $display("%b", 32'd3);
+    end
+endmodule