+{-# LANGUAGE TemplateHaskell #-}
--
-- Simple module providing some types used by Translator. These are in a
-- separate module to prevent circular dependencies in Pretty for example.
--
-{-# LANGUAGE TemplateHaskell #-}
module CLasH.Translator.TranslatorTypes where
-- Standard modules
import qualified Control.Monad.Trans.State as State
import qualified Data.Map as Map
import qualified Data.Accessor.Template
-import Data.Accessor
+import qualified Data.Accessor.Monad.Trans.State as MonadState
-- GHC API
+import qualified GHC
import qualified CoreSyn
import qualified Type
import qualified HscTypes
import qualified UniqSupply
--- ForSyDe
+-- VHDL Imports
import qualified Language.VHDL.AST as AST
-- Local imports
import CLasH.VHDL.VHDLTypes
+-- | A specification of an entity we can generate VHDL for. Consists of the
+-- binder of the top level entity, an optional initial state and an optional
+-- test input.
+type EntitySpec = (Maybe CoreSyn.CoreBndr, Maybe [(CoreSyn.CoreBndr, CoreSyn.CoreBndr)], Maybe CoreSyn.CoreExpr)
+
+-- | A function that knows which parts of a module to compile
+type Finder =
+ HscTypes.CoreModule -- ^ The module to look at
+ -> GHC.Ghc [EntitySpec]
+
+-----------------------------------------------------------------------------
+-- The TranslatorSession
+-----------------------------------------------------------------------------
+
-- A orderable equivalent of CoreSyn's Type for use as a map key
-newtype OrdType = OrdType { getType :: Type.Type }
+newtype OrdType = OrdType Type.Type
instance Eq OrdType where
(OrdType a) == (OrdType b) = Type.tcEqType a b
instance Ord OrdType where
compare (OrdType a) (OrdType b) = Type.tcCmpType a b
-data HType = StdType OrdType |
- ADTType String [HType] |
+data HType = AggrType String [HType] |
+ EnumType String [String] |
VecType Int HType |
+ UVecType HType |
SizedWType Int |
RangedWType Int |
SizedIType Int |
- BuiltinType String
- deriving (Eq, Ord)
+ BuiltinType String |
+ StateType
+ deriving (Eq, Ord, Show)
--- A map of a Core type to the corresponding type name
-type TypeMap = Map.Map HType (AST.VHDLId, Either AST.TypeDef AST.SubtypeIn)
+-- A map of a Core type to the corresponding type name, or Nothing when the
+-- type would be empty.
+type TypeMapRec = Maybe (AST.VHDLId, Maybe (Either AST.TypeDef AST.SubtypeIn))
+type TypeMap = Map.Map HType TypeMapRec
-- A map of a vector Core element type and function name to the coressponding
-- VHDLId of the function and the function body.
-type TypeFunMap = Map.Map (OrdType, String) (AST.VHDLId, AST.SubProgBody)
+type TypeFunMap = Map.Map (HType, String) (AST.VHDLId, AST.SubProgBody)
type TfpIntMap = Map.Map OrdType Int
-- A substate that deals with type generation
-- | A map of Core type -> VHDL Type
tsTypes_ :: TypeMap,
-- | A list of type declarations
- tsTypeDecls_ :: [AST.PackageDecItem],
+ tsTypeDecls_ :: [Maybe AST.PackageDecItem],
-- | A map of vector Core type -> VHDL type function
tsTypeFuns_ :: TypeFunMap,
tsTfpInts_ :: TfpIntMap,
}
-- Derive accessors
-$( Data.Accessor.Template.deriveAccessors ''TypeState )
-
--- Compatibility with old VHDLSession
-vsTypes = tsTypes
-vsTypeDecls = tsTypeDecls
-vsTypeFuns = tsTypeFuns
-vsTfpInts = tsTfpInts
-vsHscEnv = tsHscEnv
+Data.Accessor.Template.deriveAccessors ''TypeState
-- Define a session
type TypeSession = State.State TypeState
, tsType_ :: TypeState
, tsBindings_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr
, tsNormalized_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr
+ , tsEntityCounter_ :: Integer
, tsEntities_ :: Map.Map CoreSyn.CoreBndr Entity
, tsArchitectures_ :: Map.Map CoreSyn.CoreBndr (Architecture, [CoreSyn.CoreBndr])
+ , tsInitStates_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreBndr
+ , tsTransformCounter_ :: Int -- ^ How many transformations were applied?
}
-- Derive accessors
-$( Data.Accessor.Template.deriveAccessors ''TranslatorState )
+Data.Accessor.Template.deriveAccessors ''TranslatorState
type TranslatorSession = State.State TranslatorState
--- Compatibility for the old VHDLSesssion
-vsType = tsType
-type VHDLSession = TranslatorSession
-
--- Compatibility for the old TransformSession
-type TransformSession = TranslatorSession
+-----------------------------------------------------------------------------
+-- Some accessors
+-----------------------------------------------------------------------------
-- Does the given binder reference a top level binder in the current
-- module(s)?
isTopLevelBinder :: CoreSyn.CoreBndr -> TranslatorSession Bool
isTopLevelBinder bndr = do
- bindings <- getA tsBindings
+ bindings <- MonadState.get tsBindings
return $ Map.member bndr bindings
+-- Finds the value of a global binding, if available
+getGlobalBind :: CoreSyn.CoreBndr -> TranslatorSession (Maybe CoreSyn.CoreExpr)
+getGlobalBind bndr = do
+ bindings <- MonadState.get tsBindings
+ return $ Map.lookup bndr bindings
+
+-- Adds a new global binding with the given value
+addGlobalBind :: CoreSyn.CoreBndr -> CoreSyn.CoreExpr -> TranslatorSession ()
+addGlobalBind bndr expr = MonadState.modify tsBindings (Map.insert bndr expr)
+
+-- Returns a list of all global binders
+getGlobalBinders :: TranslatorSession [CoreSyn.CoreBndr]
+getGlobalBinders = do
+ bindings <- MonadState.get tsBindings
+ return $ Map.keys bindings
+
-- vim: set ts=8 sw=2 sts=2 expandtab: