Make vhdl generation and normalization lazy.

[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..5fb97c2b31831c4c1f5380d51f5250ceacd57517 100644 (file)
--- a/cλash/CLasH/Translator/TranslatorTypes.hs
+++ b/cλash/CLasH/Translator/TranslatorTypes.hs
@@ -3,35 +3,101 @@
 -- 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 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 orderable equivalent of CoreSyn's Type for use as a map key
+newtype OrdType = OrdType { getType :: 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

 
 

--- | A map from a HsFunction identifier to various stuff we collect about a
---   function along the way.
-type FlatFuncMap  = Map.Map HsFunction FlatFunction
+data HType = StdType OrdType |
+             ADTType String [HType] |
+             VecType Int HType |
+             SizedWType Int |
+             RangedWType Int |
+             SizedIType Int |
+             BuiltinType String
+  deriving (Eq, Ord)

 
 

-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
+-- 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 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 )
+
+-- 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
+data TranslatorState = TranslatorState {
+    tsUniqSupply_ :: UniqSupply.UniqSupply
+  , tsType_ :: TypeState
+  , tsBindings_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr
+  , tsNormalized_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr
+  , 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
+
+-- Compatibility for the old VHDLSesssion
+vsType = tsType
+type VHDLSession = TranslatorSession
+
+-- Compatibility for the old TransformSession
+type TransformSession = TranslatorSession

 
 

-type TranslatorState = State.State TranslatorSession
+-- 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

 
 -- vim: set ts=8 sw=2 sts=2 expandtab:
 
 -- vim: set ts=8 sw=2 sts=2 expandtab: