X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FTranslator%2FTranslatorTypes.hs;h=56c5c75a0324696d5f1d6b7d8aa0c934caa5295c;hb=eab16fafe7a623b5ea669023b91ddee4b1983526;hp=1286a41bd55d6846c23074362b8633ecd0cba53c;hpb=ec4378a8a765c5a064b5cbed347b40c353c778a0;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git "a/c\316\273ash/CLasH/Translator/TranslatorTypes.hs" "b/c\316\273ash/CLasH/Translator/TranslatorTypes.hs"
index 1286a41..56c5c75 100644
--- "a/c\316\273ash/CLasH/Translator/TranslatorTypes.hs"
+++ "b/c\316\273ash/CLasH/Translator/TranslatorTypes.hs"
@@ -3,35 +3,129 @@
 -- separate module to prevent circular dependencies in Pretty for example.
 --
 {-# LANGUAGE TemplateHaskell #-}
-module TranslatorTypes where
+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
 import qualified Language.VHDL.AST as AST
 
-import FlattenTypes
-import VHDLTypes
-import HsValueMap
+-- 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 map from a HsFunction identifier to various stuff we collect about a
---   function along the way.
-type FlatFuncMap  = Map.Map HsFunction FlatFunction
+-- | A function that knows which parts of a module to compile
+type Finder =
+  HscTypes.CoreModule -- ^ The module to look at
+  -> GHC.Ghc [EntitySpec]
 
-data TranslatorSession = TranslatorSession {
-  tsCoreModule_ :: HscTypes.CoreModule, -- ^ The current module
-  tsNameCount_ :: Int, -- ^ A counter that can be used to generate unique names
-  tsFlatFuncs_ :: FlatFuncMap -- ^ A map from HsFunction to FlatFunction
+-----------------------------------------------------------------------------
+-- 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 = AggrType String [HType] |
+             EnumType String [String] |
+             VecType Int HType |
+             UVecType HType |
+             SizedWType Int |
+             RangedWType Int |
+             SizedIType Int |
+             BuiltinType String |
+             StateType
+  deriving (Eq, Ord, Show)
+
+-- 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 (HType, 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_  :: [Maybe 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])
+  , tsInitStates_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreBndr
 }
 
 -- 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 <- 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)
 
-type TranslatorState = State.State TranslatorSession
+-- 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: