[commit: ghc] ghc-8.0: Allow implicit parameters in constraint synonyms (f3354fc)

[git at git.haskell.org]

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

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/f3354fc784ba6056a2b83698f8771b7cb8e40f5e/ghc

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

commit f3354fc784ba6056a2b83698f8771b7cb8e40f5e
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Jan 21 12:26:50 2016 +0000

    Allow implicit parameters in constraint synonyms
    
    This fixes Trac #11466.
    
    It went bad by accident in
     commit ffc21506894c7887d3620423aaf86bc6113a1071
     Refactor tuple constraints
    
    (cherry picked from commit 395ec414ff21bc37439194bb31a8f764b38b0fca)


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

f3354fc784ba6056a2b83698f8771b7cb8e40f5e
 compiler/typecheck/TcValidity.hs        | 32 +++++++++++++++++++++++++++-----
 testsuite/tests/polykinds/T11466.hs     | 16 ++++++++++++++++
 testsuite/tests/polykinds/T11466.stderr |  6 ++++++
 testsuite/tests/polykinds/all.T         |  1 +
 4 files changed, 50 insertions(+), 5 deletions(-)

diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs
index a33fd40..517d059 100644
--- a/compiler/typecheck/TcValidity.hs
+++ b/compiler/typecheck/TcValidity.hs
@@ -675,12 +675,33 @@ check_valid_theta env ctxt theta
     (_,dups) = removeDups cmpType theta
 
 -------------------------
+{- Note [Validity checking for constraints]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We look through constraint synonyms so that we can see the underlying
+constraint(s).  For example
+   type Foo = ?x::Int
+   instance Foo => C T
+We should reject the instance because it has an implicit parameter in
+the context.
+
+But we record, in 'under_syn', whether we have looked under a synonym
+to avoid requiring language extensions at the use site.  Main example
+(Trac #9838):
+
+   {-# LANGUAGE ConstraintKinds #-}
+   module A where
+      type EqShow a = (Eq a, Show a)
+
+   module B where
+      import A
+      foo :: EqShow a => a -> String
+
+We don't want to require ConstraintKinds in module B.
+-}
+
 check_pred_ty :: TidyEnv -> DynFlags -> UserTypeCtxt -> PredType -> TcM ()
 -- Check the validity of a predicate in a signature
--- Do not look through any type synonyms; any constraint kinded
--- type synonyms have been checked at their definition site
--- C.f. Trac #9838
-
+-- See Note [Validity checking for constraints]
 check_pred_ty env dflags ctxt pred
   = do { check_type env SigmaCtxt MustBeMonoType pred
        ; check_pred_help False env dflags ctxt pred }
@@ -814,11 +835,12 @@ okIPCtxt GhciCtxt           = True
 okIPCtxt SigmaCtxt          = True
 okIPCtxt (DataTyCtxt {})    = True
 okIPCtxt (PatSynCtxt {})    = True
+okIPCtxt (TySynCtxt {})     = True   -- e.g.   type Blah = ?x::Int
+                                     -- Trac #11466
 
 okIPCtxt (ClassSCCtxt {})  = False
 okIPCtxt (InstDeclCtxt {}) = False
 okIPCtxt (SpecInstCtxt {}) = False
-okIPCtxt (TySynCtxt {})    = False
 okIPCtxt (RuleSigCtxt {})  = False
 okIPCtxt DefaultDeclCtxt   = False
 
diff --git a/testsuite/tests/polykinds/T11466.hs b/testsuite/tests/polykinds/T11466.hs
new file mode 100644
index 0000000..e479af0
--- /dev/null
+++ b/testsuite/tests/polykinds/T11466.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE ImplicitParams, ConstraintKinds #-}
+
+module T11466 where
+
+-- This should be ok
+type Bla = ?x::Int
+
+-- This should be ook
+f :: Bla => Int -> Int
+f y = ?x + y
+
+data T = T
+
+-- But this should be rejected
+instance Bla => Eq T
+
diff --git a/testsuite/tests/polykinds/T11466.stderr b/testsuite/tests/polykinds/T11466.stderr
new file mode 100644
index 0000000..f584731
--- /dev/null
+++ b/testsuite/tests/polykinds/T11466.stderr
@@ -0,0 +1,6 @@
+
+T11466.hs:15:10: error:
+    • Illegal implicit parameter ‘?x::Int’
+    • In the context: Bla
+      While checking an instance declaration
+      In the instance declaration for ‘Eq T’
diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T
index 899e47c..f1f25ce 100644
--- a/testsuite/tests/polykinds/all.T
+++ b/testsuite/tests/polykinds/all.T
@@ -133,3 +133,4 @@ test('T11248', normal, compile, [''])
 test('T11278', normal, compile, [''])
 test('T11255', normal, compile, [''])
 test('T11459', normal, compile_fail, [''])
+test('T11466', normal, compile_fail, [''])