Use data-accessor-transformers package to remove deprecation warnings

diff --git a/cλash/CLasH/Normalize/NormalizeTools.hs b/cλash/CLasH/Normalize/NormalizeTools.hs
index c9e2f804f55508fd7bbec7c1e624e89ac419bd00..936a4ec1e834ec59c6cc49002f50f1878c544d6e 100644 (file)
--- a/cλash/CLasH/Normalize/NormalizeTools.hs
+++ b/cλash/CLasH/Normalize/NormalizeTools.hs
@@ -16,7 +16,7 @@ import qualified Control.Monad.Trans.Writer as Writer
 import qualified "transformers" Control.Monad.Trans as Trans
 import qualified Data.Map as Map
 import Data.Accessor
 import qualified "transformers" Control.Monad.Trans as Trans
 import qualified Data.Map as Map
 import Data.Accessor

-import Data.Accessor.MonadState as MonadState
+import Data.Accessor.Monad.Trans.State as MonadState

 
 -- GHC API
 import CoreSyn
 
 -- GHC API
 import CoreSyn

diff --git a/cλash/CLasH/Translator.hs b/cλash/CLasH/Translator.hs
index 8884506ea47f27f80a0b3a93bae20384711e0159..16158d24df07fbbf441688a313cf3863cf47a9a5 100644 (file)
--- a/cλash/CLasH/Translator.hs
+++ b/cλash/CLasH/Translator.hs
@@ -10,7 +10,7 @@ import qualified Monad
 import qualified System.FilePath as FilePath
 import qualified Control.Monad.Trans.State as State
 import Text.PrettyPrint.HughesPJ (render)
 import qualified System.FilePath as FilePath
 import qualified Control.Monad.Trans.State as State
 import Text.PrettyPrint.HughesPJ (render)

-import Data.Accessor
+import Data.Accessor.Monad.Trans.State

 import qualified Data.Map as Map
 import Debug.Trace
 
 import qualified Data.Map as Map
 import Debug.Trace
 

diff --git a/cλash/CLasH/Translator/TranslatorTypes.hs b/cλash/CLasH/Translator/TranslatorTypes.hs
index 2591e666f0b3491b93b8f8baaced8d993b77998d..56c5c75a0324696d5f1d6b7d8aa0c934caa5295c 100644 (file)
--- a/cλash/CLasH/Translator/TranslatorTypes.hs
+++ b/cλash/CLasH/Translator/TranslatorTypes.hs
@@ -9,7 +9,7 @@ module CLasH.Translator.TranslatorTypes where
 import qualified Control.Monad.Trans.State as State
 import qualified Data.Map as Map
 import qualified Data.Accessor.Template
 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
 
 -- GHC API
 import qualified GHC


@@ -109,23 +109,23 @@ type TranslatorSession = State.State TranslatorState
 -- module(s)?
 isTopLevelBinder :: CoreSyn.CoreBndr -> TranslatorSession Bool
 isTopLevelBinder bndr = do
 -- 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
   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 ()
   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
 
 -- 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:
   return $ Map.keys bindings
 
 -- vim: set ts=8 sw=2 sts=2 expandtab:

diff --git a/cλash/CLasH/Utils.hs b/cλash/CLasH/Utils.hs
index 94da85494f2216f75b395b542ed6c07b5362ecbf..51c6ebfc906281c79e74d5becc61fa289a3db143 100644 (file)
--- a/cλash/CLasH/Utils.hs
+++ b/cλash/CLasH/Utils.hs
@@ -3,6 +3,7 @@ module CLasH.Utils where
 -- Standard Imports
 import qualified Maybe
 import Data.Accessor
 -- Standard Imports
 import qualified Maybe
 import Data.Accessor

+import Data.Accessor.Monad.Trans.State as MonadState

 import qualified Data.Map as Map
 import qualified Control.Monad as Monad
 import qualified Control.Monad.Trans.State as State
 import qualified Data.Map as Map
 import qualified Control.Monad as Monad
 import qualified Control.Monad.Trans.State as State


@@ -19,14 +20,14 @@ makeCached :: (Monad m, Ord k) =>
   -> State.StateT s m v -- ^ The resulting value, from the cache or freshly
                         --   computed.
 makeCached key accessor create = do
   -> State.StateT s m v -- ^ The resulting value, from the cache or freshly
                         --   computed.
 makeCached key accessor create = do

