[commit: packages/ghc-prim] master: Add `{-# MINIMAL #-}` to `class Eq` and `class Ord` (12a8244)

git at git.haskell.org git at git.haskell.org
Wed Sep 18 10:39:25 CEST 2013


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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/12a8244b12e38e61c091d38006e9285155a21290/ghc-prim

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

commit 12a8244b12e38e61c091d38006e9285155a21290
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date:   Wed Sep 18 08:06:13 2013 +0200

    Add `{-# MINIMAL #-}` to `class Eq` and `class Ord`
    
    This makes use of the new compiler checked minimal-complete-defintion
    `{-# MINIMAL #-}` annotation (see #7633 for more details)
    
    Signed-off-by: Herbert Valerio Riedel <hvr at gnu.org>


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

12a8244b12e38e61c091d38006e9285155a21290
 GHC/Classes.hs |    2 ++
 1 file changed, 2 insertions(+)

diff --git a/GHC/Classes.hs b/GHC/Classes.hs
index 4f456db..cf95cf8 100644
--- a/GHC/Classes.hs
+++ b/GHC/Classes.hs
@@ -48,6 +48,7 @@ class  Eq a  where
     {-# INLINE (==) #-}
     x /= y               = not (x == y)
     x == y               = not (x /= y)
+    {-# MINIMAL (==) | (/=) #-}
 
 deriving instance Eq ()
 deriving instance (Eq  a, Eq  b) => Eq  (a, b)
@@ -145,6 +146,7 @@ class  (Eq a) => Ord a  where
         -- because the latter is often more expensive
     max x y = if x <= y then y else x
     min x y = if x <= y then x else y
+    {-# MINIMAL compare | (<=) #-}
 
 deriving instance Ord ()
 deriving instance (Ord a, Ord b) => Ord (a, b)




More information about the ghc-commits mailing list