[commit: packages/base] master: Comparison primops return Int# (Fixes #6135) (f6e2398)
git at git.haskell.org
git at git.haskell.org
Wed Aug 14 17:16:44 CEST 2013
Repository : ssh://git@git.haskell.org/base
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/f6e2398adb63f5c35544333268df9c8837fd2581/packages/base
>---------------------------------------------------------------
commit f6e2398adb63f5c35544333268df9c8837fd2581
Author: Jan Stolarek <jan.stolarek at p.lodz.pl>
Date: Sun Apr 14 12:35:23 2013 +0200
Comparison primops return Int# (Fixes #6135)
For a deatiled discussion of this changes please visit the wiki page:
http://hackage.haskell.org/trac/ghc/wiki/PrimBool
>---------------------------------------------------------------
f6e2398adb63f5c35544333268df9c8837fd2581
GHC/Arr.lhs | 2 +-
GHC/Base.lhs | 13 +++++++++----
GHC/Conc/Sync.lhs | 2 +-
GHC/Exts.hs | 2 ++
GHC/MVar.hs | 2 +-
GHC/Real.lhs | 20 ++++++++++++--------
GHC/STRef.lhs | 2 +-
7 files changed, 27 insertions(+), 16 deletions(-)
diff --git a/GHC/Arr.lhs b/GHC/Arr.lhs
index 2428077..29f5033 100644
--- a/GHC/Arr.lhs
+++ b/GHC/Arr.lhs
@@ -411,7 +411,7 @@ data STArray s i e
-- Just pointer equality on mutable arrays:
instance Eq (STArray s i e) where
STArray _ _ _ arr1# == STArray _ _ _ arr2# =
- sameMutableArray# arr1# arr2#
+ tagToEnum# (sameMutableArray# arr1# arr2#)
\end{code}
diff --git a/GHC/Base.lhs b/GHC/Base.lhs
index ec162ef..ba2539c 100644
--- a/GHC/Base.lhs
+++ b/GHC/Base.lhs
@@ -11,11 +11,15 @@ The overall structure of the GHC Prelude is a bit tricky.
So the rough structure is as follows, in (linearised) dependency order
-GHC.Prim Has no implementation. It defines built-in things, and
+GHC.Prim Has no implementation. It defines built-in things, and
by importing it you bring them into scope.
The source file is GHC.Prim.hi-boot, which is just
copied to make GHC.Prim.hi
+GHC.PrimWrappers
+ Provides wrappers for built-in comparison operators.
+ These wrappers take unboxed operands and return a Bool.
+
GHC.Base Classes: Eq, Ord, Functor, Monad
Types: list, (), Int, Bool, Ordering, Char, String
@@ -101,8 +105,9 @@ module GHC.Base
module GHC.CString,
module GHC.Magic,
module GHC.Types,
- module GHC.Prim, -- Re-export GHC.Prim and [boot] GHC.Err, to avoid lots
- module GHC.Err -- of people having to import it explicitly
+ module GHC.Prim, -- Re-export GHC.Prim, GHC.PrimWrappers and
+ module GHC.PrimWrappers,-- [boot] GHC.Err, to avoid lots of people having to
+ module GHC.Err -- import it explicitly
)
where
@@ -112,6 +117,7 @@ import GHC.CString
import GHC.Magic
import GHC.Prim
import GHC.Err
+import GHC.PrimWrappers
import {-# SOURCE #-} GHC.IO (failIO)
-- This is not strictly speaking required by this module, but is an
@@ -734,4 +740,3 @@ a `iShiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0#
data RealWorld
\end{code}
#endif
-
diff --git a/GHC/Conc/Sync.lhs b/GHC/Conc/Sync.lhs
index 73e129a..0094412 100644
--- a/GHC/Conc/Sync.lhs
+++ b/GHC/Conc/Sync.lhs
@@ -676,7 +676,7 @@ data TVar a = TVar (TVar# RealWorld a)
INSTANCE_TYPEABLE1(TVar,tvarTc,"TVar")
instance Eq (TVar a) where
- (TVar tvar1#) == (TVar tvar2#) = sameTVar# tvar1# tvar2#
+ (TVar tvar1#) == (TVar tvar2#) = tagToEnum# (sameTVar# tvar1# tvar2#)
-- |Create a new TVar holding a value supplied
newTVar :: a -> STM (TVar a)
diff --git a/GHC/Exts.hs b/GHC/Exts.hs
index 5639e13..24e3324 100755
--- a/GHC/Exts.hs
+++ b/GHC/Exts.hs
@@ -28,6 +28,7 @@ module GHC.Exts
-- * Primitive operations
module GHC.Prim,
+ module GHC.PrimWrappers,
shiftL#, shiftRL#, iShiftL#, iShiftRA#, iShiftRL#,
uncheckedShiftL64#, uncheckedShiftRL64#,
uncheckedIShiftL64#, uncheckedIShiftRA64#,
@@ -66,6 +67,7 @@ module GHC.Exts
import Prelude
import GHC.Prim
+import GHC.PrimWrappers
import GHC.Base
import GHC.Word
import GHC.Int
diff --git a/GHC/MVar.hs b/GHC/MVar.hs
index 4113f87..7036054 100644
--- a/GHC/MVar.hs
+++ b/GHC/MVar.hs
@@ -45,7 +45,7 @@ as a a box, which may be empty or full.
-- pull in Eq (Mvar a) too, to avoid GHC.Conc being an orphan-instance module
instance Eq (MVar a) where
- (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
+ (MVar mvar1#) == (MVar mvar2#) = tagToEnum# (sameMVar# mvar1# mvar2#)
{-
M-Vars are rendezvous points for concurrent threads. They begin
diff --git a/GHC/Real.lhs b/GHC/Real.lhs
index 87e7845..347cfd9 100644
--- a/GHC/Real.lhs
+++ b/GHC/Real.lhs
@@ -385,27 +385,31 @@ instance Real Integer where
instance Integral Integer where
toInteger n = n
+ {-# INLINE quot #-}
_ `quot` 0 = divZeroError
n `quot` d = n `quotInteger` d
+ {-# INLINE rem #-}
_ `rem` 0 = divZeroError
- n `rem` d = n `remInteger` d
+ n `rem` d = n `remInteger` d
+ {-# INLINE div #-}
_ `div` 0 = divZeroError
n `div` d = n `divInteger` d
+ {-# INLINE mod #-}
_ `mod` 0 = divZeroError
- n `mod` d = n `modInteger` d
+ n `mod` d = n `modInteger` d
+ {-# INLINE divMod #-}
_ `divMod` 0 = divZeroError
- a `divMod` b = case a `divModInteger` b of
- (# x, y #) -> (x, y)
+ n `divMod` d = case n `divModInteger` d of
+ (# x, y #) -> (x, y)
+ {-# INLINE quotRem #-}
_ `quotRem` 0 = divZeroError
- a `quotRem` b = case a `quotRemInteger` b of
- (# q, r #) -> (q, r)
-
- -- use the defaults for div & mod
+ n `quotRem` d = case n `quotRemInteger` d of
+ (# q, r #) -> (q, r)
\end{code}
diff --git a/GHC/STRef.lhs b/GHC/STRef.lhs
index bd4a348..81562d0 100644
--- a/GHC/STRef.lhs
+++ b/GHC/STRef.lhs
@@ -48,6 +48,6 @@ writeSTRef (STRef var#) val = ST $ \s1# ->
-- Just pointer equality on mutable references:
instance Eq (STRef s a) where
- STRef v1# == STRef v2# = sameMutVar# v1# v2#
+ STRef v1# == STRef v2# = tagToEnum# (sameMutVar# v1# v2#)
\end{code}
More information about the ghc-commits
mailing list