Fix derived Ix instances for one-constructor GADTs
authorRyan Scott <ryan.gl.scott@gmail.com>
Sun, 11 Sep 2016 14:27:36 +0000 (10:27 -0400)
committerRyan Scott <ryan.gl.scott@gmail.com>
Sun, 11 Sep 2016 14:38:41 +0000 (10:38 -0400)
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

compiler/hsSyn/HsExpr.hs
compiler/typecheck/TcGenDeriv.hs
docs/users_guide/8.0.2-notes.rst
testsuite/tests/deriving/should_compile/T12583.hs [new file with mode: 0644]
testsuite/tests/deriving/should_compile/all.T

index 78e6ad7..1ff204b 100644 (file)
@@ -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)
 
index f378172..69f9d98 100644 (file)
@@ -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]
 
index 924998f..43c9562 100644 (file)
@@ -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
 ~~~~~~~~
 
diff --git a/testsuite/tests/deriving/should_compile/T12583.hs b/testsuite/tests/deriving/should_compile/T12583.hs
new file mode 100644 (file)
index 0000000..9dc151b
--- /dev/null
@@ -0,0 +1,11 @@
+{-# 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)
index e42e34d..6beae8a 100644 (file)
@@ -72,3 +72,4 @@ test('T11732c', normal, compile, [''])
 test('T11833', normal, compile, [''])
 test('T12245', normal, compile, [''])
 test('T12399', normal, compile, [''])
+test('T12583', normal, compile, [''])