GADT deriving Ord generates inaccessible code in a pattern with constructor.

I added a second type parameter k to a GADT Zone and found that when deriving Ord with standalone deriving, the generated code has errors in ghc-8.2.2. There's a reproduction repo for this;

https://github.com/BlockScope/zone-inaccessible-code-deriving-ord.

I found I needed at least three constructors in Zone to get this error.

#8128 (closed) seemed relevant for being about standalone deriving of a GADT. That being fixed, I tried with ghc-head that I built from source. With this version I found that the same code faults exist in the generated code but are treated as warnings by ghc-8.7.2

> inplace/bin/ghc-stage2 --version
The Glorious Glasgow Haskell Compilation System, version 8.7.20180715

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}

module Flight.Zone where

newtype Radius a = Radius a deriving (Eq, Ord)

data CourseLine
data OpenDistance
data EndOfSpeedSection

-- TODO: Remove standalone deriving Eq & Ord for empty data after GHC 8.4.1
-- SEE: https://ghc.haskell.org/trac/ghc/ticket/7401
deriving instance Eq CourseLine
deriving instance Eq OpenDistance
deriving instance Eq EndOfSpeedSection

deriving instance Ord CourseLine
deriving instance Ord OpenDistance
deriving instance Ord EndOfSpeedSection

data Zone k a where
    Point :: (Eq a, Ord a) => Zone CourseLine a
    Vector :: (Eq a, Ord a) => Zone OpenDistance a
    Conical :: (Eq a, Ord a) => Radius a -> Zone EndOfSpeedSection a

deriving instance Eq a => Eq (Zone k a)
deriving instance (Eq a, Ord a) => Ord (Zone k a)

The error;

/.../Zone.hs:25:1: error:
    • Couldn't match type ‘OpenDistance’ with ‘CourseLine’
      Inaccessible code in
        a pattern with constructor:
          Point :: forall a. (Eq a, Ord a) => Zone CourseLine a,
        in a case alternative
    • In the pattern: Point {}
      In a case alternative: Point {} -> GT
      In the expression:
        case b of
          Point {} -> GT
          Vector -> EQ
          _ -> LT
      When typechecking the code for ‘compare’
        in a derived instance for ‘Ord (Zone k a)’:
        To see the code I am typechecking, use -ddump-deriv
   |
25 | deriving instance (Eq a, Ord a) => Ord (Zone k a)
   | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

/.../Zone.hs:25:1: error:
    • Couldn't match type ‘OpenDistance’ with ‘CourseLine’
      Inaccessible code in
        a pattern with constructor:
          Point :: forall a. (Eq a, Ord a) => Zone CourseLine a,
        in a case alternative
    • In the pattern: Point {}
      In a case alternative: Point {} -> False
      In the expression:
        case b of
          Point {} -> False
          Vector -> False
          _ -> True
      When typechecking the code for ‘<’
        in a derived instance for ‘Ord (Zone k a)’:
        To see the code I am typechecking, use -ddump-deriv
   |
25 | deriving instance (Eq a, Ord a) => Ord (Zone k a)
   | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

The generated code with these replacements;

:%s/GHC\.Classes\.//
:%s/GHC\.Types\.//
:%s/Flight\.Zone\.//

instance (Eq a, Ord a) =>
           Ord (Zone k a) where
    compare a_a2hw b_a2hx
      = case a_a2hw of
          Point
            -> case b_a2hx of
                 Point -> EQ
                 _ -> LT
          Vector
            -> case b_a2hx of
                 Point {} -> GT
                 Vector -> EQ
                 _ -> LT
          Conical a1_a2hy
            -> case b_a2hx of
                 Conical b1_a2hz
                   -> (a1_a2hy `compare` b1_a2hz)
                 _ -> GT
    (<) a_a2hA b_a2hB
      = case a_a2hA of
          Point
            -> case b_a2hB of
                 Point -> False
                 _ -> True
          Vector
            -> case b_a2hB of
                 Point {} -> False
                 Vector -> False
                 _ -> True
          Conical a1_a2hC
            -> case b_a2hB of
                 Conical b1_a2hD -> (a1_a2hC < b1_a2hD)
                 _ -> False
    (<=) a_a2hE b_a2hF
      = not ((<) b_a2hF a_a2hE)
    (>) a_a2hG b_a2hH = (<) b_a2hH a_a2hG
    (>=) a_a2hI b_a2hJ
      = not ((<) a_a2hI b_a2hJ)
  
instance Eq a =>
           Eq (Zone k a) where
    (==) (Point) (Point)
      = True
    (==) (Vector) (Vector)
      = True
    (==)
      (Conical a1_a2hK)
      (Conical b1_a2hL)
      = ((a1_a2hK == b1_a2hL))
    (==) _ _ = False
    (/=) a_a2hM b_a2hN
      = not ((==) a_a2hM b_a2hN)

Trac metadata

Trac field	Value
Version	8.2.2
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture