[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