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 Data.Accessor.MonadState as MonadState
+import Data.Accessor.Monad.Trans.State as MonadState
 
 -- 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 Data.Accessor
+import Data.Accessor.Monad.Trans.State
 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 Data.Accessor
+import qualified Data.Accessor.Monad.Trans.State as MonadState
 
 -- GHC API
 import qualified GHC
@@ -109,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:

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
+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
@@ -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
-  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
-      modA accessor (Map.insert key value)
+      MonadState.modify accessor (Map.insert key value)
       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
-import Data.Accessor.MonadState as MonadState
+import Data.Accessor.Monad.Trans.State as MonadState
 
 -- GHC API
 import CoreSyn
@@ -22,16 +22,14 @@ import qualified VarSet
 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
-  us <- getA tsUniqSupply 
+  us <- MonadState.get tsUniqSupply 
   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

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 Data.Accessor.MonadState as MonadState
+import Data.Accessor.Monad.Trans.State as MonadState
 import Debug.Trace
 
 -- ForSyDe
@@ -82,9 +82,9 @@ createTypesPackage ::
   -- ^ 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)
-  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)

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 Data.Accessor
-import Data.Accessor.MonadState as MonadState
+import Data.Accessor.Monad.Trans.State as MonadState
 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
-      count <- getA tsEntityCounter 
+      count <- MonadState.get tsEntityCounter 
       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
@@ -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
-  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
@@ -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
-  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)
@@ -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)
-  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
@@ -1102,7 +1101,7 @@ vectorFunId el_ty fname = 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

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 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
@@ -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
-  modA tsEntities (Map.insert bndr entity)
+  MonadState.modify tsEntities (Map.insert bndr entity)
   arch <- createTestbenchArch mCycles stimuli' top entity
-  modA tsArchitectures (Map.insert bndr arch)
+  MonadState.modify tsArchitectures (Map.insert bndr arch)
   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 Data.Accessor
-import Data.Accessor.MonadState as MonadState
+import Data.Accessor.Monad.Trans.State as MonadState
 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
-  typemap <- getA tsTypes
+  typemap <- MonadState.get tsTypes
   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
-      typemap <- getA tsTypes
+      typemap <- MonadState.get tsTypes
       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
-  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
@@ -416,10 +415,10 @@ vhdlTyMaybe htype = do
     -- 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
-          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
 
@@ -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
-          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
-      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
@@ -473,7 +472,7 @@ mkVectorTy ::
       -- ^ 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
@@ -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
-          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
-          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
@@ -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
-  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
@@ -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
-  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
@@ -559,21 +558,21 @@ tfp_to_int ty = 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
-  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
-      modA tsTfpInts (Map.insert (OrdType norm_ty) (new_len))
+      MonadState.modify tsTfpInts (Map.insert (OrdType norm_ty) (new_len))
       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,
-                    prettyclass, directory, th-lift-ng, tfp, tfvec
+                    data-accessor-transformers, prettyclass, directory, 
+                    th-lift-ng, tfp, tfvec
                     
   exposed-modules:  CLasH.HardwareTypes
                     CLasH.Translator