Commit b19259c6 by Zachary Snow

upgraded size cast conversion

- support casts of generate scoped expressions
- support casts to sizes involving genvars
parent 2d3973e6
......@@ -29,6 +29,7 @@ module Convert.Scoper
, partScoper
, partScoperT
, insertElem
, injectItem
, lookupExpr
, lookupLHS
, lookupIdent
......@@ -81,6 +82,7 @@ data Scopes a = Scopes
{ sCurrent :: [Tier]
, sMapping :: Mapping a
, sProcedure :: Bool
, sInjected :: [ModuleItem]
} deriving Show
embedScopes :: Monad m => (Scopes a -> b -> c) -> b -> ScoperT a m c
......@@ -100,46 +102,37 @@ setScope (Tier name _ : tiers) newEntry =
enterScope :: Monad m => Identifier -> Identifier -> ScoperT a m ()
enterScope name index = do
current <- gets sCurrent
let current' = current ++ [Tier name index]
s <- get
let current' = sCurrent s ++ [Tier name index]
existingResult <- lookupIdentM name
let existingElement = fmap thd3 existingResult
let entry = Entry existingElement index Map.empty
mapping <- gets sMapping
let mapping' = setScope current' entry mapping
procedure <- gets sProcedure
put $ Scopes current' mapping' procedure
let mapping' = setScope current' entry $ sMapping s
put $ s { sCurrent = current', sMapping = mapping'}
where thd3 (_, _, c) = c
exitScope :: Monad m => Identifier -> Identifier -> ScoperT a m ()
exitScope name index = do
let tier = Tier name index
current <- gets sCurrent
mapping <- gets sMapping
procedure <- gets sProcedure
s <- get
let current = sCurrent s
if null current || last current /= tier
then error "exitScope invariant violated"
else do
let current' = init current
put $ Scopes current' mapping procedure
else put $ s { sCurrent = init current}
enterProcedure :: Monad m => ScoperT a m ()
enterProcedure = do
current <- gets sCurrent
mapping <- gets sMapping
procedure <- gets sProcedure
if procedure
s <- get
if sProcedure s
then error "enterProcedure invariant failed"
else put $ Scopes current mapping True
else put $ s { sProcedure = True }
exitProcedure :: Monad m => ScoperT a m ()
exitProcedure = do
current <- gets sCurrent
mapping <- gets sMapping
procedure <- gets sProcedure
if not procedure
s <- get
if not (sProcedure s)
then error "exitProcedure invariant failed"
else put $ Scopes current mapping False
else put $ s { sProcedure = False }
tierToAccess :: Tier -> Access
tierToAccess (Tier x "") = Access x Nil
......@@ -161,12 +154,22 @@ lhsToAccesses = exprToAccesses . lhsToExpr
insertElem :: Monad m => Identifier -> a -> ScoperT a m ()
insertElem name element = do
current <- gets sCurrent
mapping <- gets sMapping
procedure <- gets sProcedure
s <- get
let current = sCurrent s
let mapping = sMapping s
let entry = Entry (Just element) "" Map.empty
let mapping' = setScope (current ++ [Tier name ""]) entry mapping
put $ Scopes current mapping' procedure
put $ s { sMapping = mapping' }
injectItem :: Monad m => ModuleItem -> ScoperT a m ()
injectItem item =
modify' $ \s -> s { sInjected = add $ sInjected s }
where
add :: [ModuleItem] -> [ModuleItem]
add items =
if elem item items
then items
else items ++ [item]
type Replacements = Map.Map Identifier Expr
......@@ -256,10 +259,10 @@ evalScoperT declMapper moduleItemMapper genItemMapper stmtMapper topName items =
operation :: ScoperT a m [ModuleItem]
operation = do
enterScope topName ""
items' <- mapM fullModuleItemMapper items
items' <- mapM wrappedModuleItemMapper items
exitScope topName ""
return items'
initialState = Scopes [] Map.empty False
initialState = Scopes [] Map.empty False []
fullStmtMapper :: Stmt -> ScoperT a m Stmt
fullStmtMapper (Block kw name decls stmts) = do
......@@ -298,6 +301,16 @@ evalScoperT declMapper moduleItemMapper genItemMapper stmtMapper topName items =
argIdxDecl ParamType{} = Nothing
argIdxDecl CommentDecl{} = Nothing
wrappedModuleItemMapper :: ModuleItem -> ScoperT a m ModuleItem
wrappedModuleItemMapper item = do
item' <- fullModuleItemMapper item
injected <- gets sInjected
if null injected
then return item'
else do
modify' $ \s -> s { sInjected = [] }
injected' <- mapM fullModuleItemMapper injected
return $ Generate $ map GenModuleItem $ injected' ++ [item']
fullModuleItemMapper :: ModuleItem -> ScoperT a m ModuleItem
fullModuleItemMapper (MIPackageItem (Function ml t x decls stmts)) = do
enterProcedure
......@@ -353,13 +366,18 @@ evalScoperT declMapper moduleItemMapper genItemMapper stmtMapper topName items =
genItems' <- mapM fullGenItemMapper genItems
exitScope name index
return $ GenFor (index, a) b c (GenBlock name genItems')
scopeGenItemMapper (GenFor (index, a) b c genItem) = do
enterScope "" index
genItem' <- fullGenItemMapper genItem
exitScope "" index
return $ GenFor (index, a) b c genItem'
scopeGenItemMapper (GenBlock name genItems) = do
enterScope name ""
genItems' <- mapM fullGenItemMapper genItems
exitScope name ""
return $ GenBlock name genItems'
scopeGenItemMapper (GenModuleItem moduleItem) =
fullModuleItemMapper moduleItem >>= return . GenModuleItem
wrappedModuleItemMapper moduleItem >>= return . GenModuleItem
scopeGenItemMapper genItem =
traverseSinglyNestedGenItemsM fullGenItemMapper genItem
......
......@@ -7,63 +7,49 @@
module Convert.SizeCast (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.ExprUtils
import Convert.Scoper
import Convert.Traverse
import Language.SystemVerilog.AST
type TypeMap = Map.Map Identifier Type
type CastSet = Set.Set (Expr, Signing)
type ST = StateT TypeMap (Writer CastSet)
convert :: [AST] -> [AST]
convert = map convertFile
convertFile :: AST -> AST
convertFile descriptions =
descriptions' ++ map (uncurry castFn) funcs
where
results = map convertDescription descriptions
descriptions' = map fst results
funcs = Set.toList $ Set.unions $ map snd results
convert = map $ traverseDescriptions convertDescription
convertDescription :: Description -> (Description, CastSet)
convertDescription description =
(description', info)
where
(description', info) =
runWriter $
scopedConversionM traverseDeclM traverseModuleItemM traverseStmtM
Map.empty description
convertDescription :: Description -> Description
convertDescription = partScoper
traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
traverseDeclM :: Decl -> ST Decl
traverseDeclM :: Decl -> Scoper Type Decl
traverseDeclM decl = do
case decl of
Variable _ t x _ _ -> modify $ Map.insert x t
Param _ t x _ -> modify $ Map.insert x t
Variable _ t x _ _ -> insertElem x t
Param _ t x _ -> insertElem x t
ParamType _ _ _ -> return ()
CommentDecl _ -> return ()
return decl
traverseDeclExprsM traverseExprM decl
traverseModuleItemM :: ModuleItem -> Scoper Type ModuleItem
traverseModuleItemM (Genvar x) =
insertElem x (IntegerAtom TInteger Unspecified) >> return (Genvar x)
traverseModuleItemM item =
traverseExprsM traverseExprM item
traverseModuleItemM :: ModuleItem -> ST ModuleItem
traverseModuleItemM item = traverseExprsM traverseExprM item
traverseGenItemM :: GenItem -> Scoper Type GenItem
traverseGenItemM = return
traverseStmtM :: Stmt -> ST Stmt
traverseStmtM stmt = traverseStmtExprsM traverseExprM stmt
traverseStmtM :: Stmt -> Scoper Type Stmt
traverseStmtM = traverseStmtExprsM traverseExprM
pattern ConvertedUU :: Integer -> Integer -> Expr
pattern ConvertedUU a b = Number (Based 1 True Binary a b)
traverseExprM :: Expr -> ST Expr
traverseExprM :: Expr -> Scoper Type Expr
traverseExprM =
traverseNestedExprsM convertExprM
where
convertExprM :: Expr -> ST Expr
convertExprM :: Expr -> Scoper Type Expr
convertExprM (Cast (Right (Number s)) (Number n)) =
case n of
UnbasedUnsized{} -> fallback
......@@ -85,9 +71,9 @@ traverseExprM =
fallback = convertCastM (Number s) (Number n)
num = return . Number
convertExprM (Cast (Right (Ident x)) e) = do
typeMap <- get
details <- lookupIdentM x
-- can't convert this cast yet because x could be a typename
if Map.notMember x typeMap
if details == Nothing
then return $ Cast (Right $ Ident x) e
else convertCastM (Ident x) e
convertExprM (Cast (Right s) e) =
......@@ -100,7 +86,7 @@ traverseExprM =
convertExprM $ Cast (Right $ dimensionsSize rs) e
convertExprM other = return other
convertCastM :: Expr -> Expr -> ST Expr
convertCastM :: Expr -> Expr -> Scoper Type Expr
convertCastM (RawNum n) (ConvertedUU a b) =
return $ Number $ Based (fromIntegral n) False Binary
(extend a) (extend b)
......@@ -109,14 +95,15 @@ traverseExprM =
extend 1 = (2 ^ n) - 1
extend _ = error "not possible"
convertCastM s e = do
typeMap <- get
case exprSigning typeMap e of
signing <- embedScopes exprSigning e
case signing of
Just sg -> convertCastWithSigningM s e sg
_ -> return $ Cast (Right s) e
convertCastWithSigningM :: Expr -> Expr -> Signing -> ST Expr
convertCastWithSigningM :: Expr -> Expr -> Signing -> Scoper Type Expr
convertCastWithSigningM s e sg = do
lift $ tell $ Set.singleton (s, sg)
details <- lookupIdentM $ castFnName s sg
when (details == Nothing) $ injectItem $ MIPackageItem $ castFn s sg
let f = castFnName s sg
let args = Args [e] []
return $ Call (Ident f) args
......@@ -132,9 +119,8 @@ isSimpleExpr =
collectUnresolvedExprM (expr @ DimFn {}) = tell [expr]
collectUnresolvedExprM _ = return ()
castFn :: Expr -> Signing -> Description
castFn :: Expr -> Signing -> PackageItem
castFn e sg =
PackageItem $
Function Automatic t fnName [decl] [Return $ Ident inp]
where
inp = "inp"
......@@ -157,16 +143,12 @@ castFnName e sg =
_ -> shortHash e
name = "sv2v_cast_" ++ sizeStr ++ "_" ++ show sg
exprSigning :: TypeMap -> Expr -> Maybe Signing
exprSigning typeMap (Ident x) =
case Map.lookup x typeMap of
Just t -> typeSigning t
Nothing -> Just Unspecified
exprSigning typeMap (BinOp op e1 e2) =
exprSigning :: Scopes Type -> Expr -> Maybe Signing
exprSigning scopes (BinOp op e1 e2) =
combiner sg1 sg2
where
sg1 = exprSigning typeMap e1
sg2 = exprSigning typeMap e2
sg1 = exprSigning scopes e1
sg2 = exprSigning scopes e2
combiner = case op of
BitAnd -> combineSigning
BitXor -> combineSigning
......@@ -181,7 +163,10 @@ exprSigning typeMap (BinOp op e1 e2) =
ShiftAL -> curry fst
ShiftAR -> curry fst
_ -> \_ _ -> Just Unspecified
exprSigning _ _ = Just Unspecified
exprSigning scopes expr =
case lookupExpr scopes expr of
Just (_, _, t) -> typeSigning t
Nothing -> Just Unspecified
combineSigning :: Maybe Signing -> Maybe Signing -> Maybe Signing
combineSigning Nothing _ = Nothing
......
module top;
parameter WIDTH = 32;
generate
begin : A
int x = -235;
end
endgenerate
initial begin
logic [31:0] w = 1234;
int x = -235;
int y = 1234;
logic [4:0] z = y;
$display("%0d %0d", w, 5'(w));
$display("%0d %0d", x, 5'(x));
$display("%0d %0d", A.x, 5'(A.x));
$display("%0d %0d", y, 5'(y));
$display("%0d %0d", z, 5'(z));
$display("%0d %0d", w+1, 5'(w+1));
$display("%0d %0d", x+1, 5'(x+1));
$display("%0d %0d", A.x+1, 5'(A.x+1));
$display("%0d %0d", y+1, 5'(y+1));
$display("%0d %0d", z+1, 5'(z+1));
$display("%b %b", w, 40'(w));
$display("%b %b", x, 40'(x));
$display("%b %b", A.x, 40'(A.x));
$display("%b %b", y, 40'(y));
$display("%b %b", z, 40'(z));
$display("%0d %0d", w, ($clog2(WIDTH))'(w));
$display("%0d %0d", x, ($clog2(WIDTH))'(x));
$display("%0d %0d", A.x, ($clog2(WIDTH))'(A.x));
$display("%0d %0d", y, ($clog2(WIDTH))'(y));
$display("%0d %0d", z, ($clog2(WIDTH))'(z));
$display("%b", 32'(4));
......
module top;
generate
begin : A
reg signed [31:0] x;
end
endgenerate
initial begin : foo_block
reg [31:0] w;
reg signed [31:0] x;
reg signed [31:0] y;
reg [4:0] z;
w = 1234;
x = -235;
A.x = -235;
y = 1234;
z = y;
$display("%0d %0d", w, w[4:0]);
$display("%0d %0d", x, $signed(x[4:0]));
$display("%0d %0d", A.x, $signed(A.x[4:0]));
$display("%0d %0d", y, $signed(y[4:0]));
$display("%0d %0d", z, z[4:0]);
$display("%0d %0d", w+1, w[4:0]+1);
$display("%0d %0d", x+1, $signed(x[4:0])+1);
$display("%0d %0d", A.x+1, $signed(A.x[4:0])+1);
$display("%0d %0d", y+1, $signed(y[4:0])+1);
$display("%0d %0d", z+1, z[4:0]+1);
$display("%b %b", w, {8'b0, w});
$display("%b %b", x, {8'hFF, x});
$display("%b %b", A.x, {8'hFF, A.x});
$display("%b %b", y, {8'b0, y});
$display("%b %b", z, {35'b0, z});
$display("%0d %0d", w, w[4:0]);
$display("%0d %0d", x, $signed(x[4:0]));
$display("%0d %0d", A.x, $signed(A.x[4:0]));
$display("%0d %0d", y, $signed(y[4:0]));
$display("%0d %0d", z, z[4:0]);
$display("%b", 32'd4);
......
module top;
generate
for (genvar i = 1; i < 5; ++i) begin
initial begin
integer x, y;
x = $unsigned(i'(1'sb1));
y = $unsigned((i + 5)'(1'sb1));
$display("%0d %b %b", i, x, y);
end
for (genvar j = 3; j < 6; ++j) begin
initial begin
integer x;
x = $unsigned((i * j)'(1'sb1));
$display("%0d %0d %b", i, j, x);
end
end
end
endgenerate
endmodule
module top;
generate
genvar i, j;
for (i = 1; i < 5; i = i + 1) begin
initial begin : foo
integer x, y;
x = $unsigned(cast_i(1'sb1));
y = (1 << (i + 5)) - 1;
$display("%0d %b %b", i, x, y);
end
for (j = 3; j < 6; j = j + 1) begin
initial begin : bar
integer x;
x = (1 << (i * j)) - 1;
$display("%0d %0d %b", i, j, x);
end
end
function signed [i-1:0] cast_i;
input signed [i-1:0] inp;
cast_i = inp;
endfunction
end
endgenerate
endmodule
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment