Interface.hs 12.5 KB
Newer Older
1 2 3 4 5 6 7 8
{- sv2v
 - Author: Zachary Snow <zach@zachjs.com>
 -
 - Conversion for interfaces
 -}

module Convert.Interface (convert) where

9
import Data.Maybe (fromJust, mapMaybe)
10 11
import Control.Monad.Writer
import qualified Data.Map.Strict as Map
12
import qualified Data.Set as Set
13 14 15 16 17 18 19 20

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 [ModportDecl]
21
type Modules = Map.Map (Identifier, Identifier) Type
22

23
convert :: [AST] -> [AST]
24 25
convert =
    traverseFiles (collectDescriptionsM collectDesc) converter
26
    where
27 28 29
        converter (interfaces, modules) =
            filter (not . isInterface) .
            map (convertDescription interfaces modules)
30
        -- we can only collect/map non-extern interfaces
31
        collectDesc :: Description -> Writer (Interfaces, Modules) ()
32
        collectDesc (orig @ (Part _ False kw _ name ports items)) = do
33 34 35
            if kw == Interface
                then tell (Map.singleton name (ports, items), Map.empty)
                else collectModuleItemsM (collectDeclsM $ collectDecl name) orig
36
        collectDesc _ = return ()
37 38 39 40
        collectDecl :: Identifier -> Decl -> Writer (Interfaces, Modules) ()
        collectDecl name (Variable _ t ident _ _) = do
            tell (Map.empty, Map.singleton (name, ident) t)
        collectDecl _ _ = return ()
41
        isInterface :: Description -> Bool
42
        isInterface (Part _ False Interface _ _ _ _) = True
43 44
        isInterface _ = False

45
convertDescription :: Interfaces -> Modules -> Description -> Description
46 47
convertDescription interfaces modules (Part attrs extern Module lifetime name ports items) =
    Part attrs extern Module lifetime name ports' items'
48
    where
49
        items' =
