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 17a2b9cccafbc47dfd6314d0a5d21159a8e9a665..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)
-
--- Derive accessors
-$( Data.Accessor.Template.deriveAccessors ''FuncData )
-
-data VHDLSession = 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 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

 }
 
 }
 

--- | Add the function to the session
-addFunc :: HsFunction -> VHDLState ()
-addFunc hsfunc =
-  modFuncMap (Map.insert hsfunc (FuncData Nothing Nothing Nothing))
-
--- | Find the given function in the current session
-getFunc :: HsFunction -> VHDLState (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 :: VHDLState [(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 :: VHDLState [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 -> VHDLState ()
-setFlatFunc hsfunc flatfunc =
-  modFunc (fdFlatFunc ^= Just flatfunc) hsfunc
-
--- | Sets the Entity for the given HsFunction in the current session.
-setEntity :: HsFunction -> Entity -> VHDLState ()
-setEntity hsfunc entity =
-  modFunc (fdEntity ^= Just entity) hsfunc
-
--- | Sets the Entity for the given HsFunction in the current session.
-setArchitecture :: HsFunction -> AST.ArchBody -> VHDLState ()
-setArchitecture hsfunc arch =
-  modFunc (fdArch ^= Just arch) hsfunc
-
--- | Modify a function in the map using the given function
-modFunc :: (FuncData -> FuncData) -> HsFunction -> VHDLState ()
-modFunc f hsfunc =
-  modFuncMap (Map.adjust f hsfunc)
-
--- | Get the map of functions in the session
-getFuncMap :: VHDLState FuncMap
-getFuncMap = State.gets funcs
-
--- | Modify the function map in the session using the given function
-modFuncMap :: (FuncMap -> FuncMap) -> VHDLState ()
-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 -> VHDLState ()) -> VHDLState ()
-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 :: VHDLState HscTypes.CoreModule
-getModule = State.gets coreMod -- Get the coreMod element from the session
-
-type VHDLState = State.State VHDLSession
+-- Derive accessors
+$( Data.Accessor.Template.deriveAccessors ''TranslatorSession )

 
 

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

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