Commit 7b7ea8f4 authored by Ryan Scott's avatar Ryan Scott

Fix derived Ix instances for one-constructor GADTs

Summary:
Standalone-derived `Ix` instances would panic on GADTs with exactly
one constructor, since the list of fields was being passed to a function that
uses `foldl1` in order to generate an implementation for `inRange`. This adds a
simple check that makes `inRange` be `True` whenever a product type has no
fields.

Fixes #12583.

Test Plan: make test TEST=12583

Reviewers: simonpj, austin, bgamari

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2521

GHC Trac Issues: #12583
parent 04184a2a
......@@ -1954,9 +1954,15 @@ ppr_do_stmts stmts
pprComp :: (OutputableBndrId id, Outputable body)
=> [LStmt id body] -> SDoc
pprComp quals -- Prints: body | qual1, ..., qualn
| not (null quals)
, L _ (LastStmt body _ _) <- last quals
= hang (ppr body <+> vbar) 2 (pprQuals (dropTail 1 quals))
| Just (initStmts, L _ (LastStmt body _ _)) <- snocView quals
= if null initStmts
-- If there are no statements in a list comprehension besides the last
-- one, we simply treat it like a normal list. This does arise
-- occasionally in code that GHC generates, e.g., in implementations of
-- 'range' for derived 'Ix' instances for product datatypes with exactly
-- one constructor (e.g., see Trac #12583).
then ppr body
else hang (ppr body <+> vbar) 2 (pprQuals initStmts)
| otherwise
= pprPanic "pprComp" (pprQuals quals)
......
......@@ -908,7 +908,12 @@ gen_Ix_binds loc tycon
= mk_easy_FunBind loc inRange_RDR
[nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed,
con_pat cs_needed] $
foldl1 and_Expr (zipWith3Equal "single_con_inRange" in_range as_needed bs_needed cs_needed)
if con_arity == 0
-- If the product type has no fields, inRange is trivially true
-- (see Trac #12853).
then true_Expr
else foldl1 and_Expr (zipWith3Equal "single_con_inRange" in_range
as_needed bs_needed cs_needed)
where
in_range a b c = nlHsApps inRange_RDR [mkLHsVarTuple [a,b], nlHsVar c]
......
......@@ -22,6 +22,9 @@ Language
refer to closed local bindings. For instance, this is now permitted:
``f = static x where x = 'a'``.
- A bug has been fixed that caused standalone derived ``Ix`` instances to fail
for GADTs with exactly one constructor (:ghc-ticket:`12583`).
Compiler
~~~~~~~~
......
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
module T12583 where
import Data.Ix
data Foo a where
MkFoo :: (Eq a, Ord a, Ix a) => Foo a
deriving instance Eq (Foo a)
deriving instance Ord (Foo a)
deriving instance Ix (Foo a)
......@@ -72,3 +72,4 @@ test('T11732c', normal, compile, [''])
test('T11833', normal, compile, [''])
test('T12245', normal, compile, [''])
test('T12399', normal, compile, [''])
test('T12583', normal, compile, [''])
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