[commit: ghc] ghc-8.4: Move zonkWC to the right place in simplfyInfer (e6c1474)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.4
Link       : http://ghc.haskell.org/trac/ghc/changeset/e6c147442fbeb161bbed209126186056f371d60c/ghc

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

commit e6c147442fbeb161bbed209126186056f371d60c
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Jan 31 11:35:33 2018 +0000

    Move zonkWC to the right place in simplfyInfer
    
    runTcSWithEvBinds does some unification, so the zonkWC
    must be after, not before!  Yikes.  An outright bug.
    
    This fixes Trac #14715.
    
    (cherry picked from commit e7c3878dacbad8120aacbe4423857b5ca9b43eb4)


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

e6c147442fbeb161bbed209126186056f371d60c
 compiler/typecheck/TcSimplify.hs                      |  5 ++---
 testsuite/tests/partial-sigs/should_compile/T14715.hs | 19 +++++++++++++++++++
 .../should_compile/T14715.stderr}                     |  0
 testsuite/tests/partial-sigs/should_compile/all.T     |  1 +
 4 files changed, 22 insertions(+), 3 deletions(-)

diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs
index 7985746..970ebaf 100644
--- a/compiler/typecheck/TcSimplify.hs
+++ b/compiler/typecheck/TcSimplify.hs
@@ -648,9 +648,7 @@ simplifyInfer rhs_tclvl infer_mode sigs name_taus wanteds
                         psig_givens = mkGivens loc psig_theta_vars
                   ; _ <- solveSimpleGivens psig_givens
                          -- See Note [Add signature contexts as givens]
-                  ; wanteds' <- solveWanteds wanteds
-                  ; TcS.zonkWC wanteds' }
-
+                  ; solveWanteds wanteds }
 
        -- Find quant_pred_candidates, the predicates that
        -- we'll consider quantifying over
@@ -658,6 +656,7 @@ simplifyInfer rhs_tclvl infer_mode sigs name_taus wanteds
        --      the psig_theta; it's just the extra bit
        -- NB2: We do not do any defaulting when inferring a type, this can lead
        --      to less polymorphic types, see Note [Default while Inferring]
+       ; wanted_transformed_incl_derivs <- TcM.zonkWC wanted_transformed_incl_derivs
        ; let definite_error = insolubleWC wanted_transformed_incl_derivs
                               -- See Note [Quantification with errors]
                               -- NB: must include derived errors in this test,
diff --git a/testsuite/tests/partial-sigs/should_compile/T14715.hs b/testsuite/tests/partial-sigs/should_compile/T14715.hs
new file mode 100644
index 0000000..1a902ac
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_compile/T14715.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+module T14715 (bench_mulPublic) where
+
+data Cyc r
+data CT zp r'q
+class Reduce a b
+type family LiftOf b
+
+bench_mulPublic :: forall z zp zq . (z ~ LiftOf zq, _) => Cyc zp -> Cyc z -> IO (zp,zq)
+bench_mulPublic pt sk = do
+  ct :: CT zp (Cyc zq) <- encrypt sk pt
+  undefined ct
+
+encrypt :: forall z zp zq. Reduce z zq => Cyc z -> Cyc zp -> IO (CT zp (Cyc zq))
+encrypt = undefined
diff --git a/testsuite/tests/deSugar/should_run/T5472.stdout b/testsuite/tests/partial-sigs/should_compile/T14715.stderr
similarity index 100%
copy from testsuite/tests/deSugar/should_run/T5472.stdout
copy to testsuite/tests/partial-sigs/should_compile/T14715.stderr
diff --git a/testsuite/tests/partial-sigs/should_compile/all.T b/testsuite/tests/partial-sigs/should_compile/all.T
index d13af5c..ebf6338 100644
--- a/testsuite/tests/partial-sigs/should_compile/all.T
+++ b/testsuite/tests/partial-sigs/should_compile/all.T
@@ -73,4 +73,5 @@ test('T13482', normal, compile, [''])
 test('T14217', normal, compile_fail, [''])
 test('T14643', normal, compile, [''])
 test('T14643a', normal, compile, [''])
+test('T14715', normal, compile, [''])