GHC.Exts (original) (raw)
Representations of some basic types
data Int [Source](/packages/archive///doc/html/src/GHC-Types.html#Int)
A fixed-precision integer type with at least the range [-2^29 .. 2^29-1]
. The exact range for a given implementation can be determined by using[minBound](Prelude.html#t:minBound)
and [maxBound](Prelude.html#t:maxBound)
from the [Bounded](Prelude.html#t:Bounded)
class.
data Float [Source](/packages/archive///doc/html/src/GHC-Types.html#Float)
Single-precision floating point numbers. It is desirable that this type be at least equal in range and precision to the IEEE single-precision type.
data Double [Source](/packages/archive///doc/html/src/GHC-Types.html#Double)
Double-precision floating point numbers. It is desirable that this type be at least equal in range and precision to the IEEE double-precision type.
data Char [Source](/packages/archive///doc/html/src/GHC-Types.html#Char)
The character type [Char](GHC-Exts.html#t:Char)
is an enumeration whose values represent Unicode (or equivalently ISO/IEC 10646) characters (seehttp://www.unicode.org/ for details). This set extends the ISO 8859-1 (Latin-1) character set (the first 256 characters), which is itself an extension of the ASCII character set (the first 128 characters). A character literal in Haskell has type [Char](GHC-Exts.html#t:Char)
.
To convert a [Char](GHC-Exts.html#t:Char)
to or from the corresponding [Int](GHC-Exts.html#t:Int)
value defined by Unicode, use [toEnum](Prelude.html#t:toEnum)
and [fromEnum](Prelude.html#t:fromEnum)
from the[Enum](Prelude.html#t:Enum)
class respectively (or equivalently ord
and chr
).
data Ptr a Source
A value of type `[Ptr](GHC-Exts.html#t:Ptr)` a
represents a pointer to an object, or an array of objects, which may be marshalled to or from Haskell values of type a
.
The type a
will often be an instance of class[Storable](Foreign-Storable.html#t:Storable)
which provides the marshalling operations. However this is not essential, and you can provide your own operations to access the pointer. For example you might write small foreign functions to get or set the fields of a C struct
.
data FunPtr a Source
A value of type `[FunPtr](GHC-Exts.html#t:FunPtr)` a
is a pointer to a function callable from foreign code. The type a
will normally be a foreign type, a function type with zero or more arguments where
- the argument types are marshallable foreign types, i.e.
[Char](GHC-Exts.html#t:Char)
,[Int](GHC-Exts.html#t:Int)
,[Double](GHC-Exts.html#t:Double)
,[Float](GHC-Exts.html#t:Float)
,[Bool](Data-Bool.html#t:Bool)
,[Int8](Data-Int.html#t:Int8)
,[Int16](Data-Int.html#t:Int16)
,[Int32](Data-Int.html#t:Int32)
,[Int64](Data-Int.html#t:Int64)
,[Word8](Data-Word.html#t:Word8)
,[Word16](Data-Word.html#t:Word16)
,[Word32](Data-Word.html#t:Word32)
,[Word64](Data-Word.html#t:Word64)
,`[Ptr](GHC-Exts.html#t:Ptr)` a
,`[FunPtr](GHC-Exts.html#t:FunPtr)` a
,`[StablePtr](Foreign-StablePtr.html#t:StablePtr)` a
or a renaming of any of these usingnewtype
. - the return type is either a marshallable foreign type or has the form
`[IO](System-IO.html#t:IO)` t
wheret
is a marshallable foreign type or()
.
A value of type `[FunPtr](GHC-Exts.html#t:FunPtr)` a
may be a pointer to a foreign function, either returned by another foreign function or imported with a a static address import like
foreign import ccall "stdlib.h &free" p_free :: FunPtr (Ptr a -> IO ())
or a pointer to a Haskell function created using a wrapper stub declared to produce a [FunPtr](GHC-Exts.html#t:FunPtr)
of the correct type. For example:
type Compare = Int -> Int -> Bool foreign import ccall "wrapper" mkCompare :: Compare -> IO (FunPtr Compare)
Calls to wrapper stubs like mkCompare
allocate storage, which should be released with [freeHaskellFunPtr](Foreign-Ptr.html#t:freeHaskellFunPtr)
when no longer required.
To convert [FunPtr](GHC-Exts.html#t:FunPtr)
values to corresponding Haskell functions, one can define a dynamic stub for the specific foreign type, e.g.
type IntFunction = CInt -> IO () foreign import ccall "dynamic" mkFun :: FunPtr IntFunction -> IntFunction
The maximum tuple size
Primitive operations
iShiftRL# :: [Int#](/packages/archive///doc/html/GHC-Prim.html#t:Int-35-) -> [Int#](/packages/archive///doc/html/GHC-Prim.html#t:Int-35-) -> [Int#](/packages/archive///doc/html/GHC-Prim.html#t:Int-35-)Source
Shift the argument right (unsigned) by the specified number of bits (which must be non-negative).
Fusion
build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]Source
A list producer that can be fused with [foldr](Data-List.html#v:foldr)
. This function is merely
build g = g (:) []
but GHC's simplifier will transform an expression of the form`[foldr](Data-List.html#v:foldr)` k z (`[build](GHC-Exts.html#v:build)` g)
, which may arise after inlining, to g k z
, which avoids producing an intermediate list.
augment :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a] -> [a]Source
A list producer that can be fused with [foldr](Data-List.html#v:foldr)
. This function is merely
augment g xs = g (:) xs
but GHC's simplifier will transform an expression of the form`[foldr](Data-List.html#v:foldr)` k z (`[augment](GHC-Exts.html#v:augment)` g xs)
, which may arise after inlining, tog k (`[foldr](Data-List.html#v:foldr)` k z xs)
, which avoids producing an intermediate list.
Overloaded string literals
class IsString a whereSource
Class for string-like datastructures; used by the overloaded string extension (-foverloaded-strings in GHC).
Debugging
Ids with special behaviour
lazy :: a -> aSource
The call '(lazy e)' means the same as e
, but [lazy](GHC-Exts.html#v:lazy)
has a magical strictness property: it is lazy in its first argument, even though its semantics is strict.
inline :: a -> a[Source](/packages/archive///doc/html/src/GHC-Magic.html#inline)
The call '(inline f)' reduces to f
, but [inline](GHC-Exts.html#v:inline)
has a BuiltInRule that tries to inline f
(if it has an unfolding) unconditionally The NOINLINE
pragma arranges that inline only gets inlined (and hence eliminated) late in compilation, after the rule has had a good chance to fire.
Transform comprehensions
newtype Down a Source
The [Down](GHC-Exts.html#t:Down)
type allows you to reverse sort order conveniently. A value of type`[Down](GHC-Exts.html#t:Down)` a
contains a value of type a
(represented as `[Down](GHC-Exts.html#t:Down)` a
). If a
has an `[Ord](Data-Ord.html#t:Ord)`
instance associated with it then comparing two values thus wrapped will give you the opposite of their normal sort order. This is particularly useful when sorting in generalised list comprehensions, as in: then sortWith by `[Down](GHC-Exts.html#t:Down)` x
groupWith :: Ord b => (a -> b) -> [a] -> [[a]]Source
The [groupWith](GHC-Exts.html#v:groupWith)
function uses the user supplied function which projects an element out of every list element in order to first sort the input list and then to form groups by equality on these projected elements
sortWith :: Ord b => (a -> b) -> [a] -> [a]Source
The [sortWith](GHC-Exts.html#v:sortWith)
function sorts a list of elements using the user supplied function to project something out of each element
[the](GHC-Exts.html#v:the)
ensures that all the elements of the list are identical and then returns that unique element
Event logging
SpecConstr annotations
The call stack
currentCallStack :: IO [String]Source
returns a '[String]' representing the current call stack. This can be useful for debugging.
The implementation uses the call-stack simulation maintined by the profiler, so it only works if the program was compiled with -prof
and contains suitable SCC annotations (e.g. by using -fprof-auto
). Otherwise, the list returned is likely to be empty or uninformative.