2 -- Simple module providing some types used by Translator. These are in a
3 -- separate module to prevent circular dependencies in Pretty for example.
5 {-# LANGUAGE TemplateHaskell #-}
6 module CLasH.Translator.TranslatorTypes where
9 import qualified Control.Monad.Trans.State as State
10 import qualified Data.Map as Map
11 import qualified Data.Accessor.Template
16 import qualified CoreSyn
18 import qualified HscTypes
19 import qualified UniqSupply
22 import qualified Language.VHDL.AST as AST
25 import CLasH.VHDL.VHDLTypes
27 -- | A specification of an entity we can generate VHDL for. Consists of the
28 -- binder of the top level entity, an optional initial state and an optional
30 type EntitySpec = (Maybe CoreSyn.CoreBndr, Maybe CoreSyn.CoreExpr, Maybe CoreSyn.CoreExpr)
32 -- | A function that knows which parts of a module to compile
34 HscTypes.CoreModule -- ^ The module to look at
35 -> GHC.Ghc [EntitySpec]
37 -----------------------------------------------------------------------------
38 -- The TranslatorSession
39 -----------------------------------------------------------------------------
41 -- A orderable equivalent of CoreSyn's Type for use as a map key
42 newtype OrdType = OrdType Type.Type
43 instance Eq OrdType where
44 (OrdType a) == (OrdType b) = Type.tcEqType a b
45 instance Ord OrdType where
46 compare (OrdType a) (OrdType b) = Type.tcCmpType a b
48 data HType = StdType OrdType |
49 ADTType String [HType] |
50 EnumType String [String] |
58 -- A map of a Core type to the corresponding type name, or Nothing when the
59 -- type would be empty.
60 type TypeMap = Map.Map HType (Maybe (AST.VHDLId, Either AST.TypeDef AST.SubtypeIn))
62 -- A map of a vector Core element type and function name to the coressponding
63 -- VHDLId of the function and the function body.
64 type TypeFunMap = Map.Map (HType, String) (AST.VHDLId, AST.SubProgBody)
66 type TfpIntMap = Map.Map OrdType Int
67 -- A substate that deals with type generation
68 data TypeState = TypeState {
69 -- | A map of Core type -> VHDL Type
71 -- | A list of type declarations
72 tsTypeDecls_ :: [AST.PackageDecItem],
73 -- | A map of vector Core type -> VHDL type function
74 tsTypeFuns_ :: TypeFunMap,
75 tsTfpInts_ :: TfpIntMap,
76 tsHscEnv_ :: HscTypes.HscEnv
80 $( Data.Accessor.Template.deriveAccessors ''TypeState )
83 type TypeSession = State.State TypeState
84 -- A global state for the translator
85 data TranslatorState = TranslatorState {
86 tsUniqSupply_ :: UniqSupply.UniqSupply
87 , tsType_ :: TypeState
88 , tsBindings_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr
89 , tsNormalized_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr
90 , tsEntityCounter_ :: Integer
91 , tsEntities_ :: Map.Map CoreSyn.CoreBndr Entity
92 , tsArchitectures_ :: Map.Map CoreSyn.CoreBndr (Architecture, [CoreSyn.CoreBndr])
96 $( Data.Accessor.Template.deriveAccessors ''TranslatorState )
98 type TranslatorSession = State.State TranslatorState
100 -----------------------------------------------------------------------------
102 -----------------------------------------------------------------------------
104 -- Does the given binder reference a top level binder in the current
106 isTopLevelBinder :: CoreSyn.CoreBndr -> TranslatorSession Bool
107 isTopLevelBinder bndr = do
108 bindings <- getA tsBindings
109 return $ Map.member bndr bindings
111 -- Finds the value of a global binding, if available
112 getGlobalBind :: CoreSyn.CoreBndr -> TranslatorSession (Maybe CoreSyn.CoreExpr)
113 getGlobalBind bndr = do
114 bindings <- getA tsBindings
115 return $ Map.lookup bndr bindings
117 -- Adds a new global binding with the given value
118 addGlobalBind :: CoreSyn.CoreBndr -> CoreSyn.CoreExpr -> TranslatorSession ()
119 addGlobalBind bndr expr = modA tsBindings (Map.insert bndr expr)
121 -- Returns a list of all global binders
122 getGlobalBinders :: TranslatorSession [CoreSyn.CoreBndr]
123 getGlobalBinders = do
124 bindings <- getA tsBindings
125 return $ Map.keys bindings
127 -- vim: set ts=8 sw=2 sts=2 expandtab: