Commit d8efb098 authored by Tao He's avatar Tao He Committed by Ben Gamari

Fix broken test T14547.

Phab:D4571 lags behind HEAD for too many commits. The commit of
Phab:4571 1f88f541 brought some
unintentional changes (not belong to [Phab:4571's Diff
16314](https://phabricator.haskell.org/differential/diff/16314/)) into
ghc-head, breaking T14557.

Let's fix that.

Test Plan: make test TEST="T14547"

Reviewers: bgamari

Reviewed By: bgamari

Subscribers: rwbarton, thomie, carter

GHC Trac Issues: #15222

Differential Revision: https://phabricator.haskell.org/D4778
parent c560f382
......@@ -53,6 +53,7 @@ import Type
import UniqSupply
import DsGRHSs (isTrueLHsExpr)
import Maybes (expectJust)
import qualified GHC.LanguageExtensions as LangExt
import Data.List (find)
import Data.Maybe (catMaybes, isJust, fromMaybe)
......@@ -788,18 +789,31 @@ translatePat fam_insts pat = case pat of
<$> translatePatVec fam_insts (map unLoc ps)
-- overloaded list
ListPat (ListPatTc elem_ty (Just (pat_ty, _to_list))) lpats
| Just e_ty <- splitListTyConApp_maybe pat_ty
, (_, 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 ->
-- 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'
translatePat fam_insts (ListPat (ListPatTc e_ty Nothing) lpats)
-- See Note [Guards and Approximation]
| otherwise -> mkCanFailPmPat pat_ty
ListPat (ListPatTc _elem_ty (Just (pat_ty, _to_list))) lpats -> do
dflags <- getDynFlags
if xopt LangExt.RebindableSyntax dflags
then mkCanFailPmPat pat_ty
else case splitListTyConApp_maybe pat_ty of
Just e_ty -> translatePat fam_insts
(ListPat (ListPatTc e_ty Nothing) lpats)
Nothing -> mkCanFailPmPat pat_ty
-- (a) In the presence of RebindableSyntax, we don't know anything about
-- `toList`, we should treat `ListPat` as any other view pattern.
--
-- (b) In the absence of RebindableSyntax,
-- - If the pat_ty is `[a]`, then we treat the overloaded list pattern
-- as ordinary list pattern. Although we can give an instance
-- `IsList [Int]` (more specific than the default `IsList [a]`), in
-- practice, we almost never do that. We assume the `_to_list` is
-- the `toList` from `instance IsList [a]`.
--
-- - Otherwise, we treat the `ListPat` as ordinary view pattern.
--
-- See Trac #14547, especially comment#9 and comment#10.
--
-- Here we construct CanFailPmPat directly, rather can construct a view
-- pattern and do further translation as an optimization, for the reason,
-- see Note [Guards and Approximation].
ConPatOut { pat_con = L _ con
, pat_arg_tys = arg_tys
......
......@@ -103,7 +103,7 @@ test('T14135', normal, compile, [''])
test('T14546a', normal, compile, ['-Wincomplete-patterns'])
test('T14546b', normal, compile, ['-Wincomplete-patterns'])
test('T14546c', normal, compile, ['-Wincomplete-patterns'])
test('T14547', expect_broken(15222), compile, ['-Wincomplete-patterns'])
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'])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment