[commit: ghc] ghc-7.6: Fix Trac #7453 on the 7.6 branch (b637a24)

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

On branch  : ghc-7.6

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

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

commit b637a24dbb471d99887e5544037a2abe10af26ee
Author: Simon Peyton Jones <[email protected]>
Date:   Mon Dec 3 16:57:30 2012 +0000

    Fix Trac #7453 on the 7.6 branch
    
    This patch fixes a quite egregious bug. runTcS was intialising
    the 'untouchables' to NoUntouchables, which is quite wrong for
    the invocation in TcSimplify.simplifyInfer.  Result: missed
    skolem-escape check and seg-fault city.
    
    All this is done differently, and better, in HEAD, so this
    patch is needed only on the branch.

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

 compiler/typecheck/TcSMonad.lhs |   10 +++++++++-
 1 files changed, 9 insertions(+), 1 deletions(-)

diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs
index eaaa8f6..8adb1d5 100644
--- a/compiler/typecheck/TcSMonad.lhs
+++ b/compiler/typecheck/TcSMonad.lhs
@@ -935,6 +935,15 @@ runTcSWithEvBinds ev_binds_var tcs
        ; inert_var <- TcM.newTcRef is 
        ; wl_var <- TcM.newTcRef wl
 
+       -- The "low end" of the untouchable range should come from the
+       -- ambient tcl_untch; the high end is the highest allocated to
+       -- date. 'untouch' used (in 7.6.1, entirely wrongly) to be
+       -- set to NoUntouchables, causing #7453.
+       -- All this is done much better in 7.8.
+       ; tc_lenv <- TcM.getLclEnv
+       ; tcm_high <- TcM.readTcRef (tcl_meta tc_lenv)
+       ; let untouch = TouchableRange tcm_low tcm_high
+             tcm_low = tcl_untch tc_lenv
        ; let env = TcSEnv { tcs_ev_binds = ev_binds_var
                           , tcs_ty_binds = ty_binds_var
                           , tcs_untch    = (untouch, emptyVarSet) -- No Tcs untouchables yet
@@ -960,7 +969,6 @@ runTcSWithEvBinds ev_binds_var tcs
        ; return res }
   where
     do_unification (tv,ty) = TcM.writeMetaTyVar tv ty
-    untouch = NoUntouchables
     is = emptyInert
     wl = emptyWorkList