[commit: ghc] master: Normalize the element type of ListPat, fix #14547 (361d23a)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/361d23a8ebb44f5df5167306d7b98d8bd1724e06/ghc

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

commit 361d23a8ebb44f5df5167306d7b98d8bd1724e06
Author: HE, Tao <sighingnow at gmail.com>
Date:   Thu May 3 17:16:09 2018 -0400

    Normalize the element type of ListPat, fix #14547
    
    The element type of `List` maybe a type family instacen, rather than a
    trivial type.  For example in Trac #14547,
    
    ```
    {-# LANGUAGE TypeFamilies, OverloadedLists #-}
    
    class Foo f where
            type It f
            foo :: [It f] -> f
    
    data List a = Empty | a :! List a deriving Show
    
    instance Foo (List a) where
            type It (List a) = a
            foo [] = Empty
            foo (x : xs) = x :! foo xs
    ```
    
    Here the element type of `[]` is `It (List a)`, we should also normalize
    it as `a`.
    
    Test Plan: make test TEST="T14547"
    
    Reviewers: bgamari
    
    Reviewed By: bgamari
    
    Subscribers: thomie, carter
    
    GHC Trac Issues: #14547
    
    Differential Revision: https://phabricator.haskell.org/D4624


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

361d23a8ebb44f5df5167306d7b98d8bd1724e06
 compiler/deSugar/Check.hs                        |  5 ++++-
 testsuite/tests/deSugar/should_compile/T14547.hs | 15 +++++++++++++++
 testsuite/tests/deSugar/should_compile/all.T     |  1 +
 3 files changed, 20 insertions(+), 1 deletion(-)

diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index 545aace..7a5f889 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -790,10 +790,13 @@ translatePat fam_insts pat = case pat of
   -- overloaded list
   ListPat (ListPatTc elem_ty (Just (pat_ty, _to_list))) lpats
     | Just e_ty <- splitListTyConApp_maybe pat_ty
+    , (_, norm_e_ty) <- normaliseType fam_insts Nominal e_ty
+         -- e_ty can be a type family instance, like
+         -- `It (List a)`, but we prefer `a`, see Trac #14547
     , (_, norm_elem_ty) <- normaliseType fam_insts Nominal elem_ty
          -- elem_ty is frequently something like
          -- `Item [Int]`, but we prefer `Int`
-    , norm_elem_ty `eqType` e_ty ->
+    , norm_elem_ty `eqType` norm_e_ty ->
         -- We have to ensure that the element types are exactly the same.
         -- Otherwise, one may give an instance IsList [Int] (more specific than
         -- the default IsList [a]) with a different implementation for `toList'
diff --git a/testsuite/tests/deSugar/should_compile/T14547.hs b/testsuite/tests/deSugar/should_compile/T14547.hs
new file mode 100644
index 0000000..02ff2e6
--- /dev/null
+++ b/testsuite/tests/deSugar/should_compile/T14547.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module T14547 where
+
+class Foo f where
+        type It f
+        foo :: [It f] -> f
+
+data List a = Empty | a :! List a deriving Show
+
+instance Foo (List a) where
+        type It (List a) = a
+        foo [] = Empty
+        foo (x : xs) = x :! foo xs
diff --git a/testsuite/tests/deSugar/should_compile/all.T b/testsuite/tests/deSugar/should_compile/all.T
index 2d36146..1414073 100644
--- a/testsuite/tests/deSugar/should_compile/all.T
+++ b/testsuite/tests/deSugar/should_compile/all.T
@@ -100,6 +100,7 @@ test('T13290', normal, compile, [''])
 test('T13257', normal, compile, [''])
 test('T13870', normal, compile, [''])
 test('T14135', normal, compile, [''])
+test('T14547', normal, compile, ['-Wincomplete-patterns'])
 test('T14773a', normal, compile, ['-Wincomplete-patterns'])
 test('T14773b', normal, compile, ['-Wincomplete-patterns'])
 test('T14815', [], run_command, ['$MAKE -s --no-print-directory T14815'])