-  cache <- getA accessor
+  cache <- MonadState.get accessor

   case Map.lookup key cache of
     -- Found in cache, just return
     Just value -> return value
     -- Not found, compute it and put it in the cache
     Nothing -> do
       value <- create
   case Map.lookup key cache of
     -- Found in cache, just return
     Just value -> return value
     -- Not found, compute it and put it in the cache
     Nothing -> do
       value <- create

-      modA accessor (Map.insert key value)
+      MonadState.modify accessor (Map.insert key value)

       return value
 
 unzipM :: (Monad m) =>
       return value
 
 unzipM :: (Monad m) =>

diff --git a/cλash/CLasH/Utils/Core/BinderTools.hs b/cλash/CLasH/Utils/Core/BinderTools.hs
index a072c45f2ee95389672704fce4a9f6e412145752..ef694746286b622a70dab4f98bbef36a247a264e 100644 (file)
--- a/cλash/CLasH/Utils/Core/BinderTools.hs
+++ b/cλash/CLasH/Utils/Core/BinderTools.hs
@@ -4,7 +4,7 @@
 module CLasH.Utils.Core.BinderTools where
 
 -- Standard modules
 module CLasH.Utils.Core.BinderTools where
 
 -- Standard modules

-import Data.Accessor.MonadState as MonadState
+import Data.Accessor.Monad.Trans.State as MonadState

 
 -- GHC API
 import CoreSyn
 
 -- GHC API
 import CoreSyn


@@ -22,16 +22,14 @@ import qualified VarSet
 import qualified HscTypes
 
 -- Local imports
 import qualified HscTypes
 
 -- Local imports

-import Data.Accessor
-import Data.Accessor.MonadState as MonadState

 import CLasH.Translator.TranslatorTypes
 
 -- Create a new Unique
 mkUnique :: TranslatorSession Unique.Unique    
 mkUnique = do
 import CLasH.Translator.TranslatorTypes
 
 -- Create a new Unique
 mkUnique :: TranslatorSession Unique.Unique    
 mkUnique = do

