X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelBase.lhs;h=f883948d7a04603d0a96434ca06b18ed0bc21063;hb=2f874c4c1d0cc861a8f72585a3e6f9673105b766;hp=7f2a8a926a928433b71d987c27876a0436b272bf;hpb=44b23802911814737773f4ed21dabddca515afa5;p=ghc-hetmet.git diff --git a/ghc/lib/std/PrelBase.lhs b/ghc/lib/std/PrelBase.lhs index 7f2a8a9..f883948 100644 --- a/ghc/lib/std/PrelBase.lhs +++ b/ghc/lib/std/PrelBase.lhs @@ -1,5 +1,7 @@ +% ----------------------------------------------------------------------------- +% $Id: PrelBase.lhs,v 1.61 2002/02/12 03:52:09 chak Exp $ % -% (c) The GRAP/AQUA Project, Glasgow University, 1992-1996 +% (c) The University of Glasgow, 1992-2000 % \section[PrelBase]{Module @PrelBase@} @@ -73,19 +75,18 @@ 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, to avoid lots of people - -- having to import it explicitly + module PrelGHC, -- Re-export PrelGHC and PrelErr, to avoid lots + module PrelErr -- of people having to import it explicitly ) where -import {-# SOURCE #-} PrelErr ( error ) -import {-# SOURCE #-} PrelNum ( addr2Integer ) - -- Otherwise the system import of addr2Integer looks for PrelNum.hi - import PrelGHC +import {-# SOURCE #-} PrelErr infixr 9 . infixr 5 ++, : @@ -107,14 +108,14 @@ default () -- Double isn't available yet %********************************************************* \begin{code} -{- +{- data Bool = False | True data Ordering = LT | EQ | GT data Char = C# Char# type String = [Char] data Int = I# Int# data () = () --- data [] a = MkNil +data [] a = MkNil not True = False (&&) True True = True @@ -123,14 +124,14 @@ otherwise = True build = error "urk" foldr = error "urk" -unpackCString# :: Addr# -> [Char] -unpackFoldrCString# :: Addr# -> (Char -> a -> a) -> a -> a +unpackCString# :: Addr# -> [Char] +unpackFoldrCString# :: Addr# -> (Char -> a -> a) -> a -> a unpackAppendCString# :: Addr# -> [Char] -> [Char] -unpackNBytes# :: Addr# -> Int# -> [Char] -unpackNBytes# a b = error "urk" +unpackCStringUtf8# :: Addr# -> [Char] unpackCString# a = error "urk" unpackFoldrCString# a = error "urk" unpackAppendCString# a = error "urk" +unpackCStringUtf8# a = error "urk" -} \end{code} @@ -143,37 +144,35 @@ unpackAppendCString# 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 = True - (/=) x y = not ((==) x y) - x == y = True + 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} %********************************************************* @@ -184,7 +183,7 @@ class (Eq a) => Ord a where \begin{code} class Functor f where - fmap :: (a -> b) -> f a -> f b + fmap :: (a -> b) -> f a -> f b class Monad m where (>>=) :: m a -> (a -> m b) -> m b @@ -192,9 +191,8 @@ 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} @@ -209,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 @@ -257,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 (x:xs) = x `k` go xs + 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 @@ -285,11 +272,21 @@ augment g xs = g (:) xs "foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) . foldr k z (augment g xs) = g k (foldr k z xs) -"foldr/id" foldr (:) [] = \x->x -"foldr/app" forall xs ys. foldr (:) ys xs = append xs ys +"foldr/id" foldr (:) [] = \x->x +"foldr/app" [1] forall xs ys. foldr (:) ys xs = xs ++ ys + -- Only activate this from phase 1, because that's + -- when we disable the rule that expands (++) into foldr + +-- 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/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 +"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) . @@ -309,20 +306,37 @@ augment g xs = g (:) xs \begin{code} map :: (a -> b) -> [a] -> [b] -map = mapList +map _ [] = [] +map f (x:xs) = f x : map f xs -- Note eta expanded +mapFB :: (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst +{-# INLINE [0] mapFB #-} mapFB c f x ys = c (f x) ys -mapList :: (a -> b) -> [a] -> [b] -mapList _ [] = [] -mapList f (x:xs) = f x : mapList f xs +-- The rules for map work like this. +-- +-- Up to (but not including) phase 1, we use the "map" rule to +-- rewrite all saturated applications of map with its build/fold +-- form, hoping for fusion to happen. +-- In phase 1 and 0, we switch off that rule, inline build, and +-- switch on the "mapList" rule, which rewrites the foldr/mapFB +-- thing back into plain map. +-- +-- It's important that these two rules aren't both active at once +-- (along with build's unfolding) else we'd get an infinite loop +-- in the rules. Hence the activation control below. +-- +-- The "mapFB" rule optimises compositions of map. +-- +-- This same pattern is followed by many other functions: +-- e.g. append, filter, iterate, repeat, etc. {-# RULES -"map" forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs) +"map" [~1] forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs) +"mapList" [1] forall f. foldr (mapFB (:) f) [] = map f "mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f.g) -"mapList" forall f. foldr (mapFB (:) f) [] = mapList f - #-} + #-} \end{code} @@ -331,15 +345,13 @@ mapList f (x:xs) = f x : mapList f xs ---------------------------------------------- \begin{code} (++) :: [a] -> [a] -> [a] -(++) = append +(++) [] ys = ys +(++) (x:xs) ys = x : xs ++ ys {-# RULES - "++" forall xs ys. (++) xs ys = augment (\c n -> foldr c n xs) ys - #-} +"++" [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys + #-} -append :: [a] -> [a] -> [a] -append [] ys = ys -append (x:xs) ys = x : append xs ys \end{code} @@ -384,7 +396,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 @@ -420,7 +432,7 @@ data Ordering = LT | EQ | GT deriving (Eq, Ord) %********************************************************* \begin{code} -type String = [Char] +type String = [Char] data Char = C# Char# @@ -429,24 +441,44 @@ 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# && i <=# 255# = 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. + +\begin{code} +eqString :: String -> String -> Bool +eqString [] [] = True +eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2 +eqString cs1 cs2 = False + +{-# RULES "eqString" (==) = eqString #-} \end{code} @@ -463,25 +495,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} @@ -511,6 +556,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 @@ -547,10 +593,37 @@ instance CReturnable () -- Why, exactly? %********************************************************* %* * +\subsection{Generics} +%* * +%********************************************************* + +\begin{code} +data Unit = Unit +data (:+:) a b = Inl a | Inr b +data (:*:) a b = a :*: b +\end{code} + + +%********************************************************* +%* * \subsection{Numeric primops} %* * %********************************************************* +\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. @@ -568,12 +641,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" @@ -589,26 +675,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} @@ -622,10 +743,11 @@ This code is needed for virtually all programs, since it's used for unpacking the strings of error messages. \begin{code} -unpackCString# :: Addr# -> [Char] +unpackCString# :: Addr# -> [Char] +{-# NOINLINE [1] unpackCString# #-} unpackCString# a = unpackCStringList# a -unpackCStringList# :: Addr# -> [Char] +unpackCStringList# :: Addr# -> [Char] unpackCStringList# addr = unpack 0# where @@ -645,7 +767,10 @@ unpackAppendCString# addr rest where ch = indexCharOffAddr# addr nh -unpackFoldrCString# :: Addr# -> (Char -> a -> a) -> a -> a +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 @@ -655,11 +780,32 @@ unpackFoldrCString# addr f z where ch = indexCharOffAddr# addr nh -unpackNBytes# :: Addr# -> Int# -> [Char] - -- This one is called by the compiler to unpack literal - -- strings with NULs in them; rare. It's strict! - -- We don't try to do list deforestation for this one +unpackCStringUtf8# :: Addr# -> [Char] +unpackCStringUtf8# addr + = unpack 0# + where + unpack nh + | 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#))) : + 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 +unpackNBytes# :: Addr# -> Int# -> [Char] unpackNBytes# _addr 0# = [] unpackNBytes# addr len# = unpack [] (len# -# 1#) where @@ -670,13 +816,12 @@ unpackNBytes# addr len# = unpack [] (len# -# 1#) ch -> unpack (C# ch : acc) (i# -# 1#) {-# RULES -"unpack" forall a . unpackCString# a = build (unpackFoldrCString# a) -"unpack-list" forall a . unpackFoldrCString# a (:) [] = unpackCStringList# a -"unpack-append" forall a n . unpackFoldrCString# a (:) n = unpackAppendCString# a n +"unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a) +"unpack-list" [1] forall a . unpackFoldrCString# a (:) [] = unpackCStringList# a +"unpack-append" forall a n . unpackFoldrCString# a (:) n = unpackAppendCString# a n -- There's a built-in rule (in PrelRules.lhs) for -- unpackFoldr "foo" c (unpackFoldr "baz" c n) = unpackFoldr "foobaz" c n #-} - \end{code}