This documentation is stolen directly from the HBC distribution. The modules that GHC does not support (because they require HBC-specific extensions) are omitted.
data Either a b = Left a | Right bThe constructor `Left' is typically used for errors; it can be renamed to `Wrong' on import.
data Maybe a = Nothing | Just a thenM :: Maybe a -> (a -> Maybe b) -> Maybe b -- apply a function that may fail
data Option a = None | Some a thenO :: Option a -> (a -> Option b) -> Option b
assoc :: (Eq c) => (a -> b) -> b -> [(c, a)] -> c -> b -- assoc f d l k looks for k in the association list l, if it -- is found f is applied to the value, otherwise d is returned. concatMap :: (a -> [b]) -> [a] -> [b] -- flattening map (LML's concmap) unfoldr :: (a -> (b, a)) -> (a -> Bool) -> a -> [b] -- unfoldr f p x repeatedly applies f to x until (p x) holds. -- (f x) should give a list element and a new x. mapAccuml :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c]) -- mapAccuml f s l maps f over l, but also threads the state s -- through (LML's mapstate). union :: (Eq a) => [a] -> [a] -> [a] -- union of two lists intersection :: (Eq a) => [a] -> [a] -> [a] -- intersection of two lists chopList :: ([a] -> (b, [a])) -> [a] -> [b] -- LMLs choplist assocDef :: (Eq a) => [(a, b)] -> b -> a -> b -- LMLs assocdef lookup :: (Eq a) => [(a, b)] -> a -> Option b -- lookup l k looks for the key k in the association list l -- and returns an optional value tails :: [a] -> [[a]] -- return all the tails of a list rept :: (Integral a) => a -> b -> [b] -- repeat a value a number of times groupEq :: (a->a->Bool) -> [a] -> [[a]] -- group list elements according to an equality predicate group :: (Eq a) => [a] -> [[a]] -- group according to} == readListLazily :: (Text a) => String -> [a] -- read a list in a lazy fashion
type Context = (Bool, Int, Int, Int) type IText = Context -> [String] text :: String -> IText -- just text (~.) :: IText -> IText -> IText -- horizontal composition (^.) :: IText -> IText -> IText -- vertical composition separate :: [IText] -> IText -- separate by spaces nest :: Int -> IText -> IText -- indent pretty :: Int -> Int -> IText -> String -- format it
sortLe :: (a -> a -> Bool) -> [a] -> [a] -- sort le l sorts l with le as less than predicate sort :: (Ord a) => [a] -> [a] -- sort l sorts l using the Ord class
randomInts :: Int -> Int -> [Int] -- given two seeds gives a list of random Int randomDoubles :: Int -> Int -> [Double] -- random Double with uniform distribution in (0,1) normalRandomDoubles :: Int -> Int -> [Double] -- random Double with normal distribution, mean 0, variance 1
trace :: String -> a -> a -- trace x y prints x and returns y
class Bits a where bitAnd :: a -> a -> a -- bitwise and bitOr :: a -> a -> a -- bitwise or bitXor :: a -> a -> a -- bitwise xor bitCompl :: a -> a -- bitwise negation bitRsh :: a -> Int -> a -- bitwise right shift bitLsh :: a -> Int -> a -- bitwise left shift bitSwap :: a -> a -- swap word halves bit0 :: a -- word with least significant bit set bitSize :: a -> Int -- number of bits in a word data Byte -- 8 bit quantity data Short -- 16 bit quantity data Word -- 32 bit quantity instance Bits Byte, Bits Short, Bits Word instance Eq Byte, Eq Short, Eq Word instance Ord Byte, Ord Short, Ord Word instance Text Byte, Text Short, Text Word instance Num Byte, Num Short, Num Word wordToShorts :: Word -> [Short] -- convert a Word to two Short wordToBytes :: Word -> [Byte] -- convert a Word to four Byte bytesToString :: [Byte] -> String -- convert a list of Byte to a String (bit by bit) wordToInt :: Word -> Int -- convert a Word to Int shortToInt :: Short -> Int -- convert a Short to Int byteToInt :: Byte -> Int -- convert a Byte to Int
-- year mon day hour min sec dec-sec weekday data Time = Time Int Int Int Int Int Int Double Int dblToTime :: Double -> Time -- convert a Double to a Time timeToDbl :: Time -> Double -- convert a Time to a Double timeToString :: Time -> String -- convert a Time to a readable String
class Hashable a where hash :: a -> Int -- hash a value, return an Int -- instances for all Prelude types hashToMax :: (Hashable a) => Int -> a -> Int -- hash into interval [0..x-1]
type Name = Int initialNameSupply :: NameSupply -- The initial name supply (may be different every -- time the program is run. splitNameSupply :: NameSupply -> (NameSupply,NameSupply) -- split the namesupply into two getName :: NameSupply -> Name -- get the name associated with a name supply
infixr 8 +.+ , ..+ , +.. infix 6 `act` , >>> , `into` , .> infixr 4 ||| , ||! , |!! data ParseResult a b type Parser a b = a -> Int -> ParseResult a b (|||) :: Parser a b -> Parser a b -> Parser a b -- Alternative (||!) :: Parser a b -> Parser a b -> Parser a b -- Alternative, but with committed choice (|!!) :: Parser a b -> Parser a b -> Parser a b -- Alternative, but with committed choice (+.+) :: Parser a b -> Parser a c -> Parser a (b,c) -- Sequence (..+) :: Parser a b -> Parser a c -> Parser a c -- Sequence, throw away first part (+..) :: Parser a b -> Parser a c -> Parser a b -- Sequence, throw away second part act :: Parser a b -> (b->c) -> Parser a c -- Action (>>>) :: Parser a (b,c) -> (b->c->d) -> Parser a d -- Action on two items (.>) :: Parser a b -> c -> Parse a c -- Action ignoring value into :: Parser a b -> (b -> Parser a c) -> Parser a c -- Use a produced value in a parser. succeed b :: Parser a b -- Always succeeds without consuming a token failP :: Parser a b -- Always fails. many :: Parser a b -> Parser a [b] -- Kleene star many1 :: Parser a b -> Parser a [b] -- Kleene plus count :: Parser a b -> Int -> Parser a [b] -- Parse an exact number of items sepBy1 :: Parser a b -> Parser a c -> Parser a [b] -- Non-empty sequence of items separated by something sepBy :: Parser a b -> Parser a c -> Parser a [b] -- Sequence of items separated by something lit :: (Eq a, Text a) => a -> Parser [a] a -- Recognise a literal token from a list of tokens litp :: String -> (a->Bool) -> Parser [a] a -- Recognise a token with a predicate. -- The string is a description for error messages. testp :: String -> (a -> Bool) -> (Parser b a) -> Parser b a -- Test a semantic value. token :: (a -> Either String (b, a)) -> Parser a b -- General token recogniser. parse :: Parser a b -> a -> Either ([String], a) [(b, a)] -- Do a parse. Return either error (possible tokens and rest -- of tokens) or all possible parses. sParse :: (Text a) => (Parser [a] b) -> [a] -> Either String b -- Simple parse. Return error message or result.
type Bytes = [Char] -- A byte stream is just a list of characters class Native a where showBytes :: a -> Bytes -> Bytes -- prepend the representation of an item the a byte stream listShowBytes :: [a] -> Bytes -> Bytes -- prepend the representation of a list of items to a stream -- (may be more efficient than repeating showBytes). readBytes :: Bytes -> Maybe (a, Bytes) -- get an item from the stream and return the rest, -- or fail if the stream is to short. listReadBytes :: Int -> Bytes -> Maybe ([a], Bytes) -- read n items from a stream. instance Native Int instance Native Float instance Native Double instance (Native a, Native b) => Native (a,b) -- juxtaposition of the two items instance (Native a, Native b, Native c) => Native (a, b, c) -- juxtaposition of the three items instance (Native a) => Native [a] -- an item count in an Int followed by the items shortIntToBytes :: Int -> Bytes -> Bytes -- Convert an Int to what corresponds to a short in C. bytesToShortInt :: Bytes -> Maybe (Int, Bytes) -- Get a short from a byte stream and convert to an Int. showB :: (Native a) => a -> Bytes -- Simple interface to showBytes. readB :: (Native a) => Bytes -> a -- Simple interface to readBytes.
data Number -- The type itself. instance ... -- All reasonable instances. isInteger :: Number -> Bool -- Test if a Number is an integer.