-  us <- getA tsUniqSupply 
+  us <- MonadState.get tsUniqSupply 

   let (us', us'') = UniqSupply.splitUniqSupply us
   let (us', us'') = UniqSupply.splitUniqSupply us

-  putA tsUniqSupply us'
+  MonadState.set tsUniqSupply us'

   return $ UniqSupply.uniqFromSupply us''
 
 -- Create a new internal var with the given name and type. A Unique is
   return $ UniqSupply.uniqFromSupply us''
 
 -- Create a new internal var with the given name and type. A Unique is

diff --git a/cλash/CLasH/VHDL.hs b/cλash/CLasH/VHDL.hs
index 762a0f43f4facc8e142d45537c55beb21df96fb7..21671adedef95da3bccd4f64e204486e43b620b0 100644 (file)
--- a/cλash/CLasH/VHDL.hs
+++ b/cλash/CLasH/VHDL.hs
@@ -11,7 +11,7 @@ import qualified Control.Arrow as Arrow
 import qualified Control.Monad.Trans.State as State
 import qualified Data.Monoid as Monoid
 import Data.Accessor
 import qualified Control.Monad.Trans.State as State
 import qualified Data.Monoid as Monoid
 import Data.Accessor

-import Data.Accessor.MonadState as MonadState
+import Data.Accessor.Monad.Trans.State as MonadState

 import Debug.Trace
 
 -- ForSyDe
 import Debug.Trace
 
 -- ForSyDe


@@ -82,9 +82,9 @@ createTypesPackage ::
   -- ^ The id and content of the types package
  
 createTypesPackage = do
   -- ^ The id and content of the types package
  
 createTypesPackage = do

-  tyfuns <- getA (tsType .> tsTypeFuns)
+  tyfuns <- MonadState.get (tsType .> tsTypeFuns)

   let tyfun_decls = mkBuiltInShow ++ (map snd $ Map.elems tyfuns)
   let tyfun_decls = mkBuiltInShow ++ (map snd $ Map.elems tyfuns)

-  ty_decls_maybes <- getA (tsType .> tsTypeDecls)
+  ty_decls_maybes <- MonadState.get (tsType .> tsTypeDecls)

   let ty_decls = Maybe.catMaybes ty_decls_maybes
   let subProgSpecs = map (\(AST.SubProgBody spec _ _) -> AST.PDISS spec) tyfun_decls
   let type_package_dec = AST.LUPackageDec $ AST.PackageDec (mkVHDLBasicId "types") ([tfvec_index_decl] ++ ty_decls ++ subProgSpecs)
   let ty_decls = Maybe.catMaybes ty_decls_maybes
   let subProgSpecs = map (\(AST.SubProgBody spec _ _) -> AST.PDISS spec) tyfun_decls
   let type_package_dec = AST.LUPackageDec $ AST.PackageDec (mkVHDLBasicId "types") ([tfvec_index_decl] ++ ty_decls ++ subProgSpecs)

diff --git a/cλash/CLasH/VHDL/Generate.hs b/cλash/CLasH/VHDL/Generate.hs
index 3c738a0a04b4c1c9dfefd79a7e816d66a50fb06f..4b24b576e89ca597a8c4b85b8bb551682d63e7fa 100644 (file)
--- a/cλash/CLasH/VHDL/Generate.hs
+++ b/cλash/CLasH/VHDL/Generate.hs
@@ -6,8 +6,7 @@ import qualified Data.Map as Map
 import qualified Control.Monad as Monad
 import qualified Maybe
 import qualified Data.Either as Either
 import qualified Control.Monad as Monad
 import qualified Maybe
 import qualified Data.Either as Either

-import Data.Accessor
-import Data.Accessor.MonadState as MonadState
+import Data.Accessor.Monad.Trans.State as MonadState

 import Debug.Trace
 
 -- ForSyDe
 import Debug.Trace
 
 -- ForSyDe


@@ -50,9 +49,9 @@ getEntity fname = Utils.makeCached fname tsEntities $ do
       args' <- catMaybesM $ mapM mkMap args
       -- TODO: Handle Nothing
       res' <- mkMap res
       args' <- catMaybesM $ mapM mkMap args
       -- TODO: Handle Nothing
       res' <- mkMap res

-      count <- getA tsEntityCounter 
+      count <- MonadState.get tsEntityCounter 

       let vhdl_id = mkVHDLBasicId $ varToString fname ++ "Component_" ++ show count
       let vhdl_id = mkVHDLBasicId $ varToString fname ++ "Component_" ++ show count

-      putA tsEntityCounter (count + 1)
+      MonadState.set tsEntityCounter (count + 1)

       let ent_decl = createEntityAST vhdl_id args' res'
       let signature = Entity vhdl_id args' res' ent_decl
       return signature
       let ent_decl = createEntityAST vhdl_id args' res'
       let signature = Entity vhdl_id args' res' ent_decl
       return signature


@@ -130,7 +129,7 @@ getArchitecture fname = Utils.makeCached fname tsArchitectures $ do
   let (in_state_maybes, out_state_maybes) = unzip state_vars
   let (statementss, used_entitiess) = unzip sms
   -- Get initial state, if it's there
   let (in_state_maybes, out_state_maybes) = unzip state_vars
   let (statementss, used_entitiess) = unzip sms
   -- Get initial state, if it's there

-  initSmap <- getA tsInitStates
+  initSmap <- MonadState.get tsInitStates

   let init_state = Map.lookup fname initSmap
   -- Create a state proc, if needed
   (state_proc, resbndr) <- case (Maybe.catMaybes in_state_maybes, Maybe.catMaybes out_state_maybes, init_state) of
   let init_state = Map.lookup fname initSmap
   -- Create a state proc, if needed
   (state_proc, resbndr) <- case (Maybe.catMaybes in_state_maybes, Maybe.catMaybes out_state_maybes, init_state) of


@@ -340,7 +339,7 @@ genLitArgs ::
   (dst -> func -> [Literal.Literal] -> TranslatorSession [AST.ConcSm])
   -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.ConcSm])
 genLitArgs wrap dst func args = do
   (dst -> func -> [Literal.Literal] -> TranslatorSession [AST.ConcSm])
   -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.ConcSm])
 genLitArgs wrap dst func args = do

