cλash/CLasH/Translator/TranslatorTypes.hs

   1 --
   2 -- Simple module providing some types used by Translator. These are in a
   3 -- separate module to prevent circular dependencies in Pretty for example.
   4 --
   5 {-# LANGUAGE TemplateHaskell #-}
   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 -- ForSyDe
  22 import qualified Language.VHDL.AST as AST
  23
  24 -- Local imports
  25 import CLasH.VHDL.VHDLTypes
  26 import CLasH.Translator.Annotations
  27
  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
  30 --   test input.
  31 type EntitySpec = (Maybe CoreSyn.CoreBndr, Maybe [(CoreSyn.CoreBndr, CoreSyn.CoreBndr)], Maybe CoreSyn.CoreExpr)
  32
  33 -- | A function that knows which parts of a module to compile
  34 type Finder =
  35   HscTypes.CoreModule -- ^ The module to look at
  36   -> GHC.Ghc [EntitySpec]
  37
  38 -----------------------------------------------------------------------------
  39 -- The TranslatorSession
  40 -----------------------------------------------------------------------------
  41
  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
  48
  49 data HType = AggrType String [HType] |
  50              EnumType String [String] |
  51              VecType Int HType |
  52              UVecType HType |
  53              SizedWType Int |
  54              RangedWType Int |
  55              SizedIType Int |
  56              BuiltinType String |
  57              StateType
  58   deriving (Eq, Ord, Show)
  59
  60 -- A map of a Core type to the corresponding type name, or Nothing when the
  61 -- type would be empty.
  62 type TypeMapRec   = Maybe (AST.VHDLId, Maybe (Either AST.TypeDef AST.SubtypeIn))
  63 type TypeMap      = Map.Map HType TypeMapRec
  64
  65 -- A map of a vector Core element type and function name to the coressponding
  66 -- VHDLId of the function and the function body.
  67 type TypeFunMap = Map.Map (HType, String) (AST.VHDLId, AST.SubProgBody)
  68
  69 type TfpIntMap = Map.Map OrdType Int
  70 -- A substate that deals with type generation
  71 data TypeState = TypeState {
  72   -- | A map of Core type -> VHDL Type
  73   tsTypes_      :: TypeMap,
  74   -- | A list of type declarations
  75   tsTypeDecls_  :: [Maybe AST.PackageDecItem],
  76   -- | A map of vector Core type -> VHDL type function
  77   tsTypeFuns_   :: TypeFunMap,
  78   tsTfpInts_    :: TfpIntMap,
  79   tsHscEnv_     :: HscTypes.HscEnv
  80 }
  81
  82 -- Derive accessors
  83 $( Data.Accessor.Template.deriveAccessors ''TypeState )
  84
  85 -- Define a session
  86 type TypeSession = State.State TypeState
  87 -- A global state for the translator
  88 data TranslatorState = TranslatorState {
  89     tsUniqSupply_ :: UniqSupply.UniqSupply
  90   , tsType_ :: TypeState
  91   , tsBindings_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr
  92   , tsNormalized_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr
  93   , tsEntityCounter_ :: Integer
  94   , tsEntities_ :: Map.Map CoreSyn.CoreBndr Entity
  95   , tsArchitectures_ :: Map.Map CoreSyn.CoreBndr (Architecture, [CoreSyn.CoreBndr])
  96   , tsInitStates_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreBndr
  97 }
  98
  99 -- Derive accessors
 100 $( Data.Accessor.Template.deriveAccessors ''TranslatorState )
 101
 102 type TranslatorSession = State.State TranslatorState
 103
 104 -----------------------------------------------------------------------------
 105 -- Some accessors
 106 -----------------------------------------------------------------------------
 107
 108 -- Does the given binder reference a top level binder in the current
 109 -- module(s)?
 110 isTopLevelBinder :: CoreSyn.CoreBndr -> TranslatorSession Bool
 111 isTopLevelBinder bndr = do
 112   bindings <- MonadState.get tsBindings
 113   return $ Map.member bndr bindings
 114
 115 -- Finds the value of a global binding, if available
 116 getGlobalBind :: CoreSyn.CoreBndr -> TranslatorSession (Maybe CoreSyn.CoreExpr)
 117 getGlobalBind bndr = do
 118   bindings <- MonadState.get tsBindings
 119   return $ Map.lookup bndr bindings
 120
 121 -- Adds a new global binding with the given value
 122 addGlobalBind :: CoreSyn.CoreBndr -> CoreSyn.CoreExpr -> TranslatorSession ()
 123 addGlobalBind bndr expr = MonadState.modify tsBindings (Map.insert bndr expr)
 124
 125 -- Returns a list of all global binders
 126 getGlobalBinders :: TranslatorSession [CoreSyn.CoreBndr]
 127 getGlobalBinders = do
 128   bindings <- MonadState.get tsBindings
 129   return $ Map.keys bindings
 130
 131 -- vim: set ts=8 sw=2 sts=2 expandtab: