Move zonkWC to the right place in simplfyInfer
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 31 Jan 2018 11:35:33 +0000 (11:35 +0000)
committerBen Gamari <ben@smart-cactus.org>
Thu, 1 Feb 2018 03:12:46 +0000 (22:12 -0500)
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)

compiler/typecheck/TcSimplify.hs
testsuite/tests/partial-sigs/should_compile/T14715.hs [new file with mode: 0644]
testsuite/tests/partial-sigs/should_compile/T14715.stderr [new file with mode: 0644]
testsuite/tests/partial-sigs/should_compile/all.T

index 7985746..970ebaf 100644 (file)
@@ -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 (file)
index 0000000..1a902ac
--- /dev/null
@@ -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/partial-sigs/should_compile/T14715.stderr b/testsuite/tests/partial-sigs/should_compile/T14715.stderr
new file mode 100644 (file)
index 0000000..0519ecb
--- /dev/null
@@ -0,0 +1 @@
\ No newline at end of file
index d13af5c..ebf6338 100644 (file)
@@ -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, [''])