[commit: ghc] tc-untouchables: Remove historical Unique parameter from pushUntouchables (d4fa711)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : tc-untouchables

http://hackage.haskell.org/trac/ghc/changeset/d4fa71154f19187264e5e88f5c6b272b51617f78

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

commit d4fa71154f19187264e5e88f5c6b272b51617f78
Author: Simon Peyton Jones <[email protected]>
Date:   Mon Sep 3 18:38:27 2012 +0100

    Remove historical Unique parameter from pushUntouchables

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

 compiler/typecheck/TcRnMonad.lhs  |    3 +--
 compiler/typecheck/TcSMonad.lhs   |    3 +--
 compiler/typecheck/TcSimplify.lhs |    3 +--
 compiler/typecheck/TcType.lhs     |   32 ++------------------------------
 4 files changed, 5 insertions(+), 36 deletions(-)

diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index 248b188..62c364a 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -1036,8 +1036,7 @@ captureConstraints thing_inside
 captureUntouchables :: TcM a -> TcM (a, Untouchables)
 captureUntouchables thing_inside
   = do { env <- getLclEnv
-       ; uniq <- newUnique
-       ; let untch' = pushUntouchables uniq (tcl_untch env)
+       ; let untch' = pushUntouchables (tcl_untch env)
        ; res <- setLclEnv (env { tcl_untch = untch' })
                 thing_inside
        ; return (res, untch') }
diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs
index bc386f1..bde2a50 100644
--- a/compiler/typecheck/TcSMonad.lhs
+++ b/compiler/typecheck/TcSMonad.lhs
@@ -1597,14 +1597,13 @@ deferTcSForAllEq (loc,orig_ev) (tvs1,body1) (tvs2,body2)
             skol_info = UnifyForAllSkol skol_tvs phi1
         ; mev <- newWantedEvVar loc (mkTcEqPred phi1 phi2)
         ; untch <- getUntouchables
-        ; uniq  <- wrapTcS TcM.newUnique  -- Clumsy
         ; coe_inside <- case mev of
             Cached ev_tm -> return (evTermCoercion ev_tm)
             Fresh ctev   -> do { ev_binds_var <- wrapTcS $ TcM.newTcEvBinds
                                ; let ev_binds = TcEvBinds ev_binds_var
                                      new_ct = mkNonCanonical ctev
               			     new_co = evTermCoercion (ctEvTerm ctev)
-                                     new_untch = pushUntouchables uniq untch
+                                     new_untch = pushUntouchables untch
                                ; lcl_env <- wrapTcS $ TcM.getLclTypeEnv
                                ; loc <- wrapTcS $ TcM.getCtLoc skol_info
                                ; let wc = WC { wc_flat  = singleCt new_ct 
diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 2075f69..e749570 100644
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -440,8 +440,7 @@ simplifyInfer _top_lvl apply_mr name_taus wanteds
        ; lcl_env <- getLclTypeEnv
        ; gloc <- getCtLoc skol_info
        ; untch <- TcRnMonad.getUntouchables
-       ; uniq  <- TcRnMonad.newUnique
-       ; let implic = Implic { ic_untch    = pushUntouchables uniq untch 
+       ; let implic = Implic { ic_untch    = pushUntouchables untch 
                              , ic_env      = lcl_env
                              , ic_skols    = qtvs_to_return
                              , ic_fsks     = []  -- wanted_tansformed arose only from solveWanteds
diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index f33e2bb..2c07bca 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -324,8 +324,8 @@ newtype Untouchables = Untouchables Int
 noUntouchables :: Untouchables
 noUntouchables = Untouchables 0   -- 0 = outermost level
 
-pushUntouchables :: Unique -> Untouchables -> Untouchables 
-pushUntouchables _ (Untouchables us) = Untouchables (us+1)
+pushUntouchables :: Untouchables -> Untouchables 
+pushUntouchables (Untouchables us) = Untouchables (us+1)
 
 isFloatedTouchable :: Untouchables -> Untouchables -> Bool
 isFloatedTouchable (Untouchables ctxt_untch) (Untouchables tv_untch) 
@@ -343,34 +343,6 @@ checkTouchableInvariant (Untouchables ctxt_untch) (Untouchables tv_untch)
 instance Outputable Untouchables where
   ppr (Untouchables us) = ppr us
 
-{-   OLD
-newtype Untouchables = Untouchables [Unique]
-
-noUntouchables :: Untouchables
-noUntouchables = Untouchables []   -- 0 = outermost level
-
-pushUntouchables :: Unique -> Untouchables -> Untouchables 
-pushUntouchables u (Untouchables us) = Untouchables (u:us)
-
-isFloatedTouchable :: Untouchables -> Untouchables -> Bool
-isFloatedTouchable (Untouchables ctxt_untch) (Untouchables tv_untch) 
-  = case (ctxt_untch, tv_untch) of
-      (_,  [])     -> False
-      ([],  _)     -> True
-      (u:_, tv_u:tv_us) | u `elem` tv_us -> ASSERT2( u /= tv_u, ppr u <+> ppr tv_us ) True
-                        | otherwise      -> False
-
-isTouchable :: Untouchables -> Untouchables -> Bool
-isTouchable (Untouchables ctxt_untch) (Untouchables tv_untch) 
-  = case ctxt_untch of
-      []    -> True
-      (u:_) -> u `elem` tv_untch
-
-instance Outputable Untouchables where
-  ppr (Untouchables us) = pprWithCommas ppr us
--}
-
-
 -----------------------------
 data MetaDetails
   = Flexi  -- Flexi type variables unify to become Indirects