Commit 85e3d0f5 by Zachary Snow

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
{-# LANGUAGE TupleSections #-}
{- sv2v {- sv2v
- Author: Zachary Snow <zach@zachjs.com> - Author: Zachary Snow <zach@zachjs.com>
- -
...@@ -25,42 +26,34 @@ ...@@ -25,42 +26,34 @@
module Convert.MultiplePacked (convert) where module Convert.MultiplePacked (convert) where
import Control.Monad.State import Control.Monad ((>=>))
import Data.Tuple (swap) import Data.Tuple (swap)
import Data.Maybe (isJust) import Data.Maybe (isJust)
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Convert.Scoper
import Convert.Traverse import Convert.Traverse
import Language.SystemVerilog.AST import Language.SystemVerilog.AST
type TypeInfo = (Type, [Range]) type TypeInfo = (Type, [Range])
type Info = Map.Map Identifier TypeInfo
convert :: [AST] -> [AST] convert :: [AST] -> [AST]
convert = map $ traverseDescriptions convertDescription convert = map $ traverseDescriptions $ partScoper
traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
convertDescription :: Description -> Description
convertDescription part @ Part{} =
scopedConversion traverseDeclM traverseModuleItemM traverseStmtM
instances part'
where
(part', instances) = runState
(traverseModuleItemsM traverseInstancesM part) Map.empty
convertDescription other = other
-- collects and converts declarations with multiple packed dimensions -- 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 traverseDeclM (Variable dir t ident a e) = do
t' <- traverseTypeM t a ident 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 traverseDeclM (Param s t ident e) = do
t' <- traverseTypeM t [] ident t' <- traverseTypeM t [] ident
return $ Param s t' ident e traverseDeclExprsM traverseExprM $ Param s t' ident e
traverseDeclM other = return other traverseDeclM other = traverseDeclExprsM traverseExprM other
traverseTypeM :: Type -> [Range] -> Identifier -> State Info Type traverseTypeM :: Type -> [Range] -> Identifier -> Scoper TypeInfo Type
traverseTypeM t a ident = do traverseTypeM t a ident = do
modify $ Map.insert ident (t, a) insertElem ident (t, a)
t' <- case t of t' <- case t of
Struct pk fields rs -> do Struct pk fields rs -> do
fields' <- flattenFields fields fields' <- flattenFields fields
...@@ -82,18 +75,20 @@ traverseTypeM t a ident = do ...@@ -82,18 +75,20 @@ traverseTypeM t a ident = do
fieldTypes' <- mapM (\x -> traverseTypeM x [] "") fieldTypes fieldTypes' <- mapM (\x -> traverseTypeM x [] "") fieldTypes
return $ zip fieldTypes' fieldNames return $ zip fieldTypes' fieldNames
-- converts multi-dimensional instances traverseModuleItemM :: ModuleItem -> Scoper TypeInfo ModuleItem
traverseInstancesM :: ModuleItem -> State Info ModuleItem traverseModuleItemM (Instance m p x rs l) = do
traverseInstancesM (Instance m p x rs l) = do -- converts multi-dimensional instances
rs' <- if length rs <= 1 rs' <- if length rs <= 1
then return rs then return rs
else do else do
let t = Implicit Unspecified rs let t = Implicit Unspecified rs
modify $ Map.insert x (t, []) insertElem x (t, [])
let r1 : r2 : rest = rs let r1 : r2 : rest = rs
return $ (combineRanges r1 r2) : rest return $ (combineRanges r1 r2) : rest
return $ Instance m p x rs' l traverseExprsM traverseExprM $ Instance m p x rs' l
traverseInstancesM other = return other traverseModuleItemM item =
traverseLHSsM traverseLHSM item >>=
traverseExprsM traverseExprM
-- combines two ranges into one flattened range -- combines two ranges into one flattened range
combineRanges :: Range -> Range -> Range combineRanges :: Range -> Range -> Range
...@@ -117,37 +112,38 @@ combineRanges r1 r2 = r ...@@ -117,37 +112,38 @@ combineRanges r1 r2 = r
upper = BinOp Add (BinOp Mul size1 size2) upper = BinOp Add (BinOp Mul size1 size2)
(BinOp Sub lower (Number "1")) (BinOp Sub lower (Number "1"))
traverseModuleItemM :: ModuleItem -> State Info ModuleItem traverseStmtM :: Stmt -> Scoper TypeInfo Stmt
traverseModuleItemM =
traverseLHSsM traverseLHSM >=>
traverseExprsM traverseExprM
traverseStmtM :: Stmt -> State Info Stmt
traverseStmtM = traverseStmtM =
traverseStmtLHSsM traverseLHSM >=> traverseStmtLHSsM traverseLHSM >=>
traverseStmtExprsM traverseExprM traverseStmtExprsM traverseExprM
traverseExprM :: Expr -> State Info Expr traverseExprM :: Expr -> Scoper TypeInfo Expr
traverseExprM = traverseNestedExprsM $ stately traverseExpr traverseExprM = traverseNestedExprsM convertExprM
traverseGenItemM :: GenItem -> Scoper TypeInfo GenItem
traverseGenItemM = traverseGenItemExprsM traverseExprM
-- LHSs need to be converted too. Rather than duplicating the procedures, we -- LHSs need to be converted too. Rather than duplicating the procedures, we
-- turn LHSs into expressions temporarily and use the expression conversion. -- turn LHSs into expressions temporarily and use the expression conversion.
traverseLHSM :: LHS -> State Info LHS traverseLHSM :: LHS -> Scoper TypeInfo LHS
traverseLHSM = traverseNestedLHSsM traverseLHSSingleM traverseLHSM = traverseNestedLHSsM traverseLHSSingleM
where where
-- We can't use traverseExprM directly because that would cause Exprs -- We can't use traverseExprM directly because that would cause Exprs
-- inside of LHSs to be converted twice in a single cycle! -- inside of LHSs to be converted twice in a single cycle!
traverseLHSSingleM :: LHS -> State Info LHS traverseLHSSingleM :: LHS -> Scoper TypeInfo LHS
traverseLHSSingleM lhs = do traverseLHSSingleM lhs = do
let expr = lhsToExpr lhs let expr = lhsToExpr lhs
expr' <- stately traverseExpr expr expr' <- convertExprM expr
case exprToLHS expr' of case exprToLHS expr' of
Just lhs' -> return lhs' Just lhs' -> return lhs'
Nothing -> error $ "multi-packed conversion created non-LHS from " Nothing -> error $ "multi-packed conversion created non-LHS from "
++ (show expr) ++ " to " ++ (show expr') ++ (show expr) ++ " to " ++ (show expr')
traverseExpr :: Info -> Expr -> Expr convertExprM :: Expr -> Scoper TypeInfo Expr
traverseExpr typeMap = convertExprM = embedScopes convertExpr
convertExpr :: Scopes TypeInfo -> Expr -> Expr
convertExpr scopes =
rewriteExpr rewriteExpr
where where
-- removes the innermost dimensions of the given type information, and -- removes the innermost dimensions of the given type information, and
...@@ -165,19 +161,17 @@ traverseExpr typeMap = ...@@ -165,19 +161,17 @@ traverseExpr typeMap =
-- given an expression, returns its type information and a tagged -- given an expression, returns its type information and a tagged
-- version of the expression, if possible -- version of the expression, if possible
levels :: Expr -> Maybe (TypeInfo, Expr) 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) = 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) = levels (Range expr a b) =
fmap (dropLevel $ \expr' -> Range expr' a b) (levels expr) fmap (dropLevel $ \expr' -> Range expr' a b) (levels expr)
levels (Dot expr x) = levels (Dot expr x) =
case levels expr of case levels expr of
Just ((Struct _ fields [], []), expr') -> dropDot fields expr' Just ((Struct _ fields [], []), expr') -> dropDot fields expr'
Just ((Union _ fields [], []), expr') -> dropDot fields expr' Just ((Union _ fields [], []), expr') -> dropDot fields expr'
_ -> Nothing _ -> fallbackLevels $ Dot expr x
where where
dropDot :: [Field] -> Expr -> Maybe (TypeInfo, Expr) dropDot :: [Field] -> Expr -> Maybe (TypeInfo, Expr)
dropDot fields expr' = dropDot fields expr' =
...@@ -187,7 +181,14 @@ traverseExpr typeMap = ...@@ -187,7 +181,14 @@ traverseExpr typeMap =
where where
fieldMap = Map.fromList $ map swap fields fieldMap = Map.fromList $ map swap fields
fieldType = fieldMap Map.! x 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, -- given an expression, returns the two most significant (innermost,
-- leftmost) packed dimensions and a tagged version of the expression, -- leftmost) packed dimensions and a tagged version of the expression,
......
{-# 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 @@ ...@@ -6,19 +6,17 @@
module Convert.Struct (convert) where module Convert.Struct (convert) where
import Control.Monad.State import Control.Monad ((>=>), when)
import Control.Monad.Writer
import Data.List (partition) import Data.List (partition)
import Data.Tuple (swap) import Data.Tuple (swap)
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import Convert.Scoper
import Convert.Traverse import Convert.Traverse
import Language.SystemVerilog.AST import Language.SystemVerilog.AST
type TypeFunc = [Range] -> Type type StructInfo = (Type, Map.Map Identifier Range)
type StructInfo = (Type, Map.Map Identifier (Range, Expr))
type Types = Map.Map Identifier Type
convert :: [AST] -> [AST] convert :: [AST] -> [AST]
convert = map $ traverseDescriptions convertDescription convert = map $ traverseDescriptions convertDescription
...@@ -26,51 +24,10 @@ convert = map $ traverseDescriptions convertDescription ...@@ -26,51 +24,10 @@ convert = map $ traverseDescriptions convertDescription
convertDescription :: Description -> Description convertDescription :: Description -> Description
convertDescription (description @ (Part _ _ Module _ _ _ _)) = convertDescription (description @ (Part _ _ Module _ _ _ _)) =
traverseModuleItems (traverseTypes' ExcludeParamTypes convertType) $ traverseModuleItems (traverseTypes' ExcludeParamTypes convertType) $
scopedConversion traverseDeclM' traverseModuleItemM partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
traverseStmtM tfArgTypes description 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
convertDescription other = other convertDescription other = other
-- write down unstructured versions of packed struct types
convertStruct :: Type -> Maybe StructInfo convertStruct :: Type -> Maybe StructInfo
convertStruct (Struct Unpacked fields _) = convertStruct (Struct Unpacked fields _) =
convertStruct' True Unspecified fields convertStruct' True Unspecified fields
...@@ -112,11 +69,9 @@ convertStruct' isStruct sg fields = ...@@ -112,11 +69,9 @@ convertStruct' isStruct sg fields =
else map simplify $ map (BinOp Add (Number "-1")) fieldSizes else map simplify $ map (BinOp Add (Number "-1")) fieldSizes
-- create the mapping structure for the unstructured fields -- create the mapping structure for the unstructured fields
unstructOffsets = map simplify $ map snd fieldRanges
unstructRanges = zip fieldHis fieldLos
keys = map snd fields keys = map snd fields
vals = zip unstructRanges unstructOffsets unstructRanges = zip fieldHis fieldLos
unstructFields = Map.fromList $ zip keys vals unstructFields = Map.fromList $ zip keys unstructRanges
-- create the unstructured type; result type takes on the signing of the -- create the unstructured type; result type takes on the signing of the
-- struct itself to preserve behavior of operations on the whole struct -- struct itself to preserve behavior of operations on the whole struct
...@@ -135,9 +90,6 @@ convertStruct' isStruct sg fields = ...@@ -135,9 +90,6 @@ convertStruct' isStruct sg fields =
isFlatIntVec _ = False isFlatIntVec _ = False
canUnstructure = all isFlatIntVec fieldTypes canUnstructure = all isFlatIntVec fieldTypes
isReadyStruct :: Type -> Bool
isReadyStruct = (Nothing /=) . convertStruct
-- convert a struct type to its unstructured equivalent -- convert a struct type to its unstructured equivalent
convertType :: Type -> Type convertType :: Type -> Type
...@@ -148,106 +100,106 @@ convertType t1 = ...@@ -148,106 +100,106 @@ convertType t1 =
where (tf2, rs2) = typeRanges t2 where (tf2, rs2) = typeRanges t2
where (_, rs1) = typeRanges t1 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 -- write down the types of declarations
traverseDeclM :: Decl -> State Types Decl traverseDeclM :: Decl -> Scoper Type Decl
traverseDeclM origDecl = do traverseDeclM decl = do
case origDecl of decl' <- case decl of
Variable d t x a e -> do Variable d t x a e -> do
let (tf, rs) = typeRanges t let (tf, rs) = typeRanges t
if isRangeable t when (isRangeable t) $
then modify $ Map.insert x (tf $ a ++ rs) insertElem x (tf $ a ++ rs)
else return () let e' = convertExpr t e
e' <- convertDeclExpr x e
return $ Variable d t x a e' return $ Variable d t x a e'
Param s t x e -> do Param s t x e -> do
modify $ Map.insert x t insertElem x t
e' <- convertDeclExpr x e let e' = convertExpr t e
return $ Param s t x e' return $ Param s t x e'
ParamType{} -> return origDecl ParamType{} -> return decl
CommentDecl{} -> return origDecl CommentDecl{} -> return decl
traverseDeclExprsM traverseExprM decl'
where 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 :: Type -> Bool
isRangeable (IntegerAtom _ _) = False isRangeable IntegerAtom{} = False
isRangeable (NonInteger _ ) = False isRangeable NonInteger{} = False
isRangeable _ = True 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 -- removes the innermost range from the given type, if possible
dropInnerTypeRange :: Type -> Type dropInnerTypeRange :: Type -> Type
dropInnerTypeRange t = dropInnerTypeRange t =
case typeRanges t of case typeRanges t of
(_, []) -> Implicit Unspecified [] (_, []) -> unknownType
(tf, rs) -> tf $ tail rs (tf, rs) -> tf $ tail rs
-- This is where the magic happens. This is responsible for converting struct unknownType :: Type
-- accesses, assignments, and literals, given appropriate information about the unknownType = Implicit Unspecified []
-- 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 traverseAsgnM :: (LHS, Expr) -> Scoper Type (LHS, Expr)
-- then using the outermost type to figure out the corresponding struct traverseAsgnM (lhs, expr) = do
-- definition for struct literals that are encountered. -- convert the LHS using the innermost type information
convertAsgn :: Types -> (LHS, Expr) -> (LHS, Expr) (typ, lhs') <- convertLHS lhs
convertAsgn types (lhs, expr) = -- convert the RHS using the LHS type information, and then the innermost
(lhs', expr') -- type information on the resulting RHS
where (_, expr') <- embedScopes convertSubExpr $ convertExpr typ expr
(typ, lhs') = convertLHS lhs return (lhs', expr')
expr' = snd $ convertSubExpr $ convertExpr typ expr
specialTag :: Char
-- converting LHSs by looking at the innermost types first specialTag = ':'
convertLHS :: LHS -> (Type, LHS) defaultKey :: String
convertLHS l = defaultKey = specialTag : "default"
case exprToLHS e' of
Just l' -> (t, l') structIsntReady :: Type -> Bool
Nothing -> error $ "struct conversion created non-LHS from " structIsntReady = (Nothing ==) . convertStruct
++ (show e) ++ " to " ++ (show e')
where -- try expression conversion by looking at the *outermost* type first
e = lhsToExpr l convertExpr :: Type -> Expr -> Expr
(t, e') = convertSubExpr e convertExpr _ Nil = Nil
convertExpr t (Mux c e1 e2) =
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' Mux c e1' e2'
where where
e1' = convertExpr t e1 e1' = convertExpr t e1
e2' = convertExpr t e2 e2' = convertExpr t e2
-- TODO: This is really a conversion for using default patterns to -- TODO: This is really a conversion for using default patterns to
-- populate arrays. Maybe this should be somewhere else? -- populate arrays. Maybe this should be somewhere else?
convertExpr (IntegerVector t sg (r:rs)) (Pattern [(":default", e)]) = convertExpr (IntegerVector t sg (r:rs)) (Pattern [(":default", e)]) =
Repeat (rangeSize r) [e'] Repeat (rangeSize r) [e']
where e' = convertExpr (IntegerVector t sg rs) e where e' = convertExpr (IntegerVector t sg rs) e
-- TODO: This is a conversion for concat array literals with elements -- TODO: This is a conversion for concat array literals with elements
-- that are unsized numbers. This probably belongs somewhere else. -- that are unsized numbers. This probably belongs somewhere else.
convertExpr (t @ IntegerVector{}) (Pattern items) = convertExpr (t @ IntegerVector{}) (Pattern items) =
if all (null . fst) items if all (null . fst) items
then convertExpr t $ Concat $ map snd items then convertExpr t $ Concat $ map snd items
else Pattern items else Pattern items
convertExpr (t @ IntegerVector{}) (Concat exprs) = convertExpr (t @ IntegerVector{}) (Concat exprs) =
if all isUnsizedNumber exprs if all isUnsizedNumber exprs
then Concat exprs' then Concat exprs'
else Concat exprs else Concat exprs
...@@ -258,31 +210,29 @@ convertAsgn types (lhs, expr) = ...@@ -258,31 +210,29 @@ convertAsgn types (lhs, expr) =
isUnsizedNumber (Number n) = not $ elem '\'' n isUnsizedNumber (Number n) = not $ elem '\'' n
isUnsizedNumber (UniOp UniSub e) = isUnsizedNumber e isUnsizedNumber (UniOp UniSub e) = isUnsizedNumber e
isUnsizedNumber _ = False isUnsizedNumber _ = False
convertExpr (Struct packing fields (_:rs)) (Concat exprs) = convertExpr (Struct packing fields (_:rs)) (Concat exprs) =
Concat $ map (convertExpr (Struct packing fields rs)) exprs Concat $ map (convertExpr (Struct packing fields rs)) exprs
convertExpr (Struct packing fields (_:rs)) (Bit e _) = convertExpr (Struct packing fields (_:rs)) (Bit e _) =
convertExpr (Struct packing fields rs) e convertExpr (Struct packing fields rs) e
convertExpr (Struct packing fields []) (Pattern [("", Repeat (Number nStr) exprs)]) = convertExpr (Struct packing fields []) (Pattern [("", Repeat (Number nStr) exprs)]) =
case fmap fromIntegral (readNumber nStr) of case fmap fromIntegral (readNumber nStr) of
Just n -> convertExpr (Struct packing fields []) $ Pattern $ Just n -> convertExpr (Struct packing fields []) $ Pattern $
zip (repeat "") (concat $ take n $ repeat exprs) zip (repeat "") (concat $ take n $ repeat exprs)
Nothing -> Nothing ->
error $ "unable to handle repeat in pattern: " ++ error $ "unable to handle repeat in pattern: " ++
(show $ Repeat (Number nStr) exprs) (show $ Repeat (Number nStr) exprs)
convertExpr (Struct packing fields []) (Pattern itemsOrig) = convertExpr (struct @ (Struct _ fields [])) (Pattern itemsOrig) =
if extraNames /= Set.empty then if extraNames /= Set.empty then
error $ "pattern " ++ show (Pattern itemsOrig) ++ error $ "pattern " ++ show (Pattern itemsOrig) ++
" has extra named fields: " ++ " has extra named fields: " ++
show (Set.toList extraNames) ++ " that are not in " ++ show (Set.toList extraNames) ++ " that are not in " ++ show struct
show structTf else if structIsntReady struct then
else if isReadyStruct (structTf []) then Pattern items
else
Concat Concat
$ map (uncurry $ Cast . Left) $ map (uncurry $ Cast . Left)
$ zip (map fst fields) (map snd items) $ zip (map fst fields) (map snd items)
else
Pattern items
where where
structTf = Struct packing fields
fieldNames = map snd fields fieldNames = map snd fields
fieldTypeMap = Map.fromList $ map swap fields fieldTypeMap = Map.fromList $ map swap fields
...@@ -293,8 +243,7 @@ convertAsgn types (lhs, expr) = ...@@ -293,8 +243,7 @@ convertAsgn types (lhs, expr) =
-- position-based patterns should cover every field -- position-based patterns should cover every field
else if length itemsOrig /= length fields then else if length itemsOrig /= length fields then
error $ "struct pattern " ++ show (Pattern itemsOrig) ++ error $ "struct pattern " ++ show (Pattern itemsOrig) ++
" doesn't have the same # of items as " ++ " doesn't have the same # of items as " ++ show struct
show structTf
-- if the pattern does not use identifiers, use the -- if the pattern does not use identifiers, use the
-- identifiers from the struct type definition in order -- identifiers from the struct type definition in order
else else
...@@ -326,7 +275,7 @@ convertAsgn types (lhs, expr) = ...@@ -326,7 +275,7 @@ convertAsgn types (lhs, expr) =
specialItemMap Map.! defaultKey specialItemMap Map.! defaultKey
else else
error $ "couldn't find field " ++ fieldName ++ error $ "couldn't find field " ++ fieldName ++
" from struct definition " ++ show structTf ++ " from struct definition " ++ show struct ++
" in struct pattern " ++ show itemsOrig " in struct pattern " ++ show itemsOrig
where where
fieldType = fieldTypeMap Map.! fieldName fieldType = fieldTypeMap Map.! fieldName
...@@ -336,7 +285,7 @@ convertAsgn types (lhs, expr) = ...@@ -336,7 +285,7 @@ convertAsgn types (lhs, expr) =
isStruct (Struct{}) = True isStruct (Struct{}) = True
isStruct _ = False isStruct _ = False
convertExpr (Struct packing fields (r : rs)) (Pattern items) = convertExpr (Struct packing fields (r : rs)) (Pattern items) =
if all null keys if all null keys
then convertExpr (structTf (r : rs)) (Concat vals) then convertExpr (structTf (r : rs)) (Concat vals)
else Repeat (rangeSize r) [subExpr'] else Repeat (rangeSize r) [subExpr']
...@@ -345,69 +294,75 @@ convertAsgn types (lhs, expr) = ...@@ -345,69 +294,75 @@ convertAsgn types (lhs, expr) =
subExpr = Pattern items subExpr = Pattern items
structTf = Struct packing fields structTf = Struct packing fields
subExpr' = convertExpr (structTf rs) subExpr subExpr' = convertExpr (structTf rs) subExpr
convertExpr (Struct packing fields (r : rs)) subExpr = convertExpr (Struct packing fields (r : rs)) subExpr =
Repeat (rangeSize r) [subExpr'] Repeat (rangeSize r) [subExpr']
where where
structTf = Struct packing fields structTf = Struct packing fields
subExpr' = convertExpr (structTf rs) subExpr subExpr' = convertExpr (structTf rs) subExpr
convertExpr _ other = other convertExpr _ other = other
-- try expression conversion by looking at the *innermost* type first fallbackType :: Scopes Type -> Expr -> (Type, Expr)
convertSubExpr :: Expr -> (Type, Expr) fallbackType scopes e =
convertSubExpr (Ident x) = case lookupExpr scopes e of
case Map.lookup x types of Nothing -> (unknownType, e)
Nothing -> (Implicit Unspecified [], Ident x) Just (_, _, t) -> (t, e)
Just t -> (t, Ident x)
convertSubExpr (Dot e x) = -- converting LHSs by looking at the innermost types first
if maybeFields == Nothing convertLHS :: LHS -> Scoper Type (Type, LHS)
then (Implicit Unspecified [], Dot e' x) convertLHS l = do
else if not $ isReadyStruct (structTf []) let e = lhsToExpr l
then (fieldType, Dot e' x) (t, e') <- embedScopes convertSubExpr e
else (dropInnerTypeRange fieldType, undotted) 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 where
(subExprType, e') = convertSubExpr e (subExprType, e') = convertSubExpr scopes e
maybeFields = getFields subExprType (fieldType, bounds, dims) = lookupFieldInfo subExprType x
Just (structTf, fields) = maybeFields
(fieldType, bounds, dims) = lookupFieldInfo structTf fields x
base = fst bounds base = fst bounds
len = rangeSize bounds len = rangeSize bounds
[dim] = dims undotted = if null dims || rangeSize (head dims) == Number "1"
undotted = if null dims || rangeSize dim == Number "1"
then Bit e' (fst bounds) then Bit e' (fst bounds)
else Range e' IndexedMinus (base, len) else Range e' IndexedMinus (base, len)
convertSubExpr (Range (Dot e x) NonIndexed rOuter) = convertSubExpr scopes (Range (Dot e x) NonIndexed rOuter) =
if maybeFields == Nothing if isntStruct subExprType then
then (Implicit Unspecified [], orig') fallbackType scopes orig'
else if not $ isReadyStruct (structTf []) else if structIsntReady subExprType then
then (fieldType, orig') (dropInnerTypeRange fieldType, orig')
else (dropInnerTypeRange fieldType, undotted) else
(dropInnerTypeRange fieldType, undotted)
where where
(subExprType, e') = convertSubExpr scopes e
orig' = Range (Dot e' x) NonIndexed rOuter orig' = Range (Dot e' x) NonIndexed rOuter
(subExprType, e') = convertSubExpr e (fieldType, bounds, dims) = lookupFieldInfo subExprType x
maybeFields = getFields subExprType
Just (structTf, fields) = maybeFields
(fieldType, bounds, dims) = lookupFieldInfo structTf fields x
[dim] = dims [dim] = dims
undotted = Range e' NonIndexed $ rangeLeft = ( BinOp Sub (fst bounds) $ BinOp Sub (fst dim) (fst rOuter)
endianCondRange dim rangeLeft rangeRight
rangeLeft =
( BinOp Sub (fst bounds) $ BinOp Sub (fst dim) (fst rOuter)
, BinOp Sub (fst bounds) $ BinOp Sub (fst dim) (snd rOuter) ) , BinOp Sub (fst bounds) $ BinOp Sub (fst dim) (snd rOuter) )
rangeRight = rangeRight =( BinOp Add (snd bounds) $ BinOp Sub (snd dim) (fst rOuter)
( BinOp Add (snd bounds) $ BinOp Sub (snd dim) (fst rOuter)
, BinOp Add (snd bounds) $ BinOp Sub (snd dim) (snd rOuter) ) , BinOp Add (snd bounds) $ BinOp Sub (snd dim) (snd rOuter) )
convertSubExpr (Range (Dot e x) mode (baseO, lenO)) = undotted = Range e' NonIndexed $
if maybeFields == Nothing endianCondRange dim rangeLeft rangeRight
then (Implicit Unspecified [], orig') convertSubExpr scopes (Range (Dot e x) mode (baseO, lenO)) =
else if not $ isReadyStruct (structTf []) if isntStruct subExprType then
then (fieldType, orig') fallbackType scopes orig'
else (dropInnerTypeRange fieldType, undotted) else if structIsntReady subExprType then
(dropInnerTypeRange fieldType, orig')
else
(dropInnerTypeRange fieldType, undotted)
where where
(subExprType, e') = convertSubExpr scopes e
orig' = Range (Dot e' x) mode (baseO, lenO) orig' = Range (Dot e' x) mode (baseO, lenO)
(subExprType, e') = convertSubExpr e (fieldType, bounds, dims) = lookupFieldInfo subExprType x
maybeFields = getFields subExprType
Just (structTf, fields) = maybeFields
(fieldType, bounds, dims) = lookupFieldInfo structTf fields x
[dim] = dims [dim] = dims
baseLeft = BinOp Sub (fst bounds) $ BinOp Sub (fst dim) baseO baseLeft = BinOp Sub (fst bounds) $ BinOp Sub (fst dim) baseO
baseRight = BinOp Add (snd bounds) $ BinOp Sub (snd dim) baseO baseRight = BinOp Add (snd bounds) $ BinOp Sub (snd dim) baseO
...@@ -419,104 +374,94 @@ convertAsgn types (lhs, expr) = ...@@ -419,104 +374,94 @@ convertAsgn types (lhs, expr) =
base = endianCondExpr dim baseDec baseInc base = endianCondExpr dim baseDec baseInc
undotted = Range e' mode (base, lenO) undotted = Range e' mode (base, lenO)
one = Number "1" one = Number "1"
convertSubExpr (Range e mode r) = convertSubExpr scopes (Range e mode r) =
(t', Range e' mode r) (dropInnerTypeRange t, Range e' mode r)
where where (t, e') = convertSubExpr scopes e
(t, e') = convertSubExpr e convertSubExpr scopes (Bit (Dot e x) i) =
t' = dropInnerTypeRange t if isntStruct subExprType then
convertSubExpr (Bit (Dot e x) i) = fallbackType scopes orig'
if maybeFields == Nothing else if structIsntReady subExprType then
then (Implicit Unspecified [], Bit (Dot e' x) i) (dropInnerTypeRange fieldType, orig')
else if not $ isReadyStruct (structTf []) else
then (dropInnerTypeRange fieldType, Bit (Dot e' x) i) (dropInnerTypeRange fieldType, Bit e' i')
else (dropInnerTypeRange fieldType, Bit e' i')
where where
(subExprType, e') = convertSubExpr e (subExprType, e') = convertSubExpr scopes e
maybeFields = getFields subExprType orig' = Bit (Dot e' x) i
Just (structTf, fields) = maybeFields (fieldType, bounds, dims) = lookupFieldInfo subExprType x
(fieldType, bounds, dims) = lookupFieldInfo structTf fields x
[dim] = dims [dim] = dims
iLeft = BinOp Sub (fst bounds) $ BinOp Sub (fst dim) i iLeft = BinOp Sub (fst bounds) $ BinOp Sub (fst dim) i
iRight = BinOp Add (snd bounds) $ BinOp Sub (snd dim) i iRight = BinOp Add (snd bounds) $ BinOp Sub (snd dim) i
i' = endianCondExpr dim iLeft iRight i' = endianCondExpr dim iLeft iRight
convertSubExpr (Bit e i) = convertSubExpr scopes (Bit e i) =
(t', 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 where
(t, e') = convertSubExpr e (retType, _) = fallbackType scopes e
t' = dropInnerTypeRange t args' = convertCall scopes e args
convertSubExpr (Call e args) = convertSubExpr scopes (Cast (Left t) e) =
(retType, Call e $ convertCall types e' args) (t, Cast (Left t) e')
where where (_, e') = convertSubExpr scopes e
(_, e') = convertSubExpr e convertSubExpr scopes (Pattern items) =
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' if all (== "") $ map fst items'
then (Implicit Unspecified [], Concat $ map snd items') then (unknownType, Concat $ map snd items')
else (Implicit Unspecified [], Pattern items') else (unknownType, Pattern items')
where where
items' = map mapItem items items' = map mapItem items
mapItem (mx, e) = (mx, snd $ convertSubExpr e) mapItem (x, e) = (x, e')
convertSubExpr (Mux a b c) = where (_, e') = convertSubExpr scopes e
convertSubExpr scopes (Mux a b c) =
(t, Mux a' b' c') (t, Mux a' b' c')
where where
(_, a') = convertSubExpr a (_, a') = convertSubExpr scopes a
(t, b') = convertSubExpr b (t, b') = convertSubExpr scopes b
(_, c') = convertSubExpr c (_, c') = convertSubExpr scopes c
convertSubExpr other = convertSubExpr scopes other =
(Implicit Unspecified [], other) fallbackType scopes other
-- lookup the range of a field in its unstructured type -- get the fields and type function of a struct or union
lookupUnstructRange :: TypeFunc -> Identifier -> Range getFields :: Type -> Maybe [Field]
lookupUnstructRange structTf fieldName = getFields (Struct _ fields []) = Just fields
case Map.lookup fieldName fieldRangeMap of getFields (Union _ fields []) = Just fields
Nothing -> error $ "field '" ++ fieldName ++ getFields _ = Nothing
"' not found in struct: " ++ show structTf
Just r -> r isntStruct :: Type -> Bool
where isntStruct = (== Nothing) . getFields
Just structInfo = convertStruct $ structTf []
fieldRangeMap = Map.map fst $ snd structInfo -- get the field type, flattended bounds, and original type dimensions
lookupFieldInfo :: Type -> Identifier -> (Type, Range, [Range])
-- lookup the type of a field in the given field list lookupFieldInfo struct fieldName =
lookupFieldType :: [(Type, Identifier)] -> Identifier -> Type if maybeFieldType == Nothing
lookupFieldType fields fieldName = fieldMap Map.! fieldName then error $ "field '" ++ fieldName ++ "' not found in: " ++ show struct
where fieldMap = Map.fromList $ map swap fields else (fieldType, bounds, dims)
-- 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 where
fieldType = lookupFieldType fields x Just fields = getFields struct
bounds = lookupUnstructRange structTf x maybeFieldType = lookup fieldName $ map swap fields
Just fieldType = maybeFieldType
dims = snd $ typeRanges fieldType 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 -- attempts to convert based on the assignment-like contexts of TF arguments
convertCall :: Types -> Expr -> Args -> Args convertCall :: Scopes Type -> Expr -> Args -> Args
convertCall types fn (Args pnArgs kwArgs) = convertCall scopes fn (Args pnArgs kwArgs) =
case fn of case exprToLHS fn of
Ident _ -> args Just fnLHS ->
Args (map snd pnArgs') kwArgs'
where
pnArgs' = map (convertArg fnLHS) $ zip idxs pnArgs
kwArgs' = map (convertArg fnLHS) kwArgs
_ -> Args pnArgs kwArgs _ -> Args pnArgs kwArgs
where where
Ident f = fn
idxs = map show ([0..] :: [Int]) idxs = map show ([0..] :: [Int])
args = Args convertArg :: LHS -> (Identifier, Expr) -> (Identifier, Expr)
(map snd $ map convertArg $ zip idxs pnArgs) convertArg lhs (x, e) =
(map convertArg kwArgs) (x, e')
convertArg :: (Identifier, Expr) -> (Identifier, Expr)
convertArg (x, e) = (x, e')
where where
(_, e') = convertAsgn types details = lookupLHS scopes $ LHSDot lhs x
(LHSIdent $ f ++ ":" ++ x, e) typ = maybe unknownType thd3 details
thd3 (_, _, c) = c
(_, e') = convertSubExpr scopes $ convertExpr typ e
...@@ -57,6 +57,12 @@ module Convert.Traverse ...@@ -57,6 +57,12 @@ module Convert.Traverse
, traverseTypeExprsM , traverseTypeExprsM
, traverseTypeExprs , traverseTypeExprs
, collectTypeExprsM , collectTypeExprsM
, traverseGenItemExprsM
, traverseGenItemExprs
, collectGenItemExprsM
, traverseDeclExprsM
, traverseDeclExprs
, collectDeclExprsM
, traverseDeclTypesM , traverseDeclTypesM
, traverseDeclTypes , traverseDeclTypes
, collectDeclTypesM , collectDeclTypesM
...@@ -97,6 +103,8 @@ module Convert.Traverse ...@@ -97,6 +103,8 @@ module Convert.Traverse
, stately , stately
, traverseFilesM , traverseFilesM
, traverseFiles , traverseFiles
, traverseSinglyNestedGenItemsM
, traverseSinglyNestedStmtsM
) where ) where
import Data.Functor.Identity (Identity, runIdentity) import Data.Functor.Identity (Identity, runIdentity)
...@@ -407,7 +415,7 @@ traverseNestedExprsM :: Monad m => MapperM m Expr -> MapperM m Expr ...@@ -407,7 +415,7 @@ traverseNestedExprsM :: Monad m => MapperM m Expr -> MapperM m Expr
traverseNestedExprsM mapper = exprMapper traverseNestedExprsM mapper = exprMapper
where where
exprMapper = mapper >=> em exprMapper = mapper >=> em
(_, _, _, typeMapper) = exprMapperHelpers exprMapper (_, _, _, typeMapper, _) = exprMapperHelpers exprMapper
typeOrExprMapper (Left t) = typeOrExprMapper (Left t) =
typeMapper t >>= return . Left typeMapper t >>= return . Left
typeOrExprMapper (Right e) = typeOrExprMapper (Right e) =
...@@ -489,9 +497,19 @@ traverseNestedExprsM mapper = exprMapper ...@@ -489,9 +497,19 @@ traverseNestedExprsM mapper = exprMapper
em (Nil) = return Nil em (Nil) = return Nil
exprMapperHelpers :: Monad m => MapperM m Expr -> 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 = exprMapperHelpers exprMapper =
(rangeMapper, declMapper, traverseNestedLHSsM lhsMapper, typeMapper) ( rangeMapper
, declMapper
, traverseNestedLHSsM lhsMapper
, typeMapper
, genItemMapper
)
where where
rangeMapper (a, b) = do rangeMapper (a, b) = do
...@@ -535,11 +553,26 @@ exprMapperHelpers exprMapper = ...@@ -535,11 +553,26 @@ exprMapperHelpers exprMapper =
return $ LHSStream o e' ls return $ LHSStream o e' ls
lhsMapper other = return other 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' :: Monad m => TFStrategy -> MapperM m Expr -> MapperM m ModuleItem
traverseExprsM' strat exprMapper = moduleItemMapper traverseExprsM' strat exprMapper = moduleItemMapper
where where
(rangeMapper, declMapper, lhsMapper, typeMapper) (rangeMapper, declMapper, lhsMapper, typeMapper, genItemMapper)
= exprMapperHelpers exprMapper = exprMapperHelpers exprMapper
stmtMapper = traverseNestedStmtsM (traverseStmtExprsM exprMapper) stmtMapper = traverseNestedStmtsM (traverseStmtExprsM exprMapper)
...@@ -632,21 +665,6 @@ traverseExprsM' strat exprMapper = moduleItemMapper ...@@ -632,21 +665,6 @@ traverseExprsM' strat exprMapper = moduleItemMapper
a'' <- traverseAssertionExprsM exprMapper a' a'' <- traverseAssertionExprsM exprMapper a'
return $ AssertionItem (mx, 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 modportDeclMapper (dir, ident, t, e) = do
t' <- typeMapper t t' <- typeMapper t
e' <- exprMapper e e' <- exprMapper e
...@@ -668,7 +686,7 @@ traverseStmtExprsM :: Monad m => MapperM m Expr -> MapperM m Stmt ...@@ -668,7 +686,7 @@ traverseStmtExprsM :: Monad m => MapperM m Expr -> MapperM m Stmt
traverseStmtExprsM exprMapper = flatStmtMapper traverseStmtExprsM exprMapper = flatStmtMapper
where where
(_, declMapper, lhsMapper, _) = exprMapperHelpers exprMapper (_, declMapper, lhsMapper, _, _) = exprMapperHelpers exprMapper
caseMapper (exprs, stmt) = do caseMapper (exprs, stmt) = do
exprs' <- mapM exprMapper exprs exprs' <- mapM exprMapper exprs
...@@ -888,13 +906,33 @@ collectExprTypesM = collectify traverseExprTypesM ...@@ -888,13 +906,33 @@ collectExprTypesM = collectify traverseExprTypesM
traverseTypeExprsM :: Monad m => MapperM m Expr -> MapperM m Type traverseTypeExprsM :: Monad m => MapperM m Expr -> MapperM m Type
traverseTypeExprsM mapper = traverseTypeExprsM mapper =
typeMapper typeMapper
where (_, _, _, typeMapper) = exprMapperHelpers mapper where (_, _, _, typeMapper, _) = exprMapperHelpers mapper
traverseTypeExprs :: Mapper Expr -> Mapper Type traverseTypeExprs :: Mapper Expr -> Mapper Type
traverseTypeExprs = unmonad traverseTypeExprsM traverseTypeExprs = unmonad traverseTypeExprsM
collectTypeExprsM :: Monad m => CollectorM m Expr -> CollectorM m Type collectTypeExprsM :: Monad m => CollectorM m Expr -> CollectorM m Type
collectTypeExprsM = collectify traverseTypeExprsM 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 :: Monad m => MapperM m Type -> MapperM m Decl
traverseDeclTypesM mapper (Param s t x e) = traverseDeclTypesM mapper (Param s t x e) =
mapper t >>= \t' -> return $ Param s t' x e mapper t >>= \t' -> return $ Param s t' x e
......
...@@ -11,45 +11,27 @@ ...@@ -11,45 +11,27 @@
module Convert.TypeOf (convert) where module Convert.TypeOf (convert) where
import Control.Monad.State
import Data.List (elemIndex) import Data.List (elemIndex)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Int (Int32) import Data.Int (Int32)
import Data.Tuple (swap) import Data.Tuple (swap)
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Convert.Scoper
import Convert.Traverse import Convert.Traverse
import Language.SystemVerilog.AST import Language.SystemVerilog.AST
type Info = Map.Map Identifier Type
convert :: [AST] -> [AST] 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 traverseDeclM decl = do
item <- traverseModuleItemM (MIPackageItem $ Decl decl) item <- traverseModuleItemM (MIPackageItem $ Decl decl)
let MIPackageItem (Decl decl') = item let MIPackageItem (Decl decl') = item
case decl' of case decl' of
Variable d t ident a e -> do Variable d t ident a e -> do
let t' = injectRanges t a let t' = injectRanges t a
modify $ Map.insert ident t' insertElem ident t'
return $ case t' of return $ case t' of
UnpackedType t'' a' -> Variable d t'' ident a' e UnpackedType t'' a' -> Variable d t'' ident a' e
_ -> Variable d t' ident [] e _ -> Variable d t' ident [] e
...@@ -57,39 +39,58 @@ traverseDeclM decl = do ...@@ -57,39 +39,58 @@ traverseDeclM decl = do
let t' = if t == Implicit Unspecified [] let t' = if t == Implicit Unspecified []
then IntegerAtom TInteger Unspecified then IntegerAtom TInteger Unspecified
else t else t
modify $ Map.insert ident t' insertElem ident t'
return decl' return decl'
ParamType{} -> return decl' ParamType{} -> return decl'
CommentDecl{} -> return decl' CommentDecl{} -> return decl'
traverseModuleItemM :: ModuleItem -> State Info ModuleItem traverseModuleItemM :: ModuleItem -> Scoper Type ModuleItem
traverseModuleItemM item = traverseTypesM traverseTypeM item traverseModuleItemM = traverseTypesM traverseTypeM
traverseGenItemM :: GenItem -> Scoper Type GenItem
traverseGenItemM = traverseGenItemExprsM traverseExprM
traverseStmtM :: Stmt -> Scoper Type Stmt
traverseStmtM = traverseStmtExprsM traverseExprM
traverseStmtM :: Stmt -> State Info Stmt traverseExprM :: Expr -> Scoper Type Expr
traverseStmtM = traverseExprM = traverseNestedExprsM $ traverseExprTypesM traverseTypeM
traverseStmtExprsM $ traverseNestedExprsM $ traverseExprTypesM traverseTypeM
traverseTypeM :: Type -> State Info Type traverseTypeM :: Type -> Scoper Type Type
traverseTypeM (TypeOf expr) = typeof expr traverseTypeM (TypeOf expr) = typeof expr
traverseTypeM other = return other 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) = typeof (Number n) =
return $ IntegerVector TLogic sg [r] return $ IntegerVector TLogic sg [r]
where where
(size, sg) = parseNumber n (size, sg) = parseNumber n
r = (Number $ show (size - 1), Number "0") r = (Number $ show (size - 1), Number "0")
typeof (orig @ (Ident x)) = do typeof (Call (Ident x) _) =
res <- gets $ Map.lookup x typeof $ Ident x
return $ fromMaybe (TypeOf orig) res
typeof (orig @ (Call (Ident x) _)) = do
res <- gets $ Map.lookup x
return $ fromMaybe (TypeOf orig) res
typeof (orig @ (Bit e _)) = do typeof (orig @ (Bit e _)) = do
t <- typeof e t <- typeof e
return $ case t of case t of
TypeOf _ -> TypeOf orig TypeOf _ -> lookupTypeOf orig
_ -> popRange t _ -> return $ popRange t
typeof (orig @ (Range e mode r)) = do typeof (orig @ (Range e mode r)) = do
t <- typeof e t <- typeof e
return $ case t of return $ case t of
...@@ -103,17 +104,18 @@ typeof (orig @ (Range e mode r)) = do ...@@ -103,17 +104,18 @@ typeof (orig @ (Range e mode r)) = do
IndexedMinus -> BinOp Add (uncurry (BinOp Sub) r) (Number "1") IndexedMinus -> BinOp Add (uncurry (BinOp Sub) r) (Number "1")
typeof (orig @ (Dot e x)) = do typeof (orig @ (Dot e x)) = do
t <- typeof e t <- typeof e
return $ case t of case t of
Struct _ fields [] -> 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 case lookup x $ map swap fields of
Just typ -> typ Just typ -> typ
Nothing -> TypeOf orig 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 (Cast (Right s) _) = return $ typeOfSize s
typeof (UniOp UniSub e ) = typeof e typeof (UniOp UniSub e ) = typeof e
typeof (UniOp BitNot e ) = typeof e typeof (UniOp BitNot e ) = typeof e
...@@ -135,7 +137,7 @@ typeof (Mux _ a b) = return $ largerSizeType a b ...@@ -135,7 +137,7 @@ typeof (Mux _ a b) = return $ largerSizeType a b
typeof (Concat exprs) = return $ typeOfSize $ concatSize exprs typeof (Concat exprs) = return $ typeOfSize $ concatSize exprs
typeof (Repeat reps exprs) = return $ typeOfSize size typeof (Repeat reps exprs) = return $ typeOfSize size
where size = BinOp Mul reps (concatSize exprs) 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 -- determines the size and sign of a number literal
parseNumber :: String -> (Int32, Signing) parseNumber :: String -> (Int32, Signing)
......
...@@ -9,108 +9,91 @@ ...@@ -9,108 +9,91 @@
module Convert.Typedef (convert) where module Convert.Typedef (convert) where
import Control.Monad.Writer import Control.Monad ((>=>))
import qualified Data.Map as Map
import Convert.Scoper
import Convert.Traverse import Convert.Traverse
import Language.SystemVerilog.AST import Language.SystemVerilog.AST
type Types = Map.Map Identifier Type
convert :: [AST] -> [AST] 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 traverseExprM :: Expr -> Scoper Type Expr
convertDescription (description @ Part{}) = traverseExprM (Cast v e) = do
traverseModuleItems (convertTypedef types) description' v' <- traverseTypeOrExprM v
where return $ Cast v' e
description' = traverseExprM (DimsFn f v) = do
traverseModuleItems (traverseGenItems convertGenItem) description v' <- traverseTypeOrExprM v
types = execWriter $ collectModuleItemsM collectTypedefM description' return $ DimsFn f v'
convertDescription other = other traverseExprM (DimFn f v e) = do
v' <- traverseTypeOrExprM v
return $ DimFn f v' e
traverseExprM other = return other
convertTypedef :: Types -> ModuleItem -> ModuleItem traverseModuleItemM :: ModuleItem -> Scoper Type ModuleItem
convertTypedef types = traverseModuleItemM (MIPackageItem (Typedef t x)) = do
removeTypedef . t' <- traverseNestedTypesM traverseTypeM t
convertModuleItem . insertElem x t'
(traverseExprs $ traverseNestedExprs $ convertExpr) . return $ Generate []
(traverseTypes $ resolveType types) traverseModuleItemM (Instance m params x rs p) = do
where let mapParam (i, v) = traverseTypeOrExprM v >>= \v' -> return (i, v')
removeTypedef :: ModuleItem -> ModuleItem params' <- mapM mapParam params
removeTypedef (MIPackageItem (Typedef _ x)) = traverseModuleItemM' $ Instance m params' x rs p
MIPackageItem $ Decl $ CommentDecl $ "removed typedef: " ++ x traverseModuleItemM item = traverseModuleItemM' item
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
convertGenItem :: GenItem -> GenItem traverseModuleItemM' :: ModuleItem -> Scoper Type ModuleItem
convertGenItem (GenIf c a b) = traverseModuleItemM' =
GenIf c a' b' traverseTypesM traverseTypeM >=>
where traverseExprsM (traverseNestedExprsM traverseExprM)
a' = convertGenItem' a
b' = convertGenItem' b
convertGenItem other = other
convertGenItem' :: GenItem -> GenItem traverseGenItemM :: GenItem -> Scoper Type GenItem
convertGenItem' item = do traverseGenItemM = traverseGenItemExprsM (traverseNestedExprsM traverseExprM)
GenBlock "" items
where
-- convert inner generate blocks first
item' = Generate [traverseNestedGenItems convertGenItem item]
types = execWriter $ collectNestedModuleItemsM collectTypedefM item'
Generate items = traverseNestedModuleItems (convertTypedef types) item'
collectTypedefM :: ModuleItem -> Writer Types () traverseDeclM :: Decl -> Scoper Type Decl
collectTypedefM (MIPackageItem (Typedef a b)) = tell $ Map.singleton b a traverseDeclM decl = do
collectTypedefM _ = return () 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) traverseStmtM :: Stmt -> Scoper Type Stmt
resolveItem types (t, x) = (resolveType types t, x) traverseStmtM =
traverseStmtExprsM $ traverseNestedExprsM $
traverseExprTypesM traverseTypeM >=> traverseExprM
resolveType :: Types -> Type -> Type traverseTypeM :: Type -> Scoper Type Type
resolveType _ (Net kw sg rs) = Net kw sg rs traverseTypeM (Alias Nothing st rs1) = do
resolveType _ (Implicit sg rs) = Implicit sg rs details <- lookupIdentM st
resolveType _ (IntegerVector kw sg rs) = IntegerVector kw sg rs return $ case details of
resolveType _ (IntegerAtom kw sg ) = IntegerAtom kw sg Nothing -> Alias Nothing st rs1
resolveType _ (NonInteger kw ) = NonInteger kw Just (_, _, typ) -> case typ of
resolveType _ (InterfaceT x my rs) = InterfaceT x my rs Net kw sg rs2 -> Net kw sg $ rs1 ++ rs2
resolveType _ (Alias (Just ps) st rs) = Alias (Just ps) st rs Implicit sg rs2 -> Implicit sg $ rs1 ++ rs2
resolveType _ (TypeOf expr) = TypeOf expr IntegerVector kw sg rs2 -> IntegerVector kw sg $ rs1 ++ rs2
resolveType _ (UnpackedType t rs) = UnpackedType t rs Enum t v rs2 -> Enum t v $ rs1 ++ rs2
resolveType types (Enum t vals rs) = Enum (resolveType types t) vals rs Struct p l rs2 -> Struct p l $ rs1 ++ rs2
resolveType types (Struct p items rs) = Struct p (map (resolveItem types) items) rs Union p l rs2 -> Union p l $ rs1 ++ rs2
resolveType types (Union p items rs) = Union p (map (resolveItem types) items) rs InterfaceT x my rs2 -> InterfaceT x my $ rs1 ++ rs2
resolveType types (Alias Nothing st rs1) = Alias ps x rs2 -> Alias ps x $ rs1 ++ rs2
if Map.notMember st types UnpackedType t rs2 -> UnpackedType t $ rs1 ++ rs2
then Alias Nothing st rs1 IntegerAtom kw sg -> nullRange (IntegerAtom kw sg) rs1
else case resolveType types $ types Map.! st of NonInteger kw -> nullRange (NonInteger kw ) rs1
(Net kw sg rs2) -> Net kw sg $ rs1 ++ rs2 TypeOf expr -> nullRange (TypeOf expr) rs1
(Implicit sg rs2) -> Implicit sg $ rs1 ++ rs2 traverseTypeM other = return other
(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
...@@ -81,6 +81,7 @@ executable sv2v ...@@ -81,6 +81,7 @@ executable sv2v
Convert.Package Convert.Package
Convert.ParamType Convert.ParamType
Convert.RemoveComments Convert.RemoveComments
Convert.Scoper
Convert.SignCast Convert.SignCast
Convert.Simplify Convert.Simplify
Convert.SizeCast Convert.SizeCast
......
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
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
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
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; ...@@ -134,6 +134,7 @@ module top;
input StructA b; input StructA b;
input StructB c; input StructB c;
input StructC d; input StructC d;
integer unused;
input StructD e; input StructD e;
input StructE f; input StructE f;
$display("F: %1d%1d%1d -> ", i,j,k, a,b,c,d,e,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