Merge remote-tracking branch 'origin/master' into tc-untouchables
authorSimon Peyton Jones <simonpj@microsoft.com>
Mon, 17 Sep 2012 12:09:22 +0000 (13:09 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Mon, 17 Sep 2012 12:09:22 +0000 (13:09 +0100)
Conflicts:
compiler/typecheck/TcMType.lhs
compiler/typecheck/TcSMonad.lhs

1  2 
compiler/typecheck/TcMType.lhs
compiler/typecheck/TcSMonad.lhs
compiler/typecheck/TcUnify.lhs
compiler/types/Type.lhs

@@@ -618,17 -593,17 +618,20 @@@ skolemiseSigTv t
  
  \begin{code}
  zonkImplication :: Implication -> TcM Implication
 -zonkImplication implic@(Implic { ic_skols  = skols
 -                               , ic_given = given 
 +zonkImplication implic@(Implic { ic_untch  = untch
 +                               , ic_binds  = binds_var
++                               , ic_skols  = skols
 +                               , ic_given  = given
                                 , ic_wanted = wanted
                                 , ic_loc = loc })
-   = do {    -- No need to zonk the skolems
+   = do { skols'  <- mapM zonkTcTyVarBndr skols  -- Need to zonk their kinds!
+                                                 -- as Trac #7230 showed
         ; given'  <- mapM zonkEvVar given
         ; loc'    <- zonkGivenLoc loc
 -       ; wanted' <- zonkWC wanted
 +       ; wanted' <- zonkWCRec binds_var untch wanted
-        ; return (implic { ic_given = given'
+        ; return (implic { ic_skols = skols'
+                         , ic_given = given'
 +                        , ic_fsks  = []  -- Zonking removes all FlatSkol tyvars
                          , ic_wanted = wanted'
                          , ic_loc = loc' }) }
  
@@@ -1453,25 -1497,29 +1467,18 @@@ xCtFlavor :: CtEvidence              -
            -> [TcPredType]          -- New predicate types
            -> XEvTerm               -- Instructions about how to manipulate evidence
            -> TcS [CtEvidence]
 -xCtFlavor = xCtFlavor_cache True          
 -
 -xCtFlavor_cache :: Bool            -- True = if wanted add to the solved bag!    
 -          -> CtEvidence            -- Original flavor   
 -          -> [TcPredType]          -- New predicate types
 -          -> XEvTerm               -- Instructions about how to manipulate evidence
 -          -> TcS [CtEvidence]
  
 -xCtFlavor_cache _ (Given { ctev_gloc = gl, ctev_evtm = tm }) ptys xev
 +xCtFlavor (CtGiven { ctev_gloc = gl, ctev_evtm = tm }) ptys xev
    = ASSERT( equalLength ptys (ev_decomp xev tm) )
      zipWithM (newGivenEvVar gl) ptys (ev_decomp xev tm)
-     -- For Givens we make new EvVars and bind them immediately. We don't worry
-     -- about caching, but we don't expect complicated calculations among Givens.
-     -- It is important to bind each given:
-     --       class (a~b) => C a b where ....
-     --       f :: C a b => ....
-     -- Then in f's Givens we have g:(C a b) and the superclass sc(g,0):a~b.
-     -- But that superclass selector can't (yet) appear in a coercion
-     -- (see evTermCoercion), so the easy thing is to bind it to an Id
+     -- See Note [Bind new Givens immediately]
    
 -xCtFlavor_cache cache ctev@(Wanted { ctev_wloc = wl, ctev_evar = evar }) ptys xev
 +xCtFlavor ctev@(CtWanted { ctev_wloc = wl, ctev_evar = evar }) ptys xev
    = do { new_evars <- mapM (newWantedEvVar wl) ptys
         ; setEvBind evar (ev_comp xev (getEvTerms new_evars))
 -
 -           -- Add the now-solved wanted constraint to the cache
 -       ; when cache $ addToSolved ctev
 -
         ; return (freshGoals new_evars) }
      
 -xCtFlavor_cache _ (Derived { ctev_wloc = wl }) ptys _xev
 +xCtFlavor (CtDerived { ctev_wloc = wl }) ptys _xev
    = do { ders <- mapM (newDerived wl) ptys
         ; return (catMaybes ders) }
  
@@@ -1506,12 -1553,22 +1513,13 @@@ Main purpose: create new evidence for n
  -- If derived, don't even look at the coercion
  -- NB: this allows us to sneak away with ``error'' thunks for 
  -- coercions that come from derived ids (which don't exist!) 
 -rewriteCtFlavor_cache _cache (Derived { ctev_wloc = wl }) pty_new _co
 +
 +rewriteCtFlavor (CtDerived { ctev_wloc = wl }) pty_new _co
    = newDerived wl pty_new
          
 -rewriteCtFlavor_cache _cache (Given { ctev_gloc = gl, ctev_evtm = old_tm }) pty_new co
 +rewriteCtFlavor (CtGiven { ctev_gloc = gl, ctev_evtm = old_tm }) pty_new co
-   = return (Just (CtGiven { ctev_gloc = gl, ctev_pred = pty_new, ctev_evtm = new_tm }))
+   = do { new_ev <- newGivenEvVar gl pty_new new_tm  -- See Note [Bind new Givens immediately]
+        ; return (Just new_ev) }
    where
      new_tm = mkEvCast old_tm (mkTcSymCo co)  -- mkEvCase optimises ReflCo
    
Simple merge
Simple merge