-  hscenv <- MonadState.lift tsType $ getA tsHscEnv
+  hscenv <- MonadState.lift tsType $ MonadState.get tsHscEnv

   let (exprargs, []) = Either.partitionEithers args
   -- FIXME: Check if we were passed an CoreSyn.App
   let litargs = concat (map (getLiterals hscenv) exprargs)
   let (exprargs, []) = Either.partitionEithers args
   -- FIXME: Check if we were passed an CoreSyn.App
   let litargs = concat (map (getLiterals hscenv) exprargs)


@@ -1092,7 +1091,7 @@ vectorFunId el_ty fname = do
   -- TODO: This should not be duplicated from mk_vector_ty. Probably but it in
   -- the VHDLState or something.
   let vectorTM = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId elemTM)
   -- TODO: This should not be duplicated from mk_vector_ty. Probably but it in
   -- the VHDLState or something.
   let vectorTM = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId elemTM)

-  typefuns <- getA tsTypeFuns
+  typefuns <- MonadState.get tsTypeFuns

   el_htype <- mkHType error_msg el_ty
   case Map.lookup (UVecType el_htype, fname) typefuns of
     -- Function already generated, just return it
   el_htype <- mkHType error_msg el_ty
   case Map.lookup (UVecType el_htype, fname) typefuns of
     -- Function already generated, just return it


@@ -1102,7 +1101,7 @@ vectorFunId el_ty fname = do
       let functions = genUnconsVectorFuns elemTM vectorTM
       case lookup fname functions of
         Just body -> do
       let functions = genUnconsVectorFuns elemTM vectorTM
       case lookup fname functions of
         Just body -> do

-          modA tsTypeFuns $ Map.insert (UVecType el_htype, fname) (function_id, (fst body))
+          MonadState.modify tsTypeFuns $ Map.insert (UVecType el_htype, fname) (function_id, (fst body))

           mapM_ (vectorFunId el_ty) (snd body)
           return function_id
         Nothing -> error $ "\nGenerate.vectorFunId: I don't know how to generate vector function " ++ fname
           mapM_ (vectorFunId el_ty) (snd body)
           return function_id
         Nothing -> error $ "\nGenerate.vectorFunId: I don't know how to generate vector function " ++ fname

diff --git a/cλash/CLasH/VHDL/Testbench.hs b/cλash/CLasH/VHDL/Testbench.hs
index 399846dc0d6327e9e4dc90616aa975ca0f52797a..89988f5372327b0eb675ecbff08d525ea62a4c73 100644 (file)
--- a/cλash/CLasH/VHDL/Testbench.hs
+++ b/cλash/CLasH/VHDL/Testbench.hs
@@ -7,8 +7,7 @@ module CLasH.VHDL.Testbench where
 import qualified Control.Monad as Monad
 import qualified Maybe
 import qualified Data.Map as Map
 import qualified Control.Monad as Monad
 import qualified Maybe
 import qualified Data.Map as Map

-import Data.Accessor
-import qualified Data.Accessor.MonadState as MonadState
+import qualified Data.Accessor.Monad.Trans.State as MonadState

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


@@ -42,9 +41,9 @@ createTestbench mCycles cores stimuli top = do
   -- testbench has no outputs and no inputs.
   bndr <- mkInternalVar "testbench" TysWiredIn.unitTy
   let entity = createTestbenchEntity bndr
   -- testbench has no outputs and no inputs.
   bndr <- mkInternalVar "testbench" TysWiredIn.unitTy
   let entity = createTestbenchEntity bndr

-  modA tsEntities (Map.insert bndr entity)
+  MonadState.modify tsEntities (Map.insert bndr entity)

   arch <- createTestbenchArch mCycles stimuli' top entity
   arch <- createTestbenchArch mCycles stimuli' top entity

-  modA tsArchitectures (Map.insert bndr arch)
+  MonadState.modify tsArchitectures (Map.insert bndr arch)

   return bndr
 
 createTestbenchEntity :: 
   return bndr
 
 createTestbenchEntity :: 

diff --git a/cλash/CLasH/VHDL/VHDLTools.hs b/cλash/CLasH/VHDL/VHDLTools.hs
index 546fc124ffd216b7e105340b64172fcc423e895d..db3e13acdf200bd199d2f9d49b617722baf3f18d 100644 (file)
--- a/cλash/CLasH/VHDL/VHDLTools.hs
+++ b/cλash/CLasH/VHDL/VHDLTools.hs
@@ -11,8 +11,7 @@ import qualified Control.Monad as Monad
 import qualified Control.Arrow as Arrow
 import qualified Control.Monad.Trans.State as State
 import qualified Data.Monoid as Monoid
 import qualified Control.Arrow as Arrow
 import qualified Control.Monad.Trans.State as State
 import qualified Data.Monoid as Monoid

