[commit: ghc] master: Stop exporting, and stop using, functions marked as deprecated (51aa2fa)

git at git.haskell.org git at git.haskell.org
Sat Sep 27 11:58:19 UTC 2014


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/51aa2fa3e65a960c1432dba9acc29db719964618/ghc

>---------------------------------------------------------------

commit 51aa2fa3e65a960c1432dba9acc29db719964618
Author: Thomas Miedema <thomasmiedema at gmail.com>
Date:   Sat Sep 27 13:55:48 2014 +0200

    Stop exporting, and stop using, functions marked as deprecated
    
    Don't export `getUs` and `getUniqueUs`. `UniqSM` has a `MonadUnique` instance:
    
        instance MonadUnique UniqSM where
            getUniqueSupplyM = getUs
            getUniqueM  = getUniqueUs
            getUniquesM = getUniquesUs
    
    Commandline-fu used:
    
        git grep -l 'getUs\>' |
            grep -v compiler/basicTypes/UniqSupply.lhs |
            xargs sed -i 's/getUs/getUniqueSupplyM/g
    
        git grep -l 'getUniqueUs\>' |
            grep -v combiler/basicTypes/UniqSupply.lhs |
            xargs sed -i 's/getUniqueUs/getUniqueM/g'
    
    Follow up on b522d3a3f970a043397a0d6556ca555648e7a9c3
    
    Reviewed By: austin, hvr
    
    Differential Revision: https://phabricator.haskell.org/D220


>---------------------------------------------------------------

51aa2fa3e65a960c1432dba9acc29db719964618
 compiler/basicTypes/MkId.lhs               | 2 +-
 compiler/basicTypes/UniqSupply.lhs         | 3 ---
 compiler/cmm/CmmInfo.hs                    | 4 ++--
 compiler/llvmGen/LlvmCodeGen/CodeGen.hs    | 2 +-
 compiler/nativeGen/AsmCodeGen.lhs          | 2 +-
 compiler/nativeGen/PPC/Instr.hs            | 2 +-
 compiler/nativeGen/RegAlloc/Graph/Spill.hs | 2 +-
 compiler/nativeGen/RegAlloc/Linear/Main.hs | 2 +-
 compiler/nativeGen/X86/Instr.hs            | 2 +-
 compiler/simplCore/SAT.lhs                 | 2 +-
 compiler/specialise/SpecConstr.lhs         | 6 +++---
 11 files changed, 13 insertions(+), 16 deletions(-)

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 5a317e2..bf1c199 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -576,7 +576,7 @@ mkDataConRep dflags fam_envs wrap_name data_con
 
 -------------------------
 newLocal :: Type -> UniqSM Var
