[commit: ghc] ghc-7.10: Improve typechecking of RULEs, to account for type wildcard holes (20ccf72)

[git at git.haskell.org]

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

On branch  : ghc-7.10
Link       : http://ghc.haskell.org/trac/ghc/changeset/20ccf72614bab9a00767b2514b7cded4b6e3084e/ghc

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

commit 20ccf72614bab9a00767b2514b7cded4b6e3084e
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Sun Feb 15 20:21:42 2015 +0000

    Improve typechecking of RULEs, to account for type wildcard holes
    
    This fixes Trac #10072. Previously the type-hole constraint was
    escaping to top level, but it belongs in the scope of the skolems
    bound by the RULE.
    
    (cherry picked from commit 5ab7518f28e89515c73ff09acd48b5acab48b8a5)


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

20ccf72614bab9a00767b2514b7cded4b6e3084e
 compiler/typecheck/TcMType.hs                          |  2 +-
 compiler/typecheck/TcRules.hs                          | 11 +++++++++--
 testsuite/tests/typecheck/should_compile/T10072.hs     |  4 ++++
 testsuite/tests/typecheck/should_compile/T10072.stderr |  8 ++++++++
 testsuite/tests/typecheck/should_compile/all.T         |  1 +
 5 files changed, 23 insertions(+), 3 deletions(-)

diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs
index 08c0b8b..db76ee3 100644
--- a/compiler/typecheck/TcMType.hs
+++ b/compiler/typecheck/TcMType.hs
@@ -606,7 +606,7 @@ skolemiseUnboundMetaTyVar tv details
         ; writeMetaTyVar tv (mkTyVarTy final_tv)
         ; return final_tv }
   where
-    -- If a wildcard type called _a is generalised, we rename it to tw_a
+    -- If a wildcard type called _a is generalised, we rename it to w_a
     generaliseWildcardVarName :: OccName -> OccName
     generaliseWildcardVarName name | startsWithUnderscore name
       = mkOccNameFS (occNameSpace name) (appendFS (fsLit "w") (occNameFS name))
diff --git a/compiler/typecheck/TcRules.hs b/compiler/typecheck/TcRules.hs
index 56dad98..96de43e 100644
--- a/compiler/typecheck/TcRules.hs
+++ b/compiler/typecheck/TcRules.hs
@@ -132,7 +132,13 @@ tcRule (HsRule name act hs_bndrs lhs fv_lhs rhs fv_rhs)
     do { traceTc "---- Rule ------" (ppr name)
 
         -- Note [Typechecking rules]
-       ; vars <- tcRuleBndrs hs_bndrs
+       ; (vars, bndr_wanted) <- captureConstraints $
+                                tcRuleBndrs hs_bndrs
+              -- bndr_wanted constraints can include wildcard hole
+              -- constraints, which we should not forget about.
+              -- It may mention the skolem type variables bound by
+              -- the RULE.  c.f. Trac #10072
+
        ; let (id_bndrs, tv_bndrs) = partition isId vars
        ; (lhs', lhs_wanted, rhs', rhs_wanted, rule_ty)
             <- tcExtendTyVarEnv tv_bndrs $
@@ -141,7 +147,8 @@ tcRule (HsRule name act hs_bndrs lhs fv_lhs rhs fv_rhs)
                   ; (rhs', rhs_wanted) <- captureConstraints (tcMonoExpr rhs rule_ty)
                   ; return (lhs', lhs_wanted, rhs', rhs_wanted, rule_ty) }
 
-       ; (lhs_evs, other_lhs_wanted) <- simplifyRule (unLoc name) lhs_wanted
+       ; (lhs_evs, other_lhs_wanted) <- simplifyRule (unLoc name) 
+                                                     (bndr_wanted `andWC` lhs_wanted)
                                                      rhs_wanted
 
         -- Now figure out what to quantify over
diff --git a/testsuite/tests/typecheck/should_compile/T10072.hs b/testsuite/tests/typecheck/should_compile/T10072.hs
new file mode 100644
index 0000000..78d47d4
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T10072.hs
@@ -0,0 +1,4 @@
+module T0072 where
+{-# RULES
+"map/empty" forall (f :: a -> _). map f [] = []
+  #-}
diff --git a/testsuite/tests/typecheck/should_compile/T10072.stderr b/testsuite/tests/typecheck/should_compile/T10072.stderr
new file mode 100644
index 0000000..134a137
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T10072.stderr
@@ -0,0 +1,8 @@
+
+T10072.hs:3:31:
+    Found hole ‘_’ with type: w_
+    Where: ‘w_’ is a rigid type variable bound by
+                the RULE "map/empty" at T10072.hs:3:1
+    To use the inferred type, enable PartialTypeSignatures
+    In a RULE for ‘f’: a -> _
+    When checking the transformation rule "map/empty"
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index cce92d0..0b46cc6 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -440,3 +440,4 @@ test('T9892', normal, compile, [''])
 test('T9971', normal, compile, [''])
 test('T9999', normal, compile, [''])
 test('T10031', normal, compile, [''])
+test('T10072', normal, compile_fail, [''])