[project @ 2003-03-08 23:03:47 by panne]

[ghc-base.git] / GHC / Base.lhs

diff --git a/GHC/Base.lhs b/GHC/Base.lhs
index 9601209..2598583 100644 (file)
--- a/GHC/Base.lhs
+++ b/GHC/Base.lhs
@@ -86,7 +86,7 @@ Other Prelude modules are much easier with fewer complex dependencies.
 module GHC.Base
        (
        module GHC.Base,
-       module GHC.Prim,                -- Re-export GHC.Prim and GHC.Err, to avoid lots
+       module GHC.Prim,        -- Re-export GHC.Prim and GHC.Err, to avoid lots
        module GHC.Err          -- of people having to import it explicitly
   ) 
        where
@@ -595,6 +595,14 @@ id x                       =  x
 lazy :: a -> a
 lazy x = x
 
+-- Assertion function. This simply ignores its boolean argument.
+-- The compiler may rewrite it to (assertError line)
+--     SLPJ: in 5.04 etc 'assert' is in GHC.Prim,
+--     but from Template Haskell onwards it's simply
+--     defined here in Base.lhs
+assert :: Bool -> a -> a
+assert pred r = r
+ 
 -- constant function
 const                  :: a -> b -> a
 const x _              =  x
@@ -659,6 +667,29 @@ data (:*:) a b = a :*: b
 #endif
 \end{code}
 
+%*********************************************************
+%*                                                     *
+\subsection{@getTag@}
+%*                                                     *
+%*********************************************************
+
+Returns the 'tag' of a constructor application; this function is used
+by the deriving code for Eq, Ord and Enum.
+
+The primitive dataToTag# requires an evaluated constructor application
+as its argument, so we provide getTag as a wrapper that performs the
+evaluation before calling dataToTag#.  We could have dataToTag#
+evaluate its argument, but we prefer to do it this way because (a)
+dataToTag# can be an inline primop if it doesn't need to do any
+evaluation, and (b) we want to expose the evaluation to the
+simplifier, because it might be possible to eliminate the evaluation
+in the case when the argument is already known to be evaluated.
+
+\begin{code}
+{-# INLINE getTag #-}
+getTag :: a -> Int#
+getTag x = x `seq` dataToTag# x
+\end{code}
 
 %*********************************************************
 %*                                                     *
@@ -669,13 +700,13 @@ data (:*:) a b = a :*: b
 \begin{code}
 divInt# :: Int# -> Int# -> Int#
 x# `divInt#` y#
-       -- careful NOT to overflow if we do any additional arithmetic
+       -- 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#
-    | (x# ># 0#) && (y# <# 0#) = (x# -# 1#) `quotInt#` y# -# 1#
-    | (x# <# 0#) && (y# ># 0#) = (x# +# 1#) `quotInt#` y# -# 1#
+    | (x# ># 0#) && (y# <# 0#) = ((x# -# 1#) `quotInt#` y#) -# 1#
+    | (x# <# 0#) && (y# ># 0#) = ((x# +# 1#) `quotInt#` y#) -# 1#
     | otherwise                = x# `quotInt#` y#
 
 modInt# :: Int# -> Int# -> Int#
@@ -872,19 +903,19 @@ unpackCStringUtf8# addr
       | ch `eqChar#` '\0'#   = []
       | ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#)
       | ch `leChar#` '\xDF'# =
-          C# (chr# ((ord# ch                                  -# 0xC0#) `uncheckedIShiftL#`  6# +#
-                    (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
+          C# (chr# (((ord# ch                                  -# 0xC0#) `uncheckedIShiftL#`  6#) +#
+                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
           unpack (nh +# 2#)
       | ch `leChar#` '\xEF'# =
-          C# (chr# ((ord# ch                                  -# 0xE0#) `uncheckedIShiftL#` 12# +#
-                    (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#`  6# +#
-                    (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :
+          C# (chr# (((ord# ch                                  -# 0xE0#) `uncheckedIShiftL#` 12#) +#
+                    ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#`  6#) +#
+                     (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :
           unpack (nh +# 3#)
       | otherwise            =
-          C# (chr# ((ord# ch                                  -# 0xF0#) `uncheckedIShiftL#` 18# +#
-                    (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12# +#
-                    (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#`  6# +#
-                    (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
+          C# (chr# (((ord# ch                                  -# 0xF0#) `uncheckedIShiftL#` 18#) +#
+                    ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12#) +#
+                    ((ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#`  6#) +#
+                     (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
           unpack (nh +# 4#)
       where
        ch = indexCharOffAddr# addr nh