Keep (and show) a count of applied transformations.
[matthijs/master-project/cλash.git] / cλash / CLasH / Translator / TranslatorTypes.hs
index 7483504fd08c12083c4ff58038eca4a916ffafe5..eabb00423c5c0734aab838be9a353db290e32e55 100644 (file)
@@ -1,15 +1,15 @@
+{-# LANGUAGE TemplateHaskell #-}
 --
 -- Simple module providing some types used by Translator. These are in a
 -- separate module to prevent circular dependencies in Pretty for example.
 --
-{-# 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 Data.Accessor.Monad.Trans.State as MonadState
 
 -- GHC API
 import qualified GHC
@@ -18,7 +18,7 @@ import qualified Type
 import qualified HscTypes
 import qualified UniqSupply
 
--- ForSyDe
+-- VHDL Imports
 import qualified Language.VHDL.AST as AST
 
 -- Local imports
@@ -27,7 +27,7 @@ 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)
+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 =
@@ -45,22 +45,25 @@ instance Eq OrdType where
 instance Ord OrdType where
   compare (OrdType a) (OrdType b) = Type.tcCmpType a b
 
-data HType = StdType OrdType |
-             ADTType String [HType] |
+data HType = AggrType String [HType] |
+             EnumType String [String] |
              VecType Int HType |
+             UVecType HType |
              SizedWType Int |
              RangedWType Int |
              SizedIType Int |
-             BuiltinType String
-  deriving (Eq, Ord)
+             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 TypeMap = Map.Map HType (Maybe (AST.VHDLId, Either AST.TypeDef AST.SubtypeIn))
+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 (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
@@ -68,7 +71,7 @@ data TypeState = TypeState {
   -- | A map of Core type -> VHDL Type
   tsTypes_      :: TypeMap,
   -- | A list of type declarations
-  tsTypeDecls_  :: [AST.PackageDecItem],
+  tsTypeDecls_  :: [Maybe AST.PackageDecItem],
   -- | A map of vector Core type -> VHDL type function
   tsTypeFuns_   :: TypeFunMap,
   tsTfpInts_    :: TfpIntMap,
@@ -76,7 +79,7 @@ data TypeState = TypeState {
 }
 
 -- Derive accessors
-$( Data.Accessor.Template.deriveAccessors ''TypeState )
+Data.Accessor.Template.deriveAccessors ''TypeState
 
 -- Define a session
 type TypeSession = State.State TypeState
@@ -89,10 +92,12 @@ data TranslatorState = TranslatorState {
   , tsEntityCounter_ :: Integer
   , tsEntities_ :: Map.Map CoreSyn.CoreBndr Entity
   , tsArchitectures_ :: Map.Map CoreSyn.CoreBndr (Architecture, [CoreSyn.CoreBndr])
+  , tsInitStates_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreBndr
+  , tsTransformCounter_ :: Int -- ^ How many transformations were applied?
 }
 
 -- Derive accessors
-$( Data.Accessor.Template.deriveAccessors ''TranslatorState )
+Data.Accessor.Template.deriveAccessors ''TranslatorState
 
 type TranslatorSession = State.State TranslatorState
 
@@ -104,23 +109,23 @@ type TranslatorSession = State.State TranslatorState
 -- module(s)?
 isTopLevelBinder :: CoreSyn.CoreBndr -> TranslatorSession Bool
 isTopLevelBinder bndr = do
-  bindings <- getA tsBindings
+  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 <- getA tsBindings
+  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 = modA tsBindings (Map.insert bndr expr)
+addGlobalBind bndr expr = MonadState.modify tsBindings (Map.insert bndr expr)
 
 -- Returns a list of all global binders
 getGlobalBinders :: TranslatorSession [CoreSyn.CoreBndr]
 getGlobalBinders = do
-  bindings <- getA tsBindings
+  bindings <- MonadState.get tsBindings
   return $ Map.keys bindings
 
 -- vim: set ts=8 sw=2 sts=2 expandtab: