HBC Libraries

The import one of these modules you only need to do an ordinary import, no compiler flags are needed.

Some of these module are based on very early Haskell library proposals.


Bit

infixl 7 ^&
infixl 6 ^|
infixl 5 `xor`
infixl 8 ^>>
infixl 8 ^<<
infixl 8 `asr`
infixl 8 `rol`
infixl 8 `ror`
class (Integral a) => Bits a where 
    (^&) :: a -> a -> a
    (^|) :: a -> a -> a
    xor :: a -> a -> a
    compl :: a -> a
    (^>>) :: a -> Int -> a
    (^<<) :: a -> Int -> a
    asr :: a -> Int -> a
    rol :: a -> Int -> a
    ror :: a -> Int -> a
    test :: Int -> a -> Bool
    set :: Int -> a -> a
    clear :: Int -> a -> a
    bitSize :: a -> Int
instance Bits Nat__16.Nat16
instance Bits Nat__32.Nat32
instance Bits Nat__64.Nat64
instance Bits Nat__8.Nat8

ByteVector

data ByteVector
data Byte
append :: ByteVector -> ByteVector -> ByteVector 
sub :: ByteVector -> Int -> Byte 
empty :: ByteVector 
fromList :: [Byte] -> ByteVector 
substr :: ByteVector -> Int -> Int -> ByteVector 
toList :: ByteVector -> [Byte] 
size :: ByteVector -> Int 
cPointerToByteVector :: _CPointer -> Int -> ByteVector 
getNet16 :: ByteVector -> Int 
getNet32 :: ByteVector -> Int 
setNet16 :: Int -> ByteVector 
setNet32 :: Int -> ByteVector 
instance CCall.CValue ByteVector
instance Bounded Byte
instance Enum Byte
instance Eq Byte
instance Eq ByteVector
instance Ord Byte
instance Ord ByteVector
instance Show Byte
instance Show ByteVector

CCall

ccallCU :: CPointer -> [CUnion] -> CUnion -> IO CUnion 
ccallCV :: (CValue a) => CPointer -> [CUnion] -> IO a 
nullCPointer :: CPointer 
addCPointer :: CPointer -> Int -> CPointer 
type CUnion = _CUnion
type CPointer = _CPointer
class CValue a where 
    toCU :: a -> CUnion
    fromCU :: CUnion -> a
data _CUnion
data _CPointer
instance Eq _CPointer
instance Eq _CUnion
instance Show _CPointer
instance Show _CUnion
instance CValue ()
instance CValue Bool
instance CValue Char
instance CValue Double
instance CValue Float
instance CValue Int
instance CValue [a]
instance CValue [Char]
instance CValue _ByteVector._ByteVector
instance CValue _CPointer

CatList

An implementation of Chris Okasaki's catenable lists. These list have O(1) cons, head, tail, and (++)
data CatList a
nil :: CatList a 
empty :: CatList a 
cons :: a -> (CatList a) -> CatList a 
snoc :: (CatList a) -> a -> CatList a 
singleton :: a -> CatList a 
head :: (CatList a) -> a 
tail :: (CatList a) -> CatList a 
length :: (CatList a) -> Int 
size :: (CatList a) -> Int 
null :: (CatList a) -> Bool 
toList :: (CatList a) -> [a] 
fromList :: [a] -> CatList a 
filter :: (a -> Bool) -> (CatList a) -> CatList a 
reverse :: (CatList a) -> CatList a 
foldr :: (a -> b -> b) -> b -> (CatList a) -> b 
instance (Eq a) => Eq (CatList a)
instance Functor CatList
instance Monad CatList
instance MonadPlus CatList
instance MonadZero CatList
instance (Ord a) => Ord (CatList a)
instance (Show a) => Show (CatList a)

ContinuationIO

Haskell 1.2 continuation I/O compatibility.

Dequeue

An implemenation of Chris Okasaki's dequeues with O(1) insert and delete. See JFP vol 5 part 4.
data Dequeue a
empty :: Dequeue a 
snoc :: a -> (Dequeue a) -> Dequeue a 
tail :: (Dequeue a) -> Dequeue a 
head :: (Dequeue a) -> a 
null :: (Dequeue a) -> Bool 
cons :: a -> (Dequeue a) -> Dequeue a 
init :: (Dequeue a) -> Dequeue a 
last :: (Dequeue a) -> a 
size :: (Dequeue a) -> Int 
toList :: (Dequeue a) -> [a] 
fromList :: [a] -> Dequeue a 
instance (Eq a) => Eq (Dequeue a)
instance Functor Dequeue
instance (Show a) => Show (Dequeue a)

DialogueIO

Haskell 1.2 dialugue I/O compatibility.

Duplicates

Grouping of equal list elements.
groupBy :: (a -> a -> Bool) -> [a] -> [[a]] 
uniqBy :: (a -> a -> Bool) -> [a] -> [a] 
group :: (Eq a) => [a] -> [[a]] 
uniq :: (Eq a) => [a] -> [a] 

FileStat

getFileStat :: StdIO.FilePath -> IO FileStat 
data FileStat = FileStat { st_dev :: Int, st_ino :: Int, st_mode :: [FileMode], st_uperm :: [FilePerm], st_gperm :: [FilePerm], st_operm :: [FilePerm], st_nlink :: Int, st_uid :: String, st_gid :: String, st_size :: Integer, st_atime :: Time.ClockTime, st_mtime :: Time.ClockTime, st_ctime :: Time.ClockTime }
st_dev :: FileStat -> Int 
st_ino :: FileStat -> Int 
st_mode :: FileStat -> [FileMode] 
st_uperm :: FileStat -> [FilePerm] 
st_gperm :: FileStat -> [FilePerm] 
st_operm :: FileStat -> [FilePerm] 
st_nlink :: FileStat -> Int 
st_uid :: FileStat -> String 
st_gid :: FileStat -> String 
st_size :: FileStat -> Integer 
st_atime :: FileStat -> Time.ClockTime 
st_mtime :: FileStat -> Time.ClockTime 
st_ctime :: FileStat -> Time.ClockTime 
data FilePerm = FPWrite | FPRead | FPExec
data FileMode = FFifo | FFchr | FFdir | FFblk | FFreg | FFlnk | FFsock | FSuid | FSgid | FSvtx
instance Eq FileMode
instance Eq FilePerm
instance Eq FileStat
instance Ord FileMode
instance Ord FilePerm
instance Ord FileStat
instance Show FileMode
instance Show FilePerm
instance Show FileStat

GenericList

length :: (Num b) => [a] -> b 
drop :: (Integral a) => a -> [b] -> [b] 
take :: (Integral a) => a -> [b] -> [b] 
splitAt :: (Integral a) => a -> [b] -> ([b], [b]) 
replicate :: (Integral a) => a -> b -> [b] 
(!!) :: (Integral b) => [a] -> b -> a 

Graph

Graphs and DFS-based algorithms on them based on Launchbury and King.

Uses monadic mutable arrays.

type Graph a = Array a [a]
type Edge a = (a, a)
buildG :: (Ix a) => (a, a) -> [Edge a] -> Graph a 
vertices :: (Ix a) => (Graph a) -> [a] 
edges :: (Ix a) => (Graph a) -> [Edge a] 
outdegree :: (Ix a) => (Graph a) -> Array a Int 
indegree :: (Ix a) => (Graph a) -> Array a Int 
transposeG :: (Ix a) => (Graph a) -> Graph a 
reverseE :: (Ix a) => (Graph a) -> [Edge a] 
preOrd :: (Ix a) => (Graph a) -> [a] 
postOrd :: (Ix a) => (Graph a) -> [a] 
topSort :: (Ix a) => (Graph a) -> [a] 
scc :: (Ix a) => (Graph a) -> [[a]] 
tabulate :: (Ix a) => (a, a) -> [a] -> Array a Int 
reachable :: (Ix a) => (Graph a) -> a -> [a] 
path :: (Ix a) => (Graph a) -> a -> a -> Bool 

HO

Some useful combinators.
lift :: (a -> b -> c) -> (d -> a) -> (d -> b) -> d -> c 
cross :: (a -> b) -> (a -> c) -> a -> (b, c) 
apFst :: (a -> b) -> (a, c) -> (b, c) 
apSnd :: (a -> b) -> (c, a) -> (c, b) 
curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d 
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d 
curry4 :: ((a, b, c, d) -> e) -> a -> b -> c -> d -> e 
uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e 

HandleException

handleException :: Exception -> ExceptionHandler -> IO ExceptionHandler 
excError :: Exception 
excHangup :: Exception 
excInterrupt :: Exception 
excArithmetic :: Exception 
excPipe :: Exception 
excTerminate :: Exception 
data ExceptionHandler = ExcDefault | ExcIgnore | ExcHandle (String -> IO ())
type Exception = Int

Hash

data Hash
combineHash :: Hash -> Hash -> Hash 
emptyHash :: Hash 
hashToInt :: Int -> Hash -> Int 
hashToMax :: (Hashable a) => Int -> a -> Int 
class Hashable a where 
    hash :: a -> Hash
instance Eq Hash
instance Show Hash
instance (RealFloat a, Hashable a) => Hashable (Complex.Complex a)
instance (Hashable a, Hashable b) => Hashable (a, b)
instance (Hashable a, Hashable b, Hashable c) => Hashable (a, b, c)
instance (Hashable a, Hashable b, Hashable c, Hashable d) => Hashable (a, b, c, d)
instance (Hashable a, Hashable b, Hashable c, Hashable d, Hashable e) => Hashable (a, b, c, d, e)
instance Hashable (a -> b)
instance Hashable ()
instance Hashable Bool
instance Hashable Char
instance Hashable Double
instance (Hashable a, Hashable b) => Hashable (Either a b)
instance Hashable Float
instance Hashable Int
instance Hashable Integer
instance (Hashable a) => Hashable (Maybe a)
instance (Hashable a) => Hashable [a]
instance Hashable [Char]
instance (Integral a, Hashable a) => Hashable (Ratio.Ratio a)
instance (Ix a) => Hashable (Array a b)
instance Hashable (IO a)

IOMisc

hGetLine :: Handle -> IO String 
hPutStrLn :: Handle -> String -> IO () 

IOMutVar

data MutableVar a
newVar :: a -> IO (MutableVar a) 
readVar :: (MutableVar a) -> IO a 
writeVar :: (MutableVar a) -> a -> IO () 
sameVar :: (MutableVar a) -> (MutableVar a) -> Bool 

IOUtil

getEnvi :: String -> Maybe String 
progName :: String 
progArgs :: [String] 

Identity

newtype Identity a = I a
instance Functor Identity
instance Monad Identity

IntMap

Mapping from Int to any type. Similar to an array with Int index, but without any bounds on the index.
data IntMap a
empty :: IntMap a 
singleton :: (Int, a) -> IntMap a 
union :: (IntMap a) -> (IntMap a) -> IntMap a 
unionMany :: [IntMap a] -> IntMap a 
add :: (Int, a) -> (IntMap a) -> IntMap a 
(//) :: (IntMap a) -> [(Int, a)] -> IntMap a 
addKeep :: (Int, a) -> (IntMap a) -> IntMap a 
add_C :: (a -> a -> a) -> (Int, a) -> (IntMap a) -> IntMap a 
delete :: Int -> (IntMap a) -> IntMap a 
deleteMany :: [Int] -> (IntMap a) -> IntMap a 
foldr :: ((Int, a) -> b -> b) -> b -> (IntMap a) -> b 
imap :: ((Int, a) -> (Int, b)) -> (IntMap a) -> IntMap b 
filter :: ((Int, a) -> Bool) -> (IntMap a) -> IntMap a 
toList :: (IntMap a) -> [(Int, a)] 
fromList :: [(Int, a)] -> IntMap a 
length :: (IntMap a) -> Int 
null :: (IntMap a) -> Bool 
isSingleton :: (IntMap a) -> Bool 
elems :: (IntMap a) -> [a] 
indices :: (IntMap a) -> [Int] 
(!) :: (IntMap a) -> Int -> a 
lookup :: Int -> (IntMap a) -> Maybe a 
lookupWithDefault :: (IntMap a) -> a -> Int -> a 
instance (Eq a) => Eq (IntMap a)
instance Functor IntMap
instance (Show a) => Show (IntMap a)

IntSet

data IntSet
empty :: IntSet 
singleton :: Int -> IntSet 
union :: IntSet -> IntSet -> IntSet 
unionMany :: [IntSet] -> IntSet 
add :: Int -> IntSet -> IntSet 
addMany :: [Int] -> IntSet -> IntSet 
intersect :: IntSet -> IntSet -> IntSet 
delete :: Int -> IntSet -> IntSet 
deleteMany :: [Int] -> IntSet -> IntSet 
minus :: IntSet -> IntSet -> IntSet 
toList :: IntSet -> [Int] 
fromList :: [Int] -> IntSet 
length :: IntSet -> Int 
null :: IntSet -> Bool 
isSingleton :: IntSet -> Bool 
intersecting :: IntSet -> IntSet -> Bool 
isSubsetOf :: IntSet -> IntSet -> Bool 
elem :: Int -> IntSet -> Bool 
instance Eq IntSet
instance Show IntSet

IntegerMisc

Useful functions on Integer.
integerPowMod :: Integer -> Integer -> Integer -> Integer 
integerToString :: Int -> Integer -> String 
integerGcd :: Integer -> Integer -> Integer 
integerAnd :: Integer -> Integer -> Integer 
integerOr :: Integer -> Integer -> Integer 
integerSqrt :: Integer -> (Integer, Integer) 
integerToIntList :: Integer -> [Int] 

Interrupt

setUserInterrupt :: (Maybe (IO ())) -> IO (Maybe (IO ())) 

LazyArray

Similar LibArray.array, but builds the array lazily.
array :: (Ix a) => (a, a) -> [(a, b)] -> Array a [b] 

ListMap

Lists as finite mappings.
type ListMap a b = [(a, b)]
empty :: ListMap a b 
singleton :: (a, b) -> ListMap a b 
union :: (Eq a) => (ListMap a b) -> (ListMap a b) -> ListMap a b 
unionMany :: (Eq a) => [ListMap a b] -> ListMap a b 
add :: (Eq a) => (a, b) -> (ListMap a b) -> ListMap a b 
addKeep :: (Eq a) => (a, b) -> (ListMap a b) -> ListMap a b 
amap :: (a -> b) -> (ListMap c a) -> ListMap c b 
toList :: (ListMap a b) -> [(a, b)] 
fromList :: [(a, b)] -> ListMap a b 
length :: (ListMap a b) -> Int 
null :: (ListMap a b) -> Bool 
isSingleton :: (ListMap a b) -> Bool 
elems :: (ListMap a b) -> [b] 
indices :: (ListMap a b) -> [a] 
(!) :: (Eq a) => (ListMap a b) -> a -> b 
lookup :: (Eq a) => a -> (ListMap a b) -> Maybe b 
lookupWithDefault :: (Eq a) => [(a, b)] -> b -> a -> b 

ListOps

limit :: (Eq a) => [a] -> a 
limitBy :: (a -> a -> Bool) -> [a] -> a 
elemIndex :: (Eq a) => [a] -> a -> Int 
elemIndexBy :: (a -> a -> Bool) -> [a] -> a -> Int 
intersperse :: a -> [a] -> [a] 
uniqBy :: (a -> a -> Bool) -> [a] -> [a] 
uniq :: (Eq a) => [a] -> [a] 
deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] 
deleteFirsts :: (Eq a) => [a] -> [a] -> [a] 
elemBy :: (a -> a -> Bool) -> a -> [a] -> Bool 
notElemBy :: (a -> a -> Bool) -> a -> [a] -> Bool 
lookupBy :: (a -> a -> Bool) -> a -> [(a, b)] -> Maybe b 
products :: (Num a) => [a] -> [a] 
sums :: (Num a) => [a] -> [a] 
groupBy :: (a -> a -> Bool) -> [a] -> [[a]] 
group :: (Eq a) => [a] -> [[a]] 
inits :: [a] -> [[a]] 
subsequences :: [a] -> [[a]] 
tails :: [a] -> [[a]] 
permutations :: [a] -> [[a]] 

ListSet

Lists as sets.
empty :: [a] 
singleton :: a -> [a] 
union :: (Eq a) => [a] -> [a] -> [a] 
unionMany :: (Eq a) => [[a]] -> [a] 
add :: (Eq a) => a -> [a] -> [a] 
addMany :: (Eq a) => [a] -> [a] -> [a] 
deleteMany :: (Eq a) => [a] -> [a] -> [a] 
toList :: a -> a 
fromList :: a -> a 
intersect :: (Eq a) => [a] -> [a] -> [a] 
minus :: (Eq a) => [a] -> [a] -> [a] 
isSingleton :: [a] -> Bool 
intersecting :: (Eq a) => [a] -> [a] -> Bool 
isSubsetOf :: (Eq a) => [a] -> [a] -> Bool 

ListUtil

unfoldr :: (a -> (b, a)) -> (a -> Bool) -> a -> [b] 
chopList :: ([a] -> (b, [a])) -> [a] -> [b] 
breakAt :: (Eq a) => a -> [a] -> ([a], [a]) 
readListLazily :: (Read a) => String -> [a] 
mapFst :: (a -> b) -> [(a, c)] -> [(b, c)] 
mapSnd :: (a -> b) -> [(c, a)] -> [(c, b)] 
assoc :: (Eq c) => (a -> b) -> b -> [(c, a)] -> c -> b 

MonadUtil

(@@) :: (Monad c) => (a -> c b) -> (d -> c a) -> d -> c b 
mapAndUnzipR :: (Monad d) => (a -> d (b, c)) -> [a] -> d ([b], [c]) 
accumulateR :: (Monad b) => [b a] -> b [a] 
zipWithR :: (Monad d) => (a -> b -> d c) -> [a] -> [b] -> d [c] 
sequenceL :: (Monad b) => [b a] -> b () 
sequenceR :: (Monad b) => [b a] -> b () 
mapL :: (Monad c) => (a -> c b) -> [a] -> c [b] 
mapR :: (Monad c) => (a -> c b) -> [a] -> c [b] 
map_ :: (Monad c) => (a -> c b) -> [a] -> c () 
foldR :: (Monad c) => (a -> b -> c b) -> b -> [a] -> c b 
concatM :: (MonadPlus b) => [b a] -> b a 
done :: (Monad a) => a () 

MutArray

data (Ix b) => MutArray a b c
newMutArray :: (Ix a) => (a, a) -> b -> State.ST c (MutArray c a b) 
readMutArray :: (Ix b) => (MutArray a b c) -> b -> State.ST a c 
writeMutArray :: (Ix b) => (MutArray a b c) -> b -> c -> State.ST a () 
freezeMutArray :: (Ix b) => (MutArray a b c) -> State.ST a (Array b c) 

NameSupply

data NameSupply
initialNameSupply :: IO NameSupply 
splitNameSupply :: NameSupply -> (NameSupply, NameSupply) 
getName :: NameSupply -> Name 
listNameSupply :: NameSupply -> [NameSupply] 
listName :: NameSupply -> [Name] 
type Name = Int

Nat

data Nat__8.Nat8
data Nat__16.Nat16
data Nat__32.Nat32
data Nat__64.Nat64
instance Bounded Nat__16.Nat16
instance Bounded Nat__32.Nat32
instance Bounded Nat__64.Nat64
instance Bounded Nat__8.Nat8
instance Enum Nat__16.Nat16
instance Enum Nat__32.Nat32
instance Enum Nat__64.Nat64
instance Enum Nat__8.Nat8
instance Eq Nat__16.Nat16
instance Eq Nat__32.Nat32
instance Eq Nat__64.Nat64
instance Eq Nat__8.Nat8
instance Integral Nat__16.Nat16
instance Integral Nat__32.Nat32
instance Integral Nat__64.Nat64
instance Integral Nat__8.Nat8
instance Num Nat__16.Nat16
instance Num Nat__32.Nat32
instance Num Nat__64.Nat64
instance Num Nat__8.Nat8
instance Ord Nat__16.Nat16
instance Ord Nat__32.Nat32
instance Ord Nat__64.Nat64
instance Ord Nat__8.Nat8
instance Read Nat__16.Nat16
instance Read Nat__32.Nat32
instance Read Nat__64.Nat64
instance Read Nat__8.Nat8
instance Real Nat__16.Nat16
instance Real Nat__32.Nat32
instance Real Nat__64.Nat64
instance Real Nat__8.Nat8
instance Show Nat__16.Nat16
instance Show Nat__32.Nat32
instance Show Nat__64.Nat64
instance Show Nat__8.Nat8

Native

Functions to convert the primitive types Int, Float, and Double to their native representation as a list of bytes (Char). If such a list is read/written to a file it will have the same format as when, e.g., C read/writes then same kind of data.
class Native a where 
    showBytes :: a -> Bytes -> Bytes
    listShowBytes :: [a] -> Bytes -> Bytes
    readBytes :: Bytes -> Maybe (a, Bytes)
    listReadBytes :: Int -> Bytes -> Maybe ([a], Bytes)
type Bytes = [Char]
shortIntToBytes :: Int -> Bytes -> Bytes 
bytesToShortInt :: Bytes -> Maybe (Int, Bytes) 
longIntToBytes :: Int -> Bytes -> Bytes 
bytesToLongInt :: Bytes -> Maybe (Int, Bytes) 
showB :: (Native a) => a -> Bytes 
readB :: (Native a) => Bytes -> a 
instance (Native a, Native b) => Native (a, b)
instance (Native a, Native b, Native c) => Native (a, b, c)
instance Native Bool
instance Native Char
instance Native Double
instance Native Float
instance Native Int
instance (Native a) => Native (Maybe a)
instance (Native a) => Native [a]
instance (Native a, Ix a, Native b) => Native (Array a b)

Natural

data Natural = Zero | Succ !Natural
instance Ix Natural
instance Enum Natural
instance Eq Natural
instance Integral Natural
instance Num Natural
instance Ord Natural
instance Read Natural
instance Real Natural
instance Show Natural

NonStdTrace

Side effect tracing!
trace :: String -> a -> a 

Number

Simple numbers that belong to all numeric classes and behave like a naive user would expect (except that printing is still ugly). Use 'default Number' to get it everywhere.
data Number
isInteger :: Number -> Bool 
instance Ix Number
instance Enum Number
instance Eq Number
instance Floating Number
instance Fractional Number
instance Integral Number
instance Num Number
instance Ord Number
instance Read Number
instance Real Number
instance RealFloat Number
instance RealFrac Number
instance Show Number

OrdMap

Finite mappings with ordered keys.
data OrdMap a b
empty :: OrdMap a b 
singleton :: (Ord a) => (a, b) -> OrdMap a b 
union :: (Ord a) => (OrdMap a b) -> (OrdMap a b) -> OrdMap a b 
unionMany :: (Ord a) => [OrdMap a b] -> OrdMap a b 
add :: (Ord a) => (a, b) -> (OrdMap a b) -> OrdMap a b 
(//) :: (Ord a) => (OrdMap a b) -> [(a, b)] -> OrdMap a b 
toList :: (OrdMap a b) -> [(a, b)] 
fromList :: (Ord a) => [(a, b)] -> OrdMap a b 
length :: (OrdMap a b) -> Int 
null :: (OrdMap a b) -> Bool 
isSingleton :: (OrdMap a b) -> Bool 
elems :: (OrdMap a b) -> [b] 
indices :: (OrdMap a b) -> [a] 
lookup :: (Ord a) => a -> (OrdMap a b) -> Maybe b 
lookupWithDefault :: (Ord a) => (OrdMap a b) -> b -> a -> b 
instance (Ord a, Eq b) => Eq (OrdMap a b)
instance (Ord a) => Functor (OrdMap a)
instance (Ord a, Show a, Show b) => Show (OrdMap a b)

OrdSet

Sets of ordered items.
data OrdSet a
empty :: OrdSet a 
singleton :: a -> OrdSet a 
union :: (Ord a) => (OrdSet a) -> (OrdSet a) -> OrdSet a 
unionMany :: (Ord a) => [OrdSet a] -> OrdSet a 
add :: (Ord a) => a -> (OrdSet a) -> OrdSet a 
addMany :: (Ord a) => [a] -> (OrdSet a) -> OrdSet a 
toList :: (OrdSet a) -> [a] 
fromList :: (Ord a) => [a] -> OrdSet a 
length :: (OrdSet a) -> Int 
null :: (OrdSet a) -> Bool 
isSingleton :: (OrdSet a) -> Bool 
elem :: (Ord a) => a -> (OrdSet a) -> Bool 
instance (Eq a) => Eq (OrdSet a)
instance (Ord a, Show a) => Show (OrdSet a)

PackedString

data PackedString
packString :: [Char] -> PackedString 
unpackPS :: PackedString -> String 
append :: PackedString -> PackedString -> PackedString 
(++) :: PackedString -> PackedString -> PackedString 
break :: (Char -> Bool) -> PackedString -> (PackedString, PackedString) 
concat :: [PackedString] -> PackedString 
cons :: Char -> PackedString -> PackedString 
drop :: Int -> PackedString -> PackedString 
dropWhile :: (Char -> Bool) -> PackedString -> PackedString 
elem :: Char -> PackedString -> Bool 
filter :: (Char -> Bool) -> PackedString -> PackedString 
foldl :: (a -> Char -> a) -> a -> PackedString -> a 
foldr :: (Char -> a -> a) -> a -> PackedString -> a 
fromList :: [Char] -> PackedString 
head :: PackedString -> Char 
(!!) :: PackedString -> Int -> Char 
length :: PackedString -> Int 
lines :: PackedString -> [PackedString] 
map :: (Char -> Char) -> PackedString -> PackedString 
nil :: PackedString 
null :: PackedString -> Bool 
reverse :: PackedString -> PackedString 
span :: (Char -> Bool) -> PackedString -> (PackedString, PackedString) 
splitAt :: Int -> PackedString -> (PackedString, PackedString) 
substr :: PackedString -> Int -> Int -> PackedString 
tail :: PackedString -> PackedString 
take :: Int -> PackedString -> PackedString 
takeWhile :: (Char -> Bool) -> PackedString -> PackedString 
toList :: PackedString -> String 
unlines :: [PackedString] -> PackedString 
unwords :: [PackedString] -> PackedString 
words :: PackedString -> [PackedString] 
hPut :: Handle -> PackedString -> IO () 
hGetContents :: Handle -> IO PackedString 
data Handle
instance Eq Handle
instance Eq PackedString
instance Ord PackedString
instance Read PackedString
instance Show Handle
instance Show PackedString

Parse

Higher order functions to make parsers. A (Parser a b) takes a list of a and returns a list of possible parsings of this string. A parsing consists of a b value, and a list of remaining as. Parsing combinatores with good error reporting.
infixr 8 +.+
infixr 8 ..+
infixr 8 +..
infixr 4 |||
infix  6 >>-
infix  6 >>>
infixr 4 ||!
infixr 4 |!!
infix  6 .>
infix  6 `into`
type Parser a b = a -> Int -> ParseResult a b
(+.+) :: (Parser a b) -> (Parser a c) -> Parser a (b, c) 
(..+) :: (Parser a b) -> (Parser a c) -> Parser a c 
(+..) :: (Parser a b) -> (Parser a c) -> Parser a b 
(|||) :: (Parser a b) -> (Parser a b) -> Parser a b 
(>>-) :: (Parser a b) -> (b -> c) -> Parser a c 
(>>>) :: (Parser a (b, c)) -> (b -> c -> d) -> Parser a d 
(||!) :: (Parser a b) -> (Parser a b) -> Parser a b 
(|!!) :: (Parser a b) -> (Parser a b) -> Parser a b 
(.>) :: (Parser a b) -> c -> Parser a c 
into :: (Parser a b) -> (b -> Parser a c) -> Parser a c 
lit :: (Eq a, Show a) => a -> Parser [a] a 
litp :: String -> (a -> Bool) -> Parser [a] a 
many :: (Parser a b) -> Parser a [b] 
many1 :: (Parser a b) -> Parser a [b] 
succeed :: a -> Parser b a 
failure :: String -> Parser a b 
sepBy :: (Parser a b) -> (Parser a c) -> Parser a [b] 
count :: (Parser a b) -> Int -> Parser a [b] 
sepBy1 :: (Parser a b) -> (Parser a c) -> Parser a [b] 
testp :: String -> (a -> Bool) -> (Parser b a) -> Parser b a 
token :: (a -> Either String (b, a)) -> Parser a b 
recover :: (Parser a b) -> ([String] -> a -> Maybe (a, b)) -> Parser a b 
data ParseResult a b
parse :: (Parser a b) -> a -> Either ([String], a) [(b, a)] 
sParse :: (Show a) => (Parser [a] b) -> [a] -> Either String b 
simpleParse :: (Show a) => (Parser [a] b) -> [a] -> b 
instance (Show b, Show a) => Show (ParseResult a b)

Pretty

John Hughes' pretty printing library.
infixr 8 ~.
infixr 8 ^.
text :: String -> IText 
separate :: [IText] -> IText 
cseparate :: [IText] -> IText 
nest :: Int -> IText -> IText 
pretty :: Int -> Int -> IText -> String 
(~.) :: IText -> IText -> IText 
(^.) :: IText -> IText -> IText 
type IText = Context -> [String]
type Context = (Bool, Int, Int, Int)

Printf

C printf style formatting. Handles same types as printf in C, but requires the arguments to be tagged. Useful for formatting of floating point values.
data UPrintf = UChar Char | UString String | UInt Int | UInteger Integer | UFloat Float | UDouble Double
printf :: String -> [UPrintf] -> String 

PriorityQueue

Simple pairing heaps as priority queues.

Note: The ordering relation is given (explicitely or implicitely) when an empty queue is created.

data PriorityQueue a
empty :: (Ord a) => PriorityQueue a 
snoc :: a -> (PriorityQueue a) -> PriorityQueue a 
tail :: (PriorityQueue a) -> PriorityQueue a 
head :: (PriorityQueue a) -> a 
null :: (PriorityQueue a) -> Bool 
singleton :: (Ord a) => a -> PriorityQueue a 
emptyLE :: (a -> a -> Bool) -> PriorityQueue a 
merge :: (PriorityQueue a) -> (PriorityQueue a) -> PriorityQueue a 
size :: (PriorityQueue a) -> Int 
toList :: (PriorityQueue a) -> [a] 
fromList :: (Ord a) => [a] -> PriorityQueue a 
instance (Eq a) => Eq (PriorityQueue a)
instance (Show a) => Show (PriorityQueue a)

Queue

An implemenattion of Chris Okasaki's queues with O(1) insert and delete.
data Queue a
empty :: Queue a 
snoc :: a -> (Queue a) -> Queue a 
tail :: (Queue a) -> Queue a 
head :: (Queue a) -> a 
null :: (Queue a) -> Bool 
size :: (Queue a) -> Int 
toList :: (Queue a) -> [a] 
fromList :: [a] -> Queue a 
instance (Eq a) => Eq (Queue a)
instance Functor Queue
instance (Show a) => Show (Queue a)

RAList

An implementation of Chris Okasaki's random access lists, with O(1) head, tail, cons and O(log n) indexing.
data RAList a
(!!) :: (RAList a) -> Int -> a 
update :: (RAList a) -> Int -> a -> RAList a 
cons :: a -> (RAList a) -> RAList a 
head :: (RAList a) -> a 
tail :: (RAList a) -> RAList a 
null :: (RAList a) -> Bool 
nil :: RAList a 
empty :: RAList a 
singleton :: a -> RAList a 
toList :: (RAList a) -> [a] 
fromList :: [a] -> RAList a 
foldr :: (a -> b -> b) -> b -> (RAList a) -> b 
filter :: (a -> Bool) -> (RAList a) -> RAList a 
append :: (RAList a) -> (RAList a) -> RAList a 
reverse :: (RAList a) -> RAList a 
length :: (RAList a) -> Int 
size :: (RAList a) -> Int 
instance (Eq a) => Eq (RAList a)
instance Functor RAList
instance Monad RAList
instance MonadPlus RAList
instance MonadZero RAList
instance (Ord a) => Ord (RAList a)
instance (Show a) => Show (RAList a)

RandomHBC

randomInts :: Int -> Int -> [Int] 
randomDoubles :: Int -> Int -> [Double] 
normalRandomDoubles :: Int -> Int -> [Double] 

Scans

mapAccumL :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c]) 
mapAccumR :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c]) 

SelectIO

select :: SelectData -> IO (Maybe SelectData) 
type SelectData = ([Handle], [Handle], Maybe Double)

Signed

data Signed__8.Signed8
data Signed__16.Signed16
data Signed__32.Signed32
data Signed__64.Signed64
instance Bounded Signed__16.Signed16
instance Bounded Signed__32.Signed32
instance Bounded Signed__64.Signed64
instance Bounded Signed__8.Signed8
instance Enum Signed__16.Signed16
instance Enum Signed__32.Signed32
instance Enum Signed__64.Signed64
instance Enum Signed__8.Signed8
instance Eq Signed__16.Signed16
instance Eq Signed__32.Signed32
instance Eq Signed__64.Signed64
instance Eq Signed__8.Signed8
instance Integral Signed__16.Signed16
instance Integral Signed__32.Signed32
instance Integral Signed__64.Signed64
instance Integral Signed__8.Signed8
instance Num Signed__16.Signed16
instance Num Signed__32.Signed32
instance Num Signed__64.Signed64
instance Num Signed__8.Signed8
instance Ord Signed__16.Signed16
instance Ord Signed__32.Signed32
instance Ord Signed__64.Signed64
instance Ord Signed__8.Signed8
instance Read Signed__16.Signed16
instance Read Signed__32.Signed32
instance Read Signed__64.Signed64
instance Read Signed__8.Signed8
instance Real Signed__16.Signed16
instance Real Signed__32.Signed32
instance Real Signed__64.Signed64
instance Real Signed__8.Signed8
instance Show Signed__16.Signed16
instance Show Signed__32.Signed32
instance Show Signed__64.Signed64
instance Show Signed__8.Signed8

