diff --git a/src/Convert/Interface.hs b/src/Convert/Interface.hs index cc15434..2d8ac66 100644 --- a/src/Convert/Interface.hs +++ b/src/Convert/Interface.hs @@ -6,7 +6,7 @@ module Convert.Interface (convert) where -import Data.Maybe (fromJust, mapMaybe) +import Data.Maybe (mapMaybe) import Control.Monad.Writer import qualified Data.Map.Strict as Map import qualified Data.Set as Set @@ -14,11 +14,12 @@ import qualified Data.Set as Set import Convert.Traverse import Language.SystemVerilog.AST -type Instances = Map.Map Identifier Identifier type Interface = ([Identifier], [ModuleItem]) type Interfaces = Map.Map Identifier Interface -type Modports = Map.Map Identifier (Identifier, [ModportDecl]) -type Modules = Map.Map Identifier ([Identifier], [(Identifier, Type)]) +type Module = ([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 = @@ -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 (instances, modports) = execWriter $ mapM - (collectNestedModuleItemsM collectInterface) items - collectInterface :: ModuleItem -> Writer (Instances, Modports) () - collectInterface (MIPackageItem (Decl (Variable _ t ident _ _))) = + (collectNestedModuleItemsM collectInstanceM) items + collectInstanceM :: ModuleItem -> Writer (Instances, Modports) () + collectInstanceM (MIPackageItem (Decl (Variable _ t ident _ _))) = case t of InterfaceT interfaceName (Just modportName) [] -> if Map.member interfaceName interfaces - then tell (Map.empty, Map.singleton ident (interfaceName, modportDecls)) + then writeModport interfaceName modportName else return () - where Just modportDecls = lookupModport interfaceName modportName Alias Nothing interfaceName [] -> - case impliedModport interfaceName of - Just modportDecls -> - tell (Map.empty, Map.singleton ident modport) - where modport = (interfaceName, modportDecls) - Nothing -> return () + if Map.member interfaceName interfaces + then writeModport interfaceName "" + else 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 then tell (Map.singleton ident part, Map.empty) else return () - collectInterface _ = return () + collectInstanceM _ = return () mapInterface :: ModuleItem -> ModuleItem - mapInterface (orig @ (MIPackageItem (Decl (Variable _ t ident _ _)))) = + mapInterface (orig @ (MIPackageItem (Decl (Variable _ _ ident _ _)))) = -- expand instantiation of a modport - case Map.lookup ident modports of - Just (_, modportDecls) -> Generate $ map GenModuleItem $ + if Map.member ident modports + then Generate $ map GenModuleItem $ filter shouldKeep interfaceItems ++ map makePortDecl - (prefixModportDecls ident modportDecls) - Nothing -> orig + modportDecls + else orig where - interfaceName = case t of - InterfaceT x (Just _) [] -> x - Alias Nothing x [] -> x - _ -> error $ "unexpected modport type " ++ show t + Just (interfaceName, modportName) = Map.lookup ident modports interfaceItems = prefixInterface ident $ - case Map.lookup interfaceName interfaces of - Just res -> snd res - Nothing -> error $ "could not find interface " ++ show interfaceName + snd $ lookupInterface interfaceName + modportDecls = lookupModport interfaceItems modportName shouldKeep (MIPackageItem (Decl Param{})) = True shouldKeep (MIPackageItem Task{}) = True shouldKeep (MIPackageItem Function{}) = True shouldKeep _ = False makePortDecl :: ModportDecl -> ModuleItem makePortDecl (dir, port, typ, _) = - MIPackageItem $ Decl $ - Variable dir mpt (ident ++ "_" ++ port) mprs Nil - where (mpt, mprs) = (typ, []) + MIPackageItem $ Decl $ Variable dir typ port' [] Nil + where port' = if null modportName + then port + else ident ++ '_' : port mapInterface (Instance part params ident [] instancePorts) = -- expand modport port bindings 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 expandPortBinding _ (origBinding @ (portName, Dot (Ident instanceName) modportName)) _ = -- expand instance modport bound to a modport - if Map.member instanceName instances && modportDecls /= Nothing + if Map.member instanceName instances then expandPortBinding' interfaceName portName instanceName - (fromJust modportDecls) + modportDecls else ([], [origBinding]) where interfaceName = instances Map.! instanceName - modportDecls = lookupModport interfaceName modportName + interfaceItems = snd $ lookupInterface interfaceName + modportDecls = lookupModport interfaceItems modportName expandPortBinding moduleName (origBinding @ (portName, Ident ident)) _ = case (instances Map.!? ident, modports Map.!? ident) of (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 if Map.notMember moduleName modules then error $ "could not find module " ++ show moduleName - else if modportDecls == Nothing then - ([], [origBinding]) else expandPortBinding' interfaceName portName ident - (fromJust modportDecls) + modportDecls where Just (_, decls) = Map.lookup moduleName modules portType = @@ -206,18 +206,22 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po ++ show portName ++ " in module " ++ show moduleName Just t -> t - modportDecls = - case portType of - InterfaceT _ (Just modportName) [] -> - lookupModport interfaceName modportName - Alias Nothing _ [] -> - impliedModport interfaceName - _ -> Nothing - (_, Just (interfaceName, modportDecls)) -> + interfaceItems = snd $ lookupInterface interfaceName + modportDecls = lookupModport interfaceItems modportName + modportName = case portType of + InterfaceT _ (Just x) [] -> x + Alias Nothing _ [] -> "" + _ -> error $ "can't deduce modport for interface " + ++ interfaceName ++ " bound to port " + ++ portName ++ " of module " ++ moduleName + (_, Just (interfaceName, modportName)) -> -- modport directly bound to a modport expandPortBinding' interfaceName portName ident (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' :: Identifier -> Identifier -> Identifier -> @@ -226,7 +230,7 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po (paramBindings, portBindings) where paramBindings = map toParamBinding interfaceParamNames - interfaceItems = snd $ interfaces Map.! interfaceName + interfaceItems = snd $ lookupInterface interfaceName interfaceParamNames = map fst $ parameters interfaceItems toParamBinding x = (portName ++ '_' : x, Right $ Ident $ instanceName ++ '_' : x) 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 other = other - lookupModport :: Identifier -> Identifier -> Maybe [ModportDecl] - lookupModport interfaceName = - if Map.member interfaceName interfaces - then (Map.!?) modportMap - else error $ "could not find interface " ++ show interfaceName + lookupInterface :: Identifier -> Interface + lookupInterface interfaceName = + case Map.lookup interfaceName interfaces of + Just res -> res + 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 - interfaceItems = snd $ interfaces Map.! interfaceName modportMap = execWriter $ mapM (collectNestedModuleItemsM collectModport) $ 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 _ = return () - impliedModport :: Identifier -> Maybe [ModportDecl] - impliedModport interfaceName = - if Map.member interfaceName interfaces - then Just modport - else Nothing + impliedModport :: [ModuleItem] -> [ModportDecl] + impliedModport = + execWriter . mapM (collectNestedModuleItemsM collectModportDecls) where - interfaceItems = snd $ interfaces Map.! interfaceName - modport = execWriter $ - mapM (collectNestedModuleItemsM collectModportDecls) $ - interfaceItems collectModportDecls :: ModuleItem -> Writer [ModportDecl] () collectModportDecls (MIPackageItem (Decl (Variable d t x _ _))) = tell [(d', x, t, Ident x)] @@ -284,8 +288,12 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po convertPort ident = case Map.lookup ident modports of Nothing -> [ident] - Just (_, decls) -> map (\(_, x, _, _) -> - ident ++ "_" ++ x) decls + Just (interfaceName, modportName) -> + map (\(_, x, _, _) -> + ident ++ "_" ++ x) modportDecls + where + interfaceItems = snd $ lookupInterface interfaceName + modportDecls = lookupModport interfaceItems modportName convertDescription _ _ other = other @@ -341,24 +349,6 @@ collectIdentsM item = collectDeclsM collectDecl item collectDecl (ParamType _ x _) = tell $ Set.singleton x 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 inlineInterface :: Interface -> (Identifier, [ParamBinding], [PortBinding]) -> [ModuleItem] inlineInterface (ports, items) (instanceName, instanceParams, instancePorts) = diff --git a/src/Convert/Logic.hs b/src/Convert/Logic.hs index 13b4dfe..26a2743 100644 --- a/src/Convert/Logic.hs +++ b/src/Convert/Logic.hs @@ -52,8 +52,7 @@ convert = lookupDir portName = case lookup portName dirs of Just dir -> dir - Nothing -> error $ "Could not find dir for port " ++ - portName ++ " in module " ++ name + Nothing -> Inout collectPortsM _ = return () collectDeclDirsM :: ModuleItem -> Writer [(Identifier, Direction)] () collectDeclDirsM (MIPackageItem (Decl (Variable dir t ident _ _))) =