Skip to content

S
sv2v
Commit 85e3d0f5 by Zachary Snow
Options

initial generate block scoping support 

- significant refactor of struct conversion
- significant refactor of typedef conversion
- scoping support in multipack conversion
- scoping support in typeof conversion
parent 211e4b0e
Showing with 1215 additions and 606 deletions
src/Convert/MultiplePacked.hs
{-# LANGUAGE TupleSections #-}
{- sv2v
- Author: Zachary Snow <zach@zachjs.com>
-
......@@ -25,42 +26,34 @@
module Convert.MultiplePacked (convert) where
import Control.Monad.State
import Control.Monad ((>=>))
import Data.Tuple (swap)
import Data.Maybe (isJust)
import qualified Data.Map.Strict as Map
import Convert.Scoper
import Convert.Traverse
import Language.SystemVerilog.AST
type TypeInfo = (Type, [Range])
type Info = Map.Map Identifier TypeInfo
convert :: [AST] -> [AST]
convert = map $ traverseDescriptions convertDescription
convertDescription :: Description -> Description
convertDescription part @ Part{} =
scopedConversion traverseDeclM traverseModuleItemM traverseStmtM
instances part'
where
(part', instances) = runState
(traverseModuleItemsM traverseInstancesM part) Map.empty
convertDescription other = other
convert = map $ traverseDescriptions $ partScoper
traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
-- collects and converts declarations with multiple packed dimensions
traverseDeclM :: Decl -> State Info Decl
traverseDeclM :: Decl -> Scoper TypeInfo Decl
traverseDeclM (Variable dir t ident a e) = do
t' <- traverseTypeM t a ident
return $ Variable dir t' ident a e
traverseDeclExprsM traverseExprM $ Variable dir t' ident a e
traverseDeclM (Param s t ident e) = do
t' <- traverseTypeM t [] ident
return $ Param s t' ident e
traverseDeclM other = return other
traverseDeclExprsM traverseExprM $ Param s t' ident e
traverseDeclM other = traverseDeclExprsM traverseExprM other
traverseTypeM :: Type -> [Range] -> Identifier -> State Info Type
traverseTypeM :: Type -> [Range] -> Identifier -> Scoper TypeInfo Type
traverseTypeM t a ident = do
modify $ Map.insert ident (t, a)
insertElem ident (t, a)
t' <- case t of
Struct pk fields rs -> do
fields' <- flattenFields fields
......@@ -82,18 +75,20 @@ traverseTypeM t a ident = do
fieldTypes' <- mapM (\x -> traverseTypeM x [] "") fieldTypes
return $ zip fieldTypes' fieldNames
-- converts multi-dimensional instances
traverseInstancesM :: ModuleItem -> State Info ModuleItem
traverseInstancesM (Instance m p x rs l) = do
traverseModuleItemM :: ModuleItem -> Scoper TypeInfo ModuleItem
traverseModuleItemM (Instance m p x rs l) = do
-- converts multi-dimensional instances
rs' <- if length rs <= 1
then return rs
else do
let t = Implicit Unspecified rs
modify $ Map.insert x (t, [])
insertElem x (t, [])
let r1 : r2 : rest = rs
return $ (combineRanges r1 r2) : rest
return $ Instance m p x rs' l
traverseInstancesM other = return other
traverseExprsM traverseExprM $ Instance m p x rs' l
traverseModuleItemM item =
traverseLHSsM traverseLHSM item >>=
traverseExprsM traverseExprM
-- combines two ranges into one flattened range
combineRanges :: Range -> Range -> Range
......@@ -117,37 +112,38 @@ combineRanges r1 r2 = r
upper = BinOp Add (BinOp Mul size1 size2)
(BinOp Sub lower (Number "1"))
traverseModuleItemM :: ModuleItem -> State Info ModuleItem
traverseModuleItemM =
traverseLHSsM traverseLHSM >=>
traverseExprsM traverseExprM
traverseStmtM :: Stmt -> State Info Stmt
traverseStmtM :: Stmt -> Scoper TypeInfo Stmt
traverseStmtM =
traverseStmtLHSsM traverseLHSM >=>
traverseStmtExprsM traverseExprM
traverseExprM :: Expr -> State Info Expr
traverseExprM = traverseNestedExprsM $ stately traverseExpr
traverseExprM :: Expr -> Scoper TypeInfo Expr
traverseExprM = traverseNestedExprsM convertExprM
traverseGenItemM :: GenItem -> Scoper TypeInfo GenItem
traverseGenItemM = traverseGenItemExprsM traverseExprM
-- LHSs need to be converted too. Rather than duplicating the procedures, we
-- turn LHSs into expressions temporarily and use the expression conversion.
traverseLHSM :: LHS -> State Info LHS
traverseLHSM :: LHS -> Scoper TypeInfo LHS
traverseLHSM = traverseNestedLHSsM traverseLHSSingleM
where
-- We can't use traverseExprM directly because that would cause Exprs
-- inside of LHSs to be converted twice in a single cycle!
traverseLHSSingleM :: LHS -> State Info LHS
traverseLHSSingleM :: LHS -> Scoper TypeInfo LHS
traverseLHSSingleM lhs = do
let expr = lhsToExpr lhs
expr' <- stately traverseExpr expr
expr' <- convertExprM expr
case exprToLHS expr' of
Just lhs' -> return lhs'
Nothing -> error $ "multi-packed conversion created non-LHS from "
++ (show expr) ++ " to " ++ (show expr')
traverseExpr :: Info -> Expr -> Expr
traverseExpr typeMap =
convertExprM :: Expr -> Scoper TypeInfo Expr
convertExprM = embedScopes convertExpr
convertExpr :: Scopes TypeInfo -> Expr -> Expr
convertExpr scopes =
rewriteExpr
where
-- removes the innermost dimensions of the given type information, and
......@@ -165,19 +161,17 @@ traverseExpr typeMap =
-- given an expression, returns its type information and a tagged
-- version of the expression, if possible
levels :: Expr -> Maybe (TypeInfo, Expr)
levels (Ident x) =
case Map.lookup x typeMap of
Just a -> Just (a, Ident $ tag : x)
Nothing -> Nothing
levels (Bit expr a) =
fmap (dropLevel $ \expr' -> Bit expr' a) (levels expr)
case levels expr of
Just info -> Just $ dropLevel (\expr' -> Bit expr' a) info
Nothing -> fallbackLevels $ Bit expr a
levels (Range expr a b) =
fmap (dropLevel $ \expr' -> Range expr' a b) (levels expr)
levels (Dot expr x) =
case levels expr of
Just ((Struct _ fields [], []), expr') -> dropDot fields expr'
Just ((Union _ fields [], []), expr') -> dropDot fields expr'
_ -> Nothing
_ -> fallbackLevels $ Dot expr x
where
dropDot :: [Field] -> Expr -> Maybe (TypeInfo, Expr)
dropDot fields expr' =
......@@ -187,7 +181,14 @@ traverseExpr typeMap =
where
fieldMap = Map.fromList $ map swap fields
fieldType = fieldMap Map.! x
levels _ = Nothing
levels expr = fallbackLevels expr
fallbackLevels :: Expr -> Maybe (TypeInfo, Expr)
fallbackLevels expr =
fmap ((, expr) . thd3) res
where
res = lookupExpr scopes expr
thd3 (_, _, c) = c
-- given an expression, returns the two most significant (innermost,
-- leftmost) packed dimensions and a tagged version of the expression,
......
src/Convert/Scoper.hs 0 → 100644
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- sv2v
- Author: Zachary Snow <zach@zachjs.com>
-
- Standardized scope traversal utilities
-
- This module provides a series of "scopers" which track the scope of blocks,
- generate loops, tasks, and functions, and provides the ability to insert and
- lookup elements in a scope-aware way.
-
- The interfaces take in a mappers for each of: Decl, ModuleItem, GenItem, and
- Stmt. Note that Function, Task, Always, Initial, and Final are NOT passed
- through the ModuleItem mapper as those constructs only provide Stmts and
- Decls. For the same reason, Decl ModuleItems are not passed through the
- ModuleItem mapper.
-
- All of the mappers should not recursively traverse any of the items captured
- by any of the other mappers. Scope resolution enforces data declaration
- ordering.
-}
module Convert.Scoper
( Scoper
, ScoperT
, evalScoper
, evalScoperT
, partScoper
, partScoperT
, insertElem
, lookupExpr
, lookupLHS
, lookupIdent
, lookupAccesses
, lookupExprM
, lookupLHSM
, lookupIdentM
, lookupAccessesM
, Access
, Scopes
, embedScopes
) where
import Control.Monad.State
import Data.Functor.Identity (runIdentity)
import Data.List (inits)
import Data.Maybe (catMaybes)
import qualified Data.Map.Strict as Map
import Convert.Traverse
import Language.SystemVerilog.AST
-- user monad aliases
type Scoper a = State (Scopes a)
type ScoperT a m = StateT (Scopes a) m
-- one tier of scope construction
data Tier = Tier
{ tierName :: Identifier
, tierIndex :: Identifier
} deriving (Eq, Show)
-- one layer of scope inspection
data Access = Access
{ accessName :: Identifier
, accessIndex :: Expr
} deriving (Eq, Show)
type Mapping a = Map.Map Identifier (Entry a)
data Entry a = Entry
{ eElement :: Maybe a
, eIndex :: Identifier
, eMapping :: Mapping a
} deriving Show
data Scopes a = Scopes
{ sCurrent :: [Tier]
, sMapping :: Mapping a
} deriving Show
embedScopes :: Monad m => (Scopes a -> b -> c) -> b -> ScoperT a m c
embedScopes func x = do
scopes <- get
return $ func scopes x
setScope :: [Tier] -> Entry a -> Mapping a -> Mapping a
setScope [] _ = error "setScope invariant violated"
setScope [Tier name _] newEntry =
Map.insert name newEntry
setScope (Tier name _ : tiers) newEntry =
Map.adjust adjustment name
where
adjustment entry =
entry { eMapping = setScope tiers newEntry (eMapping entry) }
enterScope :: Monad m => Identifier -> Identifier -> ScoperT a m ()
enterScope name index = do
current <- gets sCurrent
let current' = current ++ [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
put $ Scopes current' 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
if null current || last current /= tier
then error "exitScope invariant violated"
else do
let current' = init current
put $ Scopes current' mapping
tierToAccess :: Tier -> Access
tierToAccess (Tier x "") = Access x Nil
tierToAccess (Tier x y) = Access x (Ident y)
exprToAccesses :: Expr -> Maybe [Access]
exprToAccesses (Ident x) = Just [Access x Nil]
exprToAccesses (Bit (Ident x) y) = Just [Access x y]
exprToAccesses (Bit (Dot e x) y) = do
accesses <- exprToAccesses e
Just $ accesses ++ [Access x y]
exprToAccesses (Dot e x) = do
accesses <- exprToAccesses e
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
current <- gets sCurrent
mapping <- gets sMapping
let entry = Entry (Just element) "" Map.empty
let mapping' = setScope (current ++ [Tier name ""]) entry mapping
put $ Scopes current mapping'
type Replacements = Map.Map Identifier Expr
attemptResolve :: Mapping a -> [Access] -> Maybe (Replacements, a)
attemptResolve _ [] = Nothing
attemptResolve mapping (Access x e : rest) = do
Entry maybeElement index subMapping <- Map.lookup x mapping
if null rest && e == Nil then
fmap (Map.empty, ) maybeElement
else do
(replacements, element) <- attemptResolve subMapping rest
if e /= Nil && not (null index) then do
let replacements' = Map.insert index e replacements
Just (replacements', element)
else if e == Nil && null index then
Just (replacements, element)
else
Nothing
type LookupResult a = Maybe ([Access], Replacements, a)
lookupExprM :: Monad m => Expr -> ScoperT a m (LookupResult a)
lookupExprM = embedScopes lookupExpr
lookupLHSM :: Monad m => LHS -> ScoperT a m (LookupResult a)
lookupLHSM = embedScopes lookupLHS
lookupIdentM :: Monad m => Identifier -> ScoperT a m (LookupResult a)
lookupIdentM = embedScopes lookupIdent
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]
lookupAccesses :: Scopes a -> [Access] -> LookupResult a
lookupAccesses scopes accesses = do
if null results
then Nothing
else Just $ last results
where
options = inits $ map tierToAccess (sCurrent scopes)
try option =
fmap toResult $ attemptResolve (sMapping scopes) full
where
full = option ++ accesses
toResult (a, b) = (full, a, b)
results = catMaybes $ map try options
evalScoper
:: MapperM (Scoper a) Decl
-> MapperM (Scoper a) ModuleItem
-> MapperM (Scoper a) GenItem
-> MapperM (Scoper a) Stmt
-> Identifier
-> [ModuleItem]
-> [ModuleItem]
evalScoper declMapper moduleItemMapper genItemMapper stmtMapper topName items =
runIdentity $ evalScoperT
declMapper moduleItemMapper genItemMapper stmtMapper topName items
evalScoperT
:: forall a m. Monad m
=> MapperM (ScoperT a m) Decl
-> MapperM (ScoperT a m) ModuleItem
-> MapperM (ScoperT a m) GenItem
-> MapperM (ScoperT a m) Stmt
-> Identifier
-> [ModuleItem]
-> m [ModuleItem]
evalScoperT declMapper moduleItemMapper genItemMapper stmtMapper topName items =
evalStateT operation initialState
where
operation :: ScoperT a m [ModuleItem]
operation = do
enterScope topName ""
items' <- mapM fullModuleItemMapper items
exitScope topName ""
return items'
initialState = Scopes [] Map.empty
fullStmtMapper :: Stmt -> ScoperT a m Stmt
fullStmtMapper (Block kw name decls stmts) = do
enterScope name ""
decls' <- mapM declMapper decls
stmts' <- mapM fullStmtMapper stmts
exitScope name ""
return $ Block kw name decls' stmts'
-- TODO: Do we need to support the various procedural loops?
fullStmtMapper stmt =
stmtMapper stmt >>= traverseSinglyNestedStmtsM fullStmtMapper
mapTFDecls :: [Decl] -> ScoperT a m [Decl]
mapTFDecls = mapTFDecls' 0
where
mapTFDecls' :: Int -> [Decl] -> ScoperT a m [Decl]
mapTFDecls' _ [] = return []
mapTFDecls' idx (decl : decls) =
case argIdxDecl decl of
Nothing -> do
decl' <- declMapper decl
decls' <- mapTFDecls' idx decls
return $ decl' : decls'
Just declFunc -> do
_ <- declMapper $ declFunc idx
decl' <- declMapper decl
decls' <- mapTFDecls' (idx + 1) decls
return $ decl' : decls'
argIdxDecl :: Decl -> Maybe (Int -> Decl)
argIdxDecl (Variable d t _ a e) =
if d == Local
then Nothing
else Just $ \i -> Variable d t (show i) a e
argIdxDecl Param{} = Nothing
argIdxDecl ParamType{} = Nothing
argIdxDecl CommentDecl{} = Nothing
fullModuleItemMapper :: ModuleItem -> ScoperT a m ModuleItem
fullModuleItemMapper (MIPackageItem (Function ml t x decls stmts)) = do
t' <- do
res <- declMapper $ Variable Local t x [] Nil
case res of
Variable Local newType _ [] Nil -> return newType
_ -> error $ "redirected func ret traverse failed: " ++ show res
enterScope x ""
decls' <- mapTFDecls decls
stmts' <- mapM fullStmtMapper stmts
exitScope x ""
return $ MIPackageItem $ Function ml t' x decls' stmts'
fullModuleItemMapper (MIPackageItem (Task ml x decls stmts)) = do
enterScope x ""
decls' <- mapTFDecls decls
stmts' <- mapM fullStmtMapper stmts
exitScope x ""
return $ MIPackageItem $ Task ml x decls' stmts'
fullModuleItemMapper (MIPackageItem (Decl decl)) =
declMapper decl >>= return . MIPackageItem . Decl
fullModuleItemMapper (AlwaysC kw stmt) =
fullStmtMapper stmt >>= return . AlwaysC kw
fullModuleItemMapper (Initial stmt) =
fullStmtMapper stmt >>= return . Initial
fullModuleItemMapper (Final stmt) =
fullStmtMapper stmt >>= return . Final
fullModuleItemMapper (Generate genItems) =
mapM fullGenItemMapper genItems >>= return . Generate
fullModuleItemMapper (MIAttr attr item) =
fullModuleItemMapper item >>= return . MIAttr attr
fullModuleItemMapper item = moduleItemMapper item
-- TODO: This doesn't yet support implicit naming of generate blocks as
-- blocks as described in Section 27.6.
fullGenItemMapper :: GenItem -> ScoperT a m GenItem
fullGenItemMapper = genItemMapper >=> scopeGenItemMapper
scopeGenItemMapper :: GenItem -> ScoperT a m GenItem
scopeGenItemMapper (GenFor (index, a) b c (GenBlock name genItems)) = do
enterScope name index
genItems' <- mapM fullGenItemMapper genItems
exitScope name index
return $ GenFor (index, a) b c (GenBlock name genItems')
scopeGenItemMapper (GenBlock name genItems) = do
enterScope name ""
genItems' <- mapM fullGenItemMapper genItems
exitScope name ""
return $ GenBlock name genItems'
scopeGenItemMapper (GenModuleItem moduleItem) =
fullModuleItemMapper moduleItem >>= return . GenModuleItem
scopeGenItemMapper genItem =
traverseSinglyNestedGenItemsM fullGenItemMapper genItem
partScoper
:: MapperM (Scoper a) Decl
-> MapperM (Scoper a) ModuleItem
-> MapperM (Scoper a) GenItem
-> MapperM (Scoper a) Stmt
-> Description
-> Description
partScoper declMapper moduleItemMapper genItemMapper stmtMapper part =
runIdentity $ partScoperT
declMapper moduleItemMapper genItemMapper stmtMapper part
partScoperT
:: Monad m
=> MapperM (ScoperT a m) Decl
-> MapperM (ScoperT a m) ModuleItem
-> MapperM (ScoperT a m) GenItem
-> MapperM (ScoperT a m) Stmt
-> Description
-> m Description
partScoperT declMapper moduleItemMapper genItemMapper stmtMapper =
mapper
where
operation = evalScoperT
declMapper moduleItemMapper genItemMapper stmtMapper
mapper (Part attrs extern kw liftetime name ports items) = do
items' <- operation name items
return $ Part attrs extern kw liftetime name ports items'
mapper description = return description
src/Convert/Struct.hs
......@@ -6,19 +6,17 @@
module Convert.Struct (convert) where
import Control.Monad.State
import Control.Monad.Writer
import Control.Monad ((>=>), when)
import Data.List (partition)
import Data.Tuple (swap)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Convert.Scoper
import Convert.Traverse
import Language.SystemVerilog.AST
type TypeFunc = [Range] -> Type
type StructInfo = (Type, Map.Map Identifier (Range, Expr))
type Types = Map.Map Identifier Type
type StructInfo = (Type, Map.Map Identifier Range)
convert :: [AST] -> [AST]
convert = map $ traverseDescriptions convertDescription
......@@ -26,51 +24,10 @@ convert = map $ traverseDescriptions convertDescription
convertDescription :: Description -> Description
convertDescription (description @ (Part _ _ Module _ _ _ _)) =
traverseModuleItems (traverseTypes' ExcludeParamTypes convertType) $
scopedConversion traverseDeclM' traverseModuleItemM
traverseStmtM tfArgTypes description
where
-- collect information about this description
tfArgTypes = execWriter $ collectModuleItemsM collectTFArgsM description
-- helpers for the scoped traversal
traverseDeclM' :: Decl -> State Types Decl
traverseDeclM' decl = do
decl' <- traverseDeclM decl
res <- traverseModuleItemM $ MIPackageItem $ Decl decl'
let MIPackageItem (Decl decl'') = res
return decl''
traverseModuleItemM :: ModuleItem -> State Types ModuleItem
traverseModuleItemM =
traverseLHSsM traverseLHSM >=>
traverseExprsM traverseExprM >=>
traverseAsgnsM traverseAsgnM
traverseStmtM :: Stmt -> State Types Stmt
traverseStmtM (Subroutine expr args) = do
stateTypes <- get
let stmt' = Subroutine expr $ convertCall stateTypes expr args
traverseStmtM' stmt'
traverseStmtM stmt = traverseStmtM' stmt
traverseStmtM' :: Stmt -> State Types Stmt
traverseStmtM' =
traverseStmtLHSsM traverseLHSM >=>
traverseStmtExprsM traverseExprM >=>
traverseStmtAsgnsM traverseAsgnM
traverseExprM =
traverseNestedExprsM $ stately converter
where
converter :: Types -> Expr -> Expr
converter types expr =
snd $ convertAsgn types (LHSIdent "", expr)
traverseLHSM =
traverseNestedLHSsM $ stately converter
where
converter :: Types -> LHS -> LHS
converter types lhs =
fst $ convertAsgn types (lhs, Ident "")
traverseAsgnM = stately convertAsgn
partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
description
convertDescription other = other
-- write down unstructured versions of packed struct types
convertStruct :: Type -> Maybe StructInfo
convertStruct (Struct Unpacked fields _) =
convertStruct' True Unspecified fields
......@@ -112,11 +69,9 @@ convertStruct' isStruct sg fields =
else map simplify $ map (BinOp Add (Number "-1")) fieldSizes
-- create the mapping structure for the unstructured fields
unstructOffsets = map simplify $ map snd fieldRanges
unstructRanges = zip fieldHis fieldLos
keys = map snd fields
vals = zip unstructRanges unstructOffsets
unstructFields = Map.fromList $ zip keys vals
unstructRanges = zip fieldHis fieldLos
unstructFields = Map.fromList $ zip keys unstructRanges
-- create the unstructured type; result type takes on the signing of the
-- struct itself to preserve behavior of operations on the whole struct
......@@ -135,9 +90,6 @@ convertStruct' isStruct sg fields =
isFlatIntVec _ = False
canUnstructure = all isFlatIntVec fieldTypes
isReadyStruct :: Type -> Bool
isReadyStruct = (Nothing /=) . convertStruct
-- convert a struct type to its unstructured equivalent
convertType :: Type -> Type
......@@ -148,375 +100,368 @@ convertType t1 =
where (tf2, rs2) = typeRanges t2
where (_, rs1) = typeRanges t1
collectTFArgsM :: ModuleItem -> Writer Types ()
collectTFArgsM (MIPackageItem item) = do
_ <- case item of
Function _ t f decls _ -> do
tell $ Map.singleton f t
mapM (collect f) (zip [0..] decls)
Task _ f decls _ ->
mapM (collect f) (zip [0..] decls)
_ -> return []
return ()
where
collect :: Identifier -> (Int, Decl) -> Writer Types ()
collect f (idx, (Variable _ t x _ _)) = do
tell $ Map.singleton (f ++ ":" ++ show idx) t
tell $ Map.singleton (f ++ ":" ++ x) t
collect _ _ = return ()
collectTFArgsM _ = return ()
-- write down the types of declarations
traverseDeclM :: Decl -> State Types Decl
traverseDeclM origDecl = do
case origDecl of
traverseDeclM :: Decl -> Scoper Type Decl
traverseDeclM decl = do
decl' <- case decl of
Variable d t x a e -> do
let (tf, rs) = typeRanges t
if isRangeable t
then modify $ Map.insert x (tf $ a ++ rs)
else return ()
e' <- convertDeclExpr x e
when (isRangeable t) $
insertElem x (tf $ a ++ rs)
let e' = convertExpr t e
return $ Variable d t x a e'
Param s t x e -> do
modify $ Map.insert x t
e' <- convertDeclExpr x e
insertElem x t
let e' = convertExpr t e
return $ Param s t x e'
ParamType{} -> return origDecl
CommentDecl{} -> return origDecl
ParamType{} -> return decl
CommentDecl{} -> return decl
traverseDeclExprsM traverseExprM decl'
where
convertDeclExpr :: Identifier -> Expr -> State Types Expr
convertDeclExpr x e = do
types <- get
let (LHSIdent _, e') = convertAsgn types (LHSIdent x, e)
return e'
isRangeable :: Type -> Bool
isRangeable (IntegerAtom _ _) = False
isRangeable (NonInteger _ ) = False
isRangeable IntegerAtom{} = False
isRangeable NonInteger{} = False
isRangeable _ = True
traverseGenItemM :: GenItem -> Scoper Type GenItem
traverseGenItemM = traverseGenItemExprsM traverseExprM
traverseModuleItemM :: ModuleItem -> Scoper Type ModuleItem
traverseModuleItemM =
traverseLHSsM traverseLHSM >=>
traverseExprsM traverseExprM >=>
traverseAsgnsM traverseAsgnM
traverseStmtM :: Stmt -> Scoper Type Stmt
traverseStmtM (Subroutine expr args) = do
argsMapper <- embedScopes convertCall expr
let args' = argsMapper args
let stmt' = Subroutine expr args'
traverseStmtM' stmt'
traverseStmtM stmt = traverseStmtM' stmt
traverseStmtM' :: Stmt -> Scoper Type Stmt
traverseStmtM' =
traverseStmtLHSsM traverseLHSM >=>
traverseStmtExprsM traverseExprM >=>
traverseStmtAsgnsM traverseAsgnM
traverseExprM :: Expr -> Scoper Type Expr
traverseExprM = traverseNestedExprsM $
embedScopes convertSubExpr >=> return . snd
traverseLHSM :: LHS -> Scoper Type LHS
traverseLHSM = traverseNestedLHSsM $ convertLHS >=> return . snd
-- removes the innermost range from the given type, if possible
dropInnerTypeRange :: Type -> Type
dropInnerTypeRange t =
case typeRanges t of
(_, []) -> Implicit Unspecified []
(_, []) -> unknownType
(tf, rs) -> tf $ tail rs
-- This is where the magic happens. This is responsible for converting struct
-- accesses, assignments, and literals, given appropriate information about the
-- structs and the current declaration context. The general strategy involves
-- looking at the innermost type of a node to convert outer uses of fields, and
-- then using the outermost type to figure out the corresponding struct
-- definition for struct literals that are encountered.
convertAsgn :: Types -> (LHS, Expr) -> (LHS, Expr)
convertAsgn types (lhs, expr) =
(lhs', expr')
unknownType :: Type
unknownType = Implicit Unspecified []
traverseAsgnM :: (LHS, Expr) -> Scoper Type (LHS, Expr)
traverseAsgnM (lhs, expr) = do
-- convert the LHS using the innermost type information
(typ, lhs') <- convertLHS lhs
-- convert the RHS using the LHS type information, and then the innermost
-- type information on the resulting RHS
(_, expr') <- embedScopes convertSubExpr $ convertExpr typ expr
return (lhs', expr')
specialTag :: Char
specialTag = ':'
defaultKey :: String
defaultKey = specialTag : "default"
structIsntReady :: Type -> Bool
structIsntReady = (Nothing ==) . convertStruct
-- try expression conversion by looking at the *outermost* type first
convertExpr :: Type -> Expr -> Expr
convertExpr _ Nil = Nil
convertExpr t (Mux c e1 e2) =
Mux c e1' e2'
where
(typ, lhs') = convertLHS lhs
expr' = snd $ convertSubExpr $ convertExpr typ expr
-- converting LHSs by looking at the innermost types first
convertLHS :: LHS -> (Type, LHS)
convertLHS l =
case exprToLHS e' of
Just l' -> (t, l')
Nothing -> error $ "struct conversion created non-LHS from "
++ (show e) ++ " to " ++ (show e')
where
e = lhsToExpr l
(t, e') = convertSubExpr e
specialTag = ':'
defaultKey = specialTag : "default"
-- try expression conversion by looking at the *outermost* type first
convertExpr :: Type -> Expr -> Expr
convertExpr _ Nil = Nil
convertExpr t (Mux c e1 e2) =
Mux c e1' e2'
where
e1' = convertExpr t e1
e2' = convertExpr t e2
-- TODO: This is really a conversion for using default patterns to
-- populate arrays. Maybe this should be somewhere else?
convertExpr (IntegerVector t sg (r:rs)) (Pattern [(":default", e)]) =
Repeat (rangeSize r) [e']
where e' = convertExpr (IntegerVector t sg rs) e
-- TODO: This is a conversion for concat array literals with elements
-- that are unsized numbers. This probably belongs somewhere else.
convertExpr (t @ IntegerVector{}) (Pattern items) =
if all (null . fst) items
then convertExpr t $ Concat $ map snd items
else Pattern items
convertExpr (t @ IntegerVector{}) (Concat exprs) =
if all isUnsizedNumber exprs
then Concat exprs'
else Concat exprs
where
caster = Cast (Left $ dropInnerTypeRange t)
exprs' = map caster exprs
isUnsizedNumber :: Expr -> Bool
isUnsizedNumber (Number n) = not $ elem '\'' n
isUnsizedNumber (UniOp UniSub e) = isUnsizedNumber e
isUnsizedNumber _ = False
convertExpr (Struct packing fields (_:rs)) (Concat exprs) =
Concat $ map (convertExpr (Struct packing fields rs)) exprs
convertExpr (Struct packing fields (_:rs)) (Bit e _) =
convertExpr (Struct packing fields rs) e
convertExpr (Struct packing fields []) (Pattern [("", Repeat (Number nStr) exprs)]) =
case fmap fromIntegral (readNumber nStr) of
Just n -> convertExpr (Struct packing fields []) $ Pattern $
zip (repeat "") (concat $ take n $ repeat exprs)
Nothing ->
error $ "unable to handle repeat in pattern: " ++
(show $ Repeat (Number nStr) exprs)
convertExpr (Struct packing fields []) (Pattern itemsOrig) =
if extraNames /= Set.empty then
error $ "pattern " ++ show (Pattern itemsOrig) ++
" has extra named fields: " ++
show (Set.toList extraNames) ++ " that are not in " ++
show structTf
else if isReadyStruct (structTf []) then
Concat
$ map (uncurry $ Cast . Left)
$ zip (map fst fields) (map snd items)
e1' = convertExpr t e1
e2' = convertExpr t e2
-- TODO: This is really a conversion for using default patterns to
-- populate arrays. Maybe this should be somewhere else?
convertExpr (IntegerVector t sg (r:rs)) (Pattern [(":default", e)]) =
Repeat (rangeSize r) [e']
where e' = convertExpr (IntegerVector t sg rs) e
-- TODO: This is a conversion for concat array literals with elements
-- that are unsized numbers. This probably belongs somewhere else.
convertExpr (t @ IntegerVector{}) (Pattern items) =
if all (null . fst) items
then convertExpr t $ Concat $ map snd items
else Pattern items
convertExpr (t @ IntegerVector{}) (Concat exprs) =
if all isUnsizedNumber exprs
then Concat exprs'
else Concat exprs
where
caster = Cast (Left $ dropInnerTypeRange t)
exprs' = map caster exprs
isUnsizedNumber :: Expr -> Bool
isUnsizedNumber (Number n) = not $ elem '\'' n
isUnsizedNumber (UniOp UniSub e) = isUnsizedNumber e
isUnsizedNumber _ = False
convertExpr (Struct packing fields (_:rs)) (Concat exprs) =
Concat $ map (convertExpr (Struct packing fields rs)) exprs
convertExpr (Struct packing fields (_:rs)) (Bit e _) =
convertExpr (Struct packing fields rs) e
convertExpr (Struct packing fields []) (Pattern [("", Repeat (Number nStr) exprs)]) =
case fmap fromIntegral (readNumber nStr) of
Just n -> convertExpr (Struct packing fields []) $ Pattern $
zip (repeat "") (concat $ take n $ repeat exprs)
Nothing ->
error $ "unable to handle repeat in pattern: " ++
(show $ Repeat (Number nStr) exprs)
convertExpr (struct @ (Struct _ fields [])) (Pattern itemsOrig) =
if extraNames /= Set.empty then
error $ "pattern " ++ show (Pattern itemsOrig) ++
" has extra named fields: " ++
show (Set.toList extraNames) ++ " that are not in " ++ show struct
else if structIsntReady struct then
Pattern items
else
Concat
$ map (uncurry $ Cast . Left)
$ zip (map fst fields) (map snd items)
where
fieldNames = map snd fields
fieldTypeMap = Map.fromList $ map swap fields
itemsNamed =
-- patterns either use positions based or name/type/default
if all ((/= "") . fst) itemsOrig then
itemsOrig
-- position-based patterns should cover every field
else if length itemsOrig /= length fields then
error $ "struct pattern " ++ show (Pattern itemsOrig) ++
" doesn't have the same # of items as " ++ show struct
-- if the pattern does not use identifiers, use the
-- identifiers from the struct type definition in order
else
Pattern items
where
structTf = Struct packing fields
fieldNames = map snd fields
fieldTypeMap = Map.fromList $ map swap fields
itemsNamed =
-- patterns either use positions based or name/type/default
if all ((/= "") . fst) itemsOrig then
itemsOrig
-- position-based patterns should cover every field
else if length itemsOrig /= length fields then
error $ "struct pattern " ++ show (Pattern itemsOrig) ++
" doesn't have the same # of items as " ++
show structTf
-- if the pattern does not use identifiers, use the
-- identifiers from the struct type definition in order
else
zip fieldNames (map snd itemsOrig)
(specialItems, namedItems) =
partition ((== specialTag) . head . fst) itemsNamed
namedItemMap = Map.fromList namedItems
specialItemMap = Map.fromList specialItems
extraNames = Set.difference
(Set.fromList $ map fst namedItems)
(Map.keysSet fieldTypeMap)
items = zip fieldNames $ map resolveField fieldNames
resolveField :: Identifier -> Expr
resolveField fieldName =
convertExpr fieldType $
-- look up by name
if Map.member fieldName namedItemMap then
namedItemMap Map.! fieldName
-- recurse for substructures
else if isStruct fieldType then
Pattern specialItems
-- look up by field type
else if Map.member fieldTypeName specialItemMap then
specialItemMap Map.! fieldTypeName
-- fall back on the default value
else if Map.member defaultKey specialItemMap then
specialItemMap Map.! defaultKey
else
error $ "couldn't find field " ++ fieldName ++
" from struct definition " ++ show structTf ++
" in struct pattern " ++ show itemsOrig
where
fieldType = fieldTypeMap Map.! fieldName
fieldTypeName =
specialTag : (show $ fst $ typeRanges fieldType)
isStruct :: Type -> Bool
isStruct (Struct{}) = True
isStruct _ = False
convertExpr (Struct packing fields (r : rs)) (Pattern items) =
if all null keys
then convertExpr (structTf (r : rs)) (Concat vals)
else Repeat (rangeSize r) [subExpr']
where
(keys, vals) = unzip items
subExpr = Pattern items
structTf = Struct packing fields
subExpr' = convertExpr (structTf rs) subExpr
convertExpr (Struct packing fields (r : rs)) subExpr =
Repeat (rangeSize r) [subExpr']
where
structTf = Struct packing fields
subExpr' = convertExpr (structTf rs) subExpr
convertExpr _ other = other
-- try expression conversion by looking at the *innermost* type first
convertSubExpr :: Expr -> (Type, Expr)
convertSubExpr (Ident x) =
case Map.lookup x types of
Nothing -> (Implicit Unspecified [], Ident x)
Just t -> (t, Ident x)
convertSubExpr (Dot e x) =
if maybeFields == Nothing
then (Implicit Unspecified [], Dot e' x)
else if not $ isReadyStruct (structTf [])
then (fieldType, Dot e' x)
else (dropInnerTypeRange fieldType, undotted)
where
(subExprType, e') = convertSubExpr e
maybeFields = getFields subExprType
Just (structTf, fields) = maybeFields
(fieldType, bounds, dims) = lookupFieldInfo structTf fields x
base = fst bounds
len = rangeSize bounds
[dim] = dims
undotted = if null dims || rangeSize dim == Number "1"
then Bit e' (fst bounds)
else Range e' IndexedMinus (base, len)
convertSubExpr (Range (Dot e x) NonIndexed rOuter) =
if maybeFields == Nothing
then (Implicit Unspecified [], orig')
else if not $ isReadyStruct (structTf [])
then (fieldType, orig')
else (dropInnerTypeRange fieldType, undotted)
zip fieldNames (map snd itemsOrig)
(specialItems, namedItems) =
partition ((== specialTag) . head . fst) itemsNamed
namedItemMap = Map.fromList namedItems
specialItemMap = Map.fromList specialItems
extraNames = Set.difference
(Set.fromList $ map fst namedItems)
(Map.keysSet fieldTypeMap)
items = zip fieldNames $ map resolveField fieldNames
resolveField :: Identifier -> Expr
resolveField fieldName =
convertExpr fieldType $
-- look up by name
if Map.member fieldName namedItemMap then
namedItemMap Map.! fieldName
-- recurse for substructures
else if isStruct fieldType then
Pattern specialItems
-- look up by field type
else if Map.member fieldTypeName specialItemMap then
specialItemMap Map.! fieldTypeName
-- fall back on the default value
else if Map.member defaultKey specialItemMap then
specialItemMap Map.! defaultKey
else
error $ "couldn't find field " ++ fieldName ++
" from struct definition " ++ show struct ++
" in struct pattern " ++ show itemsOrig
where
orig' = Range (Dot e' x) NonIndexed rOuter
(subExprType, e') = convertSubExpr e
maybeFields = getFields subExprType
Just (structTf, fields) = maybeFields
(fieldType, bounds, dims) = lookupFieldInfo structTf fields x
[dim] = dims
undotted = Range e' NonIndexed $
endianCondRange dim rangeLeft rangeRight
rangeLeft =
( BinOp Sub (fst bounds) $ BinOp Sub (fst dim) (fst rOuter)
fieldType = fieldTypeMap Map.! fieldName
fieldTypeName =
specialTag : (show $ fst $ typeRanges fieldType)
isStruct :: Type -> Bool
isStruct (Struct{}) = True
isStruct _ = False
convertExpr (Struct packing fields (r : rs)) (Pattern items) =
if all null keys
then convertExpr (structTf (r : rs)) (Concat vals)
else Repeat (rangeSize r) [subExpr']
where
(keys, vals) = unzip items
subExpr = Pattern items
structTf = Struct packing fields
subExpr' = convertExpr (structTf rs) subExpr
convertExpr (Struct packing fields (r : rs)) subExpr =
Repeat (rangeSize r) [subExpr']
where
structTf = Struct packing fields
subExpr' = convertExpr (structTf rs) subExpr
convertExpr _ other = other
fallbackType :: Scopes Type -> Expr -> (Type, Expr)
fallbackType scopes e =
case lookupExpr scopes e of
Nothing -> (unknownType, e)
Just (_, _, t) -> (t, e)
-- converting LHSs by looking at the innermost types first
convertLHS :: LHS -> Scoper Type (Type, LHS)
convertLHS l = do
let e = lhsToExpr l
(t, e') <- embedScopes convertSubExpr e
return $ case exprToLHS e' of
Just l' -> (t, l')
Nothing -> error $ "struct conversion created non-LHS from "
++ (show e) ++ " to " ++ (show e')
-- try expression conversion by looking at the *innermost* type first
convertSubExpr :: Scopes Type -> Expr -> (Type, Expr)
convertSubExpr scopes (Dot e x) =
if isntStruct subExprType then
fallbackType scopes $ Dot e' x
else if structIsntReady subExprType then
(fieldType, Dot e' x)
else
(fieldType, undotted)
where
(subExprType, e') = convertSubExpr scopes e
(fieldType, bounds, dims) = lookupFieldInfo subExprType x
base = fst bounds
len = rangeSize bounds
undotted = if null dims || rangeSize (head dims) == Number "1"
then Bit e' (fst bounds)
else Range e' IndexedMinus (base, len)
convertSubExpr scopes (Range (Dot e x) NonIndexed rOuter) =
if isntStruct subExprType then
fallbackType scopes orig'
else if structIsntReady subExprType then
(dropInnerTypeRange fieldType, orig')
else
(dropInnerTypeRange fieldType, undotted)
where
(subExprType, e') = convertSubExpr scopes e
orig' = Range (Dot e' x) NonIndexed rOuter
(fieldType, bounds, dims) = lookupFieldInfo subExprType x
[dim] = dims
rangeLeft = ( BinOp Sub (fst bounds) $ BinOp Sub (fst dim) (fst rOuter)
, BinOp Sub (fst bounds) $ BinOp Sub (fst dim) (snd rOuter) )
rangeRight =
( BinOp Add (snd bounds) $ BinOp Sub (snd dim) (fst rOuter)
rangeRight =( BinOp Add (snd bounds) $ BinOp Sub (snd dim) (fst rOuter)
, BinOp Add (snd bounds) $ BinOp Sub (snd dim) (snd rOuter) )
convertSubExpr (Range (Dot e x) mode (baseO, lenO)) =
if maybeFields == Nothing
then (Implicit Unspecified [], orig')
else if not $ isReadyStruct (structTf [])
then (fieldType, orig')
else (dropInnerTypeRange fieldType, undotted)
where
orig' = Range (Dot e' x) mode (baseO, lenO)
(subExprType, e') = convertSubExpr e
maybeFields = getFields subExprType
Just (structTf, fields) = maybeFields
(fieldType, bounds, dims) = lookupFieldInfo structTf fields x
[dim] = dims
baseLeft = BinOp Sub (fst bounds) $ BinOp Sub (fst dim) baseO
baseRight = BinOp Add (snd bounds) $ BinOp Sub (snd dim) baseO
baseDec = baseLeft
baseInc = case mode of
IndexedPlus -> BinOp Add (BinOp Sub baseRight lenO) one
IndexedMinus -> BinOp Sub (BinOp Add baseRight lenO) one
NonIndexed -> error "invariant violated"
base = endianCondExpr dim baseDec baseInc
undotted = Range e' mode (base, lenO)
one = Number "1"
convertSubExpr (Range e mode r) =
(t', Range e' mode r)
where
(t, e') = convertSubExpr e
t' = dropInnerTypeRange t
convertSubExpr (Bit (Dot e x) i) =
if maybeFields == Nothing
then (Implicit Unspecified [], Bit (Dot e' x) i)
else if not $ isReadyStruct (structTf [])
then (dropInnerTypeRange fieldType, Bit (Dot e' x) i)
else (dropInnerTypeRange fieldType, Bit e' i')
where
(subExprType, e') = convertSubExpr e
maybeFields = getFields subExprType
Just (structTf, fields) = maybeFields
(fieldType, bounds, dims) = lookupFieldInfo structTf fields x
[dim] = dims
iLeft = BinOp Sub (fst bounds) $ BinOp Sub (fst dim) i
iRight = BinOp Add (snd bounds) $ BinOp Sub (snd dim) i
i' = endianCondExpr dim iLeft iRight
convertSubExpr (Bit e i) =
(t', Bit e' i)
where
(t, e') = convertSubExpr e
t' = dropInnerTypeRange t
convertSubExpr (Call e args) =
(retType, Call e $ convertCall types e' args)
where
(_, e') = convertSubExpr e
retType = case e' of
Ident f -> case Map.lookup f types of
Nothing -> Implicit Unspecified []
Just t -> t
_ -> Implicit Unspecified []
convertSubExpr (Cast (Left t) sub) =
(t, Cast (Left t) (snd $ convertSubExpr sub))
convertSubExpr (Pattern items) =
if all (== "") $ map fst items'
then (Implicit Unspecified [], Concat $ map snd items')
else (Implicit Unspecified [], Pattern items')
where
items' = map mapItem items
mapItem (mx, e) = (mx, snd $ convertSubExpr e)
convertSubExpr (Mux a b c) =
(t, Mux a' b' c')
where
(_, a') = convertSubExpr a
(t, b') = convertSubExpr b
(_, c') = convertSubExpr c
convertSubExpr other =
(Implicit Unspecified [], other)
-- lookup the range of a field in its unstructured type
lookupUnstructRange :: TypeFunc -> Identifier -> Range
lookupUnstructRange structTf fieldName =
case Map.lookup fieldName fieldRangeMap of
Nothing -> error $ "field '" ++ fieldName ++
"' not found in struct: " ++ show structTf
Just r -> r
where
Just structInfo = convertStruct $ structTf []
fieldRangeMap = Map.map fst $ snd structInfo
-- lookup the type of a field in the given field list
lookupFieldType :: [(Type, Identifier)] -> Identifier -> Type
lookupFieldType fields fieldName = fieldMap Map.! fieldName
where fieldMap = Map.fromList $ map swap fields
-- get the fields and type function of a struct or union
getFields :: Type -> Maybe ([Range] -> Type, [Field])
getFields (Struct p fields []) = Just (Struct p fields, fields)
getFields (Union p fields []) = Just (Union p fields, fields)
getFields _ = Nothing
-- get the field type, flattended bounds, and original type dimensions
lookupFieldInfo :: ([Range] -> Type) -> [Field] -> Identifier
-> (Type, Range, [Range])
lookupFieldInfo structTf fields x =
(fieldType, bounds, dims)
where
fieldType = lookupFieldType fields x
bounds = lookupUnstructRange structTf x
dims = snd $ typeRanges fieldType
undotted = Range e' NonIndexed $
endianCondRange dim rangeLeft rangeRight
convertSubExpr scopes (Range (Dot e x) mode (baseO, lenO)) =
if isntStruct subExprType then
fallbackType scopes orig'
else if structIsntReady subExprType then
(dropInnerTypeRange fieldType, orig')
else
(dropInnerTypeRange fieldType, undotted)
where
(subExprType, e') = convertSubExpr scopes e
orig' = Range (Dot e' x) mode (baseO, lenO)
(fieldType, bounds, dims) = lookupFieldInfo subExprType x
[dim] = dims
baseLeft = BinOp Sub (fst bounds) $ BinOp Sub (fst dim) baseO
baseRight = BinOp Add (snd bounds) $ BinOp Sub (snd dim) baseO
baseDec = baseLeft
baseInc = case mode of
IndexedPlus -> BinOp Add (BinOp Sub baseRight lenO) one
IndexedMinus -> BinOp Sub (BinOp Add baseRight lenO) one
NonIndexed -> error "invariant violated"
base = endianCondExpr dim baseDec baseInc
undotted = Range e' mode (base, lenO)
one = Number "1"
convertSubExpr scopes (Range e mode r) =
(dropInnerTypeRange t, Range e' mode r)
where (t, e') = convertSubExpr scopes e
convertSubExpr scopes (Bit (Dot e x) i) =
if isntStruct subExprType then
fallbackType scopes orig'
else if structIsntReady subExprType then
(dropInnerTypeRange fieldType, orig')
else
(dropInnerTypeRange fieldType, Bit e' i')
where
(subExprType, e') = convertSubExpr scopes e
orig' = Bit (Dot e' x) i
(fieldType, bounds, dims) = lookupFieldInfo subExprType x
[dim] = dims
iLeft = BinOp Sub (fst bounds) $ BinOp Sub (fst dim) i
iRight = BinOp Add (snd bounds) $ BinOp Sub (snd dim) i
i' = endianCondExpr dim iLeft iRight
convertSubExpr scopes (Bit e i) =
if t == unknownType
then fallbackType scopes $ Bit e' i
else (dropInnerTypeRange t, Bit e' i)
where (t, e') = convertSubExpr scopes e
convertSubExpr scopes (Call e args) =
(retType, Call e args')
where
(retType, _) = fallbackType scopes e
args' = convertCall scopes e args
convertSubExpr scopes (Cast (Left t) e) =
(t, Cast (Left t) e')
where (_, e') = convertSubExpr scopes e
convertSubExpr scopes (Pattern items) =
if all (== "") $ map fst items'
then (unknownType, Concat $ map snd items')
else (unknownType, Pattern items')
where
items' = map mapItem items
mapItem (x, e) = (x, e')
where (_, e') = convertSubExpr scopes e
convertSubExpr scopes (Mux a b c) =
(t, Mux a' b' c')
where
(_, a') = convertSubExpr scopes a
(t, b') = convertSubExpr scopes b
(_, c') = convertSubExpr scopes c
convertSubExpr scopes other =
fallbackType scopes other
-- get the fields and type function of a struct or union
getFields :: Type -> Maybe [Field]
getFields (Struct _ fields []) = Just fields
getFields (Union _ fields []) = Just fields
getFields _ = Nothing
isntStruct :: Type -> Bool
isntStruct = (== Nothing) . getFields
-- get the field type, flattended bounds, and original type dimensions
lookupFieldInfo :: Type -> Identifier -> (Type, Range, [Range])
lookupFieldInfo struct fieldName =
if maybeFieldType == Nothing
then error $ "field '" ++ fieldName ++ "' not found in: " ++ show struct
else (fieldType, bounds, dims)
where
Just fields = getFields struct
maybeFieldType = lookup fieldName $ map swap fields
Just fieldType = maybeFieldType
dims = snd $ typeRanges fieldType
Just (_, unstructRanges) = convertStruct struct
Just bounds = Map.lookup fieldName unstructRanges
-- attempts to convert based on the assignment-like contexts of TF arguments
convertCall :: Types -> Expr -> Args -> Args
convertCall types fn (Args pnArgs kwArgs) =
case fn of
Ident _ -> args
convertCall :: Scopes Type -> Expr -> Args -> Args
convertCall scopes fn (Args pnArgs kwArgs) =
case exprToLHS fn of
Just fnLHS ->
Args (map snd pnArgs') kwArgs'
where
pnArgs' = map (convertArg fnLHS) $ zip idxs pnArgs
kwArgs' = map (convertArg fnLHS) kwArgs
_ -> Args pnArgs kwArgs
where
Ident f = fn
idxs = map show ([0..] :: [Int])
args = Args
(map snd $ map convertArg $ zip idxs pnArgs)
(map convertArg kwArgs)
convertArg :: (Identifier, Expr) -> (Identifier, Expr)
convertArg (x, e) = (x, e')
convertArg :: LHS -> (Identifier, Expr) -> (Identifier, Expr)
convertArg lhs (x, e) =
(x, e')
where
(_, e') = convertAsgn types
(LHSIdent $ f ++ ":" ++ x, e)
details = lookupLHS scopes $ LHSDot lhs x
typ = maybe unknownType thd3 details
thd3 (_, _, c) = c
(_, e') = convertSubExpr scopes $ convertExpr typ e
src/Convert/Traverse.hs
......@@ -57,6 +57,12 @@ module Convert.Traverse
, traverseTypeExprsM
, traverseTypeExprs
, collectTypeExprsM
, traverseGenItemExprsM
, traverseGenItemExprs
, collectGenItemExprsM
, traverseDeclExprsM
, traverseDeclExprs
, collectDeclExprsM
, traverseDeclTypesM
, traverseDeclTypes
, collectDeclTypesM
......@@ -97,6 +103,8 @@ module Convert.Traverse
, stately
, traverseFilesM
, traverseFiles
, traverseSinglyNestedGenItemsM
, traverseSinglyNestedStmtsM
) where
import Data.Functor.Identity (Identity, runIdentity)
......@@ -407,7 +415,7 @@ traverseNestedExprsM :: Monad m => MapperM m Expr -> MapperM m Expr
traverseNestedExprsM mapper = exprMapper
where
exprMapper = mapper >=> em
(_, _, _, typeMapper) = exprMapperHelpers exprMapper
(_, _, _, typeMapper, _) = exprMapperHelpers exprMapper
typeOrExprMapper (Left t) =
typeMapper t >>= return . Left
typeOrExprMapper (Right e) =
......@@ -489,9 +497,19 @@ traverseNestedExprsM mapper = exprMapper
em (Nil) = return Nil
exprMapperHelpers :: Monad m => MapperM m Expr ->
(MapperM m Range, MapperM m Decl, MapperM m LHS, MapperM m Type)
( MapperM m Range
, MapperM m Decl
, MapperM m LHS
, MapperM m Type
, MapperM m GenItem
)
exprMapperHelpers exprMapper =
(rangeMapper, declMapper, traverseNestedLHSsM lhsMapper, typeMapper)
( rangeMapper
, declMapper
, traverseNestedLHSsM lhsMapper
, typeMapper
, genItemMapper
)
where
rangeMapper (a, b) = do
......@@ -535,11 +553,26 @@ exprMapperHelpers exprMapper =
return $ LHSStream o e' ls
lhsMapper other = return other
genItemMapper (GenFor (x1, e1) cc (x2, op2, e2) subItem) = do
e1' <- exprMapper e1
e2' <- exprMapper e2
cc' <- exprMapper cc
return $ GenFor (x1, e1') cc' (x2, op2, e2') subItem
genItemMapper (GenIf e i1 i2) = do
e' <- exprMapper e
return $ GenIf e' i1 i2
genItemMapper (GenCase e cases) = do
e' <- exprMapper e
caseExprs <- mapM (mapM exprMapper . fst) cases
let cases' = zip caseExprs (map snd cases)
return $ GenCase e' cases'
genItemMapper other = return other
traverseExprsM' :: Monad m => TFStrategy -> MapperM m Expr -> MapperM m ModuleItem
traverseExprsM' strat exprMapper = moduleItemMapper
where
(rangeMapper, declMapper, lhsMapper, typeMapper)
(rangeMapper, declMapper, lhsMapper, typeMapper, genItemMapper)
= exprMapperHelpers exprMapper
stmtMapper = traverseNestedStmtsM (traverseStmtExprsM exprMapper)
......@@ -632,21 +665,6 @@ traverseExprsM' strat exprMapper = moduleItemMapper
a'' <- traverseAssertionExprsM exprMapper a'
return $ AssertionItem (mx, a'')
genItemMapper (GenFor (x1, e1) cc (x2, op2, e2) subItem) = do
e1' <- exprMapper e1
e2' <- exprMapper e2
cc' <- exprMapper cc
return $ GenFor (x1, e1') cc' (x2, op2, e2') subItem
genItemMapper (GenIf e i1 i2) = do
e' <- exprMapper e
return $ GenIf e' i1 i2
genItemMapper (GenCase e cases) = do
e' <- exprMapper e
caseExprs <- mapM (mapM exprMapper . fst) cases
let cases' = zip caseExprs (map snd cases)
return $ GenCase e' cases'
genItemMapper other = return other
modportDeclMapper (dir, ident, t, e) = do
t' <- typeMapper t
e' <- exprMapper e
......@@ -668,7 +686,7 @@ traverseStmtExprsM :: Monad m => MapperM m Expr -> MapperM m Stmt
traverseStmtExprsM exprMapper = flatStmtMapper
where
(_, declMapper, lhsMapper, _) = exprMapperHelpers exprMapper
(_, declMapper, lhsMapper, _, _) = exprMapperHelpers exprMapper
caseMapper (exprs, stmt) = do
exprs' <- mapM exprMapper exprs
......@@ -888,13 +906,33 @@ collectExprTypesM = collectify traverseExprTypesM
traverseTypeExprsM :: Monad m => MapperM m Expr -> MapperM m Type
traverseTypeExprsM mapper =
typeMapper
where (_, _, _, typeMapper) = exprMapperHelpers mapper
where (_, _, _, typeMapper, _) = exprMapperHelpers mapper
traverseTypeExprs :: Mapper Expr -> Mapper Type
traverseTypeExprs = unmonad traverseTypeExprsM
collectTypeExprsM :: Monad m => CollectorM m Expr -> CollectorM m Type
collectTypeExprsM = collectify traverseTypeExprsM
traverseGenItemExprsM :: Monad m => MapperM m Expr -> MapperM m GenItem
traverseGenItemExprsM mapper =
genItemMapper
where (_, _, _, _, genItemMapper) = exprMapperHelpers mapper
traverseGenItemExprs :: Mapper Expr -> Mapper GenItem
traverseGenItemExprs = unmonad traverseGenItemExprsM
collectGenItemExprsM :: Monad m => CollectorM m Expr -> CollectorM m GenItem
collectGenItemExprsM = collectify traverseGenItemExprsM
traverseDeclExprsM :: Monad m => MapperM m Expr -> MapperM m Decl
traverseDeclExprsM mapper =
declMapper
where (_, declMapper, _, _, _) = exprMapperHelpers mapper
traverseDeclExprs :: Mapper Expr -> Mapper Decl
traverseDeclExprs = unmonad traverseDeclExprsM
collectDeclExprsM :: Monad m => CollectorM m Expr -> CollectorM m Decl
collectDeclExprsM = collectify traverseDeclExprsM
traverseDeclTypesM :: Monad m => MapperM m Type -> MapperM m Decl
traverseDeclTypesM mapper (Param s t x e) =
mapper t >>= \t' -> return $ Param s t' x e
......
src/Convert/TypeOf.hs
......@@ -11,45 +11,27 @@
module Convert.TypeOf (convert) where
import Control.Monad.State
import Data.List (elemIndex)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Int (Int32)
import Data.Tuple (swap)
import qualified Data.Map.Strict as Map
import Convert.Scoper
import Convert.Traverse
import Language.SystemVerilog.AST
type Info = Map.Map Identifier Type
convert :: [AST] -> [AST]
convert = map $ traverseDescriptions convertDescription
convert = map $ traverseDescriptions $ partScoper
traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
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)
returnType (MIPackageItem (Function _ t f _ _)) =
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 -> Scoper Type Decl
traverseDeclM decl = do
item <- traverseModuleItemM (MIPackageItem $ Decl decl)
let MIPackageItem (Decl decl') = item
case decl' of
Variable d t ident a e -> do
let t' = injectRanges t a
modify $ Map.insert ident t'
insertElem ident t'
return $ case t' of
UnpackedType t'' a' -> Variable d t'' ident a' e
_ -> Variable d t' ident [] e
......@@ -57,39 +39,58 @@ traverseDeclM decl = do
let t' = if t == Implicit Unspecified []
then IntegerAtom TInteger Unspecified
else t
modify $ Map.insert ident t'
insertElem ident t'
return decl'
ParamType{} -> return decl'
CommentDecl{} -> return decl'
traverseModuleItemM :: ModuleItem -> State Info ModuleItem
traverseModuleItemM item = traverseTypesM traverseTypeM item
traverseModuleItemM :: ModuleItem -> Scoper Type ModuleItem
traverseModuleItemM = traverseTypesM traverseTypeM
traverseGenItemM :: GenItem -> Scoper Type GenItem
traverseGenItemM = traverseGenItemExprsM traverseExprM
traverseStmtM :: Stmt -> State Info Stmt
traverseStmtM =
traverseStmtExprsM $ traverseNestedExprsM $ traverseExprTypesM traverseTypeM
traverseStmtM :: Stmt -> Scoper Type Stmt
traverseStmtM = traverseStmtExprsM traverseExprM
traverseTypeM :: Type -> State Info Type
traverseExprM :: Expr -> Scoper Type Expr
traverseExprM = traverseNestedExprsM $ traverseExprTypesM traverseTypeM
traverseTypeM :: Type -> Scoper Type Type
traverseTypeM (TypeOf expr) = typeof expr
traverseTypeM other = return other
typeof :: Expr -> State Info Type
lookupTypeOf :: Expr -> Scoper Type Type
lookupTypeOf expr = do
details <- lookupExprM expr
case details of
Nothing -> return $ TypeOf expr
-- functions with no return type implicitly return a single bit
Just (_, _, Implicit Unspecified []) ->
return $ IntegerVector TLogic Unspecified []
Just (_, replacements, typ) ->
return $ rewriteType typ
where
rewriteType = traverseNestedTypes $ traverseTypeExprs $
traverseNestedExprs replace
replace :: Expr -> Expr
replace (Ident x) =
Map.findWithDefault (Ident x) x replacements
replace other = other
typeof :: Expr -> Scoper Type Type
typeof (Number n) =
return $ IntegerVector TLogic sg [r]
where
(size, sg) = parseNumber n
r = (Number $ show (size - 1), Number "0")
typeof (orig @ (Ident x)) = do
res <- gets $ Map.lookup x
return $ fromMaybe (TypeOf orig) res
typeof (orig @ (Call (Ident x) _)) = do
res <- gets $ Map.lookup x
return $ fromMaybe (TypeOf orig) res
typeof (Call (Ident x) _) =
typeof $ Ident x
typeof (orig @ (Bit e _)) = do
t <- typeof e
return $ case t of
TypeOf _ -> TypeOf orig
_ -> popRange t
case t of
TypeOf _ -> lookupTypeOf orig
_ -> return $ popRange t
typeof (orig @ (Range e mode r)) = do
t <- typeof e
return $ case t of
......@@ -103,17 +104,18 @@ typeof (orig @ (Range e mode r)) = do
IndexedMinus -> BinOp Add (uncurry (BinOp Sub) r) (Number "1")
typeof (orig @ (Dot e x)) = do
t <- typeof e
return $ case t of
case t of
Struct _ fields [] ->
return $ fieldsType fields
Union _ fields [] ->
return $ fieldsType fields
_ -> lookupTypeOf orig
where
fieldsType :: [Field] -> Type
fieldsType fields =
case lookup x $ map swap fields of
Just typ -> typ
Nothing -> TypeOf orig
_ -> TypeOf orig
typeof (orig @ (Cast (Right (Ident x)) _)) = do
typeMap <- get
if Map.member x typeMap
then return $ typeOfSize (Ident x)
else return $ TypeOf orig
typeof (Cast (Right s) _) = return $ typeOfSize s
typeof (UniOp UniSub e ) = typeof e
typeof (UniOp BitNot e ) = typeof e
......@@ -135,7 +137,7 @@ typeof (Mux _ a b) = return $ largerSizeType a b
typeof (Concat exprs) = return $ typeOfSize $ concatSize exprs
typeof (Repeat reps exprs) = return $ typeOfSize size
where size = BinOp Mul reps (concatSize exprs)
typeof other = return $ TypeOf other
typeof other = lookupTypeOf other
-- determines the size and sign of a number literal
parseNumber :: String -> (Int32, Signing)
......
src/Convert/Typedef.hs
......@@ -9,108 +9,91 @@
module Convert.Typedef (convert) where
import Control.Monad.Writer
import qualified Data.Map as Map
import Control.Monad ((>=>))
import Convert.Scoper
import Convert.Traverse
import Language.SystemVerilog.AST
type Types = Map.Map Identifier Type
convert :: [AST] -> [AST]
convert = map $ traverseDescriptions convertDescription
convert = map $ traverseDescriptions $ partScoper
traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
traverseTypeOrExprM :: TypeOrExpr -> Scoper Type TypeOrExpr
traverseTypeOrExprM (Left (TypeOf (Ident x))) = do
details <- lookupIdentM x
return $ case details of
Nothing -> Left $ TypeOf $ Ident x
Just (_, _, typ) -> Left typ
traverseTypeOrExprM (Right (Ident x)) = do
details <- lookupIdentM x
return $ case details of
Nothing -> Right $ Ident x
Just (_, _, typ) -> Left typ
traverseTypeOrExprM other = return other
convertDescription :: Description -> Description
convertDescription (description @ Part{}) =
traverseModuleItems (convertTypedef types) description'
where
description' =
traverseModuleItems (traverseGenItems convertGenItem) description
types = execWriter $ collectModuleItemsM collectTypedefM description'
convertDescription other = other
traverseExprM :: Expr -> Scoper Type Expr
traverseExprM (Cast v e) = do
v' <- traverseTypeOrExprM v
return $ Cast v' e
traverseExprM (DimsFn f v) = do
v' <- traverseTypeOrExprM v
return $ DimsFn f v'
traverseExprM (DimFn f v e) = do
v' <- traverseTypeOrExprM v
return $ DimFn f v' e
traverseExprM other = return other
convertTypedef :: Types -> ModuleItem -> ModuleItem
convertTypedef types =
removeTypedef .
convertModuleItem .
(traverseExprs $ traverseNestedExprs $ convertExpr) .
(traverseTypes $ resolveType types)
where
removeTypedef :: ModuleItem -> ModuleItem
removeTypedef (MIPackageItem (Typedef _ x)) =
MIPackageItem $ Decl $ CommentDecl $ "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 [])
else Right $ Ident x
convertTypeOrExpr other = other
convertExpr :: Expr -> Expr
convertExpr (Cast v e) = Cast (convertTypeOrExpr v) e
convertExpr (DimsFn f v) = DimsFn f (convertTypeOrExpr v)
convertExpr (DimFn f v e) = DimFn f (convertTypeOrExpr v) e
convertExpr other = other
convertModuleItem :: ModuleItem -> ModuleItem
convertModuleItem (Instance m params x rs p) =
Instance m (map mapParam params) x rs p
where mapParam (i, v) = (i, convertTypeOrExpr v)
convertModuleItem other = other
traverseModuleItemM :: ModuleItem -> Scoper Type ModuleItem
traverseModuleItemM (MIPackageItem (Typedef t x)) = do
t' <- traverseNestedTypesM traverseTypeM t
insertElem x t'
return $ Generate []
traverseModuleItemM (Instance m params x rs p) = do
let mapParam (i, v) = traverseTypeOrExprM v >>= \v' -> return (i, v')
params' <- mapM mapParam params
traverseModuleItemM' $ Instance m params' x rs p
traverseModuleItemM item = traverseModuleItemM' item
convertGenItem :: GenItem -> GenItem
convertGenItem (GenIf c a b) =
GenIf c a' b'
where
a' = convertGenItem' a
b' = convertGenItem' b
convertGenItem other = other
traverseModuleItemM' :: ModuleItem -> Scoper Type ModuleItem
traverseModuleItemM' =
traverseTypesM traverseTypeM >=>
traverseExprsM (traverseNestedExprsM traverseExprM)
convertGenItem' :: GenItem -> GenItem
convertGenItem' item = do
GenBlock "" items
where
-- convert inner generate blocks first
item' = Generate [traverseNestedGenItems convertGenItem item]
types = execWriter $ collectNestedModuleItemsM collectTypedefM item'
Generate items = traverseNestedModuleItems (convertTypedef types) item'
traverseGenItemM :: GenItem -> Scoper Type GenItem
traverseGenItemM = traverseGenItemExprsM (traverseNestedExprsM traverseExprM)
collectTypedefM :: ModuleItem -> Writer Types ()
collectTypedefM (MIPackageItem (Typedef a b)) = tell $ Map.singleton b a
collectTypedefM _ = return ()
traverseDeclM :: Decl -> Scoper Type Decl
traverseDeclM decl = do
item <- traverseModuleItemM (MIPackageItem $ Decl decl)
let MIPackageItem (Decl decl') = item
case decl' of
Variable{} -> return decl'
Param{} -> return decl'
ParamType{} -> return decl'
CommentDecl{} -> return decl'
resolveItem :: Types -> (Type, Identifier) -> (Type, Identifier)
resolveItem types (t, x) = (resolveType types t, x)
traverseStmtM :: Stmt -> Scoper Type Stmt
traverseStmtM =
traverseStmtExprsM $ traverseNestedExprsM $
traverseExprTypesM traverseTypeM >=> traverseExprM
resolveType :: Types -> Type -> Type
resolveType _ (Net kw sg rs) = Net kw sg rs
resolveType _ (Implicit sg rs) = Implicit sg rs
resolveType _ (IntegerVector kw sg rs) = IntegerVector kw sg rs
resolveType _ (IntegerAtom kw sg ) = IntegerAtom kw sg
resolveType _ (NonInteger kw ) = NonInteger kw
resolveType _ (InterfaceT x my rs) = InterfaceT x my 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 t vals rs) = Enum (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
resolveType types (Alias Nothing st rs1) =
if Map.notMember st types
then Alias Nothing st rs1
else case resolveType types $ types Map.! st of
(Net kw sg rs2) -> Net kw sg $ rs1 ++ rs2
(Implicit sg rs2) -> Implicit sg $ rs1 ++ rs2
(IntegerVector kw sg rs2) -> IntegerVector kw sg $ rs1 ++ rs2
(Enum t v rs2) -> Enum t v $ rs1 ++ rs2
(Struct p l rs2) -> Struct p l $ rs1 ++ rs2
(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
traverseTypeM :: Type -> Scoper Type Type
traverseTypeM (Alias Nothing st rs1) = do
details <- lookupIdentM st
return $ case details of
Nothing -> Alias Nothing st rs1
Just (_, _, typ) -> case typ of
Net kw sg rs2 -> Net kw sg $ rs1 ++ rs2
Implicit sg rs2 -> Implicit sg $ rs1 ++ rs2
IntegerVector kw sg rs2 -> IntegerVector kw sg $ rs1 ++ rs2
Enum t v rs2 -> Enum t v $ rs1 ++ rs2
Struct p l rs2 -> Struct p l $ rs1 ++ rs2
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
traverseTypeM other = return other
sv2v.cabal
......@@ -81,6 +81,7 @@ executable sv2v
Convert.Package
Convert.ParamType
Convert.RemoveComments
Convert.Scoper
Convert.SignCast
Convert.Simplify
Convert.SizeCast
......
test/basic/decl_scope.sv 0 → 100644
module top;
logic t;
initial $display("A t %0d", $bits(t));
initial $display("A top.t %0d", $bits(top.t));
generate
begin : X
logic [1:0] t;
initial $display("B t %0d", $bits(t));
initial $display("B top.t %0d", $bits(top.t));
initial $display("B X.t %0d", $bits(X.t));
initial $display("B top.X.t %0d", $bits(top.X.t));
begin : Y
logic [2:0] t;
initial $display("C t %0d", $bits(t));
initial $display("C top.t %0d", $bits(top.t));
initial $display("C X.t %0d", $bits(X.t));
initial $display("C top.X.t %0d", $bits(top.X.t));
initial $display("C Y.t %0d", $bits(Y.t));
initial $display("C X.Y.t %0d", $bits(X.Y.t));
initial $display("C top.X.Y.t %0d", $bits(top.X.Y.t));
end
end
for (genvar i = 0; i < 3; ++i) begin : Z
logic [i:0] t;
end
endgenerate
initial $display("A t %0d", $bits(t));
initial $display("A top.t %0d", $bits(top.t));
initial $display("A X.t %0d", $bits(X.t));
initial $display("A top.X.t %0d", $bits(top.X.t));
initial $display("A X.Y.t %0d", $bits(X.Y.t));
initial $display("A top.X.Y.t %0d", $bits(top.X.Y.t));
initial $display("A top.Z[0].t %0d", $bits(top.Z[0].t));
initial $display("A Z[0].t %0d", $bits(Z[0].t));
initial $display("A Z[1].t %0d", $bits(Z[1].t));
initial $display("A Z[2].t %0d", $bits(Z[2].t));
logic x;
initial begin
type(x) x [1:0];
type(x) y [2:0];
$display("size of x = %0d", $bits(x));
$display("size of y = %0d", $bits(y));
end
logic [2:0][3:0] arr;
generate
begin : M
logic [3:0][4:0] arr;
initial $display("M arr[0] = %b", arr[0]);
initial $display("M M.arr[0] = %b", M.arr[0]);
initial $display("M top.arr[0] = %b", top.arr[0]);
end
endgenerate
initial $display("arr[0] = %b", arr[0]);
initial $display("M.arr[0] = %b", M.arr[0]);
initial $display("top.arr[0] = %b", top.arr[0]);
localparam arr2 [2][3] = '{
'{1'b0, 1'b1, 1'b1},
'{1'b1, 1'b0, 1'b0}
};
for (genvar i = 0 ; i < 2 ; ++i) begin
for (genvar j = 0 ; j < 3 ; ++j) begin
localparam value = arr2[i][j];
initial $display("%0d %0d %0d", i, j, value);
end
end
endmodule
test/basic/decl_scope.v 0 → 100644
module top;
wire t;
initial $display("A t %0d", 1);
initial $display("A top.t %0d", 1);
generate
begin : X
wire [1:0] t;
initial $display("B t %0d", 2);
initial $display("B top.t %0d", 1);
initial $display("B X.t %0d", 2);
initial $display("B top.X.t %0d", 2);
begin : Y
wire [2:0] t;
initial $display("C t %0d", 3);
initial $display("C top.t %0d", 1);
initial $display("C X.t %0d", 2);
initial $display("C top.X.t %0d", 2);
initial $display("C Y.t %0d", 3);
initial $display("C X.Y.t %0d", 3);
initial $display("C top.X.Y.t %0d", 3);
end
end
genvar i;
for (i = 0; i < 3; i = i + 1) begin : Z
wire [i:0] t;
end
endgenerate
initial $display("A t %0d", 1);
initial $display("A top.t %0d", 1);
initial $display("A X.t %0d", 2);
initial $display("A top.X.t %0d", 2);
initial $display("A X.Y.t %0d", 3);
initial $display("A top.X.Y.t %0d", 3);
initial $display("A top.Z[0].t %0d", 1);
initial $display("A Z[0].t %0d", 1);
initial $display("A Z[1].t %0d", 2);
initial $display("A Z[2].t %0d", 3);
wire x;
initial begin : name
reg [1:0] x;
reg [5:0] y;
$display("size of x = %0d", $bits(x));
$display("size of y = %0d", $bits(y));
end
wire [11:0] arr;
generate
begin : M
wire [19:0] arr;
initial $display("M arr[0] = %b", arr[4:0]);
initial $display("M M.arr[0] = %b", M.arr[4:0]);
initial $display("M top.arr[0] = %b", top.arr[3:0]);
end
endgenerate
initial $display("arr[0] = %b", arr[3:0]);
initial $display("M.arr[0] = %b", M.arr[4:0]);
initial $display("top.arr[0] = %b", top.arr[3:0]);
localparam [0:5] arr2 = 6'b011100;
generate
genvar j;
for (i = 0 ; i < 2 ; i = i + 1) begin
for (j = 0 ; j < 3 ; j = j + 1) begin
localparam value = arr2[i * 3 + j];
initial $display("%0d %0d %0d", i, j, value);
end
end
endgenerate
endmodule
test/basic/struct_scope.sv 0 → 100644
module top;
typedef struct packed {
logic x;
logic [1:0] y;
} A;
typedef struct packed {
logic [2:0] x;
logic [3:0] y;
} B;
typedef struct packed {
logic [4:0] x;
logic [5:0] y;
B z;
} C;
A a;
B b;
C c;
generate
begin : foo
typedef struct packed {
logic [6:0] x;
logic [7:0] y;
} B;
typedef struct packed {
logic [8:0] x;
logic [9:0] y;
B z;
} D;
A a;
B b;
C c;
D d;
end
endgenerate
`define INSPECT_SIZE(expr) $display(`"expr -> %0d`", $bits(expr));
`define INSPECT_DATA(expr) $display(`"expr -> %b`", expr);
initial begin
`INSPECT_SIZE(a);
`INSPECT_SIZE(a.x);
`INSPECT_SIZE(a.y);
`INSPECT_SIZE(b);
`INSPECT_SIZE(b.x);
`INSPECT_SIZE(b.y);
`INSPECT_SIZE(c);
`INSPECT_SIZE(c.x);
`INSPECT_SIZE(c.y);
`INSPECT_SIZE(c.z);
`INSPECT_SIZE(c.z.x);
`INSPECT_SIZE(c.z.y);
`INSPECT_SIZE(foo.a);
`INSPECT_SIZE(foo.a.x);
`INSPECT_SIZE(foo.a.y);
`INSPECT_SIZE(foo.b);
`INSPECT_SIZE(foo.b.x);
`INSPECT_SIZE(foo.b.y);
`INSPECT_SIZE(foo.c);
`INSPECT_SIZE(foo.c.x);
`INSPECT_SIZE(foo.c.y);
`INSPECT_SIZE(foo.c.z);
`INSPECT_SIZE(foo.c.z.x);
`INSPECT_SIZE(foo.c.z.y);
`INSPECT_SIZE(foo.d);
`INSPECT_SIZE(foo.d.x);
`INSPECT_SIZE(foo.d.y);
`INSPECT_SIZE(foo.d.z);
`INSPECT_SIZE(foo.d.z.x);
`INSPECT_SIZE(foo.d.z.y);
`INSPECT_DATA(a);
`INSPECT_DATA(b);
`INSPECT_DATA(c);
`INSPECT_DATA(foo.a);
`INSPECT_DATA(foo.b);
`INSPECT_DATA(foo.c);
`INSPECT_DATA(foo.d);
end
endmodule
test/basic/struct_scope.v 0 → 100644
module top;
wire [2:0] a;
wire [6:0] b;
wire [17:0] c;
generate
begin : foo
wire [2:0] a;
wire [14:0] b;
wire [17:0] c;
wire [33:0] d;
end
endgenerate
`define INSPECT_SIZE(expr, size) $display(`"expr -> %0d`", size);
`define INSPECT_DATA(expr) $display(`"expr -> %b`", expr);
initial begin
`INSPECT_SIZE(a, 3);
`INSPECT_SIZE(a.x, 1);
`INSPECT_SIZE(a.y, 2);
`INSPECT_SIZE(b, 7);
`INSPECT_SIZE(b.x, 3);
`INSPECT_SIZE(b.y, 4);
`INSPECT_SIZE(c, 18);
`INSPECT_SIZE(c.x, 5);
`INSPECT_SIZE(c.y, 6);
`INSPECT_SIZE(c.z, 7);
`INSPECT_SIZE(c.z.x, 3);
`INSPECT_SIZE(c.z.y, 4);
`INSPECT_SIZE(foo.a, 3);
`INSPECT_SIZE(foo.a.x, 1);
`INSPECT_SIZE(foo.a.y, 2);
`INSPECT_SIZE(foo.b, 15);
`INSPECT_SIZE(foo.b.x, 7);
`INSPECT_SIZE(foo.b.y, 8);
`INSPECT_SIZE(foo.c, 18);
`INSPECT_SIZE(foo.c.x, 5);
`INSPECT_SIZE(foo.c.y, 6);
`INSPECT_SIZE(foo.c.z, 7);
`INSPECT_SIZE(foo.c.z.x, 3);
`INSPECT_SIZE(foo.c.z.y, 4);
`INSPECT_SIZE(foo.d, 34);
`INSPECT_SIZE(foo.d.x, 9);
`INSPECT_SIZE(foo.d.y, 10);
`INSPECT_SIZE(foo.d.z, 15);
`INSPECT_SIZE(foo.d.z.x, 7);
`INSPECT_SIZE(foo.d.z.y, 8);
`INSPECT_DATA(a);
`INSPECT_DATA(b);
`INSPECT_DATA(c);
`INSPECT_DATA(foo.a);
`INSPECT_DATA(foo.b);
`INSPECT_DATA(foo.c);
`INSPECT_DATA(foo.d);
end
endmodule
test/basic/struct_shadow.sv
......@@ -134,6 +134,7 @@ module top;
input StructA b;
input StructB c;
input StructC d;
integer unused;
input StructD e;
input StructE f;
$display("F: %1d%1d%1d -> ", i,j,k, a,b,c,d,e,f);
......
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