+++ /dev/null
------------------------------------------------------------------------------
--- Standard Library: Array operations
---
--- Suitable for use with Hugs 98
------------------------------------------------------------------------------
-
-module Array (
- module Ix, -- export all of Ix
- Array, array, listArray, (!), bounds, indices, elems, assocs,
- accumArray, (//), accum, ixmap ) where
-
-import Ix
-import List( (\\) )
-
-infixl 9 !, //
-
-data Array ix elt = Array (ix,ix) (PrimArray elt)
-
-array :: Ix a => (a,a) -> [(a,b)] -> Array a b
-array ixs@(ix_start, ix_end) ivs = primRunST (do
- { mut_arr <- primNewArray (rangeSize ixs) arrEleBottom
- ; mapM_ (\ (i,v) -> primWriteArray mut_arr (index ixs i) v) ivs
- ; arr <- primUnsafeFreezeArray mut_arr
- ; return (Array ixs arr)
- }
- )
- where
- arrEleBottom = error "(Array.!): undefined array element"
-
-listArray :: Ix a => (a,a) -> [b] -> Array a b
-listArray b vs = array b (zipWith (\ a b -> (a,b)) (range b) vs)
-
-(!) :: Ix a => Array a b -> a -> b
-(Array bounds arr) ! i = primIndexArray arr (index bounds i)
-
-bounds :: Ix a => Array a b -> (a,a)
-bounds (Array b _) = b
-
-indices :: Ix a => Array a b -> [a]
-indices = range . bounds
-
-elems :: Ix a => Array a b -> [b]
-elems a = [a!i | i <- indices a]
-
-assocs :: Ix a => Array a b -> [(a,b)]
-assocs a = [(i, a!i) | i <- indices a]
-
-(//) :: Ix a => Array a b -> [(a,b)] -> Array a b
-a // us = array (bounds a)
- ([(i,a!i) | i <- indices a \\ [i | (i,_) <- us]]
- ++ us)
-
-accum :: Ix a => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b
-accum f = foldl (\a (i,v) -> a // [(i,f (a!i) v)])
-
-accumArray :: Ix a => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b
-accumArray f z b = accum f (array b [(i,z) | i <- range b])
-
-ixmap :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c -> Array a c
-ixmap b f a = array b [(i, a ! f i) | i <- range b]
-
-
-instance (Ix a) => Functor (Array a) where
- fmap f a = array (bounds a) [(i, f(a!i)) | i <- indices a]
-
-instance (Ix a, Eq b) => Eq (Array a b) where
- a == a' = assocs a == assocs a'
-
-instance (Ix a, Ord b) => Ord (Array a b) where
- a <= a' = assocs a <= assocs a'
-
-
-instance (Ix a, Show a, Show b) => Show (Array a b) where
- showsPrec p a = showParen (p > 9) (
- showString "array " .
- shows (bounds a) . showChar ' ' .
- shows (assocs a) )
-
-instance (Ix a, Read a, Read b) => Read (Array a b) where
- readsPrec p = readParen (p > 9)
- (\r -> [(array b as, u) | ("array",s) <- lex r,
- (b,t) <- reads s,
- (as,u) <- reads t ])
-
------------------------------------------------------------------------------
+++ /dev/null
------------------------------------------------------------------------------
--- Standard Library: Char operations
---
--- Suitable for use with Hugs 98
------------------------------------------------------------------------------
-
-module Char (
- isAscii, isLatin1, isControl, isPrint, isSpace, isUpper, isLower,
- isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
- digitToInt, intToDigit,
- toUpper, toLower,
- ord, chr,
- readLitChar, showLitChar, lexLitChar,
-
- -- ... and what the prelude exports
- Char, String
- ) where
-
--- This module is (almost) empty; Char operations are currently defined in
--- the prelude, but should eventually be moved to this library file instead.
--- No Unicode support yet.
-
-isLatin1 c = True
-
------------------------------------------------------------------------------
+++ /dev/null
------------------------------------------------------------------------------
--- Standard Library: Complex numbers
---
--- Suitable for use with Hugs 98
------------------------------------------------------------------------------
-
-module Complex(Complex((:+)), realPart, imagPart, conjugate, mkPolar,
- cis, polar, magnitude, phase) where
-
-infix 6 :+
-
-data (RealFloat a) => Complex a = !a :+ !a
- deriving (Eq,Read,Show)
-
-realPart, imagPart :: (RealFloat a) => Complex a -> a
-realPart (x:+y) = x
-imagPart (x:+y) = y
-
-conjugate :: (RealFloat a) => Complex a -> Complex a
-conjugate (x:+y) = x :+ (-y)
-
-mkPolar :: (RealFloat a) => a -> a -> Complex a
-mkPolar r theta = r * cos theta :+ r * sin theta
-
-cis :: (RealFloat a) => a -> Complex a
-cis theta = cos theta :+ sin theta
-
-polar :: (RealFloat a) => Complex a -> (a,a)
-polar z = (magnitude z, phase z)
-
-magnitude, phase :: (RealFloat a) => Complex a -> a
-magnitude (x:+y) = scaleFloat k
- (sqrt ((scaleFloat mk x)^2 + (scaleFloat mk y)^2))
- where k = max (exponent x) (exponent y)
- mk = - k
-phase (0:+0) = 0
-phase (x:+y) = atan2 y x
-
-instance (RealFloat a) => Num (Complex a) where
- (x:+y) + (x':+y') = (x+x') :+ (y+y')
- (x:+y) - (x':+y') = (x-x') :+ (y-y')
- (x:+y) * (x':+y') = (x*x'-y*y') :+ (x*y'+y*x')
- negate (x:+y) = negate x :+ negate y
- abs z = magnitude z :+ 0
- signum 0 = 0
- signum z@(x:+y) = x/r :+ y/r where r = magnitude z
- fromInteger n = fromInteger n :+ 0
- fromInt n = fromInt n :+ 0
-
-instance (RealFloat a) => Fractional (Complex a) where
- (x:+y) / (x':+y') = (x*x''+y*y'') / d :+ (y*x''-x*y'') / d
- where x'' = scaleFloat k x'
- y'' = scaleFloat k y'
- k = - max (exponent x') (exponent y')
- d = x'*x'' + y'*y''
- fromRational a = fromRational a :+ 0
- fromDouble a = fromDouble a :+ 0
-
-instance (RealFloat a) => Floating (Complex a) where
- pi = pi :+ 0
- exp (x:+y) = expx * cos y :+ expx * sin y
- where expx = exp x
- log z = log (magnitude z) :+ phase z
- sqrt 0 = 0
- sqrt z@(x:+y) = u :+ (if y < 0 then -v else v)
- where (u,v) = if x < 0 then (v',u') else (u',v')
- v' = abs y / (u'*2)
- u' = sqrt ((magnitude z + abs x) / 2)
- sin (x:+y) = sin x * cosh y :+ cos x * sinh y
- cos (x:+y) = cos x * cosh y :+ (- sin x * sinh y)
- tan (x:+y) = (sinx*coshy:+cosx*sinhy)/(cosx*coshy:+(-sinx*sinhy))
- where sinx = sin x
- cosx = cos x
- sinhy = sinh y
- coshy = cosh y
- sinh (x:+y) = cos y * sinh x :+ sin y * cosh x
- cosh (x:+y) = cos y * cosh x :+ sin y * sinh x
- tanh (x:+y) = (cosy*sinhx:+siny*coshx)/(cosy*coshx:+siny*sinhx)
- where siny = sin y
- cosy = cos y
- sinhx = sinh x
- coshx = cosh x
- asin z@(x:+y) = y':+(-x')
- where (x':+y') = log (((-y):+x) + sqrt (1 - z*z))
- acos z@(x:+y) = y'':+(-x'')
- where (x'':+y'') = log (z + ((-y'):+x'))
- (x':+y') = sqrt (1 - z*z)
- atan z@(x:+y) = y':+(-x')
- where (x':+y') = log (((1-y):+x) / sqrt (1+z*z))
- asinh z = log (z + sqrt (1+z*z))
- acosh z = log (z + (z+1) * sqrt ((z-1)/(z+1)))
- atanh z = log ((1+z) / sqrt (1-z*z))
-
------------------------------------------------------------------------------
+++ /dev/null
-
------------------------------------------------------------------------------
--- Standard Library: IO operations, beyond those included in the prelude
---
--- WARNING: The names and semantics of functions defined in this module
--- may change as the details of the IO standard are clarified.
---
--- WARNING: extremely kludgey, incomplete and just plain wrong.
------------------------------------------------------------------------------
-
-module IO (
--- Handle, HandlePosn,
- Handle,
--- IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
- IOMode(ReadMode,WriteMode,AppendMode),
- BufferMode(NoBuffering,LineBuffering,BlockBuffering),
- SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
- stdin, stdout, stderr,
- openFile, hClose,
--- hFileSize, hIsEOF, isEOF,
--- hSetBuffering, hGetBuffering, hFlush,
- hFlush,
- hGetPosn, hSetPosn,
--- hSeek, hIsSeekable,
--- hReady, hGetChar, hLookAhead, hGetContents,
- hGetChar, hGetLine, hGetContents,
- hPutChar, hPutStr, hPutStrLn, hPrint,
- hIsOpen, hIsClosed, hIsReadable, hIsWritable,
- isAlreadyExistsError, isDoesNotExistError, isAlreadyInUseError,
- isFullError, isEOFError,
- isIllegalOperation, isPermissionError, isUserError,
- ioeGetErrorString, ioeGetHandle, ioeGetFileName,
- try, bracket, bracket_,
-
- -- ... and what the Prelude exports
- IO,
- FilePath, IOError, ioError, userError, catch,
- putChar, putStr, putStrLn, print,
- getChar, getLine, getContents, interact,
- readFile, writeFile, appendFile, readIO, readLn
- ) where
-
-import Ix(Ix)
-
-unimp :: String -> a
-unimp s = error ("function not implemented: " ++ s)
-
-type FILE_STAR = Int
-type Ptr = Int
-nULL = 0 :: Int
-
-data Handle
- = Handle { name :: FilePath,
- file :: FILE_STAR, -- C handle
- state :: HState, -- open/closed/semiclosed
- mode :: IOMode,
- --seekable :: Bool,
- bmode :: BufferMode,
- buff :: Ptr,
- buffSize :: Int
- }
-
-instance Eq Handle where
- h1 == h2 = file h1 == file h2
-
-instance Show Handle where
- showsPrec _ h = showString ("<<handle " ++ name h ++ "=" ++ show (file h) ++ ">>")
-
-data HandlePosn
- = HandlePosn
- deriving (Eq, Show)
-
-
-data IOMode = ReadMode | WriteMode | AppendMode
- deriving (Eq, Ord, Ix, Bounded, Enum, Read, Show)
-
-data BufferMode = NoBuffering | LineBuffering
- | BlockBuffering
- deriving (Eq, Ord, Read, Show)
-
-data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
- deriving (Eq, Ord, Ix, Bounded, Enum, Read, Show)
-
-data HState = HOpen | HSemiClosed | HClosed
- deriving Eq
-
-stdin = Handle "stdin" (primRunST nh_stdin) HOpen ReadMode NoBuffering nULL 0
-stdout = Handle "stdout" (primRunST nh_stdout) HOpen WriteMode LineBuffering nULL 0
-stderr = Handle "stderr" (primRunST nh_stderr) HOpen WriteMode NoBuffering nULL 0
-
-openFile :: FilePath -> IOMode -> IO Handle
-openFile f mode
- = copy_String_to_cstring f >>= \nameptr ->
- nh_open nameptr (mode2num mode) >>= \fh ->
- nh_free nameptr >>
- if fh == nULL
- then (ioError.IOError) ("openFile: can't open " ++ f ++ " in " ++ show mode)
- else return (Handle f fh HOpen mode BlockBuffering nULL 0)
- where
- mode2num :: IOMode -> Int
- mode2num ReadMode = 0
- mode2num WriteMode = 1
- mode2num AppendMode = 2
-
-hClose :: Handle -> IO ()
-hClose h
- | not (state h == HOpen)
- = (ioError.IOError) ("hClose on non-open handle " ++ show h)
- | otherwise
- = nh_close (file h) >>
- nh_errno >>= \err ->
- if err == 0
- then return ()
- else (ioError.IOError) ("hClose: error closing " ++ name h)
-
-hFileSize :: Handle -> IO Integer
-hFileSize = unimp "IO.hFileSize"
-hIsEOF :: Handle -> IO Bool
-hIsEOF = unimp "IO.hIsEOF"
-isEOF :: IO Bool
-isEOF = hIsEOF stdin
-
-hSetBuffering :: Handle -> BufferMode -> IO ()
-hSetBuffering = unimp "IO.hSetBuffering"
-hGetBuffering :: Handle -> IO BufferMode
-hGetBuffering = unimp "IO.hGetBuffering"
-
-hFlush :: Handle -> IO ()
-hFlush h
- = if state h /= HOpen
- then (ioError.IOError) ("hFlush on closed/semiclosed file " ++ name h)
- else nh_flush (file h)
-
-hGetPosn :: Handle -> IO HandlePosn
-hGetPosn = unimp "IO.hGetPosn"
-hSetPosn :: HandlePosn -> IO ()
-hSetPosn = unimp "IO.hSetPosn"
-hSeek :: Handle -> SeekMode -> Integer -> IO ()
-hSeek = unimp "IO.hSeek"
-hWaitForInput :: Handle -> Int -> IO Bool
-hWaitForInput = unimp "hWaitForInput"
-hReady :: Handle -> IO Bool
-hReady h = hWaitForInput h 0
-
-hGetChar :: Handle -> IO Char
-hGetChar h
- = nh_read (file h) >>= \ci ->
- return (primIntToChar ci)
-
-hGetLine :: Handle -> IO String
-hGetLine h = do c <- hGetChar h
- if c=='\n' then return ""
- else do cs <- hGetLine h
- return (c:cs)
-
-hLookAhead :: Handle -> IO Char
-hLookAhead = unimp "IO.hLookAhead"
-
-hGetContents :: Handle -> IO String
-hGetContents h
- | not (state h == HOpen && mode h == ReadMode)
- = (ioError.IOError) ("hGetContents on invalid handle " ++ show h)
- | otherwise
- = read_all (file h)
- where
- read_all f
- = unsafeInterleaveIO (
- nh_read f >>= \ci ->
- if ci == -1
- then hClose h >> return []
- else read_all f >>= \rest ->
- return ((primIntToChar ci):rest)
- )
-
-hPutStr :: Handle -> String -> IO ()
-hPutStr h s
- | not (state h == HOpen && mode h /= ReadMode)
- = (ioError.IOError) ("hPutStr on invalid handle " ++ show h)
- | otherwise
- = write_all (file h) s
- where
- write_all f []
- = return ()
- write_all f (c:cs)
- = nh_write f (primCharToInt c) >>
- write_all f cs
-
-hPutChar :: Handle -> Char -> IO ()
-hPutChar h c = hPutStr h [c]
-
-hPutStrLn :: Handle -> String -> IO ()
-hPutStrLn h s = do { hPutStr h s; hPutChar h '\n' }
-
-hPrint :: Show a => Handle -> a -> IO ()
-hPrint h = hPutStrLn h . show
-
-hIsOpen, hIsClosed, hIsReadable, hIsWritable :: Handle -> IO Bool
-hIsOpen h = return (state h == HOpen)
-hIsClosed h = return (state h == HClosed)
-hIsReadable h = return (mode h == ReadMode)
-hIsWritable h = return (mode h == WriteMode)
-
-hIsSeekable :: Handle -> IO Bool
-hIsSeekable = unimp "IO.hIsSeekable"
-
-isIllegalOperation,
- isAlreadyExistsError,
- isDoesNotExistError,
- isAlreadyInUseError,
- isFullError,
- isEOFError,
- isPermissionError,
- isUserError :: IOError -> Bool
-
-isIllegalOperation = unimp "IO.isIllegalOperation"
-isAlreadyExistsError = unimp "IO.isAlreadyExistsError"
-isDoesNotExistError = unimp "IO.isDoesNotExistError"
-isAlreadyInUseError = unimp "IO.isAlreadyInUseError"
-isFullError = unimp "IO.isFullError"
-isEOFError = unimp "IO.isEOFError"
-isPermissionError = unimp "IO.isPermissionError"
-isUserError = unimp "IO.isUserError"
-
-
-ioeGetErrorString :: IOError -> String
-ioeGetErrorString = unimp "ioeGetErrorString"
-ioeGetHandle :: IOError -> Maybe Handle
-ioeGetHandle = unimp "ioeGetHandle"
-ioeGetFileName :: IOError -> Maybe FilePath
-ioeGetFileName = unimp "ioeGetFileName"
-
-try :: IO a -> IO (Either IOError a)
-try p = catch (p >>= (return . Right)) (return . Left)
-
-bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
-bracket before after m = do
- x <- before
- rs <- try (m x)
- after x
- case rs of
- Right r -> return r
- Left e -> ioError e
-
--- variant of the above where middle computation doesn't want x
-bracket_ :: IO a -> (a -> IO b) -> IO c -> IO c
-bracket_ before after m = do
- x <- before
- rs <- try m
- after x
- case rs of
- Right r -> return r
- Left e -> ioError e
-
------------------------------------------------------------------------------
-
+++ /dev/null
------------------------------------------------------------------------------
--- Standard Library: Ix operations
---
--- Suitable for use with Hugs 98
------------------------------------------------------------------------------
-
-module Ix (
- -- official Haskell 98 interface: Ix(range, index, inRange), rangeSize
- Ix(range, index, inRange, rangeSize)
- ) where
-
--- This module is empty; Ix is currently defined in the prelude, but should
--- eventually be moved to this library file instead.
-
------------------------------------------------------------------------------
+++ /dev/null
------------------------------------------------------------------------------
--- Standard Library: List operations
---
--- Suitable for use with Hugs 98
------------------------------------------------------------------------------
-
-module List (
- elemIndex, elemIndices,
- find, findIndex, findIndices,
- nub, nubBy, delete, deleteBy, (\\), deleteFirstsBy,
- union, unionBy, intersect, intersectBy,
- intersperse, transpose, partition, group, groupBy,
- inits, tails, isPrefixOf, isSuffixOf,
- mapAccumL, mapAccumR,
- sort, sortBy, insert, insertBy, maximumBy, minimumBy,
- genericLength, genericTake, genericDrop,
- genericSplitAt, genericIndex, genericReplicate,
- zip4, zip5, zip6, zip7,
- zipWith4, zipWith5, zipWith6, zipWith7,
- unzip4, unzip5, unzip6, unzip7, unfoldr,
-
- -- ... and what the Prelude exports
- -- List type: []((:), [])
- (:),
- map, (++), concat, filter,
- head, last, tail, init, null, length, (!!),
- foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1,
- iterate, repeat, replicate, cycle,
- take, drop, splitAt, takeWhile, dropWhile, span, break,
- lines, words, unlines, unwords, reverse, and, or,
- any, all, elem, notElem, lookup,
- sum, product, maximum, minimum, concatMap,
- zip, zip3, zipWith, zipWith3, unzip, unzip3
- ) where
-
-import Maybe( listToMaybe )
-
-infix 5 \\
-
-elemIndex :: Eq a => a -> [a] -> Maybe Int
-elemIndex x = findIndex (x ==)
-
-elemIndices :: Eq a => a -> [a] -> [Int]
-elemIndices x = findIndices (x ==)
-
-find :: (a -> Bool) -> [a] -> Maybe a
-find p = listToMaybe . filter p
-
-findIndex :: (a -> Bool) -> [a] -> Maybe Int
-findIndex p = listToMaybe . findIndices p
-
-findIndices :: (a -> Bool) -> [a] -> [Int]
-findIndices p xs = [ i | (x,i) <- zip xs [0..], p x ]
-
-nub :: (Eq a) => [a] -> [a]
-nub = nubBy (==)
-
-nubBy :: (a -> a -> Bool) -> [a] -> [a]
-nubBy eq [] = []
-nubBy eq (x:xs) = x : nubBy eq (filter (\y -> not (eq x y)) xs)
-
-delete :: (Eq a) => a -> [a] -> [a]
-delete = deleteBy (==)
-
-deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]
-deleteBy eq x [] = []
-deleteBy eq x (y:ys) = if x `eq` y then ys else y : deleteBy eq x ys
-
-(\\) :: (Eq a) => [a] -> [a] -> [a]
-(\\) = foldl (flip delete)
-
-deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
-deleteFirstsBy eq = foldl (flip (deleteBy eq))
-
-union :: (Eq a) => [a] -> [a] -> [a]
-union = unionBy (==)
-
-unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
-unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs
-
-intersect :: (Eq a) => [a] -> [a] -> [a]
-intersect = intersectBy (==)
-
-intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
-intersectBy eq xs ys = [x | x <- xs, any (eq x) ys]
-
-intersperse :: a -> [a] -> [a]
-intersperse sep [] = []
-intersperse sep [x] = [x]
-intersperse sep (x:xs) = x : sep : intersperse sep xs
-
-transpose :: [[a]] -> [[a]]
-transpose [] = []
-transpose ([] : xss) = transpose xss
-transpose ((x:xs) : xss) = (x : [h | (h:t) <- xss]) :
- transpose (xs : [ t | (h:t) <- xss])
-
-partition :: (a -> Bool) -> [a] -> ([a],[a])
-partition p xs = foldr select ([],[]) xs
- where select x (ts,fs) | p x = (x:ts,fs)
- | otherwise = (ts,x:fs)
-
--- group splits its list argument into a list of lists of equal, adjacent
--- elements. e.g.,
--- group "Mississippi" == ["M","i","ss","i","ss","i","pp","i"]
-group :: (Eq a) => [a] -> [[a]]
-group = groupBy (==)
-
-groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
-groupBy eq [] = []
-groupBy eq (x:xs) = (x:ys) : groupBy eq zs
- where (ys,zs) = span (eq x) xs
-
--- inits xs returns the list of initial segments of xs, shortest first.
--- e.g., inits "abc" == ["","a","ab","abc"]
-inits :: [a] -> [[a]]
-inits [] = [[]]
-inits (x:xs) = [[]] ++ map (x:) (inits xs)
-
--- tails xs returns the list of all final segments of xs, longest first.
--- e.g., tails "abc" == ["abc", "bc", "c",""]
-tails :: [a] -> [[a]]
-tails [] = [[]]
-tails xxs@(_:xs) = xxs : tails xs
-
-isPrefixOf :: (Eq a) => [a] -> [a] -> Bool
-isPrefixOf [] _ = True
-isPrefixOf _ [] = False
-isPrefixOf (x:xs) (y:ys) = x == y && isPrefixOf xs ys
-
-isSuffixOf :: (Eq a) => [a] -> [a] -> Bool
-isSuffixOf x y = reverse x `isPrefixOf` reverse y
-
-mapAccumL :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c])
-mapAccumL f s [] = (s, [])
-mapAccumL f s (x:xs) = (s'',y:ys)
- where (s', y ) = f s x
- (s'',ys) = mapAccumL f s' xs
-
-mapAccumR :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c])
-mapAccumR f s [] = (s, [])
-mapAccumR f s (x:xs) = (s'', y:ys)
- where (s'',y ) = f s' x
- (s', ys) = mapAccumR f s xs
-
-unfoldr :: (b -> Maybe (a,b)) -> b -> [a]
-unfoldr f b = case f b of Nothing -> []
- Just (a,b) -> a : unfoldr f b
-
-sort :: (Ord a) => [a] -> [a]
-sort = sortBy compare
-
-sortBy :: (a -> a -> Ordering) -> [a] -> [a]
-sortBy cmp = foldr (insertBy cmp) []
-
-insert :: (Ord a) => a -> [a] -> [a]
-insert = insertBy compare
-
-insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
-insertBy cmp x [] = [x]
-insertBy cmp x ys@(y:ys')
- = case cmp x y of
- GT -> y : insertBy cmp x ys'
- _ -> x : ys
-
-maximumBy :: (a -> a -> a) -> [a] -> a
-maximumBy max [] = error "List.maximumBy: empty list"
-maximumBy max xs = foldl1 max xs
-
-minimumBy :: (a -> a -> a) -> [a] -> a
-minimumBy min [] = error "List.minimumBy: empty list"
-minimumBy min xs = foldl1 min xs
-
-genericLength :: (Integral a) => [b] -> a
-genericLength [] = 0
-genericLength (x:xs) = 1 + genericLength xs
-
-genericTake :: (Integral a) => a -> [b] -> [b]
-genericTake 0 _ = []
-genericTake _ [] = []
-genericTake n (x:xs)
- | n > 0 = x : genericTake (n-1) xs
- | otherwise = error "List.genericTake: negative argument"
-
-genericDrop :: (Integral a) => a -> [b] -> [b]
-genericDrop 0 xs = xs
-genericDrop _ [] = []
-genericDrop n (_:xs)
- | n > 0 = genericDrop (n-1) xs
- | otherwise = error "List.genericDrop: negative argument"
-
-genericSplitAt :: (Integral a) => a -> [b] -> ([b],[b])
-genericSplitAt 0 xs = ([],xs)
-genericSplitAt _ [] = ([],[])
-genericSplitAt n (x:xs)
- | n > 0 = (x:xs',xs'')
- | otherwise = error "List.genericSplitAt: negative argument"
- where (xs',xs'') = genericSplitAt (n-1) xs
-
-genericIndex :: (Integral a) => [b] -> a -> b
-genericIndex (x:_) 0 = x
-genericIndex (_:xs) n
- | n > 0 = genericIndex xs (n-1)
- | otherwise = error "List.genericIndex: negative argument"
-genericIndex _ _ = error "List.genericIndex: index too large"
-
-genericReplicate :: (Integral a) => a -> b -> [b]
-genericReplicate n x = genericTake n (repeat x)
-
-zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
-zip4 = zipWith4 (,,,)
-
-zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
-zip5 = zipWith5 (,,,,)
-
-zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
- [(a,b,c,d,e,f)]
-zip6 = zipWith6 (,,,,,)
-
-zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
- [g] -> [(a,b,c,d,e,f,g)]
-zip7 = zipWith7 (,,,,,,)
-
-zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
-zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
- = z a b c d : zipWith4 z as bs cs ds
-zipWith4 _ _ _ _ _ = []
-
-zipWith5 :: (a->b->c->d->e->f) ->
- [a]->[b]->[c]->[d]->[e]->[f]
-zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
- = z a b c d e : zipWith5 z as bs cs ds es
-zipWith5 _ _ _ _ _ _ = []
-
-zipWith6 :: (a->b->c->d->e->f->g) ->
- [a]->[b]->[c]->[d]->[e]->[f]->[g]
-zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
- = z a b c d e f : zipWith6 z as bs cs ds es fs
-zipWith6 _ _ _ _ _ _ _ = []
-
-zipWith7 :: (a->b->c->d->e->f->g->h) ->
- [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
-zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
- = z a b c d e f g : zipWith7 z as bs cs ds es fs gs
-zipWith7 _ _ _ _ _ _ _ _ = []
-
-unzip4 :: [(a,b,c,d)] -> ([a],[b],[c],[d])
-unzip4 = foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
- (a:as,b:bs,c:cs,d:ds))
- ([],[],[],[])
-
-unzip5 :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])
-unzip5 = foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
- (a:as,b:bs,c:cs,d:ds,e:es))
- ([],[],[],[],[])
-
-unzip6 :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])
-unzip6 = foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
- (a:as,b:bs,c:cs,d:ds,e:es,f:fs))
- ([],[],[],[],[],[])
-
-unzip7 :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])
-unzip7 = foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
- (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))
- ([],[],[],[],[],[],[])
-
------------------------------------------------------------------------------
+++ /dev/null
------------------------------------------------------------------------------
--- Standard Library: Operations on the Maybe datatype
---
--- Suitable for use with Hugs 98
------------------------------------------------------------------------------
-module Maybe(
- isJust, fromJust, fromMaybe, listToMaybe, maybeToList,
- catMaybes, mapMaybe,
-
- -- ... and what the Prelude exports
- Maybe(Nothing, Just),
- maybe
- ) where
-
-isJust :: Maybe a -> Bool
-isJust (Just a) = True
-isJust Nothing = False
-
-fromJust :: Maybe a -> a
-fromJust (Just a) = a
-fromJust Nothing = error "Maybe.fromJust: Nothing"
-
-fromMaybe :: a -> Maybe a -> a
-fromMaybe d Nothing = d
-fromMaybe d (Just a) = a
-
-maybeToList :: Maybe a -> [a]
-maybeToList Nothing = []
-maybeToList (Just a) = [a]
-
-listToMaybe :: [a] -> Maybe a
-listToMaybe [] = Nothing
-listToMaybe (a:as) = Just a
-
-catMaybes :: [Maybe a] -> [a]
-catMaybes ms = [ m | Just m <- ms ]
-
-mapMaybe :: (a -> Maybe b) -> [a] -> [b]
-mapMaybe f = catMaybes . map f
-
------------------------------------------------------------------------------
+++ /dev/null
------------------------------------------------------------------------------
--- Standard Library: Monad operations
---
--- Suitable for use with Hugs 98
------------------------------------------------------------------------------
-
-module Monad (
- MonadPlus(mzero, mplus),
- join, guard, when, unless, ap,
- msum,
- filterM, mapAndUnzipM, zipWithM, zipWithM_, foldM,
- liftM, liftM2, liftM3, liftM4, liftM5,
-
- -- ... and what the Prelude exports
- Monad((>>=), (>>), return, fail),
- Functor(fmap),
- mapM, mapM_, accumulate, sequence, (=<<),
- ) where
-
--- The MonadPlus class definition
-
-class Monad m => MonadPlus m where
- mzero :: m a
- mplus :: m a -> m a -> m a
-
--- Instances of MonadPlus
-
-instance MonadPlus Maybe where
- mzero = Nothing
- Nothing `mplus` ys = ys
- xs `mplus` ys = xs
-
-instance MonadPlus [ ] where
- mzero = []
- mplus = (++)
-
--- Functions
-
-msum :: MonadPlus m => [m a] -> m a
-msum = foldr mplus mzero
-
-join :: (Monad m) => m (m a) -> m a
-join x = x >>= id
-
-when :: (Monad m) => Bool -> m () -> m ()
-when p s = if p then s else return ()
-
-unless :: (Monad m) => Bool -> m () -> m ()
-unless p s = when (not p) s
-
-ap :: (Monad m) => m (a -> b) -> m a -> m b
-ap = liftM2 ($)
-
-guard :: MonadPlus m => Bool -> m ()
-guard p = if p then return () else mzero
-
-mapAndUnzipM :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
-mapAndUnzipM f xs = accumulate (map f xs) >>= return . unzip
-
-zipWithM :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
-zipWithM f xs ys = accumulate (zipWith f xs ys)
-
-zipWithM_ :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
-zipWithM_ f xs ys = sequence (zipWith f xs ys)
-
-foldM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
-foldM f a [] = return a
-foldM f a (x:xs) = f a x >>= \ y -> foldM f y xs
-
-filterM :: MonadPlus m => (a -> m Bool) -> [a] -> m [a]
-filterM p [] = return []
-filterM p (x:xs) = do b <- p x
- ys <- filterM p xs
- return (if b then (x:ys) else ys)
-
-liftM :: (Monad m) => (a -> b) -> (m a -> m b)
-liftM f = \a -> do { a' <- a; return (f a') }
-
-liftM2 :: (Monad m) => (a -> b -> c) -> (m a -> m b -> m c)
-liftM2 f = \a b -> do { a' <- a; b' <- b; return (f a' b') }
-
-liftM3 :: (Monad m) => (a -> b -> c -> d) ->
- (m a -> m b -> m c -> m d)
-liftM3 f = \a b c -> do { a' <- a; b' <- b; c' <- c;
- return (f a' b' c')}
-
-liftM4 :: (Monad m) => (a -> b -> c -> d -> e) ->
- (m a -> m b -> m c -> m d -> m e)
-liftM4 f = \a b c d -> do { a' <- a; b' <- b; c' <- c; d' <- d;
- return (f a' b' c' d')}
-
-liftM5 :: (Monad m) => (a -> b -> c -> d -> e -> f) ->
- (m a -> m b -> m c -> m d -> m e -> m f)
-liftM5 f = \a b c d e -> do { a' <- a; b' <- b; c' <- c; d' <- d;
- e' <- e; return (f a' b' c' d' e')}
-
------------------------------------------------------------------------------
isInfinite, isDenormalized, isIEEE, isNegativeZero),
Monad((>>=), (>>), return, fail),
Functor(fmap),
- mapM, mapM_, accumulate, sequence, (=<<),
+ mapM, mapM_, sequence, sequence_, (=<<),
maybe, either,
(&&), (||), not, otherwise,
subtract, even, odd, gcd, lcm, (^), (^^),
,primUnsafeFreezeArray,primIndexArray,primGetRawArgs,primGetEnv
,nh_stdin,nh_stdout,nh_stderr,copy_String_to_cstring,nh_open
,nh_free,nh_close,nh_errno,nh_flush,nh_read,primIntToChar
- ,unsafeInterleaveIO,nh_write,primCharToInt
-
+ ,unsafeInterleaveIO,nh_write,primCharToInt,
+ nullAddr, incAddr, isNullAddr,
-- debugging hacks
--,ST(..)
--,primIntToAddr
p >> q = p >>= \ _ -> q
fail s = error s
-accumulate :: Monad m => [m a] -> m [a]
-accumulate [] = return []
-accumulate (c:cs) = do x <- c
- xs <- accumulate cs
- return (x:xs)
+sequence :: Monad m => [m a] -> m [a]
+sequence [] = return []
+sequence (c:cs) = do x <- c
+ xs <- sequence cs
+ return (x:xs)
-sequence :: Monad m => [m a] -> m ()
-sequence = foldr (>>) (return ())
+sequence_ :: Monad m => [m a] -> m ()
+sequence_ = foldr (>>) (return ())
mapM :: Monad m => (a -> m b) -> [a] -> m [b]
-mapM f = accumulate . map f
+mapM f = sequence . map f
mapM_ :: Monad m => (a -> m b) -> [a] -> m ()
-mapM_ f = sequence . map f
+mapM_ f = sequence_ . map f
(=<<) :: Monad m => (a -> m b) -> m a -> m b
f =<< x = x >>= f
-- data (a,b) = (a,b) deriving (Eq, Ord, Ix, Read, Show)
-- etc..
--- Functions ----------------------------------------------------------------
-
-instance Show (a -> b) where
- showsPrec p f = showString "<<function>>"
-
-instance Functor ((->) a) where
- fmap = (.)
-
-- Standard Integral types --------------------------------------------------
data Int -- builtin datatype of fixed size integers
primGetRawArgs :: IO [String]
primGetRawArgs
= primGetArgc >>= \argc ->
- accumulate (map get_one_arg [0 .. argc-1])
+ sequence (map get_one_arg [0 .. argc-1])
where
get_one_arg :: Int -> IO String
get_one_arg argno
+++ /dev/null
------------------------------------------------------------------------------
--- Standard Library: Ratio and Rational types and operations
---
--- Suitable for use with Hugs 98
------------------------------------------------------------------------------
-
-module Ratio (
- Ratio, Rational, (%), numerator, denominator, approxRational ) where
-
--- This module is empty; Rational is currently defined in the prelude,
--- but should eventually be moved to this library file instead.
-
------------------------------------------------------------------------------
+++ /dev/null
------------------------------------------------------------------------------
--- Standard Library: System operations
---
--- Warning: the implementation of these functions in Hugs 98 is very weak.
--- The functions themselves are best suited to uses in compiled programs,
--- and not to use in an interpreter-based environment like Hugs.
---
--- Suitable for use with Hugs 98
------------------------------------------------------------------------------
-
-module System (
- ExitCode(..), exitWith, exitFailure,
- getArgs, getProgName, getEnv,
- system
- ) where
-
-data ExitCode = ExitSuccess | ExitFailure Int
- deriving (Eq, Ord, Read, Show)
-
-getArgs :: IO [String]
-getArgs = primGetRawArgs >>= \rawargs ->
- return (drop 1 (dropWhile (/= "--") rawargs))
-
-getProgName :: IO String
-getProgName = primGetRawArgs >>= \rawargs ->
- return (head rawargs)
-
-getEnv :: String -> IO String
-getEnv = primGetEnv
-
-system :: String -> IO ExitCode
-system s = error "System.system unimplemented"
-
-exitWith :: ExitCode -> IO a
-exitWith c = error "System.exitWith unimplemented"
-
-exitFailure :: IO a
-exitFailure = exitWith (ExitFailure 1)
-
-toExitCode :: Int -> ExitCode
-toExitCode 0 = ExitSuccess
-toExitCode n = ExitFailure n
-
-fromExitCode :: ExitCode -> Int
-fromExitCode ExitSuccess = 0
-fromExitCode (ExitFailure n) = n
-
------------------------------------------------------------------------------
isInfinite, isDenormalized, isIEEE, isNegativeZero),
Monad((>>=), (>>), return, fail),
Functor(fmap),
- mapM, mapM_, accumulate, sequence, (=<<),
+ mapM, mapM_, sequence, sequence_, (=<<),
maybe, either,
(&&), (||), not, otherwise,
subtract, even, odd, gcd, lcm, (^), (^^),
,primUnsafeFreezeArray,primIndexArray,primGetRawArgs,primGetEnv
,nh_stdin,nh_stdout,nh_stderr,copy_String_to_cstring,nh_open
,nh_free,nh_close,nh_errno,nh_flush,nh_read,primIntToChar
- ,unsafeInterleaveIO,nh_write,primCharToInt
-
+ ,unsafeInterleaveIO,nh_write,primCharToInt,
+ nullAddr, incAddr, isNullAddr,
-- debugging hacks
--,ST(..)
--,primIntToAddr
p >> q = p >>= \ _ -> q
fail s = error s
-accumulate :: Monad m => [m a] -> m [a]
-accumulate [] = return []
-accumulate (c:cs) = do x <- c
- xs <- accumulate cs
- return (x:xs)
+sequence :: Monad m => [m a] -> m [a]
+sequence [] = return []
+sequence (c:cs) = do x <- c
+ xs <- sequence cs
+ return (x:xs)
-sequence :: Monad m => [m a] -> m ()
-sequence = foldr (>>) (return ())
+sequence_ :: Monad m => [m a] -> m ()
+sequence_ = foldr (>>) (return ())
mapM :: Monad m => (a -> m b) -> [a] -> m [b]
-mapM f = accumulate . map f
+mapM f = sequence . map f
mapM_ :: Monad m => (a -> m b) -> [a] -> m ()
-mapM_ f = sequence . map f
+mapM_ f = sequence_ . map f
(=<<) :: Monad m => (a -> m b) -> m a -> m b
f =<< x = x >>= f
-- data (a,b) = (a,b) deriving (Eq, Ord, Ix, Read, Show)
-- etc..
--- Functions ----------------------------------------------------------------
-
-instance Show (a -> b) where
- showsPrec p f = showString "<<function>>"
-
-instance Functor ((->) a) where
- fmap = (.)
-
-- Standard Integral types --------------------------------------------------
data Int -- builtin datatype of fixed size integers
primGetRawArgs :: IO [String]
primGetRawArgs
= primGetArgc >>= \argc ->
- accumulate (map get_one_arg [0 .. argc-1])
+ sequence (map get_one_arg [0 .. argc-1])
where
get_one_arg :: Int -> IO String
get_one_arg argno
projects / ghc-hetmet.git / commitdiff