Start support on initial state. Substates currently break

[matthijs/master-project/cλash.git] / cλash / CLasH / Translator / TranslatorTypes.hs

diff --git a/cλash/CLasH/Translator/TranslatorTypes.hs b/cλash/CLasH/Translator/TranslatorTypes.hs
index 5fb97c2b31831c4c1f5380d51f5250ceacd57517..12ca6ed8ea9313f59ecd035e8d2e299a6d58bbc6 100644 (file)
--- a/cλash/CLasH/Translator/TranslatorTypes.hs
+++ b/cλash/CLasH/Translator/TranslatorTypes.hs
@@ -12,6 +12,7 @@ import qualified Data.Accessor.Template
 import Data.Accessor
 
 -- GHC API
+import qualified GHC
 import qualified CoreSyn
 import qualified Type
 import qualified HscTypes
@@ -22,9 +23,24 @@ import qualified Language.VHDL.AST as AST
 
 -- Local imports
 import CLasH.VHDL.VHDLTypes
+import CLasH.Translator.Annotations
+
+-- | 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
@@ -32,6 +48,7 @@ instance Ord OrdType where
 
 data HType = StdType OrdType |
              ADTType String [HType] |
+             EnumType String [String] |
              VecType Int HType |
              SizedWType Int |
              RangedWType Int |
@@ -39,12 +56,13 @@ data HType = StdType OrdType |
              BuiltinType String
   deriving (Eq, Ord)
 
--- 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 TypeMap = Map.Map HType (Maybe (AST.VHDLId, Either AST.TypeDef AST.SubtypeIn))
 
 -- 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
@@ -62,13 +80,6 @@ data TypeState = TypeState {
 -- Derive accessors
 $( Data.Accessor.Template.deriveAccessors ''TypeState )
 
--- Compatibility with old VHDLSession
-vsTypes = tsTypes
-vsTypeDecls = tsTypeDecls
-vsTypeFuns = tsTypeFuns
-vsTfpInts = tsTfpInts
-vsHscEnv = tsHscEnv
-
 -- Define a session
 type TypeSession = State.State TypeState
 -- A global state for the translator
@@ -77,8 +88,10 @@ data TranslatorState = TranslatorState {
   , 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
 }
 
 -- Derive accessors
@@ -86,12 +99,9 @@ $( 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)?
@@ -100,4 +110,20 @@ isTopLevelBinder bndr = do
   bindings <- getA 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 <- getA tsBindings
+  return $ Map.lookup bndr bindings 
+
+-- Adds a new global binding with the given value
+addGlobalBind :: CoreSyn.CoreBndr -> CoreSyn.CoreExpr -> TranslatorSession ()
+addGlobalBind bndr expr = modA tsBindings (Map.insert bndr expr)
+
+-- Returns a list of all global binders
+getGlobalBinders :: TranslatorSession [CoreSyn.CoreBndr]
+getGlobalBinders = do
+  bindings <- getA tsBindings
+  return $ Map.keys bindings
+
 -- vim: set ts=8 sw=2 sts=2 expandtab: