[commit: ghc-prim] master: Move divInt#/modInt# from base (7398a64)

Ian Lynagh <[email protected]>
Newsgroups gmane.comp.lang.haskell.cvs.libraries
Message-ID <[email protected]>
Repository : ssh://darcs.haskell.org//srv/darcs/packages/ghc-prim

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/7398a64cb94c8c548fb50baebcf0d528885c0436

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

commit 7398a64cb94c8c548fb50baebcf0d528885c0436
Author: Ian Lynagh <[email protected]>
Date:   Tue Jun 19 19:21:29 2012 +0100

    Move divInt#/modInt# from base
    
    This allows them to be shared with integer-gmp

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

 GHC/Classes.hs |   26 +++++++++++++++++++++++++-
 GHC/Types.hs   |    1 +
 2 files changed, 26 insertions(+), 1 deletions(-)

diff --git a/GHC/Classes.hs b/GHC/Classes.hs
index 7586af4..863a8fa 100644
--- a/GHC/Classes.hs
+++ b/GHC/Classes.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns #-}
 {-# OPTIONS_GHC -fno-warn-unused-imports #-}
 -- XXX -fno-warn-unused-imports needed for the GHC.Tuple import below. Sigh.
 {-# OPTIONS_HADDOCK hide #-}
@@ -285,3 +285,27 @@ deriving instance Ord Arity
 deriving instance Ord Associativity
 deriving instance Ord Fixity
 
+------------------------------------------------------------------------
+-- These don't really belong here, but we don't have a better place to
+-- put them
+
+divInt# :: Int# -> Int# -> Int#
+x# `divInt#` y#
+        -- Be careful NOT to overflow if we do any additional arithmetic
+        -- on the arguments...  the following  previous version of this
+        -- code has problems with overflow:
+--    | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y#
+--    | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y#
+    =      if (x# ># 0#) && (y# <# 0#) then ((x# -# 1#) `quotInt#` y#) -# 1#
+      else if (x# <# 0#) && (y# ># 0#) then ((x# +# 1#) `quotInt#` y#) -# 1#
+      else x# `quotInt#` y#
+
+modInt# :: Int# -> Int# -> Int#
+x# `modInt#` y#
+    = if (x# ># 0#) && (y# <# 0#) ||
+         (x# <# 0#) && (y# ># 0#)
+      then if r# /=# 0# then r# +# y# else 0#
+      else r#
+    where
+    !r# = x# `remInt#` y#
+
diff --git a/GHC/Types.hs b/GHC/Types.hs
index c8868da..e7983e7 100644
--- a/GHC/Types.hs
+++ b/GHC/Types.hs
@@ -84,3 +84,4 @@ newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
 -- The type constructor is special in that GHC pretends that it
 -- has kind (? -> ? -> Fact) rather than (* -> * -> *)
 data (~) a b = Eq# ((~#) a b)
+
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.