Add support for enumeration types.

[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 1286a41bd55d6846c23074362b8633ecd0cba53c..c9c94055a199a124ab34588cd10f14f3f1f70fa0 100644 (file)
--- a/cλash/CLasH/Translator/TranslatorTypes.hs
+++ b/cλash/CLasH/Translator/TranslatorTypes.hs
@@ -3,35 +3,125 @@
 -- separate module to prevent circular dependencies in Pretty for example.
 --
 {-# LANGUAGE TemplateHaskell #-}
 -- 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 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
 

-import FlattenTypes
-import VHDLTypes
-import HsValueMap
+-- 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.CoreExpr, 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 = StdType OrdType |
+             ADTType String [HType] |
+             EnumType String [String] |
+             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: