Skip to content

GitLab

Commit 6a04b119 authored by andy's avatar andy
Browse files

[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.
parent 1b3b9664
Hide whitespace changes
Inline Side-by-side
ghc/interpreter/lib/Array.hs deleted 100644 → 0
View file @ 1b3b9664
-----------------------------------------------------------------------------
-- 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 ])
-----------------------------------------------------------------------------
ghc/interpreter/lib/Char.hs deleted 100644 → 0
View file @ 1b3b9664
-----------------------------------------------------------------------------
-- 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
-----------------------------------------------------------------------------
ghc/interpreter/lib/Complex.hs deleted 100644 → 0
View file @ 1b3b9664
-----------------------------------------------------------------------------
-- 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))
-----------------------------------------------------------------------------
ghc/interpreter/lib/IO.hs deleted 100644 → 0
View file @ 1b3b9664
-----------------------------------------------------------------------------
-- 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
-----------------------------------------------------------------------------
ghc/interpreter/lib/Ix.hs deleted 100644 → 0
View file @ 1b3b9664
-----------------------------------------------------------------------------
-- 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.
-----------------------------------------------------------------------------
ghc/interpreter/lib/List.hs deleted 100644 → 0
View file @ 1b3b9664
-----------------------------------------------------------------------------
-- 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]]