X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fdocs%2Flibraries%2Flibs.sgml;h=a8fcc7b4bcc5a829ebd48360f94b695aa522f969;hb=456eca7317895df8193d83b986352b6238e3824d;hp=4f8b49e15732e7d5a17876baadc28a078c1eca65;hpb=d2773c400eb83d69449a7c2de4747a8f792dd50d;p=ghc-hetmet.git diff --git a/ghc/docs/libraries/libs.sgml b/ghc/docs/libraries/libs.sgml index 4f8b49e..a8fcc7b 100644 --- a/ghc/docs/libraries/libs.sgml +++ b/ghc/docs/libraries/libs.sgml @@ -1,4 +1,22 @@ - + + + + + + + + + + + + + + + + + +]> - + +

-This library provides support for both . In addition to the -monad -module LazyST( module LazyST, module Monad ) where -import Monad - -data ST s a -- abstract type -runST :: forall a. (forall s. ST s a) -> a -returnST :: a -> ST s a -thenLazyST :: ST s a -> (a -> ST s b) -> ST s b -thenStrictST :: ST s a -> (a -> ST s b) -> ST s b -fixST :: (a -> ST s a) -> ST s a -unsafeInterleaveST :: ST s a -> ST s a -instance Functor (ST s) -instance Monad (ST s) - -data STRef s a -- mutable variables in state thread s - -- containing values of type a. -newSTRef :: a -> ST s (STRef s a) -readSTRef :: STRef s a -> ST s a -writeSTRef :: STRef s a -> a -> ST s () -instance Eq (STRef s a) - -data STArray s ix elt -- mutable arrays in state thread s - -- indexed by values of type ix - -- containing values of type a. -newSTArray :: Ix ix => (ix,ix) -> elt -> ST s (STArray s ix elt) -boundsSTArray :: Ix ix => STArray s ix elt -> (ix, ix) -readSTArray :: Ix ix => STArray s ix elt -> ix -> ST s elt -writeSTArray :: Ix ix => STArray s ix elt -> ix -> elt -> ST s () -thawSTArray :: Ix ix => Array ix elt -> ST s (STArray s ix elt) -freezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt) -unsafeFreezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt) -instance Eq (STArray s ix elt) - - -Notes: - - - -GHC also supports ByteArrays --- these aren't supported by Hugs yet. - - -The operations -In the current version of Hugs, the - Note that it is possible to install Hugs 1.4 without support for lazy - state threads, and hence the primitives described here may not be - available in all implementations. Also, in contrast with the - implementation of lazy state threads in previous releases of Hugs and - Gofer, there is no direct relationship between the - - - -The only difference between the lazy and strict instances of the ->=/ -and >=/ but this is not supported by Hugs yet. - - - - - - -This library is identical to - -This library provides the following extensions to the IO monad: - - -The operations - - -References (aka mutable variables) and mutable arrays (but no form of -mutable byte arrays) - - - -When called, - - - -> cache :: (a -> b) -> (a -> b) -> cache f = \x -> unsafePerformIO (check x) -> where -> ref = unsafePerformIO (newIORef (error "cache", error "cache")) -> check x = readIORef ref >>= \ (x',a) -> -> if x `unsafePtrEq` x' then -> return a -> else -> let a = f x in -> writeIORef ref (x, a) >> -> return a - - - - - - -module IOExts where - -fixIO :: (a -> IO a) -> IO a -unsafePerformIO :: IO a -> a -unsafeInterleaveIO :: IO a -> IO a - -data IORef a -- mutable variables containing values of type a -newIORef :: a -> IO (IORef a) -readIORef :: IORef a -> IO a -writeIORef :: IORef a -> a -> IO () -instance Eq (IORef a) - -data IOArray ix elt -- mutable arrays indexed by values of type ix - -- containing values of type a. -newIOArray :: Ix ix => (ix,ix) -> elt -> IO (IOArray ix elt) -boundsIOArray :: Ix ix => IOArray ix elt -> (ix, ix) -readIOArray :: Ix ix => IOArray ix elt -> ix -> IO elt -writeIOArray :: Ix ix => IOArray ix elt -> ix -> elt -> IO () -freezeIOArray :: Ix ix => IOArray ix elt -> IO (Array ix elt) -instance Eq (IOArray ix elt) - -performGC :: IO () -trace :: String -> a -> a -unsafePtrEq :: a -> a -> Bool - - - - - - -This library defines bitwise operations for signed and unsigned ints. - - -module Bits where -infixl 8 `shift`, `rotate` -infixl 7 .&. -infixl 6 `xor` -infixl 5 .|. - -class Bits a where - (.&.), (.|.), xor :: a -> a -> a - complement :: a -> a - shift :: a -> Int -> a - rotate :: a -> Int -> a - bit :: Int -> a - setBit :: a -> Int -> a - clearBit :: a -> Int -> a - complementBit :: a -> Int -> a - testBit :: a -> Int -> Bool - bitSize :: a -> Int - isSigned :: a -> Bool - -shiftL, shiftR :: Bits a => a -> Int -> a -rotateL, rotateR :: Bits a => a -> Int -> a -shiftL a i = shift a i -shiftR a i = shift a (-i) -rotateL a i = rotate a i -rotateR a i = rotate a (-i) - - -Notes: - - - Bits are numbered from 0 with bit 0 being the least significant bit. +Actions that create a new values have the prefix - - - - - - - -This library provides unsigned integers of various sizes. -The types supported are as follows: - - -type | number of bits @ - -Word8 | 8 @ -Word16 | 16 @ -Word32 | 32 @ -Word64 | 64 @ - - - -For each type -data W -- Unsigned Ints -instance Eq W -instance Ord W -instance Show W -instance Read W -instance Bounded W -instance Num W -instance Real W -instance Integral W -instance Enum W -instance Ix W -instance Bits W - -Plus - -word8ToWord32 :: Word8 -> Word32 -word32ToWord8 :: Word32 -> Word8 -word16ToWord32 :: Word16 -> Word32 -word32ToWord16 :: Word32 -> Word16 - -word8ToInt :: Word8 -> Int -intToWord8 :: Int -> Word8 -word16ToInt :: Word16 -> Int -intToWord16 :: Int -> Word16 -word32ToInt :: Word32 -> Int -intToWord32 :: Int -> Word32 - +Operations that read a value from a mutable object are prefixed with + - All arithmetic is performed modulo 2^n - - One non-obvious consequequence of this is that -The coercion -ToDo: complete the set of coercion functions. - - -Use a -> b/ to -coerce between different sizes or to preserve sign when converting -between values of the same size. - - -It would be very natural to add a type a type -The -It would be useful to provide a function (or a family of functions?) -which coerced between any two Word types (without going through -Integer). - - - -Hugs only provides - -This library provides signed integers of various sizes. The types -supported are as follows: - - -type | number of bits @ - -Int8 | 8 @ -Int16 | 16 @ -Int32 | 32 @ -Int64 | 64 @ - - - -For each type -data I -- Signed Ints -iToInt :: I -> Int -- not provided for Int64 -intToi :: Int -> I -- not provided for Int64 -instance Eq I -instance Ord I -instance Show I -instance Read I -instance Bounded I -instance Num I -instance Real I -instance Integral I -instance Enum I -instance Ix I -instance Bits I - -Plus - -int8ToInt :: Int8 -> Int -intToInt8 :: Int -> Int8 -int16ToInt :: Int16 -> Int -intToInt16 :: Int -> Int16 -int32ToInt :: Int32 -> Int -intToInt32 :: Int -> Int32 - - - - -Hugs does not provide -ToDo: complete the set of coercion functions. - +Operations provided by various concurrency abstractions, e.g., - - - -This library provides machine addresses and is primarily intended for -use in creating foreign function interfaces using GreenCard. - - -module Addr where -data Addr -- Address type -instance Eq Addr - -nullAddr :: Addr -plusAddr :: Addr -> Int -> Addr - --- read value out of _immutable_ memory -indexCharOffAddr :: Addr -> Int -> Char -indexIntOffAddr :: Addr -> Int -> Int -- should we drop this? -indexAddrOffAddr :: Addr -> Int -> Addr -indexFloatOffAddr :: Addr -> Int -> Float -indexDoubleOffAddr :: Addr -> Int -> Double -indexWord8OffAddr :: Addr -> Int -> Word8 -indexWord16OffAddr :: Addr -> Int -> Word16 -indexWord32OffAddr :: Addr -> Int -> Word32 -indexWord64OffAddr :: Addr -> Int -> Word64 -indexInt8OffAddr :: Addr -> Int -> Int8 -indexInt16OffAddr :: Addr -> Int -> Int16 -indexInt32OffAddr :: Addr -> Int -> Int32 -indexInt64OffAddr :: Addr -> Int -> Int64 - --- read value out of mutable memory -readCharOffAddr :: Addr -> Int -> IO Char -readIntOffAddr :: Addr -> Int -> IO Int -- should we drop this? -readAddrOffAddr :: Addr -> Int -> IO Addr -readFloatOffAddr :: Addr -> Int -> IO Float -readDoubleOffAddr :: Addr -> Int -> IO Double -readWord8OffAddr :: Addr -> Int -> IO Word8 -readWord16OffAddr :: Addr -> Int -> IO Word16 -readWord32OffAddr :: Addr -> Int -> IO Word32 -readWord64OffAddr :: Addr -> Int -> IO Word64 -readInt8OffAddr :: Addr -> Int -> IO Int8 -readInt16OffAddr :: Addr -> Int -> IO Int16 -readInt32OffAddr :: Addr -> Int -> IO Int32 -readInt64OffAddr :: Addr -> Int -> IO Int64 - --- write value into mutable memory -writeCharOffAddr :: Addr -> Int -> Char -> IO () -writeIntOffAddr :: Addr -> Int -> Int -> IO () -- should we drop this? -writeAddrOffAddr :: Addr -> Int -> Addr -> IO () -writeFloatOffAddr :: Addr -> Int -> Float -> IO () -writeDoubleOffAddr :: Addr -> Int -> Double -> IO () -writeWord8OffAddr :: Addr -> Int -> Word8 -> IO () -writeWord16OffAddr :: Addr -> Int -> Word16 -> IO () -writeWord32OffAddr :: Addr -> Int -> Word32 -> IO () -writeWord64OffAddr :: Addr -> Int -> Word64 -> IO () -writeInt8OffAddr :: Addr -> Int -> Int8 -> IO () -writeInt16OffAddr :: Addr -> Int -> Int16 -> IO () -writeInt32OffAddr :: Addr -> Int -> Int32 -> IO () -writeInt64OffAddr :: Addr -> Int -> Int64 -> IO () - - -Hugs provides - -This module is provided by GHC but not by Hugs. -GreenCard for Hugs provides the - -This library provides the Concurrent Haskell extensions -. - -We are grateful to the Glasgow Haskell Project for allowing us to -redistribute their implementation of this module. - - -module Concurrent where - -data ThreadId -- thread identifiers -instance Eq ThreadId -instance Ord ThreadId - -forkIO :: IO () -> IO ThreadId -killThread :: ThreadId -> IO () - -data MVar a -- Synchronisation variables -newEmptyMVar :: IO (MVar a) -newMVar :: a -> IO (MVar a) -takeMVar :: MVar a -> IO a -putMVar :: MVar a -> a -> IO () -swapMVar :: MVar a -> a -> IO a -readMVar :: MVar a -> IO a -instance Eq (MVar a) - -data Chan a -- channels -newChan :: IO (Chan a) -writeChan :: Chan a -> a -> IO () -readChan :: Chan a -> IO a -dupChan :: Chan a -> IO (Chan a) -unReadChan :: Chan a -> a -> IO () -getChanContents :: Chan a -> IO [a] -writeList2Chan :: Chan a -> [a] -> IO () - -data CVar a -- one element channels -newCVar :: IO (CVar a) -putCVar :: CVar a -> a -> IO () -getCVar :: CVar a -> IO a - -data QSem -- General/quantity semaphores -newQSem :: Int -> IO QSem -waitQSem :: QSem -> IO () -signalQSem :: QSem -> IO () - -data QSemN -- General/quantity semaphores -newQSemN :: Int -> IO QSemN -waitQSemN :: QSemN -> Int -> IO () -signalQSemN :: QSemN -> Int -> IO () - -type SampleVar a -- Sample variables -newEmptySampleVar:: IO (SampleVar a) -newSampleVar :: a -> IO (SampleVar a) -emptySampleVar :: SampleVar a -> IO () -readSampleVar :: SampleVar a -> IO a -writeSampleVar :: SampleVar a -> a -> IO () - - -Notes: - - - - GHC uses preemptive multitasking: - Context switches can occur at any time, except if you call a C - function (like \verb"getchar") that blocks waiting for input. - - Hugs uses cooperative multitasking: - Context switches only occur when you use one of the primitives - defined in this module. This means that programs such as: - - -main = forkIO (write 'a') >> write 'b' - where write c = putChar c >> write c - - - will print either -Hugs does not provide the functions -Thread identities and ---it to kill its children before exiting. - - -The - - -This library contains Simon Peyton Jones' implementation of John -Hughes's pretty printer combinators. - - -module Pretty where -infixl 6 <> -infixl 6 <+> -infixl 5 $$, $+$ -data Doc -- the Document datatype - --- The primitive Doc values -empty :: Doc -text :: String -> Doc -char :: Char -> Doc -int :: Int -> Doc -integer :: Integer -> Doc -float :: Float -> Doc -double :: Double -> Doc -rational :: Rational -> Doc -semi, comma, colon, space, equals :: Doc -lparen, rparen, lbrack, rbrack, lbrace, rbrace :: Doc -parens, brackets, braces :: Doc -> Doc -quotes, doubleQuotes :: Doc -> Doc - --- Combining Doc values -(<>) :: Doc -> Doc -> Doc -- Beside -hcat :: [Doc] -> Doc -- List version of <> -(<+>) :: Doc -> Doc -> Doc -- Beside, separated by space -hsep :: [Doc] -> Doc -- List version of <+> -($$) :: Doc -> Doc -> Doc -- Above; if there is no - -- overlap it "dovetails" the two -vcat :: [Doc] -> Doc -- List version of $$ -cat :: [Doc] -> Doc -- Either hcat or vcat -sep :: [Doc] -> Doc -- Either hsep or vcat -fcat :: [Doc] -> Doc -- ``Paragraph fill'' version of cat -fsep :: [Doc] -> Doc -- ``Paragraph fill'' version of sep -nest :: Int -> Doc -> Doc -- Nested -hang :: Doc -> Int -> Doc -> Doc -punctuate :: Doc -> [Doc] -> [Doc] --- punctuate p [d1, ... dn] = [d1 <> p, d2 <> p, ... dn-1 <> p, dn] - --- Displaying Doc values -instance Show Doc -render :: Doc -> String -- Uses default style -renderStyle :: Style -> Doc -> String -data Style = Style { lineLength :: Int, -- In chars - ribbonsPerLine :: Float, -- Ratio of ribbon length - -- to line length - mode :: Mode - } -data Mode = PageMode -- Normal - | ZigZagMode -- With zig-zag cuts - | LeftMode -- No indentation, infinitely long lines - | OneLineMode -- All on one line - + + +&addr +&bits +&concurrent +&dynamic +&exception +&foreign +&getopt +&glaexts +&ioexts +&int + +&numexts +&pretty +&st +&stable + + +

+ +This library is identical to +lazyToStrictST :: LazyST.ST s a -> ST.ST s a +strictToLazyST :: ST.ST s a -> LazyST.ST s a + + +These are used to convert between lazy and strict state threads. The +semantics with respect to laziness are as you would expect: the strict +state thread passed to