From 6a04b1197460b491c0bd8974c05f585db28fea6d Mon Sep 17 00:00:00 2001 From: andy Date: Mon, 1 Nov 1999 02:38:33 +0000 Subject: [PATCH] [project @ 1999-11-01 02:38:31 by andy] minor tweaks to do with H98 (like sequence => sequence_, etc) Removing the lib/*hs standard libs to make way for the automatically generated ones. --- ghc/interpreter/lib/Array.hs | 85 ------------- ghc/interpreter/lib/Char.hs | 25 ---- ghc/interpreter/lib/Complex.hs | 94 -------------- ghc/interpreter/lib/IO.hs | 255 -------------------------------------- ghc/interpreter/lib/Ix.hs | 15 --- ghc/interpreter/lib/List.hs | 267 ---------------------------------------- ghc/interpreter/lib/Maybe.hs | 41 ------ ghc/interpreter/lib/Monad.hs | 97 --------------- ghc/interpreter/lib/Prelude.hs | 34 ++--- ghc/interpreter/lib/Ratio.hs | 13 -- ghc/interpreter/lib/System.hs | 48 -------- ghc/lib/hugs/Prelude.hs | 34 ++--- 12 files changed, 26 insertions(+), 982 deletions(-) delete mode 100644 ghc/interpreter/lib/Array.hs delete mode 100644 ghc/interpreter/lib/Char.hs delete mode 100644 ghc/interpreter/lib/Complex.hs delete mode 100644 ghc/interpreter/lib/IO.hs delete mode 100644 ghc/interpreter/lib/Ix.hs delete mode 100644 ghc/interpreter/lib/List.hs delete mode 100644 ghc/interpreter/lib/Maybe.hs delete mode 100644 ghc/interpreter/lib/Monad.hs delete mode 100644 ghc/interpreter/lib/Ratio.hs delete mode 100644 ghc/interpreter/lib/System.hs diff --git a/ghc/interpreter/lib/Array.hs b/ghc/interpreter/lib/Array.hs deleted file mode 100644 index 8bd5ce4..0000000 --- a/ghc/interpreter/lib/Array.hs +++ /dev/null @@ -1,85 +0,0 @@ ------------------------------------------------------------------------------ --- 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 ]) - ------------------------------------------------------------------------------ diff --git a/ghc/interpreter/lib/Char.hs b/ghc/interpreter/lib/Char.hs deleted file mode 100644 index dc2d256..0000000 --- a/ghc/interpreter/lib/Char.hs +++ /dev/null @@ -1,25 +0,0 @@ ------------------------------------------------------------------------------ --- 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 - ------------------------------------------------------------------------------ diff --git a/ghc/interpreter/lib/Complex.hs b/ghc/interpreter/lib/Complex.hs deleted file mode 100644 index 4f54283..0000000 --- a/ghc/interpreter/lib/Complex.hs +++ /dev/null @@ -1,94 +0,0 @@ ------------------------------------------------------------------------------ --- 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)) - ------------------------------------------------------------------------------ diff --git a/ghc/interpreter/lib/IO.hs b/ghc/interpreter/lib/IO.hs deleted file mode 100644 index 3c8c3d2..0000000 --- a/ghc/interpreter/lib/IO.hs +++ /dev/null @@ -1,255 +0,0 @@ - ------------------------------------------------------------------------------ --- 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 ("<>") - -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 - ------------------------------------------------------------------------------ - diff --git a/ghc/interpreter/lib/Ix.hs b/ghc/interpreter/lib/Ix.hs deleted file mode 100644 index 9d9531a..0000000 --- a/ghc/interpreter/lib/Ix.hs +++ /dev/null @@ -1,15 +0,0 @@ ------------------------------------------------------------------------------ --- 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. - ------------------------------------------------------------------------------ diff --git a/ghc/interpreter/lib/List.hs b/ghc/interpreter/lib/List.hs deleted file mode 100644 index bb10d13..0000000 --- a/ghc/interpreter/lib/List.hs +++ /dev/null @@ -1,267 +0,0 @@ ------------------------------------------------------------------------------ --- 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)) - ([],[],[],[],[],[],[]) - ------------------------------------------------------------------------------ diff --git a/ghc/interpreter/lib/Maybe.hs b/ghc/interpreter/lib/Maybe.hs deleted file mode 100644 index c1a1ee3..0000000 --- a/ghc/interpreter/lib/Maybe.hs +++ /dev/null @@ -1,41 +0,0 @@ ------------------------------------------------------------------------------ --- 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 - ------------------------------------------------------------------------------ diff --git a/ghc/interpreter/lib/Monad.hs b/ghc/interpreter/lib/Monad.hs deleted file mode 100644 index 4b7cbcb..0000000 --- a/ghc/interpreter/lib/Monad.hs +++ /dev/null @@ -1,97 +0,0 @@ ------------------------------------------------------------------------------ --- 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')} - ------------------------------------------------------------------------------ diff --git a/ghc/interpreter/lib/Prelude.hs b/ghc/interpreter/lib/Prelude.hs index 8696608..bd7374f 100644 --- a/ghc/interpreter/lib/Prelude.hs +++ b/ghc/interpreter/lib/Prelude.hs @@ -94,7 +94,7 @@ module Prelude ( 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, (^), (^^), @@ -110,8 +110,8 @@ module Prelude ( ,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 @@ -402,20 +402,20 @@ class Monad m where 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 @@ -633,14 +633,6 @@ instance Show a => Show [a] where -- data (a,b) = (a,b) deriving (Eq, Ord, Ix, Read, Show) -- etc.. --- Functions ---------------------------------------------------------------- - -instance Show (a -> b) where - showsPrec p f = showString "<>" - -instance Functor ((->) a) where - fmap = (.) - -- Standard Integral types -------------------------------------------------- data Int -- builtin datatype of fixed size integers @@ -1759,7 +1751,7 @@ writetohandle fname h (c:cs) 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 diff --git a/ghc/interpreter/lib/Ratio.hs b/ghc/interpreter/lib/Ratio.hs deleted file mode 100644 index 46aeebe..0000000 --- a/ghc/interpreter/lib/Ratio.hs +++ /dev/null @@ -1,13 +0,0 @@ ------------------------------------------------------------------------------ --- 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. - ------------------------------------------------------------------------------ diff --git a/ghc/interpreter/lib/System.hs b/ghc/interpreter/lib/System.hs deleted file mode 100644 index 07494a8..0000000 --- a/ghc/interpreter/lib/System.hs +++ /dev/null @@ -1,48 +0,0 @@ ------------------------------------------------------------------------------ --- 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 - ------------------------------------------------------------------------------ diff --git a/ghc/lib/hugs/Prelude.hs b/ghc/lib/hugs/Prelude.hs index 8696608..bd7374f 100644 --- a/ghc/lib/hugs/Prelude.hs +++ b/ghc/lib/hugs/Prelude.hs @@ -94,7 +94,7 @@ module Prelude ( 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, (^), (^^), @@ -110,8 +110,8 @@ module Prelude ( ,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 @@ -402,20 +402,20 @@ class Monad m where 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 @@ -633,14 +633,6 @@ instance Show a => Show [a] where -- data (a,b) = (a,b) deriving (Eq, Ord, Ix, Read, Show) -- etc.. --- Functions ---------------------------------------------------------------- - -instance Show (a -> b) where - showsPrec p f = showString "<>" - -instance Functor ((->) a) where - fmap = (.) - -- Standard Integral types -------------------------------------------------- data Int -- builtin datatype of fixed size integers @@ -1759,7 +1751,7 @@ writetohandle fname h (c:cs) 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 -- 1.7.10.4