Moved to new GHC API (6.11). Also use vhdl package for the VHDL AST

[matthijs/master-project/cλash.git] / TranslatorTypes.hs

diff --git a/TranslatorTypes.hs b/TranslatorTypes.hs
index fdd0e34fcd86f95e0f75afa0f8437a22d1ea8aea..1286a41bd55d6846c23074362b8633ecd0cba53c 100644 (file)
--- a/TranslatorTypes.hs
+++ b/TranslatorTypes.hs
@@ -5,14 +5,14 @@
 {-# LANGUAGE TemplateHaskell #-}
 module TranslatorTypes where
 
 {-# LANGUAGE TemplateHaskell #-}
 module TranslatorTypes where
 

-import qualified Control.Monad.State as State
+import qualified Control.Monad.Trans.State as State

 import qualified Data.Map as Map
 import qualified Data.Accessor.Template
 import Data.Accessor
 
 import qualified HscTypes
 
 import qualified Data.Map as Map
 import qualified Data.Accessor.Template
 import Data.Accessor
 
 import qualified HscTypes
 

-import qualified ForSyDe.Backend.VHDL.AST as AST
+import qualified Language.VHDL.AST as AST

 
 import FlattenTypes
 import VHDLTypes
 
 import FlattenTypes
 import VHDLTypes


@@ -21,105 +21,17 @@ import HsValueMap
 
 -- | A map from a HsFunction identifier to various stuff we collect about a
 --   function along the way.
 
 -- | A map from a HsFunction identifier to various stuff we collect about a
 --   function along the way.

-type FuncMap  = Map.Map HsFunction FuncData
+type FlatFuncMap  = Map.Map HsFunction FlatFunction

 
 

--- | Some stuff we collect about a function along the way.
-data FuncData = FuncData {
-  fdFlatFunc_ :: Maybe FlatFunction,
-  fdEntity_ :: Maybe Entity,
-  fdArch_ :: Maybe AST.ArchBody
-} deriving (Show)
+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
+}

 
 -- Derive accessors
 
 -- Derive accessors

-$( Data.Accessor.Template.deriveAccessors ''FuncData )
-
-data TranslatorSession = VHDLSession {
-  coreMod   :: HscTypes.CoreModule, -- The current module
-  nameCount :: Int,             -- A counter that can be used to generate unique names
-  funcs     :: FuncMap          -- A map from HsFunction to FlatFunction, HWFunction, VHDL Entity and Architecture
-}
+$( Data.Accessor.Template.deriveAccessors ''TranslatorSession )

 
 type TranslatorState = State.State TranslatorSession
 
 
 type TranslatorState = State.State TranslatorSession
 

--- | Add the function to the session
-addFunc :: HsFunction -> TranslatorState ()
-addFunc hsfunc =
-  modFuncMap (Map.insert hsfunc (FuncData Nothing Nothing Nothing))
-
--- | Find the given function in the current session
-getFunc :: HsFunction -> TranslatorState (Maybe FuncData)
-getFunc hsfunc = do
-  fs <- State.gets funcs -- Get the funcs element from the session
-  return $ Map.lookup hsfunc fs
-
--- | Gets all functions from the current session
-getFuncs :: TranslatorState [(HsFunction, FuncData)]
-getFuncs = do
-  fs <- State.gets funcs -- Get the funcs element from the session
-  return $ Map.toList fs
-
--- | Gets all the functions from the current session
-getHsFuncs :: TranslatorState [HsFunction]
-getHsFuncs = do
-  fs <- State.gets funcs -- Get the funcs element from the session
-  return $ Map.keys fs
-  
--- | Sets the FlatFunction for the given HsFunction in the current session.
-setFlatFunc :: HsFunction -> FlatFunction -> TranslatorState ()
-setFlatFunc hsfunc flatfunc =
-  modFunc (fdFlatFunc ^= Just flatfunc) hsfunc
-
--- | Sets the Entity for the given HsFunction in the current session.
-setEntity :: HsFunction -> Entity -> TranslatorState ()
-setEntity hsfunc entity =
-  modFunc (fdEntity ^= Just entity) hsfunc
-
--- | Sets the Entity for the given HsFunction in the current session.
-setArchitecture :: HsFunction -> AST.ArchBody -> TranslatorState ()
-setArchitecture hsfunc arch =
-  modFunc (fdArch ^= Just arch) hsfunc
-
--- | Modify a function in the map using the given function
-modFunc :: (FuncData -> FuncData) -> HsFunction -> TranslatorState ()
-modFunc f hsfunc =
-  modFuncMap (Map.adjust f hsfunc)
-
--- | Get the map of functions in the session
-getFuncMap :: TranslatorState FuncMap
-getFuncMap = State.gets funcs
-
--- | Modify the function map in the session using the given function
-modFuncMap :: (FuncMap -> FuncMap) -> TranslatorState ()
-modFuncMap f = do
-  fs <- State.gets funcs -- Get the funcs element from the session
-  let fs' = f fs
-  State.modify (\x -> x {funcs = fs' })
-
--- | Apply the given function to all functions in the map, and collect the
---   results. The function is allowed to change the function map in the
---   session, but any new functions added will not be mapped.
-modFuncs :: (HsFunction -> FuncData -> TranslatorState ()) -> TranslatorState ()
-modFuncs f = do
-  hsfuncs <- getHsFuncs
-  mapM doFunc hsfuncs
-  return ()
-  where
-    doFunc hsfunc = do
-      fdata_maybe <- getFunc hsfunc
-      case fdata_maybe of
-        Nothing -> do return ()
-        Just fdata -> f hsfunc fdata
-
-getModule :: TranslatorState HscTypes.CoreModule
-getModule = State.gets coreMod -- Get the coreMod element from the session
-
--- Makes the given name unique by appending a unique number.
--- This does not do any checking against existing names, so it only guarantees
--- uniqueness with other names generated by uniqueName.
-uniqueName :: String -> TranslatorState String
-uniqueName name = do
-  count <- State.gets nameCount -- Get the funcs element from the session
-  State.modify (\s -> s {nameCount = count + 1})
-  return $ name ++ "_" ++ (show count)
-

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