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 _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
