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 Data.Accessor
  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
  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.CoreExpr, 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 = StdType OrdType |
  49              ADTType String [HType] |
  50              VecType Int HType |
  51              SizedWType Int |
  52              RangedWType Int |
  53              SizedIType Int |
  54              BuiltinType String
  55   deriving (Eq, Ord)
  56
  57 -- A map of a Core type to the corresponding type name, or Nothing when the
  58 -- type would be empty.
  59 type TypeMap = Map.Map HType (Maybe (AST.VHDLId, Either AST.TypeDef AST.SubtypeIn))
  60
  61 -- A map of a vector Core element type and function name to the coressponding
  62 -- VHDLId of the function and the function body.
  63 type TypeFunMap = Map.Map (OrdType, String) (AST.VHDLId, AST.SubProgBody)
  64
  65 type TfpIntMap = Map.Map OrdType Int
  66 -- A substate that deals with type generation
  67 data TypeState = TypeState {
  68   -- | A map of Core type -> VHDL Type
  69   tsTypes_      :: TypeMap,
  70   -- | A list of type declarations
  71   tsTypeDecls_  :: [AST.PackageDecItem],
  72   -- | A map of vector Core type -> VHDL type function
  73   tsTypeFuns_   :: TypeFunMap,
  74   tsTfpInts_    :: TfpIntMap,
  75   tsHscEnv_     :: HscTypes.HscEnv
  76 }
  77
  78 -- Derive accessors
  79 $( Data.Accessor.Template.deriveAccessors ''TypeState )
  80
  81 -- Define a session
  82 type TypeSession = State.State TypeState
  83 -- A global state for the translator
  84 data TranslatorState = TranslatorState {
  85     tsUniqSupply_ :: UniqSupply.UniqSupply
  86   , tsType_ :: TypeState
  87   , tsBindings_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr
  88   , tsNormalized_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr
  89   , tsEntityCounter_ :: Integer
  90   , tsEntities_ :: Map.Map CoreSyn.CoreBndr Entity
  91   , tsArchitectures_ :: Map.Map CoreSyn.CoreBndr (Architecture, [CoreSyn.CoreBndr])
  92 }
  93
  94 -- Derive accessors
  95 $( Data.Accessor.Template.deriveAccessors ''TranslatorState )
  96
  97 type TranslatorSession = State.State TranslatorState
  98
  99 -----------------------------------------------------------------------------
 100 -- Some accessors
 101 -----------------------------------------------------------------------------
 102
 103 -- Does the given binder reference a top level binder in the current
 104 -- module(s)?
 105 isTopLevelBinder :: CoreSyn.CoreBndr -> TranslatorSession Bool
 106 isTopLevelBinder bndr = do
 107   bindings <- getA tsBindings
 108   return $ Map.member bndr bindings
 109
 110 -- Finds the value of a global binding, if available
 111 getGlobalBind :: CoreSyn.CoreBndr -> TranslatorSession (Maybe CoreSyn.CoreExpr)
 112 getGlobalBind bndr = do
 113   bindings <- getA tsBindings
 114   return $ Map.lookup bndr bindings
 115
 116 -- Adds a new global binding with the given value
 117 addGlobalBind :: CoreSyn.CoreBndr -> CoreSyn.CoreExpr -> TranslatorSession ()
 118 addGlobalBind bndr expr = modA tsBindings (Map.insert bndr expr)
 119
 120 -- Returns a list of all global binders
 121 getGlobalBinders :: TranslatorSession [CoreSyn.CoreBndr]
 122 getGlobalBinders = do
 123   bindings <- getA tsBindings
 124   return $ Map.keys bindings
 125
 126 -- vim: set ts=8 sw=2 sts=2 expandtab: