1 {-# LANGUAGE TemplateHaskell #-}
3 -- Simple module providing some types used by Translator. These are in a
4 -- separate module to prevent circular dependencies in Pretty for example.
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
12 import qualified Data.Accessor.Monad.Trans.State as MonadState
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.CoreBndr, CoreSyn.CoreBndr)], 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 = AggrType String (Maybe (String, HType)) [[(String, HType)]] |
49 -- ^ A type containing multiple fields. Arguments: Type
50 -- name, an optional EnumType for the constructors (if > 1)
51 -- and a list containing a list of fields (name, htype) for
53 EnumType String [String] |
54 -- ^ A type containing no fields and multiple constructors.
55 -- Arguments: Type name, a list of possible values.
63 deriving (Eq, Ord, Show)
65 -- A map of a Core type to the corresponding type name, or Nothing when the
66 -- type would be empty.
67 type TypeMapRec = Maybe (AST.VHDLId, Maybe (Either AST.TypeDef AST.SubtypeIn))
68 type TypeMap = Map.Map HType TypeMapRec
70 -- A map of a vector Core element type and function name to the coressponding
71 -- VHDLId of the function and the function body.
72 type TypeFunMap = Map.Map (HType, String) (AST.VHDLId, AST.SubProgBody)
74 type TfpIntMap = Map.Map OrdType Int
75 -- A substate that deals with type generation
76 data TypeState = TypeState {
77 -- | A map of Core type -> VHDL Type
79 -- | A list of type declarations
80 tsTypeDecls_ :: [Maybe AST.PackageDecItem],
81 -- | A map of vector Core type -> VHDL type function
82 tsTypeFuns_ :: TypeFunMap,
83 tsTfpInts_ :: TfpIntMap,
84 tsHscEnv_ :: HscTypes.HscEnv
88 Data.Accessor.Template.deriveAccessors ''TypeState
91 type TypeSession = State.State TypeState
92 -- A global state for the translator
93 data TranslatorState = TranslatorState {
94 tsUniqSupply_ :: UniqSupply.UniqSupply
95 , tsType_ :: TypeState
96 , tsBindings_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr
97 , tsNormalized_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr
98 , tsEntityCounter_ :: Integer
99 , tsEntities_ :: Map.Map CoreSyn.CoreBndr Entity
100 , tsArchitectures_ :: Map.Map CoreSyn.CoreBndr (Architecture, [CoreSyn.CoreBndr])
101 , tsInitStates_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreBndr
102 , tsTransformCounter_ :: Int -- ^ How many transformations were applied?
106 Data.Accessor.Template.deriveAccessors ''TranslatorState
108 type TranslatorSession = State.State TranslatorState
110 -----------------------------------------------------------------------------
112 -----------------------------------------------------------------------------
114 -- Does the given binder reference a top level binder in the current
116 isTopLevelBinder :: CoreSyn.CoreBndr -> TranslatorSession Bool
117 isTopLevelBinder bndr = do
118 bindings <- MonadState.get tsBindings
119 return $ Map.member bndr bindings
121 -- Finds the value of a global binding, if available
122 getGlobalBind :: CoreSyn.CoreBndr -> TranslatorSession (Maybe CoreSyn.CoreExpr)
123 getGlobalBind bndr = do
124 bindings <- MonadState.get tsBindings
125 return $ Map.lookup bndr bindings
127 -- Adds a new global binding with the given value
128 addGlobalBind :: CoreSyn.CoreBndr -> CoreSyn.CoreExpr -> TranslatorSession ()
129 addGlobalBind bndr expr = MonadState.modify tsBindings (Map.insert bndr expr)
131 -- Returns a list of all global binders
132 getGlobalBinders :: TranslatorSession [CoreSyn.CoreBndr]
133 getGlobalBinders = do
134 bindings <- MonadState.get tsBindings
135 return $ Map.keys bindings
137 -- vim: set ts=8 sw=2 sts=2 expandtab: