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
26 import CLasH.Translator.Annotations
28 -- | A specification of an entity we can generate VHDL for. Consists of the
29 -- binder of the top level entity, an optional initial state and an optional
31 type EntitySpec = (Maybe CoreSyn.CoreBndr, Maybe [(CoreSyn.CoreBndr, CoreSyn.CoreBndr)], Maybe CoreSyn.CoreExpr)
33 -- | A function that knows which parts of a module to compile
35 HscTypes.CoreModule -- ^ The module to look at
36 -> GHC.Ghc [EntitySpec]
38 -----------------------------------------------------------------------------
39 -- The TranslatorSession
40 -----------------------------------------------------------------------------
42 -- A orderable equivalent of CoreSyn's Type for use as a map key
43 newtype OrdType = OrdType Type.Type
44 instance Eq OrdType where
45 (OrdType a) == (OrdType b) = Type.tcEqType a b
46 instance Ord OrdType where
47 compare (OrdType a) (OrdType b) = Type.tcCmpType a b
49 data HType = StdType OrdType |
50 ADTType String [HType] |
51 EnumType String [String] |
59 -- A map of a Core type to the corresponding type name, or Nothing when the
60 -- type would be empty.
61 type TypeMap = Map.Map HType (Maybe (AST.VHDLId, Either AST.TypeDef AST.SubtypeIn))
63 -- A map of a vector Core element type and function name to the coressponding
64 -- VHDLId of the function and the function body.
65 type TypeFunMap = Map.Map (HType, String) (AST.VHDLId, AST.SubProgBody)
67 type TfpIntMap = Map.Map OrdType Int
68 -- A substate that deals with type generation
69 data TypeState = TypeState {
70 -- | A map of Core type -> VHDL Type
72 -- | A list of type declarations
73 tsTypeDecls_ :: [AST.PackageDecItem],
74 -- | A map of vector Core type -> VHDL type function
75 tsTypeFuns_ :: TypeFunMap,
76 tsTfpInts_ :: TfpIntMap,
77 tsHscEnv_ :: HscTypes.HscEnv
81 $( Data.Accessor.Template.deriveAccessors ''TypeState )
84 type TypeSession = State.State TypeState
85 -- A global state for the translator
86 data TranslatorState = TranslatorState {
87 tsUniqSupply_ :: UniqSupply.UniqSupply
88 , tsType_ :: TypeState
89 , tsBindings_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr
90 , tsNormalized_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr
91 , tsEntityCounter_ :: Integer
92 , tsEntities_ :: Map.Map CoreSyn.CoreBndr Entity
93 , tsArchitectures_ :: Map.Map CoreSyn.CoreBndr (Architecture, [CoreSyn.CoreBndr])
94 , tsInitStates_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreBndr
98 $( Data.Accessor.Template.deriveAccessors ''TranslatorState )
100 type TranslatorSession = State.State TranslatorState
102 -----------------------------------------------------------------------------
104 -----------------------------------------------------------------------------
106 -- Does the given binder reference a top level binder in the current
108 isTopLevelBinder :: CoreSyn.CoreBndr -> TranslatorSession Bool
109 isTopLevelBinder bndr = do
110 bindings <- getA tsBindings
111 return $ Map.member bndr bindings
113 -- Finds the value of a global binding, if available
114 getGlobalBind :: CoreSyn.CoreBndr -> TranslatorSession (Maybe CoreSyn.CoreExpr)
115 getGlobalBind bndr = do
116 bindings <- getA tsBindings
117 return $ Map.lookup bndr bindings
119 -- Adds a new global binding with the given value
120 addGlobalBind :: CoreSyn.CoreBndr -> CoreSyn.CoreExpr -> TranslatorSession ()
121 addGlobalBind bndr expr = modA tsBindings (Map.insert bndr expr)
123 -- Returns a list of all global binders
124 getGlobalBinders :: TranslatorSession [CoreSyn.CoreBndr]
125 getGlobalBinders = do
126 bindings <- getA tsBindings
127 return $ Map.keys bindings
129 -- vim: set ts=8 sw=2 sts=2 expandtab: