Merge branch 'cλash' of http://git.stderr.nl/matthijs/projects/master-project

[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 0ab3b878a132542bbcd011b368dd254622394df8..7483504fd08c12083c4ff58038eca4a916ffafe5 100644 (file)
--- a/cλash/CLasH/Translator/TranslatorTypes.hs
+++ b/cλash/CLasH/Translator/TranslatorTypes.hs
@@ -5,25 +5,122 @@
 {-# LANGUAGE TemplateHaskell #-}
 module CLasH.Translator.TranslatorTypes where
 
 {-# 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 Control.Monad.Trans.State as State
 import qualified Data.Map as Map
 import qualified Data.Accessor.Template
 import Data.Accessor
 

+-- GHC API
+import qualified GHC
+import qualified CoreSyn
+import qualified Type

 import qualified HscTypes
 import qualified HscTypes

+import qualified UniqSupply

 
 

+-- ForSyDe

 import qualified Language.VHDL.AST as AST
 
 import qualified Language.VHDL.AST as AST
 

+-- Local imports

 import CLasH.VHDL.VHDLTypes
 
 import CLasH.VHDL.VHDLTypes
 

-data TranslatorSession = TranslatorSession {
-  tsCoreModule_ :: HscTypes.CoreModule, -- ^ The current module
-  tsNameCount_ :: Int -- ^ A counter that can be used to generate unique names
+-- | 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.CoreExpr, 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 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] |
+             VecType Int HType |
+             SizedWType Int |
+             RangedWType Int |
+             SizedIType Int |
+             BuiltinType String
+  deriving (Eq, Ord)
+
+-- 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 TfpIntMap = Map.Map OrdType Int
+-- A substate that deals with type generation
+data TypeState = TypeState {
+  -- | A map of Core type -> VHDL Type
+  tsTypes_      :: TypeMap,
+  -- | A list of type declarations
+  tsTypeDecls_  :: [AST.PackageDecItem],
+  -- | A map of vector Core type -> VHDL type function
+  tsTypeFuns_   :: TypeFunMap,
+  tsTfpInts_    :: TfpIntMap,
+  tsHscEnv_     :: HscTypes.HscEnv
+}
+
+-- Derive accessors
+$( Data.Accessor.Template.deriveAccessors ''TypeState )
+
+-- Define a session
+type TypeSession = State.State TypeState
+-- A global state for the translator
+data TranslatorState = TranslatorState {
+    tsUniqSupply_ :: UniqSupply.UniqSupply
+  , 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])

 }
 
 -- Derive accessors
 }
 
 -- Derive accessors

-$( Data.Accessor.Template.deriveAccessors ''TranslatorSession )
+$( Data.Accessor.Template.deriveAccessors ''TranslatorState )
+
+type TranslatorSession = State.State TranslatorState
+
+-----------------------------------------------------------------------------
+-- 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
+  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)

 
 

-type TranslatorState = State.State TranslatorSession
+-- 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:
 
 -- vim: set ts=8 sw=2 sts=2 expandtab: