clash/CLasH/Translator/TranslatorTypes.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2 --
   3 -- Simple module providing some types used by Translator. These are in a
   4 -- separate module to prevent circular dependencies in Pretty for example.
   5 --
   6 module CLasH.Translator.TranslatorTypes where
   7
   8 -- Standard modules
   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
  13
  14 -- GHC API
  15 import qualified GHC
  16 import qualified CoreSyn
  17 import qualified Type
  18 import qualified HscTypes
  19 import qualified UniqSupply
  20
  21 -- VHDL Imports
  22 import qualified Language.VHDL.AST as AST
  23
  24 -- Local imports
  25 import CLasH.VHDL.VHDLTypes
  26
  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
  29 --   test input.
  30 type EntitySpec = (Maybe CoreSyn.CoreBndr, Maybe [(CoreSyn.CoreBndr, CoreSyn.CoreBndr)], Maybe CoreSyn.CoreExpr)
  31
  32 -- | A function that knows which parts of a module to compile
  33 type Finder =
  34   HscTypes.CoreModule -- ^ The module to look at
  35   -> GHC.Ghc [EntitySpec]
  36
  37 -----------------------------------------------------------------------------
  38 -- The TranslatorSession
  39 -----------------------------------------------------------------------------
  40
  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
  47
  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
  52              -- each constructor.
  53              EnumType String [String] |
  54              -- ^ A type containing no fields and multiple constructors.
  55              -- Arguments: Type name, a list of possible values.
  56              VecType Int HType |
  57              UVecType HType |
  58              SizedWType Int |
  59              RangedWType Int |
  60              SizedIType Int |
  61              BuiltinType String |
  62              StateType
  63   deriving (Eq, Ord, Show)
  64
  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
  69
  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)
  73
  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
  78   tsTypes_      :: TypeMap,
  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
  85 }
  86
  87 -- Derive accessors
  88 Data.Accessor.Template.deriveAccessors ''TypeState
  89
  90 -- Define a session
  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?
 103 }
 104
 105 -- Derive accessors
 106 Data.Accessor.Template.deriveAccessors ''TranslatorState
 107
 108 type TranslatorSession = State.State TranslatorState
 109
 110 -----------------------------------------------------------------------------
 111 -- Some accessors
 112 -----------------------------------------------------------------------------
 113
 114 -- Does the given binder reference a top level binder in the current
 115 -- module(s)?
 116 isTopLevelBinder :: CoreSyn.CoreBndr -> TranslatorSession Bool
 117 isTopLevelBinder bndr = do
 118   bindings <- MonadState.get tsBindings
 119   return $ Map.member bndr bindings
 120
 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
 126
 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)
 130
 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
 136
 137 -- vim: set ts=8 sw=2 sts=2 expandtab: