mirror of
https://github.com/tweag/asterius.git
synced 2024-11-13 07:18:19 +03:00
Migrate to ghc-8.6.5 (#241)
This commit is contained in:
Shao Cheng
GitHub
parent
883d6e98bb
commit
f08260a4f6
@ -24,6 +24,7 @@ jobs:
|
||||
g++ \
|
||||
git \
|
||||
gnupg \
|
||||
libdw-dev \
|
||||
libffi-dev \
|
||||
libgmp-dev \
|
||||
libncurses-dev \
|
||||
@ -85,6 +86,7 @@ jobs:
|
||||
g++ \
|
||||
git \
|
||||
gnupg \
|
||||
libdw-dev \
|
||||
libffi-dev \
|
||||
libgmp-dev \
|
||||
libncurses-dev \
|
||||
@ -164,6 +166,7 @@ jobs:
|
||||
g++ \
|
||||
git \
|
||||
gnupg \
|
||||
libdw-dev \
|
||||
libffi-dev \
|
||||
libgmp-dev \
|
||||
libncurses-dev \
|
||||
@ -228,6 +231,7 @@ jobs:
|
||||
g++ \
|
||||
git \
|
||||
gnupg \
|
||||
libdw-dev \
|
||||
libffi-dev \
|
||||
libgmp-dev \
|
||||
libncurses-dev \
|
||||
@ -292,6 +296,7 @@ jobs:
|
||||
g++ \
|
||||
git \
|
||||
gnupg \
|
||||
libdw-dev \
|
||||
libffi-dev \
|
||||
libgmp-dev \
|
||||
libncurses-dev \
|
||||
@ -356,6 +361,7 @@ jobs:
|
||||
g++ \
|
||||
git \
|
||||
gnupg \
|
||||
libdw-dev \
|
||||
libffi-dev \
|
||||
libgmp-dev \
|
||||
libncurses-dev \
|
||||
|
||||
@ -25,6 +25,7 @@ RUN \
|
||||
g++ \
|
||||
gcc \
|
||||
gnupg \
|
||||
libdw-dev \
|
||||
libffi-dev \
|
||||
libgmp-dev \
|
||||
libncurses-dev \
|
||||
|
||||
@ -8,6 +8,7 @@ $ASTERIUS_GHC integer-simple/Setup.hs -no-keep-hi-files -no-keep-o-files -thread
|
||||
$ASTERIUS_GHC base/Setup.hs -no-keep-hi-files -no-keep-o-files -threaded -rtsopts -with-rtsopts="-I0 -qg -qb" -o $ASTERIUS_TMP_DIR/Setup-autoconf
|
||||
|
||||
cd ghc-prim
|
||||
autoreconf -i
|
||||
$ASTERIUS_TMP_DIR/Setup-ghc-prim configure --prefix=$ASTERIUS_LIB_DIR --package-db=clear --package-db=global --builddir=$ASTERIUS_TMP_DIR/dist/ghc-prim --with-ghc=$ASTERIUS_AHC --with-ghc-pkg=$ASTERIUS_AHCPKG $ASTERIUS_CONFIGURE_OPTIONS
|
||||
$ASTERIUS_TMP_DIR/Setup-ghc-prim build --builddir=$ASTERIUS_TMP_DIR/dist/ghc-prim $ASTERIUS_BUILD_OPTIONS
|
||||
$ASTERIUS_TMP_DIR/Setup-ghc-prim install --builddir=$ASTERIUS_TMP_DIR/dist/ghc-prim $ASTERIUS_INSTALL_OPTIONS
|
||||
|
||||
@ -118,9 +118,6 @@ export function newAsteriusInstance(req) {
|
||||
asin: x => Math.asin(x),
|
||||
acos: x => Math.acos(x),
|
||||
atan: x => Math.atan(x),
|
||||
asinh: x => Math.asinh(x),
|
||||
acosh: x => Math.acosh(x),
|
||||
atanh: x => Math.atanh(x),
|
||||
log: x => Math.log(x),
|
||||
exp: x => Math.exp(x),
|
||||
pow: (x, y) => Math.pow(x, y)
|
||||
|
||||
@ -229,9 +229,6 @@ rtsFunctionImports debug =
|
||||
, "asin"
|
||||
, "acos"
|
||||
, "atan"
|
||||
, "asinh"
|
||||
, "acosh"
|
||||
, "atanh"
|
||||
, "log"
|
||||
, "exp"
|
||||
]
|
||||
|
||||
@ -137,7 +137,7 @@ marshalCmmStatic st =
|
||||
pure $ SymbolStatic sym o
|
||||
_ -> throwError $ UnsupportedCmmLit $ showSBS lit
|
||||
GHC.CmmUninitialised s -> pure $ Uninitialized s
|
||||
GHC.CmmString s -> pure $ Serialized $ SBS.toShort s <> "\0"
|
||||
GHC.CmmString s -> pure $ Serialized $ SBS.pack $ s <> [0]
|
||||
|
||||
marshalCmmSectionType ::
|
||||
AsteriusEntitySymbol -> GHC.Section -> AsteriusStaticsType
|
||||
@ -668,13 +668,6 @@ marshalCmmPrimCall GHC.MO_F64_Acos [r] [x] =
|
||||
marshalCmmPrimCall GHC.MO_F64_Atan [r] [x] =
|
||||
marshalCmmUnMathPrimCall "atan" F64 r x
|
||||
|
||||
marshalCmmPrimCall GHC.MO_F64_Asinh [r] [x] =
|
||||
marshalCmmUnMathPrimCall "asinh" F64 r x
|
||||
marshalCmmPrimCall GHC.MO_F64_Acosh [r] [x] =
|
||||
marshalCmmUnMathPrimCall "acosh" F64 r x
|
||||
marshalCmmPrimCall GHC.MO_F64_Atanh [r] [x] =
|
||||
marshalCmmUnMathPrimCall "atanh" F64 r x
|
||||
|
||||
marshalCmmPrimCall GHC.MO_F64_Log [r] [x] =
|
||||
marshalCmmUnMathPrimCall "log" F64 r x
|
||||
marshalCmmPrimCall GHC.MO_F64_Exp [r] [x] =
|
||||
@ -711,13 +704,6 @@ marshalCmmPrimCall GHC.MO_F32_Acos [r] [x] =
|
||||
marshalCmmPrimCall GHC.MO_F32_Atan [r] [x] =
|
||||
marshalCmmUnMathPrimCall "atan" F32 r x
|
||||
|
||||
marshalCmmPrimCall GHC.MO_F32_Asinh [r] [x] =
|
||||
marshalCmmUnMathPrimCall "asinh" F32 r x
|
||||
marshalCmmPrimCall GHC.MO_F32_Acosh [r] [x] =
|
||||
marshalCmmUnMathPrimCall "acosh" F32 r x
|
||||
marshalCmmPrimCall GHC.MO_F32_Atanh [r] [x] =
|
||||
marshalCmmUnMathPrimCall "atanh" F32 r x
|
||||
|
||||
marshalCmmPrimCall GHC.MO_F32_Log [r] [x] =
|
||||
marshalCmmUnMathPrimCall "log" F32 r x
|
||||
marshalCmmPrimCall GHC.MO_F32_Exp [r] [x] =
|
||||
@ -1113,7 +1099,7 @@ marshalCmmPrimCall (GHC.MO_U_Mul2 GHC.W64) [hi, lo] [x, y] = do
|
||||
}
|
||||
}
|
||||
pure [hiout, loout]
|
||||
|
||||
|
||||
|
||||
-- See also: QuotRemWord2#
|
||||
marshalCmmPrimCall (GHC.MO_U_QuotRem2 GHC.W64) [quot, rem] [lhsHi, lhsLo, rhs] = do
|
||||
@ -1123,7 +1109,7 @@ marshalCmmPrimCall (GHC.MO_U_QuotRem2 GHC.W64) [quot, rem] [lhsHi, lhsLo, rhs] =
|
||||
(lhsHir, _) <- marshalCmmExpr lhsHi
|
||||
(lhsLor, _) <- marshalCmmExpr lhsLo
|
||||
(rhsr, _) <- marshalCmmExpr rhs
|
||||
|
||||
|
||||
-- | Smash the high and low 32 bits together to create a 64 bit
|
||||
-- number.
|
||||
let smash32IntTo64 hi32 lo32 =
|
||||
@ -1182,8 +1168,8 @@ marshalCmmPrimCall (GHC.MO_U_QuotRem2 GHC.W64) [quot, rem] [lhsHi, lhsLo, rhs] =
|
||||
, callImportReturnTypes = [I32]
|
||||
}
|
||||
}
|
||||
|
||||
pure [quotout, remout]
|
||||
|
||||
pure [quotout, remout]
|
||||
|
||||
marshalCmmPrimCall op rs xs =
|
||||
throwError $
|
||||
@ -1217,7 +1203,7 @@ marshalCmmUnsafeCall p@(GHC.CmmLit (GHC.CmmLabel clbl)) f rs xs = do
|
||||
throwError $
|
||||
UnsupportedCmmInstr $
|
||||
showSBS $ GHC.CmmUnsafeForeignCall (GHC.ForeignTarget p f) rs xs
|
||||
|
||||
|
||||
marshalCmmUnsafeCall p f rs xs =
|
||||
throwError $
|
||||
UnsupportedCmmInstr $
|
||||
|
||||
@ -103,6 +103,7 @@ import Asterius.Passes.All
|
||||
import Asterius.Passes.Barf
|
||||
import Asterius.Passes.GlobalRegs
|
||||
import Asterius.Types
|
||||
import Control.Monad.Fail
|
||||
import Control.Monad.State.Strict
|
||||
import qualified Data.ByteString.Short as SBS
|
||||
import qualified Data.Map.Lazy as LM
|
||||
|
||||
@ -299,7 +299,7 @@ processFFI mod_sym = w
|
||||
{ ffiExportDecls =
|
||||
M.insert
|
||||
AsteriusEntitySymbol
|
||||
{entityName = SBS.toShort $ GHC.bytesFS lbl}
|
||||
{entityName = SBS.toShort $ GHC.fastStringToByteString lbl}
|
||||
FFIExportDecl
|
||||
{ffiFunctionType = ffi_ftype, ffiExportClosure = ""}
|
||||
ffiExportDecls
|
||||
@ -377,7 +377,7 @@ addFFIProcessor c = do
|
||||
export_func_name =
|
||||
AsteriusEntitySymbol
|
||||
{ entityName =
|
||||
SBS.toShort $ GHC.bytesFS lbl
|
||||
SBS.toShort $ GHC.fastStringToByteString lbl
|
||||
}
|
||||
export_closure =
|
||||
fromString $
|
||||
|
||||
@ -24,7 +24,7 @@ sizeofStatics :: AsteriusStatics -> Int64
|
||||
sizeofStatics =
|
||||
fromIntegral .
|
||||
getSum .
|
||||
foldMap'
|
||||
foldMap
|
||||
(Sum . \case
|
||||
SymbolStatic {} -> 8
|
||||
Uninitialized x -> x
|
||||
|
||||
@ -24,7 +24,7 @@ main =
|
||||
, withPrograms = prog_db
|
||||
} <- confHook simpleUserHooks t f
|
||||
let [clbi@LibComponentLocalBuildInfo {componentUnitId = uid}] =
|
||||
componentNameMap lbi M.! CLibName LMainLibName
|
||||
componentNameMap lbi M.! CLibName
|
||||
amp = autogenComponentModulesDir lbi clbi
|
||||
self_installdirs =
|
||||
absoluteComponentInstallDirs pkg_descr lbi uid NoCopyDest
|
||||
|
||||
@ -43,16 +43,12 @@ import GHC.ST ( ST(..), runST )
|
||||
import GHC.Base ( IO(..), divInt# )
|
||||
import GHC.Exts
|
||||
import GHC.Ptr ( nullPtr, nullFunPtr )
|
||||
import GHC.Show ( appPrec )
|
||||
import GHC.Stable ( StablePtr(..) )
|
||||
import GHC.Read ( expectP, parens, Read(..) )
|
||||
import GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..) )
|
||||
import GHC.Word ( Word8(..), Word16(..), Word32(..), Word64(..) )
|
||||
import GHC.IO ( stToIO )
|
||||
import GHC.IOArray ( IOArray(..),
|
||||
newIOArray, unsafeReadIOArray, unsafeWriteIOArray )
|
||||
import Text.Read.Lex ( Lexeme(Ident) )
|
||||
import Text.ParserCombinators.ReadPrec ( prec, ReadPrec, step )
|
||||
|
||||
#include "MachDeps.h"
|
||||
|
||||
@ -483,7 +479,7 @@ cmpIntUArray arr1@(UArray l1 u1 n1 _) arr2@(UArray l2 u2 n2 _) =
|
||||
{-# RULES "cmpUArray/Int" cmpUArray = cmpIntUArray #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- Showing and Reading IArrays
|
||||
-- Showing IArrays
|
||||
|
||||
{-# SPECIALISE
|
||||
showsIArray :: (IArray UArray e, Ix i, Show i, Show e) =>
|
||||
@ -492,24 +488,12 @@ cmpIntUArray arr1@(UArray l1 u1 n1 _) arr2@(UArray l2 u2 n2 _) =
|
||||
|
||||
showsIArray :: (IArray a e, Ix i, Show i, Show e) => Int -> a i e -> ShowS
|
||||
showsIArray p a =
|
||||
showParen (p > appPrec) $
|
||||
showParen (p > 9) $
|
||||
showString "array " .
|
||||
shows (bounds a) .
|
||||
showChar ' ' .
|
||||
shows (assocs a)
|
||||
|
||||
{-# SPECIALISE
|
||||
readIArray :: (IArray UArray e, Ix i, Read i, Read e) =>
|
||||
ReadPrec (UArray i e)
|
||||
#-}
|
||||
|
||||
readIArray :: (IArray a e, Ix i, Read i, Read e) => ReadPrec (a i e)
|
||||
readIArray = parens $ prec appPrec $
|
||||
do expectP (Ident "array")
|
||||
theBounds <- step readPrec
|
||||
vals <- step readPrec
|
||||
return (array theBounds vals)
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- Flat unboxed arrays: instances
|
||||
|
||||
@ -801,9 +785,6 @@ instance (Ix ix, Ord e, IArray UArray e) => Ord (UArray ix e) where
|
||||
instance (Ix ix, Show ix, Show e, IArray UArray e) => Show (UArray ix e) where
|
||||
showsPrec = showsIArray
|
||||
|
||||
instance (Ix ix, Read ix, Read e, IArray UArray e) => Read (UArray ix e) where
|
||||
readPrec = readIArray
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- Mutable arrays
|
||||
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
name: array
|
||||
version: 0.5.4.0
|
||||
version: 0.5.3.0
|
||||
-- NOTE: Don't forget to update ./changelog.md
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
@ -36,7 +36,7 @@ library
|
||||
Trustworthy,
|
||||
UnboxedTuples,
|
||||
UnliftedFFITypes
|
||||
build-depends: base >= 4.9 && < 4.14
|
||||
build-depends: base >= 4.9 && < 4.13
|
||||
ghc-options: -Wall
|
||||
exposed-modules:
|
||||
Data.Array
|
||||
|
||||
@ -1,9 +1,5 @@
|
||||
# Changelog for [`array` package](http://hackage.haskell.org/package/array)
|
||||
|
||||
## 0.5.4.0 *TBA*
|
||||
|
||||
* Add a `Read` instance for `UArray`
|
||||
|
||||
## 0.5.3.0 *Oct 2018*
|
||||
|
||||
* Bundled with GHC 8.6.2
|
||||
|
||||
@ -118,8 +118,8 @@ newtype ZipList a = ZipList { getZipList :: [a] }
|
||||
-- See Data.Traversable for Traversable instance due to import loops
|
||||
|
||||
-- |
|
||||
-- > f <$> ZipList xs1 <*> ... <*> ZipList xsN
|
||||
-- > = ZipList (zipWithN f xs1 ... xsN)
|
||||
-- > f '<$>' 'ZipList' xs1 '<*>' ... '<*>' 'ZipList' xsN
|
||||
-- > = 'ZipList' (zipWithN f xs1 ... xsN)
|
||||
--
|
||||
-- where @zipWithN@ refers to the @zipWith@ function of the appropriate arity
|
||||
-- (@zipWith@, @zipWith3@, @zipWith4@, ...). For example:
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
|
||||
-- The RULES for the methods of class Arrow may never fire
|
||||
-- e.g. compose/arr; see #10528
|
||||
-- e.g. compose/arr; see Trac #10528
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -76,7 +76,7 @@ infixr 1 ^<<, <<^
|
||||
--
|
||||
-- * @'first' f >>> 'arr' ('id' *** g) = 'arr' ('id' *** g) >>> 'first' f@
|
||||
--
|
||||
-- * @'first' ('first' f) >>> 'arr' assoc = 'arr' assoc >>> 'first' f@
|
||||
-- * @'first' ('first' f) >>> 'arr' 'assoc' = 'arr' 'assoc' >>> 'first' f@
|
||||
--
|
||||
-- where
|
||||
--
|
||||
@ -209,7 +209,7 @@ instance MonadPlus m => ArrowPlus (Kleisli m) where
|
||||
--
|
||||
-- * @'left' f >>> 'arr' ('id' +++ g) = 'arr' ('id' +++ g) >>> 'left' f@
|
||||
--
|
||||
-- * @'left' ('left' f) >>> 'arr' assocsum = 'arr' assocsum >>> 'left' f@
|
||||
-- * @'left' ('left' f) >>> 'arr' 'assocsum' = 'arr' 'assocsum' >>> 'left' f@
|
||||
--
|
||||
-- where
|
||||
--
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
|
||||
-- The RULES for the methods of class Category may never fire
|
||||
-- e.g. identity/left, identity/right, association; see #10528
|
||||
-- e.g. identity/left, identity/right, association; see Trac #10528
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -16,7 +16,7 @@
|
||||
-- Stability : experimental
|
||||
-- Portability : portable
|
||||
|
||||
-- https://gitlab.haskell.org/ghc/ghc/issues/1773
|
||||
-- http://ghc.haskell.org/trac/ghc/ticket/1773
|
||||
|
||||
module Control.Category where
|
||||
|
||||
@ -30,10 +30,11 @@ infixr 1 >>>, <<<
|
||||
|
||||
-- | A class for categories. Instances should satisfy the laws
|
||||
--
|
||||
-- [Right identity] @f '.' 'id' = f@
|
||||
-- [Left identity] @'id' '.' f = f@
|
||||
-- [Associativity] @f '.' (g '.' h) = (f '.' g) '.' h@
|
||||
--
|
||||
-- @
|
||||
-- f '.' 'id' = f -- (right identity)
|
||||
-- 'id' '.' f = f -- (left identity)
|
||||
-- f '.' (g '.' h) = (f '.' g) '.' h -- (associativity)
|
||||
-- @
|
||||
class Category cat where
|
||||
-- | the identity morphism
|
||||
id :: cat a a
|
||||
|
||||
@ -102,8 +102,8 @@ writeChan (Chan _ writeVar) val = do
|
||||
-- guarantees of 'MVar's (e.g. threads blocked in this operation are woken up in
|
||||
-- FIFO order).
|
||||
--
|
||||
-- Throws 'Control.Exception.BlockedIndefinitelyOnMVar' when the channel is
|
||||
-- empty and no other thread holds a reference to the channel.
|
||||
-- Throws 'BlockedIndefinitelyOnMVar' when the channel is empty and no other
|
||||
-- thread holds a reference to the channel.
|
||||
readChan :: Chan a -> IO a
|
||||
readChan (Chan readVar _) = do
|
||||
modifyMVar readVar $ \read_end -> do
|
||||
|
||||
@ -33,12 +33,12 @@
|
||||
--
|
||||
-- === Applicability
|
||||
--
|
||||
-- 'MVar's offer more flexibility than 'Data.IORef.IORef's, but less flexibility
|
||||
-- than 'GHC.Conc.STM'. They are appropriate for building synchronization
|
||||
-- 'MVar's offer more flexibility than 'IORef's, but less flexibility
|
||||
-- than 'STM'. They are appropriate for building synchronization
|
||||
-- primitives and performing simple interthread communication; however
|
||||
-- they are very simple and susceptible to race conditions, deadlocks or
|
||||
-- uncaught exceptions. Do not use them if you need perform larger
|
||||
-- atomic operations such as reading from multiple variables: use 'GHC.Conc.STM'
|
||||
-- atomic operations such as reading from multiple variables: use 'STM'
|
||||
-- instead.
|
||||
--
|
||||
-- In particular, the "bigger" functions in this module ('swapMVar',
|
||||
@ -70,7 +70,7 @@
|
||||
--
|
||||
-- 'MVar' operations are always observed to take place in the order
|
||||
-- they are written in the program, regardless of the memory model of
|
||||
-- the underlying machine. This is in contrast to 'Data.IORef.IORef' operations
|
||||
-- the underlying machine. This is in contrast to 'IORef' operations
|
||||
-- which may appear out-of-order to another thread in some cases.
|
||||
--
|
||||
-- === Example
|
||||
|
||||
@ -1,5 +1,6 @@
|
||||
{-# LANGUAGE Safe #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# OPTIONS_GHC -funbox-strict-fields #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -38,7 +39,7 @@ import Data.Maybe
|
||||
--
|
||||
-- is safe; it never loses a unit of the resource.
|
||||
--
|
||||
newtype QSem = QSem (MVar (Int, [MVar ()], [MVar ()]))
|
||||
data QSem = QSem !(MVar (Int, [MVar ()], [MVar ()]))
|
||||
|
||||
-- The semaphore state (i, xs, ys):
|
||||
--
|
||||
|
||||
@ -1,4 +1,6 @@
|
||||
{-# LANGUAGE Safe #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# OPTIONS_GHC -funbox-strict-fields #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -39,7 +41,7 @@ import Data.Maybe
|
||||
--
|
||||
-- is safe; it never loses any of the resource.
|
||||
--
|
||||
newtype QSemN = QSemN (MVar (Int, [(Int, MVar ())], [(Int, MVar ())]))
|
||||
data QSemN = QSemN !(MVar (Int, [(Int, MVar ())], [(Int, MVar ())]))
|
||||
|
||||
-- The semaphore state (i, xs, ys):
|
||||
--
|
||||
|
||||
@ -264,7 +264,7 @@ to write something like
|
||||
> (\e -> handler)
|
||||
|
||||
If you need to unmask asynchronous exceptions again in the exception
|
||||
handler, @restore@ can be used there too.
|
||||
handler, 'restore' can be used there too.
|
||||
|
||||
Note that 'try' and friends /do not/ have a similar default, because
|
||||
there is no exception handler in this case. Don't use 'try' for
|
||||
@ -332,24 +332,21 @@ kind of situation:
|
||||
|
||||
The following operations are guaranteed not to be interruptible:
|
||||
|
||||
* operations on 'Data.IORef.IORef' from "Data.IORef"
|
||||
* operations on 'IORef' from "Data.IORef"
|
||||
|
||||
* STM transactions that do not use 'GHC.Conc.retry'
|
||||
* STM transactions that do not use 'retry'
|
||||
|
||||
* everything from the @Foreign@ modules
|
||||
|
||||
* everything from "Control.Exception" except for 'throwTo'
|
||||
* everything from @Control.Exception@ except for 'throwTo'
|
||||
|
||||
* 'Control.Concurrent.MVar.tryTakeMVar', 'Control.Concurrent.MVar.tryPutMVar',
|
||||
'Control.Concurrent.MVar.isEmptyMVar'
|
||||
* @tryTakeMVar@, @tryPutMVar@, @isEmptyMVar@
|
||||
|
||||
* 'Control.Concurrent.MVar.takeMVar' if the 'Control.Concurrent.MVar.MVar' is
|
||||
definitely full, and conversely 'Control.Concurrent.MVar.putMVar' if the
|
||||
'Control.Concurrent.MVar.MVar' is definitely empty
|
||||
* @takeMVar@ if the @MVar@ is definitely full, and conversely @putMVar@ if the @MVar@ is definitely empty
|
||||
|
||||
* 'Control.Concurrent.MVar.newEmptyMVar', 'Control.Concurrent.MVar.newMVar'
|
||||
* @newEmptyMVar@, @newMVar@
|
||||
|
||||
* 'Control.Concurrent.forkIO', 'Control.Concurrent.myThreadId'
|
||||
* @forkIO@, @forkIOUnmasked@, @myThreadId@
|
||||
|
||||
-}
|
||||
|
||||
|
||||
@ -19,8 +19,7 @@ module Control.Monad
|
||||
-- * Functor and monad classes
|
||||
|
||||
Functor(fmap)
|
||||
, Monad((>>=), (>>), return)
|
||||
, MonadFail(fail)
|
||||
, Monad((>>=), (>>), return, fail)
|
||||
, MonadPlus(mzero, mplus)
|
||||
-- * Functions
|
||||
|
||||
@ -76,7 +75,6 @@ module Control.Monad
|
||||
, (<$!>)
|
||||
) where
|
||||
|
||||
import Control.Monad.Fail ( MonadFail(fail) )
|
||||
import Data.Foldable ( Foldable, sequence_, sequenceA_, msum, mapM_, foldlM, forM_ )
|
||||
import Data.Functor ( void, (<$>) )
|
||||
import Data.Traversable ( forM, mapM, traverse, sequence, sequenceA )
|
||||
@ -133,7 +131,7 @@ guard :: (Alternative f) => Bool -> f ()
|
||||
guard True = pure ()
|
||||
guard False = empty
|
||||
|
||||
-- | This generalizes the list-based 'Data.List.filter' function.
|
||||
-- | This generalizes the list-based 'filter' function.
|
||||
|
||||
{-# INLINE filterM #-}
|
||||
filterM :: (Applicative m) => (a -> m Bool) -> [a] -> m [a]
|
||||
@ -190,28 +188,22 @@ forever a = let a' = a *> a' in a'
|
||||
|
||||
-- | The 'mapAndUnzipM' function maps its first argument over a list, returning
|
||||
-- the result as a pair of lists. This function is mainly used with complicated
|
||||
-- data structures or a state monad.
|
||||
-- data structures or a state-transforming monad.
|
||||
mapAndUnzipM :: (Applicative m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
|
||||
{-# INLINE mapAndUnzipM #-}
|
||||
-- Inline so that fusion with 'unzip' and 'traverse' has a chance to fire.
|
||||
-- See Note [Inline @unzipN@ functions] in GHC/OldList.hs.
|
||||
mapAndUnzipM f xs = unzip <$> traverse f xs
|
||||
|
||||
-- | The 'zipWithM' function generalizes 'zipWith' to arbitrary applicative functors.
|
||||
zipWithM :: (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
|
||||
{-# INLINE zipWithM #-}
|
||||
-- Inline so that fusion with zipWith and sequenceA have a chance to fire
|
||||
-- See Note [Fusion for zipN/zipWithN] in List.hs]
|
||||
zipWithM f xs ys = sequenceA (zipWith f xs ys)
|
||||
|
||||
-- | 'zipWithM_' is the extension of 'zipWithM' which ignores the final result.
|
||||
zipWithM_ :: (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m ()
|
||||
{-# INLINE zipWithM_ #-}
|
||||
-- Inline so that fusion with zipWith and sequenceA have a chance to fire
|
||||
-- See Note [Fusion for zipN/zipWithN] in List.hs]
|
||||
zipWithM_ f xs ys = sequenceA_ (zipWith f xs ys)
|
||||
|
||||
{- | The 'foldM' function is analogous to 'Data.Foldable.foldl', except that its result is
|
||||
{- | The 'foldM' function is analogous to 'foldl', except that its result is
|
||||
encapsulated in a monad. Note that 'foldM' works from left-to-right over
|
||||
the list arguments. This could be an issue where @('>>')@ and the `folded
|
||||
function' are not commutative.
|
||||
@ -262,8 +254,8 @@ By contrast, the implementation below with a local loop makes it possible to
|
||||
inline the entire definition (as happens for foldr, for example) thereby
|
||||
specialising for the particular action.
|
||||
|
||||
For further information, see this issue comment, which includes side-by-side
|
||||
Core: https://gitlab.haskell.org/ghc/ghc/issues/11795#note_118976
|
||||
For further information, see this Trac comment, which includes side-by-side
|
||||
Core: https://ghc.haskell.org/trac/ghc/ticket/11795#comment:6
|
||||
-}
|
||||
|
||||
-- | @'replicateM' n act@ performs the action @n@ times,
|
||||
|
||||
@ -50,13 +50,13 @@ import {-# SOURCE #-} GHC.IO (failIO)
|
||||
-- only a single data constructor, and irrefutable patterns (@~pat@).
|
||||
--
|
||||
-- Instances of 'MonadFail' should satisfy the following law: @fail s@ should
|
||||
-- be a left zero for 'Control.Monad.>>=',
|
||||
-- be a left zero for '>>=',
|
||||
--
|
||||
-- @
|
||||
-- fail s >>= f = fail s
|
||||
-- @
|
||||
--
|
||||
-- If your 'Monad' is also 'Control.Monad.MonadPlus', a popular definition is
|
||||
-- If your 'Monad' is also 'MonadPlus', a popular definition is
|
||||
--
|
||||
-- @
|
||||
-- fail _ = mzero
|
||||
|
||||
@ -39,17 +39,17 @@ import System.IO
|
||||
-- | Monads having fixed points with a \'knot-tying\' semantics.
|
||||
-- Instances of 'MonadFix' should satisfy the following laws:
|
||||
--
|
||||
-- [Purity]
|
||||
-- @'mfix' ('Control.Monad.return' . h) = 'Control.Monad.return' ('fix' h)@
|
||||
-- [/purity/]
|
||||
-- @'mfix' ('return' . h) = 'return' ('fix' h)@
|
||||
--
|
||||
-- [Left shrinking (or Tightening)]
|
||||
-- [/left shrinking/ (or /tightening/)]
|
||||
-- @'mfix' (\\x -> a >>= \\y -> f x y) = a >>= \\y -> 'mfix' (\\x -> f x y)@
|
||||
--
|
||||
-- [Sliding]
|
||||
-- [/sliding/]
|
||||
-- @'mfix' ('Control.Monad.liftM' h . f) = 'Control.Monad.liftM' h ('mfix' (f . h))@,
|
||||
-- for strict @h@.
|
||||
--
|
||||
-- [Nesting]
|
||||
-- [/nesting/]
|
||||
-- @'mfix' (\\x -> 'mfix' (\\y -> f x y)) = 'mfix' (\\x -> f x x)@
|
||||
--
|
||||
-- This class is used in the translation of the recursive @do@ notation
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE Unsafe #-}
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
{-# OPTIONS_HADDOCK hide #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -24,7 +24,7 @@ module Control.Monad.ST.Imp (
|
||||
runST,
|
||||
fixST,
|
||||
|
||||
-- * Converting 'ST' to 'Prelude.IO'
|
||||
-- * Converting 'ST' to 'IO'
|
||||
RealWorld, -- abstract
|
||||
stToIO,
|
||||
|
||||
@ -45,7 +45,7 @@ import Control.Exception.Base
|
||||
( catch, throwIO, NonTermination (..)
|
||||
, BlockedIndefinitelyOnMVar (..) )
|
||||
|
||||
-- | Allow the result of an 'ST' computation to be used (lazily)
|
||||
-- | Allow the result of a state transformer computation to be used (lazily)
|
||||
-- inside the computation.
|
||||
--
|
||||
-- Note that if @f@ is strict, @'fixST' f = _|_@.
|
||||
@ -75,7 +75,7 @@ using liftST:
|
||||
|
||||
We knew that lazy blackholing could cause the computation to be re-run if the
|
||||
result was demanded strictly, but we thought that would be okay in the case of
|
||||
ST. However, that is not the case (see #15349). Notably, the first time
|
||||
ST. However, that is not the case (see Trac #15349). Notably, the first time
|
||||
the computation is executed, it may mutate variables that cause it to behave
|
||||
*differently* the second time it's run. That may allow it to terminate when it
|
||||
should not. More frighteningly, Arseniy Alekseyev produced a somewhat contrived
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
{-# LANGUAGE Unsafe #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE MagicHash, UnboxedTuples, RankNTypes #-}
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
{-# OPTIONS_HADDOCK hide #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -14,7 +14,7 @@
|
||||
-- Portability : non-portable (requires universal quantification for runST)
|
||||
--
|
||||
-- This module presents an identical interface to "Control.Monad.ST",
|
||||
-- except that the monad delays evaluation of 'ST' operations until
|
||||
-- except that the monad delays evaluation of state operations until
|
||||
-- a value depending on them is required.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
@ -46,10 +46,10 @@ import qualified GHC.ST as GHC.ST
|
||||
import GHC.Base
|
||||
import qualified Control.Monad.Fail as Fail
|
||||
|
||||
-- | The lazy @'ST' monad.
|
||||
-- The ST monad allows for destructive updates, but is escapable (unlike IO).
|
||||
-- A computation of type @'ST' s a@ returns a value of type @a@, and
|
||||
-- execute in "thread" @s@. The @s@ parameter is either
|
||||
-- | The lazy state-transformer monad.
|
||||
-- A computation of type @'ST' s a@ transforms an internal state indexed
|
||||
-- by @s@, and returns a value of type @a@.
|
||||
-- The @s@ parameter is either
|
||||
--
|
||||
-- * an uninstantiated type variable (inside invocations of 'runST'), or
|
||||
--
|
||||
@ -180,6 +180,9 @@ instance Applicative (ST s) where
|
||||
|
||||
-- | @since 2.01
|
||||
instance Monad (ST s) where
|
||||
|
||||
fail s = errorWithoutStackTrace s
|
||||
|
||||
(>>) = (*>)
|
||||
|
||||
m >>= k = ST $ \ s ->
|
||||
@ -195,13 +198,13 @@ instance Monad (ST s) where
|
||||
instance Fail.MonadFail (ST s) where
|
||||
fail s = errorWithoutStackTrace s
|
||||
|
||||
-- | Return the value computed by an 'ST' computation.
|
||||
-- | Return the value computed by a state transformer computation.
|
||||
-- The @forall@ ensures that the internal state used by the 'ST'
|
||||
-- computation is inaccessible to the rest of the program.
|
||||
runST :: (forall s. ST s a) -> a
|
||||
runST (ST st) = runRW# (\s -> case st (S# s) of (r, _) -> r)
|
||||
|
||||
-- | Allow the result of an 'ST' computation to be used (lazily)
|
||||
-- | Allow the result of a state transformer computation to be used (lazily)
|
||||
-- inside the computation.
|
||||
-- Note that if @f@ is strict, @'fixST' f = _|_@.
|
||||
fixST :: (a -> ST s a) -> ST s a
|
||||
@ -240,7 +243,7 @@ lazyToStrictST :: ST s a -> ST.ST s a
|
||||
lazyToStrictST (ST m) = GHC.ST.ST $ \s ->
|
||||
case (m (S# s)) of (a, S# s') -> (# s', a #)
|
||||
|
||||
-- | A monad transformer embedding lazy 'ST' in the 'IO'
|
||||
-- | A monad transformer embedding lazy state transformers in the 'IO'
|
||||
-- monad. The 'RealWorld' parameter indicates that the internal state
|
||||
-- used by the 'ST' computation is a special one supplied by the 'IO'
|
||||
-- monad, and thus distinct from those used by invocations of 'runST'.
|
||||
|
||||
@ -11,7 +11,7 @@
|
||||
-- Portability : non-portable (requires universal quantification for runST)
|
||||
--
|
||||
-- This module presents an identical interface to "Control.Monad.ST",
|
||||
-- except that the monad delays evaluation of 'ST' operations until
|
||||
-- except that the monad delays evaluation of state operations until
|
||||
-- a value depending on them is required.
|
||||
--
|
||||
-- Safe API only.
|
||||
|
||||
@ -11,7 +11,7 @@
|
||||
-- Portability : non-portable (requires universal quantification for runST)
|
||||
--
|
||||
-- This module presents an identical interface to "Control.Monad.ST",
|
||||
-- except that the monad delays evaluation of 'ST' operations until
|
||||
-- except that the monad delays evaluation of state operations until
|
||||
-- a value depending on them is required.
|
||||
--
|
||||
-- Unsafe API.
|
||||
|
||||
@ -26,18 +26,19 @@ import Data.Proxy
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import GHC.Generics
|
||||
|
||||
-- | Instances should satisfy the laws:
|
||||
-- | `MonadZip` type class. Minimal definition: `mzip` or `mzipWith`
|
||||
--
|
||||
-- [Naturality]
|
||||
-- Instances should satisfy the laws:
|
||||
--
|
||||
-- @'liftM' (f 'Control.Arrow.***' g) ('mzip' ma mb)
|
||||
-- = 'mzip' ('liftM' f ma) ('liftM' g mb)@
|
||||
-- * Naturality :
|
||||
--
|
||||
-- [Information Preservation]
|
||||
-- > liftM (f *** g) (mzip ma mb) = mzip (liftM f ma) (liftM g mb)
|
||||
--
|
||||
-- @'liftM' ('Prelude.const' ()) ma = 'liftM' ('Prelude.const' ()) mb@
|
||||
-- implies
|
||||
-- @'munzip' ('mzip' ma mb) = (ma, mb)@
|
||||
-- * Information Preservation:
|
||||
--
|
||||
-- > liftM (const ()) ma = liftM (const ()) mb
|
||||
-- > ==>
|
||||
-- > munzip (mzip ma mb) = (ma, mb)
|
||||
--
|
||||
class Monad m => MonadZip m where
|
||||
{-# MINIMAL mzip | mzipWith #-}
|
||||
@ -52,7 +53,7 @@ class Monad m => MonadZip m where
|
||||
munzip mab = (liftM fst mab, liftM snd mab)
|
||||
-- munzip is a member of the class because sometimes
|
||||
-- you can implement it more efficiently than the
|
||||
-- above default code. See #4370 comment by giorgidze
|
||||
-- above default code. See Trac #4370 comment by giorgidze
|
||||
|
||||
-- | @since 4.3.1.0
|
||||
instance MonadZip [] where
|
||||
|
||||
@ -76,17 +76,13 @@ import GHC.Generics (K1(..))
|
||||
-- 'bifoldr' f g z t ≡ 'appEndo' ('bifoldMap' (Endo . f) (Endo . g) t) z
|
||||
-- @
|
||||
--
|
||||
-- If the type is also a 'Data.Bifunctor.Bifunctor' instance, it should satisfy:
|
||||
-- If the type is also a 'Bifunctor' instance, it should satisfy:
|
||||
--
|
||||
-- @
|
||||
-- 'bifoldMap' f g ≡ 'bifold' . 'Data.Bifunctor.bimap' f g
|
||||
-- @
|
||||
-- > 'bifoldMap' f g ≡ 'bifold' . 'bimap' f g
|
||||
--
|
||||
-- which implies that
|
||||
--
|
||||
-- @
|
||||
-- 'bifoldMap' f g . 'Data.Bifunctor.bimap' h i ≡ 'bifoldMap' (f . h) (g . i)
|
||||
-- @
|
||||
-- > 'bifoldMap' f g . 'bimap' h i ≡ 'bifoldMap' (f . h) (g . i)
|
||||
--
|
||||
-- @since 4.10.0.0
|
||||
class Bifoldable p where
|
||||
|
||||
@ -44,19 +44,16 @@ import GHC.Generics (K1(..))
|
||||
--
|
||||
-- A definition of 'bitraverse' must satisfy the following laws:
|
||||
--
|
||||
-- [Naturality]
|
||||
-- [/naturality/]
|
||||
-- @'bitraverse' (t . f) (t . g) ≡ t . 'bitraverse' f g@
|
||||
-- for every applicative transformation @t@
|
||||
--
|
||||
-- [Identity]
|
||||
-- [/identity/]
|
||||
-- @'bitraverse' 'Identity' 'Identity' ≡ 'Identity'@
|
||||
--
|
||||
-- [Composition]
|
||||
-- @'Data.Functor.Compose.Compose' .
|
||||
-- 'fmap' ('bitraverse' g1 g2) .
|
||||
-- 'bitraverse' f1 f2
|
||||
-- ≡ 'bitraverse' ('Data.Functor.Compose.Compose' . 'fmap' g1 . f1)
|
||||
-- ('Data.Functor.Compose.Compose' . 'fmap' g2 . f2)@
|
||||
-- [/composition/]
|
||||
-- @'Compose' . 'fmap' ('bitraverse' g1 g2) . 'bitraverse' f1 f2
|
||||
-- ≡ 'traverse' ('Compose' . 'fmap' g1 . f1) ('Compose' . 'fmap' g2 . f2)@
|
||||
--
|
||||
-- where an /applicative transformation/ is a function
|
||||
--
|
||||
@ -69,9 +66,26 @@ import GHC.Generics (K1(..))
|
||||
-- t (f '<*>' x) = t f '<*>' t x
|
||||
-- @
|
||||
--
|
||||
-- and the identity functor 'Identity' and composition functors
|
||||
-- 'Data.Functor.Compose.Compose' are from "Data.Functor.Identity" and
|
||||
-- "Data.Functor.Compose".
|
||||
-- and the identity functor 'Identity' and composition functors 'Compose' are
|
||||
-- defined as
|
||||
--
|
||||
-- > newtype Identity a = Identity { runIdentity :: a }
|
||||
-- >
|
||||
-- > instance Functor Identity where
|
||||
-- > fmap f (Identity x) = Identity (f x)
|
||||
-- >
|
||||
-- > instance Applicative Identity where
|
||||
-- > pure = Identity
|
||||
-- > Identity f <*> Identity x = Identity (f x)
|
||||
-- >
|
||||
-- > newtype Compose f g a = Compose (f (g a))
|
||||
-- >
|
||||
-- > instance (Functor f, Functor g) => Functor (Compose f g) where
|
||||
-- > fmap f (Compose x) = Compose (fmap (fmap f) x)
|
||||
-- >
|
||||
-- > instance (Applicative f, Applicative g) => Applicative (Compose f g) where
|
||||
-- > pure = Compose . pure . pure
|
||||
-- > Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)
|
||||
--
|
||||
-- Some simple examples are 'Either' and '(,)':
|
||||
--
|
||||
|
||||
@ -63,6 +63,10 @@ import GHC.Num
|
||||
import GHC.Base
|
||||
import GHC.Real
|
||||
|
||||
#if defined(MIN_VERSION_integer_gmp)
|
||||
import GHC.Integer.GMP.Internals (bitInteger, popCountInteger)
|
||||
#endif
|
||||
|
||||
infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
|
||||
infixl 7 .&.
|
||||
infixl 6 `xor`
|
||||
@ -205,8 +209,7 @@ class Eq a => Bits a where
|
||||
x `complementBit` i = x `xor` bit i
|
||||
|
||||
{-| Shift the argument left by the specified number of bits
|
||||
(which must be non-negative). Some instances may throw an
|
||||
'Control.Exception.Overflow' exception if given a negative input.
|
||||
(which must be non-negative).
|
||||
|
||||
An instance can define either this and 'shiftR' or the unified
|
||||
'shift', depending on which is more convenient for the type in
|
||||
@ -228,8 +231,7 @@ class Eq a => Bits a where
|
||||
|
||||
{-| Shift the first argument right by the specified number of bits. The
|
||||
result is undefined for negative shift amounts and shift amounts
|
||||
greater or equal to the 'bitSize'. Some instances may throw an
|
||||
'Control.Exception.Overflow' exception if given a negative input.
|
||||
greater or equal to the 'bitSize'.
|
||||
|
||||
Right shifts perform sign extension on signed number types;
|
||||
i.e. they fill the top bits with 1 if the @x@ is negative
|
||||
@ -438,9 +440,6 @@ instance Bits Int where
|
||||
{-# INLINE shift #-}
|
||||
{-# INLINE bit #-}
|
||||
{-# INLINE testBit #-}
|
||||
-- We want popCnt# to be inlined in user code so that `ghc -msse4.2`
|
||||
-- can compile it down to a popcnt instruction without an extra function call
|
||||
{-# INLINE popCount #-}
|
||||
|
||||
zeroBits = 0
|
||||
|
||||
@ -455,13 +454,9 @@ instance Bits Int where
|
||||
(I# x#) `shift` (I# i#)
|
||||
| isTrue# (i# >=# 0#) = I# (x# `iShiftL#` i#)
|
||||
| otherwise = I# (x# `iShiftRA#` negateInt# i#)
|
||||
(I# x#) `shiftL` (I# i#)
|
||||
| isTrue# (i# >=# 0#) = I# (x# `iShiftL#` i#)
|
||||
| otherwise = overflowError
|
||||
(I# x#) `shiftL` (I# i#) = I# (x# `iShiftL#` i#)
|
||||
(I# x#) `unsafeShiftL` (I# i#) = I# (x# `uncheckedIShiftL#` i#)
|
||||
(I# x#) `shiftR` (I# i#)
|
||||
| isTrue# (i# >=# 0#) = I# (x# `iShiftRA#` i#)
|
||||
| otherwise = overflowError
|
||||
(I# x#) `shiftR` (I# i#) = I# (x# `iShiftRA#` i#)
|
||||
(I# x#) `unsafeShiftR` (I# i#) = I# (x# `uncheckedIShiftRA#` i#)
|
||||
|
||||
{-# INLINE rotate #-} -- See Note [Constant folding for rotate]
|
||||
@ -481,16 +476,13 @@ instance Bits Int where
|
||||
instance FiniteBits Int where
|
||||
finiteBitSize _ = WORD_SIZE_IN_BITS
|
||||
countLeadingZeros (I# x#) = I# (word2Int# (clz# (int2Word# x#)))
|
||||
{-# INLINE countLeadingZeros #-}
|
||||
countTrailingZeros (I# x#) = I# (word2Int# (ctz# (int2Word# x#)))
|
||||
{-# INLINE countTrailingZeros #-}
|
||||
|
||||
-- | @since 2.01
|
||||
instance Bits Word where
|
||||
{-# INLINE shift #-}
|
||||
{-# INLINE bit #-}
|
||||
{-# INLINE testBit #-}
|
||||
{-# INLINE popCount #-}
|
||||
|
||||
(W# x#) .&. (W# y#) = W# (x# `and#` y#)
|
||||
(W# x#) .|. (W# y#) = W# (x# `or#` y#)
|
||||
@ -500,13 +492,9 @@ instance Bits Word where
|
||||
(W# x#) `shift` (I# i#)
|
||||
| isTrue# (i# >=# 0#) = W# (x# `shiftL#` i#)
|
||||
| otherwise = W# (x# `shiftRL#` negateInt# i#)
|
||||
(W# x#) `shiftL` (I# i#)
|
||||
| isTrue# (i# >=# 0#) = W# (x# `shiftL#` i#)
|
||||
| otherwise = overflowError
|
||||
(W# x#) `shiftL` (I# i#) = W# (x# `shiftL#` i#)
|
||||
(W# x#) `unsafeShiftL` (I# i#) = W# (x# `uncheckedShiftL#` i#)
|
||||
(W# x#) `shiftR` (I# i#)
|
||||
| isTrue# (i# >=# 0#) = W# (x# `shiftRL#` i#)
|
||||
| otherwise = overflowError
|
||||
(W# x#) `shiftR` (I# i#) = W# (x# `shiftRL#` i#)
|
||||
(W# x#) `unsafeShiftR` (I# i#) = W# (x# `uncheckedShiftRL#` i#)
|
||||
(W# x#) `rotate` (I# i#)
|
||||
| isTrue# (i'# ==# 0#) = W# x#
|
||||
@ -525,9 +513,7 @@ instance Bits Word where
|
||||
instance FiniteBits Word where
|
||||
finiteBitSize _ = WORD_SIZE_IN_BITS
|
||||
countLeadingZeros (W# x#) = I# (word2Int# (clz# x#))
|
||||
{-# INLINE countLeadingZeros #-}
|
||||
countTrailingZeros (W# x#) = I# (word2Int# (ctz# x#))
|
||||
{-# INLINE countTrailingZeros #-}
|
||||
|
||||
-- | @since 2.01
|
||||
instance Bits Integer where
|
||||
@ -540,8 +526,13 @@ instance Bits Integer where
|
||||
testBit x (I# i) = testBitInteger x i
|
||||
zeroBits = 0
|
||||
|
||||
#if defined(MIN_VERSION_integer_gmp)
|
||||
bit (I# i#) = bitInteger i#
|
||||
popCount x = I# (popCountInteger x)
|
||||
#else
|
||||
bit = bitDefault
|
||||
popCount = popCountDefault
|
||||
#endif
|
||||
|
||||
rotate x i = shift x i -- since an Integer never wraps around
|
||||
|
||||
@ -549,6 +540,7 @@ instance Bits Integer where
|
||||
bitSize _ = errorWithoutStackTrace "Data.Bits.bitSize(Integer)"
|
||||
isSigned _ = True
|
||||
|
||||
#if defined(MIN_VERSION_integer_gmp)
|
||||
-- | @since 4.8.0
|
||||
instance Bits Natural where
|
||||
(.&.) = andNatural
|
||||
@ -571,6 +563,50 @@ instance Bits Natural where
|
||||
bitSizeMaybe _ = Nothing
|
||||
bitSize _ = errorWithoutStackTrace "Data.Bits.bitSize(Natural)"
|
||||
isSigned _ = False
|
||||
#else
|
||||
-- | @since 4.8.0.0
|
||||
instance Bits Natural where
|
||||
Natural n .&. Natural m = Natural (n .&. m)
|
||||
{-# INLINE (.&.) #-}
|
||||
Natural n .|. Natural m = Natural (n .|. m)
|
||||
{-# INLINE (.|.) #-}
|
||||
xor (Natural n) (Natural m) = Natural (xor n m)
|
||||
{-# INLINE xor #-}
|
||||
complement _ = errorWithoutStackTrace "Bits.complement: Natural complement undefined"
|
||||
{-# INLINE complement #-}
|
||||
shift (Natural n) = Natural . shift n
|
||||
{-# INLINE shift #-}
|
||||
rotate (Natural n) = Natural . rotate n
|
||||
{-# INLINE rotate #-}
|
||||
bit = Natural . bit
|
||||
{-# INLINE bit #-}
|
||||
setBit (Natural n) = Natural . setBit n
|
||||
{-# INLINE setBit #-}
|
||||
clearBit (Natural n) = Natural . clearBit n
|
||||
{-# INLINE clearBit #-}
|
||||
complementBit (Natural n) = Natural . complementBit n
|
||||
{-# INLINE complementBit #-}
|
||||
testBit (Natural n) = testBit n
|
||||
{-# INLINE testBit #-}
|
||||
bitSizeMaybe _ = Nothing
|
||||
{-# INLINE bitSizeMaybe #-}
|
||||
bitSize = errorWithoutStackTrace "Natural: bitSize"
|
||||
{-# INLINE bitSize #-}
|
||||
isSigned _ = False
|
||||
{-# INLINE isSigned #-}
|
||||
shiftL (Natural n) = Natural . shiftL n
|
||||
{-# INLINE shiftL #-}
|
||||
shiftR (Natural n) = Natural . shiftR n
|
||||
{-# INLINE shiftR #-}
|
||||
rotateL (Natural n) = Natural . rotateL n
|
||||
{-# INLINE rotateL #-}
|
||||
rotateR (Natural n) = Natural . rotateR n
|
||||
{-# INLINE rotateR #-}
|
||||
popCount (Natural n) = popCount n
|
||||
{-# INLINE popCount #-}
|
||||
zeroBits = Natural 0
|
||||
|
||||
#endif
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
@ -14,7 +14,7 @@
|
||||
-- Safe coercions between data types.
|
||||
--
|
||||
-- More in-depth information can be found on the
|
||||
-- <https://gitlab.haskell.org/ghc/ghc/wikis/roles Roles wiki page>
|
||||
-- <https://ghc.haskell.org/trac/ghc/wiki/Roles Roles wiki page>
|
||||
--
|
||||
-- @since 4.7.0.0
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
@ -1108,7 +1108,7 @@ ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr]
|
||||
|
||||
-- NB: This Data instance intentionally uses the (%) smart constructor instead
|
||||
-- of the internal (:%) constructor to preserve the invariant that a Ratio
|
||||
-- value is reduced to normal form. See #10011.
|
||||
-- value is reduced to normal form. See Trac #10011.
|
||||
|
||||
-- | @since 4.0.0.0
|
||||
instance (Data a, Integral a) => Data (Ratio a) where
|
||||
|
||||
@ -164,7 +164,7 @@ instance Monad (Either e) where
|
||||
--
|
||||
-- We create two values of type @'Either' 'String' 'Int'@, one using the
|
||||
-- 'Left' constructor and another using the 'Right' constructor. Then
|
||||
-- we apply \"either\" the 'Prelude.length' function (if we have a 'String')
|
||||
-- we apply \"either\" the 'length' function (if we have a 'String')
|
||||
-- or the \"times-two\" function (if we have an 'Int'):
|
||||
--
|
||||
-- >>> let s = Left "foo" :: Either String Int
|
||||
@ -192,7 +192,7 @@ either _ g (Right y) = g y
|
||||
--
|
||||
lefts :: [Either a b] -> [a]
|
||||
lefts x = [a | Left a <- x]
|
||||
{-# INLINEABLE lefts #-} -- otherwise doesn't get an unfolding, see #13689
|
||||
{-# INLINEABLE lefts #-} -- otherwise doesnt get an unfolding, see #13689
|
||||
|
||||
-- | Extracts from a list of 'Either' all the 'Right' elements.
|
||||
-- All the 'Right' elements are extracted in order.
|
||||
@ -207,7 +207,7 @@ lefts x = [a | Left a <- x]
|
||||
--
|
||||
rights :: [Either a b] -> [b]
|
||||
rights x = [a | Right a <- x]
|
||||
{-# INLINEABLE rights #-} -- otherwise doesn't get an unfolding, see #13689
|
||||
{-# INLINEABLE rights #-} -- otherwise doesnt get an unfolding, see #13689
|
||||
|
||||
-- | Partitions a list of 'Either' into two lists.
|
||||
-- All the 'Left' elements are extracted, in order, to the first
|
||||
|
||||
@ -12,12 +12,11 @@
|
||||
-- Portability : portable
|
||||
--
|
||||
-- This module defines a \"Fixed\" type for fixed-precision arithmetic.
|
||||
-- The parameter to 'Fixed' is any type that's an instance of 'HasResolution'.
|
||||
-- 'HasResolution' has a single method that gives the resolution of the 'Fixed'
|
||||
-- type.
|
||||
-- The parameter to Fixed is any type that's an instance of HasResolution.
|
||||
-- HasResolution has a single method that gives the resolution of the Fixed type.
|
||||
--
|
||||
-- This module also contains generalisations of 'div', 'mod', and 'divMod' to
|
||||
-- work with any 'Real' instance.
|
||||
-- This module also contains generalisations of div, mod, and divmod to work
|
||||
-- with any Real instance.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
@ -43,16 +42,16 @@ import Text.Read.Lex
|
||||
|
||||
default () -- avoid any defaulting shenanigans
|
||||
|
||||
-- | generalisation of 'div' to any instance of 'Real'
|
||||
-- | generalisation of 'div' to any instance of Real
|
||||
div' :: (Real a,Integral b) => a -> a -> b
|
||||
div' n d = floor ((toRational n) / (toRational d))
|
||||
|
||||
-- | generalisation of 'divMod' to any instance of 'Real'
|
||||
-- | generalisation of 'divMod' to any instance of Real
|
||||
divMod' :: (Real a,Integral b) => a -> a -> (b,a)
|
||||
divMod' n d = (f,n - (fromIntegral f) * d) where
|
||||
f = div' n d
|
||||
|
||||
-- | generalisation of 'mod' to any instance of 'Real'
|
||||
-- | generalisation of 'mod' to any instance of Real
|
||||
mod' :: (Real a) => a -> a -> a
|
||||
mod' n d = n - (fromInteger f) * d where
|
||||
f = div' n d
|
||||
@ -158,7 +157,7 @@ showFixed chopTrailingZeros fa@(MkFixed a) = (show i) ++ (withDot (showIntegerZe
|
||||
|
||||
-- | @since 2.01
|
||||
instance (HasResolution a) => Show (Fixed a) where
|
||||
showsPrec p n = showParen (p > 6 && n < 0) $ showString $ showFixed False n
|
||||
show = showFixed False
|
||||
|
||||
-- | @since 4.3.0.0
|
||||
instance (HasResolution a) => Read (Fixed a) where
|
||||
|
||||
@ -127,15 +127,9 @@ class Foldable t where
|
||||
-- and combine the results.
|
||||
foldMap :: Monoid m => (a -> m) -> t a -> m
|
||||
{-# INLINE foldMap #-}
|
||||
-- This INLINE allows more list functions to fuse. See #9848.
|
||||
-- This INLINE allows more list functions to fuse. See Trac #9848.
|
||||
foldMap f = foldr (mappend . f) mempty
|
||||
|
||||
-- | A variant of 'foldMap' that is strict in the accumulator.
|
||||
--
|
||||
-- @since 4.13.0.0
|
||||
foldMap' :: Monoid m => (a -> m) -> t a -> m
|
||||
foldMap' f = foldl' (\ acc a -> acc <> f a) mempty
|
||||
|
||||
-- | Right-associative fold of a structure.
|
||||
--
|
||||
-- In the case of lists, 'foldr', when applied to a binary operator, a
|
||||
@ -159,7 +153,6 @@ class Foldable t where
|
||||
-- | Right-associative fold of a structure, but with strict application of
|
||||
-- the operator.
|
||||
--
|
||||
-- @since 4.6.0.0
|
||||
foldr' :: (a -> b -> b) -> b -> t a -> b
|
||||
foldr' f z0 xs = foldl f' id xs z0
|
||||
where f' k x z = k $! f x z
|
||||
@ -179,8 +172,8 @@ class Foldable t where
|
||||
--
|
||||
-- Also note that if you want an efficient left-fold, you probably want to
|
||||
-- use 'foldl'' instead of 'foldl'. The reason for this is that latter does
|
||||
-- not force the "inner" results (e.g. @z \`f\` x1@ in the above example)
|
||||
-- before applying them to the operator (e.g. to @(\`f\` x2)@). This results
|
||||
-- not force the "inner" results (e.g. @z `f` x1@ in the above example)
|
||||
-- before applying them to the operator (e.g. to @(`f` x2)@). This results
|
||||
-- in a thunk chain @O(n)@ elements long, which then must be evaluated from
|
||||
-- the outside-in.
|
||||
--
|
||||
@ -205,9 +198,8 @@ class Foldable t where
|
||||
-- For a general 'Foldable' structure this should be semantically identical
|
||||
-- to,
|
||||
--
|
||||
-- @foldl' f z = 'List.foldl'' f z . 'toList'@
|
||||
-- @foldl f z = 'List.foldl'' f z . 'toList'@
|
||||
--
|
||||
-- @since 4.6.0.0
|
||||
foldl' :: (b -> a -> b) -> b -> t a -> b
|
||||
foldl' f z0 xs = foldr f' id xs z0
|
||||
where f' x k z = k $! f z x
|
||||
@ -237,8 +229,6 @@ class Foldable t where
|
||||
Just x -> f x y)
|
||||
|
||||
-- | List of elements of a structure, from left to right.
|
||||
--
|
||||
-- @since 4.8.0.0
|
||||
toList :: t a -> [a]
|
||||
{-# INLINE toList #-}
|
||||
toList t = build (\ c n -> foldr c n t)
|
||||
@ -246,49 +236,35 @@ class Foldable t where
|
||||
-- | Test whether the structure is empty. The default implementation is
|
||||
-- optimized for structures that are similar to cons-lists, because there
|
||||
-- is no general way to do better.
|
||||
--
|
||||
-- @since 4.8.0.0
|
||||
null :: t a -> Bool
|
||||
null = foldr (\_ _ -> False) True
|
||||
|
||||
-- | Returns the size/length of a finite structure as an 'Int'. The
|
||||
-- default implementation is optimized for structures that are similar to
|
||||
-- cons-lists, because there is no general way to do better.
|
||||
--
|
||||
-- @since 4.8.0.0
|
||||
length :: t a -> Int
|
||||
length = foldl' (\c _ -> c+1) 0
|
||||
|
||||
-- | Does the element occur in the structure?
|
||||
--
|
||||
-- @since 4.8.0.0
|
||||
elem :: Eq a => a -> t a -> Bool
|
||||
elem = any . (==)
|
||||
|
||||
-- | The largest element of a non-empty structure.
|
||||
--
|
||||
-- @since 4.8.0.0
|
||||
maximum :: forall a . Ord a => t a -> a
|
||||
maximum = fromMaybe (errorWithoutStackTrace "maximum: empty structure") .
|
||||
getMax . foldMap (Max #. (Just :: a -> Maybe a))
|
||||
|
||||
-- | The least element of a non-empty structure.
|
||||
--
|
||||
-- @since 4.8.0.0
|
||||
minimum :: forall a . Ord a => t a -> a
|
||||
minimum = fromMaybe (errorWithoutStackTrace "minimum: empty structure") .
|
||||
getMin . foldMap (Min #. (Just :: a -> Maybe a))
|
||||
|
||||
-- | The 'sum' function computes the sum of the numbers of a structure.
|
||||
--
|
||||
-- @since 4.8.0.0
|
||||
sum :: Num a => t a -> a
|
||||
sum = getSum #. foldMap Sum
|
||||
|
||||
-- | The 'product' function computes the product of the numbers of a
|
||||
-- structure.
|
||||
--
|
||||
-- @since 4.8.0.0
|
||||
product :: Num a => t a -> a
|
||||
product = getProduct #. foldMap Product
|
||||
|
||||
@ -536,27 +512,20 @@ deriving instance Foldable Down
|
||||
-- | Monadic fold over the elements of a structure,
|
||||
-- associating to the right, i.e. from right to left.
|
||||
foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b
|
||||
foldrM f z0 xs = foldl c return xs z0
|
||||
-- See Note [List fusion and continuations in 'c']
|
||||
where c k x z = f x z >>= k
|
||||
{-# INLINE c #-}
|
||||
foldrM f z0 xs = foldl f' return xs z0
|
||||
where f' k x z = f x z >>= k
|
||||
|
||||
-- | Monadic fold over the elements of a structure,
|
||||
-- associating to the left, i.e. from left to right.
|
||||
foldlM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b
|
||||
foldlM f z0 xs = foldr c return xs z0
|
||||
-- See Note [List fusion and continuations in 'c']
|
||||
where c x k z = f z x >>= k
|
||||
{-# INLINE c #-}
|
||||
foldlM f z0 xs = foldr f' return xs z0
|
||||
where f' x k z = f z x >>= k
|
||||
|
||||
-- | Map each element of a structure to an action, evaluate these
|
||||
-- actions from left to right, and ignore the results. For a version
|
||||
-- that doesn't ignore the results see 'Data.Traversable.traverse'.
|
||||
traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f ()
|
||||
traverse_ f = foldr c (pure ())
|
||||
-- See Note [List fusion and continuations in 'c']
|
||||
where c x k = f x *> k
|
||||
{-# INLINE c #-}
|
||||
traverse_ f = foldr ((*>) . f) (pure ())
|
||||
|
||||
-- | 'for_' is 'traverse_' with its arguments flipped. For a version
|
||||
-- that doesn't ignore the results see 'Data.Traversable.for'.
|
||||
@ -578,10 +547,7 @@ for_ = flip traverse_
|
||||
-- As of base 4.8.0.0, 'mapM_' is just 'traverse_', specialized to
|
||||
-- 'Monad'.
|
||||
mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m ()
|
||||
mapM_ f = foldr c (return ())
|
||||
-- See Note [List fusion and continuations in 'c']
|
||||
where c x k = f x >> k
|
||||
{-# INLINE c #-}
|
||||
mapM_ f= foldr ((>>) . f) (return ())
|
||||
|
||||
-- | 'forM_' is 'mapM_' with its arguments flipped. For a version that
|
||||
-- doesn't ignore the results see 'Data.Traversable.forM'.
|
||||
@ -595,10 +561,7 @@ forM_ = flip mapM_
|
||||
-- ignore the results. For a version that doesn't ignore the results
|
||||
-- see 'Data.Traversable.sequenceA'.
|
||||
sequenceA_ :: (Foldable t, Applicative f) => t (f a) -> f ()
|
||||
sequenceA_ = foldr c (pure ())
|
||||
-- See Note [List fusion and continuations in 'c']
|
||||
where c m k = m *> k
|
||||
{-# INLINE c #-}
|
||||
sequenceA_ = foldr (*>) (pure ())
|
||||
|
||||
-- | Evaluate each monadic action in the structure from left to right,
|
||||
-- and ignore the results. For a version that doesn't ignore the
|
||||
@ -607,14 +570,11 @@ sequenceA_ = foldr c (pure ())
|
||||
-- As of base 4.8.0.0, 'sequence_' is just 'sequenceA_', specialized
|
||||
-- to 'Monad'.
|
||||
sequence_ :: (Foldable t, Monad m) => t (m a) -> m ()
|
||||
sequence_ = foldr c (return ())
|
||||
-- See Note [List fusion and continuations in 'c']
|
||||
where c m k = m >> k
|
||||
{-# INLINE c #-}
|
||||
sequence_ = foldr (>>) (return ())
|
||||
|
||||
-- | The sum of a collection of actions, generalizing 'concat'.
|
||||
--
|
||||
-- >>> asum [Just "Hello", Nothing, Just "World"]
|
||||
-- asum [Just "Hello", Nothing, Just "World"]
|
||||
-- Just "Hello"
|
||||
asum :: (Foldable t, Alternative f) => t (f a) -> f a
|
||||
{-# INLINE asum #-}
|
||||
@ -689,84 +649,6 @@ notElem x = not . elem x
|
||||
find :: Foldable t => (a -> Bool) -> t a -> Maybe a
|
||||
find p = getFirst . foldMap (\ x -> First (if p x then Just x else Nothing))
|
||||
|
||||
{-
|
||||
Note [List fusion and continuations in 'c']
|
||||
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
Suppose we define
|
||||
mapM_ f = foldr ((>>) . f) (return ())
|
||||
(this is the way it used to be).
|
||||
|
||||
Now suppose we want to optimise the call
|
||||
|
||||
mapM_ <big> (build g)
|
||||
where
|
||||
g c n = ...(c x1 y1)...(c x2 y2)....n...
|
||||
|
||||
GHC used to proceed like this:
|
||||
|
||||
mapM_ <big> (build g)
|
||||
|
||||
= { Definition of mapM_ }
|
||||
foldr ((>>) . <big>) (return ()) (build g)
|
||||
|
||||
= { foldr/build rule }
|
||||
g ((>>) . <big>) (return ())
|
||||
|
||||
= { Inline g }
|
||||
let c = (>>) . <big>
|
||||
n = return ()
|
||||
in ...(c x1 y1)...(c x2 y2)....n...
|
||||
|
||||
The trouble is that `c`, being big, will not be inlined. And that can
|
||||
be absolutely terrible for performance, as we saw in #8763.
|
||||
|
||||
It's much better to define
|
||||
|
||||
mapM_ f = foldr c (return ())
|
||||
where
|
||||
c x k = f x >> k
|
||||
{-# INLINE c #-}
|
||||
|
||||
Now we get
|
||||
mapM_ <big> (build g)
|
||||
|
||||
= { inline mapM_ }
|
||||
foldr c (return ()) (build g)
|
||||
where c x k = f x >> k
|
||||
{-# INLINE c #-}
|
||||
f = <big>
|
||||
|
||||
Notice that `f` does not inline into the RHS of `c`,
|
||||
because the INLINE pragma stops it; see
|
||||
Note [Simplifying inside stable unfoldings] in SimplUtils.
|
||||
Continuing:
|
||||
|
||||
= { foldr/build rule }
|
||||
g c (return ())
|
||||
where ...
|
||||
c x k = f x >> k
|
||||
{-# INLINE c #-}
|
||||
f = <big>
|
||||
|
||||
= { inline g }
|
||||
...(c x1 y1)...(c x2 y2)....n...
|
||||
where c x k = f x >> k
|
||||
{-# INLINE c #-}
|
||||
f = <big>
|
||||
n = return ()
|
||||
|
||||
Now, crucially, `c` does inline
|
||||
|
||||
= { inline c }
|
||||
...(f x1 >> y1)...(f x2 >> y2)....n...
|
||||
where f = <big>
|
||||
n = return ()
|
||||
|
||||
And all is well! The key thing is that the fragment
|
||||
`(f x1 >> y1)` is inlined into the body of the builder
|
||||
`g`.
|
||||
-}
|
||||
|
||||
{-
|
||||
Note [maximumBy/minimumBy space usage]
|
||||
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
@ -776,7 +658,7 @@ foldr1. This was problematic for space usage, as the semantics of maximumBy
|
||||
and minimumBy essentially require that they examine every element of the
|
||||
data structure. Using foldr1 to examine every element results in space usage
|
||||
proportional to the size of the data structure. For the common case of lists,
|
||||
this could be particularly bad (see #10830).
|
||||
this could be particularly bad (see Trac #10830).
|
||||
|
||||
For the common case of lists, switching the implementations of maximumBy and
|
||||
minimumBy to foldl1 solves the issue, as GHC's strictness analysis can then
|
||||
@ -784,7 +666,7 @@ make these functions only use O(1) stack space. It is perhaps not the optimal
|
||||
way to fix this problem, as there are other conceivable data structures
|
||||
(besides lists) which might benefit from specialized implementations for
|
||||
maximumBy and minimumBy (see
|
||||
https://gitlab.haskell.org/ghc/ghc/issues/10830#note_129843 for a further
|
||||
https://ghc.haskell.org/trac/ghc/ticket/10830#comment:26 for a further
|
||||
discussion). But using foldl1 is at least always better than using foldr1, so
|
||||
GHC has chosen to adopt that approach for now.
|
||||
-}
|
||||
|
||||
@ -45,18 +45,16 @@ infixl 1 &
|
||||
-- 120
|
||||
--
|
||||
-- Instead of making a recursive call, we introduce a dummy parameter @rec@;
|
||||
-- when used within 'fix', this parameter then refers to 'fix' argument, hence
|
||||
-- when used within 'fix', this parameter then refers to 'fix'' argument, hence
|
||||
-- the recursion is reintroduced.
|
||||
fix :: (a -> a) -> a
|
||||
fix f = let x = f x in x
|
||||
|
||||
-- | @'on' b u x y@ runs the binary function @b@ /on/ the results of applying
|
||||
-- unary function @u@ to two arguments @x@ and @y@. From the opposite
|
||||
-- perspective, it transforms two inputs and combines the outputs.
|
||||
-- | @'on' b u x y@ runs the binary function `b` /on/ the results of applying unary function `u` to two arguments `x` and `y`. From the opposite perspective, it transforms two inputs and combines the outputs.
|
||||
--
|
||||
-- @((+) \``on`\` f) x y = f x + f y@
|
||||
--
|
||||
-- Typical usage: @'Data.List.sortBy' ('Prelude.compare' \`on\` 'Prelude.fst')@.
|
||||
-- Typical usage: @'Data.List.sortBy' ('compare' \`on\` 'fst')@.
|
||||
--
|
||||
-- Algebraic properties:
|
||||
--
|
||||
|
||||
@ -11,31 +11,8 @@
|
||||
-- Stability : provisional
|
||||
-- Portability : portable
|
||||
--
|
||||
--
|
||||
-- A type @f@ is a Functor if it provides a function @fmap@ which, given any types @a@ and @b@,
|
||||
-- lets you apply any function of type @(a -> b)@ to turn an @f a@ into an @f b@, preserving the
|
||||
-- structure of @f@.
|
||||
--
|
||||
-- ==== __Examples__
|
||||
--
|
||||
-- >>> fmap show (Just 1) -- (a -> b) -> f a -> f b
|
||||
-- Just "1" -- (Int -> String) -> Maybe Int -> Maybe String
|
||||
--
|
||||
-- >>> fmap show Nothing -- (a -> b) -> f a -> f b
|
||||
-- Nothing -- (Int -> String) -> Maybe Int -> Maybe String
|
||||
--
|
||||
-- >>> fmap show [1,2,3] -- (a -> b) -> f a -> f b
|
||||
-- ["1", "2", "3"] -- (Int -> String) -> [Int] -> [String]
|
||||
--
|
||||
-- >>> fmap show [] -- (a -> b) -> f a -> f b
|
||||
-- [] -- (Int -> String) -> [Int] -> [String]
|
||||
--
|
||||
-- The 'fmap' function is also available as the infix operator '<$>':
|
||||
--
|
||||
-- >>> fmap show (Just 1) -- (Int -> String) -> Maybe Int -> Maybe String
|
||||
-- Just "1"
|
||||
-- >>> show <$> (Just 1) -- (Int -> String) -> Maybe Int -> Maybe String
|
||||
-- Just "1"
|
||||
-- Functors: uniform action over a parameterized type, generalizing the
|
||||
-- 'Data.List.map' function on lists.
|
||||
|
||||
module Data.Functor
|
||||
(
|
||||
@ -57,27 +34,26 @@ infixl 4 <$>
|
||||
|
||||
-- | An infix synonym for 'fmap'.
|
||||
--
|
||||
-- The name of this operator is an allusion to 'Prelude.$'.
|
||||
-- The name of this operator is an allusion to '$'.
|
||||
-- Note the similarities between their types:
|
||||
--
|
||||
-- > ($) :: (a -> b) -> a -> b
|
||||
-- > (<$>) :: Functor f => (a -> b) -> f a -> f b
|
||||
--
|
||||
-- Whereas 'Prelude.$' is function application, '<$>' is function
|
||||
-- Whereas '$' is function application, '<$>' is function
|
||||
-- application lifted over a 'Functor'.
|
||||
--
|
||||
-- ==== __Examples__
|
||||
--
|
||||
-- Convert from a @'Data.Maybe.Maybe' 'Data.Int.Int'@ to a @'Data.Maybe.Maybe'
|
||||
-- 'Data.String.String'@ using 'Prelude.show':
|
||||
-- Convert from a @'Maybe' 'Int'@ to a @'Maybe' 'String'@ using 'show':
|
||||
--
|
||||
-- >>> show <$> Nothing
|
||||
-- Nothing
|
||||
-- >>> show <$> Just 3
|
||||
-- Just "3"
|
||||
--
|
||||
-- Convert from an @'Data.Either.Either' 'Data.Int.Int' 'Data.Int.Int'@ to an
|
||||
-- @'Data.Either.Either' 'Data.Int.Int'@ 'Data.String.String' using 'Prelude.show':
|
||||
-- Convert from an @'Either' 'Int' 'Int'@ to an @'Either' 'Int'@
|
||||
-- 'String' using 'show':
|
||||
--
|
||||
-- >>> show <$> Left 17
|
||||
-- Left 17
|
||||
@ -89,7 +65,7 @@ infixl 4 <$>
|
||||
-- >>> (*2) <$> [1,2,3]
|
||||
-- [2,4,6]
|
||||
--
|
||||
-- Apply 'Prelude.even' to the second element of a pair:
|
||||
-- Apply 'even' to the second element of a pair:
|
||||
--
|
||||
-- >>> even <$> (2,2)
|
||||
-- (2,True)
|
||||
@ -130,29 +106,27 @@ infixl 1 <&>
|
||||
--
|
||||
-- ==== __Examples__
|
||||
--
|
||||
-- Replace the contents of a @'Data.Maybe.Maybe' 'Data.Int.Int'@ with a constant
|
||||
-- 'Data.String.String':
|
||||
-- Replace the contents of a @'Maybe' 'Int'@ with a constant 'String':
|
||||
--
|
||||
-- >>> Nothing $> "foo"
|
||||
-- Nothing
|
||||
-- >>> Just 90210 $> "foo"
|
||||
-- Just "foo"
|
||||
--
|
||||
-- Replace the contents of an @'Data.Either.Either' 'Data.Int.Int' 'Data.Int.Int'@
|
||||
-- with a constant 'Data.String.String', resulting in an @'Data.Either.Either'
|
||||
-- 'Data.Int.Int' 'Data.String.String'@:
|
||||
-- Replace the contents of an @'Either' 'Int' 'Int'@ with a constant
|
||||
-- 'String', resulting in an @'Either' 'Int' 'String'@:
|
||||
--
|
||||
-- >>> Left 8675309 $> "foo"
|
||||
-- Left 8675309
|
||||
-- >>> Right 8675309 $> "foo"
|
||||
-- Right "foo"
|
||||
--
|
||||
-- Replace each element of a list with a constant 'Data.String.String':
|
||||
-- Replace each element of a list with a constant 'String':
|
||||
--
|
||||
-- >>> [1,2,3] $> "foo"
|
||||
-- ["foo","foo","foo"]
|
||||
--
|
||||
-- Replace the second element of a pair with a constant 'Data.String.String':
|
||||
-- Replace the second element of a pair with a constant 'String':
|
||||
--
|
||||
-- >>> (1,2) $> "foo"
|
||||
-- (1,"foo")
|
||||
@ -165,15 +139,15 @@ infixl 1 <&>
|
||||
--
|
||||
-- ==== __Examples__
|
||||
--
|
||||
-- Replace the contents of a @'Data.Maybe.Maybe' 'Data.Int.Int'@ with unit:
|
||||
-- Replace the contents of a @'Maybe' 'Int'@ with unit:
|
||||
--
|
||||
-- >>> void Nothing
|
||||
-- Nothing
|
||||
-- >>> void (Just 3)
|
||||
-- Just ()
|
||||
--
|
||||
-- Replace the contents of an @'Data.Either.Either' 'Data.Int.Int' 'Data.Int.Int'@
|
||||
-- with unit, resulting in an @'Data.Either.Either' 'Data.Int.Int' '()'@:
|
||||
-- Replace the contents of an @'Either' 'Int' 'Int'@ with unit,
|
||||
-- resulting in an @'Either' 'Int' '()'@:
|
||||
--
|
||||
-- >>> void (Left 8675309)
|
||||
-- Left 8675309
|
||||
|
||||
@ -69,6 +69,7 @@ import Control.Applicative (Alternative((<|>)), Const(Const))
|
||||
import Data.Functor.Identity (Identity(Identity))
|
||||
import Data.Proxy (Proxy(Proxy))
|
||||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import Data.Monoid (mappend)
|
||||
import Data.Ord (Down(Down))
|
||||
|
||||
import GHC.Read (expectP, list, paren)
|
||||
@ -751,7 +752,7 @@ showsBinaryWith sp1 sp2 name d x y = showParen (d > 10) $
|
||||
-- and then parses its argument using 'readsPrec'.
|
||||
--
|
||||
-- @since 4.9.0.0
|
||||
{-# DEPRECATED readsUnary "Use 'readsUnaryWith' to define 'liftReadsPrec'" #-}
|
||||
{-# DEPRECATED readsUnary "Use readsUnaryWith to define liftReadsPrec" #-}
|
||||
readsUnary :: (Read a) => String -> (a -> t) -> String -> ReadS t
|
||||
readsUnary name cons kw s =
|
||||
[(cons x,t) | kw == name, (x,t) <- readsPrec 11 s]
|
||||
@ -760,7 +761,7 @@ readsUnary name cons kw s =
|
||||
-- and then parses its argument using 'readsPrec1'.
|
||||
--
|
||||
-- @since 4.9.0.0
|
||||
{-# DEPRECATED readsUnary1 "Use 'readsUnaryWith' to define 'liftReadsPrec'" #-}
|
||||
{-# DEPRECATED readsUnary1 "Use readsUnaryWith to define liftReadsPrec" #-}
|
||||
readsUnary1 :: (Read1 f, Read a) => String -> (f a -> t) -> String -> ReadS t
|
||||
readsUnary1 name cons kw s =
|
||||
[(cons x,t) | kw == name, (x,t) <- readsPrec1 11 s]
|
||||
@ -769,8 +770,7 @@ readsUnary1 name cons kw s =
|
||||
-- and then parses its arguments using 'readsPrec1'.
|
||||
--
|
||||
-- @since 4.9.0.0
|
||||
{-# DEPRECATED readsBinary1
|
||||
"Use 'readsBinaryWith' to define 'liftReadsPrec'" #-}
|
||||
{-# DEPRECATED readsBinary1 "Use readsBinaryWith to define liftReadsPrec" #-}
|
||||
readsBinary1 :: (Read1 f, Read1 g, Read a) =>
|
||||
String -> (f a -> g a -> t) -> String -> ReadS t
|
||||
readsBinary1 name cons kw s =
|
||||
@ -781,7 +781,7 @@ readsBinary1 name cons kw s =
|
||||
-- constructor with name @n@ and argument @x@, in precedence context @d@.
|
||||
--
|
||||
-- @since 4.9.0.0
|
||||
{-# DEPRECATED showsUnary "Use 'showsUnaryWith' to define 'liftShowsPrec'" #-}
|
||||
{-# DEPRECATED showsUnary "Use showsUnaryWith to define liftShowsPrec" #-}
|
||||
showsUnary :: (Show a) => String -> Int -> a -> ShowS
|
||||
showsUnary name d x = showParen (d > 10) $
|
||||
showString name . showChar ' ' . showsPrec 11 x
|
||||
@ -790,7 +790,7 @@ showsUnary name d x = showParen (d > 10) $
|
||||
-- constructor with name @n@ and argument @x@, in precedence context @d@.
|
||||
--
|
||||
-- @since 4.9.0.0
|
||||
{-# DEPRECATED showsUnary1 "Use 'showsUnaryWith' to define 'liftShowsPrec'" #-}
|
||||
{-# DEPRECATED showsUnary1 "Use showsUnaryWith to define liftShowsPrec" #-}
|
||||
showsUnary1 :: (Show1 f, Show a) => String -> Int -> f a -> ShowS
|
||||
showsUnary1 name d x = showParen (d > 10) $
|
||||
showString name . showChar ' ' . showsPrec1 11 x
|
||||
@ -800,8 +800,7 @@ showsUnary1 name d x = showParen (d > 10) $
|
||||
-- context @d@.
|
||||
--
|
||||
-- @since 4.9.0.0
|
||||
{-# DEPRECATED showsBinary1
|
||||
"Use 'showsBinaryWith' to define 'liftShowsPrec'" #-}
|
||||
{-# DEPRECATED showsBinary1 "Use showsBinaryWith to define liftShowsPrec" #-}
|
||||
showsBinary1 :: (Show1 f, Show1 g, Show a) =>
|
||||
String -> Int -> f a -> g a -> ShowS
|
||||
showsBinary1 name d x y = showParen (d > 10) $
|
||||
|
||||
@ -1,10 +1,8 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : Data.Functor.Compose
|
||||
@ -29,7 +27,8 @@ import Data.Functor.Classes
|
||||
import Control.Applicative
|
||||
import Data.Coerce (coerce)
|
||||
import Data.Data (Data)
|
||||
import Data.Type.Equality (TestEquality(..), (:~:)(..))
|
||||
import Data.Foldable (Foldable(foldMap))
|
||||
import Data.Traversable (Traversable(traverse))
|
||||
import GHC.Generics (Generic, Generic1)
|
||||
import Text.Read (Read(..), readListDefault, readListPrecDefault)
|
||||
|
||||
@ -121,12 +120,3 @@ instance (Alternative f, Applicative g) => Alternative (Compose f g) where
|
||||
empty = Compose empty
|
||||
(<|>) = coerce ((<|>) :: f (g a) -> f (g a) -> f (g a))
|
||||
:: forall a . Compose f g a -> Compose f g a -> Compose f g a
|
||||
|
||||
-- | The deduction (via generativity) that if @g x :~: g y@ then @x :~: y@.
|
||||
--
|
||||
-- @since 4.14.0.0
|
||||
instance (TestEquality f) => TestEquality (Compose f g) where
|
||||
testEquality (Compose x) (Compose y) =
|
||||
case testEquality x y of -- :: Maybe (g x :~: g y)
|
||||
Just Refl -> Just Refl -- :: Maybe (x :~: y)
|
||||
Nothing -> Nothing
|
||||
|
||||
@ -59,7 +59,7 @@ newtype Const a b = Const { getConst :: a }
|
||||
)
|
||||
|
||||
-- | This instance would be equivalent to the derived instances of the
|
||||
-- 'Const' newtype if the 'getConst' field were removed
|
||||
-- 'Const' newtype if the 'runConst' field were removed
|
||||
--
|
||||
-- @since 4.8.0.0
|
||||
instance Read a => Read (Const a b) where
|
||||
@ -67,7 +67,7 @@ instance Read a => Read (Const a b) where
|
||||
$ \r -> [(Const x,t) | ("Const", s) <- lex r, (x, t) <- readsPrec 11 s]
|
||||
|
||||
-- | This instance would be equivalent to the derived instances of the
|
||||
-- 'Const' newtype if the 'getConst' field were removed
|
||||
-- 'Const' newtype if the 'runConst' field were removed
|
||||
--
|
||||
-- @since 4.8.0.0
|
||||
instance Show a => Show (Const a b) where
|
||||
|
||||
@ -54,6 +54,7 @@ import Data.Functor.Sum
|
||||
import Data.Functor.Compose
|
||||
|
||||
import Data.Monoid (Alt(..))
|
||||
import Data.Semigroup (Semigroup(..))
|
||||
import Data.Proxy
|
||||
import GHC.Generics
|
||||
|
||||
@ -86,8 +87,8 @@ import Prelude hiding ((.),id)
|
||||
--
|
||||
-- Any instance should be subject to the following laws:
|
||||
--
|
||||
-- [Identity] @'contramap' 'id' = 'id'@
|
||||
-- [Composition] @'contramap' (g . f) = 'contramap' f . 'contramap' g@
|
||||
-- > contramap id = id
|
||||
-- > contramap f . contramap g = contramap (g . f)
|
||||
--
|
||||
-- Note, that the second law follows from the free theorem of the type of
|
||||
-- 'contramap' and the first law, so you need only check that the former
|
||||
@ -102,7 +103,7 @@ class Contravariant f where
|
||||
(>$) :: b -> f b -> f a
|
||||
(>$) = contramap . const
|
||||
|
||||
-- | If @f@ is both 'Functor' and 'Contravariant' then by the time you factor
|
||||
-- | If 'f' is both 'Functor' and 'Contravariant' then by the time you factor
|
||||
-- in the laws of each of those classes, it can't actually use its argument in
|
||||
-- any meaningful capacity.
|
||||
--
|
||||
@ -205,11 +206,22 @@ defaultComparison = Comparison compare
|
||||
--
|
||||
-- Equivalence relations are expected to satisfy three laws:
|
||||
--
|
||||
-- [Reflexivity]: @'getEquivalence' f a a = True@
|
||||
-- [Symmetry]: @'getEquivalence' f a b = 'getEquivalence' f b a@
|
||||
-- [Transitivity]:
|
||||
-- If @'getEquivalence' f a b@ and @'getEquivalence' f b c@ are both 'True'
|
||||
-- then so is @'getEquivalence' f a c@.
|
||||
-- __Reflexivity__:
|
||||
--
|
||||
-- @
|
||||
-- 'getEquivalence' f a a = True
|
||||
-- @
|
||||
--
|
||||
-- __Symmetry__:
|
||||
--
|
||||
-- @
|
||||
-- 'getEquivalence' f a b = 'getEquivalence' f b a
|
||||
-- @
|
||||
--
|
||||
-- __Transitivity__:
|
||||
--
|
||||
-- If @'getEquivalence' f a b@ and @'getEquivalence' f b c@ are both 'True'
|
||||
-- then so is @'getEquivalence' f a c@.
|
||||
--
|
||||
-- The types alone do not enforce these laws, so you'll have to check them
|
||||
-- yourself.
|
||||
|
||||
@ -26,7 +26,10 @@ import Control.Monad (MonadPlus(..))
|
||||
import Control.Monad.Fix (MonadFix(..))
|
||||
import Control.Monad.Zip (MonadZip(mzipWith))
|
||||
import Data.Data (Data)
|
||||
import Data.Foldable (Foldable(foldMap))
|
||||
import Data.Functor.Classes
|
||||
import Data.Monoid (mappend)
|
||||
import Data.Traversable (Traversable(traverse))
|
||||
import GHC.Generics (Generic, Generic1)
|
||||
import Text.Read (Read(..), readListDefault, readListPrecDefault)
|
||||
|
||||
|
||||
@ -23,7 +23,9 @@ module Data.Functor.Sum (
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
import Data.Data (Data)
|
||||
import Data.Foldable (Foldable(foldMap))
|
||||
import Data.Functor.Classes
|
||||
import Data.Traversable (Traversable(traverse))
|
||||
import GHC.Generics (Generic, Generic1)
|
||||
import Text.Read (Read(..), readListDefault, readListPrecDefault)
|
||||
|
||||
|
||||
@ -48,7 +48,7 @@ instance Ord a => Semigroup (Min a) where
|
||||
instance Ord a => Monoid (Min a) where
|
||||
mempty = Min Nothing
|
||||
|
||||
-- left-to-right state-transforming monad
|
||||
-- left-to-right state transformer
|
||||
newtype StateL s a = StateL { runStateL :: s -> (s, a) }
|
||||
|
||||
-- | @since 4.0
|
||||
@ -67,7 +67,7 @@ instance Applicative (StateL s) where
|
||||
(s'', y) = ky s'
|
||||
in (s'', f x y)
|
||||
|
||||
-- right-to-left state-transforming monad
|
||||
-- right-to-left state transformer
|
||||
newtype StateR s a = StateR { runStateR :: s -> (s, a) }
|
||||
|
||||
-- | @since 4.0
|
||||
|
||||
@ -1,6 +1,5 @@
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -37,7 +36,8 @@ module Data.IORef
|
||||
|
||||
import GHC.Base
|
||||
import GHC.STRef
|
||||
import GHC.IORef
|
||||
import GHC.IORef hiding (atomicModifyIORef)
|
||||
import qualified GHC.IORef
|
||||
import GHC.Weak
|
||||
|
||||
-- |Make a 'Weak' pointer to an 'IORef', using the second argument as a finalizer
|
||||
@ -91,9 +91,18 @@ modifyIORef' ref f = do
|
||||
-- Use 'atomicModifyIORef'' or 'atomicWriteIORef' to avoid this problem.
|
||||
--
|
||||
atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b
|
||||
atomicModifyIORef ref f = do
|
||||
(_old, ~(_new, res)) <- atomicModifyIORef2 ref f
|
||||
pure res
|
||||
atomicModifyIORef = GHC.IORef.atomicModifyIORef
|
||||
|
||||
-- | Strict version of 'atomicModifyIORef'. This forces both the value stored
|
||||
-- in the 'IORef' as well as the value returned.
|
||||
--
|
||||
-- @since 4.6.0.0
|
||||
atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b
|
||||
atomicModifyIORef' ref f = do
|
||||
b <- atomicModifyIORef ref $ \a ->
|
||||
case f a of
|
||||
v@(a',_) -> a' `seq` v
|
||||
b `seq` return b
|
||||
|
||||
-- | Variant of 'writeIORef' with the \"barrier to reordering\" property that
|
||||
-- 'atomicModifyIORef' has.
|
||||
@ -101,8 +110,8 @@ atomicModifyIORef ref f = do
|
||||
-- @since 4.6.0.0
|
||||
atomicWriteIORef :: IORef a -> a -> IO ()
|
||||
atomicWriteIORef ref a = do
|
||||
_ <- atomicSwapIORef ref a
|
||||
pure ()
|
||||
x <- atomicModifyIORef ref (\_ -> (a, ()))
|
||||
x `seq` return ()
|
||||
|
||||
{- $memmodel
|
||||
|
||||
@ -111,23 +120,19 @@ atomicWriteIORef ref a = do
|
||||
processor architecture. For example, on x86, loads can move ahead
|
||||
of stores, so in the following example:
|
||||
|
||||
> import Data.IORef
|
||||
> import Control.Monad (unless)
|
||||
> import Control.Concurrent (forkIO, threadDelay)
|
||||
>
|
||||
> maybePrint :: IORef Bool -> IORef Bool -> IO ()
|
||||
> maybePrint myRef yourRef = do
|
||||
> writeIORef myRef True
|
||||
> yourVal <- readIORef yourRef
|
||||
> unless yourVal $ putStrLn "critical section"
|
||||
>
|
||||
> main :: IO ()
|
||||
> main = do
|
||||
> r1 <- newIORef False
|
||||
> r2 <- newIORef False
|
||||
> forkIO $ maybePrint r1 r2
|
||||
> forkIO $ maybePrint r2 r1
|
||||
> threadDelay 1000000
|
||||
> maybePrint :: IORef Bool -> IORef Bool -> IO ()
|
||||
> maybePrint myRef yourRef = do
|
||||
> writeIORef myRef True
|
||||
> yourVal <- readIORef yourRef
|
||||
> unless yourVal $ putStrLn "critical section"
|
||||
>
|
||||
> main :: IO ()
|
||||
> main = do
|
||||
> r1 <- newIORef False
|
||||
> r2 <- newIORef False
|
||||
> forkIO $ maybePrint r1 r2
|
||||
> forkIO $ maybePrint r2 r1
|
||||
> threadDelay 1000000
|
||||
|
||||
it is possible that the string @"critical section"@ is printed
|
||||
twice, even though there is no interleaving of the operations of the
|
||||
|
||||
@ -178,8 +178,8 @@ module Data.List
|
||||
-- counterpart whose name is suffixed with \`@By@\'.
|
||||
--
|
||||
-- It is often convenient to use these functions together with
|
||||
-- 'Data.Function.on', for instance @'sortBy' ('Prelude.compare'
|
||||
-- ``Data.Function.on`` 'Prelude.fst')@.
|
||||
-- 'Data.Function.on', for instance @'sortBy' ('compare'
|
||||
-- \`on\` 'fst')@.
|
||||
|
||||
-- *** User-supplied equality (replacing an @Eq@ context)
|
||||
-- | The predicate is assumed to define an equivalence.
|
||||
|
||||
@ -380,7 +380,7 @@ groupWith1 f = groupBy1 ((==) `on` f)
|
||||
groupAllWith1 :: (Ord b) => (a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a)
|
||||
groupAllWith1 f = groupWith1 f . sortWith f
|
||||
|
||||
-- | The 'isPrefixOf' function returns 'True' if the first argument is
|
||||
-- | The 'isPrefix' function returns @True@ if the first argument is
|
||||
-- a prefix of the second.
|
||||
isPrefixOf :: Eq a => [a] -> NonEmpty a -> Bool
|
||||
isPrefixOf [] _ = True
|
||||
|
||||
@ -32,7 +32,6 @@ module Data.Maybe
|
||||
) where
|
||||
|
||||
import GHC.Base
|
||||
import GHC.Stack.Types ( HasCallStack )
|
||||
|
||||
-- $setup
|
||||
-- Allow the use of some Prelude functions in doctests.
|
||||
@ -56,7 +55,7 @@ import GHC.Stack.Types ( HasCallStack )
|
||||
-- >>> maybe False odd Nothing
|
||||
-- False
|
||||
--
|
||||
-- Read an integer from a string using 'Text.Read.readMaybe'. If we succeed,
|
||||
-- Read an integer from a string using 'readMaybe'. If we succeed,
|
||||
-- return twice the integer; that is, apply @(*2)@ to it. If instead
|
||||
-- we fail to parse an integer, return @0@ by default:
|
||||
--
|
||||
@ -66,7 +65,7 @@ import GHC.Stack.Types ( HasCallStack )
|
||||
-- >>> maybe 0 (*2) (readMaybe "")
|
||||
-- 0
|
||||
--
|
||||
-- Apply 'Prelude.show' to a @Maybe Int@. If we have @Just n@, we want to show
|
||||
-- Apply 'show' to a @Maybe Int@. If we have @Just n@, we want to show
|
||||
-- the underlying 'Int' @n@. But if we have 'Nothing', we return the
|
||||
-- empty string instead of (for example) \"Nothing\":
|
||||
--
|
||||
@ -144,8 +143,8 @@ isNothing _ = False
|
||||
-- >>> 2 * (fromJust Nothing)
|
||||
-- *** Exception: Maybe.fromJust: Nothing
|
||||
--
|
||||
fromJust :: HasCallStack => Maybe a -> a
|
||||
fromJust Nothing = error "Maybe.fromJust: Nothing" -- yuck
|
||||
fromJust :: Maybe a -> a
|
||||
fromJust Nothing = errorWithoutStackTrace "Maybe.fromJust: Nothing" -- yuck
|
||||
fromJust (Just x) = x
|
||||
|
||||
-- | The 'fromMaybe' function takes a default value and and 'Maybe'
|
||||
@ -162,7 +161,7 @@ fromJust (Just x) = x
|
||||
-- >>> fromMaybe "" Nothing
|
||||
-- ""
|
||||
--
|
||||
-- Read an integer from a string using 'Text.Read.readMaybe'. If we fail to
|
||||
-- Read an integer from a string using 'readMaybe'. If we fail to
|
||||
-- parse an integer, we want to return @0@ by default:
|
||||
--
|
||||
-- >>> import Text.Read ( readMaybe )
|
||||
@ -175,7 +174,7 @@ fromMaybe :: a -> Maybe a -> a
|
||||
fromMaybe d x = case x of {Nothing -> d;Just v -> v}
|
||||
|
||||
-- | The 'maybeToList' function returns an empty list when given
|
||||
-- 'Nothing' or a singleton list when given 'Just'.
|
||||
-- 'Nothing' or a singleton list when not given 'Nothing'.
|
||||
--
|
||||
-- ==== __Examples__
|
||||
--
|
||||
|
||||
@ -16,43 +16,8 @@
|
||||
-- Stability : experimental
|
||||
-- Portability : portable
|
||||
--
|
||||
-- A type @a@ is a 'Monoid' if it provides an associative function ('<>')
|
||||
-- that lets you combine any two values of type @a@ into one, and a neutral
|
||||
-- element (`mempty`) such that
|
||||
--
|
||||
-- > a <> mempty == mempty <> a == a
|
||||
--
|
||||
-- A 'Monoid' is a 'Semigroup' with the added requirement of a neutral element.
|
||||
-- Thus any 'Monoid' is a 'Semigroup', but not the other way around.
|
||||
--
|
||||
-- ==== __Examples__
|
||||
--
|
||||
-- The 'Sum' monoid is defined by the numerical addition operator and `0` as neutral element:
|
||||
--
|
||||
-- >>> mempty :: Sum Int
|
||||
-- Sum 0
|
||||
-- >>> Sum 1 <> Sum 2 <> Sum 3 <> Sum 4 :: Sum Int
|
||||
-- Sum {getSum = 10}
|
||||
--
|
||||
-- We can combine multiple values in a list into a single value using the `mconcat` function.
|
||||
-- Note that we have to specify the type here since 'Int' is a monoid under several different
|
||||
-- operations:
|
||||
--
|
||||
-- >>> mconcat [1,2,3,4] :: Sum Int
|
||||
-- Sum {getSum = 10}
|
||||
-- >>> mconcat [] :: Sum Int
|
||||
-- Sum {getSum = 0}
|
||||
--
|
||||
-- Another valid monoid instance of 'Int' is 'Product' It is defined by multiplication
|
||||
-- and `1` as neutral element:
|
||||
--
|
||||
-- >>> Product 1 <> Product 2 <> Product 3 <> Product 4 :: Product Int
|
||||
-- Product {getProduct = 24}
|
||||
-- >>> mconcat [1,2,3,4] :: Product Int
|
||||
-- Product {getProduct = 24}
|
||||
-- >>> mconcat [] :: Product Int
|
||||
-- Product {getProduct = 1}
|
||||
--
|
||||
-- A class for monoids (types with an associative binary operation that
|
||||
-- has an identity) with various general-purpose instances.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
@ -91,7 +56,7 @@ import Control.Monad.Fail (MonadFail)
|
||||
import Data.Semigroup.Internal
|
||||
|
||||
-- $MaybeExamples
|
||||
-- To implement @find@ or @findLast@ on any 'Data.Foldable.Foldable':
|
||||
-- To implement @find@ or @findLast@ on any 'Foldable':
|
||||
--
|
||||
-- @
|
||||
-- findLast :: Foldable t => (a -> Bool) -> t a -> Maybe a
|
||||
@ -100,20 +65,20 @@ import Data.Semigroup.Internal
|
||||
-- else Last Nothing)
|
||||
-- @
|
||||
--
|
||||
-- Much of 'Data.Map.Lazy.Map's interface can be implemented with
|
||||
-- 'Data.Map.Lazy.alter'. Some of the rest can be implemented with a new
|
||||
-- 'Data.Map.Lazy.alterF' function and either 'First' or 'Last':
|
||||
-- Much of Data.Map's interface can be implemented with
|
||||
-- Data.Map.alter. Some of the rest can be implemented with a new
|
||||
-- @alterA@ function and either 'First' or 'Last':
|
||||
--
|
||||
-- > alterF :: (Functor f, Ord k) =>
|
||||
-- > alterA :: (Applicative f, Ord k) =>
|
||||
-- > (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
|
||||
-- >
|
||||
-- > instance Monoid a => Functor ((,) a) -- from Data.Functor
|
||||
-- > instance Monoid a => Applicative ((,) a) -- from Control.Applicative
|
||||
--
|
||||
-- @
|
||||
-- insertLookupWithKey :: Ord k => (k -> v -> v -> v) -> k -> v
|
||||
-- -> Map k v -> (Maybe v, Map k v)
|
||||
-- insertLookupWithKey combine key value =
|
||||
-- Arrow.first getFirst . 'Data.Map.Lazy.alterF' doChange key
|
||||
-- Arrow.first getFirst . alterA doChange key
|
||||
-- where
|
||||
-- doChange Nothing = (First Nothing, Just value)
|
||||
-- doChange (Just oldValue) =
|
||||
|
||||
@ -221,7 +221,7 @@ import GHC.Real
|
||||
import GHC.List
|
||||
import GHC.Base
|
||||
|
||||
infix 5 \\ -- comment to fool cpp: https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/phases.html#cpp-and-string-gaps
|
||||
infix 5 \\ -- comment to fool cpp: https://www.haskell.org/ghc/docs/latest/html/users_guide/options-phases.html#cpp-string-gaps
|
||||
|
||||
-- -----------------------------------------------------------------------------
|
||||
-- List functions
|
||||
@ -241,9 +241,9 @@ infix 5 \\ -- comment to fool cpp: https://downloads.haskell.org/~ghc/latest/doc
|
||||
dropWhileEnd :: (a -> Bool) -> [a] -> [a]
|
||||
dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []
|
||||
|
||||
-- | /O(min(m,n))/. The 'stripPrefix' function drops the given prefix from a
|
||||
-- list. It returns 'Nothing' if the list did not start with the prefix given,
|
||||
-- or 'Just' the list after the prefix, if it does.
|
||||
-- | The 'stripPrefix' function drops the given prefix from a list.
|
||||
-- It returns 'Nothing' if the list did not start with the prefix
|
||||
-- given, or 'Just' the list after the prefix, if it does.
|
||||
--
|
||||
-- >>> stripPrefix "foo" "foobar"
|
||||
-- Just "bar"
|
||||
@ -310,16 +310,14 @@ findIndices :: (a -> Bool) -> [a] -> [Int]
|
||||
findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
|
||||
#else
|
||||
-- Efficient definition, adapted from Data.Sequence
|
||||
-- (Note that making this INLINABLE instead of INLINE allows
|
||||
-- 'findIndex' to fuse, fixing #15426.)
|
||||
{-# INLINABLE findIndices #-}
|
||||
{-# INLINE findIndices #-}
|
||||
findIndices p ls = build $ \c n ->
|
||||
let go x r k | p x = I# k `c` r (k +# 1#)
|
||||
| otherwise = r (k +# 1#)
|
||||
in foldr go (\_ -> n) ls 0#
|
||||
#endif /* USE_REPORT_PRELUDE */
|
||||
|
||||
-- | /O(min(m,n))/. The 'isPrefixOf' function takes two lists and returns 'True'
|
||||
-- | The 'isPrefixOf' function takes two lists and returns 'True'
|
||||
-- iff the first list is a prefix of the second.
|
||||
--
|
||||
-- >>> "Hello" `isPrefixOf` "Hello World!"
|
||||
@ -431,8 +429,8 @@ elem_by eq y (x:xs) = x `eq` y || elem_by eq y xs
|
||||
#endif
|
||||
|
||||
|
||||
-- | /O(n)/. 'delete' @x@ removes the first occurrence of @x@ from its list
|
||||
-- argument. For example,
|
||||
-- | 'delete' @x@ removes the first occurrence of @x@ from its list argument.
|
||||
-- For example,
|
||||
--
|
||||
-- >>> delete 'a' "banana"
|
||||
-- "bnana"
|
||||
@ -442,7 +440,7 @@ elem_by eq y (x:xs) = x `eq` y || elem_by eq y xs
|
||||
delete :: (Eq a) => a -> [a] -> [a]
|
||||
delete = deleteBy (==)
|
||||
|
||||
-- | /O(n)/. The 'deleteBy' function behaves like 'delete', but takes a
|
||||
-- | The 'deleteBy' function behaves like 'delete', but takes a
|
||||
-- user-supplied equality predicate.
|
||||
--
|
||||
-- >>> deleteBy (<=) 4 [1..10]
|
||||
@ -509,7 +507,7 @@ intersectBy _ [] _ = []
|
||||
intersectBy _ _ [] = []
|
||||
intersectBy eq xs ys = [x | x <- xs, any (eq x) ys]
|
||||
|
||||
-- | /O(n)/. The 'intersperse' function takes an element and a list and
|
||||
-- | The 'intersperse' function takes an element and a list and
|
||||
-- \`intersperses\' that element between the elements of the list.
|
||||
-- For example,
|
||||
--
|
||||
@ -618,18 +616,19 @@ mapAccumR f s (x:xs) = (s'', y:ys)
|
||||
where (s'',y ) = f s' x
|
||||
(s', ys) = mapAccumR f s xs
|
||||
|
||||
-- | /O(n)/. The 'insert' function takes an element and a list and inserts the
|
||||
-- element into the list at the first position where it is less than or equal to
|
||||
-- the next element. In particular, if the list is sorted before the call, the
|
||||
-- result will also be sorted. It is a special case of 'insertBy', which allows
|
||||
-- the programmer to supply their own comparison function.
|
||||
-- | The 'insert' function takes an element and a list and inserts the
|
||||
-- element into the list at the first position where it is less
|
||||
-- than or equal to the next element. In particular, if the list
|
||||
-- is sorted before the call, the result will also be sorted.
|
||||
-- It is a special case of 'insertBy', which allows the programmer to
|
||||
-- supply their own comparison function.
|
||||
--
|
||||
-- >>> insert 4 [1,2,3,5,6,7]
|
||||
-- [1,2,3,4,5,6,7]
|
||||
insert :: Ord a => a -> [a] -> [a]
|
||||
insert e ls = insertBy (compare) e ls
|
||||
|
||||
-- | /O(n)/. The non-overloaded version of 'insert'.
|
||||
-- | The non-overloaded version of 'insert'.
|
||||
insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
|
||||
insertBy _ x [] = [x]
|
||||
insertBy cmp x ys@(y:ys')
|
||||
@ -669,14 +668,9 @@ minimumBy cmp xs = foldl1 minBy xs
|
||||
GT -> y
|
||||
_ -> x
|
||||
|
||||
-- | /O(n)/. The 'genericLength' function is an overloaded version of 'length'.
|
||||
-- In particular, instead of returning an 'Int', it returns any type which is an
|
||||
-- instance of 'Num'. It is, however, less efficient than 'length'.
|
||||
--
|
||||
-- >>> genericLength [1, 2, 3] :: Int
|
||||
-- 3
|
||||
-- >>> genericLength [1, 2, 3] :: Float
|
||||
-- 3.0
|
||||
-- | The 'genericLength' function is an overloaded version of 'length'. In
|
||||
-- particular, instead of returning an 'Int', it returns any type which is
|
||||
-- an instance of 'Num'. It is, however, less efficient than 'length'.
|
||||
genericLength :: (Num i) => [a] -> i
|
||||
{-# NOINLINE [1] genericLength #-}
|
||||
genericLength [] = 0
|
||||
@ -732,34 +726,22 @@ genericReplicate n x = genericTake n (repeat x)
|
||||
|
||||
-- | The 'zip4' function takes four lists and returns a list of
|
||||
-- quadruples, analogous to 'zip'.
|
||||
-- It is capable of list fusion, but it is restricted to its
|
||||
-- first list argument and its resulting list.
|
||||
{-# INLINE zip4 #-}
|
||||
zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
|
||||
zip4 = zipWith4 (,,,)
|
||||
|
||||
-- | The 'zip5' function takes five lists and returns a list of
|
||||
-- five-tuples, analogous to 'zip'.
|
||||
-- It is capable of list fusion, but it is restricted to its
|
||||
-- first list argument and its resulting list.
|
||||
{-# INLINE zip5 #-}
|
||||
zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
|
||||
zip5 = zipWith5 (,,,,)
|
||||
|
||||
-- | The 'zip6' function takes six lists and returns a list of six-tuples,
|
||||
-- analogous to 'zip'.
|
||||
-- It is capable of list fusion, but it is restricted to its
|
||||
-- first list argument and its resulting list.
|
||||
{-# INLINE zip6 #-}
|
||||
zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
|
||||
[(a,b,c,d,e,f)]
|
||||
zip6 = zipWith6 (,,,,,)
|
||||
|
||||
-- | The 'zip7' function takes seven lists and returns a list of
|
||||
-- seven-tuples, analogous to 'zip'.
|
||||
-- It is capable of list fusion, but it is restricted to its
|
||||
-- first list argument and its resulting list.
|
||||
{-# INLINE zip7 #-}
|
||||
zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
|
||||
[g] -> [(a,b,c,d,e,f,g)]
|
||||
zip7 = zipWith7 (,,,,,,)
|
||||
@ -767,9 +749,6 @@ zip7 = zipWith7 (,,,,,,)
|
||||
-- | The 'zipWith4' function takes a function which combines four
|
||||
-- elements, as well as four lists and returns a list of their point-wise
|
||||
-- combination, analogous to 'zipWith'.
|
||||
-- It is capable of list fusion, but it is restricted to its
|
||||
-- first list argument and its resulting list.
|
||||
{-# NOINLINE [1] zipWith4 #-}
|
||||
zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
|
||||
zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
|
||||
= z a b c d : zipWith4 z as bs cs ds
|
||||
@ -778,9 +757,6 @@ zipWith4 _ _ _ _ _ = []
|
||||
-- | The 'zipWith5' function takes a function which combines five
|
||||
-- elements, as well as five lists and returns a list of their point-wise
|
||||
-- combination, analogous to 'zipWith'.
|
||||
-- It is capable of list fusion, but it is restricted to its
|
||||
-- first list argument and its resulting list.
|
||||
{-# NOINLINE [1] zipWith5 #-}
|
||||
zipWith5 :: (a->b->c->d->e->f) ->
|
||||
[a]->[b]->[c]->[d]->[e]->[f]
|
||||
zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
|
||||
@ -790,9 +766,6 @@ zipWith5 _ _ _ _ _ _ = []
|
||||
-- | The 'zipWith6' function takes a function which combines six
|
||||
-- elements, as well as six lists and returns a list of their point-wise
|
||||
-- combination, analogous to 'zipWith'.
|
||||
-- It is capable of list fusion, but it is restricted to its
|
||||
-- first list argument and its resulting list.
|
||||
{-# NOINLINE [1] zipWith6 #-}
|
||||
zipWith6 :: (a->b->c->d->e->f->g) ->
|
||||
[a]->[b]->[c]->[d]->[e]->[f]->[g]
|
||||
zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
|
||||
@ -802,154 +775,14 @@ zipWith6 _ _ _ _ _ _ _ = []
|
||||
-- | The 'zipWith7' function takes a function which combines seven
|
||||
-- elements, as well as seven lists and returns a list of their point-wise
|
||||
-- combination, analogous to 'zipWith'.
|
||||
-- It is capable of list fusion, but it is restricted to its
|
||||
-- first list argument and its resulting list.
|
||||
{-# NOINLINE [1] zipWith7 #-}
|
||||
zipWith7 :: (a->b->c->d->e->f->g->h) ->
|
||||
[a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
|
||||
zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
|
||||
= z a b c d e f g : zipWith7 z as bs cs ds es fs gs
|
||||
zipWith7 _ _ _ _ _ _ _ _ = []
|
||||
|
||||
{-
|
||||
Functions and rules for fusion of zipWith4, zipWith5, zipWith6 and zipWith7.
|
||||
The principle is the same as for zip and zipWith in GHC.List:
|
||||
Turn zipWithX into a version in which the first argument and the result
|
||||
can be fused. Turn it back into the original function if no fusion happens.
|
||||
-}
|
||||
|
||||
{-# INLINE [0] zipWith4FB #-} -- See Note [Inline FB functions]
|
||||
zipWith4FB :: (e->xs->xs') -> (a->b->c->d->e) ->
|
||||
a->b->c->d->xs->xs'
|
||||
zipWith4FB cons func = \a b c d r -> (func a b c d) `cons` r
|
||||
|
||||
{-# INLINE [0] zipWith5FB #-} -- See Note [Inline FB functions]
|
||||
zipWith5FB :: (f->xs->xs') -> (a->b->c->d->e->f) ->
|
||||
a->b->c->d->e->xs->xs'
|
||||
zipWith5FB cons func = \a b c d e r -> (func a b c d e) `cons` r
|
||||
|
||||
{-# INLINE [0] zipWith6FB #-} -- See Note [Inline FB functions]
|
||||
zipWith6FB :: (g->xs->xs') -> (a->b->c->d->e->f->g) ->
|
||||
a->b->c->d->e->f->xs->xs'
|
||||
zipWith6FB cons func = \a b c d e f r -> (func a b c d e f) `cons` r
|
||||
|
||||
{-# INLINE [0] zipWith7FB #-} -- See Note [Inline FB functions]
|
||||
zipWith7FB :: (h->xs->xs') -> (a->b->c->d->e->f->g->h) ->
|
||||
a->b->c->d->e->f->g->xs->xs'
|
||||
zipWith7FB cons func = \a b c d e f g r -> (func a b c d e f g) `cons` r
|
||||
|
||||
{-# INLINE [0] foldr4 #-}
|
||||
foldr4 :: (a->b->c->d->e->e) ->
|
||||
e->[a]->[b]->[c]->[d]->e
|
||||
foldr4 k z = go
|
||||
where
|
||||
go (a:as) (b:bs) (c:cs) (d:ds) = k a b c d (go as bs cs ds)
|
||||
go _ _ _ _ = z
|
||||
|
||||
{-# INLINE [0] foldr5 #-}
|
||||
foldr5 :: (a->b->c->d->e->f->f) ->
|
||||
f->[a]->[b]->[c]->[d]->[e]->f
|
||||
foldr5 k z = go
|
||||
where
|
||||
go (a:as) (b:bs) (c:cs) (d:ds) (e:es) = k a b c d e (go as bs cs ds es)
|
||||
go _ _ _ _ _ = z
|
||||
|
||||
{-# INLINE [0] foldr6 #-}
|
||||
foldr6 :: (a->b->c->d->e->f->g->g) ->
|
||||
g->[a]->[b]->[c]->[d]->[e]->[f]->g
|
||||
foldr6 k z = go
|
||||
where
|
||||
go (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) = k a b c d e f (
|
||||
go as bs cs ds es fs)
|
||||
go _ _ _ _ _ _ = z
|
||||
|
||||
{-# INLINE [0] foldr7 #-}
|
||||
foldr7 :: (a->b->c->d->e->f->g->h->h) ->
|
||||
h->[a]->[b]->[c]->[d]->[e]->[f]->[g]->h
|
||||
foldr7 k z = go
|
||||
where
|
||||
go (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) = k a b c d e f g (
|
||||
go as bs cs ds es fs gs)
|
||||
go _ _ _ _ _ _ _ = z
|
||||
|
||||
foldr4_left :: (a->b->c->d->e->f)->
|
||||
f->a->([b]->[c]->[d]->e)->
|
||||
[b]->[c]->[d]->f
|
||||
foldr4_left k _z a r (b:bs) (c:cs) (d:ds) = k a b c d (r bs cs ds)
|
||||
foldr4_left _ z _ _ _ _ _ = z
|
||||
|
||||
foldr5_left :: (a->b->c->d->e->f->g)->
|
||||
g->a->([b]->[c]->[d]->[e]->f)->
|
||||
[b]->[c]->[d]->[e]->g
|
||||
foldr5_left k _z a r (b:bs) (c:cs) (d:ds) (e:es) = k a b c d e (r bs cs ds es)
|
||||
foldr5_left _ z _ _ _ _ _ _ = z
|
||||
|
||||
foldr6_left :: (a->b->c->d->e->f->g->h)->
|
||||
h->a->([b]->[c]->[d]->[e]->[f]->g)->
|
||||
[b]->[c]->[d]->[e]->[f]->h
|
||||
foldr6_left k _z a r (b:bs) (c:cs) (d:ds) (e:es) (f:fs) =
|
||||
k a b c d e f (r bs cs ds es fs)
|
||||
foldr6_left _ z _ _ _ _ _ _ _ = z
|
||||
|
||||
foldr7_left :: (a->b->c->d->e->f->g->h->i)->
|
||||
i->a->([b]->[c]->[d]->[e]->[f]->[g]->h)->
|
||||
[b]->[c]->[d]->[e]->[f]->[g]->i
|
||||
foldr7_left k _z a r (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) =
|
||||
k a b c d e f g (r bs cs ds es fs gs)
|
||||
foldr7_left _ z _ _ _ _ _ _ _ _ = z
|
||||
|
||||
{-# RULES
|
||||
|
||||
"foldr4/left" forall k z (g::forall b.(a->b->b)->b->b).
|
||||
foldr4 k z (build g) = g (foldr4_left k z) (\_ _ _ -> z)
|
||||
"foldr5/left" forall k z (g::forall b.(a->b->b)->b->b).
|
||||
foldr5 k z (build g) = g (foldr5_left k z) (\_ _ _ _ -> z)
|
||||
"foldr6/left" forall k z (g::forall b.(a->b->b)->b->b).
|
||||
foldr6 k z (build g) = g (foldr6_left k z) (\_ _ _ _ _ -> z)
|
||||
"foldr7/left" forall k z (g::forall b.(a->b->b)->b->b).
|
||||
foldr7 k z (build g) = g (foldr7_left k z) (\_ _ _ _ _ _ -> z)
|
||||
|
||||
"zipWith4" [~1] forall f as bs cs ds.
|
||||
zipWith4 f as bs cs ds = build (\c n ->
|
||||
foldr4 (zipWith4FB c f) n as bs cs ds)
|
||||
"zipWith5" [~1] forall f as bs cs ds es.
|
||||
zipWith5 f as bs cs ds es = build (\c n ->
|
||||
foldr5 (zipWith5FB c f) n as bs cs ds es)
|
||||
"zipWith6" [~1] forall f as bs cs ds es fs.
|
||||
zipWith6 f as bs cs ds es fs = build (\c n ->
|
||||
foldr6 (zipWith6FB c f) n as bs cs ds es fs)
|
||||
"zipWith7" [~1] forall f as bs cs ds es fs gs.
|
||||
zipWith7 f as bs cs ds es fs gs = build (\c n ->
|
||||
foldr7 (zipWith7FB c f) n as bs cs ds es fs gs)
|
||||
|
||||
"zipWith4List" [1] forall f. foldr4 (zipWith4FB (:) f) [] = zipWith4 f
|
||||
"zipWith5List" [1] forall f. foldr5 (zipWith5FB (:) f) [] = zipWith5 f
|
||||
"zipWith6List" [1] forall f. foldr6 (zipWith6FB (:) f) [] = zipWith6 f
|
||||
"zipWith7List" [1] forall f. foldr7 (zipWith7FB (:) f) [] = zipWith7 f
|
||||
|
||||
#-}
|
||||
|
||||
{-
|
||||
|
||||
Note [Inline @unzipN@ functions]
|
||||
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
The inline principle for @unzip{4,5,6,7}@ is the same as 'unzip'/'unzip3' in
|
||||
"GHC.List".
|
||||
The 'unzip'/'unzip3' functions are inlined so that the `foldr` with which they
|
||||
are defined has an opportunity to fuse.
|
||||
|
||||
As such, since there are not any differences between 2/3-ary 'unzip' and its
|
||||
n-ary counterparts below aside from the number of arguments, the `INLINE`
|
||||
pragma should be replicated in the @unzipN@ functions below as well.
|
||||
|
||||
-}
|
||||
|
||||
-- | The 'unzip4' function takes a list of quadruples and returns four
|
||||
-- lists, analogous to 'unzip'.
|
||||
{-# INLINE unzip4 #-}
|
||||
-- Inline so that fusion with `foldr` has an opportunity to fire.
|
||||
-- See Note [Inline @unzipN@ functions] above.
|
||||
unzip4 :: [(a,b,c,d)] -> ([a],[b],[c],[d])
|
||||
unzip4 = foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
|
||||
(a:as,b:bs,c:cs,d:ds))
|
||||
@ -957,9 +790,6 @@ unzip4 = foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
|
||||
|
||||
-- | The 'unzip5' function takes a list of five-tuples and returns five
|
||||
-- lists, analogous to 'unzip'.
|
||||
{-# INLINE unzip5 #-}
|
||||
-- Inline so that fusion with `foldr` has an opportunity to fire.
|
||||
-- See Note [Inline @unzipN@ functions] above.
|
||||
unzip5 :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])
|
||||
unzip5 = foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
|
||||
(a:as,b:bs,c:cs,d:ds,e:es))
|
||||
@ -967,9 +797,6 @@ unzip5 = foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
|
||||
|
||||
-- | The 'unzip6' function takes a list of six-tuples and returns six
|
||||
-- lists, analogous to 'unzip'.
|
||||
{-# INLINE unzip6 #-}
|
||||
-- Inline so that fusion with `foldr` has an opportunity to fire.
|
||||
-- See Note [Inline @unzipN@ functions] above.
|
||||
unzip6 :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])
|
||||
unzip6 = foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
|
||||
(a:as,b:bs,c:cs,d:ds,e:es,f:fs))
|
||||
@ -977,9 +804,6 @@ unzip6 = foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
|
||||
|
||||
-- | The 'unzip7' function takes a list of seven-tuples and returns
|
||||
-- seven lists, analogous to 'unzip'.
|
||||
{-# INLINE unzip7 #-}
|
||||
-- Inline so that fusion with `foldr` has an opportunity to fire.
|
||||
-- See Note [Inline @unzipN@ functions] above.
|
||||
unzip7 :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])
|
||||
unzip7 = foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
|
||||
(a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))
|
||||
@ -1029,7 +853,7 @@ inits = map toListSB . scanl' snocSB emptySB
|
||||
-- if it fuses with a consumer, and it would generally lead to serious
|
||||
-- loss of sharing if allowed to fuse with a producer.
|
||||
|
||||
-- | /O(n)/. The 'tails' function returns all final segments of the argument,
|
||||
-- | The 'tails' function returns all final segments of the argument,
|
||||
-- longest first. For example,
|
||||
--
|
||||
-- >>> tails "abc"
|
||||
@ -1085,7 +909,7 @@ permutations xs0 = xs0 : perms xs0 []
|
||||
-- It is a special case of 'sortBy', which allows the programmer to supply
|
||||
-- their own comparison function.
|
||||
--
|
||||
-- Elements are arranged from lowest to highest, keeping duplicates in
|
||||
-- Elements are arranged from from lowest to highest, keeping duplicates in
|
||||
-- the order they appeared in the input.
|
||||
--
|
||||
-- >>> sort [1,6,4,3,2,5]
|
||||
@ -1112,7 +936,7 @@ and possibly to bear similarities to a 1982 paper by Richard O'Keefe:
|
||||
"A smooth applicative merge sort".
|
||||
|
||||
Benchmarks show it to be often 2x the speed of the previous implementation.
|
||||
Fixes ticket https://gitlab.haskell.org/ghc/ghc/issues/2143
|
||||
Fixes ticket http://ghc.haskell.org/trac/ghc/ticket/2143
|
||||
-}
|
||||
|
||||
sort = sortBy compare
|
||||
|
||||
@ -38,7 +38,7 @@ import GHC.Arr
|
||||
-- create one).
|
||||
--
|
||||
-- Historically, @'Proxy' :: 'Proxy' a@ is a safer alternative to the
|
||||
-- @'undefined' :: a@ idiom.
|
||||
-- @'undefined :: a'@ idiom.
|
||||
--
|
||||
-- >>> Proxy :: Proxy (Void, Int -> Int)
|
||||
-- Proxy
|
||||
@ -57,7 +57,7 @@ data Proxy t = Proxy deriving ( Bounded -- ^ @since 4.7.0.0
|
||||
, Read -- ^ @since 4.7.0.0
|
||||
)
|
||||
|
||||
-- | A concrete, promotable proxy type, for use at the kind level.
|
||||
-- | A concrete, promotable proxy type, for use at the kind level
|
||||
-- There are no instances for this because it is intended at the kind level only
|
||||
data KProxy (t :: Type) = KProxy
|
||||
|
||||
|
||||
@ -42,7 +42,7 @@ import GHC.STRef
|
||||
-- Be warned that 'modifySTRef' does not apply the function strictly. This
|
||||
-- means if the program calls 'modifySTRef' many times, but seldomly uses the
|
||||
-- value, thunks will pile up in memory resulting in a space leak. This is a
|
||||
-- common mistake made when using an 'STRef' as a counter. For example, the
|
||||
-- common mistake made when using an STRef as a counter. For example, the
|
||||
-- following will leak memory and may produce a stack overflow:
|
||||
--
|
||||
-- >>> import Control.Monad (replicateM_)
|
||||
|
||||
@ -19,52 +19,15 @@
|
||||
-- Stability : provisional
|
||||
-- Portability : portable
|
||||
--
|
||||
-- A type @a@ is a 'Semigroup' if it provides an associative function ('<>')
|
||||
-- that lets you combine any two values of type @a@ into one. Where being
|
||||
-- associative means that the following must always hold:
|
||||
-- In mathematics, a semigroup is an algebraic structure consisting of a
|
||||
-- set together with an associative binary operation. A semigroup
|
||||
-- generalizes a monoid in that there might not exist an identity
|
||||
-- element. It also (originally) generalized a group (a monoid with all
|
||||
-- inverses) to a type where every element did not have to have an inverse,
|
||||
-- thus the name semigroup.
|
||||
--
|
||||
-- >>> (a <> b) <> c == a <> (b <> c)
|
||||
--
|
||||
-- ==== __Examples__
|
||||
--
|
||||
-- The 'Min' 'Semigroup' instance for 'Int' is defined to always pick the smaller
|
||||
-- number:
|
||||
-- >>> Min 1 <> Min 2 <> Min 3 <> Min 4 :: Min Int
|
||||
-- Min {getMin = 1}
|
||||
--
|
||||
-- If we need to combine multiple values we can use the 'sconcat' function
|
||||
-- to do so. We need to ensure however that we have at least one value to
|
||||
-- operate on, since otherwise our result would be undefined. It is for this
|
||||
-- reason that 'sconcat' uses "Data.List.NonEmpty.NonEmpty" - a list that
|
||||
-- can never be empty:
|
||||
--
|
||||
-- >>> (1 :| [])
|
||||
-- 1 :| [] -- equivalent to [1] but guaranteed to be non-empty
|
||||
-- >>> (1 :| [2, 3, 4])
|
||||
-- 1 :| [2,3,4] -- equivalent to [1,2,3,4] but guaranteed to be non-empty
|
||||
--
|
||||
-- Equipped with this guaranteed to be non-empty data structure, we can combine
|
||||
-- values using 'sconcat' and a 'Semigroup' of our choosing. We can try the 'Min'
|
||||
-- and 'Max' instances of 'Int' which pick the smallest, or largest number
|
||||
-- respectively:
|
||||
--
|
||||
-- >>> sconcat (1 :| [2, 3, 4]) :: Min Int
|
||||
-- Min {getMin = 1}
|
||||
-- >>> sconcat (1 :| [2, 3, 4]) :: Max Int
|
||||
-- Max {getMax = 4}
|
||||
--
|
||||
-- String concatenation is another example of a 'Semigroup' instance:
|
||||
--
|
||||
-- >>> "foo" <> "bar"
|
||||
-- "foobar"
|
||||
--
|
||||
-- A 'Semigroup' is a generalization of a 'Monoid'. Yet unlike the 'Semigroup', the 'Monoid'
|
||||
-- requires the presence of a neutral element ('mempty') in addition to the associative
|
||||
-- operator. The requirement for a neutral element prevents many types from being a full Monoid,
|
||||
-- like "Data.List.NonEmpty.NonEmpty".
|
||||
--
|
||||
-- Note that the use of @(\<\>)@ in this module conflicts with an operator with the same
|
||||
-- name that is being exported by "Data.Monoid". However, this package
|
||||
-- The use of @(\<\>)@ in this module conflicts with an operator with the same
|
||||
-- name that is being exported by Data.Monoid. However, this package
|
||||
-- re-exports (most of) the contents of Data.Monoid, so to use semigroups
|
||||
-- and monoids in the same package just
|
||||
--
|
||||
@ -117,6 +80,9 @@ import Data.Bifunctor
|
||||
import Data.Bitraversable
|
||||
import Data.Coerce
|
||||
import Data.Data
|
||||
import Data.Monoid (All (..), Any (..), Dual (..), Endo (..),
|
||||
Product (..), Sum (..))
|
||||
-- import qualified Data.Monoid as Monoid
|
||||
import GHC.Generics
|
||||
|
||||
-- | A generalization of 'Data.List.cycle' to an arbitrary 'Semigroup'.
|
||||
|
||||
@ -4,7 +4,7 @@ module Data.Semigroup.Internal where
|
||||
|
||||
import {-# SOURCE #-} GHC.Real (Integral)
|
||||
import {-# SOURCE #-} GHC.Base (Semigroup,Monoid,Maybe)
|
||||
import GHC.Integer () -- See Note [Depend on GHC.Integer] in GHC.Base
|
||||
import GHC.Integer () -- Note [Depend on GHC.Integer]
|
||||
|
||||
stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a
|
||||
|
||||
|
||||
@ -76,29 +76,27 @@ import qualified GHC.List as List ( foldr )
|
||||
--
|
||||
-- A definition of 'traverse' must satisfy the following laws:
|
||||
--
|
||||
-- [Naturality]
|
||||
-- [/naturality/]
|
||||
-- @t . 'traverse' f = 'traverse' (t . f)@
|
||||
-- for every applicative transformation @t@
|
||||
--
|
||||
-- [Identity]
|
||||
-- @'traverse' 'Identity' = 'Identity'@
|
||||
-- [/identity/]
|
||||
-- @'traverse' Identity = Identity@
|
||||
--
|
||||
-- [Composition]
|
||||
-- @'traverse' ('Data.Functor.Compose.Compose' . 'fmap' g . f)
|
||||
-- = 'Data.Functor.Compose.Compose' . 'fmap' ('traverse' g) . 'traverse' f@
|
||||
-- [/composition/]
|
||||
-- @'traverse' (Compose . 'fmap' g . f) = Compose . 'fmap' ('traverse' g) . 'traverse' f@
|
||||
--
|
||||
-- A definition of 'sequenceA' must satisfy the following laws:
|
||||
--
|
||||
-- [Naturality]
|
||||
-- [/naturality/]
|
||||
-- @t . 'sequenceA' = 'sequenceA' . 'fmap' t@
|
||||
-- for every applicative transformation @t@
|
||||
--
|
||||
-- [Identity]
|
||||
-- @'sequenceA' . 'fmap' 'Identity' = 'Identity'@
|
||||
-- [/identity/]
|
||||
-- @'sequenceA' . 'fmap' Identity = Identity@
|
||||
--
|
||||
-- [Composition]
|
||||
-- @'sequenceA' . 'fmap' 'Data.Functor.Compose.Compose'
|
||||
-- = 'Data.Functor.Compose.Compose' . 'fmap' 'sequenceA' . 'sequenceA'@
|
||||
-- [/composition/]
|
||||
-- @'sequenceA' . 'fmap' Compose = Compose . 'fmap' 'sequenceA' . 'sequenceA'@
|
||||
--
|
||||
-- where an /applicative transformation/ is a function
|
||||
--
|
||||
@ -106,14 +104,30 @@ import qualified GHC.List as List ( foldr )
|
||||
--
|
||||
-- preserving the 'Applicative' operations, i.e.
|
||||
--
|
||||
-- @
|
||||
-- t ('pure' x) = 'pure' x
|
||||
-- t (f '<*>' x) = t f '<*>' t x
|
||||
-- @
|
||||
-- * @t ('pure' x) = 'pure' x@
|
||||
--
|
||||
-- and the identity functor 'Identity' and composition functors
|
||||
-- 'Data.Functor.Compose.Compose' are from "Data.Functor.Identity" and
|
||||
-- "Data.Functor.Compose".
|
||||
-- * @t (x '<*>' y) = t x '<*>' t y@
|
||||
--
|
||||
-- and the identity functor @Identity@ and composition of functors @Compose@
|
||||
-- are defined as
|
||||
--
|
||||
-- > newtype Identity a = Identity a
|
||||
-- >
|
||||
-- > instance Functor Identity where
|
||||
-- > fmap f (Identity x) = Identity (f x)
|
||||
-- >
|
||||
-- > instance Applicative Identity where
|
||||
-- > pure x = Identity x
|
||||
-- > Identity f <*> Identity x = Identity (f x)
|
||||
-- >
|
||||
-- > newtype Compose f g a = Compose (f (g a))
|
||||
-- >
|
||||
-- > instance (Functor f, Functor g) => Functor (Compose f g) where
|
||||
-- > fmap f (Compose x) = Compose (fmap (fmap f) x)
|
||||
-- >
|
||||
-- > instance (Applicative f, Applicative g) => Applicative (Compose f g) where
|
||||
-- > pure x = Compose (pure (pure x))
|
||||
-- > Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)
|
||||
--
|
||||
-- (The naturality law is implied by parametricity.)
|
||||
--
|
||||
@ -366,14 +380,14 @@ forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)
|
||||
forM = flip mapM
|
||||
|
||||
-- |The 'mapAccumL' function behaves like a combination of 'fmap'
|
||||
-- and 'Data.Foldable.foldl'; it applies a function to each element of a structure,
|
||||
-- and 'foldl'; it applies a function to each element of a structure,
|
||||
-- passing an accumulating parameter from left to right, and returning
|
||||
-- a final value of this accumulator together with the new structure.
|
||||
mapAccumL :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)
|
||||
mapAccumL f s t = runStateL (traverse (StateL . flip f) t) s
|
||||
|
||||
-- |The 'mapAccumR' function behaves like a combination of 'fmap'
|
||||
-- and 'Data.Foldable.foldr'; it applies a function to each element of a structure,
|
||||
-- and 'foldr'; it applies a function to each element of a structure,
|
||||
-- passing an accumulating parameter from right to left, and returning
|
||||
-- a final value of this accumulator together with the new structure.
|
||||
mapAccumR :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)
|
||||
|
||||
@ -23,8 +23,8 @@
|
||||
-- Stability : experimental
|
||||
-- Portability : not portable
|
||||
--
|
||||
-- Definition of propositional equality @(':~:')@. Pattern-matching on a variable
|
||||
-- of type @(a ':~:' b)@ produces a proof that @a '~' b@.
|
||||
-- Definition of propositional equality @(:~:)@. Pattern-matching on a variable
|
||||
-- of type @(a :~: b)@ produces a proof that @a ~ b@.
|
||||
--
|
||||
-- @since 4.7.0.0
|
||||
-----------------------------------------------------------------------------
|
||||
@ -53,6 +53,30 @@ import GHC.Read
|
||||
import GHC.Base
|
||||
import Data.Type.Bool
|
||||
|
||||
-- | Lifted, homogeneous equality. By lifted, we mean that it can be
|
||||
-- bogus (deferred type error). By homogeneous, the two types @a@
|
||||
-- and @b@ must have the same kind.
|
||||
class a ~~ b => (a :: k) ~ (b :: k)
|
||||
-- See Note [The equality types story] in TysPrim
|
||||
-- NB: All this class does is to wrap its superclass, which is
|
||||
-- the "real", inhomogeneous equality; this is needed when
|
||||
-- we have a Given (a~b), and we want to prove things from it
|
||||
-- NB: Not exported, as (~) is magical syntax. That's also why there's
|
||||
-- no fixity.
|
||||
|
||||
-- It's tempting to put functional dependencies on (~), but it's not
|
||||
-- necessary because the functional-dependency coverage check looks
|
||||
-- through superclasses, and (~#) is handled in that check.
|
||||
|
||||
-- | @since 4.9.0.0
|
||||
instance {-# INCOHERENT #-} a ~~ b => a ~ b
|
||||
-- See Note [The equality types story] in TysPrim
|
||||
-- If we have a Wanted (t1 ~ t2), we want to immediately
|
||||
-- simplify it to (t1 ~~ t2) and solve that instead
|
||||
--
|
||||
-- INCOHERENT because we want to use this instance eagerly, even when
|
||||
-- the tyvars are partially unknown.
|
||||
|
||||
infix 4 :~:, :~~:
|
||||
|
||||
-- | Propositional equality. If @a :~: b@ is inhabited by some terminating
|
||||
|
||||
@ -36,7 +36,7 @@
|
||||
-- Since GHC 7.8, 'Typeable' is poly-kinded. The changes required for this might
|
||||
-- break some old programs involving 'Typeable'. More details on this, including
|
||||
-- how to fix your code, can be found on the
|
||||
-- <https://gitlab.haskell.org/ghc/ghc/wikis/ghc-kinds/poly-typeable PolyTypeable wiki page>
|
||||
-- <https://ghc.haskell.org/trac/ghc/wiki/GhcKinds/PolyTypeable PolyTypeable wiki page>
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
@ -664,12 +664,8 @@ runtimeRepTypeRep r =
|
||||
SumRep rs -> kindedTypeRep @_ @'SumRep
|
||||
`kApp` buildList (map runtimeRepTypeRep rs)
|
||||
IntRep -> rep @'IntRep
|
||||
Int8Rep -> rep @'Int8Rep
|
||||
Int16Rep -> rep @'Int16Rep
|
||||
Int64Rep -> rep @'Int64Rep
|
||||
WordRep -> rep @'WordRep
|
||||
Word8Rep -> rep @'Word8Rep
|
||||
Word16Rep -> rep @'Word16Rep
|
||||
Int64Rep -> rep @'Int64Rep
|
||||
Word64Rep -> rep @'Word64Rep
|
||||
AddrRep -> rep @'AddrRep
|
||||
FloatRep -> rep @'FloatRep
|
||||
@ -777,11 +773,7 @@ showTypeable _ TrType = showChar '*'
|
||||
showTypeable _ rep
|
||||
| isListTyCon tc, [ty] <- tys =
|
||||
showChar '[' . shows ty . showChar ']'
|
||||
|
||||
-- Take care only to render saturated tuple tycon applications
|
||||
-- with tuple notation (#14341).
|
||||
| isTupleTyCon tc,
|
||||
Just _ <- TrType `eqTypeRep` typeRepKind rep =
|
||||
| isTupleTyCon tc =
|
||||
showChar '(' . showArgs (showChar ',') tys . showChar ')'
|
||||
where (tc, tys) = splitApps rep
|
||||
showTypeable _ (TrTyCon {trTyCon = tycon, trKindVars = []})
|
||||
@ -830,7 +822,7 @@ splitApps = go []
|
||||
-- appropriate module and constructor names.
|
||||
--
|
||||
-- The ticket to find a better way to deal with this is
|
||||
-- #14480.
|
||||
-- Trac #14480.
|
||||
tyConTYPE :: TyCon
|
||||
tyConTYPE = mkTyCon (tyConPackage liftedRepTyCon) "GHC.Prim" "TYPE" 0
|
||||
(KindRepFun (KindRepTyConApp liftedRepTyCon []) (KindRepTYPE LiftedRep))
|
||||
|
||||
@ -25,9 +25,6 @@ module Data.Word
|
||||
-- * byte swapping
|
||||
byteSwap16, byteSwap32, byteSwap64,
|
||||
|
||||
-- * bit reversal
|
||||
|
||||
bitReverse8, bitReverse16, bitReverse32, bitReverse64
|
||||
-- * Notes
|
||||
|
||||
-- $notes
|
||||
|
||||
@ -81,7 +81,7 @@ traceIO :: String -> IO ()
|
||||
traceIO msg = do
|
||||
withCString "%s\n" $ \cfmt -> do
|
||||
-- NB: debugBelch can't deal with null bytes, so filter them
|
||||
-- out so we don't accidentally truncate the message. See #9395
|
||||
-- out so we don't accidentally truncate the message. See Trac #9395
|
||||
let (nulls, msg') = partition (=='\0') msg
|
||||
withCString msg' $ \cmsg ->
|
||||
debugBelch cfmt cmsg
|
||||
@ -169,9 +169,8 @@ Note that the application of 'traceM' is not an action in the 'Applicative'
|
||||
context, as 'traceIO' is in the 'IO' type. While the fresh bindings in the
|
||||
following example will force the 'traceM' expressions to be reduced every time
|
||||
the @do@-block is executed, @traceM "not crashed"@ would only be reduced once,
|
||||
and the message would only be printed once. If your monad is in
|
||||
'Control.Monad.IO.Class.MonadIO', @'Control.Monad.IO.Class.liftIO' . 'traceIO'@
|
||||
may be a better option.
|
||||
and the message would only be printed once. If your monad is in 'MonadIO',
|
||||
@liftIO . traceIO@ may be a better option.
|
||||
|
||||
>>> :{
|
||||
do
|
||||
|
||||
@ -255,15 +255,11 @@ isValidErrno (Errno errno) = errno /= -1
|
||||
|
||||
-- | Get the current value of @errno@ in the current thread.
|
||||
--
|
||||
-- On GHC, the runtime will ensure that any Haskell thread will only see "its own"
|
||||
-- @errno@, by saving and restoring the value when Haskell threads are scheduled
|
||||
-- across OS threads.
|
||||
getErrno :: IO Errno
|
||||
|
||||
-- We must call a C function to get the value of errno in general. On
|
||||
-- threaded systems, errno is hidden behind a C macro so that each OS
|
||||
-- thread gets its own copy (`saved_errno`, which `rts/Schedule.c` restores
|
||||
-- back into the thread-local `errno` when a Haskell thread is rescheduled).
|
||||
-- thread gets its own copy.
|
||||
getErrno = do e <- get_errno; return (Errno e)
|
||||
foreign import ccall unsafe "HsBase.h __hscore_get_errno" get_errno :: IO CInt
|
||||
|
||||
|
||||
@ -37,9 +37,9 @@ module Foreign.C.Types
|
||||
-- | These types are represented as @newtype@s of
|
||||
-- types in "Data.Int" and "Data.Word", and are instances of
|
||||
-- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read',
|
||||
-- 'Prelude.Show', 'Prelude.Enum', 'Data.Typeable.Typeable',
|
||||
-- 'Storable', 'Prelude.Bounded', 'Prelude.Real', 'Prelude.Integral'
|
||||
-- and 'Bits'.
|
||||
-- 'Prelude.Show', 'Prelude.Enum', 'Typeable', 'Storable',
|
||||
-- 'Prelude.Bounded', 'Prelude.Real', 'Prelude.Integral' and
|
||||
-- 'Bits'.
|
||||
CChar(..), CSChar(..), CUChar(..)
|
||||
, CShort(..), CUShort(..), CInt(..), CUInt(..)
|
||||
, CLong(..), CULong(..)
|
||||
@ -51,8 +51,7 @@ module Foreign.C.Types
|
||||
-- | These types are represented as @newtype@s of basic
|
||||
-- foreign types, and are instances of
|
||||
-- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read',
|
||||
-- 'Prelude.Show', 'Prelude.Enum', 'Data.Typeable.Typeable' and
|
||||
-- 'Storable'.
|
||||
-- 'Prelude.Show', 'Prelude.Enum', 'Typeable' and 'Storable'.
|
||||
, CClock(..), CTime(..), CUSeconds(..), CSUSeconds(..)
|
||||
|
||||
-- extracted from CTime, because we don't want this comment in
|
||||
@ -67,7 +66,7 @@ module Foreign.C.Types
|
||||
-- | These types are represented as @newtype@s of
|
||||
-- 'Prelude.Float' and 'Prelude.Double', and are instances of
|
||||
-- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read',
|
||||
-- 'Prelude.Show', 'Prelude.Enum', 'Data.Typeable.Typeable', 'Storable',
|
||||
-- 'Prelude.Show', 'Prelude.Enum', 'Typeable', 'Storable',
|
||||
-- 'Prelude.Real', 'Prelude.Fractional', 'Prelude.Floating',
|
||||
-- 'Prelude.RealFrac' and 'Prelude.RealFloat'. That does mean
|
||||
-- that `CFloat`'s (respectively `CDouble`'s) instances of
|
||||
|
||||
@ -40,34 +40,33 @@ newForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a)
|
||||
-- associating a finalizer - given by the monadic operation - with the
|
||||
-- reference. The storage manager will start the finalizer, in a
|
||||
-- separate thread, some time after the last reference to the
|
||||
-- 'ForeignPtr' is dropped. There is no guarantee of promptness, and
|
||||
-- @ForeignPtr@ is dropped. There is no guarantee of promptness, and
|
||||
-- in fact there is no guarantee that the finalizer will eventually
|
||||
-- run at all.
|
||||
--
|
||||
-- Note that references from a finalizer do not necessarily prevent
|
||||
-- another object from being finalized. If A's finalizer refers to B
|
||||
-- (perhaps using 'Foreign.ForeignPtr.touchForeignPtr', then the only
|
||||
-- guarantee is that B's finalizer will never be started before A's. If both
|
||||
-- A and B are unreachable, then both finalizers will start together. See
|
||||
-- 'Foreign.ForeignPtr.touchForeignPtr' for more on finalizer ordering.
|
||||
-- (perhaps using 'touchForeignPtr', then the only guarantee is that
|
||||
-- B's finalizer will never be started before A's. If both A and B
|
||||
-- are unreachable, then both finalizers will start together. See
|
||||
-- 'touchForeignPtr' for more on finalizer ordering.
|
||||
--
|
||||
newForeignPtr = GHC.ForeignPtr.newConcForeignPtr
|
||||
|
||||
addForeignPtrFinalizer :: ForeignPtr a -> IO () -> IO ()
|
||||
-- ^This function adds a finalizer to the given 'ForeignPtr'. The
|
||||
-- ^This function adds a finalizer to the given @ForeignPtr@. The
|
||||
-- finalizer will run /before/ all other finalizers for the same
|
||||
-- object which have already been registered.
|
||||
--
|
||||
-- This is a variant of 'Foreign.ForeignPtr.addForeignPtrFinalizer',
|
||||
-- where the finalizer is an arbitrary 'IO' action. When it is
|
||||
-- This is a variant of @Foreign.ForeignPtr.addForeignPtrFinalizer@,
|
||||
-- where the finalizer is an arbitrary @IO@ action. When it is
|
||||
-- invoked, the finalizer will run in a new thread.
|
||||
--
|
||||
-- NB. Be very careful with these finalizers. One common trap is that
|
||||
-- if a finalizer references another finalized value, it does not
|
||||
-- prevent that value from being finalized. In particular, 'System.IO.Handle's
|
||||
-- are finalized objects, so a finalizer should not refer to a
|
||||
-- 'System.IO.Handle' (including 'System.IO.stdout', 'System.IO.stdin', or
|
||||
-- 'System.IO.stderr').
|
||||
-- prevent that value from being finalized. In particular, 'Handle's
|
||||
-- are finalized objects, so a finalizer should not refer to a 'Handle'
|
||||
-- (including @stdout@, @stdin@ or @stderr@).
|
||||
--
|
||||
addForeignPtrFinalizer = GHC.ForeignPtr.addForeignPtrConcFinalizer
|
||||
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
{-# LANGUAGE Unsafe #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
{-# OPTIONS_HADDOCK hide #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
|
||||
@ -1,12 +1,12 @@
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
{-# LANGUAGE NoImplicitPrelude, MagicHash, ScopedTypeVariables #-}
|
||||
{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : Foreign.Marshal.Array
|
||||
-- Copyright : (c) The FFI task force 2001
|
||||
-- License : BSD-style (see the file libraries/base/LICENSE)
|
||||
--
|
||||
--
|
||||
-- Maintainer : ffi@haskell.org
|
||||
-- Stability : provisional
|
||||
-- Portability : portable
|
||||
@ -82,8 +82,11 @@ import GHC.Base
|
||||
-- |Allocate storage for the given number of elements of a storable type
|
||||
-- (like 'Foreign.Marshal.Alloc.malloc', but for multiple elements).
|
||||
--
|
||||
mallocArray :: forall a . Storable a => Int -> IO (Ptr a)
|
||||
mallocArray size = mallocBytes (size * sizeOf (undefined :: a))
|
||||
mallocArray :: Storable a => Int -> IO (Ptr a)
|
||||
mallocArray = doMalloc undefined
|
||||
where
|
||||
doMalloc :: Storable a' => a' -> Int -> IO (Ptr a')
|
||||
doMalloc dummy size = mallocBytes (size * sizeOf dummy)
|
||||
|
||||
-- |Like 'mallocArray', but add an extra position to hold a special
|
||||
-- termination element.
|
||||
@ -93,8 +96,11 @@ mallocArray0 size = mallocArray (size + 1)
|
||||
|
||||
-- |Like 'mallocArray', but allocated memory is filled with bytes of value zero.
|
||||
--
|
||||
callocArray :: forall a . Storable a => Int -> IO (Ptr a)
|
||||
callocArray size = callocBytes (size * sizeOf (undefined :: a))
|
||||
callocArray :: Storable a => Int -> IO (Ptr a)
|
||||
callocArray = doCalloc undefined
|
||||
where
|
||||
doCalloc :: Storable a' => a' -> Int -> IO (Ptr a')
|
||||
doCalloc dummy size = callocBytes (size * sizeOf dummy)
|
||||
|
||||
-- |Like 'callocArray0', but allocated memory is filled with bytes of value
|
||||
-- zero.
|
||||
@ -105,9 +111,12 @@ callocArray0 size = callocArray (size + 1)
|
||||
-- |Temporarily allocate space for the given number of elements
|
||||
-- (like 'Foreign.Marshal.Alloc.alloca', but for multiple elements).
|
||||
--
|
||||
allocaArray :: forall a b . Storable a => Int -> (Ptr a -> IO b) -> IO b
|
||||
allocaArray size = allocaBytesAligned (size * sizeOf (undefined :: a))
|
||||
(alignment (undefined :: a))
|
||||
allocaArray :: Storable a => Int -> (Ptr a -> IO b) -> IO b
|
||||
allocaArray = doAlloca undefined
|
||||
where
|
||||
doAlloca :: Storable a' => a' -> Int -> (Ptr a' -> IO b') -> IO b'
|
||||
doAlloca dummy size = allocaBytesAligned (size * sizeOf dummy)
|
||||
(alignment dummy)
|
||||
|
||||
-- |Like 'allocaArray', but add an extra position to hold a special
|
||||
-- termination element.
|
||||
@ -120,8 +129,11 @@ allocaArray0 size = allocaArray (size + 1)
|
||||
|
||||
-- |Adjust the size of an array
|
||||
--
|
||||
reallocArray :: forall a . Storable a => Ptr a -> Int -> IO (Ptr a)
|
||||
reallocArray ptr size = reallocBytes ptr (size * sizeOf (undefined :: a))
|
||||
reallocArray :: Storable a => Ptr a -> Int -> IO (Ptr a)
|
||||
reallocArray = doRealloc undefined
|
||||
where
|
||||
doRealloc :: Storable a' => a' -> Ptr a' -> Int -> IO (Ptr a')
|
||||
doRealloc dummy ptr size = reallocBytes ptr (size * sizeOf dummy)
|
||||
|
||||
-- |Adjust the size of an array including an extra position for the end marker.
|
||||
--
|
||||
@ -141,7 +153,7 @@ peekArray size ptr | size <= 0 = return []
|
||||
where
|
||||
f 0 acc = do e <- peekElemOff ptr 0; return (e:acc)
|
||||
f n acc = do e <- peekElemOff ptr n; f (n-1) (e:acc)
|
||||
|
||||
|
||||
-- |Convert an array terminated by the given end marker into a Haskell list
|
||||
--
|
||||
peekArray0 :: (Storable a, Eq a) => a -> Ptr a -> IO [a]
|
||||
@ -226,14 +238,20 @@ withArrayLen0 marker vals f =
|
||||
-- |Copy the given number of elements from the second array (source) into the
|
||||
-- first array (destination); the copied areas may /not/ overlap
|
||||
--
|
||||
copyArray :: forall a . Storable a => Ptr a -> Ptr a -> Int -> IO ()
|
||||
copyArray dest src size = copyBytes dest src (size * sizeOf (undefined :: a))
|
||||
copyArray :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
|
||||
copyArray = doCopy undefined
|
||||
where
|
||||
doCopy :: Storable a' => a' -> Ptr a' -> Ptr a' -> Int -> IO ()
|
||||
doCopy dummy dest src size = copyBytes dest src (size * sizeOf dummy)
|
||||
|
||||
-- |Copy the given number of elements from the second array (source) into the
|
||||
-- first array (destination); the copied areas /may/ overlap
|
||||
--
|
||||
moveArray :: forall a . Storable a => Ptr a -> Ptr a -> Int -> IO ()
|
||||
moveArray dest src size = moveBytes dest src (size * sizeOf (undefined :: a))
|
||||
moveArray :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
|
||||
moveArray = doMove undefined
|
||||
where
|
||||
doMove :: Storable a' => a' -> Ptr a' -> Ptr a' -> Int -> IO ()
|
||||
doMove dummy dest src size = moveBytes dest src (size * sizeOf dummy)
|
||||
|
||||
|
||||
-- finding the length
|
||||
@ -254,5 +272,9 @@ lengthArray0 marker ptr = loop 0
|
||||
|
||||
-- |Advance a pointer into an array by the given number of elements
|
||||
--
|
||||
advancePtr :: forall a . Storable a => Ptr a -> Int -> Ptr a
|
||||
advancePtr ptr i = ptr `plusPtr` (i * sizeOf (undefined :: a))
|
||||
advancePtr :: Storable a => Ptr a -> Int -> Ptr a
|
||||
advancePtr = doAdvance undefined
|
||||
where
|
||||
doAdvance :: Storable a' => a' -> Ptr a' -> Int -> Ptr a'
|
||||
doAdvance dummy ptr i = ptr `plusPtr` (i * sizeOf dummy)
|
||||
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
{-# LANGUAGE NoImplicitPrelude, ScopedTypeVariables #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -102,8 +102,11 @@ withPool act = -- ATTENTION: cut-n-paste from Control.Exception below!
|
||||
-- allocated is determined by the 'sizeOf' method from the instance of
|
||||
-- 'Storable' for the appropriate type.
|
||||
|
||||
pooledMalloc :: forall a . Storable a => Pool -> IO (Ptr a)
|
||||
pooledMalloc pool = pooledMallocBytes pool (sizeOf (undefined :: a))
|
||||
pooledMalloc :: Storable a => Pool -> IO (Ptr a)
|
||||
pooledMalloc = pm undefined
|
||||
where
|
||||
pm :: Storable a' => a' -> Pool -> IO (Ptr a')
|
||||
pm dummy pool = pooledMallocBytes pool (sizeOf dummy)
|
||||
|
||||
-- | Allocate the given number of bytes of storage in the pool.
|
||||
|
||||
@ -117,8 +120,11 @@ pooledMallocBytes (Pool pool) size = do
|
||||
-- | Adjust the storage area for an element in the pool to the given size of
|
||||
-- the required type.
|
||||
|
||||
pooledRealloc :: forall a . Storable a => Pool -> Ptr a -> IO (Ptr a)
|
||||
pooledRealloc pool ptr = pooledReallocBytes pool ptr (sizeOf (undefined :: a))
|
||||
pooledRealloc :: Storable a => Pool -> Ptr a -> IO (Ptr a)
|
||||
pooledRealloc = pr undefined
|
||||
where
|
||||
pr :: Storable a' => a' -> Pool -> Ptr a' -> IO (Ptr a')
|
||||
pr dummy pool ptr = pooledReallocBytes pool ptr (sizeOf dummy)
|
||||
|
||||
-- | Adjust the storage area for an element in the pool to the given size.
|
||||
|
||||
@ -134,9 +140,11 @@ pooledReallocBytes (Pool pool) ptr size = do
|
||||
-- | Allocate storage for the given number of elements of a storable type in the
|
||||
-- pool.
|
||||
|
||||
pooledMallocArray :: forall a . Storable a => Pool -> Int -> IO (Ptr a)
|
||||
pooledMallocArray pool size =
|
||||
pooledMallocBytes pool (size * sizeOf (undefined :: a))
|
||||
pooledMallocArray :: Storable a => Pool -> Int -> IO (Ptr a)
|
||||
pooledMallocArray = pma undefined
|
||||
where
|
||||
pma :: Storable a' => a' -> Pool -> Int -> IO (Ptr a')
|
||||
pma dummy pool size = pooledMallocBytes pool (size * sizeOf dummy)
|
||||
|
||||
-- | Allocate storage for the given number of elements of a storable type in the
|
||||
-- pool, but leave room for an extra element to signal the end of the array.
|
||||
@ -147,9 +155,11 @@ pooledMallocArray0 pool size =
|
||||
|
||||
-- | Adjust the size of an array in the given pool.
|
||||
|
||||
pooledReallocArray :: forall a . Storable a => Pool -> Ptr a -> Int -> IO (Ptr a)
|
||||
pooledReallocArray pool ptr size =
|
||||
pooledReallocBytes pool ptr (size * sizeOf (undefined :: a))
|
||||
pooledReallocArray :: Storable a => Pool -> Ptr a -> Int -> IO (Ptr a)
|
||||
pooledReallocArray = pra undefined
|
||||
where
|
||||
pra :: Storable a' => a' -> Pool -> Ptr a' -> Int -> IO (Ptr a')
|
||||
pra dummy pool ptr size = pooledReallocBytes pool ptr (size * sizeOf dummy)
|
||||
|
||||
-- | Adjust the size of an array with an end marker in the given pool.
|
||||
|
||||
@ -185,3 +195,4 @@ pooledNewArray0 pool marker vals = do
|
||||
ptr <- pooledMallocArray0 pool (length vals)
|
||||
pokeArray0 marker ptr vals
|
||||
return ptr
|
||||
|
||||
|
||||
@ -110,7 +110,7 @@ Note [Exporting constructors of marshallable foreign types]
|
||||
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
One might expect that IntPtr, WordPtr, and the other newtypes in the
|
||||
Foreign.C.Types and System.Posix.Types modules to be abstract, but this is not
|
||||
the case in GHC (see #5229 and #11983). In fact, we deliberately export
|
||||
the case in GHC (see Trac #5229 and #11983). In fact, we deliberately export
|
||||
the constructors for these datatypes in order to satisfy a requirement of the
|
||||
Haskell 2010 Report (§ 8.4.2) that if a newtype is used in a foreign
|
||||
declaration, then its constructor must be visible.
|
||||
@ -118,7 +118,7 @@ declaration, then its constructor must be visible.
|
||||
This requirement was motivated by the fact that using a type in a foreign
|
||||
declaration necessarily exposes some information about the type to the user,
|
||||
so being able to use abstract types in a foreign declaration breaks their
|
||||
abstraction (see #3008). As a result, the constructors of all FFI-related
|
||||
abstraction (see Trac #3008). As a result, the constructors of all FFI-related
|
||||
newtypes in base must be exported in order to be useful for FFI programming,
|
||||
even at the cost of exposing their underlying, architecture-dependent types.
|
||||
-}
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
{-# LANGUAGE Unsafe #-}
|
||||
{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples, RoleAnnotations #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
{-# OPTIONS_HADDOCK hide #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -126,7 +126,7 @@ Note [Inlining index]
|
||||
We inline the 'index' operation,
|
||||
|
||||
* Partly because it generates much faster code
|
||||
(although bigger); see #1216
|
||||
(although bigger); see Trac #1216
|
||||
|
||||
* Partly because it exposes the bounds checks to the simplifier which
|
||||
might help a big.
|
||||
@ -151,13 +151,13 @@ is a property of the particular instances of index, bounds, and inRange,
|
||||
so GHC cannot guarantee it.
|
||||
|
||||
* If you do (A) and not (B), then you might get a seg-fault,
|
||||
by indexing at some bizarre location. #1610
|
||||
by indexing at some bizarre location. Trac #1610
|
||||
|
||||
* If you do (B) but not (A), you may get no complaint when you index
|
||||
an array out of its semantic bounds. #2120
|
||||
an array out of its semantic bounds. Trac #2120
|
||||
|
||||
At various times we have had (A) and not (B), or (B) and not (A); both
|
||||
led to complaints. So now we implement *both* checks (#2669).
|
||||
led to complaints. So now we implement *both* checks (Trac #2669).
|
||||
|
||||
For 1-d, 2-d, and 3-d arrays of Int we have specialised instances to avoid this.
|
||||
|
||||
@ -453,13 +453,13 @@ array :: Ix i
|
||||
-- of the array. These bounds are the lowest and
|
||||
-- highest indices in the array, in that order.
|
||||
-- For example, a one-origin vector of length
|
||||
-- @10@ has bounds @(1,10)@, and a one-origin @10@
|
||||
-- by @10@ matrix has bounds @((1,1),(10,10))@.
|
||||
-- '10' has bounds '(1,10)', and a one-origin '10'
|
||||
-- by '10' matrix has bounds '((1,1),(10,10))'.
|
||||
-> [(i, e)] -- ^ a list of /associations/ of the form
|
||||
-- (/index/, /value/). Typically, this list will
|
||||
-- be expressed as a comprehension. An
|
||||
-- association @(i, x)@ defines the value of
|
||||
-- the array at index @i@ to be @x@.
|
||||
-- association '(i, x)' defines the value of
|
||||
-- the array at index 'i' to be 'x'.
|
||||
-> Array i e
|
||||
array (l,u) ies
|
||||
= let n = safeRangeSize (l,u)
|
||||
@ -787,7 +787,7 @@ There are two problems:
|
||||
2. This implementation relies on list fusion for efficiency. In order
|
||||
to implement the "amap/coerce" rule, we need to delay inlining amap
|
||||
until simplifier phase 1, which is when the eftIntList rule kicks
|
||||
in and makes that impossible. (c.f. #8767)
|
||||
in and makes that impossible. (c.f. Trac #8767)
|
||||
-}
|
||||
|
||||
|
||||
|
||||
@ -90,7 +90,7 @@ Other Prelude modules are much easier with fewer complex dependencies.
|
||||
-- -Wno-orphans is needed for things like:
|
||||
-- Orphan rule: "x# -# x#" ALWAYS forall x# :: Int# -# x# x# = 0
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
{-# OPTIONS_HADDOCK hide #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -213,16 +213,16 @@ infixr 6 <>
|
||||
|
||||
-- | The class of semigroups (types with an associative binary operation).
|
||||
--
|
||||
-- Instances should satisfy the following:
|
||||
-- Instances should satisfy the associativity law:
|
||||
--
|
||||
-- [Associativity] @x '<>' (y '<>' z) = (x '<>' y) '<>' z@
|
||||
-- * @x '<>' (y '<>' z) = (x '<>' y) '<>' z@
|
||||
--
|
||||
-- @since 4.9.0.0
|
||||
class Semigroup a where
|
||||
-- | An associative operation.
|
||||
(<>) :: a -> a -> a
|
||||
|
||||
-- | Reduce a non-empty list with '<>'
|
||||
-- | Reduce a non-empty list with @\<\>@
|
||||
--
|
||||
-- The default definition should be sufficient, but this can be
|
||||
-- overridden for efficiency.
|
||||
@ -240,19 +240,22 @@ class Semigroup a where
|
||||
--
|
||||
-- By making this a member of the class, idempotent semigroups
|
||||
-- and monoids can upgrade this to execute in /O(1)/ by
|
||||
-- picking @stimes = 'Data.Semigroup.stimesIdempotent'@ or @stimes =
|
||||
-- picking @stimes = 'stimesIdempotent'@ or @stimes =
|
||||
-- 'stimesIdempotentMonoid'@ respectively.
|
||||
stimes :: Integral b => b -> a -> a
|
||||
stimes = stimesDefault
|
||||
|
||||
|
||||
-- | The class of monoids (types with an associative binary operation that
|
||||
-- has an identity). Instances should satisfy the following:
|
||||
-- has an identity). Instances should satisfy the following laws:
|
||||
--
|
||||
-- [Right identity] @x '<>' 'mempty' = x@
|
||||
-- [Left identity] @'mempty' '<>' x = x@
|
||||
-- [Associativity] @x '<>' (y '<>' z) = (x '<>' y) '<>' z@ ('Semigroup' law)
|
||||
-- [Concatenation] @'mconcat' = 'foldr' ('<>') 'mempty'@
|
||||
-- * @x '<>' 'mempty' = x@
|
||||
--
|
||||
-- * @'mempty' '<>' x = x@
|
||||
--
|
||||
-- * @x '<>' (y '<>' z) = (x '<>' y) '<>' z@ ('Semigroup' law)
|
||||
--
|
||||
-- * @'mconcat' = 'foldr' '(<>)' 'mempty'@
|
||||
--
|
||||
-- The method names refer to the monoid of lists under concatenation,
|
||||
-- but there are many other instances.
|
||||
@ -260,7 +263,7 @@ class Semigroup a where
|
||||
-- Some types can be viewed as a monoid in more than one way,
|
||||
-- e.g. both addition and multiplication on numbers.
|
||||
-- In such cases we often define @newtype@s and make those instances
|
||||
-- of 'Monoid', e.g. 'Data.Semigroup.Sum' and 'Data.Semigroup.Product'.
|
||||
-- of 'Monoid', e.g. 'Sum' and 'Product'.
|
||||
--
|
||||
-- __NOTE__: 'Semigroup' is a superclass of 'Monoid' since /base-4.11.0.0/.
|
||||
class Semigroup a => Monoid a where
|
||||
@ -270,7 +273,7 @@ class Semigroup a => Monoid a where
|
||||
-- | An associative operation
|
||||
--
|
||||
-- __NOTE__: This method is redundant and has the default
|
||||
-- implementation @'mappend' = ('<>')@ since /base-4.11.0.0/.
|
||||
-- implementation @'mappend' = '(<>)'@ since /base-4.11.0.0/.
|
||||
mappend :: a -> a -> a
|
||||
mappend = (<>)
|
||||
{-# INLINE mappend #-}
|
||||
@ -441,15 +444,14 @@ instance Semigroup a => Semigroup (IO a) where
|
||||
instance Monoid a => Monoid (IO a) where
|
||||
mempty = pure mempty
|
||||
|
||||
{- | A type @f@ is a Functor if it provides a function @fmap@ which, given any types @a@ and @b@
|
||||
lets you apply any function from @(a -> b)@ to turn an @f a@ into an @f b@, preserving the
|
||||
structure of @f@. Furthermore @f@ needs to adhere to the following:
|
||||
{- | The 'Functor' class is used for types that can be mapped over.
|
||||
Instances of 'Functor' should satisfy the following laws:
|
||||
|
||||
[Identity] @'fmap' 'id' == 'id'@
|
||||
[Composition] @'fmap' (f . g) == 'fmap' f . 'fmap' g@
|
||||
> fmap id == id
|
||||
> fmap (f . g) == fmap f . fmap g
|
||||
|
||||
Note, that the second law follows from the free theorem of the type 'fmap' and
|
||||
the first law, so you need only check that the former condition holds.
|
||||
The instances of 'Functor' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO'
|
||||
satisfy these laws.
|
||||
-}
|
||||
|
||||
class Functor f where
|
||||
@ -473,23 +475,23 @@ class Functor f where
|
||||
--
|
||||
-- @('<*>') = 'liftA2' 'id'@
|
||||
--
|
||||
-- @'liftA2' f x y = f 'Prelude.<$>' x '<*>' y@
|
||||
-- @'liftA2' f x y = f '<$>' x '<*>' y@
|
||||
--
|
||||
-- Further, any definition must satisfy the following:
|
||||
--
|
||||
-- [Identity]
|
||||
-- [/identity/]
|
||||
--
|
||||
-- @'pure' 'id' '<*>' v = v@
|
||||
--
|
||||
-- [Composition]
|
||||
-- [/composition/]
|
||||
--
|
||||
-- @'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@
|
||||
--
|
||||
-- [Homomorphism]
|
||||
-- [/homomorphism/]
|
||||
--
|
||||
-- @'pure' f '<*>' 'pure' x = 'pure' (f x)@
|
||||
--
|
||||
-- [Interchange]
|
||||
-- [/interchange/]
|
||||
--
|
||||
-- @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@
|
||||
--
|
||||
@ -519,7 +521,7 @@ class Functor f where
|
||||
--
|
||||
-- * @'pure' = 'return'@
|
||||
--
|
||||
-- * @m1 '<*>' m2 = m1 '>>=' (\x1 -> m2 '>>=' (\x2 -> 'return' (x1 x2)))@
|
||||
-- * @('<*>') = 'ap'@
|
||||
--
|
||||
-- * @('*>') = ('>>')@
|
||||
--
|
||||
@ -543,9 +545,6 @@ class Functor f => Applicative f where
|
||||
-- efficient than the default one. In particular, if 'fmap' is an
|
||||
-- expensive operation, it is likely better to use 'liftA2' than to
|
||||
-- 'fmap' over the structure and then use '<*>'.
|
||||
--
|
||||
-- This became a typeclass method in 4.10.0.0. Prior to that, it was
|
||||
-- a function defined in terms of '<*>' and 'fmap'.
|
||||
liftA2 :: (a -> b -> c) -> f a -> f b -> f c
|
||||
liftA2 f x = (<*>) (fmap f x)
|
||||
|
||||
@ -630,16 +629,16 @@ think of a monad as an /abstract datatype/ of actions.
|
||||
Haskell's @do@ expressions provide a convenient syntax for writing
|
||||
monadic expressions.
|
||||
|
||||
Instances of 'Monad' should satisfy the following:
|
||||
Instances of 'Monad' should satisfy the following laws:
|
||||
|
||||
[Left identity] @'return' a '>>=' k = k a@
|
||||
[Right identity] @m '>>=' 'return' = m@
|
||||
[Associativity] @m '>>=' (\\x -> k x '>>=' h) = (m '>>=' k) '>>=' h@
|
||||
* @'return' a '>>=' k = k a@
|
||||
* @m '>>=' 'return' = m@
|
||||
* @m '>>=' (\\x -> k x '>>=' h) = (m '>>=' k) '>>=' h@
|
||||
|
||||
Furthermore, the 'Monad' and 'Applicative' operations should relate as follows:
|
||||
|
||||
* @'pure' = 'return'@
|
||||
* @m1 '<*>' m2 = m1 '>>=' (\x1 -> m2 '>>=' (\x2 -> 'return' (x1 x2)))@
|
||||
* @('<*>') = 'ap'@
|
||||
|
||||
The above laws imply:
|
||||
|
||||
@ -667,6 +666,17 @@ class Applicative m => Monad m where
|
||||
return :: a -> m a
|
||||
return = pure
|
||||
|
||||
-- | Fail with a message. This operation is not part of the
|
||||
-- mathematical definition of a monad, but is invoked on pattern-match
|
||||
-- failure in a @do@ expression.
|
||||
--
|
||||
-- As part of the MonadFail proposal (MFP), this function is moved
|
||||
-- to its own class 'MonadFail' (see "Control.Monad.Fail" for more
|
||||
-- details). The definition here will be removed in a future
|
||||
-- release.
|
||||
fail :: String -> m a
|
||||
fail s = errorWithoutStackTrace s
|
||||
|
||||
{- Note [Recursive bindings for Applicative/Monad]
|
||||
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
@ -847,6 +857,8 @@ instance Monad Maybe where
|
||||
|
||||
(>>) = (*>)
|
||||
|
||||
fail _ = Nothing
|
||||
|
||||
-- -----------------------------------------------------------------------------
|
||||
-- The Alternative class definition
|
||||
|
||||
@ -857,7 +869,7 @@ infixl 3 <|>
|
||||
-- If defined, 'some' and 'many' should be the least solutions
|
||||
-- of the equations:
|
||||
--
|
||||
-- * @'some' v = (:) 'Prelude.<$>' v '<*>' 'many' v@
|
||||
-- * @'some' v = (:) '<$>' v '<*>' 'many' v@
|
||||
--
|
||||
-- * @'many' v = 'some' v '<|>' 'pure' []@
|
||||
class Applicative f => Alternative f where
|
||||
@ -974,6 +986,8 @@ instance Monad [] where
|
||||
xs >>= f = [y | x <- xs, y <- f x]
|
||||
{-# INLINE (>>) #-}
|
||||
(>>) = (*>)
|
||||
{-# INLINE fail #-}
|
||||
fail _ = []
|
||||
|
||||
-- | @since 2.01
|
||||
instance Alternative [] where
|
||||
@ -1083,14 +1097,11 @@ augment g xs = g (:) xs
|
||||
-- map
|
||||
----------------------------------------------
|
||||
|
||||
-- | /O(n)/. 'map' @f xs@ is the list obtained by applying @f@ to each element
|
||||
-- | 'map' @f xs@ is the list obtained by applying @f@ to each element
|
||||
-- of @xs@, i.e.,
|
||||
--
|
||||
-- > map f [x1, x2, ..., xn] == [f x1, f x2, ..., f xn]
|
||||
-- > map f [x1, x2, ...] == [f x1, f x2, ...]
|
||||
--
|
||||
-- >>> map (+1) [1, 2, 3]
|
||||
--- [2,3,4]
|
||||
|
||||
map :: (a -> b) -> [a] -> [b]
|
||||
{-# NOINLINE [0] map #-}
|
||||
@ -1245,8 +1256,8 @@ id x = x
|
||||
-- The compiler may rewrite it to @('assertError' line)@.
|
||||
|
||||
-- | If the first argument evaluates to 'True', then the result is the
|
||||
-- second argument. Otherwise an 'Control.Exception.AssertionFailed' exception
|
||||
-- is raised, containing a 'String' with the source file and line number of the
|
||||
-- second argument. Otherwise an 'AssertionFailed' exception is raised,
|
||||
-- containing a 'String' with the source file and line number of the
|
||||
-- call to 'assert'.
|
||||
--
|
||||
-- Assertions can normally be turned on or off with a compiler flag
|
||||
@ -1303,8 +1314,9 @@ flip f x y = f y x
|
||||
-- It is also useful in higher-order situations, such as @'map' ('$' 0) xs@,
|
||||
-- or @'Data.List.zipWith' ('$') fs xs@.
|
||||
--
|
||||
-- Note that @('$')@ is levity-polymorphic in its result type, so that
|
||||
-- @foo '$' True@ where @foo :: Bool -> Int#@ is well-typed.
|
||||
-- Note that @($)@ is levity-polymorphic in its result type, so that
|
||||
-- foo $ True where foo :: Bool -> Int#
|
||||
-- is well-typed
|
||||
{-# INLINE ($) #-}
|
||||
($) :: forall r a (b :: TYPE r). (a -> b) -> a -> b
|
||||
f $ x = f x
|
||||
@ -1353,6 +1365,7 @@ instance Monad IO where
|
||||
{-# INLINE (>>=) #-}
|
||||
(>>) = (*>)
|
||||
(>>=) = bindIO
|
||||
fail s = failIO s
|
||||
|
||||
-- | @since 4.9.0.0
|
||||
instance Alternative IO where
|
||||
@ -1375,7 +1388,7 @@ unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
|
||||
unIO (IO a) = a
|
||||
|
||||
{- |
|
||||
Returns the tag of a constructor application; this function is used
|
||||
Returns the 'tag' of a constructor application; this function is used
|
||||
by the deriving code for Eq, Ord and Enum.
|
||||
-}
|
||||
{-# INLINE getTag #-}
|
||||
|
||||
@ -85,7 +85,7 @@ ioManagerCapabilitiesChanged = return ()
|
||||
-- | Block the current thread until data is available to read on the
|
||||
-- given file descriptor (GHC only).
|
||||
--
|
||||
-- This will throw an 'Prelude.IOError' if the file descriptor was closed
|
||||
-- This will throw an 'IOError' if the file descriptor was closed
|
||||
-- while this thread was blocked. To safely close a file descriptor
|
||||
-- that has been used with 'threadWaitRead', use 'closeFdWith'.
|
||||
threadWaitRead :: Fd -> IO ()
|
||||
@ -101,7 +101,7 @@ threadWaitRead fd
|
||||
-- | Block the current thread until data can be written to the
|
||||
-- given file descriptor (GHC only).
|
||||
--
|
||||
-- This will throw an 'Prelude.IOError' if the file descriptor was closed
|
||||
-- This will throw an 'IOError' if the file descriptor was closed
|
||||
-- while this thread was blocked. To safely close a file descriptor
|
||||
-- that has been used with 'threadWaitWrite', use 'closeFdWith'.
|
||||
threadWaitWrite :: Fd -> IO ()
|
||||
|
||||
@ -367,7 +367,7 @@ to avoid contention with other processes in the machine.
|
||||
-}
|
||||
setNumCapabilities :: Int -> IO ()
|
||||
setNumCapabilities i
|
||||
| i <= 0 = failIO $ "setNumCapabilities: Capability count ("++show i++") must be positive"
|
||||
| i <= 0 = fail $ "setNumCapabilities: Capability count ("++show i++") must be positive"
|
||||
| otherwise = c_setNumCapabilities (fromIntegral i)
|
||||
|
||||
foreign import ccall safe "setNumCapabilities"
|
||||
@ -543,8 +543,8 @@ data BlockReason
|
||||
-- ^currently in a foreign call
|
||||
| BlockedOnOther
|
||||
-- ^blocked on some other resource. Without @-threaded@,
|
||||
-- I\/O and 'Control.Concurrent.threadDelay' show up as
|
||||
-- 'BlockedOnOther', with @-threaded@ they show up as 'BlockedOnMVar'.
|
||||
-- I\/O and 'threadDelay' show up as 'BlockedOnOther', with @-threaded@
|
||||
-- they show up as 'BlockedOnMVar'.
|
||||
deriving ( Eq -- ^ @since 4.3.0.0
|
||||
, Ord -- ^ @since 4.3.0.0
|
||||
, Show -- ^ @since 4.3.0.0
|
||||
@ -720,11 +720,8 @@ unsafeIOToSTM (IO m) = STM m
|
||||
--
|
||||
-- However, there are functions for creating transactional variables that
|
||||
-- can always be safely called in 'unsafePerformIO'. See: 'newTVarIO',
|
||||
-- 'Control.Concurrent.STM.TChan.newTChanIO',
|
||||
-- 'Control.Concurrent.STM.TChan.newBroadcastTChanIO',
|
||||
-- 'Control.Concurrent.STM.TQueue.newTQueueIO',
|
||||
-- 'Control.Concurrent.STM.TBQueue.newTBQueueIO', and
|
||||
-- 'Control.Concurrent.STM.TMVar.newTMVarIO'.
|
||||
-- 'newTChanIO', 'newBroadcastTChanIO', 'newTQueueIO', 'newTBQueueIO',
|
||||
-- and 'newTMVarIO'.
|
||||
--
|
||||
-- Using 'unsafePerformIO' inside of 'atomically' is also dangerous but for
|
||||
-- different reasons. See 'unsafeIOToSTM' for more on this.
|
||||
@ -752,12 +749,7 @@ orElse (STM m) e = STM $ \s -> catchRetry# m (unSTM e) s
|
||||
-- | A variant of 'throw' that can only be used within the 'STM' monad.
|
||||
--
|
||||
-- Throwing an exception in @STM@ aborts the transaction and propagates the
|
||||
-- exception. If the exception is caught via 'catchSTM', only the changes
|
||||
-- enclosed by the catch are rolled back; changes made outside of 'catchSTM'
|
||||
-- persist.
|
||||
--
|
||||
-- If the exception is not caught inside of the 'STM', it is re-thrown by
|
||||
-- 'atomically', and the entire 'STM' is rolled back.
|
||||
-- exception.
|
||||
--
|
||||
-- Although 'throwSTM' has a type that is an instance of the type of 'throw', the
|
||||
-- two functions are subtly different:
|
||||
@ -775,12 +767,7 @@ orElse (STM m) e = STM $ \s -> catchRetry# m (unSTM e) s
|
||||
throwSTM :: Exception e => e -> STM a
|
||||
throwSTM e = STM $ raiseIO# (toException e)
|
||||
|
||||
-- | Exception handling within STM actions.
|
||||
--
|
||||
-- @'catchSTM' m f@ catches any exception thrown by @m@ using 'throwSTM',
|
||||
-- using the function @f@ to handle the exception. If an exception is
|
||||
-- thrown, any changes made by @m@ are rolled back, but changes prior to
|
||||
-- @m@ persist.
|
||||
-- |Exception handling within STM actions.
|
||||
catchSTM :: Exception e => STM a -> (e -> STM a) -> STM a
|
||||
catchSTM (STM m) handler = STM $ catchSTM# m handler'
|
||||
where
|
||||
|
||||
@ -131,7 +131,7 @@ waitForDelayEvent :: Int -> IO ()
|
||||
waitForDelayEvent usecs = do
|
||||
m <- newEmptyMVar
|
||||
target <- calculateTarget usecs
|
||||
_ <- atomicModifyIORef'_ pendingDelays (\xs -> Delay target m : xs)
|
||||
atomicModifyIORef pendingDelays (\xs -> (Delay target m : xs, ()))
|
||||
prodServiceThread
|
||||
takeMVar m
|
||||
|
||||
@ -140,7 +140,7 @@ waitForDelayEventSTM :: Int -> IO (TVar Bool)
|
||||
waitForDelayEventSTM usecs = do
|
||||
t <- atomically $ newTVar False
|
||||
target <- calculateTarget usecs
|
||||
_ <- atomicModifyIORef'_ pendingDelays (\xs -> DelaySTM target t : xs)
|
||||
atomicModifyIORef pendingDelays (\xs -> (DelaySTM target t : xs, ()))
|
||||
prodServiceThread
|
||||
return t
|
||||
|
||||
@ -219,10 +219,10 @@ foreign import ccall unsafe "getOrSetGHCConcWindowsProddingStore"
|
||||
|
||||
prodServiceThread :: IO ()
|
||||
prodServiceThread = do
|
||||
-- NB. use atomicSwapIORef here, otherwise there are race
|
||||
-- NB. use atomicModifyIORef here, otherwise there are race
|
||||
-- conditions in which prodding is left at True but the server is
|
||||
-- blocked in select().
|
||||
was_set <- atomicSwapIORef prodding True
|
||||
was_set <- atomicModifyIORef prodding $ \b -> (True,b)
|
||||
when (not was_set) wakeupIOManager
|
||||
|
||||
-- ----------------------------------------------------------------------------
|
||||
@ -239,7 +239,7 @@ service_loop :: HANDLE -- read end of pipe
|
||||
|
||||
service_loop wakeup old_delays = do
|
||||
-- pick up new delay requests
|
||||
new_delays <- atomicSwapIORef pendingDelays []
|
||||
new_delays <- atomicModifyIORef pendingDelays (\a -> ([],a))
|
||||
let delays = foldr insertDelay old_delays new_delays
|
||||
|
||||
now <- getMonotonicUSec
|
||||
@ -262,7 +262,8 @@ service_loop wakeup old_delays = do
|
||||
|
||||
service_cont :: HANDLE -> [DelayReq] -> IO ()
|
||||
service_cont wakeup delays = do
|
||||
_ <- atomicSwapIORef prodding False
|
||||
r <- atomicModifyIORef prodding (\_ -> (False,False))
|
||||
r `seq` return () -- avoid space leak
|
||||
service_loop wakeup delays
|
||||
|
||||
-- must agree with rts/win32/ThrIOManager.c
|
||||
|
||||
@ -3,7 +3,7 @@
|
||||
, RankNTypes
|
||||
, ExistentialQuantification
|
||||
#-}
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
{-# OPTIONS_HADDOCK hide #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
{-# OPTIONS_HADDOCK hide #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -632,9 +632,9 @@ instance Bounded Word where
|
||||
-- use unboxed literals for maxBound, because GHC doesn't optimise
|
||||
-- (fromInteger 0xffffffff :: Word).
|
||||
#if WORD_SIZE_IN_BITS == 32
|
||||
maxBound = W# 0xFFFFFFFF##
|
||||
maxBound = W# (int2Word# 0xFFFFFFFF#)
|
||||
#elif WORD_SIZE_IN_BITS == 64
|
||||
maxBound = W# 0xFFFFFFFFFFFFFFFF##
|
||||
maxBound = W# (int2Word# 0xFFFFFFFFFFFFFFFF#)
|
||||
#else
|
||||
#error Unhandled value for WORD_SIZE_IN_BITS
|
||||
#endif
|
||||
@ -919,6 +919,7 @@ dn_list x0 delta lim = go (x0 :: Integer)
|
||||
-- Natural
|
||||
------------------------------------------------------------------------
|
||||
|
||||
#if defined(MIN_VERSION_integer_gmp)
|
||||
-- | @since 4.8.0.0
|
||||
instance Enum Natural where
|
||||
succ n = n `plusNatural` wordToNaturalBase 1##
|
||||
@ -926,13 +927,11 @@ instance Enum Natural where
|
||||
|
||||
toEnum = intToNatural
|
||||
|
||||
#if defined(MIN_VERSION_integer_gmp)
|
||||
fromEnum (NatS# w)
|
||||
| i >= 0 = i
|
||||
| otherwise = errorWithoutStackTrace "fromEnum: out of Int range"
|
||||
where
|
||||
i = I# (word2Int# w)
|
||||
#endif
|
||||
fromEnum n = fromEnum (naturalToInteger n)
|
||||
|
||||
enumFrom x = enumDeltaNatural x (wordToNaturalBase 1##)
|
||||
@ -963,6 +962,31 @@ enumNegDeltaToNatural x0 ndelta lim = go x0
|
||||
| x >= ndelta = x : go (x-ndelta)
|
||||
| otherwise = [x]
|
||||
|
||||
#else
|
||||
|
||||
-- | @since 4.8.0.0
|
||||
instance Enum Natural where
|
||||
pred (Natural 0) = errorWithoutStackTrace "Natural.pred: 0"
|
||||
pred (Natural n) = Natural (pred n)
|
||||
{-# INLINE pred #-}
|
||||
succ (Natural n) = Natural (succ n)
|
||||
{-# INLINE succ #-}
|
||||
fromEnum (Natural n) = fromEnum n
|
||||
{-# INLINE fromEnum #-}
|
||||
toEnum n | n < 0 = errorWithoutStackTrace "Natural.toEnum: negative"
|
||||
| otherwise = Natural (toEnum n)
|
||||
{-# INLINE toEnum #-}
|
||||
|
||||
enumFrom = coerce (enumFrom :: Integer -> [Integer])
|
||||
enumFromThen x y
|
||||
| x <= y = coerce (enumFromThen :: Integer -> Integer -> [Integer]) x y
|
||||
| otherwise = enumFromThenTo x y (wordToNaturalBase 0##)
|
||||
|
||||
enumFromTo = coerce (enumFromTo :: Integer -> Integer -> [Integer])
|
||||
enumFromThenTo
|
||||
= coerce (enumFromThenTo :: Integer -> Integer -> Integer -> [Integer])
|
||||
|
||||
#endif
|
||||
|
||||
-- Instances from GHC.Types
|
||||
|
||||
|
||||
@ -21,10 +21,10 @@ import qualified GHC.Foreign as GHC
|
||||
# endif
|
||||
#endif
|
||||
|
||||
-- | Computation 'getFullArgs' is the "raw" version of
|
||||
-- 'System.Environment.getArgs', similar to @argv@ in other languages. It
|
||||
-- returns a list of the program's command line arguments, starting with the
|
||||
-- program name, and including those normally eaten by the RTS (+RTS ... -RTS).
|
||||
-- | Computation 'getFullArgs' is the "raw" version of 'getArgs', similar
|
||||
-- to @argv@ in other languages. It returns a list of the program's
|
||||
-- command line arguments, starting with the program name, and
|
||||
-- including those normally eaten by the RTS (+RTS ... -RTS).
|
||||
getFullArgs :: IO [String]
|
||||
getFullArgs = do
|
||||
alloca $ \ p_argc -> do
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
{-# LANGUAGE NoImplicitPrelude, MagicHash, ImplicitParams #-}
|
||||
{-# LANGUAGE RankNTypes, PolyKinds, DataKinds #-}
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
{-# OPTIONS_HADDOCK hide #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -29,9 +29,7 @@ import GHC.Stack.Types
|
||||
import GHC.Prim
|
||||
import GHC.Integer () -- Make sure Integer and Natural are compiled first
|
||||
import GHC.Natural () -- because GHC depends on it in a wired-in way
|
||||
-- so the build system doesn't see the dependency.
|
||||
-- See Note [Depend on GHC.Integer] and
|
||||
-- Note [Depend on GHC.Natural] in GHC.Base.
|
||||
-- so the build system doesn't see the dependency
|
||||
import {-# SOURCE #-} GHC.Exception
|
||||
( errorCallWithCallStackException
|
||||
, errorCallException )
|
||||
|
||||
@ -126,7 +126,7 @@ newControl shouldRegister = allocaArray 2 $ \fds -> do
|
||||
-- file after it has been closed.
|
||||
closeControl :: Control -> IO ()
|
||||
closeControl w = do
|
||||
_ <- atomicSwapIORef (controlIsDead w) True
|
||||
atomicModifyIORef (controlIsDead w) (\_ -> (True, ()))
|
||||
_ <- c_close . fromIntegral . controlReadFd $ w
|
||||
_ <- c_close . fromIntegral . controlWriteFd $ w
|
||||
when (didRegisterWakeupFd w) $ c_setIOManagerWakeupFd (-1)
|
||||
|
||||
@ -216,7 +216,7 @@ delete :: Backend -> IO ()
|
||||
delete (Backend bState _ _ _ bDelete) = bDelete bState
|
||||
{-# INLINE delete #-}
|
||||
|
||||
-- | Throw an 'Prelude.IOError' corresponding to the current value of
|
||||
-- | Throw an 'IOError' corresponding to the current value of
|
||||
-- 'getErrno' if the result value of the 'IO' action is -1 and
|
||||
-- 'getErrno' is not 'eINTR'. If the result value is -1 and
|
||||
-- 'getErrno' returns 'eINTR' 0 is returned. Otherwise the result
|
||||
|
||||
@ -372,7 +372,7 @@ registerFd mgr cb fd evs lt = do
|
||||
when we register an event.
|
||||
|
||||
For more information, please read:
|
||||
https://gitlab.haskell.org/ghc/ghc/issues/7651
|
||||
http://ghc.haskell.org/trac/ghc/ticket/7651
|
||||
-}
|
||||
-- | Wake up the event manager.
|
||||
wakeManager :: EventManager -> IO ()
|
||||
|
||||
@ -49,6 +49,7 @@ import GHC.Event.Unique
|
||||
import GHC.Word (Word64)
|
||||
import GHC.Num (Num(..))
|
||||
import GHC.Real (fromIntegral)
|
||||
import GHC.Types (Int)
|
||||
|
||||
#include "MachDeps.h"
|
||||
|
||||
|
||||
@ -72,7 +72,7 @@ registerDelay usecs = do
|
||||
-- | Block the current thread until data is available to read from the
|
||||
-- given file descriptor.
|
||||
--
|
||||
-- This will throw an 'Prelude.IOError' if the file descriptor was closed
|
||||
-- This will throw an 'IOError' if the file descriptor was closed
|
||||
-- while this thread was blocked. To safely close a file descriptor
|
||||
-- that has been used with 'threadWaitRead', use 'closeFdWith'.
|
||||
threadWaitRead :: Fd -> IO ()
|
||||
@ -82,7 +82,7 @@ threadWaitRead = threadWait evtRead
|
||||
-- | Block the current thread until the given file descriptor can
|
||||
-- accept data to write.
|
||||
--
|
||||
-- This will throw an 'Prelude.IOError' if the file descriptor was closed
|
||||
-- This will throw an 'IOError' if the file descriptor was closed
|
||||
-- while this thread was blocked. To safely close a file descriptor
|
||||
-- that has been used with 'threadWaitWrite', use 'closeFdWith'.
|
||||
threadWaitWrite :: Fd -> IO ()
|
||||
@ -145,7 +145,7 @@ threadWaitSTM evt fd = mask_ $ do
|
||||
-- The second element of the return value pair is an IO action that can be used
|
||||
-- to deregister interest in the file descriptor.
|
||||
--
|
||||
-- The STM action will throw an 'Prelude.IOError' if the file descriptor was closed
|
||||
-- The STM action will throw an 'IOError' if the file descriptor was closed
|
||||
-- while the STM action is being executed. To safely close a file descriptor
|
||||
-- that has been used with 'threadWaitReadSTM', use 'closeFdWith'.
|
||||
threadWaitReadSTM :: Fd -> IO (STM (), IO ())
|
||||
@ -157,7 +157,7 @@ threadWaitReadSTM = threadWaitSTM evtRead
|
||||
-- The second element of the return value pair is an IO action that can be used to deregister
|
||||
-- interest in the file descriptor.
|
||||
--
|
||||
-- The STM action will throw an 'Prelude.IOError' if the file descriptor was closed
|
||||
-- The STM action will throw an 'IOError' if the file descriptor was closed
|
||||
-- while the STM action is being executed. To safely close a file descriptor
|
||||
-- that has been used with 'threadWaitWriteSTM', use 'closeFdWith'.
|
||||
threadWaitWriteSTM :: Fd -> IO (STM (), IO ())
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
, PatternSynonyms
|
||||
#-}
|
||||
{-# LANGUAGE TypeInType #-}
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
{-# OPTIONS_HADDOCK hide #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
|
||||
@ -5,7 +5,7 @@
|
||||
, RecordWildCards
|
||||
, PatternSynonyms
|
||||
#-}
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
{-# OPTIONS_HADDOCK hide #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
|
||||
@ -34,9 +34,6 @@ module GHC.Exts
|
||||
uncheckedIShiftL64#, uncheckedIShiftRA64#,
|
||||
isTrue#,
|
||||
|
||||
-- * Compat wrapper
|
||||
atomicModifyMutVar#,
|
||||
|
||||
-- * Fusion
|
||||
build, augment,
|
||||
|
||||
@ -49,7 +46,7 @@ module GHC.Exts
|
||||
-- * Ids with special behaviour
|
||||
lazy, inline, oneShot,
|
||||
|
||||
-- * Running 'RealWorld' state thread
|
||||
-- * Running 'RealWorld' state transformers
|
||||
runRW#,
|
||||
|
||||
-- * Safe coercions
|
||||
@ -222,27 +219,3 @@ instance IsList CallStack where
|
||||
type (Item CallStack) = (String, SrcLoc)
|
||||
fromList = fromCallSiteList
|
||||
toList = getCallStack
|
||||
|
||||
-- | An implementation of the old @atomicModifyMutVar#@ primop in
|
||||
-- terms of the new 'atomicModifyMutVar2#' primop, for backwards
|
||||
-- compatibility. The type of this function is a bit bogus. It's
|
||||
-- best to think of it as having type
|
||||
--
|
||||
-- @
|
||||
-- atomicModifyMutVar#
|
||||
-- :: MutVar# s a
|
||||
-- -> (a -> (a, b))
|
||||
-- -> State# s
|
||||
-- -> (# State# s, b #)
|
||||
-- @
|
||||
--
|
||||
-- but there may be code that uses this with other two-field record
|
||||
-- types.
|
||||
atomicModifyMutVar#
|
||||
:: MutVar# s a
|
||||
-> (a -> b)
|
||||
-> State# s
|
||||
-> (# State# s, c #)
|
||||
atomicModifyMutVar# mv f s =
|
||||
case unsafeCoerce# (atomicModifyMutVar2# mv f s) of
|
||||
(# s', _, ~(_, res) #) -> (# s', res #)
|
||||
|
||||
@ -10,7 +10,7 @@
|
||||
-- We believe we could deorphan this module, by moving lots of things
|
||||
-- around, but we haven't got there yet:
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
{-# OPTIONS_HADDOCK hide #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -65,13 +65,12 @@ infixr 8 **
|
||||
|
||||
-- | Trigonometric and hyperbolic functions and related functions.
|
||||
--
|
||||
-- The Haskell Report defines no laws for 'Floating'. However, @('+')@, @('*')@
|
||||
-- The Haskell Report defines no laws for 'Floating'. However, '(+)', '(*)'
|
||||
-- and 'exp' are customarily expected to define an exponential field and have
|
||||
-- the following properties:
|
||||
--
|
||||
-- * @exp (a + b)@ = @exp a * exp b@
|
||||
-- * @exp (a + b)@ = @exp a * exp b
|
||||
-- * @exp (fromInteger 0)@ = @fromInteger 1@
|
||||
--
|
||||
class (Fractional a) => Floating a where
|
||||
pi :: a
|
||||
exp, log, sqrt :: a -> a
|
||||
@ -167,7 +166,7 @@ class (RealFrac a, Floating a) => RealFloat a where
|
||||
decodeFloat :: a -> (Integer,Int)
|
||||
-- | 'encodeFloat' performs the inverse of 'decodeFloat' in the
|
||||
-- sense that for finite @x@ with the exception of @-0.0@,
|
||||
-- @'Prelude.uncurry' 'encodeFloat' ('decodeFloat' x) = x@.
|
||||
-- @'uncurry' 'encodeFloat' ('decodeFloat' x) = x@.
|
||||
-- @'encodeFloat' m n@ is one of the two closest representable
|
||||
-- floating-point numbers to @m*b^^n@ (or @±Infinity@ if overflow
|
||||
-- occurs); usually the closer, but if @m@ contains too many bits,
|
||||
@ -391,9 +390,13 @@ instance Floating Float where
|
||||
(**) x y = powerFloat x y
|
||||
logBase x y = log y / log x
|
||||
|
||||
asinh x = asinhFloat x
|
||||
acosh x = acoshFloat x
|
||||
atanh x = atanhFloat x
|
||||
asinh x
|
||||
| x > huge = log 2 + log x
|
||||
| x < 0 = -asinh (-x)
|
||||
| otherwise = log (x + sqrt (1 + x*x))
|
||||
where huge = 1e10
|
||||
acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))
|
||||
atanh x = 0.5 * log ((1.0+x) / (1.0-x))
|
||||
|
||||
log1p = log1pFloat
|
||||
expm1 = expm1Float
|
||||
@ -532,9 +535,13 @@ instance Floating Double where
|
||||
(**) x y = powerDouble x y
|
||||
logBase x y = log y / log x
|
||||
|
||||
asinh x = asinhDouble x
|
||||
acosh x = acoshDouble x
|
||||
atanh x = atanhDouble x
|
||||
asinh x
|
||||
| x > huge = log 2 + log x
|
||||
| x < 0 = -asinh (-x)
|
||||
| otherwise = log (x + sqrt (1 + x*x))
|
||||
where huge = 1e20
|
||||
acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))
|
||||
atanh x = 0.5 * log ((1.0+x) / (1.0-x))
|
||||
|
||||
log1p = log1pDouble
|
||||
expm1 = expm1Double
|
||||
@ -1144,7 +1151,6 @@ expFloat, logFloat, sqrtFloat, fabsFloat :: Float -> Float
|
||||
sinFloat, cosFloat, tanFloat :: Float -> Float
|
||||
asinFloat, acosFloat, atanFloat :: Float -> Float
|
||||
sinhFloat, coshFloat, tanhFloat :: Float -> Float
|
||||
asinhFloat, acoshFloat, atanhFloat :: Float -> Float
|
||||
expFloat (F# x) = F# (expFloat# x)
|
||||
logFloat (F# x) = F# (logFloat# x)
|
||||
sqrtFloat (F# x) = F# (sqrtFloat# x)
|
||||
@ -1158,9 +1164,6 @@ atanFloat (F# x) = F# (atanFloat# x)
|
||||
sinhFloat (F# x) = F# (sinhFloat# x)
|
||||
coshFloat (F# x) = F# (coshFloat# x)
|
||||
tanhFloat (F# x) = F# (tanhFloat# x)
|
||||
asinhFloat (F# x) = F# (asinhFloat# x)
|
||||
acoshFloat (F# x) = F# (acoshFloat# x)
|
||||
atanhFloat (F# x) = F# (atanhFloat# x)
|
||||
|
||||
powerFloat :: Float -> Float -> Float
|
||||
powerFloat (F# x) (F# y) = F# (powerFloat# x y)
|
||||
@ -1193,7 +1196,6 @@ expDouble, logDouble, sqrtDouble, fabsDouble :: Double -> Double
|
||||
sinDouble, cosDouble, tanDouble :: Double -> Double
|
||||
asinDouble, acosDouble, atanDouble :: Double -> Double
|
||||
sinhDouble, coshDouble, tanhDouble :: Double -> Double
|
||||
asinhDouble, acoshDouble, atanhDouble :: Double -> Double
|
||||
expDouble (D# x) = D# (expDouble# x)
|
||||
logDouble (D# x) = D# (logDouble# x)
|
||||
sqrtDouble (D# x) = D# (sqrtDouble# x)
|
||||
@ -1207,9 +1209,6 @@ atanDouble (D# x) = D# (atanDouble# x)
|
||||
sinhDouble (D# x) = D# (sinhDouble# x)
|
||||
coshDouble (D# x) = D# (coshDouble# x)
|
||||
tanhDouble (D# x) = D# (tanhDouble# x)
|
||||
asinhDouble (D# x) = D# (asinhDouble# x)
|
||||
acoshDouble (D# x) = D# (acoshDouble# x)
|
||||
atanhDouble (D# x) = D# (atanhDouble# x)
|
||||
|
||||
powerDouble :: Double -> Double -> Double
|
||||
powerDouble (D# x) (D# y) = D# (x **## y)
|
||||
@ -1294,7 +1293,7 @@ And with the rule:
|
||||
The running time of the program goes from 120 seconds to 0.198 seconds
|
||||
with the native backend, and 0.143 seconds with the C backend.
|
||||
|
||||
A few more details in #2251, and the patch message
|
||||
A few more details in Trac #2251, and the patch message
|
||||
"Add RULES for realToFrac from Int".
|
||||
-}
|
||||
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}
|
||||
{-# OPTIONS_GHC -O2 #-}
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
{-# OPTIONS_HADDOCK hide #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
{-# OPTIONS_HADDOCK hide #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
|
||||
@ -154,8 +154,7 @@ withCStringsLen enc strs f = go [] strs
|
||||
go cs (s:ss) = withCString enc s $ \c -> go (c:cs) ss
|
||||
go cs [] = withArrayLen (reverse cs) f
|
||||
|
||||
-- | Determines whether a character can be accurately encoded in a
|
||||
-- 'Foreign.C.String.CString'.
|
||||
-- | Determines whether a character can be accurately encoded in a 'CString'.
|
||||
--
|
||||
-- Pretty much anyone who uses this function is in a state of sin because
|
||||
-- whether or not a character is encodable will, in general, depend on the
|
||||
@ -201,7 +200,7 @@ peekEncodedCString (TextEncoding { mkTextDecoder = mk_decoder }) (p, sz_bytes)
|
||||
from0 <- fmap (\fp -> bufferAdd sz_bytes (emptyBuffer fp sz_bytes ReadBuffer)) $ newForeignPtr_ (castPtr p)
|
||||
to <- newCharBuffer chunk_size WriteBuffer
|
||||
|
||||
let go !iteration from = do
|
||||
let go iteration from = do
|
||||
(why, from', to') <- encode decoder from to
|
||||
if isEmptyBuffer from'
|
||||
then
|
||||
@ -230,7 +229,7 @@ withEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate
|
||||
= bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do
|
||||
from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p
|
||||
|
||||
let go !iteration to_sz_bytes = do
|
||||
let go iteration to_sz_bytes = do
|
||||
putDebugMsg ("withEncodedCString: " ++ show iteration)
|
||||
allocaBytes to_sz_bytes $ \to_p -> do
|
||||
mb_res <- tryFillBufferAndCall encoder null_terminate from to_p to_sz_bytes act
|
||||
@ -250,7 +249,7 @@ newEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s
|
||||
= bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do
|
||||
from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p
|
||||
|
||||
let go !iteration to_p to_sz_bytes = do
|
||||
let go iteration to_p to_sz_bytes = do
|
||||
putDebugMsg ("newEncodedCString: " ++ show iteration)
|
||||
mb_res <- tryFillBufferAndCall encoder null_terminate from to_p to_sz_bytes return
|
||||
case mb_res of
|
||||
@ -272,7 +271,7 @@ tryFillBufferAndCall encoder null_terminate from0 to_p to_sz_bytes act = do
|
||||
to_fp <- newForeignPtr_ to_p
|
||||
go (0 :: Int) (from0, emptyBuffer to_fp to_sz_bytes WriteBuffer)
|
||||
where
|
||||
go !iteration (from, to) = do
|
||||
go iteration (from, to) = do
|
||||
(why, from', to') <- encode encoder from to
|
||||
putDebugMsg ("tryFillBufferAndCall: " ++ show iteration ++ " " ++ show why ++ " " ++ summaryBuffer from ++ " " ++ summaryBuffer from')
|
||||
if isEmptyBuffer from'
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
, MagicHash
|
||||
, UnboxedTuples
|
||||
#-}
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
{-# OPTIONS_HADDOCK hide #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
@ -153,8 +153,8 @@ mallocForeignPtr :: Storable a => IO (ForeignPtr a)
|
||||
-- implementation in GHC. It uses pinned memory in the garbage
|
||||
-- collected heap, so the 'ForeignPtr' does not require a finalizer to
|
||||
-- free the memory. Use of 'mallocForeignPtr' and associated
|
||||
-- functions is strongly recommended in preference to
|
||||
-- 'Foreign.ForeignPtr.newForeignPtr' with a finalizer.
|
||||
-- functions is strongly recommended in preference to 'newForeignPtr'
|
||||
-- with a finalizer.
|
||||
--
|
||||
mallocForeignPtr = doMalloc undefined
|
||||
where doMalloc :: Storable b => b -> IO (ForeignPtr b)
|
||||
@ -250,7 +250,7 @@ mallocPlainForeignPtrAlignedBytes (I# size) (I# align) = IO $ \s ->
|
||||
}
|
||||
|
||||
addForeignPtrFinalizer :: FinalizerPtr a -> ForeignPtr a -> IO ()
|
||||
-- ^ This function adds a finalizer to the given foreign object. The
|
||||
-- ^This function adds a finalizer to the given foreign object. The
|
||||
-- finalizer will run /before/ all other finalizers for the same
|
||||
-- object which have already been registered.
|
||||
addForeignPtrFinalizer (FunPtr fp) (ForeignPtr p c) = case c of
|
||||
@ -269,8 +269,10 @@ addForeignPtrFinalizer (FunPtr fp) (ForeignPtr p c) = case c of
|
||||
|
||||
addForeignPtrFinalizerEnv ::
|
||||
FinalizerEnvPtr env a -> Ptr env -> ForeignPtr a -> IO ()
|
||||
-- ^ Like 'addForeignPtrFinalizer' but the finalizer is passed an additional
|
||||
-- environment parameter.
|
||||
-- ^ Like 'addForeignPtrFinalizerEnv' but allows the finalizer to be
|
||||
-- passed an additional environment parameter to be passed to the
|
||||
-- finalizer. The environment passed to the finalizer is fixed by the
|
||||
-- second argument to 'addForeignPtrFinalizerEnv'
|
||||
addForeignPtrFinalizerEnv (FunPtr fp) (Ptr ep) (ForeignPtr p c) = case c of
|
||||
PlainForeignPtr r -> insertCFinalizer r fp 1# ep p ()
|
||||
MallocPtr _ r -> insertCFinalizer r fp 1# ep p c
|
||||
@ -287,10 +289,9 @@ addForeignPtrConcFinalizer :: ForeignPtr a -> IO () -> IO ()
|
||||
--
|
||||
-- NB. Be very careful with these finalizers. One common trap is that
|
||||
-- if a finalizer references another finalized value, it does not
|
||||
-- prevent that value from being finalized. In particular, 'System.IO.Handle's
|
||||
-- are finalized objects, so a finalizer should not refer to a
|
||||
-- 'System.IO.Handle' (including 'System.IO.stdout', 'System.IO.stdin', or
|
||||
-- 'System.IO.stderr').
|
||||
-- prevent that value from being finalized. In particular, 'Handle's
|
||||
-- are finalized objects, so a finalizer should not refer to a 'Handle'
|
||||
-- (including @stdout@, @stdin@ or @stderr@).
|
||||
--
|
||||
addForeignPtrConcFinalizer (ForeignPtr _ c) finalizer =
|
||||
addForeignPtrConcFinalizer_ c finalizer
|
||||
@ -320,7 +321,7 @@ addForeignPtrConcFinalizer_ _ _ =
|
||||
|
||||
insertHaskellFinalizer :: IORef Finalizers -> IO () -> IO Bool
|
||||
insertHaskellFinalizer r f = do
|
||||
!wasEmpty <- atomicModifyIORefP r $ \finalizers -> case finalizers of
|
||||
!wasEmpty <- atomicModifyIORef r $ \finalizers -> case finalizers of
|
||||
NoFinalizers -> (HaskellFinalizers [f], True)
|
||||
HaskellFinalizers fs -> (HaskellFinalizers (f:fs), False)
|
||||
_ -> noMixingError
|
||||
@ -351,8 +352,8 @@ ensureCFinalizerWeak ref@(IORef (STRef r#)) value = do
|
||||
NoFinalizers -> IO $ \s ->
|
||||
case mkWeakNoFinalizer# r# (unsafeCoerce# value) s of { (# s1, w #) ->
|
||||
-- See Note [MallocPtr finalizers] (#10904)
|
||||
case atomicModifyMutVar2# r# (update w) s1 of
|
||||
{ (# s2, _, (_, (weak, needKill )) #) ->
|
||||
case atomicModifyMutVar# r# (update w) s1 of
|
||||
{ (# s2, (weak, needKill ) #) ->
|
||||
if needKill
|
||||
then case finalizeWeak# w s2 of { (# s3, _, _ #) ->
|
||||
(# s3, weak #) }
|
||||
@ -369,8 +370,7 @@ noMixingError = errorWithoutStackTrace $
|
||||
|
||||
foreignPtrFinalizer :: IORef Finalizers -> IO ()
|
||||
foreignPtrFinalizer r = do
|
||||
fs <- atomicSwapIORef r NoFinalizers
|
||||
-- atomic, see #7170
|
||||
fs <- atomicModifyIORef r $ \fs -> (NoFinalizers, fs) -- atomic, see #7170
|
||||
case fs of
|
||||
NoFinalizers -> return ()
|
||||
CFinalizers w -> IO $ \s -> case finalizeWeak# w s of
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
{-# OPTIONS_HADDOCK hide #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
|
||||
@ -105,7 +105,7 @@ module GHC.Generics (
|
||||
-- This is a lot of information! However, most of it is actually merely meta-information
|
||||
-- that makes names of datatypes and constructors and more available on the type level.
|
||||
--
|
||||
-- Here is a reduced representation for @Tree@ with nearly all meta-information removed,
|
||||
-- Here is a reduced representation for 'Tree' with nearly all meta-information removed,
|
||||
-- for now keeping only the most essential aspects:
|
||||
--
|
||||
-- @
|
||||
@ -189,7 +189,7 @@ module GHC.Generics (
|
||||
--
|
||||
-- Here, 'R' is a type-level proxy that does not have any associated values.
|
||||
--
|
||||
-- There used to be another variant of 'K1' (namely @Par0@), but it has since
|
||||
-- There used to be another variant of 'K1' (namely 'Par0'), but it has since
|
||||
-- been deprecated.
|
||||
|
||||
-- *** Meta information: 'M1'
|
||||
@ -273,7 +273,7 @@ module GHC.Generics (
|
||||
-- between the original value and its `Rep`-based representation and then invokes the
|
||||
-- generic instances.
|
||||
--
|
||||
-- As an example, let us look at a function @encode@ that produces a naive, but lossless
|
||||
-- As an example, let us look at a function 'encode' that produces a naive, but lossless
|
||||
-- bit encoding of values of various datatypes. So we are aiming to define a function
|
||||
--
|
||||
-- @
|
||||
@ -367,15 +367,18 @@ module GHC.Generics (
|
||||
-- @
|
||||
--
|
||||
-- The case for 'K1' is rather interesting. Here, we call the final function
|
||||
-- @encode@ that we yet have to define, recursively. We will use another type
|
||||
-- class @Encode@ for that function:
|
||||
-- 'encode' that we yet have to define, recursively. We will use another type
|
||||
-- class 'Encode' for that function:
|
||||
--
|
||||
-- @
|
||||
-- instance (Encode c) => Encode' ('K1' i c) where
|
||||
-- encode' ('K1' x) = encode x
|
||||
-- @
|
||||
--
|
||||
-- Note how we can define a uniform instance for 'M1', because we completely
|
||||
-- Note how 'Par0' and 'Rec0' both being mapped to 'K1' allows us to define
|
||||
-- a uniform instance here.
|
||||
--
|
||||
-- Similarly, we can define a uniform instance for 'M1', because we completely
|
||||
-- disregard all meta-information:
|
||||
--
|
||||
-- @
|
||||
@ -383,13 +386,13 @@ module GHC.Generics (
|
||||
-- encode' ('M1' x) = encode' x
|
||||
-- @
|
||||
--
|
||||
-- Unlike in 'K1', the instance for 'M1' refers to @encode'@, not @encode@.
|
||||
-- Unlike in 'K1', the instance for 'M1' refers to 'encode'', not 'encode'.
|
||||
|
||||
-- *** The wrapper and generic default
|
||||
--
|
||||
-- |
|
||||
--
|
||||
-- We now define class @Encode@ for the actual @encode@ function:
|
||||
-- We now define class 'Encode' for the actual 'encode' function:
|
||||
--
|
||||
-- @
|
||||
-- class Encode a where
|
||||
@ -398,9 +401,9 @@ module GHC.Generics (
|
||||
-- encode x = encode' ('from' x)
|
||||
-- @
|
||||
--
|
||||
-- The incoming @x@ is converted using 'from', then we dispatch to the
|
||||
-- generic instances using @encode'@. We use this as a default definition
|
||||
-- for @encode@. We need the @default encode@ signature because ordinary
|
||||
-- The incoming 'x' is converted using 'from', then we dispatch to the
|
||||
-- generic instances using 'encode''. We use this as a default definition
|
||||
-- for 'encode'. We need the 'default encode' signature because ordinary
|
||||
-- Haskell default methods must not introduce additional class constraints,
|
||||
-- but our generic default does.
|
||||
--
|
||||
@ -418,10 +421,10 @@ module GHC.Generics (
|
||||
-- possible to use @deriving Encode@ as well, but GHC does not yet support
|
||||
-- that syntax for this situation.
|
||||
--
|
||||
-- Having @Encode@ as a class has the advantage that we can define
|
||||
-- Having 'Encode' as a class has the advantage that we can define
|
||||
-- non-generic special cases, which is particularly useful for abstract
|
||||
-- datatypes that have no structural representation. For example, given
|
||||
-- a suitable integer encoding function @encodeInt@, we can define
|
||||
-- a suitable integer encoding function 'encodeInt', we can define
|
||||
--
|
||||
-- @
|
||||
-- instance Encode Int where
|
||||
@ -454,7 +457,7 @@ module GHC.Generics (
|
||||
-- any datatype where each constructor has at least one field.
|
||||
--
|
||||
-- An 'M1' instance is always required (but it can just ignore the
|
||||
-- meta-information, as is the case for @encode@ above).
|
||||
-- meta-information, as is the case for 'encode' above).
|
||||
#if 0
|
||||
-- *** Using meta-information
|
||||
--
|
||||
@ -467,15 +470,14 @@ module GHC.Generics (
|
||||
-- |
|
||||
--
|
||||
-- Datatype-generic functions as defined above work for a large class
|
||||
-- of datatypes, including parameterized datatypes. (We have used @Tree@
|
||||
-- of datatypes, including parameterized datatypes. (We have used 'Tree'
|
||||
-- as our example above, which is of kind @* -> *@.) However, the
|
||||
-- 'Generic' class ranges over types of kind @*@, and therefore, the
|
||||
-- resulting generic functions (such as @encode@) must be parameterized
|
||||
-- resulting generic functions (such as 'encode') must be parameterized
|
||||
-- by a generic type argument of kind @*@.
|
||||
--
|
||||
-- What if we want to define generic classes that range over type
|
||||
-- constructors (such as 'Data.Functor.Functor',
|
||||
-- 'Data.Traversable.Traversable', or 'Data.Foldable.Foldable')?
|
||||
-- constructors (such as 'Functor', 'Traversable', or 'Foldable')?
|
||||
|
||||
-- *** The 'Generic1' class
|
||||
--
|
||||
@ -489,7 +491,7 @@ module GHC.Generics (
|
||||
-- The 'Generic1' class is also derivable.
|
||||
--
|
||||
-- The representation 'Rep1' is ever so slightly different from 'Rep'.
|
||||
-- Let us look at @Tree@ as an example again:
|
||||
-- Let us look at 'Tree' as an example again:
|
||||
--
|
||||
-- @
|
||||
-- data Tree a = Leaf a | Node (Tree a) (Tree a)
|
||||
@ -747,7 +749,7 @@ import GHC.Show ( Show(..), showString )
|
||||
|
||||
-- Needed for metadata
|
||||
import Data.Proxy ( Proxy(..) )
|
||||
import GHC.TypeLits ( KnownSymbol, KnownNat, symbolVal, natVal )
|
||||
import GHC.TypeLits ( Nat, Symbol, KnownSymbol, KnownNat, symbolVal, natVal )
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Representation types
|
||||
@ -1333,8 +1335,8 @@ instance (SingI mn, SingI su, SingI ss, SingI ds)
|
||||
-- A 'Generic' instance must satisfy the following laws:
|
||||
--
|
||||
-- @
|
||||
-- 'from' . 'to' ≡ 'Prelude.id'
|
||||
-- 'to' . 'from' ≡ 'Prelude.id'
|
||||
-- 'from' . 'to' ≡ 'id'
|
||||
-- 'to' . 'from' ≡ 'id'
|
||||
-- @
|
||||
class Generic a where
|
||||
-- | Generic representation type
|
||||
@ -1352,8 +1354,8 @@ class Generic a where
|
||||
-- A 'Generic1' instance must satisfy the following laws:
|
||||
--
|
||||
-- @
|
||||
-- 'from1' . 'to1' ≡ 'Prelude.id'
|
||||
-- 'to1' . 'from1' ≡ 'Prelude.id'
|
||||
-- 'from1' . 'to1' ≡ 'id'
|
||||
-- 'to1' . 'from1' ≡ 'id'
|
||||
-- @
|
||||
class Generic1 (f :: k -> Type) where
|
||||
-- | Generic representation type
|
||||
@ -1482,6 +1484,8 @@ deriving instance Generic1 Down
|
||||
data family Sing (a :: k)
|
||||
|
||||
-- | A 'SingI' constraint is essentially an implicitly-passed singleton.
|
||||
-- If you need to satisfy this constraint with an explicit singleton, please
|
||||
-- see 'withSingI'.
|
||||
class SingI (a :: k) where
|
||||
-- | Produce the singleton explicitly. You will likely need the @ScopedTypeVariables@
|
||||
-- extension to use this method the way you want.
|
||||
|
||||
@ -7,7 +7,7 @@
|
||||
, UnboxedTuples
|
||||
#-}
|
||||
{-# OPTIONS_GHC -funbox-strict-fields #-}
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
{-# OPTIONS_HADDOCK hide #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -53,8 +53,8 @@ import {-# SOURCE #-} GHC.IO.Exception ( userError, IOError )
|
||||
-- The IO Monad
|
||||
|
||||
{-
|
||||
The IO Monad is just an instance of the ST monad, where the state thread
|
||||
is the real world. We use the exception mechanism (in GHC.Exception) to
|
||||
The IO Monad is just an instance of the ST monad, where the state is
|
||||
the real world. We use the exception mechanism (in GHC.Exception) to
|
||||
implement IO exceptions.
|
||||
|
||||
NOTE: The IO representation is deeply wired in to various parts of the
|
||||
@ -84,7 +84,7 @@ failIO s = IO (raiseIO# (toException (userError s)))
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- Coercions between IO and ST
|
||||
|
||||
-- | Embed a strict state thread in an 'IO'
|
||||
-- | Embed a strict state transformer in an 'IO'
|
||||
-- action. The 'RealWorld' parameter indicates that the internal state
|
||||
-- used by the 'ST' computation is a special one supplied by the 'IO'
|
||||
-- monad, and thus distinct from those used by invocations of 'runST'.
|
||||
@ -92,20 +92,20 @@ stToIO :: ST RealWorld a -> IO a
|
||||
stToIO (ST m) = IO m
|
||||
|
||||
-- | Convert an 'IO' action into an 'ST' action. The type of the result
|
||||
-- is constrained to use a 'RealWorld' state thread, and therefore the
|
||||
-- result cannot be passed to 'runST'.
|
||||
-- is constrained to use a 'RealWorld' state, and therefore the result cannot
|
||||
-- be passed to 'runST'.
|
||||
ioToST :: IO a -> ST RealWorld a
|
||||
ioToST (IO m) = (ST m)
|
||||
|
||||
-- | Convert an 'IO' action to an 'ST' action.
|
||||
-- This relies on 'IO' and 'ST' having the same representation modulo the
|
||||
-- constraint on the state thread type parameter.
|
||||
-- constraint on the type of the state.
|
||||
unsafeIOToST :: IO a -> ST s a
|
||||
unsafeIOToST (IO io) = ST $ \ s -> (unsafeCoerce# io) s
|
||||
|
||||
-- | Convert an 'ST' action to an 'IO' action.
|
||||
-- This relies on 'IO' and 'ST' having the same representation modulo the
|
||||
-- constraint on the state thread type parameter.
|
||||
-- constraint on the type of the state.
|
||||
--
|
||||
-- For an example demonstrating why this is unsafe, see
|
||||
-- https://mail.haskell.org/pipermail/haskell-cafe/2009-April/060719.html
|
||||
@ -440,7 +440,7 @@ evaluate a = IO $ \s -> seq# a s -- NB. see #2273, #5129
|
||||
{- $exceptions_and_strictness
|
||||
|
||||
Laziness can interact with @catch@-like operations in non-obvious ways (see,
|
||||
e.g. GHC #11555 and #13330). For instance, consider these subtly-different
|
||||
e.g. GHC Trac #11555 and #13330). For instance, consider these subtly-different
|
||||
examples:
|
||||
|
||||
> test1 = Control.Exception.catch (error "uh oh") (\(_ :: SomeException) -> putStrLn "it failed")
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
module GHC.IO where
|
||||
|
||||
import GHC.Types
|
||||
import GHC.Integer () -- See Note [Depend on GHC.Integer] in GHC.Base
|
||||
import GHC.Integer () -- see Note [Depend upon GHC.Integer] in libraries/base/GHC/Base.hs
|
||||
|
||||
failIO :: [Char] -> IO a
|
||||
mplusIO :: IO a -> IO a -> IO a
|
||||
|
||||
@ -32,8 +32,8 @@ import GHC.IO.Buffer
|
||||
-- | The purpose of 'BufferedIO' is to provide a common interface for I/O
|
||||
-- devices that can read and write data through a buffer. Devices that
|
||||
-- implement 'BufferedIO' include ordinary files, memory-mapped files,
|
||||
-- and bytestrings. The underlying device implementing a 'System.IO.Handle'
|
||||
-- must provide 'BufferedIO'.
|
||||
-- and bytestrings. The underlying device implementing a 'Handle' must
|
||||
-- provide 'BufferedIO'.
|
||||
--
|
||||
class BufferedIO dev where
|
||||
-- | allocate a new buffer. The size of the buffer is at the
|
||||
|
||||
@ -56,7 +56,7 @@ class RawIO a where
|
||||
writeNonBlocking :: a -> Ptr Word8 -> Int -> IO Int
|
||||
|
||||
|
||||
-- | I/O operations required for implementing a 'System.IO.Handle'.
|
||||
-- | I/O operations required for implementing a 'Handle'.
|
||||
class IODevice a where
|
||||
-- | @ready dev write msecs@ returns 'True' if the device has data
|
||||
-- to read (if @write@ is 'False') or space to write new data (if
|
||||
@ -139,7 +139,7 @@ data IODeviceType
|
||||
= Directory -- ^ The standard libraries do not have direct support
|
||||
-- for this device type, but a user implementation is
|
||||
-- expected to provide a list of file names in
|
||||
-- the directory, in any order, separated by @\'\\0\'@
|
||||
-- the directory, in any order, separated by @'\0'@
|
||||
-- characters, excluding the @"."@ and @".."@ names. See
|
||||
-- also 'System.Directory.getDirectoryContents'. Seek
|
||||
-- operations are not supported on directories (other
|
||||
@ -160,7 +160,7 @@ data IODeviceType
|
||||
-- -----------------------------------------------------------------------------
|
||||
-- SeekMode type
|
||||
|
||||
-- | A mode that determines the effect of 'System.IO.hSeek' @hdl mode i@.
|
||||
-- | A mode that determines the effect of 'hSeek' @hdl mode i@.
|
||||
data SeekMode
|
||||
= AbsoluteSeek -- ^ the position of @hdl@ is set to @i@.
|
||||
| RelativeSeek -- ^ the position of @hdl@ is set to offset @i@
|
||||
|
||||
@ -57,8 +57,7 @@ import System.IO.Unsafe (unsafePerformIO)
|
||||
-- | The Latin1 (ISO8859-1) encoding. This encoding maps bytes
|
||||
-- directly to the first 256 Unicode code points, and is thus not a
|
||||
-- complete Unicode encoding. An attempt to write a character greater than
|
||||
-- @\'\\255\'@ to a 'System.IO.Handle' using the 'latin1' encoding will result in an
|
||||
-- error.
|
||||
-- '\255' to a 'Handle' using the 'latin1' encoding will result in an error.
|
||||
latin1 :: TextEncoding
|
||||
latin1 = Latin1.latin1_checked
|
||||
|
||||
@ -123,7 +122,7 @@ getFileSystemEncoding :: IO TextEncoding
|
||||
|
||||
-- | The Unicode encoding of the current locale, but where undecodable
|
||||
-- bytes are replaced with their closest visual match. Used for
|
||||
-- the 'Foreign.C.String.CString' marshalling functions in "Foreign.C.String"
|
||||
-- the 'CString' marshalling functions in "Foreign.C.String"
|
||||
--
|
||||
-- @since 4.5.0.0
|
||||
getForeignEncoding :: IO TextEncoding
|
||||
@ -188,7 +187,7 @@ char8 = Latin1.latin1
|
||||
|
||||
-- | Look up the named Unicode encoding. May fail with
|
||||
--
|
||||
-- * 'System.IO.Error.isDoesNotExistError' if the encoding is unknown
|
||||
-- * 'isDoesNotExistError' if the encoding is unknown
|
||||
--
|
||||
-- The set of known encodings is system-dependent, but includes at least:
|
||||
--
|
||||
|
||||
@ -34,8 +34,8 @@ import GHC.Real ( fromIntegral )
|
||||
|
||||
--import System.Posix.Internals
|
||||
|
||||
-- | The 'CodingFailureMode' is used to construct 'System.IO.TextEncoding's,
|
||||
-- and specifies how they handle illegal sequences.
|
||||
-- | The 'CodingFailureMode' is used to construct 'TextEncoding's, and
|
||||
-- specifies how they handle illegal sequences.
|
||||
data CodingFailureMode
|
||||
= ErrorOnCodingFailure
|
||||
-- ^ Throw an error when an illegal sequence is encountered
|
||||
|
||||
@ -3,7 +3,7 @@
|
||||
, NoImplicitPrelude
|
||||
, NondecreasingIndentation
|
||||
#-}
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
{-# OPTIONS_HADDOCK hide #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user