mirror of https://github.com/zachjs/sv2v.git
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
This commit is contained in:
parent
211e4b0ed8
commit
85e3d0f5b5
|
|
@ -1,3 +1,4 @@
|
|||
{-# 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,
|
||||
|
|
|
|||
|
|
@ -0,0 +1,349 @@
|
|||
{-# 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
|
||||
|
|
@ -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
|
||||
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
|
||||
|
||||
-- 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)
|
||||
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
|
||||
zip fieldNames (map snd itemsOrig)
|
||||
(specialItems, namedItems) =
|
||||
partition ((== specialTag) . head . fst) itemsNamed
|
||||
namedItemMap = Map.fromList namedItems
|
||||
specialItemMap = Map.fromList specialItems
|
||||
|
||||
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)
|
||||
|
||||
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
|
||||
fieldType = fieldTypeMap Map.! fieldName
|
||||
fieldTypeName =
|
||||
specialTag : (show $ fst $ typeRanges fieldType)
|
||||
isStruct :: Type -> Bool
|
||||
isStruct (Struct{}) = True
|
||||
isStruct _ = False
|
||||
|
||||
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
|
||||
|
||||
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)
|
||||
|
||||
-- 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)
|
||||
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)
|
||||
-- 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)
|
||||
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
|
||||
|
||||
-- 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
|
||||
-- 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
|
||||
|
||||
-- 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
|
||||
isntStruct :: Type -> Bool
|
||||
isntStruct = (== Nothing) . getFields
|
||||
|
||||
-- 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
|
||||
-- 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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
traverseStmtM :: Stmt -> State Info Stmt
|
||||
traverseStmtM =
|
||||
traverseStmtExprsM $ traverseNestedExprsM $ traverseExprTypesM traverseTypeM
|
||||
traverseGenItemM :: GenItem -> Scoper Type GenItem
|
||||
traverseGenItemM = traverseGenItemExprsM traverseExprM
|
||||
|
||||
traverseTypeM :: Type -> State Info Type
|
||||
traverseStmtM :: Stmt -> Scoper Type Stmt
|
||||
traverseStmtM = traverseStmtExprsM traverseExprM
|
||||
|
||||
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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
convertDescription :: Description -> Description
|
||||
convertDescription (description @ Part{}) =
|
||||
traverseModuleItems (convertTypedef types) description'
|
||||
where
|
||||
description' =
|
||||
traverseModuleItems (traverseGenItems convertGenItem) description
|
||||
types = execWriter $ collectModuleItemsM collectTypedefM description'
|
||||
convertDescription other = other
|
||||
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
|
||||
|
||||
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
|
||||
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
|
||||
|
||||
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 (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' 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'
|
||||
traverseModuleItemM' :: ModuleItem -> Scoper Type ModuleItem
|
||||
traverseModuleItemM' =
|
||||
traverseTypesM traverseTypeM >=>
|
||||
traverseExprsM (traverseNestedExprsM traverseExprM)
|
||||
|
||||
collectTypedefM :: ModuleItem -> Writer Types ()
|
||||
collectTypedefM (MIPackageItem (Typedef a b)) = tell $ Map.singleton b a
|
||||
collectTypedefM _ = return ()
|
||||
traverseGenItemM :: GenItem -> Scoper Type GenItem
|
||||
traverseGenItemM = traverseGenItemExprsM (traverseNestedExprsM traverseExprM)
|
||||
|
||||
resolveItem :: Types -> (Type, Identifier) -> (Type, Identifier)
|
||||
resolveItem types (t, x) = (resolveType types t, x)
|
||||
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'
|
||||
|
||||
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
|
||||
traverseStmtM :: Stmt -> Scoper Type Stmt
|
||||
traverseStmtM =
|
||||
traverseStmtExprsM $ traverseNestedExprsM $
|
||||
traverseExprTypesM traverseTypeM >=> traverseExprM
|
||||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -81,6 +81,7 @@ executable sv2v
|
|||
Convert.Package
|
||||
Convert.ParamType
|
||||
Convert.RemoveComments
|
||||
Convert.Scoper
|
||||
Convert.SignCast
|
||||
Convert.Simplify
|
||||
Convert.SizeCast
|
||||
|
|
|
|||
|
|
@ -0,0 +1,69 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,70 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,87 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,63 @@
|
|||
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
|
||||
|
|
@ -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);
|
||||
|
|
|
|||
Loading…
Reference in New Issue