Next Previous Contents

5. The GHC prelude and libraries

This document describes GHC's prelude and libraries. The basic story is that of the Haskell 1.4 Report and Libraries document (which we do not reproduce here), but this document describes in addition:

A number of the libraries that provide access to GHC's language extensions are shared by Hugs, and are described in the GHC/Hugs Extension Libraries document.

5.1 Prelude extensions

GHC's prelude contains the following non-standard extensions:

fromInt method in class Num:

It's there. Converts from an Int to the type.

toInt method in class Integral:

Converts from type type to an Int.

GHC also internally uses a number of modules that begin with the string Prel: for this reason, we don't recommend that you use any module names beginning with Prel in your own programs. The Prel modules are always available: in fact, you can get access to several extensions this way (for some you might need to give the -fglasgow-exts flag).

5.2 The module PrelGHC: really primitive stuff

This section defines all the types which are primitive in Glasgow Haskell, and the operations provided for them.

A primitive type is one which cannot be defined in Haskell, and which is therefore built into the language and compiler. Primitive types are always unboxed; that is, a value of primitive type cannot be bottom.

Primitive values are often represented by a simple bit-pattern, such as Int#, Float#, Double#. But this is not necessarily the case: a primitive value might be represented by a pointer to a heap-allocated object. Examples include Array#, the type of primitive arrays. You might think this odd: doesn't being heap-allocated mean that it has a box? No, it does not. A primitive array is heap-allocated because it is too big a value to fit in a register, and would be too expensive to copy around; in a sense, it is accidental that it is represented by a pointer. If a pointer represents a primitive value, then it really does point to that value: no unevaluated thunks, no indirections...nothing can be at the other end of the pointer than the primitive value.

This section also describes a few non-primitive types, which are needed to express the result types of some primitive operations.

Character and numeric types

There are the following obvious primitive types:

type Char#
type Int#       -- see also Word# and Addr#, later
type Float#
type Double#

If you really want to know their exact equivalents in C, see ghc/includes/StgTypes.lh in the GHC source tree.

Literals for these types may be written as follows:

1#              an Int#
1.2#            a Float#
1.34##          a Double#
'a'#            a Char#; for weird characters, use '\o<octal>'#
"a"#            an Addr# (a `char *')

Comparison operations

{>,>=,==,/=,<,<=}# :: Int# -> Int# -> Bool

{gt,ge,eq,ne,lt,le}Char# :: Char# -> Char# -> Bool
    -- ditto for Word# and Addr#

Primitive-character operations

ord# :: Char# -> Int#
chr# :: Int# -> Char#

Primitive-Int operations

{+,-,*,quotInt,remInt}# :: Int# -> Int# -> Int#
negateInt# :: Int# -> Int#

iShiftL#, iShiftRA#, iShiftRL# :: Int# -> Int# -> Int#
        -- shift left, right arithmetic, right logical

Note: No error/overflow checking!

Primitive-Double and Float operations

{+,-,*,/}##         :: Double# -> Double# -> Double#
{<,<=,==,/=,>=,>}## :: Double# -> Double# -> Bool
negateDouble#       :: Double# -> Double#
double2Int#         :: Double# -> Int#
int2Double#         :: Int#    -> Double#

{plus,minux,times,divide}Float# :: Float# -> Float# -> Float#
{gt,ge,eq,ne,lt,le}Float# :: Float# -> Float# -> Bool
negateFloat#        :: Float# -> Float#
float2Int#          :: Float# -> Int#
int2Float#          :: Int#   -> Float#

And a full complement of trigonometric functions:

expDouble#      :: Double# -> Double#
logDouble#      :: Double# -> Double#
sqrtDouble#     :: Double# -> Double#
sinDouble#      :: Double# -> Double#
cosDouble#      :: Double# -> Double#
tanDouble#      :: Double# -> Double#
asinDouble#     :: Double# -> Double#
acosDouble#     :: Double# -> Double#
atanDouble#     :: Double# -> Double#
sinhDouble#     :: Double# -> Double#
coshDouble#     :: Double# -> Double#
tanhDouble#     :: Double# -> Double#
powerDouble#    :: Double# -> Double# -> Double#

similarly for Float#.

There are two coercion functions for Float#/Double#:

float2Double#   :: Float# -> Double#
double2Float#   :: Double# -> Float#

The primitive versions of encodeDouble/decodeDouble:

encodeDouble#   :: Int# -> Int# -> ByteArray#   -- Integer mantissa
                -> Int#                         -- Int exponent
                -> Double#

decodeDouble#   :: Double# -> PrelNum.ReturnIntAndGMP

(And the same for Float#s.)

Operations on/for Integers (interface to GMP)

We implement Integers (arbitrary-precision integers) using the GNU multiple-precision (GMP) package (version 1.3.2).

Note: some of this might change when we upgrade to using GMP 2.x.

The data type for Integer must mirror that for MP_INT in gmp.h (see gmp.info in ghc/includes/runtime/gmp). It comes out as:

data Integer = J# Int# Int# ByteArray#

So, Integer is really just a ``pairing'' type for a particular collection of primitive types.

The operations in the GMP return other combinations of GMP-plus-something, so we need ``pairing'' types for those, too:

data Return2GMPs     = Return2GMPs Int# Int# ByteArray# Int# Int# ByteArray#
data ReturnIntAndGMP = ReturnIntAndGMP Int# Int# Int# ByteArray#

-- ????? something to return a string of bytes (in the heap?)

The primitive ops to support Integers use the ``pieces'' of the representation, and are as follows:

negateInteger#  :: Int# -> Int# -> ByteArray# -> Integer

{plus,minus,times}Integer# :: Int# -> Int# -> ByteArray#
                           -> Int# -> Int# -> ByteArray#
                           -> Integer

cmpInteger# :: Int# -> Int# -> ByteArray#
            -> Int# -> Int# -> ByteArray#
            -> Int# -- -1 for <; 0 for ==; +1 for >

divModInteger#, quotRemInteger#
        :: Int# -> Int# -> ByteArray#
        -> Int# -> Int# -> ByteArray#
        -> PrelNum.Return2GMPs

integer2Int# :: Int# -> Int# -> ByteArray# -> Int# 

int2Integer#  :: Int#  -> Integer -- NB: no error-checking on these two!
word2Integer# :: Word# -> Integer

addr2Integer# :: Addr# -> Integer
        -- the Addr# is taken to be a `char *' string
        -- to be converted into an Integer.

Words and addresses

A Word# is used for bit-twiddling operations. It is the same size as an Int#, but has no sign nor any arithmetic operations.

type Word#      -- Same size/etc as Int# but *unsigned*
type Addr#      -- A pointer from outside the "Haskell world" (from C, probably);
                -- described under "arrays"

Word#s and Addr#s have the usual comparison operations. Other unboxed-Word ops (bit-twiddling and coercions):

and#, or#, xor# :: Word# -> Word# -> Word#
        -- standard bit ops.

quotWord#, remWord# :: Word# -> Word# -> Word#
        -- word (i.e. unsigned) versions are different from int
        -- versions, so we have to provide these explicitly.

not# :: Word# -> Word#

shiftL#, shiftRA#, shiftRL# :: Word# -> Int# -> Word#
        -- shift left, right arithmetic, right logical

int2Word#       :: Int#  -> Word# -- just a cast, really
word2Int#       :: Word# -> Int#

Unboxed-Addr ops (C casts, really):

int2Addr#       :: Int#  -> Addr#
addr2Int#       :: Addr# -> Int#

The casts between Int#, Word# and Addr# correspond to null operations at the machine level, but are required to keep the Haskell type checker happy.

Operations for indexing off of C pointers (Addr#s) to snatch values are listed under ``arrays''.

Arrays

The type Array# elt is the type of primitive, unpointed arrays of values of type elt.

type Array# elt

Array# is more primitive than a Haskell array --- indeed, the Haskell Array interface is implemented using Array# --- in that an Array# is indexed only by Int#s, starting at zero. It is also more primitive by virtue of being unboxed. That doesn't mean that it isn't a heap-allocated object - of course, it is. Rather, being unboxed means that it is represented by a pointer to the array itself, and not to a thunk which will evaluate to the array (or to bottom). The components of an Array# are themselves boxed.

The type ByteArray# is similar to Array#, except that it contains just a string of (non-pointer) bytes.

type ByteArray#

Arrays of these types are useful when a Haskell program wishes to construct a value to pass to a C procedure. It is also possible to use them to build (say) arrays of unboxed characters for internal use in a Haskell program. Given these uses, ByteArray# is deliberately a bit vague about the type of its components. Operations are provided to extract values of type Char#, Int#, Float#, Double#, and Addr# from arbitrary offsets within a ByteArray#. (For type Foo#, the $i$th offset gets you the $i$th Foo#, not the Foo# at byte-position $i$. Mumble.) (If you want a Word#, grab an Int#, then coerce it.)

Lastly, we have static byte-arrays, of type Addr# [mentioned previously]. (Remember the duality between arrays and pointers in C.) Arrays of this types are represented by a pointer to an array in the world outside Haskell, so this pointer is not followed by the garbage collector. In other respects they are just like ByteArray#. They are only needed in order to pass values from C to Haskell.

Reading and writing

Primitive arrays are linear, and indexed starting at zero.

The size and indices of a ByteArray#, Addr#, and MutableByteArray# are all in bytes. It's up to the program to calculate the correct byte offset from the start of the array. This allows a ByteArray# to contain a mixture of values of different type, which is often needed when preparing data for and unpicking results from C. (Umm... not true of indices... WDP 95/09)

Should we provide some sizeOfDouble# constants?

Out-of-range errors on indexing should be caught by the code which uses the primitive operation; the primitive operations themselves do not check for out-of-range indexes. The intention is that the primitive ops compile to one machine instruction or thereabouts.

We use the terms ``reading'' and ``writing'' to refer to accessing mutable arrays (see Section  Mutable arrays), and ``indexing'' to refer to reading a value from an immutable array.

Immutable byte arrays are straightforward to index (all indices in bytes):

indexCharArray#   :: ByteArray# -> Int# -> Char#
indexIntArray#    :: ByteArray# -> Int# -> Int#
indexAddrArray#   :: ByteArray# -> Int# -> Addr#
indexFloatArray#  :: ByteArray# -> Int# -> Float#
indexDoubleArray# :: ByteArray# -> Int# -> Double#

indexCharOffAddr#   :: Addr# -> Int# -> Char#
indexIntOffAddr#    :: Addr# -> Int# -> Int#
indexFloatOffAddr#  :: Addr# -> Int# -> Float#
indexDoubleOffAddr# :: Addr# -> Int# -> Double#
indexAddrOffAddr#   :: Addr# -> Int# -> Addr#   
 -- Get an Addr# from an Addr# offset

The last of these, indexAddrOffAddr#, extracts an Addr# using an offset from another Addr#, thereby providing the ability to follow a chain of C pointers.

Something a bit more interesting goes on when indexing arrays of boxed objects, because the result is simply the boxed object. So presumably it should be entered --- we never usually return an unevaluated object! This is a pain: primitive ops aren't supposed to do complicated things like enter objects. The current solution is to return a lifted value, but I don't like it!

indexArray#       :: Array# elt -> Int# -> PrelBase.Lift elt  -- Yuk!

The state type

The primitive type State# represents the state of a state transformer. It is parameterised on the desired type of state, which serves to keep states from distinct threads distinct from one another. But the only effect of this parameterisation is in the type system: all values of type State# are represented in the same way. Indeed, they are all represented by nothing at all! The code generator ``knows'' to generate no code, and allocate no registers etc, for primitive states.

type State# s

The type GHC.RealWorld is truly opaque: there are no values defined of this type, and no operations over it. It is ``primitive'' in that sense - but it is not unboxed! Its only role in life is to be the type which distinguishes the IO state transformer.

data RealWorld

State of the world

A single, primitive, value of type State# RealWorld is provided.

realWorld# :: State# GHC.RealWorld

(Note: in the compiler, not a PrimOp; just a mucho magic Id. Exported from GHC, though).

State pairing types

This subsection defines some types which, while they aren't quite primitive because we can define them in Haskell, are very nearly so. They define constructors which pair a primitive state with a value of each primitive type. They are required to express the result type of the primitive operations in the state monad.

data StateAndPtr#    s elt = StateAndPtr#    (State# s) elt 

data StateAndChar#   s     = StateAndChar#   (State# s) Char# 
data StateAndInt#    s     = StateAndInt#    (State# s) Int# 
data StateAndWord#   s     = StateAndWord#   (State# s) Word#
data StateAndFloat#  s     = StateAndFloat#  (State# s) Float# 
data StateAndDouble# s     = StateAndDouble# (State# s) Double#  
data StateAndAddr#   s     = StateAndAddr#   (State# s) Addr#

data StateAndStablePtr# s a = StateAndStablePtr#  (State# s) (StablePtr# a)
data StateAndForeignObj# s  = StateAndForeignObj# (State# s) ForeignObj#
data StateAndSynchVar#  s a = StateAndSynchVar#  (State# s) (SynchVar# a)

data StateAndArray#            s elt = StateAndArray#        (State# s) (Array# elt) 
data StateAndMutableArray#     s elt = StateAndMutableArray# (State# s) (MutableArray# s elt)  
data StateAndByteArray#        s = StateAndByteArray#        (State# s) ByteArray# 
data StateAndMutableByteArray# s = StateAndMutableByteArray# (State# s) (MutableByteArray# s)

Hideous.

Mutable arrays

Corresponding to Array# and ByteArray#, we have the types of mutable versions of each. In each case, the representation is a pointer to a suitable block of (mutable) heap-allocated storage.

type MutableArray# s elt
type MutableByteArray# s

Allocation

Mutable arrays can be allocated. Only pointer-arrays are initialised; arrays of non-pointers are filled in by ``user code'' rather than by the array-allocation primitive. Reason: only the pointer case has to worry about GC striking with a partly-initialised array.

newArray#       :: Int# -> elt -> State# s -> StateAndMutableArray# s elt 

newCharArray#   :: Int# -> State# s -> StateAndMutableByteArray# s 
newIntArray#    :: Int# -> State# s -> StateAndMutableByteArray# s 
newAddrArray#   :: Int# -> State# s -> StateAndMutableByteArray# s 
newFloatArray#  :: Int# -> State# s -> StateAndMutableByteArray# s 
newDoubleArray# :: Int# -> State# s -> StateAndMutableByteArray# s 

The size of a ByteArray# is given in bytes.

Reading and writing

readArray#       :: MutableArray# s elt -> Int# -> State# s -> StateAndPtr#    s elt
readCharArray#   :: MutableByteArray# s -> Int# -> State# s -> StateAndChar#   s
readIntArray#    :: MutableByteArray# s -> Int# -> State# s -> StateAndInt#    s
readAddrArray#   :: MutableByteArray# s -> Int# -> State# s -> StateAndAddr#   s 
readFloatArray#  :: MutableByteArray# s -> Int# -> State# s -> StateAndFloat#  s 
readDoubleArray# :: MutableByteArray# s -> Int# -> State# s -> StateAndDouble# s 

writeArray#       :: MutableArray# s elt -> Int# -> elt     -> State# s -> State# s 
writeCharArray#   :: MutableByteArray# s -> Int# -> Char#   -> State# s -> State# s 
writeIntArray#    :: MutableByteArray# s -> Int# -> Int#    -> State# s -> State# s 
writeAddrArray#   :: MutableByteArray# s -> Int# -> Addr#   -> State# s -> State# s 
writeFloatArray#  :: MutableByteArray# s -> Int# -> Float#  -> State# s -> State# s 
writeDoubleArray# :: MutableByteArray# s -> Int# -> Double# -> State# s -> State# s 

Equality

One can take ``equality'' of mutable arrays. What is compared is the name or reference to the mutable array, not its contents.

sameMutableArray#     :: MutableArray# s elt -> MutableArray# s elt -> Bool
sameMutableByteArray# :: MutableByteArray# s -> MutableByteArray# s -> Bool

Freezing mutable arrays

Only unsafe-freeze has a primitive. (Safe freeze is done directly in Haskell by copying the array and then using unsafeFreeze.)

unsafeFreezeArray#     :: MutableArray# s elt -> State# s -> StateAndArray#     s elt
unsafeFreezeByteArray# :: MutableByteArray# s -> State# s -> StateAndByteArray# s

Stable pointers

A stable pointer is a name for a Haskell object which can be passed to the external world. It is ``stable'' in the sense that the name does not change when the Haskell garbage collector runs --- in contrast to the address of the object which may well change.

The stable pointer type is parameterised by the type of the thing which is named.

type StablePtr# a

A stable pointer is represented by an index into the (static) StablePointerTable. The Haskell garbage collector treats the StablePointerTable as a source of roots for GC.

The makeStablePointer function converts a value into a stable pointer. It is part of the IO monad, because we want to be sure we don't allocate one twice by accident, and then only free one of the copies.

makeStablePointer#  :: a -> State# RealWorld -> StateAndStablePtr# RealWorld a
freeStablePointer#  :: StablePtr# a -> State# RealWorld -> State# RealWorld
deRefStablePointer# :: StablePtr# a -> State# RealWorld -> StateAndPtr RealWorld a

There is also a C procedure FreeStablePtr which frees a stable pointer.

Foreign objects

A ForeignObj# is a reference to an object outside the Haskell world (i.e., from the C world, or a reference to an object on another machine completely.), where the Haskell world has been told ``Let me know when you're finished with this ...''.

type ForeignObj#

GHC provides two primitives on ForeignObj#:

makeForeignObj# 
        :: Addr# -- foreign reference
        -> Addr# -- pointer to finalisation routine
        -> StateAndForeignObj# RealWorld ForeignObj#
writeForeignObj 
        :: ForeignObj#        -- foreign object
        -> Addr#              -- datum
        -> State# RealWorld
        -> State# RealWorld

The module Foreign (Section Foreign objects) provides a more programmer-friendly interface to foreign objects.

Synchronizing variables (M-vars)

Synchronising variables are the primitive type used to implement Concurrent Haskell's MVars (see the Concurrent Haskell paper for the operational behaviour of these operations).

type SynchVar# s elt    -- primitive

newSynchVar#:: State# s -> StateAndSynchVar# s elt
takeMVar#   :: SynchVar# s elt -> State# s -> StateAndPtr# s elt
putMVar#    :: SynchVar# s elt -> State# s -> State# s

spark# primitive operation (for parallel execution)

ToDo: say something It's used in the unfolding for par.

The errorIO# primitive operation

The errorIO# primitive takes an argument much like IO. It aborts execution of the current program, and continues instead by performing the given IO-like value on the current state of the world.

errorIO# :: (State# RealWorld# -> a) -> a

5.3 GHC/Hugs Extension Libraries

The extension libraries provided by both GHC and Hugs are described in the GHC/Hugs Extension Libraries document.

5.4 GHC-only Extension Libraries

If you rely on the implicit import Prelude that GHC normally does for you, and if you don't use any weird flags (notably -fglasgow-exts), and if you don't import the Glasgow extensions interface, GlaExts, then GHC should work exactly as the Haskell report says (modulo a few minor issues, see Section Language Non-compliance).

If you turn on -fglasgow-exts, the compiler will recognise and parse unboxed values properly, and provide access to the various interfaces libraries described here.

The GlaExts interface

The GlaExts interface provides access to extensions that only GHC implements. These currently are: unboxed types, including the representations of the primitive types (Int, Float, etc.), and the GHC primitive operations (+#, ==#, etc.).

This module used to provide access to all the Glasgow extensions, but these have since been moved into separate libraries for compatibility with Hugs (version 2.09: in fact, you can still get at this stuff via GlaExts for compatibility, but this facility will likely be removed in the future).

-- the representation of some basic types:
data Char    = C# Char#
data Int     = I# Int#
data Addr    = A# Addr#
data Word    = W# Word#
data Float   = F# Float#
data Double  = D# Double#
data Integer = J# Int# Int# ByteArray#

module GHC  -- all primops and primitive types.

The MutableArray interface

The MutableArray interface defines a general set of operations over mutable arrays (MutableArray) and mutable chunks of memory (MutableByteArray):

data MutableArray s ix elt -- abstract
data MutableByteArray s ix -- abstract
                           -- instance of : CCallable
-- Creators:
newArray           :: Ix ix => (ix,ix) -> elt -> ST s (MutableArray s ix elt)
newCharArray       :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix) 
newAddrArray       :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix) 
newIntArray        :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix) 
newFloatArray      :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix) 
newDoubleArray     :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix) 

boundsOfArray      :: Ix ix => MutableArray s ix elt -> (ix, ix)  
boundsOfByteArray  :: Ix ix => MutableByteArray s ix -> (ix, ix)


readArray          :: Ix ix => MutableArray s ix elt -> ix -> ST s elt 

readCharArray      :: Ix ix => MutableByteArray s ix -> ix -> ST s Char 
readIntArray       :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
readAddrArray      :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
readFloatArray     :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
readDoubleArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s Double

writeArray         :: Ix ix => MutableArray s ix elt -> ix -> elt -> ST s () 
writeCharArray     :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s () 
writeIntArray      :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s () 
writeAddrArray     :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s () 
writeFloatArray    :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s () 
writeDoubleArray   :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s () 

freezeArray        :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
freezeCharArray    :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
freezeIntArray     :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
freezeAddrArray    :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
freezeFloatArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
freezeDoubleArray  :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)

unsafeFreezeArray     :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)  
unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
thawArray             :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)

The ByteArray interface

ByteArrays are chunks of immutable Haskell heap:

data ByteArray ix -- abstract
                  -- instance of: CCallable

indexCharArray     :: Ix ix => ByteArray ix -> ix -> Char 
indexIntArray      :: Ix ix => ByteArray ix -> ix -> Int
indexAddrArray     :: Ix ix => ByteArray ix -> ix -> Addr
indexFloatArray    :: Ix ix => ByteArray ix -> ix -> Float
indexDoubleArray   :: Ix ix => ByteArray ix -> ix -> Double

indexCharOffAddr   :: Addr -> Int -> Char
indexIntOffAddr    :: Addr -> Int -> Int
indexAddrOffAddr   :: Addr -> Int -> Addr
indexFloatOffAddr  :: Addr -> Int -> Float
indexDoubleOffAddr :: Addr -> Int -> Double

Stable pointers

Nothing exciting here, just simple boxing up.

data StablePtr a = StablePtr (StablePtr# a)

makeStablePointer :: a -> StablePtr a
freeStablePointer :: StablePtr a -> IO ()

Foreign objects

This module provides the ForeignObj type and wrappers around the primitive operations on foreign objects.

data ForeignObj = ForeignObj ForeignObj#

makeForeignObj 
        :: Addr   -- object to be boxed up as a ForeignObj
        -> Addr   -- finaliser 
        -> IO ForeignObj

writeForeignObj 
        :: ForeignObj   -- previously created foreign object
        -> Addr         -- new value
        -> IO ()

A typical use of ForeignObj is in constructing Haskell bindings to external libraries. A good example is that of writing a binding to an image-processing library (which was actually the main motivation for implementing ForeignObj's precursor, MallocPtr#). The images manipulated are not stored in the Haskell heap, either because the library insist on allocating them internally or we (sensibly) decide to spare the GC from having to heave heavy images around.

data Image = Image ForeignObj

The ForeignObj type is then used to refer to the externally allocated image, and to acheive some type safety, the Haskell binding defines the Image data type. So, a value of type ForeignObj is used to ``box'' up an external reference into a Haskell heap object that we can then indirectly reference:

createImage :: (Int,Int) -> IO Image

So far, this looks just like an Addr type, but ForeignObj offers a bit more, namely that we can specify a finalisation routine to invoke when the ForeignObj is discarded by the GC. The garbage collector invokes the finalisation routine associated with the ForeignObj, saying `` Thanks, I'm through with this now..'' For the image-processing library, the finalisation routine could for the images free up memory allocated for them. The finalisation routine has currently to be written in C (the finalisation routine can in turn call on FreeStablePtr to deallocate a stable pointer).

Associating a finalisation routine with an external object is done by calling makeForeignObj. {\bf Note:} the foreign object value and its finaliser are contained in the ForeignObj, so there's no danger of an aggressive optimiser somehow separating the two (with the result that the foreign reference would not be freed).

(Implementation: a linked list of all ForeignObj#s is maintained to allow the garbage collector to detect when a ForeignObj# becomes garbage.)

Like Array, ForeignObj#s are represented by heap objects.

Upon controlled termination of the Haskell program, all ForeignObjs are freed, invoking their respective finalisers before terminating.

The CCall module

The CCall module defines the classes CCallable and CReturnable, along with instances for the primitive types (Int, Int#, Float, Float# etc.) GHC knows to import this module if you use _ccall_, but if you need to define your own instances of these classes, you will need to import CCall explicitly.

More information on how to use _ccall_ can be found in Section Calling~C directly from Haskell.

5.5 The Posix library

The Posix interface gives you access to the set of OS services standardised by POSIX 1003.1b (or the IEEE Portable Operating System Interface for Computing Environments - IEEE Std. 1003.1). The interface is accessed by import Posix and adding -syslib posix on your command-line.

Posix data types

data ByteCount  -- instances of : Eq Ord Num Real Integral Ix Enum Show

A ByteCount is a primitive of type unsigned. At a minimum, an conforming implementation must support values in the range [0, UINT_MAX].

data ClockTick  -- instances of : Eq Ord Num Real Integral Ix Enum Show

A ClockTick is a primitive of type clock_t, which is used to measure intervals of time in fractions of a second. The resolution is determined by getSysVar ClockTick.

data DeviceID  -- instances of : Eq Ord Num Real Integral Ix Enum Show

A DeviceID is a primitive of type dev_t. It must be an arithmetic type.

data EpochTime -- instances of : Eq Ord Num Real Integral Ix Enum Show

A EpochTime is a primitive of type time_t, which is used to measure seconds since the Epoch. At a minimum, the implementation must support values in the range [0, INT_MAX].

data FileID -- instances of : Eq Ord Num Real Integral Ix Enum Show

A FileID is a primitive of type ino_t. It must be an arithmetic type.

data FileMode -- instances of : Eq Ord Num Real Integral Ix Enum Show

A FileMode is a primitive of type mode_t. It must be an arithmetic type.

data FileOffset -- instances of : Eq Ord Num Real Integral Ix Enum Show

A FileOffset is a primitive of type off_t. It must be an arithmetic type.

data GroupID -- instances of : Eq Ord Num Real Integral Ix Enum Show

A GroupID is a primitive of type gid_t. It must be an arithmetic type.

data Limit -- instances of : Eq Ord Num Real Integral Ix Enum Show

A Limit is a primitive of type long. At a minimum, the implementation must support values in the range [LONG_MIN, LONG_MAX].

data LinkCount -- instances of : Eq Ord Num Real Integral Ix Enum Show

A LinkCount is a primitive of type nlink_t. It must be an arithmetic type.

data ProcessID -- instances of : Eq Ord Num Real Integral Ix Enum Show
type ProcessGroupID = ProcessID

A ProcessID is a primitive of type pid_t. It must be a signed arithmetic type.

data UserID -- instances of : Eq Ord Num Real Integral Ix Enum Show

A UserID is a primitive of type uid_t. It must be an arithmetic type.

data DirStream
A DirStream is a primitive of type DIR *.

data FileStatus
A FileStatus is a primitive of type struct stat.

data GroupEntry

A GroupEntry is a primitive of type struct group.

data ProcessTimes

ProcessTimes is a primitive structure containing a clock_t and a struct tms.

data SignalSet

An SignalSet is a primitive of type sigset_t.

data SystemID

A SystemID is a primitive of type struct utsname.

data TerminalAttributes
TerminalAttributes is a primitive of type struct termios.

data UserEntry

A UserEntry is a primitive of type struct passwd.

data BaudRate = B0 | B50 | B75 | B110 | B134 | B150 | B200 | B300 | B600
              | B1200 | B1800 | B2400 | B4800 | B9600 | B19200 | B38400
              deriving (Eq, Show)

data Fd 

intToFd :: Int -> Fd -- use with care.

data FdOption = AppendOnWrite
              | CloseOnExec
              | NonBlockingRead

data ControlCharacter = EndOfFile
                      | EndOfLine
                      | Erase
                      | Interrupt
                      | Kill
                      | Quit
                      | Suspend
                      | Start
                      | Stop

type ErrorCode = Int

type FileLock = (LockRequest, SeekMode, FileOffset, FileOffset)
--                            whence    start       length

data FlowAction = SuspendOutput | RestartOutput | TransmitStop | TransmitStart

data Handler = Default | Ignore | Catch (IO ())

data LockRequest = ReadLock | WriteLock | Unlock
                 deriving (Eq, Show)

data OpenMode = ReadOnly | WriteOnly | ReadWrite

data PathVar = LinkLimit
             | InputLineLimit
             | InputQueueLimit
             | FileNameLimit
             | PathNameLimit
             | PipeBufferLimit
             | SetOwnerAndGroupIsRestricted
             | FileNamesAreNotTruncated

data QueueSelector = InputQueue | OutputQueue | BothQueues

type Signal = Int

data SysVar = ArgumentLimit
            | ChildLimit
            | ClockTick
            | GroupLimit
            | OpenFileLimit
            | PosixVersion
            | HasSavedIDs
            | HasJobControl

data TerminalMode = InterruptOnBreak       -- BRKINT
                | MapCRtoLF                -- ICRNL
                | IgnoreBreak              -- IGNBRK
                | IgnoreCR                 -- IGNCR
                | IgnoreParityErrors       -- IGNPAR
                | MapLFtoCR                -- INLCR
                | CheckParity              -- INPCK
                | StripHighBit             -- ISTRIP
                | StartStopInput           -- IXOFF
                | StartStopOutput          -- IXON
                | MarkParityErrors         -- PARMRK
                | ProcessOutput            -- OPOST
                | LocalMode                -- CLOCAL
                | ReadEnable               -- CREAD
                | TwoStopBits              -- CSTOPB
                | HangupOnClose            -- HUPCL
                | EnableParity             -- PARENB
                | OddParity                -- PARODD
                | EnableEcho               -- ECHO
                | EchoErase                -- ECHOE
                | EchoKill                 -- ECHOK
                | EchoLF                   -- ECHONL
                | ProcessInput             -- ICANON
                | ExtendedFunctions        -- IEXTEN
                | KeyboardInterrupts       -- ISIG
                | NoFlushOnInterrupt       -- NOFLSH
                | BackgroundWriteInterrupt -- TOSTOP

data TerminalState = Immediately | WhenDrained | WhenFlushed

data ProcessStatus = Exited ExitCode 
                   | Terminated Signal 
                   | Stopped Signal
                   deriving (Eq, Show)

Posix Process Primitives

forkProcess :: IO (Maybe ProcessID)

forkProcess calls fork, returning Just pid to the parent, where pid is the ProcessID of the child, and returning Nothing to the child.

executeFile :: FilePath                   -- Command
            -> Bool                       -- Search PATH?
            -> [String]                   -- Arguments
            -> Maybe [(String, String)]   -- Environment
            -> IO ()

executeFile cmd args env calls one of the execv* family, depending on whether or not the current PATH is to be searched for the command, and whether or not an environment is provided to supersede the process's current environment. The basename (leading directory names suppressed) of the command is passed to execv* as arg[0]; the argument list passed to executeFile therefore begins with arg[1].

Search PATH?    Supersede environ?      Call
~~~~~~~~~~~~    ~~~~~~~~~~~~~~~~~~      ~~~~~~~
False           False                   execv
False           True                    execve
True            False                   execvp
True            True                    execvpe*

Note that execvpe is not provided by the POSIX standard, and must be written by hand. Care must be taken to ensure that the search path is extracted from the original environment, and not from the environment to be passed on to the new image.

A successful executeFile overlays the current process image with a new one, so it only returns on failure.

runProcess :: FilePath                    -- Command
           -> [String]                    -- Arguments
           -> Maybe [(String, String)]    -- Environment (Nothing -> Inherited)
           -> Maybe FilePath              -- Working directory (Nothing -> inherited)
           -> Maybe Handle                -- stdin  (Nothing -> inherited)
           -> Maybe Handle                -- stdout (Nothing -> inherited)
           -> Maybe Handle                -- stderr (Nothing -> inherited)
           -> IO ()

runProcess is our candidate for the high-level OS-independent primitive.

runProcess cmd args env wd inhdl outhdl errhdl runs cmd (searching the current PATH) with arguments args. If env is Just pairs, the command is executed with the environment specified by pairs of variables and values; otherwise, the command is executed with the current environment. If wd is Just dir, the command is executed with working directory dir; otherwise, the command is executed in the current working directory. If {in,out,errhdl} is Just handle, the command is executed with the Fd for std{in,out,err} attached to the specified handle; otherwise, the Fd for std{in,out,err} is left unchanged.

getProcessStatus :: Bool              -- Block?
                 -> Bool              -- Stopped processes?
                 -> ProcessID 
                 -> IO (Maybe ProcessStatus)

getProcessStatus blk stopped pid calls waitpid, returning Just tc, the ProcessStatus for process pid if it is available, Nothing otherwise. If blk is False, then WNOHANG is set in the options for waitpid, otherwise not. If stopped is True, then WUNTRACED is set in the options for waitpid, otherwise not.

getGroupProcessStatus :: Bool         -- Block?
                      -> Bool         -- Stopped processes?
                      -> ProcessGroupID 
                      -> IO (Maybe (ProcessID, ProcessStatus))

getGroupProcessStatus blk stopped pgid calls waitpid, returning Just (pid, tc), the ProcessID and ProcessStatus for any process in group pgid if one is available, Nothing otherwise. If blk is False, then WNOHANG is set in the options for waitpid, otherwise not. If stopped is True, then WUNTRACED is set in the options for waitpid, otherwise not.

getAnyProcessStatus :: Bool           -- Block?
                    -> Bool           -- Stopped processes?
                    -> IO (Maybe (ProcessID, ProcessStatus))

getAnyProcessStatus blk stopped calls waitpid, returning Just (pid, tc), the ProcessID and ProcessStatus for any child process if one is available, Nothing otherwise. If blk is False, then WNOHANG is set in the options for waitpid, otherwise not. If stopped is True, then WUNTRACED is set in the options for waitpid, otherwise not.

exitImmediately :: ExitCode -> IO ()

exitImmediately status calls _exit to terminate the process with the indicated exit status. The operation never returns.

getEnvironment :: IO [(String, String)]

getEnvironment parses the environment variable mapping provided by environ, returning (variable, value) pairs. The operation never fails.

setEnvironment :: [(String, String)] -> IO ()

setEnvironment replaces the process environment with the provided mapping of (variable, value) pairs.

getEnvVar :: String -> IO String

getEnvVar var returns the value associated with variable var in the current environment (identical functionality provided through standard Haskell library function System.getEnv).

The operation may fail with:

NoSuchThing

The variable has no mapping in the current environment.

setEnvVar :: String -> String -> IO ()

setEnvVar var val sets the value associated with variable var in the current environment to be val. Any previous mapping is superseded.

removeEnvVar :: String -> IO ()

removeEnvVar var removes any value associated with variable var in the current environment. Deleting a variable for which there is no mapping does not generate an error.

nullSignal :: Signal
nullSignal = 0

backgroundRead, sigTTIN        :: Signal
backgroundWrite, sigTTOU       :: Signal
continueProcess, sigCONT       :: Signal
floatingPointException, sigFPE :: Signal
illegalInstruction, sigILL     :: Signal
internalAbort, sigABRT         :: Signal
keyboardSignal, sigINT         :: Signal
keyboardStop, sigTSTP          :: Signal
keyboardTermination, sigQUIT   :: Signal
killProcess, sigKILL           :: Signal
lostConnection, sigHUP         :: Signal
openEndedPipe, sigPIPE         :: Signal
processStatusChanged, sigCHLD  :: Signal
realTimeAlarm, sigALRM         :: Signal
segmentationViolation, sigSEGV :: Signal
softwareStop, sigSTOP          :: Signal
softwareTermination, sigTERM   :: Signal
userDefinedSignal1, sigUSR1    :: Signal
userDefinedSignal2, sigUSR2    :: Signal

signalProcess :: Signal -> ProcessID -> IO ()

signalProcess int pid calls kill to signal process pid with interrupt signal int.

raiseSignal :: Signal -> IO ()

raiseSignal int calls kill to signal the current process with interrupt signal int.

signalProcessGroup :: Signal -> ProcessGroupID -> IO ()

signalProcessGroup int pgid calls kill to signal all processes in group pgid with interrupt signal int.

setStoppedChildFlag :: Bool -> IO Bool

setStoppedChildFlag bool sets a flag which controls whether or not the NOCLDSTOP option will be used the next time a signal handler is installed for SIGCHLD. If bool is True (the default), NOCLDSTOP will not be used; otherwise it will be. The operation never fails.

queryStoppedChildFlag :: IO Bool

queryStoppedChildFlag queries the flag which controls whether or not the NOCLDSTOP option will be used the next time a signal handler is installed for SIGCHLD. If NOCLDSTOP will be used, it returns False; otherwise (the default) it returns True. The operation never fails.

emptySignalSet :: SignalSet
fullSignalSet  :: SignalSet
addSignal      :: Signal -> SignalSet -> SignalSet
deleteSignal   :: Signal -> SignalSet -> SignalSet
inSignalSet    :: Signal -> SignalSet -> Bool

installHandler :: Signal
               -> Handler 
               -> Maybe SignalSet       -- other signals to block
               -> IO Handler            -- old handler

installHandler int handler iset calls sigaction to install an interrupt handler for signal int. If handler is Default, SIG_DFL is installed; if handler is Ignore, SIG_IGN is installed; if handler is Catch action, a handler is installed which will invoke action as a replacement for main. If iset is Just s, then the sa_mask of the sigaction structure is set to s; otherwise it is cleared. The previously installed signal handler for int is returned.

getSignalMask :: IO SignalSet

getSignalMask calls sigprocmask to determine the set of interrupts which are currently being blocked.

setSignalMask :: SignalSet -> IO SignalSet

setSignalMask mask calls sigprocmask with SIG_SETMASK to block all interrupts in mask. The previous set of blocked interrupts is returned.

blockSignals :: SignalSet -> IO SignalSet

setSignalMask mask calls sigprocmask with SIG_BLOCK to add all interrupts in mask to the set of blocked interrupts. The previous set of blocked interrupts is returned.

unBlockSignals :: SignalSet -> IO SignalSet

setSignalMask mask calls sigprocmask with SIG_UNBLOCK to remove all interrupts in mask from the set of blocked interrupts. The previous set of blocked interrupts is returned.

getPendingSignals :: IO SignalSet

getPendingSignals calls sigpending to obtain the set of interrupts which have been received but are currently blocked.

awaitSignal :: Maybe SignalSet -> IO ()

awaitSignal iset suspends execution until an interrupt is received. If iset is Just s, awaitSignal calls sigsuspend, installing s as the new signal mask before suspending execution; otherwise, it calls pause. If successful, awaitSignal does not return.

scheduleAlarm :: Int -> IO Int

scheduleAlarm i calls alarm to schedule a real time alarm at least i seconds in the future.

sleep :: Int -> IO ()

sleep i calls sleep to suspend execution of the program until at least i seconds have elapsed or a signal is received.

Posix Process Environment

getProcessID :: IO ProcessID

getProcessID calls getpid to obtain the ProcessID for the current process.

getParentProcessID :: IO ProcessID

getProcessID calls getppid to obtain the ProcessID for the parent of the current process.

getRealUserID :: IO UserID

getRealUserID calls getuid to obtain the real UserID associated with the current process.

getEffectiveUserID :: IO UserID

getRealUserID calls geteuid to obtain the effective UserID associated with the current process.

setUserID :: UserID -> IO ()

setUserID uid calls setuid to set the real, effective, and saved set-user-id associated with the current process to uid.

getLoginName :: IO String

getLoginName calls getlogin to obtain the login name associated with the current process.

getRealGroupID :: IO GroupID

getRealGroupID calls getgid to obtain the real GroupID associated with the current process.

getEffectiveGroupID :: IO GroupID

getEffectiveGroupID calls getegid to obtain the effective GroupID associated with the current process.

setGroupID :: GroupID -> IO ()

setGroupID gid calls setgid to set the real, effective, and saved set-group-id associated with the current process to gid.

getGroups :: IO [GroupID]

getGroups calls getgroups to obtain the list of supplementary GroupIDs associated with the current process.

getEffectiveUserName :: IO String

getEffectiveUserName calls cuserid to obtain a name associated with the effective UserID of the process.

getProcessGroupID :: IO ProcessGroupID

getProcessGroupID calls getpgrp to obtain the ProcessGroupID for the current process.

createProcessGroup :: ProcessID -> IO ProcessGroupID

createProcessGroup pid calls setpgid to make process pid a new process group leader.

joinProcessGroup :: ProcessGroupID -> IO ProcessGroupID

joinProcessGroup pgid calls setpgid to set the ProcessGroupID of the current process to pgid.

setProcessGroupID :: ProcessID -> ProcessGroupID -> IO ()

setProcessGroupID pid pgid calls setpgid to set the ProcessGroupID for process pid to pgid.

createSession :: IO ProcessGroupID

createSession calls setsid to create a new session with the current process as session leader.

systemName :: SystemID -> String
nodeName :: SystemID -> String
release :: SystemID -> String
version :: SystemID -> String
machine :: SystemID -> String

getSystemID :: IO SystemID

getSystemID calls uname to obtain information about the current operating system.

> epochTime :: IO EpochTime

epochTime calls time to obtain the number of seconds that have elapsed since the epoch (Jan 01 00:00:00 GMT 1970).

elapsedTime     :: ProcessTimes -> ClockTick
userTime        :: ProcessTimes -> ClockTick
systemTime      :: ProcessTimes -> ClockTick
childUserTime   :: ProcessTimes -> ClockTick
childSystemTime :: ProcessTimes -> ClockTick

getProcessTimes :: IO ProcessTimes

getProcessTimes calls times to obtain time-accounting information for the current process and its children.

getControllingTerminalName :: IO FilePath

getControllingTerminalName calls ctermid to obtain a name associated with the controlling terminal for the process. If a controlling terminal exists, getControllingTerminalName returns the name of the controlling terminal.

The operation may fail with:

NoSuchThing

There is no controlling terminal, or its name cannot be determined.

SystemError

Various other causes.

getTerminalName :: Fd -> IO FilePath

getTerminalName fd calls ttyname to obtain a name associated with the terminal for Fd fd. If fd is associated with a terminal, getTerminalName returns the name of the terminal.

The operation may fail with:

InappropriateType

The channel is not associated with a terminal.

NoSuchThing

The channel is associated with a terminal, but it has no name.

SystemError

Various other causes.

queryTerminal :: Fd -> IO Bool

queryTerminal fd calls isatty to determine whether or not Fd fd is associated with a terminal.

getSysVar :: SysVar -> IO Limit

getSysVar var calls sysconf to obtain the dynamic value of the requested configurable system limit or option. For defined system limits, getSysVar returns the associated value. For defined system options, the result of getSysVar is undefined, but not failure.

The operation may fail with:

NoSuchThing

The requested system limit or option is undefined.

Posix operations on files and directories

openDirStream :: FilePath -> IO DirStream

openDirStream dir calls opendir to obtain a directory stream for dir.

readDirStream :: DirStream -> IO String

readDirStream dp calls readdir to obtain the next directory entry (struct dirent) for the open directory stream dp, and returns the d_name member of that structure.

The operation may fail with:

EOF

End of file has been reached.

SystemError

Various other causes.

rewindDirStream :: DirStream -> IO ()

rewindDirStream dp calls rewinddir to reposition the directory stream dp at the beginning of the directory.

closeDirStream :: DirStream -> IO ()

closeDirStream dp calls closedir to close the directory stream dp.

getWorkingDirectory :: IO FilePath

getWorkingDirectory calls getcwd to obtain the name of the current working directory.

changeWorkingDirectory :: FilePath -> IO ()

changeWorkingDirectory dir calls chdir to change the current working directory to dir.

nullFileMode       :: FileMode       -- ---------
ownerReadMode      :: FileMode       -- r--------
ownerWriteMode     :: FileMode       -- -w-------
ownerExecuteMode   :: FileMode       -- --x------
groupReadMode      :: FileMode       -- ---r-----
groupWriteMode     :: FileMode       -- ----w----
groupExecuteMode   :: FileMode       -- -----x---
otherReadMode      :: FileMode       -- ------r--
otherWriteMode     :: FileMode       -- -------w-
otherExecuteMode   :: FileMode       -- --------x
setUserIDMode      :: FileMode       -- --S------
setGroupIDMode     :: FileMode       -- -----S---
                               
stdFileMode        :: FileMode       -- rw-rw-rw-
                               
ownerModes         :: FileMode       -- rwx------
groupModes         :: FileMode       -- ---rwx---
otherModes         :: FileMode       -- ------rwx
accessModes        :: FileMode       -- rwxrwxrwx

unionFileModes     :: FileMode -> FileMode -> FileMode
intersectFileModes :: FileMode -> FileMode -> FileMode

stdInput  :: Fd
stdInput  = intToFd 0

stdOutput :: Fd
stdOutput = intToFd 1

stdError  :: Fd
stdError  = intToFd 2

data OpenFileFlags =
 OpenFileFlags {
    append    :: Bool,
    exclusive :: Bool,
    noctty    :: Bool,
    nonBlock  :: Bool,
    trunc     :: Bool
 }

openFd :: FilePath
       -> OpenMode
       -> Maybe FileMode  -- Just x => O_CREAT, Nothing => must exist
       -> OpenFileFlags
       -> IO Fd

openFd path acc mode (OpenFileFlags app excl noctty nonblock trunc) calls open to obtain a Fd for the file path with access mode acc. If mode is Just m, the O_CREAT flag is set and the file's permissions will be based on m if it does not already exist; otherwise, the O_CREAT flag is not set. The arguments app, excl, noctty, nonblock, and trunc control whether or not the flags O_APPEND, O_EXCL, O_NOCTTY, O_NONBLOCK, and O_TRUNC are set, respectively.

createFile :: FilePath -> FileMode -> IO Fd

createFile path mode calls creat to obtain a Fd for file path, which will be created with permissions based on mode if it does not already exist.

setFileCreationMask :: FileMode -> IO FileMode

setFileCreationMask mode calls umask to set the process's file creation mask to mode. The previous file creation mask is returned.

createLink :: FilePath -> FilePath -> IO ()

createLink old new calls link to create a new path, new, linked to an existing file, old.

createDirectory :: FilePath -> FileMode -> IO ()

createDirectory dir mode calls mkdir to create a new directory, dir, with permissions based on mode.

createNamedPipe :: FilePath -> FileMode -> IO ()

createNamedPipe fifo mode calls mkfifo to create a new named pipe, fifo, with permissions based on mode.

removeLink :: FilePath -> IO ()

removeLink path calls unlink to remove the link named path.

removeDirectory :: FilePath -> IO ()

removeDirectory dir calls rmdir to remove the directory named dir.

rename :: FilePath -> FilePath -> IO ()

rename old new calls rename to rename a file or directory from old to new.

fileMode          :: FileStatus -> FileMode
                   
fileID            :: FileStatus -> FileID
deviceID          :: FileStatus -> DeviceID
                   
linkCount         :: FileStatus -> LinkCount
                   
fileOwner         :: FileStatus -> UserID
fileGroup         :: FileStatus -> GroupID
fileSize          :: FileStatus -> FileOffset

accessTime        :: FileStatus -> EpochTime
modificationTime  :: FileStatus -> EpochTime
statusChangeTime  :: FileStatus -> EpochTime

isDirectory       :: FileStatus -> Bool
isCharacterDevice :: FileStatus -> Bool
isBlockDevice     :: FileStatus -> Bool
isRegularFile     :: FileStatus -> Bool
isNamedPipe       :: FileStatus -> Bool

getFileStatus     :: FilePath -> IO FileStatus

getFileStatus path calls stat to get the FileStatus information for the file path.

getFdStatus :: Fd -> IO FileStatus

getFdStatus fd calls fstat to get the FileStatus information for the file associated with Fd fd.

queryAccess :: FilePath -> Bool -> Bool -> Bool -> IO Bool

queryAccess path r w x calls access to test the access permissions for file path. The three arguments, r, w, and x control whether or not access is called with R_OK, W_OK, and X_OK respectively.

queryFile :: FilePath -> IO Bool

queryFile path calls access with F_OK to test for the existence for file path.

setFileMode :: FilePath -> FileMode -> IO ()

setFileMode path mode calls chmod to set the permission bits associated with file path to mode.

setOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()

setOwnerAndGroup path uid gid calls chown to set the UserID and GroupID associated with file path to uid and gid, respectively.

setFileTimes :: FilePath -> EpochTime -> EpochTime -> IO ()

setFileTimes path atime mtime calls utime to set the access and modification times associated with file path to atime and mtime, respectively.

touchFile :: FilePath -> IO ()

touchFile path calls utime to set the access and modification times associated with file path to the current time.

getPathVar :: PathVar -> FilePath -> IO Limit

getPathVar var path calls pathconf to obtain the dynamic value of the requested configurable file limit or option associated with file or directory path. For defined file limits, getPathVar returns the associated value. For defined file options, the result of getPathVar is undefined, but not failure. The operation may fail with:

NoSuchThing

The requested file limit or option is undefined.

SystemError

Various other causes.

getFdVar :: PathVar -> Fd -> IO Limit

getFdVar var fd calls fpathconf to obtain the dynamic value of the requested configurable file limit or option associated with the file or directory attached to the open channel fd. For defined file limits, getFdVar returns the associated value. For defined file options, the result of getFdVar is undefined, but not failure.

The operation may fail with:

NoSuchThing

The requested file limit or option is undefined.

SystemError

Various other causes.

Posix Input and Output Primitives

createPipe :: IO (Fd, Fd)

createPipe calls pipe to create a pipe and returns a pair of Fds, the first for writing and the second for reading.

dup :: Fd -> IO Fd

dup fd calls dup to duplicate Fd fd to another Fd.

dupTo :: Fd -> Fd -> IO ()

dupTo src dst calls dup2 to duplicate Fd src to Fd dst.

fdClose :: Fd -> IO ()

fdClose fd calls close to close Fd fd.

fdRead :: Fd -> ByteCount -> IO (String, ByteCount)

fdRead fd nbytes calls read to read at most nbytes bytes from Fd fd, and returns the result as a string paired with the number of bytes actually read.

The operation may fail with:

EOF

End of file has been reached.

SystemError

Various other causes.

fdWrite :: Fd -> String -> IO ByteCount

fdWrite fd s calls write to write the string s to Fd fd as a contiguous sequence of bytes. It returns the number of bytes successfully written.

queryFdOption :: FdOption -> Fd -> IO Bool

getFdOption opt fd calls fcntl to determine whether or not the flag associated with FdOption opt is set for Fd fd.

setFdOption :: Fd -> FdOption -> Bool -> IO ()

setFdOption fd opt val calls fcntl to set the flag associated with FdOption opt on Fd fd to val.

getLock :: Fd -> FileLock -> IO (Maybe (ProcessID, FileLock))

getLock fd lock calls fcntl to get the first FileLock for Fd fd which blocks the FileLock lock. If no such FileLock exists, getLock returns Nothing. Otherwise, it returns Just (pid, block), where block is the blocking FileLock and pid is the ProcessID of the process holding the blocking FileLock.

setLock :: Fd -> FileLock -> IO ()

setLock fd lock calls fcntl with F_SETLK to set or clear a lock segment for Fd fd as indicated by the FileLock lock. setLock does not block, but fails with SystemError if the request cannot be satisfied immediately.

waitToSetLock :: Fd -> FileLock -> IO ()

waitToSetLock fd lock calls fcntl with F_SETLKW to set or clear a lock segment for Fd fd as indicated by the FileLock lock. If the request cannot be satisfied immediately, waitToSetLock blocks until the request can be satisfied.

fdSeek :: Fd -> SeekMode -> FileOffset -> IO FileOffset

fdSeek fd whence offset calls lseek to position the Fd fd at the given offset from the starting location indicated by whence. It returns the resulting offset from the start of the file in bytes.

Posix, Device- and Class-Specific Functions

terminalMode    :: TerminalMode -> TerminalAttributes -> Bool
withMode        :: TerminalAttributes -> TerminalMode -> TerminalAttributes
withoutMode     :: TerminalAttributes -> TerminalMode -> TerminalAttributes

bitsPerByte     :: TerminalAttributes -> Int
withBits        :: TerminalAttributes -> Int -> TerminalAttributes

controlChar     :: TerminalAttributes -> ControlCharacter -> Maybe Char
withCC          :: TerminalAttributes
                -> (ControlCharacter, Char)
                -> TerminalAttributes 
withoutCC       :: TerminalAttributes 
                -> ControlCharacter 
                -> TerminalAttributes
                  
inputTime       :: TerminalAttributes -> Int
withTime        :: TerminalAttributes -> Int -> TerminalAttributes
                  
minInput        :: TerminalAttributes -> Int
withMinInput    :: TerminalAttributes -> Int -> TerminalAttributes
                  
inputSpeed      :: TerminalAttributes -> BaudRate
withInputSpeed  :: TerminalAttributes -> BaudRate -> TerminalAttributes
                  
outputSpeed     :: TerminalAttributes -> BaudRate
withOutputSpeed :: TerminalAttributes -> BaudRate -> TerminalAttributes

getTerminalAttributes :: Fd -> IO TerminalAttributes

getTerminalAttributes fd calls tcgetattr to obtain the TerminalAttributes associated with Fd fd.

setTerminalAttributes :: Fd
                      -> TerminalAttributes 
                      -> TerminalState
                      -> IO ()

setTerminalAttributes fd attr ts calls tcsetattr to change the TerminalAttributes associated with Fd fd to attr, when the terminal is in the state indicated by ts.

sendBreak :: Fd -> Int -> IO ()

sendBreak fd duration calls tcsendbreak to transmit a continuous stream of zero-valued bits on Fd fd for the specified implementation-dependent duration.

drainOutput :: Fd -> IO ()

drainOutput fd calls tcdrain to block until all output written to Fd fd has been transmitted.

discardData :: Fd -> QueueSelector -> IO ()

discardData fd queues calls tcflush to discard pending input and/or output for Fd fd, as indicated by the QueueSelector queues.

controlFlow :: Fd -> FlowAction -> IO ()

controlFlow fd action calls tcflow to control the flow of data on Fd fd, as indicated by action.

getTerminalProcessGroupID :: Fd -> IO ProcessGroupID

getTerminalProcessGroupID fd calls tcgetpgrp to obtain the ProcessGroupID of the foreground process group associated with the terminal attached to Fd fd.

setTerminalProcessGroupID :: Fd -> ProcessGroupID -> IO ()

setTerminalProcessGroupID fd pgid calls tcsetpgrp to set the ProcessGroupID of the foreground process group associated with the terminal attached to Fd fd to pgid.

Posix System Databases

groupName    :: GroupEntry -> String
groupID      :: GroupEntry -> GroupID
groupMembers :: GroupEntry -> [String]

getGroupEntryForID :: GroupID -> IO GroupEntry

getGroupEntryForID gid calls getgrgid to obtain the GroupEntry information associated with GroupID gid.

The operation may fail with:

NoSuchThing

There is no group entry for the GroupID.

getGroupEntryForName :: String -> IO GroupEntry

getGroupEntryForName name calls getgrnam to obtain the GroupEntry information associated with the group called name.

The operation may fail with:

NoSuchThing

There is no group entry for the name.

userName      :: UserEntry -> String
userID        :: UserEntry -> UserID
userGroupID   :: UserEntry -> GroupID
homeDirectory :: UserEntry -> String
userShell     :: UserEntry -> String

getUserEntryForID :: UserID -> IO UserEntry

getUserEntryForID gid calls getpwuid to obtain the UserEntry information associated with UserID uid. The operation may fail with:

NoSuchThing

There is no user entry for the UserID.

getUserEntryForName :: String -> IO UserEntry

getUserEntryForName name calls getpwnam to obtain the UserEntry information associated with the user login name.

The operation may fail with:

NoSuchThing

There is no user entry for the name.

POSIX Errors

getErrorCode :: IO ErrorCode

getErrorCode returns the current value of the external variable errno. It never fails.

setErrorCode :: ErrorCode -> IO ()

setErrorCode err sets the external variable errno to err. It never fails.

noError :: ErrorCode
noError = 0

argumentListTooLong, e2BIG              :: ErrorCode
badFd, eBADF                            :: ErrorCode
brokenPipe, ePIPE                       :: ErrorCode
directoryNotEmpty, eNOTEMPTY            :: ErrorCode
execFormatError, eNOEXEC                :: ErrorCode
fileAlreadyExists, eEXIST               :: ErrorCode
fileTooLarge, eFBIG                     :: ErrorCode
filenameTooLong, eNAMETOOLONG           :: ErrorCode
improperLink, eXDEV                     :: ErrorCode
inappropriateIOControlOperation, eNOTTY :: ErrorCode
inputOutputError, eIO                   :: ErrorCode
interruptedOperation, eINTR             :: ErrorCode
invalidArgument, eINVAL                 :: ErrorCode
invalidSeek, eSPIPE                     :: ErrorCode
isADirectory, eISDIR                    :: ErrorCode
noChildProcess, eCHILD                  :: ErrorCode
noLocksAvailable, eNOLCK                :: ErrorCode
noSpaceLeftOnDevice, eNOSPC             :: ErrorCode
noSuchOperationOnDevice, eNODEV         :: ErrorCode
noSuchDeviceOrAddress, eNXIO            :: ErrorCode
noSuchFileOrDirectory, eNOENT           :: ErrorCode
noSuchProcess, eSRCH                    :: ErrorCode
notADirectory, eNOTDIR                  :: ErrorCode
notEnoughMemory, eNOMEM                 :: ErrorCode
operationNotImplemented, eNOSYS         :: ErrorCode
operationNotPermitted, ePERM            :: ErrorCode
permissionDenied, eACCES                :: ErrorCode
readOnlyFileSystem, eROFS               :: ErrorCode
resourceBusy, eBUSY                     :: ErrorCode
resourceDeadlockAvoided, eDEADLK        :: ErrorCode
resourceTemporarilyUnavailable, eAGAIN  :: ErrorCode
tooManyLinks, eMLINK                    :: ErrorCode
tooManyOpenFiles, eMFILE                :: ErrorCode
tooManyOpenFilesInSystem, eNFILE        :: ErrorCode

5.6 Miscellaneous libraries

This section describes a collection of Haskell libraries we've collected over the years. Access to any of these modules is provided by giving the -syslib misc .

The Bag type

A bag is an unordered collection of elements which may contain duplicates. To use, import Bag.

data Bag elt    -- abstract

emptyBag        :: Bag elt
unitBag         :: elt -> Bag elt

consBag         :: elt       -> Bag elt -> Bag elt
snocBag         :: Bag elt   -> elt     -> Bag elt

unionBags       :: Bag elt   -> Bag elt -> Bag elt
unionManyBags   :: [Bag elt] -> Bag elt

isEmptyBag      :: Bag elt   -> Bool
elemBag         :: Eq elt => elt -> Bag elt -> Bool

filterBag       :: (elt -> Bool) -> Bag elt -> Bag elt
partitionBag    :: (elt -> Bool) -> Bag elt-> (Bag elt, Bag elt)
        -- returns the elements that do/don't satisfy the predicate

concatBag       :: Bag (Bag a) -> Bag a 
foldBag         :: (r -> r -> r) -> (a -> r) -> r -> Bag a -> r
mapBag          :: (a -> b) -> Bag a -> Bag b

listToBag       :: [elt] -> Bag elt
bagToList       :: Bag elt -> [elt]

The FiniteMap type

What functional programmers call a finite map, everyone else calls a lookup table.

Out code is derived from that in this paper:

S Adams "Efficient sets: a balancing act" Journal of functional programming 3(4) Oct 1993, pages 553-562
Guess what? The implementation uses balanced trees.

data FiniteMap key elt  -- abstract

--      BUILDING
emptyFM         :: FiniteMap key elt
unitFM          :: key -> elt -> FiniteMap key elt
listToFM        :: Ord key => [(key,elt)] -> FiniteMap key elt
                        -- In the case of duplicates, the last is taken

--      ADDING AND DELETING
                   -- Throws away any previous binding
                   -- In the list case, the items are added starting with the
                   -- first one in the list
addToFM         :: Ord key => FiniteMap key elt -> key -> elt  -> FiniteMap key elt
addListToFM     :: Ord key => FiniteMap key elt -> [(key,elt)] -> FiniteMap key elt

                 -- Combines with previous binding
                 -- In the combining function, the first argument is
                 -- the "old" element, while the second is the "new" one.
addToFM_C       :: Ord key => (elt -> elt -> elt)
                           -> FiniteMap key elt -> key -> elt  
                           -> FiniteMap key elt
addListToFM_C   :: Ord key => (elt -> elt -> elt)
                           -> FiniteMap key elt -> [(key,elt)] 
                           -> FiniteMap key elt

                 -- Deletion doesn't complain if you try to delete something
                 -- which isn't there
delFromFM       :: Ord key => FiniteMap key elt -> key   -> FiniteMap key elt
delListFromFM   :: Ord key => FiniteMap key elt -> [key] -> FiniteMap key elt

--      COMBINING
                 -- Bindings in right argument shadow those in the left
plusFM          :: Ord key => FiniteMap key elt -> FiniteMap key elt
                           -> FiniteMap key elt

                   -- Combines bindings for the same thing with the given function
plusFM_C        :: Ord key => (elt -> elt -> elt) 
                           -> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt

minusFM         :: Ord key => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
                   -- (minusFM a1 a2) deletes from a1 any bindings which are bound in a2

intersectFM     :: Ord key => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt 
intersectFM_C   :: Ord key => (elt -> elt -> elt)
                           -> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt 

--      MAPPING, FOLDING, FILTERING
foldFM          :: (key -> elt -> a -> a) -> a -> FiniteMap key elt -> a
mapFM           :: (key -> elt1 -> elt2) -> FiniteMap key elt1 -> FiniteMap key elt2
filterFM        :: Ord key => (key -> elt -> Bool) 
                           -> FiniteMap key elt -> FiniteMap key elt

--      INTERROGATING
sizeFM          :: FiniteMap key elt -> Int
isEmptyFM       :: FiniteMap key elt -> Bool

elemFM          :: Ord key => key -> FiniteMap key elt -> Bool
lookupFM        :: Ord key => FiniteMap key elt -> key -> Maybe elt
lookupWithDefaultFM
                :: Ord key => FiniteMap key elt -> elt -> key -> elt
                -- lookupWithDefaultFM supplies a "default" elt
                -- to return for an unmapped key

--      LISTIFYING
fmToList        :: FiniteMap key elt -> [(key,elt)]
keysFM          :: FiniteMap key elt -> [key]
eltsFM          :: FiniteMap key elt -> [elt]

The ListSetOps type

Just a few set-sounding operations on lists. If you want sets, use the Set module.

unionLists          :: Eq a => [a] -> [a] -> [a]
intersectLists      :: Eq a => [a] -> [a] -> [a]
minusList           :: Eq a => [a] -> [a] -> [a]
disjointLists       :: Eq a => [a] -> [a] -> Bool
intersectingLists   :: Eq a => [a] -> [a] -> Bool

The Maybes type

The Maybe type is in the Haskell 1.4 prelude. Moreover, the required Maybe library provides many useful functions on Maybes. This (pre-1.3) module provides some more:

An Either-like type called MaybeErr:

data MaybeErr val err = Succeeded val | Failed err

Some operations to do with Maybe (some commentary follows):

maybeToBool :: Maybe a -> Bool      -- Nothing => False; Just => True
allMaybes   :: [Maybe a] -> Maybe [a]
firstJust   :: [Maybe a] -> Maybe a
findJust    :: (a -> Maybe b) -> [a] -> Maybe b

assocMaybe  :: Eq a => [(a,b)] -> a -> Maybe b
mkLookupFun :: (key -> key -> Bool) -- Equality predicate
            -> [(key,val)]          -- The assoc list
            -> (key -> Maybe val)   -- A lookup fun to use
mkLookupFunDef :: (key -> key -> Bool)  -- Equality predicate
               -> [(key,val)]           -- The assoc list
               -> val                   -- Value to return on failure
               -> key                   -- The key
               -> val                   -- The corresponding value

    -- a monad thing
thenMaybe   :: Maybe a -> (a -> Maybe b) -> Maybe b
returnMaybe :: a -> Maybe a
failMaybe   :: Maybe a
mapMaybe    :: (a -> Maybe b) -> [a] -> Maybe [b]

NB: catMaybes which used to be here, is now available via the standard Maybe interface (Maybe is an instance of MonadPlus).

allMaybes collects a list of Justs into a single Just, returning Nothing if there are any Nothings.

firstJust takes a list of Maybes and returns the first Just if there is one, or Nothing otherwise.

assocMaybe looks up in an association list, returning Nothing if it fails.

Now, some operations to do with MaybeErr (comments follow):

    -- a monad thing (surprise, surprise)
thenMaB   :: MaybeErr a err -> (a -> MaybeErr b err) -> MaybeErr b err
returnMaB :: val -> MaybeErr val err
failMaB   :: err -> MaybeErr val err

listMaybeErrs :: [MaybeErr val err] -> MaybeErr [val] [err]
foldlMaybeErrs :: (acc -> input -> MaybeErr acc err)
               -> acc
               -> [input]
               -> MaybeErr acc [err]

listMaybeErrs takes a list of MaybeErrs and, if they all succeed, returns a Succeeded of a list of their values. If any fail, it returns a Failed of the list of all the errors in the list.

foldlMaybeErrs works along a list, carrying an accumulator; it applies the given function to the accumulator and the next list item, accumulating any errors that occur.

The PackedString type

You need to import PackedString and heave in your -syslib ghc to use PackedStrings.

The basic type and functions available are:

data PackedString -- abstract

packString          :: [Char] -> PackedString
packStringST        :: [Char] -> ST s PackedString
packCBytesST        :: Int -> Addr -> ST s PackedString
packBytesForCST     :: [Char] -> ST s (ByteArray Int)
byteArrayToPS       :: ByteArray Int -> PackedString
unsafeByteArrayToPS :: ByteArray a   -> Int -> PackedString
psToByteArray       :: PackedString -> ByteArray Int
psToByteArrayST     :: PackedString -> ST s (ByteArray Int)

unpackPS        :: PackedString -> [Char]

We also provide a wad of list-manipulation-like functions:

nilPS       :: PackedString
consPS      :: Char -> PackedString -> PackedString

headPS      :: PackedString -> Char
tailPS      :: PackedString -> PackedString
nullPS      :: PackedString -> Bool
appendPS    :: PackedString -> PackedString -> PackedString
lengthPS    :: PackedString -> Int
indexPS     :: PackedString -> Int -> Char
            -- 0-origin indexing into the string
mapPS       :: (Char -> Char) -> PackedString -> PackedString
filterPS    :: (Char -> Bool) -> PackedString -> PackedString
foldlPS     :: (a -> Char -> a) -> a -> PackedString -> a
foldrPS     :: (Char -> a -> a) -> a -> PackedString -> a
takePS      :: Int -> PackedString -> PackedString
dropPS      :: Int -> PackedString -> PackedString
splitAtPS   :: Int -> PackedString -> (PackedString, PackedString)
takeWhilePS :: (Char -> Bool) -> PackedString -> PackedString
dropWhilePS :: (Char -> Bool) -> PackedString -> PackedString
spanPS      :: (Char -> Bool) -> PackedString -> (PackedString, PackedString)
breakPS     :: (Char -> Bool) -> PackedString -> (PackedString, PackedString)
linesPS     :: PackedString -> [PackedString]
wordsPS     :: PackedString -> [PackedString]
reversePS   :: PackedString -> PackedString
concatPS    :: [PackedString] -> PackedString
elemPS      :: Char -> PackedString -> Bool
  -- Perl-style split&join
splitPS     :: Char -> PackedString -> [PackedString]
splitWithPS :: (Char -> Bool) -> PackedString -> [PackedString]
joinPS      :: PackedString -> [PackedString] -> PackedString

substrPS   :: PackedString -> Int -> Int -> PackedString
           -- pluck out a piece of a PackedString
           -- start and end chars you want; both 0-origin-specified

The Pretty type

This is the pretty-printer that is currently used in GHC:

type Pretty

ppShow          :: Int{-width-} -> Pretty -> [Char]

pp'SP           :: Pretty -- "comma space"
ppComma         :: Pretty -- ,
ppEquals        :: Pretty -- =
ppLbrack        :: Pretty -- [
ppLparen        :: Pretty -- (
ppNil           :: Pretty -- nothing
ppRparen        :: Pretty -- )
ppRbrack        :: Pretty -- ]
ppSP            :: Pretty -- space
ppSemi          :: Pretty -- ;

ppChar          :: Char -> Pretty
ppDouble        :: Double -> Pretty
ppFloat         :: Float -> Pretty
ppInt           :: Int -> Pretty
ppInteger       :: Integer -> Pretty
ppRational      :: Rational -> Pretty
ppStr           :: [Char] -> Pretty

ppAbove         :: Pretty -> Pretty -> Pretty
ppAboves        :: [Pretty] -> Pretty
ppBeside        :: Pretty -> Pretty -> Pretty
ppBesides       :: [Pretty] -> Pretty
ppCat           :: [Pretty] -> Pretty
ppHang          :: Pretty -> Int -> Pretty -> Pretty
ppInterleave    :: Pretty -> [Pretty] -> Pretty -- spacing between
ppIntersperse   :: Pretty -> [Pretty] -> Pretty -- no spacing between
ppNest          :: Int -> Pretty -> Pretty
ppSep           :: [Pretty] -> Pretty

The Set type

Our implementation of sets (key property: no duplicates) is just a variant of the FiniteMap module.

data Set        -- abstract
                -- instance of: Eq

emptySet        :: Set a
mkSet           :: Ord a => [a]  -> Set a
setToList       :: Set a -> [a]
unitSet         :: a -> Set a
singletonSet    :: a -> Set a  -- deprecated, use unitSet.

union           :: Ord a => Set a -> Set a -> Set a
unionManySets   :: Ord a => [Set a] -> Set a
minusSet        :: Ord a => Set a -> Set a -> Set a
mapSet          :: Ord a => (b -> a) -> Set b -> Set a
intersect       :: Ord a => Set a -> Set a -> Set a

elementOf       :: Ord a => a -> Set a -> Bool
isEmptySet      :: Set a -> Bool

cardinality     :: Set a -> Int

The BitSet interface

Bit sets are a fast implementation of sets of integers ranging from 0 to one less than the number of bits in a machine word (typically 31). If any element exceeds the maximum value for a particular machine architecture, the results of these operations are undefined. You have been warned.

data BitSet   -- abstract
              -- instance of:

emptyBS       :: BitSet
mkBS          :: [Int] -> BitSet
unitBS        :: Int -> BitSet
unionBS       :: BitSet -> BitSet -> BitSet
minusBS       :: BitSet -> BitSet -> BitSet
isEmptyBS     :: BitSet -> Bool
intersectBS   :: BitSet -> BitSet -> BitSet
elementBS     :: Int -> BitSet -> Bool
listBS        :: BitSet -> [Int]

The Util type

Stuff that has been generally useful to use in writing the compiler. Don't be too surprised if this stuff moves/gets-renamed/etc.

-- general list processing
forall          :: (a -> Bool) -> [a] -> Bool
exists          :: (a -> Bool) -> [a] -> Bool

nOfThem         :: Int -> a -> [a]
lengthExceeds   :: [a] -> Int -> Bool
isSingleton     :: [a] -> Bool

--paranoid zip'ing (equal length lists)
zipEqual        :: [a] -> [b] -> [(a,b)]
zipWithEqual    :: String -> (a->b->c) -> [a]->[b]->[c]
zipWith3Equal   :: String -> (a->b->c->d) -> [a]->[b]->[c]->[d]
zipWith4Equal   :: String -> (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
-- lazy in second argument
zipLazy :: [a] -> [b] -> [(a,b)]

mapAndUnzip :: (a -> (b, c)) -> [a] -> ([b], [c])
mapAndUnzip3 :: (a -> (b, c, d)) -> [a] -> ([b], [c], [d])

-- prefix and suffix matching on lists of characters.
startsWith :: {-prefix-}String -> String -> Maybe String
endsWith   :: {-suffix-}String -> String -> Maybe String

-- association lists
assoc       :: Eq a => String -> [(a, b)] -> a -> b

-- duplicate handling
hasNoDups    :: Eq a => [a] -> Bool
equivClasses :: (a -> a -> Ordering) -> [a] -> [[a]]
runs         :: (a -> a -> Bool)     -> [a] -> [[a]]
removeDups   :: (a -> a -> Ordering) -> [a] -> ([a], [[a]])

-- sorting (don't complain of no choice...)
quicksort          :: (a -> a -> Bool)     -> [a] -> [a]
sortLt             :: (a -> a -> Bool)     -> [a] -> [a]
stableSortLt       :: (a -> a -> Bool)     -> [a] -> [a]
mergesort          :: (a -> a -> _CMP_TAG) -> [a] -> [a]
mergeSort          :: Ord a => [a] -> [a]
naturalMergeSort   :: Ord a => [a] -> [a]
mergeSortLe        :: Ord a => [a] -> [a]
naturalMergeSortLe :: Ord a => [a] -> [a]

-- transitive closures
transitiveClosure :: (a -> [a])         -- Successor function
                  -> (a -> a -> Bool)   -- Equality predicate
                  -> [a] 
                  -> [a]                -- The transitive closure

-- accumulating (Left, Right, Bi-directional)
mapAccumL :: (acc -> x -> (acc, y))
                        -- Function of elt of input list and
                        -- accumulator, returning new accumulator and
                        -- elt of result list
          -> acc        -- Initial accumulator
          -> [x]        -- Input list
          -> (acc, [y]) -- Final accumulator and result list

mapAccumR :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])

mapAccumB :: (accl -> accr -> x -> (accl, accr,y))
          -> accl -> accr -> [x]
          -> (accl, accr, [y])

--list comparison with explicit element comparer.
cmpList :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering

-- pairs
applyToPair :: ((a -> c), (b -> d)) -> (a, b) -> (c, d)
applyToFst  :: (a -> c) -> (a, b) -> (c, b)
applyToSnd  :: (b -> d) -> (a, b) -> (a, d)
foldPair    :: (a->a->a, b->b->b) -> (a, b) -> [(a, b)] -> (a, b)
unzipWith   :: (a -> b -> c) -> [(a, b)] -> [c]

5.7 Interfaces to C libraries

The GHC system library (-syslib ghc) also provides interfaces to several useful C libraries, mostly from the GNU project.

The Readline interface

(Darren Moffat supplied the Readline interface.)

The Readline module is a straightforward interface to the GNU Readline library. As such, you will need to look at the GNU documentation (and have a libreadline.a file around somewhere...)

You'll need to link any Readlining program with -lreadline -ltermcap, besides the usual -syslib ghc (and -fhaskell-1.3).

The main function you'll use is:

readline :: String{-the prompt-} -> IO String

If you want to mess around with Full Readline G(l)ory, we also provide:

rlInitialize, addHistory,

rlBindKey, rlAddDefun, RlCallbackFunction(..),

rlGetLineBuffer, rlSetLineBuffer, rlGetPoint, rlSetPoint, rlGetEnd,
rlSetEnd, rlGetMark, rlSetMark, rlSetDone, rlPendingInput,

rlPrompt, rlTerminalName, rlSetReadlineName, rlGetReadlineName
(All those names are just Haskellised versions of what you will see in the GNU readline documentation.)

The Regexp and MatchPS interfaces

(Sigbjorn Finne supplied the regular-expressions interface.)

The Regex library provides quite direct interface to the GNU regular-expression library, for doing manipulation on PackedStrings. You probably need to see the GNU documentation if you are operating at this level.

The datatypes and functions that Regex provides are:

data PatBuffer  # just a bunch of bytes (mutable)

data REmatch
 = REmatch (Array Int GroupBounds)  -- for $1, ... $n
           GroupBounds              -- for $` (everything before match)
           GroupBounds              -- for $& (entire matched string)
           GroupBounds              -- for $' (everything after)
           GroupBounds              -- for $+ (matched by last bracket)

-- GroupBounds hold the interval where a group
-- matched inside a string, e.g.
--
-- matching "reg(exp)" "a regexp" returns the pair (5,7) for the
-- (exp) group. (PackedString indices start from 0)

type GroupBounds = (Int, Int)

re_compile_pattern
        :: PackedString         -- pattern to compile
        -> Bool                 -- True <=> assume single-line mode
        -> Bool                 -- True <=> case-insensitive
        -> PrimIO PatBuffer

re_match :: PatBuffer           -- compiled regexp
         -> PackedString        -- string to match
         -> Int                 -- start position
         -> Bool                -- True <=> record results in registers
         -> PrimIO (Maybe REmatch)

-- Matching on 2 strings is useful when you're dealing with multiple
-- buffers, which is something that could prove useful for
-- PackedStrings, as we don't want to stuff the contents of a file
-- into one massive heap chunk, but load (smaller chunks) on demand.

re_match2 :: PatBuffer          -- 2-string version
          -> PackedString
          -> PackedString
          -> Int
          -> Int
          -> Bool
          -> PrimIO (Maybe REmatch)

re_search :: PatBuffer          -- compiled regexp
          -> PackedString       -- string to search
          -> Int                -- start index
          -> Int                -- stop index
          -> Bool               -- True <=> record results in registers
          -> PrimIO (Maybe REmatch)

re_search2 :: PatBuffer         -- Double buffer search
           -> PackedString
           -> PackedString
           -> Int               -- start index
           -> Int               -- range (?)
           -> Int               -- stop index
           -> Bool              -- True <=> results in registers
           -> PrimIO (Maybe REmatch)

The MatchPS module provides Perl-like ``higher-level'' facilities to operate on PackedStrings. The regular expressions in question are in Perl syntax. The ``flags'' on various functions can include: i for case-insensitive, s for single-line mode, and g for global. (It's probably worth your time to peruse the source code...)

matchPS :: PackedString    -- regexp
        -> PackedString    -- string to match
        -> [Char]          -- flags
        -> Maybe REmatch   -- info about what matched and where

searchPS :: PackedString    -- regexp
         -> PackedString    -- string to match
         -> [Char]          -- flags
         -> Maybe REmatch

-- Perl-like match-and-substitute:
substPS :: PackedString     -- regexp
        -> PackedString     -- replacement
        -> [Char]           -- flags
        -> PackedString     -- string
        -> PackedString

-- same as substPS, but no prefix and suffix:
replacePS :: PackedString  -- regexp
          -> PackedString  -- replacement
          -> [Char]        -- flags
          -> PackedString  -- string
          -> PackedString

match2PS :: PackedString   -- regexp
         -> PackedString   -- string1 to match
         -> PackedString   -- string2 to match
         -> [Char]         -- flags
         -> Maybe REmatch

search2PS :: PackedString  -- regexp
          -> PackedString  -- string to match
          -> PackedString  -- string to match
          -> [Char]        -- flags
          -> Maybe REmatch

-- functions to pull the matched pieces out of an REmatch:

getMatchesNo    :: REmatch -> Int
getMatchedGroup :: REmatch -> Int -> PackedString -> PackedString
getWholeMatch   :: REmatch -> PackedString -> PackedString
getLastMatch    :: REmatch -> PackedString -> PackedString
getAfterMatch   :: REmatch -> PackedString -> PackedString

-- (reverse) brute-force string matching;
-- Perl equivalent is index/rindex:
findPS, rfindPS :: PackedString -> PackedString -> Maybe Int

-- Equivalent to Perl "chop" (off the last character, if any):
chopPS :: PackedString -> PackedString

-- matchPrefixPS: tries to match as much as possible of strA starting
-- from the beginning of strB (handy when matching fancy literals in
-- parsers):
matchPrefixPS :: PackedString -> PackedString -> Int

Network-interface toolkit---Socket and SocketPrim

(Darren Moffat supplied the network-interface toolkit.)

Your best bet for documentation is to look at the code---really!--- normally in fptools/ghc/lib/misc/{BSD,Socket,SocketPrim.lhs}.

The BSD module provides functions to get at system-database info; pretty straightforward if you're into this sort of thing:

getHostName         :: IO String

getServiceByName    :: ServiceName -> IO ServiceEntry
getServicePortNumber:: ServiceName -> IO PortNumber
getServiceEntry     :: IO ServiceEntry
setServiceEntry     :: Bool -> IO ()
endServiceEntry     :: IO ()

getProtocolByName   :: ProtocolName -> IO ProtocolEntry
getProtocolByNumber :: ProtocolNumber -> IO ProtcolEntry
getProtocolNumber   :: ProtocolName -> ProtocolNumber
getProtocolEntry    :: IO ProtocolEntry
setProtocolEntry    :: Bool -> IO ()
endProtocolEntry    :: IO ()

getHostByName       :: HostName -> IO HostEntry
getHostByAddr       :: Family -> HostAddress -> IO HostEntry
getHostEntry        :: IO HostEntry
setHostEntry        :: Bool -> IO ()
endHostEntry        :: IO ()

The SocketPrim interface provides quite direct access to the socket facilities in a BSD Unix system, including all the complications. We hope you don't need to use it! See the source if needed...

The Socket interface is a ``higher-level'' interface to sockets, and it is what we recommend. Please tell us if the facilities it offers are inadequate to your task!

The interface is relatively modest:

connectTo       :: Hostname -> PortID -> IO Handle
listenOn        :: PortID -> IO Socket

accept          :: Socket -> IO (Handle, HostName)
sendTo          :: Hostname -> PortID -> String -> IO ()

recvFrom        :: Hostname -> PortID -> IO String
socketPort      :: Socket -> IO PortID

data PortID     -- PortID is a non-abstract type
  = Service String      -- Service Name eg "ftp"
  | PortNumber Int      -- User defined Port Number
  | UnixSocket String   -- Unix family socket in file system

type Hostname = String

Various examples of networking Haskell code are provided in


Next Previous Contents