import GHC.Prim
import {-# SOURCE #-} GHC.Err
+-- These two are not strictly speaking required by this module, but they are
+-- implicit dependencies whenever () or tuples are mentioned, so adding them
+-- as imports here helps to get the dependencies right in the new build system.
+import GHC.Tuple ()
+import GHC.Unit ()
+
infixr 9 .
infixr 5 ++
infixl 1 >>, >>=
(x# <# 0#) && (y# ># 0#) = if r# /=# 0# then r# +# y# else 0#
| otherwise = r#
where
- r# = x# `remInt#` y#
+ !r# = x# `remInt#` y#
\end{code}
Definitions of the boxed PrimOps; these will be
{-# INLINE remInt #-}
{-# INLINE negateInt #-}
-plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt, gcdInt :: Int -> Int -> Int
+plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt :: Int -> Int -> Int
(I# x) `plusInt` (I# y) = I# (x +# y)
(I# x) `minusInt` (I# y) = I# (x -# y)
(I# x) `timesInt` (I# y) = I# (x *# y)
"1# *# x#" forall x#. 1# *# x# = x#
#-}
-gcdInt (I# a) (I# b) = g a b
- where g 0# 0# = error "GHC.Base.gcdInt: gcd 0 0 is undefined"
- g 0# _ = I# absB
- g _ 0# = I# absA
- g _ _ = I# (gcdInt# absA absB)
-
- absInt x = if x <# 0# then negateInt# x else x
-
- absA = absInt a
- absB = absInt b
-
negateInt :: Int -> Int
negateInt (I# x) = I# (negateInt# x)
\begin{code}
unpackCString# :: Addr# -> [Char]
-{-# NOINLINE [1] unpackCString# #-}
+{-# NOINLINE unpackCString# #-}
+ -- There's really no point in inlining this, ever, cos
+ -- the loop doesn't specialise in an interesting
+ -- But it's pretty small, so there's a danger that
+ -- it'll be inlined at every literal, which is a waste
unpackCString# addr
= unpack 0#
where
| ch `eqChar#` '\0'# = []
| otherwise = C# ch : unpack (nh +# 1#)
where
- ch = indexCharOffAddr# addr nh
+ !ch = indexCharOffAddr# addr nh
unpackAppendCString# :: Addr# -> [Char] -> [Char]
+{-# NOINLINE unpackAppendCString# #-}
+ -- See the NOINLINE note on unpackCString#
unpackAppendCString# addr rest
= unpack 0#
where
| ch `eqChar#` '\0'# = rest
| otherwise = C# ch : unpack (nh +# 1#)
where
- ch = indexCharOffAddr# addr nh
+ !ch = indexCharOffAddr# addr nh
unpackFoldrCString# :: Addr# -> (Char -> a -> a) -> a -> a
{-# NOINLINE [0] unpackFoldrCString# #-}
--- Don't inline till right at the end;
+-- Unlike unpackCString#, there *is* some point in inlining unpackFoldrCString#,
+-- because we get better code for the function call.
+-- However, don't inline till right at the end;
-- usually the unpack-list rule turns it into unpackCStringList
-- It also has a BuiltInRule in PrelRules.lhs:
-- unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)
| ch `eqChar#` '\0'# = z
| otherwise = C# ch `f` unpack (nh +# 1#)
where
- ch = indexCharOffAddr# addr nh
+ !ch = indexCharOffAddr# addr nh
unpackCStringUtf8# :: Addr# -> [Char]
unpackCStringUtf8# addr
(ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
unpack (nh +# 4#)
where
- ch = indexCharOffAddr# addr nh
+ !ch = indexCharOffAddr# addr nh
unpackNBytes# :: Addr# -> Int# -> [Char]
unpackNBytes# _addr 0# = []
ch -> unpack (C# ch : acc) (i# -# 1#)
{-# RULES
-"unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a)
+"unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a)
"unpack-list" [1] forall a . unpackFoldrCString# a (:) [] = unpackCString# a
"unpack-append" forall a n . unpackFoldrCString# a (:) n = unpackAppendCString# a n