[project @ 2001-12-14 17:24:19 by simonpj]
[ghc-hetmet.git] / ghc / lib / std / PrelBase.lhs
index 4c0bcbe..dbff5aa 100644 (file)
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: PrelBase.lhs,v 1.39 2000/10/03 08:43:05 simonpj Exp $
+% $Id: PrelBase.lhs,v 1.59 2001/12/14 17:24:19 simonpj Exp $
 %
 % (c) The University of Glasgow, 1992-2000
 %
@@ -75,10 +75,12 @@ Other Prelude modules are much easier with fewer complex dependencies.
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude #-}
 
+#include "MachDeps.h"
+
 module PrelBase
        (
        module PrelBase,
-       module PrelGHC,         -- Re-export PrelGHC, PrelErr & PrelNum, to avoid lots
+       module PrelGHC,         -- Re-export PrelGHC and PrelErr, to avoid lots
        module PrelErr          -- of people having to import it explicitly
   ) 
        where
@@ -142,34 +144,35 @@ unpackCStringUtf8# a = error "urk"
 
 \begin{code}
 class  Eq a  where
-    (==), (/=)         :: a -> a -> Bool
+    (==), (/=)          :: a -> a -> Bool
 
-    (/=) x y            = not ((==) x y)
-    (==) x y           = not ((/=) x y)
+    x /= y              = not (x == y)
+    x == y              = not (x /= y)
 
 class  (Eq a) => Ord a  where
-    compare             :: a -> a -> Ordering
-    (<), (<=), (>=), (>):: a -> a -> Bool
-    max, min           :: a -> a -> a
+    compare             :: a -> a -> Ordering
+    (<), (<=), (>), (>=) :: a -> a -> Bool
+    max, min            :: a -> a -> a
+
+    -- An instance of Ord should define either 'compare' or '<='.
+    -- Using 'compare' can be more efficient for complex types.
 
--- An instance of Ord should define either compare or <=
--- Using compare can be more efficient for complex types.
     compare x y
-           | x == y    = EQ
-           | x <= y    = LT    -- NB: must be '<=' not '<' to validate the
-                               -- above claim about the minimal things that can
-                               -- be defined for an instance of Ord
-           | otherwise = GT
-
-    x <= y  = case compare x y of { GT -> False; _other -> True }
-    x <         y  = case compare x y of { LT -> True;  _other -> False }
-    x >= y  = case compare x y of { LT -> False; _other -> True }
-    x >         y  = case compare x y of { GT -> True;  _other -> False }
-
-       -- These two default methods use '>' rather than compare
+       | x == y    = EQ
+       | x <= y    = LT        -- NB: must be '<=' not '<' to validate the
+                               -- above claim about the minimal things that
+                               -- can be defined for an instance of Ord
+       | otherwise = GT
+
+    x <         y = case compare x y of { LT -> True;  _other -> False }
+    x <= y = case compare x y of { GT -> False; _other -> True }
+    x >         y = case compare x y of { GT -> True;  _other -> False }
+    x >= y = case compare x y of { LT -> False; _other -> True }
+
+       -- These two default methods use '<=' rather than 'compare'
        -- because the latter is often more expensive
-    max x y = if x > y then x else y
-    min x y = if x > y then y else x
+    max x y = if x <= y then y else x
+    min x y = if x <= y then x else y
 \end{code}
 
 %*********************************************************
@@ -188,7 +191,7 @@ class  Monad m  where
     return      :: a -> m a
     fail       :: String -> m a
 
-    m >> k      =  m >>= \_ -> k
+    m >> k      = m >>= \_ -> k
     fail s      = error s
 \end{code}
 
@@ -204,32 +207,20 @@ data [] a = [] | a : [a]  -- do explicitly: deriving (Eq, Ord)
                          -- to avoid weird names like con2tag_[]#
 
 
-instance (Eq a) => Eq [a]  where
-{-
+instance (Eq a) => Eq [a] where
     {-# SPECIALISE instance Eq [Char] #-}
--}
-    []     == []     = True    
+    []     == []     = True
     (x:xs) == (y:ys) = x == y && xs == ys
-    _xs    == _ys    = False                   
-
-    xs     /= ys     = if (xs == ys) then False else True
+    _xs    == _ys    = False
 
 instance (Ord a) => Ord [a] where
-{-
     {-# SPECIALISE instance Ord [Char] #-}
--}
-    a <  b  = case compare a b of { LT -> True;  EQ -> False; GT -> False }
-    a <= b  = case compare a b of { LT -> True;  EQ -> True;  GT -> False }
-    a >= b  = case compare a b of { LT -> False; EQ -> True;  GT -> True  }
-    a >  b  = case compare a b of { LT -> False; EQ -> False; GT -> True  }
-
     compare []     []     = EQ
-    compare (_:_)  []     = GT
     compare []     (_:_)  = LT
+    compare (_:_)  []     = GT
     compare (x:xs) (y:ys) = case compare x y of
-                                 LT -> LT      
-                                GT -> GT               
-                                EQ -> compare xs ys
+                                EQ    -> compare xs ys
+                                other -> other
 
 instance Functor [] where
     fmap = map
@@ -252,25 +243,26 @@ The rest of the prelude list functions are in PrelList.
 foldr            :: (a -> b -> b) -> b -> [a] -> b
 -- foldr _ z []     =  z
 -- foldr f z (x:xs) =  f x (foldr f z xs)
-{-# INLINE foldr #-}
+{-# INLINE [0] foldr #-}
+-- Inline only in the final stage, after the foldr/cons rule has had a chance
 foldr k z xs = go xs
             where
               go []     = z
               go (y:ys) = y `k` go ys
 
 build  :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
-{-# INLINE 2 build #-}
+{-# INLINE [1] build #-}
        -- The INLINE is important, even though build is tiny,
        -- because it prevents [] getting inlined in the version that
        -- appears in the interface file.  If [] *is* inlined, it
        -- won't match with [] appearing in rules in an importing module.
        --
-       -- The "2" says to inline in phase 2
+       -- The "1" says to inline in phase 1
 
 build g = g (:) []
 
 augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a]
-{-# INLINE 2 augment #-}
+{-# INLINE [1] augment #-}
 augment g xs = g (:) xs
 
 {-# RULES
@@ -283,8 +275,16 @@ augment g xs = g (:) xs
 "foldr/id"     foldr (:) [] = \x->x
 "foldr/app"            forall xs ys. foldr (:) ys xs = append xs ys
 
-"foldr/cons"   forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
-"foldr/nil"    forall k z.      foldr k z []     = z 
+-- The foldr/cons rule looks nice, but it can give disastrously
+-- bloated code when commpiling
+--     array (a,b) [(1,2), (2,2), (3,2), ...very long list... ]
+-- i.e. when there are very very long literal lists
+-- So I've disabled it for now. We could have special cases
+-- for short lists, I suppose.
+-- "foldr/cons"        forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
+
+"foldr/single" forall k z x. foldr k z [x] = k x z
+"foldr/nil"    forall k z.   foldr k z []  = z 
 
 "augment/build" forall (g::forall b. (a->b->b) -> b -> b)
                       (h::forall b. (a->b->b) -> b -> b) .
@@ -304,6 +304,7 @@ augment g xs = g (:) xs
 
 \begin{code}
 map :: (a -> b) -> [a] -> [b]
+{-# NOINLINE [1] map #-}
 map = mapList
 
 -- Note eta expanded
@@ -318,7 +319,7 @@ mapList f (x:xs) = f x : mapList f xs
 "map"      forall f xs.        map f xs                = build (\c n -> foldr (mapFB c f) n xs)
 "mapFB"            forall c f g.       mapFB (mapFB c f) g     = mapFB c (f.g) 
 "mapList"   forall f.          foldr (mapFB (:) f) []  = mapList f
- #-}
+  #-}
 \end{code}
 
 
@@ -327,11 +328,12 @@ mapList f (x:xs) = f x : mapList f xs
 ----------------------------------------------
 \begin{code}
 (++) :: [a] -> [a] -> [a]
+{-# NOINLINE [1] (++) #-}
 (++) = append
 
 {-# RULES
-  "++" forall xs ys. (++) xs ys = augment (\c n -> foldr c n xs) ys
- #-}
+"++"   forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
+  #-}
 
 append :: [a] -> [a] -> [a]
 append []     ys = ys
@@ -380,7 +382,7 @@ need ().  (We could arrange suck in () only if -fglasgow-exts, but putting
 it here seems more direct.)
 
 \begin{code}
-data  ()  =  ()
+data () = ()
 
 instance Eq () where
     () == () = True
@@ -416,7 +418,7 @@ data Ordering = LT | EQ | GT deriving (Eq, Ord)
 %*********************************************************
 
 \begin{code}
-type  String = [Char]
+type String = [Char]
 
 data Char = C# Char#
 
@@ -425,45 +427,47 @@ data Char = C# Char#
 -- '>' uses compare, and therefore takes two primops instead of one.
 
 instance Eq Char where
-  (C# c1) == (C# c2) = c1 `eqChar#` c2
-  (C# c1) /= (C# c2) = c1 `neChar#` c2
+    (C# c1) == (C# c2) = c1 `eqChar#` c2
+    (C# c1) /= (C# c2) = c1 `neChar#` c2
 
 instance Ord Char where
-  (C# c1) >  (C# c2) = c1 `gtChar#` c2
-  (C# c1) >= (C# c2) = c1 `geChar#` c2
-  (C# c1) <= (C# c2) = c1 `leChar#` c2
-  (C# c1) <  (C# c2) = c1 `ltChar#` c2
+    (C# c1) >  (C# c2) = c1 `gtChar#` c2
+    (C# c1) >= (C# c2) = c1 `geChar#` c2
+    (C# c1) <= (C# c2) = c1 `leChar#` c2
+    (C# c1) <  (C# c2) = c1 `ltChar#` c2
+
+{-# RULES
+"x# `eqChar#` x#" forall x#. x# `eqChar#` x# = True
+"x# `neChar#` x#" forall x#. x# `neChar#` x# = False
+"x# `gtChar#` x#" forall x#. x# `gtChar#` x# = False
+"x# `geChar#` x#" forall x#. x# `geChar#` x# = True
+"x# `leChar#` x#" forall x#. x# `leChar#` x# = True
+"x# `ltChar#` x#" forall x#. x# `ltChar#` x# = False
+  #-}
 
 chr :: Int -> Char
-chr (I# i) | i >=# 0#
-#if INT_SIZE_IN_BYTES > 4
-             && i <=# 0x7FFFFFFF#
-#endif
-             = C# (chr# i)
-          | otherwise = error ("Prelude.chr: bad argument")
+chr (I# i#) | int2Word# i# `leWord#` int2Word# 0x10FFFF# = C# (chr# i#)
+            | otherwise                                  = error "Prelude.chr: bad argument"
 
 unsafeChr :: Int -> Char
-unsafeChr (I# i) =  C# (chr# i)
+unsafeChr (I# i#) = C# (chr# i#)
 
 ord :: Char -> Int
-ord (C# c) =  I# (ord# c)
+ord (C# c#) = I# (ord# c#)
 \end{code}
 
 String equality is used when desugaring pattern-matches against strings.
-It's worth making it fast, and providing a rule to use the fast version
-where possible.
 
 \begin{code}
 eqString :: String -> String -> Bool
-eqString []            []            = True
-eqString (C# c1 : cs1) (C# c2 : cs2) = c1 `eqChar#` c2 && cs1 `eqString` cs2
-eqString _            _             = False
+eqString []       []      = True
+eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2
+eqString cs1      cs2     = False
 
-{-# RULES
-"eqString"  (==) = eqString
-  #-}  
+{-# RULES "eqString" (==) = eqString #-}
 \end{code}
 
+
 %*********************************************************
 %*                                                     *
 \subsection{Type @Int@}
@@ -477,25 +481,38 @@ zeroInt, oneInt, twoInt, maxInt, minInt :: Int
 zeroInt = I# 0#
 oneInt  = I# 1#
 twoInt  = I# 2#
-minInt  = I# (-2147483648#)    -- GHC <= 2.09 had this at -2147483647
-maxInt  = I# 2147483647#
+
+{- Seems clumsy. Should perhaps put minInt and MaxInt directly into MachDeps.h -}
+#if WORD_SIZE_IN_BITS == 31
+minInt  = I# (-0x40000000#)
+maxInt  = I# 0x3FFFFFFF#
+#elif WORD_SIZE_IN_BITS == 32
+minInt  = I# (-0x80000000#)
+maxInt  = I# 0x7FFFFFFF#
+#else 
+minInt  = I# (-0x8000000000000000#)
+maxInt  = I# 0x7FFFFFFFFFFFFFFF#
+#endif
 
 instance Eq Int where
-    (==) x y = x `eqInt` y
-    (/=) x y = x `neInt` y
+    (==) = eqInt
+    (/=) = neInt
 
 instance Ord Int where
-    compare x y = compareInt x y 
-
-    (<)  x y = ltInt x y
-    (<=) x y = leInt x y
-    (>=) x y = geInt x y
-    (>)  x y = gtInt x y
+    compare = compareInt
+    (<)     = ltInt
+    (<=)    = leInt
+    (>=)    = geInt
+    (>)     = gtInt
 
 compareInt :: Int -> Int -> Ordering
-(I# x) `compareInt` (I# y) | x <# y    = LT
-                          | x ==# y   = EQ
-                          | otherwise = GT
+(I# x#) `compareInt` (I# y#) = compareInt# x# y#
+
+compareInt# :: Int# -> Int# -> Ordering
+compareInt# x# y#
+    | x# <#  y# = LT
+    | x# ==# y# = EQ
+    | otherwise = GT
 \end{code}
 
 
@@ -525,6 +542,7 @@ flip f x y          =  f y x
 
 -- right-associating infix application operator (useful in continuation-
 -- passing style)
+{-# INLINE ($) #-}
 ($)                    :: (a -> b) -> a -> b
 f $ x                  =  f x
 
@@ -578,6 +596,20 @@ data a :*: b = a :*: b
 %*                                                     *
 %*********************************************************
 
+\begin{code}
+divInt#, modInt# :: Int# -> Int# -> Int#
+x# `divInt#` y#
+    | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y#
+    | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y#
+    | otherwise                = x# `quotInt#` y#
+x# `modInt#` y#
+    | (x# ># 0#) && (y# <# 0#) ||
+      (x# <# 0#) && (y# ># 0#)    = if r# /=# 0# then r# +# y# else 0#
+    | otherwise                   = r#
+    where
+    r# = x# `remInt#` y#
+\end{code}
+
 Definitions of the boxed PrimOps; these will be
 used in the case of partial applications, etc.
 
@@ -595,12 +627,25 @@ used in the case of partial applications, etc.
 {-# INLINE remInt #-}
 {-# INLINE negateInt #-}
 
-plusInt, minusInt, timesInt, quotInt, remInt, gcdInt :: Int -> Int -> Int
-plusInt        (I# x) (I# y) = I# (x +# y)
-minusInt(I# x) (I# y) = I# (x -# y)
-timesInt(I# x) (I# y) = I# (x *# y)
-quotInt        (I# x) (I# y) = I# (quotInt# x y)
-remInt (I# x) (I# y) = I# (remInt#  x y)
+plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt, gcdInt :: 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)
+(I# x) `quotInt`  (I# y) = I# (x `quotInt#` y)
+(I# x) `remInt`   (I# y) = I# (x `remInt#`  y)
+(I# x) `divInt`   (I# y) = I# (x `divInt#`  y)
+(I# x) `modInt`   (I# y) = I# (x `modInt#`  y)
+
+{-# RULES
+"x# +# 0#" forall x#. x# +# 0# = x#
+"0# +# x#" forall x#. 0# +# x# = x#
+"x# -# 0#" forall x#. x# -# 0# = x#
+"x# -# x#" forall x#. x# -# x# = 0#
+"x# *# 0#" forall x#. x# *# 0# = 0#
+"0# *# x#" forall x#. 0# *# x# = 0#
+"x# *# 1#" forall x#. x# *# 1# = x#
+"1# *# x#" forall x#. 1# *# x# = x#
+  #-}
 
 gcdInt (I# a) (I# b) = g a b
    where g 0# 0# = error "PrelBase.gcdInt: gcd 0 0 is undefined"
@@ -616,26 +661,61 @@ gcdInt (I# a) (I# b) = g a b
 negateInt :: Int -> Int
 negateInt (I# x) = I# (negateInt# x)
 
-divInt, modInt :: Int -> Int -> Int
-x `divInt` y 
-  | x > zeroInt && y < zeroInt = quotInt ((x `minusInt` y) `minusInt` oneInt) y
-  | x < zeroInt && y > zeroInt = quotInt ((x `minusInt` y) `plusInt`  oneInt) y
-  | otherwise     = quotInt x y
+gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool
+(I# x) `gtInt` (I# y) = x >#  y
+(I# x) `geInt` (I# y) = x >=# y
+(I# x) `eqInt` (I# y) = x ==# y
+(I# x) `neInt` (I# y) = x /=# y
+(I# x) `ltInt` (I# y) = x <#  y
+(I# x) `leInt` (I# y) = x <=# y
 
-x `modInt` y 
-  | x > zeroInt && y < zeroInt || 
-    x < zeroInt && y > zeroInt  = if r/=zeroInt then r `plusInt` y else zeroInt
-  | otherwise                  = r
-  where
-    r = remInt x y
+{-# RULES
+"x# ># x#"  forall x#. x# >#  x# = False
+"x# >=# x#" forall x#. x# >=# x# = True
+"x# ==# x#" forall x#. x# ==# x# = True
+"x# /=# x#" forall x#. x# /=# x# = False
+"x# <# x#"  forall x#. x# <#  x# = False
+"x# <=# x#" forall x#. x# <=# x# = True
+  #-}
 
-gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool
-gtInt  (I# x) (I# y) = x ># y
-geInt  (I# x) (I# y) = x >=# y
-eqInt  (I# x) (I# y) = x ==# y
-neInt  (I# x) (I# y) = x /=# y
-ltInt  (I# x) (I# y) = x <# y
-leInt  (I# x) (I# y) = x <=# y
+-- Wrappers for the shift operations.  The uncheckedShift# family are
+-- undefined when the amount being shifted by is greater than the size
+-- in bits of Int#, so these wrappers perform a check and return
+-- either zero or -1 appropriately.
+--
+-- Note that these wrappers still produce undefined results when the
+-- second argument (the shift amount) is negative.
+
+shiftL#, shiftRL# :: Word# -> Int# -> Word#
+
+a `shiftL#` b   | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
+               | otherwise                = a `uncheckedShiftL#` b
+
+a `shiftRL#` b  | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
+               | otherwise                = a `uncheckedShiftRL#` b
+
+iShiftL#, iShiftRA#, iShiftRL# :: Int# -> Int# -> Int#
+
+a `iShiftL#` b  | b >=# WORD_SIZE_IN_BITS# = 0#
+               | otherwise                = a `uncheckedIShiftL#` b
+
+a `iShiftRA#` b | b >=# WORD_SIZE_IN_BITS# = if a <# 0# then (-1#) else 0#
+               | otherwise                = a `uncheckedIShiftRA#` b
+
+a `iShiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0#
+               | otherwise                = a `uncheckedIShiftRL#` b
+
+#if WORD_SIZE_IN_BITS == 32
+{-# RULES
+"narrow32Int#"  forall x#. narrow32Int#   x# = x#
+"narrow32Word#" forall x#. narrow32Word#   x# = x#
+   #-}
+#endif
+
+{-# RULES
+"int2Word2Int"  forall x#. int2Word# (word2Int# x#) = x#
+"word2Int2Word" forall x#. word2Int# (int2Word# x#) = x#
+  #-}
 \end{code}
 
 
@@ -650,6 +730,7 @@ unpacking the strings of error messages.
 
 \begin{code}
 unpackCString# :: Addr# -> [Char]
+{-# NOINLINE [1] unpackCString# #-}
 unpackCString# a = unpackCStringList# a
 
 unpackCStringList# :: Addr# -> [Char]
@@ -673,6 +754,9 @@ unpackAppendCString# addr rest
        ch = indexCharOffAddr# addr nh
 
 unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a 
+{-# NOINLINE [0] unpackFoldrCString# #-}
+-- Don't inline till right at the end;
+-- usually the unpack-list rule turns it into unpackCStringList
 unpackFoldrCString# addr f z 
   = unpack 0#
   where
@@ -687,34 +771,23 @@ unpackCStringUtf8# addr
   = unpack 0#
   where
     unpack nh
-      | ch `eqChar#` '\0'# = []
+      | ch `eqChar#` '\0'#   = []
       | ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#)
-      | ch `leChar#` '\xDF'# = C# (chr# ((ord# ch                                  `iShiftL#`  6#) +#
-                                         (ord# (indexCharOffAddr# addr (nh +# 1#))) -# 0x3080#))
-                               : unpack (nh +# 2#)
-      | ch `leChar#` '\xEF'# = C# (chr# ((ord# ch                                  `iShiftL#` 12#) +#
-                                         (ord# (indexCharOffAddr# addr (nh +# 1#)) `iShiftL#`  6#) +#
-                                         (ord# (indexCharOffAddr# addr (nh +# 2#))) -# 0xE2080#))
-                               : unpack (nh +# 3#)
-      | ch `leChar#` '\xF7'# = C# (chr# ((ord# ch                                  `iShiftL#` 18#) +#
-                                         (ord# (indexCharOffAddr# addr (nh +# 1#)) `iShiftL#` 12#) +#
-                                         (ord# (indexCharOffAddr# addr (nh +# 2#)) `iShiftL#`  6#) +#
-                                         (ord# (indexCharOffAddr# addr (nh +# 3#))) -# 0x3C82080#))
-                               : unpack (nh +# 4#)
-      | ch `leChar#` '\xFB'# = C# (chr# ((ord# ch -# 0xF8#                         `iShiftL#` 24#) +#
-                                         (ord# (indexCharOffAddr# addr (nh +# 1#)) `iShiftL#` 18#) +#
-                                         (ord# (indexCharOffAddr# addr (nh +# 2#)) `iShiftL#` 12#) +#
-                                         (ord# (indexCharOffAddr# addr (nh +# 3#)) `iShiftL#`  6#) +#
-                                         (ord# (indexCharOffAddr# addr (nh +# 4#))) -# 0x2082080#))
-                               : unpack (nh +# 5#)
-      | otherwise           = C# (chr# (((ord# ch -# 0xFC#)                        `iShiftL#` 30#) +#
-                                        ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#)
-                                                                                   `iShiftL#` 24#) +#
-                                         (ord# (indexCharOffAddr# addr (nh +# 2#)) `iShiftL#` 18#) +#
-                                         (ord# (indexCharOffAddr# addr (nh +# 3#)) `iShiftL#` 12#) +#
-                                         (ord# (indexCharOffAddr# addr (nh +# 4#)) `iShiftL#`  6#) +#
-                                         (ord# (indexCharOffAddr# addr (nh +# 5#))) -# 0x2082080#))
-                               : unpack (nh +# 6#)
+      | ch `leChar#` '\xDF'# =
+          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#))) :
+          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#))) :
+          unpack (nh +# 4#)
       where
        ch = indexCharOffAddr# addr nh