[commit: ghc] wip/T10858: Move thenCmp to GHC.Classes (25d72fb)
git at git.haskell.org
git at git.haskell.org
Wed Sep 9 08:18:02 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/T10858
Link : http://ghc.haskell.org/trac/ghc/changeset/25d72fbf45903da0b65fccfd3853c7a7ecc06b57/ghc
>---------------------------------------------------------------
commit 25d72fbf45903da0b65fccfd3853c7a7ecc06b57
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Wed Sep 9 10:18:18 2015 +0200
Move thenCmp to GHC.Classes
as we need to derive code already that, and that happens before
GHC.Base.
>---------------------------------------------------------------
25d72fbf45903da0b65fccfd3853c7a7ecc06b57
compiler/prelude/PrelNames.hs | 7 +++----
libraries/base/GHC/Base.hs | 6 ------
libraries/ghc-prim/GHC/Classes.hs | 9 ++++++++-
3 files changed, 11 insertions(+), 11 deletions(-)
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index 597ef17..1515a2f 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -611,11 +611,11 @@ compose_RDR :: RdrName
compose_RDR = varQual_RDR gHC_BASE (fsLit ".")
not_RDR, getTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR,
- and_RDR, or_RDR, range_RDR, inRange_RDR, index_RDR,
+ and_RDR, thenCmp_RDR, range_RDR, inRange_RDR, index_RDR,
unsafeIndex_RDR, unsafeRangeSize_RDR :: RdrName
and_RDR = varQual_RDR gHC_CLASSES (fsLit "&&")
-or_RDR = varQual_RDR gHC_CLASSES (fsLit "||")
not_RDR = varQual_RDR gHC_CLASSES (fsLit "not")
+thenCmp_RDR = varQual_RDR gHC_CLASSES (fsLit "thenCmp")
getTag_RDR = varQual_RDR gHC_BASE (fsLit "getTag")
succ_RDR = varQual_RDR gHC_ENUM (fsLit "succ")
pred_RDR = varQual_RDR gHC_ENUM (fsLit "pred")
@@ -725,7 +725,7 @@ notAssocDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "NotAssociative")
fmap_RDR, pure_RDR, ap_RDR, foldable_foldr_RDR, foldMap_RDR,
- traverse_RDR, mempty_RDR, mappend_RDR, thenCmp_RDR :: RdrName
+ traverse_RDR, mempty_RDR, mappend_RDR :: RdrName
fmap_RDR = varQual_RDR gHC_BASE (fsLit "fmap")
pure_RDR = nameRdrName pureAName
ap_RDR = nameRdrName apAName
@@ -734,7 +734,6 @@ foldMap_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldMap")
traverse_RDR = varQual_RDR dATA_TRAVERSABLE (fsLit "traverse")
mempty_RDR = varQual_RDR gHC_BASE (fsLit "mempty")
mappend_RDR = varQual_RDR gHC_BASE (fsLit "mappend")
-thenCmp_RDR = varQual_RDR gHC_BASE (fsLit "thenCmp")
----------------------
varQual_RDR, tcQual_RDR, clsQual_RDR, dataQual_RDR
diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs
index 5d48d52..816c8d6 100644
--- a/libraries/base/GHC/Base.hs
+++ b/libraries/base/GHC/Base.hs
@@ -290,12 +290,6 @@ instance Monoid Ordering where
mempty = EQ
mappend = thenCmp
--- The monomorphic version is used by the autogenerated Ord instances
-thenCmp :: Ordering -> Ordering -> Ordering
-LT `thenCmp` _ = LT
-EQ `thenCmp` y = y
-GT `thenCmp` _ = GT
-
-- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to
-- <http://en.wikipedia.org/wiki/Monoid>: \"Any semigroup @S@ may be
-- turned into a monoid simply by adjoining an element @e@ not in @S@
diff --git a/libraries/ghc-prim/GHC/Classes.hs b/libraries/ghc-prim/GHC/Classes.hs
index 18662ad..299a872 100644
--- a/libraries/ghc-prim/GHC/Classes.hs
+++ b/libraries/ghc-prim/GHC/Classes.hs
@@ -32,7 +32,8 @@ module GHC.Classes(
Eq(..), eqInt, neInt,
Ord(..), gtInt, geInt, leInt, ltInt, compareInt, compareInt#,
(&&), (||), not,
- divInt#, modInt#
+ divInt#, modInt#,
+ thenCmp
) where
-- GHC.Magic is used in some derived instances
@@ -296,6 +297,12 @@ not :: Bool -> Bool
not True = False
not False = True
+-- This is used by the derived code for Ord, so put it here
+thenCmp :: Ordering -> Ordering -> Ordering
+LT `thenCmp` _ = LT
+EQ `thenCmp` y = y
+GT `thenCmp` _ = GT
+
------------------------------------------------------------------------
-- These don't really belong here, but we don't have a better place to
More information about the ghc-commits
mailing list