luke
/
sv2v
mirror of https://github.com/zachjs/sv2v.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

refactor interface conversion

This commit is contained in:
Zachary Snow 2020-06-20 14:39:57 -04:00
parent aca24ebe53
commit 4bebb85c14
2 changed files with 73 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

154
src/Convert/Interface.hs
View File

@ -6,7 +6,7 @@
module Convert.Interface (convert) where module Convert.Interface (convert) where
import Data.Maybe (fromJust, mapMaybe) import Data.Maybe (mapMaybe)
import Control.Monad.Writer import Control.Monad.Writer
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
@ -14,11 +14,12 @@ import qualified Data.Set as Set
import Convert.Traverse import Convert.Traverse
import Language.SystemVerilog.AST import Language.SystemVerilog.AST
type Instances = Map.Map Identifier Identifier
type Interface = ([Identifier], [ModuleItem]) type Interface = ([Identifier], [ModuleItem])
type Interfaces = Map.Map Identifier Interface type Interfaces = Map.Map Identifier Interface
type Modports = Map.Map Identifier (Identifier, [ModportDecl]) type Module = ([Identifier], [(Identifier, Type)])
type Modules = Map.Map Identifier ([Identifier], [(Identifier, Type)]) type Modules = Map.Map Identifier Module
type Instances = Map.Map Identifier Identifier
type Modports = Map.Map Identifier (Identifier, Identifier)
convert :: [AST] -> [AST] convert :: [AST] -> [AST]
convert = convert =
@ -80,54 +81,54 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po
-- collect the interface type of all interface instances in this module -- collect the interface type of all interface instances in this module
(instances, modports) = execWriter $ mapM (instances, modports) = execWriter $ mapM
(collectNestedModuleItemsM collectInterface) items (collectNestedModuleItemsM collectInstanceM) items
collectInterface :: ModuleItem -> Writer (Instances, Modports) () collectInstanceM :: ModuleItem -> Writer (Instances, Modports) ()
collectInterface (MIPackageItem (Decl (Variable _ t ident _ _))) = collectInstanceM (MIPackageItem (Decl (Variable _ t ident _ _))) =
case t of case t of
InterfaceT interfaceName (Just modportName) [] -> InterfaceT interfaceName (Just modportName) [] ->
if Map.member interfaceName interfaces if Map.member interfaceName interfaces
then tell (Map.empty, Map.singleton ident (interfaceName, modportDecls)) then writeModport interfaceName modportName
else return () else return ()
where Just modportDecls = lookupModport interfaceName modportName
Alias Nothing interfaceName [] -> Alias Nothing interfaceName [] ->
case impliedModport interfaceName of if Map.member interfaceName interfaces
Just modportDecls -> then writeModport interfaceName ""
tell (Map.empty, Map.singleton ident modport) else return ()
where modport = (interfaceName, modportDecls)
Nothing -> return ()
_ -> return () _ -> return ()
collectInterface (Instance part _ ident [] _) = where
writeModport :: Identifier -> Identifier ->
Writer (Instances, Modports) ()
writeModport interfaceName modportName =
tell (Map.empty, Map.singleton ident modport)
where modport = (interfaceName, modportName)
collectInstanceM (Instance part _ ident [] _) =
if Map.member part interfaces if Map.member part interfaces
then tell (Map.singleton ident part, Map.empty) then tell (Map.singleton ident part, Map.empty)
else return () else return ()
collectInterface _ = return () collectInstanceM _ = return ()
mapInterface :: ModuleItem -> ModuleItem mapInterface :: ModuleItem -> ModuleItem
mapInterface (orig @ (MIPackageItem (Decl (Variable _ t ident _ _)))) = mapInterface (orig @ (MIPackageItem (Decl (Variable _ _ ident _ _)))) =
-- expand instantiation of a modport -- expand instantiation of a modport
case Map.lookup ident modports of if Map.member ident modports
Just (_, modportDecls) -> Generate $ map GenModuleItem $ then Generate $ map GenModuleItem $
filter shouldKeep interfaceItems ++ map makePortDecl filter shouldKeep interfaceItems ++ map makePortDecl
(prefixModportDecls ident modportDecls) modportDecls
Nothing -> orig else orig
where where
interfaceName = case t of Just (interfaceName, modportName) = Map.lookup ident modports
InterfaceT x (Just _) [] -> x
Alias Nothing x [] -> x
_ -> error $ "unexpected modport type " ++ show t
interfaceItems = prefixInterface ident $ interfaceItems = prefixInterface ident $
case Map.lookup interfaceName interfaces of snd $ lookupInterface interfaceName
Just res -> snd res modportDecls = lookupModport interfaceItems modportName
Nothing -> error $ "could not find interface " ++ show interfaceName
shouldKeep (MIPackageItem (Decl Param{})) = True shouldKeep (MIPackageItem (Decl Param{})) = True
shouldKeep (MIPackageItem Task{}) = True shouldKeep (MIPackageItem Task{}) = True
shouldKeep (MIPackageItem Function{}) = True shouldKeep (MIPackageItem Function{}) = True
shouldKeep _ = False shouldKeep _ = False
makePortDecl :: ModportDecl -> ModuleItem makePortDecl :: ModportDecl -> ModuleItem
makePortDecl (dir, port, typ, _) = makePortDecl (dir, port, typ, _) =
MIPackageItem $ Decl $ MIPackageItem $ Decl $ Variable dir typ port' [] Nil
Variable dir mpt (ident ++ "_" ++ port) mprs Nil where port' = if null modportName
where (mpt, mprs) = (typ, []) then port
else ident ++ '_' : port
mapInterface (Instance part params ident [] instancePorts) = mapInterface (Instance part params ident [] instancePorts) =
-- expand modport port bindings -- expand modport port bindings
case Map.lookup part interfaces of case Map.lookup part interfaces of
@ -179,13 +180,14 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po
++ show binding ++ " in module " ++ show moduleName ++ show binding ++ " in module " ++ show moduleName
expandPortBinding _ (origBinding @ (portName, Dot (Ident instanceName) modportName)) _ = expandPortBinding _ (origBinding @ (portName, Dot (Ident instanceName) modportName)) _ =
-- expand instance modport bound to a modport -- expand instance modport bound to a modport
if Map.member instanceName instances && modportDecls /= Nothing if Map.member instanceName instances
then expandPortBinding' interfaceName portName instanceName then expandPortBinding' interfaceName portName instanceName
(fromJust modportDecls) modportDecls
else ([], [origBinding]) else ([], [origBinding])
where where
interfaceName = instances Map.! instanceName interfaceName = instances Map.! instanceName
modportDecls = lookupModport interfaceName modportName interfaceItems = snd $ lookupInterface interfaceName
modportDecls = lookupModport interfaceItems modportName
expandPortBinding moduleName (origBinding @ (portName, Ident ident)) _ = expandPortBinding moduleName (origBinding @ (portName, Ident ident)) _ =
case (instances Map.!? ident, modports Map.!? ident) of case (instances Map.!? ident, modports Map.!? ident) of
(Nothing, Nothing) -> ([], [origBinding]) (Nothing, Nothing) -> ([], [origBinding])
@ -193,11 +195,9 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po
-- given entire interface, but just bound to a modport -- given entire interface, but just bound to a modport
if Map.notMember moduleName modules then if Map.notMember moduleName modules then
error $ "could not find module " ++ show moduleName error $ "could not find module " ++ show moduleName
else if modportDecls == Nothing then
([], [origBinding])
else else
expandPortBinding' interfaceName portName ident expandPortBinding' interfaceName portName ident
(fromJust modportDecls) modportDecls
where where
Just (_, decls) = Map.lookup moduleName modules Just (_, decls) = Map.lookup moduleName modules
portType = portType =
@ -206,18 +206,22 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po
++ show portName ++ " in module " ++ show portName ++ " in module "
++ show moduleName ++ show moduleName
Just t -> t Just t -> t
modportDecls = interfaceItems = snd $ lookupInterface interfaceName
case portType of modportDecls = lookupModport interfaceItems modportName
InterfaceT _ (Just modportName) [] -> modportName = case portType of
lookupModport interfaceName modportName InterfaceT _ (Just x) [] -> x
Alias Nothing _ [] -> Alias Nothing _ [] -> ""
impliedModport interfaceName _ -> error $ "can't deduce modport for interface "
_ -> Nothing ++ interfaceName ++ " bound to port "
(_, Just (interfaceName, modportDecls)) -> ++ portName ++ " of module " ++ moduleName
(_, Just (interfaceName, modportName)) ->
-- modport directly bound to a modport -- modport directly bound to a modport
expandPortBinding' interfaceName portName ident expandPortBinding' interfaceName portName ident
(map redirect modportDecls) (map redirect modportDecls)
where redirect (d, x, t, _) = (d, x, t, Ident x) where
interfaceItems = snd $ lookupInterface interfaceName
modportDecls = lookupModport interfaceItems modportName
redirect (d, x, t, _) = (d, x, t, Ident x)
expandPortBinding _ other _ = ([], [other]) expandPortBinding _ other _ = ([], [other])
expandPortBinding' :: Identifier -> Identifier -> Identifier -> expandPortBinding' :: Identifier -> Identifier -> Identifier ->
@ -226,7 +230,7 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po
(paramBindings, portBindings) (paramBindings, portBindings)
where where
paramBindings = map toParamBinding interfaceParamNames paramBindings = map toParamBinding interfaceParamNames
interfaceItems = snd $ interfaces Map.! interfaceName interfaceItems = snd $ lookupInterface interfaceName
interfaceParamNames = map fst $ parameters interfaceItems interfaceParamNames = map fst $ parameters interfaceItems
toParamBinding x = (portName ++ '_' : x, Right $ Ident $ instanceName ++ '_' : x) toParamBinding x = (portName ++ '_' : x, Right $ Ident $ instanceName ++ '_' : x)
portBindings = map toPortBinding modportDecls portBindings = map toPortBinding modportDecls
@ -238,13 +242,19 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po
prefixExpr (Ident x) = Ident (instanceName ++ '_' : x) prefixExpr (Ident x) = Ident (instanceName ++ '_' : x)
prefixExpr other = other prefixExpr other = other
lookupModport :: Identifier -> Identifier -> Maybe [ModportDecl] lookupInterface :: Identifier -> Interface
lookupModport interfaceName = lookupInterface interfaceName =
if Map.member interfaceName interfaces case Map.lookup interfaceName interfaces of
then (Map.!?) modportMap Just res -> res
else error $ "could not find interface " ++ show interfaceName Nothing -> error $ "could not find interface " ++ show interfaceName
lookupModport :: [ModuleItem] -> Identifier -> [ModportDecl]
lookupModport interfaceItems "" = impliedModport interfaceItems
lookupModport interfaceItems modportName =
case Map.lookup modportName modportMap of
Just modportDecls -> modportDecls
Nothing -> error $ "could not find modport " ++ show modportName
where where
interfaceItems = snd $ interfaces Map.! interfaceName
modportMap = execWriter $ modportMap = execWriter $
mapM (collectNestedModuleItemsM collectModport) $ mapM (collectNestedModuleItemsM collectModport) $
interfaceItems interfaceItems
@ -252,16 +262,10 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po
collectModport (Modport ident l) = tell $ Map.singleton ident l collectModport (Modport ident l) = tell $ Map.singleton ident l
collectModport _ = return () collectModport _ = return ()
impliedModport :: Identifier -> Maybe [ModportDecl] impliedModport :: [ModuleItem] -> [ModportDecl]
impliedModport interfaceName = impliedModport =
if Map.member interfaceName interfaces execWriter . mapM (collectNestedModuleItemsM collectModportDecls)
then Just modport
else Nothing
where where
interfaceItems = snd $ interfaces Map.! interfaceName
modport = execWriter $
mapM (collectNestedModuleItemsM collectModportDecls) $
interfaceItems
collectModportDecls :: ModuleItem -> Writer [ModportDecl] () collectModportDecls :: ModuleItem -> Writer [ModportDecl] ()
collectModportDecls (MIPackageItem (Decl (Variable d t x _ _))) = collectModportDecls (MIPackageItem (Decl (Variable d t x _ _))) =
tell [(d', x, t, Ident x)] tell [(d', x, t, Ident x)]
@ -284,8 +288,12 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po
convertPort ident = convertPort ident =
case Map.lookup ident modports of case Map.lookup ident modports of
Nothing -> [ident] Nothing -> [ident]
Just (_, decls) -> map (\(_, x, _, _) -> Just (interfaceName, modportName) ->
ident ++ "_" ++ x) decls map (\(_, x, _, _) ->
ident ++ "_" ++ x) modportDecls
where
interfaceItems = snd $ lookupInterface interfaceName
modportDecls = lookupModport interfaceItems modportName
convertDescription _ _ other = other convertDescription _ _ other = other
@ -341,24 +349,6 @@ collectIdentsM item = collectDeclsM collectDecl item
collectDecl (ParamType _ x _) = tell $ Set.singleton x collectDecl (ParamType _ x _) = tell $ Set.singleton x
collectDecl (CommentDecl _) = return () collectDecl (CommentDecl _) = return ()
-- add a prefix to the expressions in a modport definition
prefixModportDecls :: Identifier -> [ModportDecl] -> [ModportDecl]
prefixModportDecls name modportDecls =
map mapper modportDecls
where
mapper :: ModportDecl -> ModportDecl
mapper (d, x, t, e) = (d, x, t', e')
where
exprMapper = traverseNestedExprs prefixExpr
t' = traverseNestedTypes (traverseTypeExprs exprMapper) t
e' = exprMapper e
prefix :: Identifier -> Identifier
prefix = (++) $ name ++ "_"
prefixExpr :: Expr -> Expr
prefixExpr (Ident ('$' : x)) = Ident $ '$' : x
prefixExpr (Ident x) = Ident (prefix x)
prefixExpr other = other
-- convert an interface instantiation into a series of equivalent module items -- convert an interface instantiation into a series of equivalent module items
inlineInterface :: Interface -> (Identifier, [ParamBinding], [PortBinding]) -> [ModuleItem] inlineInterface :: Interface -> (Identifier, [ParamBinding], [PortBinding]) -> [ModuleItem]
inlineInterface (ports, items) (instanceName, instanceParams, instancePorts) = inlineInterface (ports, items) (instanceName, instanceParams, instancePorts) =

3
src/Convert/Logic.hs
View File

@ -52,8 +52,7 @@ convert =
lookupDir portName = lookupDir portName =
case lookup portName dirs of case lookup portName dirs of
Just dir -> dir Just dir -> dir
Nothing -> error $ "Could not find dir for port " ++ Nothing -> Inout
portName ++ " in module " ++ name
collectPortsM _ = return () collectPortsM _ = return ()
collectDeclDirsM :: ModuleItem -> Writer [(Identifier, Direction)] () collectDeclDirsM :: ModuleItem -> Writer [(Identifier, Direction)] ()
collectDeclDirsM (MIPackageItem (Decl (Variable dir t ident _ _))) = collectDeclDirsM (MIPackageItem (Decl (Variable dir t ident _ _))) =