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 CoreSyn
  16 import qualified Type
  17 import qualified HscTypes
  18 import qualified UniqSupply
  19
  20 -- ForSyDe
  21 import qualified Language.VHDL.AST as AST
  22
  23 -- Local imports
  24 import CLasH.VHDL.VHDLTypes
  25
  26 -- A orderable equivalent of CoreSyn's Type for use as a map key
  27 newtype OrdType = OrdType { getType :: Type.Type }
  28 instance Eq OrdType where
  29   (OrdType a) == (OrdType b) = Type.tcEqType a b
  30 instance Ord OrdType where
  31   compare (OrdType a) (OrdType b) = Type.tcCmpType a b
  32
  33 data HType = StdType OrdType |
  34              ADTType String [HType] |
  35              VecType Int HType |
  36              SizedWType Int |
  37              RangedWType Int |
  38              SizedIType Int |
  39              BuiltinType String
  40   deriving (Eq, Ord)
  41
  42 -- A map of a Core type to the corresponding type name
  43 type TypeMap = Map.Map HType (AST.VHDLId, Either AST.TypeDef AST.SubtypeIn)
  44
  45 -- A map of a vector Core element type and function name to the coressponding
  46 -- VHDLId of the function and the function body.
  47 type TypeFunMap = Map.Map (OrdType, String) (AST.VHDLId, AST.SubProgBody)
  48
  49 type TfpIntMap = Map.Map OrdType Int
  50 -- A substate that deals with type generation
  51 data TypeState = TypeState {
  52   -- | A map of Core type -> VHDL Type
  53   tsTypes_      :: TypeMap,
  54   -- | A list of type declarations
  55   tsTypeDecls_  :: [AST.PackageDecItem],
  56   -- | A map of vector Core type -> VHDL type function
  57   tsTypeFuns_   :: TypeFunMap,
  58   tsTfpInts_    :: TfpIntMap,
  59   tsHscEnv_     :: HscTypes.HscEnv
  60 }
  61
  62 -- Derive accessors
  63 $( Data.Accessor.Template.deriveAccessors ''TypeState )
  64
  65 -- Define a session
  66 type TypeSession = State.State TypeState
  67 -- A global state for the translator
  68 data TranslatorState = TranslatorState {
  69     tsUniqSupply_ :: UniqSupply.UniqSupply
  70   , tsType_ :: TypeState
  71   , tsBindings_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr
  72   , tsNormalized_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr
  73   , tsEntities_ :: Map.Map CoreSyn.CoreBndr Entity
  74   , tsArchitectures_ :: Map.Map CoreSyn.CoreBndr (Architecture, [CoreSyn.CoreBndr])
  75 }
  76
  77 -- Derive accessors
  78 $( Data.Accessor.Template.deriveAccessors ''TranslatorState )
  79
  80 type TranslatorSession = State.State TranslatorState
  81
  82 -----------------------------------------------------------------------------
  83 -- Some accessors
  84 -----------------------------------------------------------------------------
  85
  86 -- Does the given binder reference a top level binder in the current
  87 -- module(s)?
  88 isTopLevelBinder :: CoreSyn.CoreBndr -> TranslatorSession Bool
  89 isTopLevelBinder bndr = do
  90   bindings <- getA tsBindings
  91   return $ Map.member bndr bindings
  92
  93 -- Finds the value of a global binding, if available
  94 getGlobalBind :: CoreSyn.CoreBndr -> TranslatorSession (Maybe CoreSyn.CoreExpr)
  95 getGlobalBind bndr = do
  96   bindings <- getA tsBindings
  97   return $ Map.lookup bndr bindings
  98
  99 -- Adds a new global binding with the given value
 100 addGlobalBind :: CoreSyn.CoreBndr -> CoreSyn.CoreExpr -> TranslatorSession ()
 101 addGlobalBind bndr expr = modA tsBindings (Map.insert bndr expr)
 102
 103 -- Returns a list of all global binders
 104 getGlobalBinders :: TranslatorSession [CoreSyn.CoreBndr]
 105 getGlobalBinders = do
 106   bindings <- getA tsBindings
 107   return $ Map.keys bindings
 108
 109 -- vim: set ts=8 sw=2 sts=2 expandtab: