Rename Untouchables to TcLevel
authorSimon Peyton Jones <simonpj@microsoft.com>
Tue, 2 Dec 2014 11:13:56 +0000 (11:13 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Tue, 2 Dec 2014 13:28:26 +0000 (13:28 +0000)
This is a long-overdue renaming
   Untouchables  -->   TcLevel
It is renaming only; no change in functionality.

We really wanted to get this done before the 7.10 fork.

15 files changed:
compiler/typecheck/TcBinds.lhs
compiler/typecheck/TcCanonical.lhs
compiler/typecheck/TcErrors.lhs
compiler/typecheck/TcFlatten.lhs
compiler/typecheck/TcInteract.lhs
compiler/typecheck/TcMType.lhs
compiler/typecheck/TcPatSyn.lhs
compiler/typecheck/TcRnDriver.lhs
compiler/typecheck/TcRnMonad.lhs
compiler/typecheck/TcRnTypes.lhs
compiler/typecheck/TcRules.lhs
compiler/typecheck/TcSMonad.lhs
compiler/typecheck/TcSimplify.lhs
compiler/typecheck/TcType.lhs
compiler/typecheck/TcUnify.lhs

index f1a6463..05fed32 100644 (file)
@@ -606,15 +606,15 @@ tcPolyInfer
   -> [LHsBind Name]
   -> TcM (LHsBinds TcId, [TcId], TopLevelFlag)
 tcPolyInfer rec_tc prag_fn tc_sig_fn mono closed bind_list
-  = do { (((binds', mono_infos), untch), wanted)
+  = do { (((binds', mono_infos), tclvl), wanted)
              <- captureConstraints  $
-                captureUntouchables $
+                captureTcLevel      $
                 tcMonoBinds rec_tc tc_sig_fn LetLclBndr bind_list
 
        ; let name_taus = [(name, idType mono_id) | (name, _, mono_id) <- mono_infos]
        ; traceTc "simplifyInfer call" (ppr name_taus $$ ppr wanted)
        ; (qtvs, givens, mr_bites, ev_binds)
-                 <- simplifyInfer untch mono name_taus wanted
+                 <- simplifyInfer tclvl mono name_taus wanted
 
        ; inferred_theta  <- zonkTcThetaType (map evVarPred givens)
        ; exports <- checkNoErrs $ mapM (mkExport prag_fn qtvs inferred_theta)
@@ -1375,7 +1375,7 @@ tcTySig (L _ (IdSig id))
        ; return ([sig], []) }
 tcTySig (L loc (TypeSig names@(L _ name1 : _) hs_ty wcs))
   = setSrcSpan loc $
-    pushUntouchablesM $
+    pushTcLevelM   $
     do { nwc_tvs <- mapM newWildcardVarMetaKind wcs      -- Generate fresh meta vars for the wildcards
        ; sigma_ty <- tcExtendTyVarEnv nwc_tvs $ tcHsSigType (FunSigCtxt name1) hs_ty
        ; sigs <- mapM (instTcTySig hs_ty sigma_ty (extra_cts hs_ty) (zip wcs nwc_tvs))
index 6488c61..f6d9d20 100644 (file)
@@ -805,8 +805,8 @@ canEqTyVarTyVar ev swapped tv1 tv2 co2
       -- If tv1 is touchable, swap only if tv2 is also
       -- touchable and it's strictly better to update the latter
       -- But see Note [Avoid unnecessary swaps]
-      | Just lvl1 <- metaTyVarUntouchables_maybe tv1
-      = case metaTyVarUntouchables_maybe tv2 of
+      | Just lvl1 <- metaTyVarTcLevel_maybe tv1
+      = case metaTyVarTcLevel_maybe tv2 of
           Nothing   -> False
           Just lvl2 | lvl2 `strictlyDeeperThan` lvl1 -> True
                     | lvl1 `strictlyDeeperThan` lvl2 -> False
index 5c2e5fc..c8406df 100644 (file)
@@ -793,7 +793,7 @@ mkTyVarEqErr dflags ctxt extra ct oriented tv1 ty2
   | (implic:_) <- cec_encl ctxt   -- Get the innermost context
   , Implic { ic_env = env, ic_given = given, ic_info = skol_info } <- implic
   = do { let msg = misMatchMsg oriented ty1 ty2
-             untch_extra
+             tclvl_extra
                 = nest 2 $
                   sep [ quotes (ppr tv1) <+> ptext (sLit "is untouchable")
                       , nest 2 $ ptext (sLit "inside the constraints") <+> pprEvVarTheta given
@@ -801,7 +801,7 @@ mkTyVarEqErr dflags ctxt extra ct oriented tv1 ty2
                       , nest 2 $ ptext (sLit "at") <+> ppr (tcl_loc env) ]
              tv_extra = extraTyVarInfo ctxt tv1 ty2
              add_sig  = suggestAddSig ctxt ty1 ty2
-       ; mkErrorMsg ctxt ct (vcat [msg, untch_extra, tv_extra, add_sig, extra]) }
+       ; mkErrorMsg ctxt ct (vcat [msg, tclvl_extra, tv_extra, add_sig, extra]) }
 
   | otherwise
   = reportEqErr ctxt extra ct oriented (mkTyVarTy tv1) ty2
index ac68ec9..8c20752 100644 (file)
@@ -1055,7 +1055,7 @@ We must solve both!
 unflatten :: Cts -> Cts -> TcS Cts
 unflatten tv_eqs funeqs
  = do { dflags   <- getDynFlags
-      ; untch    <- getUntouchables
+      ; tclvl    <- getTcLevel
 
       ; traceTcS "Unflattening" $ braces $
         vcat [ ptext (sLit "Funeqs =") <+> pprCts funeqs
@@ -1067,7 +1067,7 @@ unflatten tv_eqs funeqs
       ; traceTcS "Unflattening 1" $ braces (pprCts funeqs)
 
           -- Step 2: unify the irreds, if possible
-      ; tv_eqs  <- foldrBagM (unflatten_eq dflags untch) emptyCts tv_eqs
+      ; tv_eqs  <- foldrBagM (unflatten_eq dflags tclvl) emptyCts tv_eqs
       ; traceTcS "Unflattening 2" $ braces (pprCts tv_eqs)
 
           -- Step 3: fill any remaining fmvs with fresh unification variables
@@ -1102,12 +1102,12 @@ unflatten tv_eqs funeqs
     finalise_funeq ct = pprPanic "finalise_funeq" (ppr ct)
 
     ----------------
-    unflatten_eq ::  DynFlags -> Untouchables -> Ct -> Cts -> TcS Cts
-    unflatten_eq dflags untch ct@(CTyEqCan { cc_ev = ev, cc_tyvar = tv, cc_rhs = rhs }) rest
+    unflatten_eq ::  DynFlags -> TcLevel -> Ct -> Cts -> TcS Cts
+    unflatten_eq dflags tclvl ct@(CTyEqCan { cc_ev = ev, cc_tyvar = tv, cc_rhs = rhs }) rest
       | isFmvTyVar tv
       = do { lhs_elim <- tryFill dflags tv rhs ev
            ; if lhs_elim then return rest else
-        do { rhs_elim <- try_fill dflags untch ev rhs (mkTyVarTy tv)
+        do { rhs_elim <- try_fill dflags tclvl ev rhs (mkTyVarTy tv)
            ; if rhs_elim then return rest else
              return (ct `consCts` rest) } }
 
@@ -1133,9 +1133,9 @@ unflatten tv_eqs funeqs
     finalise_eq ct _ = pprPanic "finalise_irred" (ppr ct)
 
     ----------------
-    try_fill dflags untch ev ty1 ty2
+    try_fill dflags tclvl ev ty1 ty2
       | Just tv1 <- tcGetTyVar_maybe ty1
-      , isTouchableOrFmv untch tv1
+      , isTouchableOrFmv tclvl tv1
       , typeKind ty1 `isSubKind` tyVarKind tv1
       = tryFill dflags tv1 ty2 ev
       | otherwise
index 0febaf3..bfe470d 100644 (file)
@@ -829,8 +829,8 @@ interactTyVarEq inerts workItem@(CTyEqCan { cc_tyvar = tv, cc_rhs = rhs , cc_ev
        ; stopWith ev "Solved from inert (r)" }
 
   | otherwise
-  = do { untch <- getUntouchables
-       ; if canSolveByUnification untch ev tv rhs
+  = do { tclvl <- getTcLevel
+       ; if canSolveByUnification tclvl ev tv rhs
          then do { solveByUnification ev tv rhs
                  ; n_kicked <- kickOutRewritable givenFlavour tv
                                -- givenFlavour because the tv := xi is given
@@ -839,10 +839,10 @@ interactTyVarEq inerts workItem@(CTyEqCan { cc_tyvar = tv, cc_rhs = rhs , cc_ev
          else do { traceTcS "Can't solve tyvar equality"
                        (vcat [ text "LHS:" <+> ppr tv <+> dcolon <+> ppr (tyVarKind tv)
                              , ppWhen (isMetaTyVar tv) $
-                               nest 4 (text "Untouchable level of" <+> ppr tv
-                                       <+> text "is" <+> ppr (metaTyVarUntouchables tv))
+                               nest 4 (text "TcLevel of" <+> ppr tv
+                                       <+> text "is" <+> ppr (metaTyVarTcLevel tv))
                              , text "RHS:" <+> ppr rhs <+> dcolon <+> ppr (typeKind rhs)
-                             , text "Untouchables =" <+> ppr untch ])
+                             , text "TcLevel =" <+> ppr tclvl ])
                  ; n_kicked <- kickOutRewritable ev tv
                  ; updInertCans (\ ics -> addInertCan ics workItem)
                  ; return (Stop ev (ptext (sLit "Kept as inert") <+> ppr_kicked n_kicked)) } }
@@ -852,12 +852,12 @@ interactTyVarEq _ wi = pprPanic "interactTyVarEq" (ppr wi)
 -- @trySpontaneousSolve wi@ solves equalities where one side is a
 -- touchable unification variable.
 -- Returns True <=> spontaneous solve happened
-canSolveByUnification :: Untouchables -> CtEvidence -> TcTyVar -> Xi -> Bool
-canSolveByUnification untch gw tv xi
+canSolveByUnification :: TcLevel -> CtEvidence -> TcTyVar -> Xi -> Bool
+canSolveByUnification tclvl gw tv xi
   | isGiven gw   -- See Note [Touchables and givens]
   = False
 
-  | isTouchableMetaTyVar untch tv
+  | isTouchableMetaTyVar tclvl tv
   = case metaTyVarInfo tv of
       SigTv -> is_tyvar xi
       _     -> True
@@ -1993,10 +1993,10 @@ matchClassInst _ clas [ _k, ty1, ty2 ] loc
 
 matchClassInst inerts clas tys loc
    = do { dflags <- getDynFlags
-        ; untch <- getUntouchables
+        ; tclvl <- getTcLevel
         ; traceTcS "matchClassInst" $ vcat [ text "pred =" <+> ppr pred
                                            , text "inerts=" <+> ppr inerts
-                                           , text "untouchables=" <+> ppr untch ]
+                                           , text "untouchables=" <+> ppr tclvl ]
         ; instEnvs <- getInstEnvs
         ; case lookupInstEnv instEnvs clas tys of
             ([], _, _)               -- Nothing matches
@@ -2006,7 +2006,7 @@ matchClassInst inerts clas tys loc
 
             ([(ispec, inst_tys)], [], _) -- A single match
                 | not (xopt Opt_IncoherentInstances dflags)
-                , given_overlap untch
+                , given_overlap tclvl
                 -> -- See Note [Instance and Given overlap]
                    do { traceTcS "Delaying instance application" $
                           vcat [ text "Workitem=" <+> pprType (mkClassPred clas tys)
@@ -2051,14 +2051,14 @@ matchClassInst inerts clas tys loc
      givens_for_this_clas
          = filterBag isGivenCt (findDictsByClass (inert_dicts $ inert_cans inerts) clas)
 
-     given_overlap :: Untouchables -> Bool
-     given_overlap untch = anyBag (matchable untch) givens_for_this_clas
+     given_overlap :: TcLevel -> Bool
+     given_overlap tclvl = anyBag (matchable tclvl) givens_for_this_clas
 
-     matchable untch (CDictCan { cc_class = clas_g, cc_tyargs = sys
+     matchable tclvl (CDictCan { cc_class = clas_g, cc_tyargs = sys
                                , cc_ev = fl })
        | isGiven fl
        = ASSERT( clas_g == clas )
-         case tcUnifyTys (\tv -> if isTouchableMetaTyVar untch tv &&
+         case tcUnifyTys (\tv -> if isTouchableMetaTyVar tclvl tv &&
                                     tv `elemVarSet` tyVarsOfTypes tys
                                  then BindMe else Skolem) tys sys of
        -- We can't learn anything more about any variable at this point, so the only
index dfe9f21..c7f1418 100644 (file)
@@ -343,8 +343,8 @@ newSigTyVar name kind
 newMetaDetails :: MetaInfo -> TcM TcTyVarDetails
 newMetaDetails info
   = do { ref <- newMutVar Flexi
-       ; untch <- getUntouchables
-       ; return (MetaTv { mtv_info = info, mtv_ref = ref, mtv_untch = untch }) }
+       ; tclvl <- getTcLevel
+       ; return (MetaTv { mtv_info = info, mtv_ref = ref, mtv_tclvl = tclvl }) }
 
 cloneMetaTyVar :: TcTyVar -> TcM TcTyVar
 cloneMetaTyVar tv
index c9a5ba8..16824de 100644 (file)
@@ -66,9 +66,9 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L loc name), psb_args = details,
        ; let (arg_names, is_infix) = case details of
                  PrefixPatSyn names      -> (map unLoc names, False)
                  InfixPatSyn name1 name2 -> (map unLoc [name1, name2], True)
-       ; (((lpat', (args, pat_ty)), untch), wanted)
-            <- captureConstraints       $
-               captureUntouchables      $
+       ; (((lpat', (args, pat_ty)), tclvl), wanted)
+            <- captureConstraints  $
+               captureTcLevel      $
                do { pat_ty <- newFlexiTyVarTy openTypeKind
                   ; tcPat PatSyn lpat pat_ty $
                do { args <- mapM tcLookupId arg_names
@@ -76,7 +76,7 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L loc name), psb_args = details,
 
        ; let named_taus = (name, pat_ty) : map (\arg -> (getName arg, varType arg)) args
 
-       ; (qtvs, req_dicts, _mr_bites, ev_binds) <- simplifyInfer untch False named_taus wanted
+       ; (qtvs, req_dicts, _mr_bites, ev_binds) <- simplifyInfer tclvl False named_taus wanted
 
        ; (ex_vars, prov_dicts) <- tcCollectEx lpat'
        ; let univ_tvs   = filter (not . (`elemVarSet` ex_vars)) qtvs
index 6d91d26..901f8f1 100644 (file)
@@ -1760,12 +1760,12 @@ tcRnExpr hsc_env rdr_expr
         -- it might have a rank-2 type (e.g. :t runST)
     uniq <- newUnique ;
     let { fresh_it  = itName uniq (getLoc rdr_expr) } ;
-    (((_tc_expr, res_ty), untch), lie) <- captureConstraints  $
-                                          captureUntouchables $
+    (((_tc_expr, res_ty), tclvl), lie) <- captureConstraints $
+                                          captureTcLevel     $
                                           tcInferRho rn_expr ;
     ((qtvs, dicts, _, _), lie_top) <- captureConstraints $
                                       {-# SCC "simplifyInfer" #-}
-                                      simplifyInfer untch
+                                      simplifyInfer tclvl
                                                     False {- No MR for now -}
                                                     [(fresh_it, res_ty)]
                                                     lie ;
index 15a6ba7..c27ce98 100644 (file)
@@ -179,7 +179,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this
                 tcl_tidy       = emptyTidyEnv,
                 tcl_tyvars     = tvs_var,
                 tcl_lie        = lie_var,
-                tcl_untch      = noUntouchables
+                tcl_tclvl      = topTcLevel
              } ;
         } ;
 
@@ -1156,33 +1156,33 @@ captureConstraints thing_inside
          lie <- readTcRef lie_var ;
          return (res, lie) }
 
-captureUntouchables :: TcM a -> TcM (a, Untouchables)
-captureUntouchables thing_inside
+captureTcLevel :: TcM a -> TcM (a, TcLevel)
+captureTcLevel thing_inside
   = do { env <- getLclEnv
-       ; let untch' = pushUntouchables (tcl_untch env)
-       ; res <- setLclEnv (env { tcl_untch = untch' })
+       ; let tclvl' = pushTcLevel (tcl_tclvl env)
+       ; res <- setLclEnv (env { tcl_tclvl = tclvl' })
                 thing_inside
-       ; return (res, untch') }
+       ; return (res, tclvl') }
 
-pushUntouchablesM :: TcM a -> TcM a
-pushUntouchablesM thing_inside
+pushTcLevelM :: TcM a -> TcM a
+pushTcLevelM thing_inside
   = do { env <- getLclEnv
-       ; let untch' = pushUntouchables (tcl_untch env)
-       ; setLclEnv (env { tcl_untch = untch' })
+       ; let tclvl' = pushTcLevel (tcl_tclvl env)
+       ; setLclEnv (env { tcl_tclvl = tclvl' })
                    thing_inside }
 
-getUntouchables :: TcM Untouchables
-getUntouchables = do { env <- getLclEnv
-                     ; return (tcl_untch env) }
+getTcLevel :: TcM TcLevel
+getTcLevel = do { env <- getLclEnv
+                     ; return (tcl_tclvl env) }
 
-setUntouchables :: Untouchables -> TcM a -> TcM a
-setUntouchables untch thing_inside 
-  = updLclEnv (\env -> env { tcl_untch = untch }) thing_inside
+setTcLevel :: TcLevel -> TcM a -> TcM a
+setTcLevel tclvl thing_inside 
+  = updLclEnv (\env -> env { tcl_tclvl = tclvl }) thing_inside
 
 isTouchableTcM :: TcTyVar -> TcM Bool
 isTouchableTcM tv
   = do { env <- getLclEnv
-       ; return (isTouchableMetaTyVar (tcl_untch env) tv) }
+       ; return (isTouchableMetaTyVar (tcl_tclvl env) tv) }
 
 getLclTypeEnv :: TcM TcTypeEnv
 getLclTypeEnv = do { env <- getLclEnv; return (tcl_env env) }
index cf8b56c..bbbdd48 100644 (file)
@@ -541,7 +541,7 @@ data TcLclEnv           -- Changes as we move inside an expression
   = TcLclEnv {
         tcl_loc        :: SrcSpan,         -- Source span
         tcl_ctxt       :: [ErrCtxt],       -- Error context, innermost on top
-        tcl_untch      :: Untouchables,    -- Birthplace for new unification variables
+        tcl_tclvl      :: TcLevel,    -- Birthplace for new unification variables
 
         tcl_th_ctxt    :: ThStage,         -- Template Haskell context
         tcl_th_bndrs   :: ThBindEnv,       -- Binding level of in-scope Names
@@ -1392,7 +1392,7 @@ ppr_bag doc bag
 \begin{code}
 data Implication
   = Implic {
-      ic_untch :: Untouchables, -- Untouchables: unification variables
+      ic_tclvl :: TcLevel, -- TcLevel: unification variables
                                 -- free in the environment
 
       ic_skols  :: [TcTyVar],    -- Introduced skolems
@@ -1418,12 +1418,12 @@ data Implication
     }
 
 instance Outputable Implication where
-  ppr (Implic { ic_untch = untch, ic_skols = skols
+  ppr (Implic { ic_tclvl = tclvl, ic_skols = skols
               , ic_given = given, ic_no_eqs = no_eqs
               , ic_wanted = wanted, ic_insol = insol
               , ic_binds = binds, ic_info = info })
    = hang (ptext (sLit "Implic") <+> lbrace)
-        2 (sep [ ptext (sLit "Untouchables =") <+> ppr untch
+        2 (sep [ ptext (sLit "TcLevel =") <+> ppr tclvl
                , ptext (sLit "Skolems =") <+> pprTvBndrs skols
                , ptext (sLit "No-eqs =") <+> ppr no_eqs
                , ptext (sLit "Insol =") <+> ppr insol
@@ -1711,12 +1711,12 @@ data CtLoc = CtLoc { ctl_origin :: CtOrigin
   --    source location:  tcl_loc   :: SrcSpan
   --    context:          tcl_ctxt  :: [ErrCtxt]
   --    binder stack:     tcl_bndrs :: [TcIdBinders]
-  --    level:            tcl_untch :: Untouchables
+  --    level:            tcl_tclvl :: TcLevel
 
-mkGivenLoc :: Untouchables -> SkolemInfo -> TcLclEnv -> CtLoc
-mkGivenLoc untch skol_info env 
+mkGivenLoc :: TcLevel -> SkolemInfo -> TcLclEnv -> CtLoc
+mkGivenLoc tclvl skol_info env 
   = CtLoc { ctl_origin = GivenOrigin skol_info
-          , ctl_env    = env { tcl_untch = untch }
+          , ctl_env    = env { tcl_tclvl = tclvl }
           , ctl_depth  = initialSubGoalDepth }
 
 ctLocEnv :: CtLoc -> TcLclEnv
index dc150c5..b5d8b5b 100644 (file)
@@ -167,7 +167,7 @@ tcRule (HsRule name act hs_bndrs lhs fv_lhs rhs fv_rhs)
            -- Simplify the RHS constraints
        ; lcl_env <- getLclEnv
        ; rhs_binds_var <- newTcEvBinds
-       ; emitImplication $ Implic { ic_untch  = noUntouchables
+       ; emitImplication $ Implic { ic_tclvl  = topTcLevel
                                   , ic_skols  = qtkvs
                                   , ic_no_eqs = False
                                   , ic_given  = lhs_evs
@@ -181,7 +181,7 @@ tcRule (HsRule name act hs_bndrs lhs fv_lhs rhs fv_rhs)
            -- (a) so that we report insoluble ones
            -- (b) so that we bind any soluble ones
        ; lhs_binds_var <- newTcEvBinds
-       ; emitImplication $ Implic { ic_untch  = noUntouchables
+       ; emitImplication $ Implic { ic_tclvl  = topTcLevel
                                   , ic_skols  = qtkvs
                                   , ic_no_eqs = False
                                   , ic_given  = lhs_evs
index 0699122..752bc45 100644 (file)
@@ -58,7 +58,7 @@ module TcSMonad (
     setWantedTyBind, reportUnifications,
 
     getInstEnvs, getFamInstEnvs,                -- Getting the environments
-    getTopEnv, getGblEnv, getTcEvBinds, getUntouchables,
+    getTopEnv, getGblEnv, getTcEvBinds, getTcLevel,
     getTcEvBindsMap, 
 
     lookupFlatCache, newFlattenSkolem,            -- Flatten skolems
@@ -87,7 +87,7 @@ module TcSMonad (
     newFlexiTcSTy, instFlexiTcS, instFlexiTcSHelperTcS,
     cloneMetaTyVar, demoteUnfilledFmv,
 
-    Untouchables, isTouchableMetaTyVarTcS,
+    TcLevel, isTouchableMetaTyVarTcS,
     isFilledMetaTyVar_maybe, isFilledMetaTyVar,
     zonkTyVarsAndFV, zonkTcType, zonkTcTyVar, zonkFlats,
 
@@ -610,11 +610,11 @@ getUnsolvedInerts
 
     is_unsolved ct = not (isGivenCt ct)   -- Wanted or Derived
 
-getNoGivenEqs :: Untouchables     -- Untouchables of this implication
+getNoGivenEqs :: TcLevel     -- TcLevel of this implication
                -> [TcTyVar]       -- Skolems of this implication
                -> TcS Bool        -- True <=> definitely no residual given equalities
 -- See Note [When does an implication have given equalities?]
-getNoGivenEqs untch skol_tvs
+getNoGivenEqs tclvl skol_tvs
   = do { inerts@(IC { inert_eqs = ieqs, inert_irreds = iirreds, inert_funeqs = funeqs })
              <- getInertCans
        ; let local_fsks = foldFunEqs add_fsk funeqs emptyVarSet
@@ -636,7 +636,7 @@ getNoGivenEqs untch skol_tvs
     -- i.e. the current level
     ev_given_here ev
       =  isGiven ev
-      && untch == tcl_untch (ctl_env (ctEvLoc ev))
+      && tclvl == tcl_tclvl (ctl_env (ctEvLoc ev))
 
     add_fsk :: Ct -> VarSet -> VarSet
     add_fsk ct fsks | CFunEqCan { cc_fsk = tv, cc_ev = ev } <- ct
@@ -666,8 +666,8 @@ any equalities among them, the calculation of has_given_eqs.  There
 are some wrinkles:
 
  * We must know which ones are bound in *this* implication and which
-   are bound further out.  We can find that out from the Untouchable
-   level of the Given, which is itself recorded in the tcl_untch field
+   are bound further out.  We can find that out from the TcLevel
+   of the Given, which is itself recorded in the tcl_tclvl field
    of the TcLclEnv stored in the Given (ev_given_here).
 
    What about interactions between inner and outer givens?
@@ -1086,8 +1086,8 @@ traceFireTcS :: CtEvidence -> SDoc -> TcS ()
 traceFireTcS ev doc
   = TcS $ \env -> csTraceTcM 1 $
     do { n <- TcM.readTcRef (tcs_count env)
-       ; untch <- TcM.getUntouchables
-       ; return (hang (int n <> brackets (ptext (sLit "U:") <> ppr untch 
+       ; tclvl <- TcM.getTcLevel
+       ; return (hang (int n <> brackets (ptext (sLit "U:") <> ppr tclvl 
                                           <> ppr (ctLocDepth (ctEvLoc ev))) 
                        <+> doc <> colon)
                      4 (ppr ev)) } 
@@ -1160,8 +1160,8 @@ checkForCyclicBinds ev_binds
     edges = [(bind, bndr, varSetElems (evVarsOfTerm rhs)) | bind@(EvBind bndr rhs) <- bagToList ev_binds]
 #endif
 
-nestImplicTcS :: EvBindsVar -> Untouchables -> TcS a -> TcS a
-nestImplicTcS ref inner_untch (TcS thing_inside)
+nestImplicTcS :: EvBindsVar -> TcLevel -> TcS a -> TcS a
+nestImplicTcS ref inner_tclvl (TcS thing_inside)
   = TcS $ \ TcSEnv { tcs_unified = unified_var
                    , tcs_inerts = old_inert_var
                    , tcs_count = count } ->
@@ -1175,7 +1175,7 @@ nestImplicTcS ref inner_untch (TcS thing_inside)
                                , tcs_count       = count
                                , tcs_inerts      = new_inert_var
                                , tcs_worklist    = new_wl_var }
-       ; res <- TcM.setUntouchables inner_untch $
+       ; res <- TcM.setTcLevel inner_tclvl $
                 thing_inside nest_env
 
 #ifdef DEBUG
@@ -1307,8 +1307,8 @@ emitInsoluble ct
 getTcEvBinds :: TcS EvBindsVar
 getTcEvBinds = TcS (return . tcs_ev_binds)
 
-getUntouchables :: TcS Untouchables
-getUntouchables = wrapTcS TcM.getUntouchables
+getTcLevel :: TcS TcLevel
+getTcLevel = wrapTcS TcM.getTcLevel
 \end{code}
 
 \begin{code}
@@ -1385,8 +1385,8 @@ pprEq ty1 ty2 = pprParendType ty1 <+> char '~' <+> pprParendType ty2
 
 isTouchableMetaTyVarTcS :: TcTyVar -> TcS Bool
 isTouchableMetaTyVarTcS tv
-  = do { untch <- getUntouchables
-       ; return $ isTouchableMetaTyVar untch tv }
+  = do { tclvl <- getTcLevel
+       ; return $ isTouchableMetaTyVar tclvl tv }
 
 isFilledMetaTyVar_maybe :: TcTyVar -> TcS (Maybe Type)
 isFilledMetaTyVar_maybe tv
@@ -1489,7 +1489,7 @@ newFlattenSkolem ctxt_ev fam_ty
                     ; ref  <- TcM.newMutVar Flexi
                     ; let details = MetaTv { mtv_info  = FlatMetaTv
                                            , mtv_ref   = ref
-                                           , mtv_untch = fskUntouchables }
+                                           , mtv_tclvl = fskTcLevel }
                           name = TcM.mkTcTyVarName uniq (fsLit "s")
                     ; return (mkTcTyVar name (typeKind fam_ty) details) }
        ; ev <- newWantedEvVarNC loc (mkTcEqPred fam_ty (mkTyVarTy fuv))
@@ -1983,11 +1983,11 @@ deferTcSForAllEq role loc (tvs1,body1) (tvs2,body2)
                          ; let ev_binds = TcEvBinds ev_binds_var
                                new_ct = mkNonCanonical ctev
                                new_co = ctEvCoercion ctev
-                               new_untch = pushUntouchables (tcl_untch env)
+                               new_tclvl = pushTcLevel (tcl_tclvl env)
                          ; let wc = WC { wc_flat  = singleCt new_ct
                                        , wc_impl  = emptyBag
                                        , wc_insol = emptyCts }
-                               imp = Implic { ic_untch  = new_untch
+                               imp = Implic { ic_tclvl  = new_tclvl
                                             , ic_skols  = skol_tvs
                                             , ic_no_eqs = True
                                             , ic_given  = []
index ede529b..90924e7 100644 (file)
@@ -246,19 +246,19 @@ Consider
 To infer f's type we do the following:
  * Gather the constraints for the RHS with ambient level *one more than*
    the current one.  This is done by the call
-        captureConstraints (captureUntouchables (tcMonoBinds...))
+        captureConstraints (captureTcLevel (tcMonoBinds...))
    in TcBinds.tcPolyInfer
 
  * Call simplifyInfer to simplify the constraints and decide what to
    quantify over. We pass in the level used for the RHS constraints,
-   here called rhs_untch.
+   here called rhs_tclvl.
 
 This ensures that the implication constraint we generate, if any,
 has a strictly-increased level compared to the ambient level outside
 the let binding.
 
 \begin{code}
-simplifyInfer :: Untouchables          -- Used when generating the constraints
+simplifyInfer :: TcLevel          -- Used when generating the constraints
               -> Bool                  -- Apply monomorphism restriction
               -> [(Name, TcTauType)]   -- Variables to be generalised,
                                        -- and their tau-types
@@ -269,7 +269,7 @@ simplifyInfer :: Untouchables          -- Used when generating the constraints
                                     --   so the results type is not as general as
                                     --   it could be
                       TcEvBinds)    -- ... binding these evidence variables
-simplifyInfer rhs_untch apply_mr name_taus wanteds
+simplifyInfer rhs_tclvl apply_mr name_taus wanteds
   | isEmptyWC wanteds
   = do { gbl_tvs <- tcGetGlobalTyVars
        ; qtkvs <- quantifyTyVars gbl_tvs (tyVarsOfTypes (map snd name_taus))
@@ -279,7 +279,7 @@ simplifyInfer rhs_untch apply_mr name_taus wanteds
   | otherwise
   = do { traceTc "simplifyInfer {"  $ vcat
              [ ptext (sLit "binds =") <+> ppr name_taus
-             , ptext (sLit "rhs_untch =") <+> ppr rhs_untch
+             , ptext (sLit "rhs_tclvl =") <+> ppr rhs_tclvl
              , ptext (sLit "apply_mr =") <+> ppr apply_mr
              , ptext (sLit "(unzonked) wanted =") <+> ppr wanteds
              ]
@@ -300,7 +300,7 @@ simplifyInfer rhs_untch apply_mr name_taus wanteds
               -- constraint.
 
        ; ev_binds_var <- TcM.newTcEvBinds
-       ; wanted_transformed_incl_derivs <- setUntouchables rhs_untch $
+       ; wanted_transformed_incl_derivs <- setTcLevel rhs_tclvl $
                                            runTcSWithEvBinds ev_binds_var (solveWanteds wanteds)
        ; wanted_transformed_incl_derivs <- zonkWC wanted_transformed_incl_derivs
 
@@ -331,9 +331,9 @@ simplifyInfer rhs_untch apply_mr name_taus wanteds
 
 
                       ; WC { wc_flat = flats }
-                           <- setUntouchables rhs_untch           $
+                           <- setTcLevel rhs_tclvl                $
                               runTcSWithEvBinds null_ev_binds_var $
-                              do { mapM_ (promoteAndDefaultTyVar rhs_untch gbl_tvs) meta_tvs
+                              do { mapM_ (promoteAndDefaultTyVar rhs_tclvl gbl_tvs) meta_tvs
                                      -- See Note [Promote _and_ default when inferring]
                                  ; solveFlatWanteds quant_cand }
 
@@ -348,9 +348,9 @@ simplifyInfer rhs_untch apply_mr name_taus wanteds
        ; let zonked_tau_tvs = tyVarsOfTypes zonked_taus
        ; (promote_tvs, qtvs, bound, mr_bites) <- decideQuantification apply_mr quant_pred_candidates zonked_tau_tvs
 
-       ; outer_untch <- TcRnMonad.getUntouchables
+       ; outer_tclvl <- TcRnMonad.getTcLevel
        ; runTcSWithEvBinds null_ev_binds_var $  -- runTcS just to get the types right :-(
-         mapM_ (promoteTyVar outer_untch) (varSetElems promote_tvs)
+         mapM_ (promoteTyVar outer_tclvl) (varSetElems promote_tvs)
 
        ; let minimal_flat_preds = mkMinimalBySCs bound
                   -- See Note [Minimize by Superclasses]
@@ -361,7 +361,7 @@ simplifyInfer rhs_untch apply_mr name_taus wanteds
                         -- tidied uniformly
 
        ; minimal_bound_ev_vars <- mapM TcM.newEvVar minimal_flat_preds
-       ; let implic = Implic { ic_untch    = rhs_untch
+       ; let implic = Implic { ic_tclvl    = rhs_tclvl
                              , ic_skols    = qtvs
                              , ic_no_eqs   = False
                              , ic_given    = minimal_bound_ev_vars
@@ -641,7 +641,7 @@ simplifyRule :: RuleName
 -- See Note [Simplifying RULE constraints] in TcRule
 simplifyRule name lhs_wanted rhs_wanted
   = do {         -- We allow ourselves to unify environment
-                 -- variables: runTcS runs with NoUntouchables
+                 -- variables: runTcS runs with topTcLevel
          (resid_wanted, _) <- solveWantedsTcM (lhs_wanted `andWC` rhs_wanted)
                               -- Post: these are zonked and unflattened
 
@@ -861,7 +861,7 @@ solveImplication :: Implication    -- Wanted
                          Bag Implication) -- Unsolved rest (always empty or singleton)
 -- Precondition: The TcS monad contains an empty worklist and given-only inerts
 -- which after trying to solve this implication we must restore to their original value
-solveImplication imp@(Implic { ic_untch  = untch
+solveImplication imp@(Implic { ic_tclvl  = tclvl
                              , ic_binds  = ev_binds
                              , ic_skols  = skols
                              , ic_given  = givens
@@ -873,15 +873,15 @@ solveImplication imp@(Implic { ic_untch  = untch
 
          -- Solve the nested constraints
        ; (no_given_eqs, residual_wanted)
-             <- nestImplicTcS ev_binds untch $
-               do { solveFlatGivens (mkGivenLoc untch info env) givens
+             <- nestImplicTcS ev_binds tclvl $
+               do { solveFlatGivens (mkGivenLoc tclvl info env) givens
 
                   ; residual_wanted <- solveWanteds wanteds
                         -- solveWanteds, *not* solveWantedsAndDrop, because
                         -- we want to retain derived equalities so we can float
                         -- them out in floatEqualities
 
-                  ; no_eqs <- getNoGivenEqs untch skols
+                  ; no_eqs <- getNoGivenEqs tclvl skols
 
                   ; return (no_eqs, residual_wanted) }
 
@@ -947,25 +947,25 @@ Consider floated_eqs (all wanted or derived):
     simpl_loop.  So we iterate if there any of these
 
 \begin{code}
-promoteTyVar :: Untouchables -> TcTyVar  -> TcS ()
+promoteTyVar :: TcLevel -> TcTyVar  -> TcS ()
 -- When we float a constraint out of an implication we must restore
--- invariant (MetaTvInv) in Note [Untouchable type variables] in TcType
+-- invariant (MetaTvInv) in Note [TcLevel and untouchable type variables] in TcType
 -- See Note [Promoting unification variables]
-promoteTyVar untch tv
-  | isFloatedTouchableMetaTyVar untch tv
+promoteTyVar tclvl tv
+  | isFloatedTouchableMetaTyVar tclvl tv
   = do { cloned_tv <- TcS.cloneMetaTyVar tv
-       ; let rhs_tv = setMetaTyVarUntouchables cloned_tv untch
+       ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl
        ; setWantedTyBind tv (mkTyVarTy rhs_tv) }
   | otherwise
   = return ()
 
-promoteAndDefaultTyVar :: Untouchables -> TcTyVarSet -> TyVar -> TcS ()
+promoteAndDefaultTyVar :: TcLevel -> TcTyVarSet -> TyVar -> TcS ()
 -- See Note [Promote _and_ default when inferring]
-promoteAndDefaultTyVar untch gbl_tvs tv
+promoteAndDefaultTyVar tclvl gbl_tvs tv
   = do { tv1 <- if tv `elemVarSet` gbl_tvs
                 then return tv
                 else defaultTyVar tv
-       ; promoteTyVar untch tv1 }
+       ; promoteTyVar tclvl tv1 }
 
 defaultTyVar :: TcTyVar -> TcS TcTyVar
 -- Precondition: MetaTyVars only
@@ -979,7 +979,7 @@ defaultTyVar the_tv
        ; return new_tv }
              -- Why not directly derived_pred = mkTcEqPred k default_k?
              -- See Note [DefaultTyVar]
-             -- We keep the same Untouchables on tv'
+             -- We keep the same TcLevel on tv'
 
   | otherwise = return the_tv    -- The common case
 
@@ -1094,7 +1094,7 @@ approximateWC to produce a list of candidate constraints.  Then we MUST
 
   a) Promote any meta-tyvars that have been floated out by
      approximateWC, to restore invariant (MetaTvInv) described in
-     Note [Untouchable type variables] in TcType.
+     Note [TcLevel and untouchable type variables] in TcType.
 
   b) Default the kind of any meta-tyyvars that are not mentioned in
      in the environment.
@@ -1110,7 +1110,7 @@ Note [Promoting unification variables]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 When we float an equality out of an implication we must "promote" free
 unification variables of the equality, in order to maintain Invariant
-(MetaTvInv) from Note [Untouchable type variables] in TcType.  for the
+(MetaTvInv) from Note [TcLevel and untouchable type variables] in TcType.  for the
 leftover implication.
 
 This is absolutely necessary. Consider the following example. We start
@@ -1247,8 +1247,8 @@ floatEqualities skols no_given_eqs wanteds@(WC { wc_flat = flats })
   | not no_given_eqs  -- There are some given equalities, so don't float
   = return (emptyBag, wanteds)   -- Note [Float Equalities out of Implications]
   | otherwise
-  = do { outer_untch <- TcS.getUntouchables
-       ; mapM_ (promoteTyVar outer_untch) (varSetElems (tyVarsOfCts float_eqs))
+  = do { outer_tclvl <- TcS.getTcLevel
+       ; mapM_ (promoteTyVar outer_tclvl) (varSetElems (tyVarsOfCts float_eqs))
              -- See Note [Promoting unification variables]
        ; traceTcS "floatEqualities" (vcat [ text "Skols =" <+> ppr skols
                                           , text "Flats =" <+> ppr flats
@@ -1433,8 +1433,8 @@ disambigGroup (default_ty:default_tys) group
   = do { traceTcS "disambigGroup {" (ppr group $$ ppr default_ty)
        ; fake_ev_binds_var <- TcS.newTcEvBinds
        ; given_ev_var      <- TcS.newEvVar (mkTcEqPred (mkTyVarTy the_tv) default_ty)
-       ; untch             <- TcS.getUntouchables
-       ; success <- nestImplicTcS fake_ev_binds_var (pushUntouchables untch) $
+       ; tclvl             <- TcS.getTcLevel
+       ; success <- nestImplicTcS fake_ev_binds_var (pushTcLevel tclvl) $
                     do { solveFlatGivens loc [given_ev_var]
                        ; residual_wanted <- solveFlatWanteds wanteds
                        ; return (isEmptyWC residual_wanted) }
index 1d3ee40..3d38e42 100644 (file)
@@ -23,9 +23,9 @@ module TcType (
   TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType,
   TcTyVar, TcTyVarSet, TcKind, TcCoVar,
 
-  -- Untouchables
-  Untouchables(..), noUntouchables, pushUntouchables, 
-  strictlyDeeperThan, sameDepthAs, fskUntouchables,
+  -- TcLevel
+  TcLevel(..), topTcLevel, pushTcLevel,
+  strictlyDeeperThan, sameDepthAs, fskTcLevel,
 
   --------------------------------
   -- MetaDetails
@@ -38,7 +38,7 @@ module TcType (
   isAmbiguousTyVar, metaTvRef, metaTyVarInfo,
   isFlexi, isIndirect, isRuntimeUnkSkol,
   isTypeVar, isKindVar,
-  metaTyVarUntouchables, setMetaTyVarUntouchables, metaTyVarUntouchables_maybe,
+  metaTyVarTcLevel, setMetaTyVarTcLevel, metaTyVarTcLevel_maybe,
   isTouchableMetaTyVar, isTouchableOrFmv,
   isFloatedTouchableMetaTyVar,
   canUnifyWithPolyType,
@@ -323,7 +323,7 @@ data TcTyVarDetails
 
   | MetaTv { mtv_info  :: MetaInfo
            , mtv_ref   :: IORef MetaDetails
-           , mtv_untch :: Untouchables }  -- See Note [Untouchable type variables]
+           , mtv_tclvl :: TcLevel }  -- See Note [TcLevel and untouchable type variables]
 
 vanillaSkolemTv, superSkolemTv :: TcTyVarDetails
 -- See Note [Binding when looking up instances] in InstEnv
@@ -414,11 +414,16 @@ data UserTypeCtxt
 %*                                                                      *
 %************************************************************************
 
-Note [Untouchable type variables]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+\begin{code}
+newtype TcLevel = TcLevel Int deriving( Eq )
+  -- See Note [TcLevel and untouchable type variables] for what this Int is
+\end{code}
+
+Note [TcLevel and untouchable type variables]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 * Each unification variable (MetaTv)
   and each Implication
-  has a level number (of type Untouchables)
+  has a level number (of type TcLevel)
 
 * INVARIANTS.  In a tree of Implications,
 
@@ -435,7 +440,7 @@ Note [Untouchable type variables]
 * INVARIANT
     (GivenInv)  The free variables of the ic_given of an
                 implication are all untouchable; ie their level
-                numbers are LESS THAN the ic_untch of the implication
+                numbers are LESS THAN the ic_tclvl of the implication
 
 
 Note [Skolem escape prevention]
@@ -472,35 +477,32 @@ the whole implication disappears but when we pop out again we are left with
 uf will get unified *once more* to (F Int).
 
 \begin{code}
-newtype Untouchables = Untouchables Int deriving( Eq )
-  -- See Note [Untouchable type variables] for what this Int is
-
-fskUntouchables :: Untouchables
-fskUntouchables = Untouchables 0  -- 0 = Outside the outermost level: 
+fskTcLevel :: TcLevel
+fskTcLevel = TcLevel 0  -- 0 = Outside the outermost level: 
                                   --     flatten skolems
 
-noUntouchables :: Untouchables
-noUntouchables = Untouchables 1   -- 1 = outermost level
+topTcLevel :: TcLevel
+topTcLevel = TcLevel 1   -- 1 = outermost level
 
-pushUntouchables :: Untouchables -> Untouchables
-pushUntouchables (Untouchables us) = Untouchables (us+1)
+pushTcLevel :: TcLevel -> TcLevel
+pushTcLevel (TcLevel us) = TcLevel (us+1)
 
-strictlyDeeperThan :: Untouchables -> Untouchables -> Bool
-strictlyDeeperThan (Untouchables tv_untch) (Untouchables ctxt_untch)
-  = tv_untch > ctxt_untch
+strictlyDeeperThan :: TcLevel -> TcLevel -> Bool
+strictlyDeeperThan (TcLevel tv_tclvl) (TcLevel ctxt_tclvl)
+  = tv_tclvl > ctxt_tclvl
 
-sameDepthAs :: Untouchables -> Untouchables -> Bool
-sameDepthAs (Untouchables ctxt_untch) (Untouchables tv_untch)
-  = ctxt_untch == tv_untch   -- NB: invariant ctxt_untch >= tv_untch
+sameDepthAs :: TcLevel -> TcLevel -> Bool
+sameDepthAs (TcLevel ctxt_tclvl) (TcLevel tv_tclvl)
+  = ctxt_tclvl == tv_tclvl   -- NB: invariant ctxt_tclvl >= tv_tclvl
                              --     So <= would be equivalent
 
-checkTouchableInvariant :: Untouchables -> Untouchables -> Bool
--- Checks (MetaTvInv) from Note [Untouchable type variables]
-checkTouchableInvariant (Untouchables ctxt_untch) (Untouchables tv_untch)
-  = ctxt_untch >= tv_untch
+checkTcLevelInvariant :: TcLevel -> TcLevel -> Bool
+-- Checks (MetaTvInv) from Note [TcLevel and untouchable type variables]
+checkTcLevelInvariant (TcLevel ctxt_tclvl) (TcLevel tv_tclvl)
+  = ctxt_tclvl >= tv_tclvl
 
-instance Outputable Untouchables where
-  ppr (Untouchables us) = ppr us
+instance Outputable TcLevel where
+  ppr (TcLevel us) = ppr us
 \end{code}
 
 
@@ -517,8 +519,8 @@ pprTcTyVarDetails (SkolemTv True)  = ptext (sLit "ssk")
 pprTcTyVarDetails (SkolemTv False) = ptext (sLit "sk")
 pprTcTyVarDetails (RuntimeUnk {})  = ptext (sLit "rt")
 pprTcTyVarDetails (FlatSkol {})    = ptext (sLit "fsk")
-pprTcTyVarDetails (MetaTv { mtv_info = info, mtv_untch = untch })
-  = pp_info <> colon <> ppr untch
+pprTcTyVarDetails (MetaTv { mtv_info = info, mtv_tclvl = tclvl })
+  = pp_info <> colon <> ppr tclvl
   where
     pp_info = case info of
                 ReturnTv    -> ptext (sLit "ret")
@@ -647,33 +649,33 @@ exactTyVarsOfTypes = mapUnionVarSet exactTyVarsOfType
 %************************************************************************
 
 \begin{code}
-isTouchableOrFmv :: Untouchables -> TcTyVar -> Bool
-isTouchableOrFmv ctxt_untch tv
+isTouchableOrFmv :: TcLevel -> TcTyVar -> Bool
+isTouchableOrFmv ctxt_tclvl tv
   = ASSERT2( isTcTyVar tv, ppr tv )
     case tcTyVarDetails tv of
-      MetaTv { mtv_untch = tv_untch, mtv_info = info }
-        -> ASSERT2( checkTouchableInvariant ctxt_untch tv_untch,
-                    ppr tv $$ ppr tv_untch $$ ppr ctxt_untch )
+      MetaTv { mtv_tclvl = tv_tclvl, mtv_info = info }
+        -> ASSERT2( checkTcLevelInvariant ctxt_tclvl tv_tclvl,
+                    ppr tv $$ ppr tv_tclvl $$ ppr ctxt_tclvl )
            case info of
              FlatMetaTv -> True
-             _          -> tv_untch `sameDepthAs` ctxt_untch
+             _          -> tv_tclvl `sameDepthAs` ctxt_tclvl
       _          -> False
 
-isTouchableMetaTyVar :: Untouchables -> TcTyVar -> Bool
-isTouchableMetaTyVar ctxt_untch tv
+isTouchableMetaTyVar :: TcLevel -> TcTyVar -> Bool
+isTouchableMetaTyVar ctxt_tclvl tv
   = ASSERT2( isTcTyVar tv, ppr tv )
     case tcTyVarDetails tv of
-      MetaTv { mtv_untch = tv_untch }
-        -> ASSERT2( checkTouchableInvariant ctxt_untch tv_untch,
-                    ppr tv $$ ppr tv_untch $$ ppr ctxt_untch )
-           tv_untch `sameDepthAs` ctxt_untch
+      MetaTv { mtv_tclvl = tv_tclvl }
+        -> ASSERT2( checkTcLevelInvariant ctxt_tclvl tv_tclvl,
+                    ppr tv $$ ppr tv_tclvl $$ ppr ctxt_tclvl )
+           tv_tclvl `sameDepthAs` ctxt_tclvl
       _ -> False
 
-isFloatedTouchableMetaTyVar :: Untouchables -> TcTyVar -> Bool
-isFloatedTouchableMetaTyVar ctxt_untch tv
+isFloatedTouchableMetaTyVar :: TcLevel -> TcTyVar -> Bool
+isFloatedTouchableMetaTyVar ctxt_tclvl tv
   = ASSERT2( isTcTyVar tv, ppr tv )
     case tcTyVarDetails tv of
-      MetaTv { mtv_untch = tv_untch } -> tv_untch `strictlyDeeperThan` ctxt_untch
+      MetaTv { mtv_tclvl = tv_tclvl } -> tv_tclvl `strictlyDeeperThan` ctxt_tclvl
       _ -> False
 
 isImmutableTyVar :: TyVar -> Bool
@@ -756,26 +758,26 @@ metaTyVarInfo tv
       MetaTv { mtv_info = info } -> info
       _ -> pprPanic "metaTyVarInfo" (ppr tv)
 
-metaTyVarUntouchables :: TcTyVar -> Untouchables
-metaTyVarUntouchables tv
+metaTyVarTcLevel :: TcTyVar -> TcLevel
+metaTyVarTcLevel tv
   = ASSERT( isTcTyVar tv )
     case tcTyVarDetails tv of
-      MetaTv { mtv_untch = untch } -> untch
-      _ -> pprPanic "metaTyVarUntouchables" (ppr tv)
+      MetaTv { mtv_tclvl = tclvl } -> tclvl
+      _ -> pprPanic "metaTyVarTcLevel" (ppr tv)
 
-metaTyVarUntouchables_maybe :: TcTyVar -> Maybe Untouchables
-metaTyVarUntouchables_maybe tv
+metaTyVarTcLevel_maybe :: TcTyVar -> Maybe TcLevel
+metaTyVarTcLevel_maybe tv
   = ASSERT( isTcTyVar tv )
     case tcTyVarDetails tv of
-      MetaTv { mtv_untch = untch } -> Just untch
+      MetaTv { mtv_tclvl = tclvl } -> Just tclvl
       _                            -> Nothing
 
-setMetaTyVarUntouchables :: TcTyVar -> Untouchables -> TcTyVar
-setMetaTyVarUntouchables tv untch
+setMetaTyVarTcLevel :: TcTyVar -> TcLevel -> TcTyVar
+setMetaTyVarTcLevel tv tclvl
   = ASSERT( isTcTyVar tv )
     case tcTyVarDetails tv of
-      details@(MetaTv {}) -> setTcTyVarDetails tv (details { mtv_untch = untch })
-      _ -> pprPanic "metaTyVarUntouchables" (ppr tv)
+      details@(MetaTv {}) -> setTcTyVarDetails tv (details { mtv_tclvl = tclvl })
+      _ -> pprPanic "metaTyVarTcLevel" (ppr tv)
 
 isSigTyVar :: Var -> Bool
 isSigTyVar tv
index 9e3e68d..4936d59 100644 (file)
@@ -562,8 +562,8 @@ newImplication :: SkolemInfo -> [TcTyVar]
 newImplication skol_info skol_tvs given thing_inside
   = ASSERT2( all isTcTyVar skol_tvs, ppr skol_tvs )
     ASSERT2( all isSkolemTyVar skol_tvs, ppr skol_tvs )
-    do { ((result, untch), wanted) <- captureConstraints  $
-                                      captureUntouchables $
+    do { ((result, tclvl), wanted) <- captureConstraints  $
+                                      captureTcLevel $
                                       thing_inside
 
        ; if isEmptyWC wanted && null given
@@ -576,7 +576,7 @@ newImplication skol_info skol_tvs given thing_inside
          else do
        { ev_binds_var <- newTcEvBinds
        ; env <- getLclEnv
-       ; emitImplication $ Implic { ic_untch = untch
+       ; emitImplication $ Implic { ic_tclvl = tclvl
                                   , ic_skols = skol_tvs
                                   , ic_no_eqs = False
                                   , ic_given = given
@@ -678,9 +678,9 @@ uType_defer origin ty1 ty2
 --------------
 -- unify_np (short for "no push" on the origin stack) does the work
 uType origin orig_ty1 orig_ty2
-  = do { untch <- getUntouchables
+  = do { tclvl <- getTcLevel
        ; traceTc "u_tys " $ vcat
-              [ text "untch" <+> ppr untch
+              [ text "tclvl" <+> ppr tclvl
               , sep [ ppr orig_ty1, text "~", ppr orig_ty2]
               , pprCtOrigin origin]
        ; co <- go orig_ty1 orig_ty2