Add missing solveEqualities
authorSimon Peyton Jones <simonpj@microsoft.com>
Mon, 25 Apr 2016 15:17:34 +0000 (16:17 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Thu, 28 Apr 2016 16:28:20 +0000 (17:28 +0100)
I'd missed a call to solveEqualities in the partial-type-sig case
of TcBinds.tcUserTypeSig.

Also the checkValidType test done there best done after inference,
in checkInferredPolyId (and is already done there).

Fixes Trac #11976

compiler/typecheck/TcBinds.hs
testsuite/tests/partial-sigs/should_fail/T11976.hs [new file with mode: 0644]
testsuite/tests/partial-sigs/should_fail/T11976.stderr [new file with mode: 0644]
testsuite/tests/partial-sigs/should_fail/all.T

index 1a58719..ac19061 100644 (file)
@@ -1797,8 +1797,9 @@ tcUserTypeSig hs_sig_ty mb_name
            <- pushTcLevelM_  $
                   -- When instantiating the signature, do so "one level in"
                   -- so that they can be unified under the forall
-              tcImplicitTKBndrs vars $
-              tcWildCardBinders wcs  $ \ wcs ->
+              solveEqualities           $
+              tcImplicitTKBndrs vars    $
+              tcWildCardBinders wcs     $ \ wcs ->
               tcExplicitTKBndrs hs_tvs  $ \ tvs2 ->
          do { -- Instantiate the type-class context; but if there
               -- is an extra-constraints wildcard, just discard it here
@@ -1815,20 +1816,14 @@ tcUserTypeSig hs_sig_ty mb_name
             ; theta <- zonkTcTypes theta
             ; tau   <- zonkTcType tau
 
-              -- Check for validity (eg rankN etc)
-              -- The ambiguity check will happen (from checkValidType),
-              -- but unnecessarily; it will always succeed because there
-              -- is no quantification
-            ; checkValidType ctxt_F (mkPhiTy theta tau)
-                -- NB: Do this in the context of the pushTcLevel so that
-                -- the TcLevel invariant is respected
-
             ; let bound_tvs
                     = unionVarSets [ allBoundVariabless theta
                                    , allBoundVariables tau
                                    , mkVarSet (map snd wcs) ]
             ; return ((wcs, tvs2, theta, tau), bound_tvs) }
 
+       -- NB: checkValidType on the final inferred type will
+       --     be done later by checkInferredPolyId
        ; loc <- getSrcSpanM
        ; return $
          TISI { sig_bndr  = PartialSig { sig_name = name, sig_hs_ty = hs_ty
diff --git a/testsuite/tests/partial-sigs/should_fail/T11976.hs b/testsuite/tests/partial-sigs/should_fail/T11976.hs
new file mode 100644 (file)
index 0000000..ce6e904
--- /dev/null
@@ -0,0 +1,7 @@
+{-# LANGUAGE PartialTypeSignatures, RankNTypes #-}
+
+module T11976 where
+
+type Lens s a = forall f. Functor f => (a -> f a) -> (s -> f s)
+
+foo = undefined :: Lens _ _ _
diff --git a/testsuite/tests/partial-sigs/should_fail/T11976.stderr b/testsuite/tests/partial-sigs/should_fail/T11976.stderr
new file mode 100644 (file)
index 0000000..06320d9
--- /dev/null
@@ -0,0 +1,7 @@
+
+T11976.hs:7:20: error:
+    • Expecting one fewer arguments to ‘Lens t0 t1’
+      Expected kind ‘k0 -> *’, but ‘Lens t0 t1’ has kind ‘*’
+    • In the type ‘Lens _ _ _’
+      In the expression: undefined :: Lens _ _ _
+      In an equation for ‘foo’: foo = undefined :: Lens _ _ _
index c62dd9c..a676a02 100644 (file)
@@ -60,3 +60,4 @@ test('T10615', normal, compile_fail, [''])
 test('T10045', normal, compile_fail, [''])
 test('T10999', normal, compile_fail, [''])
 test('T11122', normal, compile, [''])
+test('T11976', normal, compile_fail, [''])