SimpleLex

simpleLex :: String -> [String] 

Sleep

sleep :: Double -> IO () 

Sort

sortLe :: (a -> a -> Bool) -> [a] -> [a] 

State

Mutable state with safe encapsulation.
infixr 0 >>=!
infixr 0 >>!
infixr 0 >>=?
infixr 0 >>?
data ST a b
runST :: (RunST a) -> a 
data RunST b = RunST (ST a b)
fixST :: (a -> ST b a) -> ST b a 
(>>=!) :: (ST a b) -> (b -> ST a c) -> ST a c 
(>>!) :: (ST a b) -> (ST a c) -> ST a c 
(>>=?) :: (ST a b) -> (b -> ST a c) -> ST a c 
(>>?) :: (ST a b) -> (ST a c) -> ST a c 
returnStrict :: a -> ST b a 
data MutableVar a b
newVar :: a -> ST b (MutableVar b a) 
readVar :: (MutableVar a b) -> ST a b 
writeVar :: (MutableVar a b) -> b -> ST a () 
sameVar :: (MutableVar a b) -> (MutableVar a b) -> Bool 
data MutVector a b
newMutVector :: Int -> a -> ST b (MutVector b a) 
readMutVector :: (MutVector a b) -> Int -> ST a b 
writeMutVector :: (MutVector a b) -> Int -> b -> ST a () 
instance Functor (ST a)
instance Monad (ST a)

Subsequences

suffixes :: [a] -> [[a]] 
prefixes :: [a] -> [[a]] 
subsequences :: [a] -> [[a]] 
permutations :: [a] -> [[a]] 
subsequence :: Int -> Int -> [a] -> [a] 
isPrefixOf :: (Eq a) => [a] -> [a] -> Bool 
isSuffixOf :: (Eq a) => [a] -> [a] -> Bool 
isSubsequenceOf :: (Eq a) => [a] -> [a] -> Bool 
isPermutationOf :: (Eq a) => [a] -> [a] -> Bool 
isPrefixOfBy :: (a -> a -> Bool) -> [a] -> [a] -> Bool 
isSuffixOfBy :: (a -> a -> Bool) -> [a] -> [a] -> Bool 
isSubsequenceOfBy :: (a -> a -> Bool) -> [a] -> [a] -> Bool 
isPermutationOfBy :: (a -> a -> Bool) -> [a] -> [a] -> Bool 
locateSubsequences :: (Eq a) => [a] -> [a] -> [Int] 

Terminal

setRaw :: IO () 
setCooked :: IO () 
readLine :: String -> String -> [String] -> IO String 

TimeIt

timeIO :: (IO a) -> IO a 
time :: (Show a) => a -> IO () 

Trace

trace :: String -> a -> a 

UnsafeDirty

This module contains highly unsafe operations. Some of them even have (GASP!!) *side effects*. Use with care, not even type safety is ensured.
infixr 0 `seq`
data LMLunsafe.Ref a
ref :: a -> LMLunsafe.Ref a 
assign :: (LMLunsafe.Ref a) -> a -> () 
deref :: (LMLunsafe.Ref a) -> a 
seq :: (Eval a) => a -> b -> b 
force :: a -> a 
instance Eq (LMLunsafe.Ref a)

UnsafePerformIO

unsafePerformIO :: (IO a) -> a 

Word

infixl 7 `bitAnd`
infixl 5 `bitOr`
infixl 6 `bitXor`
infixl 8 `bitRsh`
infixl 8 `bitLsh`
data Word
data Short
data Byte
wordToShorts :: Word -> [Short] 
wordToBytes :: Word -> [Byte] 
bytesToString :: [Byte] -> String 
class Bits a where 
    bitAnd :: a -> a -> a
    bitOr :: a -> a -> a
    bitXor :: a -> a -> a
    bitCompl :: a -> a
    bitRsh :: a -> Int -> a
    bitLsh :: a -> Int -> a
    bitSwap :: a -> a
    bit0 :: a
    bitSize :: a -> Int
wordToInt :: Word -> Int 
shortToInt :: Short -> Int 
byteToInt :: Byte -> Int 
instance Eq Word
instance Eq Short
instance Eq Byte
instance Num Word
instance Num Short
instance Num Byte
instance Ord Word
instance Ord Short
instance Ord Byte
instance Show Word
instance Show Short
instance Show Byte
instance Bits Word
instance Bits Short
instance Bits Byte

Last modified: Wed Apr 9 14:48:55 MEST 1997