[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