question. -}
shift :: a -> Int -> a
- x `shift` i | i<0 = x `shiftR` (-i)
- | i==0 = x
- | i>0 = x `shiftL` i
+ x `shift` i | i<0 = x `shiftR` (-i)
+ | i>0 = x `shiftL` i
+ | otherwise = x
{-| @'rotate' x i@ rotates @x@ left by @i@ bits if @i@ is positive,
or right by @-i@ bits otherwise.
question. -}
rotate :: a -> Int -> a
- x `rotate` i | i<0 = x `rotateR` (-i)
- | i==0 = x
- | i>0 = x `rotateL` i
+ x `rotate` i | i<0 = x `rotateR` (-i)
+ | i>0 = x `rotateL` i
+ | otherwise = x
{-
-- Rotation can be implemented in terms of two shifts, but care is
transpose :: [[a]] -> [[a]]
transpose [] = []
transpose ([] : xss) = transpose xss
-transpose ((x:xs) : xss) = (x : [h | (h:t) <- xss]) : transpose (xs : [ t | (h:t) <- xss])
+transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss])
-- | The 'partition' function takes a predicate a list and returns
{-# INLINE partition #-}
partition p xs = foldr (select p) ([],[]) xs
+select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
select p x ~(ts,fs) | p x = (x:ts,fs)
| otherwise = (ts, x:fs)
-- The list must be finite and non-empty.
maximumBy :: (a -> a -> Ordering) -> [a] -> a
maximumBy _ [] = error "List.maximumBy: empty list"
-maximumBy cmp xs = foldl1 max xs
+maximumBy cmp xs = foldl1 maxBy xs
where
- max x y = case cmp x y of
- GT -> x
- _ -> y
+ maxBy x y = case cmp x y of
+ GT -> x
+ _ -> y
-- | The 'minimumBy' function takes a comparison function and a list
-- and returns the least element of the list by the comparison function.
-- The list must be finite and non-empty.
minimumBy :: (a -> a -> Ordering) -> [a] -> a
minimumBy _ [] = error "List.minimumBy: empty list"
-minimumBy cmp xs = foldl1 min xs
+minimumBy cmp xs = foldl1 minBy xs
where
- min x y = case cmp x y of
- GT -> y
- _ -> x
+ minBy x y = case cmp x y of
+ GT -> y
+ _ -> x
-- | The 'genericLength' function is an overloaded version of 'length'. In
-- particular, instead of returning an 'Int', it returns any type which is
--
-- > permutations "abc" == ["abc","bac","cba","bca","cab","acb"]
permutations :: [a] -> [[a]]
-permutations xs = xs : perms xs []
+permutations xs0 = xs0 : perms xs0 []
where
- perms [] is = []
+ perms [] _ = []
perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)
where interleave xs r = let (_,zs) = interleave' id xs r in zs
- interleave' f [] r = (ts, r)
+ interleave' _ [] r = (ts, r)
interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r
in (y:us, f (t:y:us) : zs)
mergesort cmp = mergesort' cmp . map wrap
mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a]
-mergesort' cmp [] = []
-mergesort' cmp [xs] = xs
+mergesort' _ [] = []
+mergesort' _ [xs] = xs
mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss)
merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]]
-merge_pairs cmp [] = []
-merge_pairs cmp [xs] = [xs]
+merge_pairs _ [] = []
+merge_pairs _ [xs] = [xs]
merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss
merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
-merge cmp [] ys = ys
-merge cmp xs [] = xs
+merge _ [] ys = ys
+merge _ xs [] = xs
merge cmp (x:xs) (y:ys)
= case x `cmp` y of
GT -> y : merge cmp (x:xs) ys
-- | A strict version of 'foldl'.
foldl' :: (a -> b -> a) -> a -> [b] -> a
#ifdef __GLASGOW_HASKELL__
-foldl' f z xs = lgo z xs
+foldl' f z0 xs0 = lgo z0 xs0
where lgo z [] = z
lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs
#else
{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+-- XXX -fno-warn-unused-imports needed for the GHC.Tuple import below. Sigh.
-----------------------------------------------------------------------------
-- |
-- Module : Data.Tuple
tup4Tc = mkTyCon "(,,,)"
instance Typeable4 (,,,) where
- typeOf4 tu = mkTyConApp tup4Tc []
+ typeOf4 _ = mkTyConApp tup4Tc []
tup5Tc :: TyCon
tup5Tc = mkTyCon "(,,,,)"
instance Typeable5 (,,,,) where
- typeOf5 tu = mkTyConApp tup5Tc []
+ typeOf5 _ = mkTyConApp tup5Tc []
tup6Tc :: TyCon
tup6Tc = mkTyCon "(,,,,,)"
instance Typeable6 (,,,,,) where
- typeOf6 tu = mkTyConApp tup6Tc []
+ typeOf6 _ = mkTyConApp tup6Tc []
tup7Tc :: TyCon
tup7Tc = mkTyCon "(,,,,,,)"
instance Typeable7 (,,,,,,) where
- typeOf7 tu = mkTyConApp tup7Tc []
+ typeOf7 _ = mkTyConApp tup7Tc []
#endif /* __NHC__ */
INSTANCE_TYPEABLE1(Ptr,ptrTc,"Ptr")
newKey :: IORef Key -> IO Key
#ifdef __GLASGOW_HASKELL__
-newKey kloc = do i <- genSym; return (Key i)
+newKey _ = do i <- genSym; return (Key i)
#else
newKey kloc = do { k@(Key i) <- readIORef kloc ;
writeIORef kloc (Key (i+1)) ;
{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# OPTIONS_GHC -fno-warn-unused-binds #-}
+-- XXX -fno-warn-unused-binds stops us warning about unused constructors,
+-- but really we should just remove them if we don't want them
-----------------------------------------------------------------------------
-- |
-- Module : Foreign.C.Types
-- | The list of elements of an array in index order.
{-# INLINE elems #-}
elems :: Ix i => Array i e -> [e]
-elems arr@(Array l u n _) =
+elems arr@(Array _ _ n _) =
[unsafeAt arr i | i <- [0 .. n - 1]]
-- | The list of associations of an array in index order.
-> (i,i) -- ^ bounds of the array
-> [(i, a)] -- ^ association list
-> Array i e
-accumArray f init (l,u) ies =
+accumArray f initial (l,u) ies =
let n = safeRangeSize (l,u)
- in unsafeAccumArray' f init (l,u) n
+ in unsafeAccumArray' f initial (l,u) n
[(safeIndex (l,u) n i, e) | (i, e) <- ies]
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(Int, a)] -> Array i e
-unsafeAccumArray f init b ies = unsafeAccumArray' f init b (rangeSize b) ies
+unsafeAccumArray f initial b ies = unsafeAccumArray' f initial b (rangeSize b) ies
{-# INLINE unsafeAccumArray' #-}
unsafeAccumArray' :: Ix i => (e -> a -> e) -> e -> (i,i) -> Int -> [(Int, a)] -> Array i e
-unsafeAccumArray' f init (l,u) n@(I# n#) ies = runST (ST $ \s1# ->
- case newArray# n# init s1# of { (# s2#, marr# #) ->
+unsafeAccumArray' f initial (l,u) n@(I# n#) ies = runST (ST $ \s1# ->
+ case newArray# n# initial s1# of { (# s2#, marr# #) ->
foldr (adjust f marr#) (done l u n marr#) ies s2# })
{-# INLINE adjust #-}
\begin{code}
{-# INLINE newSTArray #-}
newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)
-newSTArray (l,u) init = ST $ \s1# ->
+newSTArray (l,u) initial = ST $ \s1# ->
case safeRangeSize (l,u) of { n@(I# n#) ->
- case newArray# n# init s1# of { (# s2#, marr# #) ->
+ case newArray# n# initial s1# of { (# s2#, marr# #) ->
(# s2#, STArray l u n marr# #) }}
{-# INLINE boundsSTArray #-}
eqString :: String -> String -> Bool
eqString [] [] = True
eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2
-eqString cs1 cs2 = False
+eqString _ _ = False
{-# RULES "eqString" (==) = eqString #-}
-- eqString also has a BuiltInRule in PrelRules.lhs:
-- but from Template Haskell onwards it's simply
-- defined here in Base.lhs
assert :: Bool -> a -> a
-assert pred r = r
+assert _pred r = r
breakpoint :: a -> a
breakpoint r = r
-- We can do better than for Ints because we don't
-- have hassles about arithmetic overflow at maxBound
{-# INLINE [0] eftCharFB #-}
-eftCharFB c n x y = go x
+eftCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> a
+eftCharFB c n x0 y = go x0
where
go x | x ># y = n
| otherwise = C# (chr# x) `c` go (x +# 1#)
-eftChar x y | x ># y = []
- | otherwise = C# (chr# x) : eftChar (x +# 1#) y
+eftChar :: Int# -> Int# -> String
+eftChar x y | x ># y = []
+ | otherwise = C# (chr# x) : eftChar (x +# 1#) y
-- For enumFromThenTo we give up on inlining
{-# NOINLINE [0] efdCharFB #-}
+efdCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> a
efdCharFB c n x1 x2
| delta >=# 0# = go_up_char_fb c n x1 delta 0x10FFFF#
| otherwise = go_dn_char_fb c n x1 delta 0#
where
delta = x2 -# x1
+efdChar :: Int# -> Int# -> String
efdChar x1 x2
| delta >=# 0# = go_up_char_list x1 delta 0x10FFFF#
| otherwise = go_dn_char_list x1 delta 0#
delta = x2 -# x1
{-# NOINLINE [0] efdtCharFB #-}
+efdtCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
efdtCharFB c n x1 x2 lim
| delta >=# 0# = go_up_char_fb c n x1 delta lim
| otherwise = go_dn_char_fb c n x1 delta lim
where
delta = x2 -# x1
+efdtChar :: Int# -> Int# -> Int# -> String
efdtChar x1 x2 lim
| delta >=# 0# = go_up_char_list x1 delta lim
| otherwise = go_dn_char_list x1 delta lim
where
delta = x2 -# x1
-go_up_char_fb c n x delta lim
- = go_up x
+go_up_char_fb :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
+go_up_char_fb c n x0 delta lim
+ = go_up x0
where
go_up x | x ># lim = n
| otherwise = C# (chr# x) `c` go_up (x +# delta)
-go_dn_char_fb c n x delta lim
- = go_dn x
+go_dn_char_fb :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
+go_dn_char_fb c n x0 delta lim
+ = go_dn x0
where
go_dn x | x <# lim = n
| otherwise = C# (chr# x) `c` go_dn (x +# delta)
-go_up_char_list x delta lim
- = go_up x
+go_up_char_list :: Int# -> Int# -> Int# -> String
+go_up_char_list x0 delta lim
+ = go_up x0
where
go_up x | x ># lim = []
| otherwise = C# (chr# x) : go_up (x +# delta)
-go_dn_char_list x delta lim
- = go_dn x
+go_dn_char_list :: Int# -> Int# -> Int# -> String
+go_dn_char_list x0 delta lim
+ = go_dn x0
where
go_dn x | x <# lim = []
| otherwise = C# (chr# x) : go_dn (x +# delta)
eftInt :: Int# -> Int# -> [Int]
-- [x1..x2]
-eftInt x y | x ># y = []
- | otherwise = go x
+eftInt x0 y | x0 ># y = []
+ | otherwise = go x0
where
go x = I# x : if x ==# y then [] else go (x +# 1#)
{-# INLINE [0] eftIntFB #-}
eftIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> r
-eftIntFB c n x y | x ># y = n
- | otherwise = go x
+eftIntFB c n x0 y | x0 ># y = n
+ | otherwise = go x0
where
go x = I# x `c` if x ==# y then n else go (x +# 1#)
-- Watch out for y=maxBound; hence ==, not >
"0" -> "0.0e0"
[d] -> d : ".0e" ++ show_e'
(d:ds') -> d : '.' : ds' ++ "e" ++ show_e'
+ [] -> error "formatRealFloat/doFmt/FFExponent: []"
Just dec ->
let dec' = max dec 1 in
case is of
case f d is of
x@(0,_) -> x
(1,xs) -> (1, 1:xs)
+ _ -> error "roundTo: bad Value"
where
b2 = base `div` 2
fromRat :: (RealFloat a) => Rational -> a
-- Deal with special cases first, delegating the real work to fromRat'
-fromRat (n :% 0) | n > 0 = 1/0 -- +Infinity
- | n == 0 = 0/0 -- NaN
- | n < 0 = -1/0 -- -Infinity
+fromRat (n :% 0) | n > 0 = 1/0 -- +Infinity
+ | n < 0 = -1/0 -- -Infinity
+ | otherwise = 0/0 -- NaN
-fromRat (n :% d) | n > 0 = fromRat' (n :% d)
- | n == 0 = encodeFloat 0 0 -- Zero
- | n < 0 = - fromRat' ((-n) :% d)
+fromRat (n :% d) | n > 0 = fromRat' (n :% d)
+ | n < 0 = - fromRat' ((-n) :% d)
+ | otherwise = encodeFloat 0 0 -- Zero
-- Conversion process:
-- Scale the rational number by the RealFloat base until
doMalloc a = do
r <- newIORef []
IO $ \s ->
- case newPinnedByteArray# size s of { (# s, mbarr# #) ->
- (# s, ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
- (MallocPtr mbarr# r) #)
+ case newPinnedByteArray# size s of { (# s', mbarr# #) ->
+ (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
+ (MallocPtr mbarr# r) #)
}
where (I# size) = sizeOf a
mallocForeignPtrBytes (I# size) = do
r <- newIORef []
IO $ \s ->
- case newPinnedByteArray# size s of { (# s, mbarr# #) ->
- (# s, ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
- (MallocPtr mbarr# r) #)
+ case newPinnedByteArray# size s of { (# s', mbarr# #) ->
+ (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
+ (MallocPtr mbarr# r) #)
}
-- | Allocate some memory and return a 'ForeignPtr' to it. The memory
mallocPlainForeignPtr = doMalloc undefined
where doMalloc :: Storable b => b -> IO (ForeignPtr b)
doMalloc a = IO $ \s ->
- case newPinnedByteArray# size s of { (# s, mbarr# #) ->
- (# s, ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
- (PlainPtr mbarr#) #)
+ case newPinnedByteArray# size s of { (# s', mbarr# #) ->
+ (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
+ (PlainPtr mbarr#) #)
}
where (I# size) = sizeOf a
-- exception to be thrown.
mallocPlainForeignPtrBytes :: Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes (I# size) = IO $ \s ->
- case newPinnedByteArray# size s of { (# s, mbarr# #) ->
- (# s, ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
- (PlainPtr mbarr#) #)
+ case newPinnedByteArray# size s of { (# s', mbarr# #) ->
+ (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
+ (PlainPtr mbarr#) #)
}
addForeignPtrFinalizer :: FinalizerPtr a -> ForeignPtr a -> IO ()
-- are finalized objects, so a finalizer should not refer to a 'Handle'
-- (including @stdout@, @stdin@ or @stderr@).
--
-addForeignPtrConcFinalizer (ForeignPtr a c) finalizer =
+addForeignPtrConcFinalizer (ForeignPtr _ c) finalizer =
addForeignPtrConcFinalizer_ c finalizer
-addForeignPtrConcFinalizer_ f@(PlainForeignPtr r) finalizer = do
+addForeignPtrConcFinalizer_ :: ForeignPtrContents -> IO () -> IO ()
+addForeignPtrConcFinalizer_ (PlainForeignPtr r) finalizer = do
fs <- readIORef r
writeIORef r (finalizer : fs)
if (null fs)
then IO $ \s ->
case r of { IORef (STRef r#) ->
- case mkWeak# r# () (foreignPtrFinalizer r) s of { (# s1, w #) ->
+ case mkWeak# r# () (foreignPtrFinalizer r) s of { (# s1, _ #) ->
(# s1, () #) }}
else return ()
addForeignPtrConcFinalizer_ f@(MallocPtr fo r) finalizer = do
if (null fs)
then IO $ \s ->
case mkWeak# fo () (do foreignPtrFinalizer r; touch f) s of
- (# s1, w #) -> (# s1, () #)
+ (# s1, _ #) -> (# s1, () #)
else return ()
addForeignPtrConcFinalizer_ _ _ =
-- result in artificial deadlock. Another alternative is to use
-- explicit reference counting.
--
-touchForeignPtr (ForeignPtr fo r) = touch r
+touchForeignPtr (ForeignPtr _ r) = touch r
-touch r = IO $ \s -> case touch# r s of s -> (# s, () #)
+touch :: ForeignPtrContents -> IO ()
+touch r = IO $ \s -> case touch# r s of s' -> (# s', () #)
unsafeForeignPtrToPtr :: ForeignPtr a -> Ptr a
-- ^This function extracts the pointer component of a foreign
-- than combinations of 'unsafeForeignPtrToPtr' and
-- 'touchForeignPtr'. However, the later routines
-- are occasionally preferred in tool generated marshalling code.
-unsafeForeignPtrToPtr (ForeignPtr fo r) = Ptr fo
+unsafeForeignPtrToPtr (ForeignPtr fo _) = Ptr fo
castForeignPtr :: ForeignPtr a -> ForeignPtr b
-- ^This function casts a 'ForeignPtr'
refFinalizers = case foreignPtr of
(PlainForeignPtr ref) -> ref
(MallocPtr _ ref) -> ref
+ PlainPtr _ ->
+ error "finalizeForeignPtr PlainPtr"
thenIO :: IO a -> IO b -> IO b
thenIO (IO m) k = IO ( \ s ->
case m s of
- (# new_s, a #) -> unIO k new_s
+ (# new_s, _ #) -> unIO k new_s
)
returnIO :: a -> IO a
| AppendHandle
| ReadWriteHandle
+isReadableHandleType :: HandleType -> Bool
isReadableHandleType ReadHandle = True
isReadableHandleType ReadWriteHandle = True
isReadableHandleType _ = False
+isWritableHandleType :: HandleType -> Bool
isWritableHandleType AppendHandle = True
isWritableHandleType WriteHandle = True
isWritableHandleType ReadWriteHandle = True
isWritableHandleType _ = False
+isReadWriteHandleType :: HandleType -> Bool
isReadWriteHandleType ReadWriteHandle{} = True
isReadWriteHandleType _ = False
-- |Build a new 'IOArray'
newIOArray :: Ix i => (i,i) -> e -> IO (IOArray i e)
{-# INLINE newIOArray #-}
-newIOArray lu init = stToIO $ do {marr <- newSTArray lu init; return (IOArray marr)}
+newIOArray lu initial = stToIO $ do {marr <- newSTArray lu initial; return (IOArray marr)}
-- | Read a value from an 'IOArray'
unsafeReadIOArray :: Ix i => IOArray i e -> Int -> IO e
-- than the derived one.
instance Show HandleType where
- showsPrec p t =
+ showsPrec _ t =
case t of
ClosedHandle -> showString "closed"
SemiClosedHandle -> showString "semi-closed"
ReadWriteHandle -> showString "read-writable"
instance Show Handle where
- showsPrec p (FileHandle file _) = showHandle file
- showsPrec p (DuplexHandle file _ _) = showHandle file
+ showsPrec _ (FileHandle file _) = showHandle file
+ showsPrec _ (DuplexHandle file _ _) = showHandle file
+showHandle :: FilePath -> String -> String
showHandle file = showString "{handle: " . showString file . showString "}"
-- ------------------------------------------------------------------------
\begin{code}
assertError :: Addr# -> Bool -> a -> a
-assertError str pred v
- | pred = v
+assertError str predicate v
+ | predicate = v
| otherwise = throw (AssertionFailed (untangle str "Assertion failed"))
{-
maxBound = 0x7F
instance Ix Int8 where
- range (m,n) = [m..n]
- unsafeIndex b@(m,_) i = fromIntegral i - fromIntegral m
- inRange (m,n) i = m <= i && i <= n
+ range (m,n) = [m..n]
+ unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
+ inRange (m,n) i = m <= i && i <= n
instance Read Int8 where
readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
maxBound = 0x7FFF
instance Ix Int16 where
- range (m,n) = [m..n]
- unsafeIndex b@(m,_) i = fromIntegral i - fromIntegral m
- inRange (m,n) i = m <= i && i <= n
+ range (m,n) = [m..n]
+ unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
+ inRange (m,n) i = m <= i && i <= n
instance Read Int16 where
readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
maxBound = 0x7FFFFFFF
instance Ix Int32 where
- range (m,n) = [m..n]
- unsafeIndex b@(m,_) i = fromIntegral i - fromIntegral m
- inRange (m,n) i = m <= i && i <= n
+ range (m,n) = [m..n]
+ unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
+ inRange (m,n) i = m <= i && i <= n
------------------------------------------------------------------------
-- type Int64
"fromIntegral/Int64->a" fromIntegral = \(I64# x#) -> fromIntegral (I# x#)
#-}
+uncheckedIShiftL64# :: Int# -> Int# -> Int#
uncheckedIShiftL64# = uncheckedIShiftL#
+
+uncheckedIShiftRA64# :: Int# -> Int# -> Int#
uncheckedIShiftRA64# = uncheckedIShiftRA#
#endif
maxBound = 0x7FFFFFFFFFFFFFFF
instance Ix Int64 where
- range (m,n) = [m..n]
- unsafeIndex b@(m,_) i = fromIntegral i - fromIntegral m
- inRange (m,n) i = m <= i && i <= n
+ range (m,n) = [m..n]
+ unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
+ inRange (m,n) i = m <= i && i <= n
head (x:_) = x
head [] = badHead
+badHead :: a
badHead = errorEmptyList "head"
-- This rule is useful in cases like
| otherwise = filter pred xs
{-# NOINLINE [0] filterFB #-}
+filterFB :: (a -> b -> b) -> (a -> Bool) -> a -> b -> b
filterFB c p x r | p x = x `c` r
| otherwise = r
-- and hence the classic space leak on foldl (+) 0 xs
foldl :: (a -> b -> a) -> a -> [b] -> a
-foldl f z xs = lgo z xs
+foldl f z0 xs0 = lgo z0 xs0
where
lgo z [] = z
lgo z (x:xs) = lgo (f z x) xs
-- | 'scanr1' is a variant of 'scanr' that has no starting value argument.
scanr1 :: (a -> a -> a) -> [a] -> [a]
-scanr1 f [] = []
-scanr1 f [x] = [x]
+scanr1 _ [] = []
+scanr1 _ [x] = [x]
scanr1 f (x:xs) = f x q : qs
where qs@(q:_) = scanr1 f xs
iterate :: (a -> a) -> a -> [a]
iterate f x = x : iterate f (f x)
+iterateFB :: (a -> b -> b) -> (a -> a) -> a -> b
iterateFB c f x = x `c` iterateFB c f (f x)
repeat x = xs where xs = x : xs
{-# INLINE [0] repeatFB #-} -- ditto
+repeatFB :: (a -> b -> b) -> a -> b
repeatFB c x = xs where xs = x `c` xs
-- The semantics is not quite the same for error conditions
-- in the more efficient version.
--
-xs !! (I# n) | n <# 0# = error "Prelude.(!!): negative index\n"
- | otherwise = sub xs n
+xs !! (I# n0) | n0 <# 0# = error "Prelude.(!!): negative index\n"
+ | otherwise = sub xs n0
where
sub :: [a] -> Int# -> a
sub [] _ = error "Prelude.(!!): index too large\n"
%*********************************************************
\begin{code}
+foldr2 :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c
foldr2 _k z [] _ys = z
foldr2 _k z _xs [] = z
foldr2 k z (x:xs) (y:ys) = k x y (foldr2 k z xs ys)
+foldr2_left :: (a -> b -> c -> d) -> d -> a -> ([b] -> c) -> [b] -> d
foldr2_left _k z _x _r [] = z
foldr2_left k _z x r (y:ys) = k x y (r ys)
+foldr2_right :: (a -> b -> c -> d) -> d -> b -> ([a] -> c) -> [a] -> d
foldr2_right _k z _y _r [] = z
foldr2_right k _z y r (x:xs) = k x y (r xs)
zip _ _ = []
{-# INLINE [0] zipFB #-}
+zipFB :: ((a, b) -> c -> d) -> a -> b -> c -> d
zipFB c x y r = (x,y) `c` r
{-# RULES
zipWith _ _ _ = []
{-# INLINE [0] zipWithFB #-}
+zipWithFB :: (a -> b -> c) -> (d -> e -> a) -> d -> e -> b -> c
zipWithFB c f x y r = (x `f` y) `c` r
{-# RULES
-- Divide an conquer implementation of string conversion
integerToString :: Integer -> String -> String
-integerToString n cs
- | n < 0 = '-' : integerToString' (-n) cs
- | otherwise = integerToString' n cs
+integerToString n0 cs0
+ | n0 < 0 = '-' : integerToString' (- n0) cs0
+ | otherwise = integerToString' n0 cs0
where
integerToString' :: Integer -> String -> String
integerToString' n cs
(# q, r #) ->
if q > 0 then fromInteger q : fromInteger r : jsplitb p ns
else fromInteger r : jsplitb p ns
+ jsplith _ [] = error "jsplith: []"
jsplitb :: Integer -> [Integer] -> [Integer]
- jsplitb p [] = []
+ jsplitb _ [] = []
jsplitb p (n:ns) = case n `quotRemInteger` p of
(# q, r #) ->
q : r : jsplitb p ns
r = fromInteger r'
in if q > 0 then jhead q $ jblock r $ jprintb ns cs
else jhead r $ jprintb ns cs
+ jprinth [] _ = error "jprinth []"
jprintb :: [Integer] -> String -> String
jprintb [] cs = cs
-- head (drop 1000000 [1 .. ]
-- works
+enumDeltaToIntegerFB :: (Integer -> a -> a) -> a
+ -> Integer -> Integer -> Integer -> a
enumDeltaToIntegerFB c n x delta lim
| delta >= 0 = up_fb c n x delta lim
| otherwise = dn_fb c n x delta lim
+enumDeltaToInteger :: Integer -> Integer -> Integer -> [Integer]
enumDeltaToInteger x delta lim
| delta >= 0 = up_list x delta lim
| otherwise = dn_list x delta lim
-up_fb c n x delta lim = go (x::Integer)
+up_fb :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a
+up_fb c n x0 delta lim = go (x0 :: Integer)
where
go x | x > lim = n
| otherwise = x `c` go (x+delta)
-dn_fb c n x delta lim = go (x::Integer)
+dn_fb :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a
+dn_fb c n x0 delta lim = go (x0 :: Integer)
where
go x | x < lim = n
| otherwise = x `c` go (x+delta)
-up_list x delta lim = go (x::Integer)
+up_list :: Integer -> Integer -> Integer -> [Integer]
+up_list x0 delta lim = go (x0 :: Integer)
where
go x | x > lim = []
| otherwise = x : go (x+delta)
-dn_list x delta lim = go (x::Integer)
+dn_list :: Integer -> Integer -> Integer -> [Integer]
+dn_list x0 delta lim = go (x0 :: Integer)
where
go x | x < lim = []
| otherwise = x : go (x+delta)
-
\end{code}
#if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64)
instance Show (Ptr a) where
- showsPrec p (Ptr a) rs = pad_out (showHex (wordToInteger(int2Word#(addr2Int# a))) "") rs
+ showsPrec _ (Ptr a) rs = pad_out (showHex (wordToInteger(int2Word#(addr2Int# a))) "")
where
-- want 0s prefixed to pad it out to a fixed length.
- pad_out ls rs =
+ pad_out ls =
'0':'x':(replicate (2*SIZEOF_HSPTR - length ls) '0') ++ ls ++ rs
instance Show (FunPtr a) where
instance (Ix a, Read a, Read b) => Read (Array a b) where
readPrec = parens $ prec appPrec $
do L.Ident "array" <- lexP
- bounds <- step readPrec
+ theBounds <- step readPrec
vals <- step readPrec
- return (array bounds vals)
+ return (array theBounds vals)
readListPrec = readListPrecDefault
readList = readListDefault
-1 -> n
0 -> if even n then n else m
1 -> m
+ _ -> error "round default defn: Bad value"
ceiling x = if r > 0 then n + 1 else n
where (n,r) = properFraction x
numericEnumFromTo n m = takeWhile (<= m + 1/2) (numericEnumFrom n)
numericEnumFromThenTo :: (Ord a, Fractional a) => a -> a -> a -> [a]
-numericEnumFromThenTo e1 e2 e3 = takeWhile pred (numericEnumFromThen e1 e2)
+numericEnumFromThenTo e1 e2 e3
+ = takeWhile predicate (numericEnumFromThen e1 e2)
where
mid = (e2 - e1) / 2
- pred | e2 >= e1 = (<= e3 + mid)
- | otherwise = (>= e3 + mid)
+ predicate | e2 >= e1 = (<= e3 + mid)
+ | otherwise = (>= e3 + mid)
\end{code}
instance Integral Integer where
toInteger n = n
- a `quot` 0 = divZeroError
+ _ `quot` 0 = divZeroError
n `quot` d = n `quotInteger` d
- a `rem` 0 = divZeroError
+ _ `rem` 0 = divZeroError
n `rem` d = n `remInteger` d
- a `divMod` 0 = divZeroError
+ _ `divMod` 0 = divZeroError
a `divMod` b = case a `divModInteger` b of
(# x, y #) -> (x, y)
- a `quotRem` 0 = divZeroError
+ _ `quotRem` 0 = divZeroError
a `quotRem` b = case a `quotRemInteger` b of
(# q, r #) -> (q, r)
-- I've done manual eta-expansion here, becuase otherwise it's
-- impossible to stop (asciiTab!!ord) getting floated out as an MFE
+isDec :: Char -> Bool
isDec c = c >= '0' && c <= '9'
protectEsc :: (Char -> Bool) -> ShowS -> ShowS
| i >=# 10# && i <=# 15# = unsafeChr (ord 'a' `minusInt` ten `plusInt` I# i)
| otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i))
+ten :: Int
ten = I# 10#
showSignedInt :: Int -> Int -> ShowS
| otherwise = itos' n# cs
where
itos' :: Int# -> String -> String
- itos' n# cs
- | n# <# 10# = C# (chr# (ord# '0'# +# n#)) : cs
- | otherwise = case chr# (ord# '0'# +# (n# `remInt#` 10#)) of { c# ->
- itos' (n# `quotInt#` 10#) (C# c# : cs) }
+ itos' x# cs'
+ | x# <# 10# = C# (chr# (ord# '0'# +# x#)) : cs'
+ | otherwise = case chr# (ord# '0'# +# (x# `remInt#` 10#)) of { c# ->
+ itos' (x# `quotInt#` 10#) (C# c# : cs') }
\end{code}
toUpper c = chr (fromIntegral (towupper (fromIntegral (ord c))))
toTitle c = chr (fromIntegral (towtitle (fromIntegral (ord c))))
-foreign import ccall unsafe "u_iswdigit"
- iswdigit :: CInt -> CInt
-
foreign import ccall unsafe "u_iswalpha"
iswalpha :: CInt -> CInt
0# -> (# s, () #)
_ -> let m' = m -# 1# in
case indexArray# arr m' of { (# io #) ->
- case unIO io s of { (# s, _ #) ->
- unIO (go m') s
+ case unIO io s of { (# s', _ #) ->
+ unIO (go m') s'
}}
in
go n
enumFromThenTo = integralEnumFromThenTo
instance Integral Word where
- quot x@(W# x#) y@(W# y#)
+ quot (W# x#) y@(W# y#)
| y /= 0 = W# (x# `quotWord#` y#)
| otherwise = divZeroError
- rem x@(W# x#) y@(W# y#)
+ rem (W# x#) y@(W# y#)
| y /= 0 = W# (x# `remWord#` y#)
| otherwise = divZeroError
- div x@(W# x#) y@(W# y#)
+ div (W# x#) y@(W# y#)
| y /= 0 = W# (x# `quotWord#` y#)
| otherwise = divZeroError
- mod x@(W# x#) y@(W# y#)
+ mod (W# x#) y@(W# y#)
| y /= 0 = W# (x# `remWord#` y#)
| otherwise = divZeroError
- quotRem x@(W# x#) y@(W# y#)
+ quotRem (W# x#) y@(W# y#)
| y /= 0 = (W# (x# `quotWord#` y#), W# (x# `remWord#` y#))
| otherwise = divZeroError
- divMod x@(W# x#) y@(W# y#)
+ divMod (W# x#) y@(W# y#)
| y /= 0 = (W# (x# `quotWord#` y#), W# (x# `remWord#` y#))
| otherwise = divZeroError
toInteger (W# x#)
#endif
instance Ix Word where
- range (m,n) = [m..n]
- unsafeIndex b@(m,_) i = fromIntegral (i - m)
- inRange (m,n) i = m <= i && i <= n
+ range (m,n) = [m..n]
+ unsafeIndex (m,_) i = fromIntegral (i - m)
+ inRange (m,n) i = m <= i && i <= n
instance Read Word where
readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
enumFromThen = boundedEnumFromThen
instance Integral Word8 where
- quot x@(W8# x#) y@(W8# y#)
+ quot (W8# x#) y@(W8# y#)
| y /= 0 = W8# (x# `quotWord#` y#)
| otherwise = divZeroError
- rem x@(W8# x#) y@(W8# y#)
+ rem (W8# x#) y@(W8# y#)
| y /= 0 = W8# (x# `remWord#` y#)
| otherwise = divZeroError
- div x@(W8# x#) y@(W8# y#)
+ div (W8# x#) y@(W8# y#)
| y /= 0 = W8# (x# `quotWord#` y#)
| otherwise = divZeroError
- mod x@(W8# x#) y@(W8# y#)
+ mod (W8# x#) y@(W8# y#)
| y /= 0 = W8# (x# `remWord#` y#)
| otherwise = divZeroError
- quotRem x@(W8# x#) y@(W8# y#)
+ quotRem (W8# x#) y@(W8# y#)
| y /= 0 = (W8# (x# `quotWord#` y#), W8# (x# `remWord#` y#))
| otherwise = divZeroError
- divMod x@(W8# x#) y@(W8# y#)
+ divMod (W8# x#) y@(W8# y#)
| y /= 0 = (W8# (x# `quotWord#` y#), W8# (x# `remWord#` y#))
| otherwise = divZeroError
toInteger (W8# x#) = smallInteger (word2Int# x#)
maxBound = 0xFF
instance Ix Word8 where
- range (m,n) = [m..n]
- unsafeIndex b@(m,_) i = fromIntegral (i - m)
- inRange (m,n) i = m <= i && i <= n
+ range (m,n) = [m..n]
+ unsafeIndex (m,_) i = fromIntegral (i - m)
+ inRange (m,n) i = m <= i && i <= n
instance Read Word8 where
readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
enumFromThen = boundedEnumFromThen
instance Integral Word16 where
- quot x@(W16# x#) y@(W16# y#)
+ quot (W16# x#) y@(W16# y#)
| y /= 0 = W16# (x# `quotWord#` y#)
| otherwise = divZeroError
- rem x@(W16# x#) y@(W16# y#)
+ rem (W16# x#) y@(W16# y#)
| y /= 0 = W16# (x# `remWord#` y#)
| otherwise = divZeroError
- div x@(W16# x#) y@(W16# y#)
+ div (W16# x#) y@(W16# y#)
| y /= 0 = W16# (x# `quotWord#` y#)
| otherwise = divZeroError
- mod x@(W16# x#) y@(W16# y#)
+ mod (W16# x#) y@(W16# y#)
| y /= 0 = W16# (x# `remWord#` y#)
| otherwise = divZeroError
- quotRem x@(W16# x#) y@(W16# y#)
+ quotRem (W16# x#) y@(W16# y#)
| y /= 0 = (W16# (x# `quotWord#` y#), W16# (x# `remWord#` y#))
| otherwise = divZeroError
- divMod x@(W16# x#) y@(W16# y#)
+ divMod (W16# x#) y@(W16# y#)
| y /= 0 = (W16# (x# `quotWord#` y#), W16# (x# `remWord#` y#))
| otherwise = divZeroError
toInteger (W16# x#) = smallInteger (word2Int# x#)
maxBound = 0xFFFF
instance Ix Word16 where
- range (m,n) = [m..n]
- unsafeIndex b@(m,_) i = fromIntegral (i - m)
- inRange (m,n) i = m <= i && i <= n
+ range (m,n) = [m..n]
+ unsafeIndex (m,_) i = fromIntegral (i - m)
+ inRange (m,n) i = m <= i && i <= n
instance Read Word16 where
readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
#endif
instance Integral Word32 where
- quot x@(W32# x#) y@(W32# y#)
+ quot (W32# x#) y@(W32# y#)
| y /= 0 = W32# (x# `quotWord#` y#)
| otherwise = divZeroError
- rem x@(W32# x#) y@(W32# y#)
+ rem (W32# x#) y@(W32# y#)
| y /= 0 = W32# (x# `remWord#` y#)
| otherwise = divZeroError
- div x@(W32# x#) y@(W32# y#)
+ div (W32# x#) y@(W32# y#)
| y /= 0 = W32# (x# `quotWord#` y#)
| otherwise = divZeroError
- mod x@(W32# x#) y@(W32# y#)
+ mod (W32# x#) y@(W32# y#)
| y /= 0 = W32# (x# `remWord#` y#)
| otherwise = divZeroError
- quotRem x@(W32# x#) y@(W32# y#)
+ quotRem (W32# x#) y@(W32# y#)
| y /= 0 = (W32# (x# `quotWord#` y#), W32# (x# `remWord#` y#))
| otherwise = divZeroError
- divMod x@(W32# x#) y@(W32# y#)
+ divMod (W32# x#) y@(W32# y#)
| y /= 0 = (W32# (x# `quotWord#` y#), W32# (x# `remWord#` y#))
| otherwise = divZeroError
toInteger (W32# x#)
maxBound = 0xFFFFFFFF
instance Ix Word32 where
- range (m,n) = [m..n]
- unsafeIndex b@(m,_) i = fromIntegral (i - m)
- inRange (m,n) i = m <= i && i <= n
+ range (m,n) = [m..n]
+ unsafeIndex (m,_) i = fromIntegral (i - m)
+ inRange (m,n) i = m <= i && i <= n
instance Read Word32 where
#if WORD_SIZE_IN_BITS < 33
enumFromThenTo = integralEnumFromThenTo
instance Integral Word64 where
- quot x@(W64# x#) y@(W64# y#)
+ quot (W64# x#) y@(W64# y#)
| y /= 0 = W64# (x# `quotWord#` y#)
| otherwise = divZeroError
- rem x@(W64# x#) y@(W64# y#)
+ rem (W64# x#) y@(W64# y#)
| y /= 0 = W64# (x# `remWord#` y#)
| otherwise = divZeroError
- div x@(W64# x#) y@(W64# y#)
+ div (W64# x#) y@(W64# y#)
| y /= 0 = W64# (x# `quotWord#` y#)
| otherwise = divZeroError
- mod x@(W64# x#) y@(W64# y#)
+ mod (W64# x#) y@(W64# y#)
| y /= 0 = W64# (x# `remWord#` y#)
| otherwise = divZeroError
- quotRem x@(W64# x#) y@(W64# y#)
+ quotRem (W64# x#) y@(W64# y#)
| y /= 0 = (W64# (x# `quotWord#` y#), W64# (x# `remWord#` y#))
| otherwise = divZeroError
- divMod x@(W64# x#) y@(W64# y#)
+ divMod (W64# x#) y@(W64# y#)
| y /= 0 = (W64# (x# `quotWord#` y#), W64# (x# `remWord#` y#))
| otherwise = divZeroError
toInteger (W64# x#)
"fromIntegral/Word64->a" fromIntegral = \(W64# x#) -> fromIntegral (W# x#)
#-}
+uncheckedShiftL64# :: Word# -> Int# -> Word#
uncheckedShiftL64# = uncheckedShiftL#
+
+uncheckedShiftRL64# :: Word# -> Int# -> Word#
uncheckedShiftRL64# = uncheckedShiftRL#
#endif
maxBound = 0xFFFFFFFFFFFFFFFF
instance Ix Word64 where
- range (m,n) = [m..n]
- unsafeIndex b@(m,_) i = fromIntegral (i - m)
- inRange (m,n) i = m <= i && i <= n
+ range (m,n) = [m..n]
+ unsafeIndex (m,_) i = fromIntegral (i - m)
+ inRange (m,n) i = m <= i && i <= n
instance Read Word64 where
readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
case tok of
L.Rat y -> return (fromRational y)
L.Int i -> return (fromInteger i)
- other -> pfail
+ _ -> pfail
-- It's turgid to have readSigned work using list comprehensions,
-- but it's specified as a ReadS to ReadS transformer
-- | Show /non-negative/ 'Integral' numbers in base 10.
showInt :: Integral a => a -> ShowS
-showInt n cs
- | n < 0 = error "Numeric.showInt: can't show negative numbers"
- | otherwise = go n cs
+showInt n0 cs0
+ | n0 < 0 = error "Numeric.showInt: can't show negative numbers"
+ | otherwise = go n0 cs0
where
go n cs
| n < 10 = case unsafeChr (ord '0' + fromIntegral n) of
-- | Shows a /non-negative/ 'Integral' number using the base specified by the
-- first argument, and the character representation specified by the second.
showIntAtBase :: Integral a => a -> (Int -> Char) -> a -> ShowS
-showIntAtBase base toChr n r
+showIntAtBase base toChr n0 r0
| base <= 1 = error ("Numeric.showIntAtBase: applied to unsupported base " ++ show base)
- | n < 0 = error ("Numeric.showIntAtBase: applied to negative number " ++ show n)
- | otherwise = showIt (quotRem n base) r
+ | n0 < 0 = error ("Numeric.showIntAtBase: applied to negative number " ++ show n0)
+ | otherwise = showIt (quotRem n0 base) r0
where
showIt (n,d) r = seq c $ -- stricter than necessary
case n of
(Get f) >>= k = Get (\c -> f c >>= k)
(Look f) >>= k = Look (\s -> f s >>= k)
- Fail >>= k = Fail
+ Fail >>= _ = Fail
(Result x p) >>= k = k x `mplus` (p >>= k)
(Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]
-- locally produces any result at all, then right parser is
-- not used.
#ifdef __GLASGOW_HASKELL__
-R f <++ q =
+R f0 <++ q =
do s <- look
- probe (f return) s 0#
+ probe (f0 return) s 0#
where
probe (Get f) (c:s) n = probe (f c) s (n+#1#)
probe (Look f) s n = probe (f s) s n
R (\k -> gath id (m (\a -> return (\s -> k (s,a)))))
where
gath l (Get f) = Get (\c -> gath (l.(c:)) (f c))
- gath l Fail = Fail
+ gath _ Fail = Fail
gath l (Look f) = Look (\s -> gath l (f s))
gath l (Result k p) = k (l []) `mplus` gath l p
- gath l (Final r) = error "do not use readS_to_P in gather!"
+ gath _ (Final _) = error "do not use readS_to_P in gather!"
-- ---------------------------------------------------------------------------
-- Derived operations
-- ---------------------------------------------------------------------------
-- The readPrec type
-newtype ReadPrec a = P { unP :: Prec -> ReadP a }
+newtype ReadPrec a = P (Prec -> ReadP a)
-- Functor, Monad, MonadPlus
reset :: ReadPrec a -> ReadPrec a
-- ^ Resets the precedence context to zero.
-reset (P f) = P (\n -> f minPrec)
+reset (P f) = P (\_ -> f minPrec)
prec :: Prec -> ReadPrec a -> ReadPrec a
-- ^ @(prec n p)@ checks whether the precedence context is
lexCharE :: ReadP (Char, Bool) -- "escaped or not"?
lexCharE =
- do c <- get
- if c == '\\'
- then do c <- lexEsc; return (c, True)
- else do return (c, False)
+ do c1 <- get
+ if c1 == '\\'
+ then do c2 <- lexEsc; return (c2, True)
+ else do return (c1, False)
where
lexEsc =
lexEscChar
-- Read the fractional part; fail if it doesn't
-- start ".d" where d is a digit
lexFrac = do char '.'
- frac <- lexDigits 10
- return (Just frac)
+ fraction <- lexDigits 10
+ return (Just fraction)
lexExp :: ReadP (Maybe Integer)
lexExp = do char 'e' +++ char 'E'
val :: Num a => a -> a -> Digits -> a
-- val base y [d1,..,dn] = y ++ [d1,..,dn], as it were
-val base y [] = y
+val _ y [] = y
val base y (x:xs) = y' `seq` val base y' xs
where
y' = y * base + fromIntegral x
frac :: Integral a => a -> a -> a -> Digits -> Ratio a
-frac base a b [] = a % b
+frac _ a b [] = a % b
frac base a b (x:xs) = a' `seq` b' `seq` frac base a' b' xs
where
a' = a * base + fromIntegral x
| 'A' <= c && c <= 'F' = Just (ord c - ord 'A' + 10)
| otherwise = Nothing
+valDig _ _ = error "valDig: Bad base"
+
+valDecDig :: Char -> Maybe Int
valDecDig c
| '0' <= c && c <= '9' = Just (ord c - ord '0')
| otherwise = Nothing
projects / ghc-base.git / commitdiff