-import Data.Accessor
-import Data.Accessor.MonadState as MonadState
+import Data.Accessor.Monad.Trans.State as MonadState

 import Debug.Trace
 
 -- ForSyDe
 import Debug.Trace
 
 -- ForSyDe


@@ -193,7 +192,7 @@ altconToVHDLExpr DEFAULT = error "\nVHDL.conToVHDLExpr: DEFAULT alternative shou
 -- Turn a datacon (without arguments!) into a VHDL expression.
 dataconToVHDLExpr :: DataCon.DataCon -> TypeSession AST.Expr
 dataconToVHDLExpr dc = do
 -- Turn a datacon (without arguments!) into a VHDL expression.
 dataconToVHDLExpr :: DataCon.DataCon -> TypeSession AST.Expr
 dataconToVHDLExpr dc = do

-  typemap <- getA tsTypes
+  typemap <- MonadState.get tsTypes

   htype_either <- mkHTypeEither (DataCon.dataConRepType dc)
   case htype_either of
     -- No errors
   htype_either <- mkHTypeEither (DataCon.dataConRepType dc)
   case htype_either of
     -- No errors


@@ -331,7 +330,7 @@ mkHTypeEither' ty | ty_has_free_tyvars ty = return $ Left $ "\nVHDLTools.mkHType
                   | otherwise = do
   case Type.splitTyConApp_maybe ty of
     Just (tycon, args) -> do
                   | otherwise = do
   case Type.splitTyConApp_maybe ty of
     Just (tycon, args) -> do

-      typemap <- getA tsTypes
+      typemap <- MonadState.get tsTypes

       let name = Name.getOccString (TyCon.tyConName tycon)
       let builtinTyMaybe = Map.lookup (BuiltinType name) typemap  
       case builtinTyMaybe of
       let name = Name.getOccString (TyCon.tyConName tycon)
       let builtinTyMaybe = Map.lookup (BuiltinType name) typemap  
       case builtinTyMaybe of


@@ -406,7 +405,7 @@ vhdlTy msg ty = do
 
 vhdlTyMaybe :: HType -> TypeSession (Maybe AST.TypeMark)
 vhdlTyMaybe htype = do
 
 vhdlTyMaybe :: HType -> TypeSession (Maybe AST.TypeMark)
 vhdlTyMaybe htype = do

-  typemap <- getA tsTypes
+  typemap <- MonadState.get tsTypes

   -- If not a builtin type, try the custom types
   let existing_ty = Map.lookup htype typemap
   case existing_ty of
   -- If not a builtin type, try the custom types
   let existing_ty = Map.lookup htype typemap
   case existing_ty of


@@ -416,10 +415,10 @@ vhdlTyMaybe htype = do
     -- No type yet, try to construct it
     Nothing -> do
       newty <- (construct_vhdl_ty htype)
     -- No type yet, try to construct it
     Nothing -> do
       newty <- (construct_vhdl_ty htype)

-      modA tsTypes (Map.insert htype newty)
+      MonadState.modify tsTypes (Map.insert htype newty)

       case newty of
         Just (ty_id, ty_def) -> do
       case newty of
         Just (ty_id, ty_def) -> do

-          modA tsTypeDecls (\typedefs -> typedefs ++ [mktydecl (ty_id, ty_def)])
+          MonadState.modify tsTypeDecls (\typedefs -> typedefs ++ [mktydecl (ty_id, ty_def)])

           return $ Just ty_id
         Nothing -> return Nothing
 
           return $ Just ty_id
         Nothing -> return Nothing
 


@@ -452,14 +451,14 @@ mkTyconTy htype =
           let ty_id = mkVHDLExtId $ tycon ++ elem_names
           let ty_def = AST.TDR $ AST.RecordTypeDef elems
           let tupshow = mkTupleShow elem_tys ty_id
           let ty_id = mkVHDLExtId $ tycon ++ elem_names
           let ty_def = AST.TDR $ AST.RecordTypeDef elems
           let tupshow = mkTupleShow elem_tys ty_id