50 51
            map (traverseNestedModuleItems $ traverseExprs' ExcludeTFs (traverseNestedExprs $ convertExpr instances modports)) $
            map (traverseNestedModuleItems $ traverseLHSs'  ExcludeTFs (traverseNestedLHSs  $ convertLHS  instances modports)) $
52 53 54
            map (traverseNestedModuleItems mapInterface) $
            items
        ports' = concatMap convertPort ports
55 56

        -- collect the interface type of all interface instances in this module
57 58 59
        (instances, modports) = execWriter $ mapM
            (collectNestedModuleItemsM collectInterface) items
        collectInterface :: ModuleItem -> Writer (Instances, Modports)  ()
60
        collectInterface (MIPackageItem (Decl (Variable _ t ident _ _))) =
61 62 63
            case t of
                InterfaceT interfaceName (Just modportName) [] ->
                    tell (Map.empty, Map.singleton ident modportDecls)
64
                    where Just modportDecls = lookupModport Nothing interfaceName modportName
65
                _ -> return ()
66
        collectInterface (Instance part _ ident Nothing _) =
67
            if Map.member part interfaces
68
                then tell (Map.singleton ident part, Map.empty)
69
                else return ()
70
        collectInterface _ = return ()
71

72
        mapInterface :: ModuleItem -> ModuleItem
73
        mapInterface (orig @ (MIPackageItem (Decl (Variable Local t ident _ _)))) =
74 75
            case Map.lookup ident modports of
                Just modportDecls -> Generate $
76 77
                    map (GenModuleItem . MIPackageItem . Decl . mapper)
                    modportDecls
78 79 80 81
                Nothing -> orig
            where
                InterfaceT interfaceName (Just _) [] = t
                interfaceItems = snd $ interfaces Map.! interfaceName
82 83 84
                mapper (dir, port, expr) =
                    Variable dir mpt (ident ++ "_" ++ port) mprs Nothing
                    where (mpt, mprs) = lookupType interfaceItems (fromJust expr)
85
        mapInterface (Instance part params ident Nothing instancePorts) =
86 87
            case Map.lookup part interfaces of
                Just interface ->
88 89 90 91 92 93 94
                    -- TODO: Add support for interfaces with parameter bindings.
                    if not $ null params
                    then error $ "interface instantiations with parameter "
                            ++ "bindings are not yet supported: "
                            ++ show (part, params, ident)
                    else Generate $ map GenModuleItem $
                            inlineInterface interface (ident, expandedPorts)
95
                Nothing -> Instance part params ident Nothing expandedPorts
96
            where expandedPorts = concatMap (expandPortBinding part) instancePorts
97 98 99 100
        mapInterface (orig @ (MIPackageItem (Function _ _ _ decls _))) =
            convertTF decls orig
        mapInterface (orig @ (MIPackageItem (Task _ _ decls _))) =
            convertTF decls orig
101
        mapInterface other = other
102

103 104 105 106 107 108 109 110 111 112 113 114 115
        convertTF :: [Decl] -> ModuleItem -> ModuleItem
        convertTF decls orig =
            traverseExprs (traverseNestedExprs $ convertExpr its mps) $
            traverseLHSs  (traverseNestedLHSs  $ convertLHS  its mps) $
            orig
            where
                locals = Set.fromList $ mapMaybe declVarIdent decls
                its = Map.withoutKeys instances locals
                mps = Map.withoutKeys modports  locals
        declVarIdent :: Decl -> Maybe Identifier
        declVarIdent (Variable _ _ x _ _) = Just x
        declVarIdent _ = Nothing

116 117
        expandPortBinding :: Identifier -> PortBinding -> [PortBinding]
        expandPortBinding _ (origBinding @ (portName, Just (Dot (Ident instanceName) modportName))) =
118
            case Map.lookup instanceName instances of
119 120 121 122
                Nothing ->
                    case Map.lookup instanceName modports of
                        Nothing -> [origBinding]
                        Just _ -> [(portName, Just $ Ident $ instanceName ++ "_" ++ modportName)]
123
                Just interfaceName ->
124 125 126
                    case modportDecls of
                        Nothing -> [(portName, Just $ Ident $ instanceName ++ "_" ++ modportName)]
                        Just decls -> map mapper decls
127
                    where
128
                        modportDecls = lookupModport (Just instanceName) interfaceName modportName
129
                        mapper (_, x, me) = (portName ++ "_" ++ x, me)
130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145
        expandPortBinding moduleName (origBinding @ (portName, Just (Ident instanceName))) =
            case (instances Map.!? instanceName, modports Map.!? instanceName) of
                (Nothing, Nothing) -> [origBinding]
                (Just _, _) ->
                    map mapper modportDecls
                    where
                        InterfaceT interfaceName (Just modportName) [] =
                            modules Map.! (moduleName, portName)
                        Just modportDecls = lookupModport (Just instanceName) interfaceName modportName
                        mapper (_, x, me) = (portName ++ "_" ++ x, me)
                (_, Just decls) ->
                    map mapper decls
                    where mapper (_, x, _) =
                            ( portName ++ "_" ++ x
                            , Just $ Ident $ instanceName ++ "_" ++ x )
        expandPortBinding _ other = [other]
146

147 148
        lookupModport :: Maybe Identifier -> Identifier -> Identifier -> Maybe [ModportDecl]
        lookupModport instanceName interfaceName = (Map.!?) modportMap
149
            where
150
                prefix = maybe "" (++ "_") instanceName
151
                interfaceItems =
152
                    map (prefixModuleItems prefix) $
153 154 155 156 157
                    snd $ interfaces Map.! interfaceName
                modportMap = execWriter $
                    mapM (collectNestedModuleItemsM collectModport) $
                    interfaceItems
                collectModport :: ModuleItem -> Writer Modports ()
158
                collectModport (Modport ident l) = tell $ Map.singleton ident l
159 160
                collectModport _ = return ()

161 162 163
        convertExpr :: Instances -> Modports -> Expr -> Expr
        convertExpr its mps (orig @ (Dot (Ident x) y)) =
            if Map.member x mps || Map.member x its
164 165
                then Ident (x ++ "_" ++ y)
                else orig
166 167 168 169
        convertExpr _ _ other = other
        convertLHS :: Instances -> Modports -> LHS -> LHS
        convertLHS its mps (orig @ (LHSDot (LHSIdent x) y)) =
            if Map.member x mps || Map.member x its
170 171
                then LHSIdent (x ++ "_" ++ y)
                else orig
172 173
        convertLHS its mps (LHSBit   l e) =
            LHSBit l (traverseNestedExprs (convertExpr its mps) e)
174 175
        convertLHS its mps (LHSRange l m (e1, e2)) =
            LHSRange l m (traverseNestedExprs (convertExpr its mps) e1, traverseNestedExprs (convertExpr its mps) e2)
176
        convertLHS _ _ other = other
177 178 179 180 181 182
        convertPort :: Identifier -> [Identifier]
        convertPort ident =
            case Map.lookup ident modports of
                Nothing -> [ident]
                Just decls -> map (\(_, x, _) -> ident ++ "_" ++ x) decls

183
convertDescription _ _ other = other
184 185 186 187 188 189


-- add a prefix to all standard identifiers in a module item
prefixModuleItems :: Identifier -> ModuleItem -> ModuleItem
prefixModuleItems prefix =
    traverseDecls prefixDecl .
190 191
    traverseExprs (traverseNestedExprs prefixExpr) .
    traverseLHSs  (traverseNestedLHSs  prefixLHS )
192 193 194
    where
        prefixDecl :: Decl -> Decl
        prefixDecl (Variable d t x a me) = Variable d t (prefix ++ x) a me
195 196
        prefixDecl (Param    s t x    e) = Param    s t (prefix ++ x)    e
        prefixDecl (ParamType  s x   mt) = ParamType  s (prefix ++ x)   mt
197 198 199 200 201 202 203
        prefixExpr :: Expr -> Expr
        prefixExpr (Ident x) = Ident (prefix ++ x)
        prefixExpr other = other
        prefixLHS :: LHS -> LHS
        prefixLHS (LHSIdent x) = LHSIdent (prefix ++ x)
        prefixLHS other = other

204
lookupType :: [ModuleItem] -> Expr -> (Type, [Range])
205
lookupType items (Ident ident) =
206 207 208
    case mapMaybe findType items of
        [] -> error $ "unable to locate type of " ++ ident
        ts -> head ts
209
    where
210
        findType :: ModuleItem -> Maybe (Type, [Range])
211
        findType (MIPackageItem (Decl (Variable _ t x rs Nothing))) =
212
            if x == ident then Just (t, rs) else Nothing
213
        findType _ = Nothing
214 215 216 217
lookupType _ expr =
    -- TODO: Add support for non-Ident modport expressions.
    error $ "interface conversion does not support modport expressions that "
        ++ " are not identifiers: " ++ show expr
218

219 220 221
-- convert an interface instantiation into a series of equivalent module items
inlineInterface :: Interface -> (Identifier, [PortBinding]) -> [ModuleItem]
inlineInterface (ports, items) (instanceName, instancePorts) =
222
    (:) (MIPackageItem $ Comment $ "expanded instance: " ++ instanceName) $
223
    flip (++) portBindings $
224
    map (traverseNestedModuleItems removeModport) $
225
    map (traverseNestedModuleItems removeDeclDir) $
226
    itemsPrefixed
227 228
    where
        prefix = instanceName ++ "_"
229
        itemsPrefixed = map (prefixModuleItems prefix) $ items
230 231 232 233 234 235 236 237
        origInstancePortNames = map fst instancePorts
        instancePortExprs = map snd instancePorts
        instancePortNames =
            map (prefix ++) $
            if all ("" ==) origInstancePortNames
                then ports
                else origInstancePortNames
        portBindings =
238
            mapMaybe portBindingItem $
239 240
            zip instancePortNames instancePortExprs

241 242 243 244
        removeDeclDir :: ModuleItem -> ModuleItem
        removeDeclDir (MIPackageItem (Decl (Variable _ t x a me))) =
            MIPackageItem $ Decl $ Variable Local t x a me
        removeDeclDir other = other
245
        removeModport :: ModuleItem -> ModuleItem
246 247
        removeModport (Modport x _) =
            MIPackageItem $ Comment $ "removed modport " ++ x
248
        removeModport other = other
249 250 251 252 253

        portBindingItem :: PortBinding -> Maybe ModuleItem
        portBindingItem (ident, Just expr) =
            Just $ if declDirs Map.! ident == Input
                then Assign Nothing (LHSIdent ident) expr
254
                else Assign Nothing (toLHS expr) (Ident ident)
255 256 257 258 259 260 261 262 263 264 265
        portBindingItem (_, Nothing) = Nothing

        declDirs = execWriter $
            mapM (collectDeclsM collectDeclDir) itemsPrefixed
        collectDeclDir :: Decl -> Writer (Map.Map Identifier Direction) ()
        collectDeclDir (Variable dir _ ident _ _) =
            if dir /= Local
                then tell $ Map.singleton ident dir
                else return ()
        collectDeclDir _ = return ()

266 267 268 269 270 271
        toLHS :: Expr -> LHS
        toLHS expr =
            case exprToLHS expr of
                Just lhs -> lhs
                Nothing  -> error $ "trying to bind an interface output to " ++
                                show expr ++ " but that can't be an LHS"