-newLocal ty = do { uniq <- getUniqueUs
+newLocal ty = do { uniq <- getUniqueM
                  ; return (mkSysLocal (fsLit "dt") uniq ty) }
 
 -------------------------
diff --git a/compiler/basicTypes/UniqSupply.lhs b/compiler/basicTypes/UniqSupply.lhs
index 6ceee20..401d69b 100644
--- a/compiler/basicTypes/UniqSupply.lhs
+++ b/compiler/basicTypes/UniqSupply.lhs
@@ -23,9 +23,6 @@ module UniqSupply (
         -- ** Operations on the monad
         initUs, initUs_,
         lazyThenUs, lazyMapUs,
-
-        -- ** Deprecated operations on 'UniqSM'
-        getUniqueUs, getUs,
   ) where
 
 import Unique
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index 3bfc728..ce8b9f8 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -323,7 +323,7 @@ mkLivenessBits :: DynFlags -> Liveness -> UniqSM (CmmLit, [RawCmmDecl])
 
 mkLivenessBits dflags liveness
   | n_bits > mAX_SMALL_BITMAP_SIZE dflags -- does not fit in one word
-  = do { uniq <- getUniqueUs
+  = do { uniq <- getUniqueM
        ; let bitmap_lbl = mkBitmapLabel uniq
        ; return (CmmLabel bitmap_lbl,
                  [mkRODataLits bitmap_lbl lits]) }
@@ -398,7 +398,7 @@ mkProfLits _ (ProfilingInfo td cd)
 
 newStringLit :: [Word8] -> UniqSM (CmmLit, GenCmmDecl CmmStatics info stmt)
 newStringLit bytes
-  = do { uniq <- getUniqueUs
+  = do { uniq <- getUniqueM
        ; return (mkByteStringCLit uniq bytes) }
 
 
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index a8869d1..6703801 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -1636,7 +1636,7 @@ getHsFunc' name fty
 -- | Create a new local var
 mkLocalVar :: LlvmType -> LlvmM LlvmVar
 mkLocalVar ty = do
-    un <- runUs getUniqueUs
+    un <- runUs getUniqueM
     return $ LMLocalVar un ty
 
 
diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 94d64b1..5b4a517 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -836,7 +836,7 @@ genMachCode
                 , [CLabel])
 
 genMachCode dflags this_mod cmmTopCodeGen cmm_top
-  = do  { initial_us <- getUs
+  = do  { initial_us <- getUniqueSupplyM
         ; let initial_st           = mkNatM_State initial_us 0 dflags this_mod
               (new_tops, final_st) = initNat initial_st (cmmTopCodeGen cmm_top)
               final_delta          = natm_delta final_st
diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs
index 3756c64..f5b9506 100644
--- a/compiler/nativeGen/PPC/Instr.hs
+++ b/compiler/nativeGen/PPC/Instr.hs
@@ -104,7 +104,7 @@ allocMoreStack platform slots (CmmProc info lbl live (ListGraph code)) = do
                         | entry `elem` infos -> infos
                         | otherwise          -> entry : infos
 
-    uniqs <- replicateM (length entries) getUniqueUs
+    uniqs <- replicateM (length entries) getUniqueM
 
     let
         delta = ((x + stackAlign - 1) `quot` stackAlign) * stackAlign -- round up
diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
index 802046c..7267ef8 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
@@ -67,7 +67,7 @@ regSpill platform code slotsFree regs
                                 $ zip (uniqSetToList regs) slots
 
                 -- Grab the unique supply from the monad.
-                us      <- getUs
+                us      <- getUniqueSupplyM
 
                 -- Run the spiller on all the blocks.
                 let (code', state')     =
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index fa47a17..12dc8f0 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -231,7 +231,7 @@ linearRegAlloc'
         -> UniqSM ([NatBasicBlock instr], RegAllocStats, Int)
 
 linearRegAlloc' dflags initFreeRegs entry_ids block_live sccs
- = do   us      <- getUs
+ = do   us      <- getUniqueSupplyM
         let (_, stack, stats, blocks) =
                 runR dflags emptyBlockMap initFreeRegs emptyRegMap (emptyStackMap dflags) us
                     $ linearRA_SCCs entry_ids block_live [] sccs
diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs
index 7d38245..2f61962 100644
--- a/compiler/nativeGen/X86/Instr.hs
+++ b/compiler/nativeGen/X86/Instr.hs
@@ -947,7 +947,7 @@ allocMoreStack _ _ top@(CmmData _ _) = return top
 allocMoreStack platform slots proc@(CmmProc info lbl live (ListGraph code)) = do
     let entries = entryBlocks proc
 
-    uniqs <- replicateM (length entries) getUniqueUs
+    uniqs <- replicateM (length entries) getUniqueM
 
     let
       delta = ((x + stackAlign - 1) `quot` stackAlign) * stackAlign -- round up
diff --git a/compiler/simplCore/SAT.lhs b/compiler/simplCore/SAT.lhs
index a0b3151..f973c35 100644
--- a/compiler/simplCore/SAT.lhs
+++ b/compiler/simplCore/SAT.lhs
@@ -255,7 +255,7 @@ runSAT :: UniqSupply -> SatM a -> a
 runSAT = initUs_
 
 newUnique :: SatM Unique
-newUnique = getUniqueUs
+newUnique = getUniqueM
 \end{code}
 
 
diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index 1e7cbb6..6cc8b04 100644
--- a/compiler/specialise/SpecConstr.lhs
+++ b/compiler/specialise/SpecConstr.lhs
@@ -1584,7 +1584,7 @@ spec_one :: ScEnv
 -}
 
 spec_one env fn arg_bndrs body (call_pat@(qvars, pats), rule_number)
-  = do  { spec_uniq <- getUniqueUs
+  = do  { spec_uniq <- getUniqueM
         ; let spec_env   = extendScSubstList (extendScInScope env qvars)
                                              (arg_bndrs `zip` pats)
               fn_name    = idName fn
@@ -1860,7 +1860,7 @@ argToPat env in_scope val_env (Cast arg co) arg_occ
                 wildCardPat ty2
           else do
         { -- Make a wild-card pattern for the coercion
-          uniq <- getUniqueUs
+          uniq <- getUniqueM
         ; let co_name = mkSysTvName uniq (fsLit "sg")
               co_var  = mkCoVar co_name (mkCoercionType Representational ty1 ty2)
         ; return (interesting, Cast arg' (mkCoVarCo co_var)) } }
@@ -1941,7 +1941,7 @@ argToPat _env _in_scope _val_env arg _arg_occ
 
 wildCardPat :: Type -> UniqSM (Bool, CoreArg)
 wildCardPat ty
-  = do { uniq <- getUniqueUs
+  = do { uniq <- getUniqueM
        ; let id = mkSysLocal (fsLit "sc") uniq ty
        ; return (False, varToCoreExpr id) }
 



More information about the ghc-commits mailing list