-          modA tsTypeFuns $ Map.insert (htype, showIdString) (showId, tupshow)
+          MonadState.modify tsTypeFuns $ Map.insert (htype, showIdString) (showId, tupshow)

           return $ Just (ty_id, Just $ Left ty_def)
     (EnumType tycon dcs) -> do
       let elems = map mkVHDLExtId dcs
       let ty_id = mkVHDLExtId tycon
       let ty_def = AST.TDE $ AST.EnumTypeDef elems
       let enumShow = mkEnumShow elems ty_id
           return $ Just (ty_id, Just $ Left ty_def)
     (EnumType tycon dcs) -> do
       let elems = map mkVHDLExtId dcs
       let ty_id = mkVHDLExtId tycon
       let ty_def = AST.TDE $ AST.EnumTypeDef elems
       let enumShow = mkEnumShow elems ty_id

-      modA tsTypeFuns $ Map.insert (htype, showIdString) (showId, enumShow)
+      MonadState.modify tsTypeFuns $ Map.insert (htype, showIdString) (showId, enumShow)

       return $ Just (ty_id, Just $ Left ty_def)
     otherwise -> error $ "\nVHDLTools.mkTyconTy: Called for HType that is neiter a AggrType or EnumType: " ++ show htype
   where
       return $ Just (ty_id, Just $ Left ty_def)
     otherwise -> error $ "\nVHDLTools.mkTyconTy: Called for HType that is neiter a AggrType or EnumType: " ++ show htype
   where


@@ -473,7 +472,7 @@ mkVectorTy ::
       -- ^ An error message or The typemark created.
 
 mkVectorTy (VecType len elHType) = do
       -- ^ An error message or The typemark created.
 
 mkVectorTy (VecType len elHType) = do

-  typesMap <- getA tsTypes
+  typesMap <- MonadState.get tsTypes

   elTyTmMaybe <- vhdlTyMaybe elHType
   case elTyTmMaybe of
     (Just elTyTm) -> do
   elTyTmMaybe <- vhdlTyMaybe elHType
   case elTyTmMaybe of
     (Just elTyTm) -> do


@@ -487,10 +486,10 @@ mkVectorTy (VecType len elHType) = do
         Nothing -> do
           let vec_id  = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId elTyTm)
           let vec_def = AST.TDA $ AST.UnconsArrayDef [tfvec_indexTM] elTyTm
         Nothing -> do
           let vec_id  = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId elTyTm)
           let vec_def = AST.TDA $ AST.UnconsArrayDef [tfvec_indexTM] elTyTm

-          modA tsTypes (Map.insert (UVecType elHType) (Just (vec_id, (Just $ Left vec_def))))
-          modA tsTypeDecls (\typedefs -> typedefs ++ [mktydecl (vec_id, (Just $ Left vec_def))])
+          MonadState.modify tsTypes (Map.insert (UVecType elHType) (Just (vec_id, (Just $ Left vec_def))))
+          MonadState.modify tsTypeDecls (\typedefs -> typedefs ++ [mktydecl (vec_id, (Just $ Left vec_def))])

           let vecShowFuns = mkVectorShow elTyTm vec_id
           let vecShowFuns = mkVectorShow elTyTm vec_id

-          mapM_ (\(id, subprog) -> modA tsTypeFuns $ Map.insert (UVecType elHType, id) ((mkVHDLExtId id), subprog)) vecShowFuns
+          mapM_ (\(id, subprog) -> MonadState.modify tsTypeFuns $ Map.insert (UVecType elHType, id) ((mkVHDLExtId id), subprog)) vecShowFuns

           let ty_def = AST.SubtypeIn vec_id (Just range)
           return (Just (ty_id, Just $ Right ty_def))
     Nothing -> return Nothing
           let ty_def = AST.SubtypeIn vec_id (Just range)
           return (Just (ty_id, Just $ Right ty_def))
     Nothing -> return Nothing


@@ -534,7 +533,7 @@ getFieldLabels ty = do
   let error_msg = "\nVHDLTools.getFieldLabels: Can not get field labels, because: " ++ pprString ty ++ "can not be generated." 
   vhdlTy error_msg ty
   -- Get the types map, lookup and unpack the VHDL TypeDef
   let error_msg = "\nVHDLTools.getFieldLabels: Can not get field labels, because: " ++ pprString ty ++ "can not be generated." 
   vhdlTy error_msg ty
   -- Get the types map, lookup and unpack the VHDL TypeDef

-  types <- getA tsTypes
+  types <- MonadState.get tsTypes

   -- Assume the type for which we want labels is really translatable
   htype <- mkHType error_msg ty
   case Map.lookup htype types of
   -- Assume the type for which we want labels is really translatable
   htype <- mkHType error_msg ty
   case Map.lookup htype types of


@@ -549,7 +548,7 @@ mktydecl (ty_id, Just (Right ty_def)) = Just $ AST.PDISD $ AST.SubtypeDec ty_id
 
 tfp_to_int :: Type.Type -> TypeSession Int
 tfp_to_int ty = do
 
 tfp_to_int :: Type.Type -> TypeSession Int
 tfp_to_int ty = do

-  hscenv <- getA tsHscEnv
+  hscenv <- MonadState.get tsHscEnv

   let norm_ty = normalise_tfp_int hscenv ty
   case Type.splitTyConApp_maybe norm_ty of
     Just (tycon, args) -> do
   let norm_ty = normalise_tfp_int hscenv ty
   case Type.splitTyConApp_maybe norm_ty of
     Just (tycon, args) -> do


@@ -559,21 +558,21 @@ tfp_to_int ty = do
           len <- tfp_to_int' ty
           return len
         otherwise -> do
           len <- tfp_to_int' ty
           return len
         otherwise -> do

-          modA tsTfpInts (Map.insert (OrdType norm_ty) (-1))
+          MonadState.modify tsTfpInts (Map.insert (OrdType norm_ty) (-1))

           return $ error ("Callin tfp_to_int on non-dec:" ++ (show ty))
     Nothing -> return $ error ("Callin tfp_to_int on non-dec:" ++ (show ty))
 
 tfp_to_int' :: Type.Type -> TypeSession Int
 tfp_to_int' ty = do
           return $ error ("Callin tfp_to_int on non-dec:" ++ (show ty))
     Nothing -> return $ error ("Callin tfp_to_int on non-dec:" ++ (show ty))
 
 tfp_to_int' :: Type.Type -> TypeSession Int
 tfp_to_int' ty = do

-  lens <- getA tsTfpInts
-  hscenv <- getA tsHscEnv
+  lens <- MonadState.get tsTfpInts
+  hscenv <- MonadState.get tsHscEnv

   let norm_ty = normalise_tfp_int hscenv ty
   let existing_len = Map.lookup (OrdType norm_ty) lens
   case existing_len of
     Just len -> return len
     Nothing -> do
       let new_len = eval_tfp_int hscenv ty
   let norm_ty = normalise_tfp_int hscenv ty
   let existing_len = Map.lookup (OrdType norm_ty) lens
   case existing_len of
     Just len -> return len
     Nothing -> do
       let new_len = eval_tfp_int hscenv ty

-      modA tsTfpInts (Map.insert (OrdType norm_ty) (new_len))
+      MonadState.modify tsTfpInts (Map.insert (OrdType norm_ty) (new_len))

       return new_len
       
 mkTupleShow :: 
       return new_len
       
 mkTupleShow :: 

diff --git a/cλash/clash.cabal b/cλash/clash.cabal
index 1797f28e596e17abeafdb997e471810621b65b33..6a262e8b029f2760d4f56d4925fcb3a97d59848e 100644 (file)
--- a/cλash/clash.cabal
+++ b/cλash/clash.cabal
@@ -20,7 +20,8 @@ Library
   build-depends:    ghc >= 6.11, pretty, vhdl > 0.1, haskell98, syb,
                     data-accessor, containers, base >= 4, transformers,
                     filepath, template-haskell, data-accessor-template,
   build-depends:    ghc >= 6.11, pretty, vhdl > 0.1, haskell98, syb,
                     data-accessor, containers, base >= 4, transformers,
                     filepath, template-haskell, data-accessor-template,

-                    prettyclass, directory, th-lift-ng, tfp, tfvec
+                    data-accessor-transformers, prettyclass, directory, 
+                    th-lift-ng, tfp, tfvec

                     
   exposed-modules:  CLasH.HardwareTypes
                     CLasH.Translator
                     
   exposed-modules:  CLasH.HardwareTypes
                     CLasH.Translator