From: simonm Date: Fri, 6 Feb 1998 15:05:02 +0000 (+0000) Subject: [project @ 1998-02-06 15:04:59 by simonm] X-Git-Tag: Approx_2487_patches~986 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=3a2b8c962894fcfb8828eaaaa07f644c528eed7c;p=ghc-hetmet.git [project @ 1998-02-06 15:04:59 by simonm] Add a few module from the old HBC lib: they're needed by a couple of things in nofib. These can disappear once the dependencies are removed. --- diff --git a/ghc/lib/misc/ByteOps.lhs b/ghc/lib/misc/ByteOps.lhs new file mode 100644 index 0000000..3eb0334 --- /dev/null +++ b/ghc/lib/misc/ByteOps.lhs @@ -0,0 +1,137 @@ +{- +% +% (c) The GRASP/AQUA Project, Glasgow University, 1993-1994 +% +\section[ByteOps]{Convert to/from ``bytes''; to support @Native@ class} + +This mimics some code that comes with HBC. +-} + +\begin{code} +module ByteOps ( + longToBytes, + intToBytes, + shortToBytes, + floatToBytes, + doubleToBytes, + + bytesToLong, + bytesToInt, + bytesToShort, + bytesToFloat, + bytesToDouble + ) where + +import GlaExts +import PrelBase + +-- \tr{xxxToBytes} prepends an \tr{xxx} to a byte stream. +-- \tr{bytesToXxx} snaffles an \tr{xxx} from a byte stream, +-- also returning the rest of the stream. + +type Bytes = [Char] + +longToBytes :: Int -> Bytes -> Bytes +intToBytes :: Int -> Bytes -> Bytes +shortToBytes :: Int -> Bytes -> Bytes +floatToBytes :: Float -> Bytes -> Bytes +doubleToBytes :: Double -> Bytes -> Bytes + +bytesToLong :: Bytes -> (Int, Bytes) +bytesToInt :: Bytes -> (Int, Bytes) +bytesToShort :: Bytes -> (Int, Bytes) +bytesToFloat :: Bytes -> (Float, Bytes) +bytesToDouble :: Bytes -> (Double, Bytes) + +--Here we go. + +#define XXXXToBytes(type,xxxx,xxxx__) \ +xxxx i stream \ + = let \ + long_bytes {- DANGEROUS! -} \ + = unsafePerformIO ( \ + {- Allocate a wad of memory to put the "long"'s bytes. \ + Let's hope 32 bytes will be big enough. -} \ + stToIO (newCharArray (0::Int, 31)) >>= \ arr# -> \ + \ + {- Call out to C to do the dirty deed: -} \ + _casm_ ``%r = xxxx__ ((type)%0, (unsigned char *)%1);'' i arr# \ + >>= \ num_bytes -> \ + \ + unpack arr# 0 (num_bytes - 1) \ + ) \ + in \ + long_bytes ++ stream + +XXXXToBytes(long,longToBytes,long2bytes__) +XXXXToBytes(int,intToBytes,int2bytes__) +XXXXToBytes(short,shortToBytes,short2bytes__) +XXXXToBytes(float,floatToBytes,float2bytes__) +XXXXToBytes(double,doubleToBytes,double2bytes__) + +-------------- +unpack :: MutableByteArray RealWorld Int -> Int -> Int -> IO [Char] + +unpack arr# curr last + = if curr > last then + return [] + else + stToIO (readCharArray arr# curr) >>= \ ch -> + unpack arr# (curr + 1) last >>= \ rest -> + return (ch : rest) + +------------- +--Now we go the other way. The paranoia checking (absent) leaves +--something to be desired. Really have to be careful on +--funny-sized things like \tr{shorts}... + +#define bytesToXXXX(htype,xxxx,alloc,read,xxxx__) \ +xxxx stream \ + = unsafePerformIO ( \ + {- slam (up to) 32 bytes [random] from the stream into an array -} \ + stToIO (newCharArray (0::Int, 31)) >>= \ arr# -> \ + pack arr# 0 31 stream >> \ + \ + {- make a one-element array to hold the result: -} \ + stToIO (alloc (0::Int, 0)) >>= \ res# -> \ + \ + {- call the C to do the business: -} \ + _casm_ ``%r = xxxx__ ((P_)%0, (htype *) %1);'' arr# res# \ + >>= \ num_bytes -> \ + \ + {- read the result out of "res#": -} \ + stToIO (read res# (0::Int)) >>= \ i -> \ + \ + {- box the result and drop the number of bytes taken: -} \ + return (i, my_drop num_bytes stream) \ + ) + +bytesToXXXX(I_,bytesToLong,newIntArray,readIntArray,bytes2long__) +bytesToXXXX(I_,bytesToInt,newIntArray,readIntArray,bytes2int__) +bytesToXXXX(I_,bytesToShort,newIntArray,readIntArray,bytes2short__) +bytesToXXXX(StgFloat,bytesToFloat,newFloatArray,readFloatArray,bytes2float__) +bytesToXXXX(StgDouble,bytesToDouble,newDoubleArray,readDoubleArray,bytes2double__) + +---------------------- +pack :: MutableByteArray RealWorld Int -> Int -> Int -> [Char] -> IO () + +pack arr# curr last from_bytes + = if curr > last then + return () + else + case from_bytes of + [] -> stToIO (writeCharArray arr# curr (chr 0)) + + (from_byte : xs) -> + stToIO (writeCharArray arr# curr from_byte) >> + pack arr# (curr + 1) last xs + +-- more cavalier than usual; we know there will be enough bytes: + +my_drop :: Int -> [a] -> [a] + +my_drop 0 xs = xs +--my_drop _ [] = [] +my_drop m (_:xs) = my_drop (m - 1) xs + +\end{code} diff --git a/ghc/lib/misc/Native.lhs b/ghc/lib/misc/Native.lhs new file mode 100644 index 0000000..4ca85a1 --- /dev/null +++ b/ghc/lib/misc/Native.lhs @@ -0,0 +1,353 @@ +\begin{code} +#if defined(__YALE_HASKELL__) +-- Native.hs -- native data conversions and I/O +-- +-- author : Sandra Loosemore +-- date : 07 Jun 1994 +-- +-- +-- Unlike in the original hbc version of this library, a Byte is a completely +-- abstract data type and not a character. You can't read and write Bytes +-- to ordinary text files; you must use the operations defined here on +-- Native files. +-- It's guaranteed to be more efficient to read and write objects directly +-- to a file than to do the conversion to a Byte stream and read/write +-- the Byte stream. +#endif + +module Native( + Native(..), Bytes, + shortIntToBytes, bytesToShortInt, + longIntToBytes, bytesToLongInt, + showB, readB +#if defined(__YALE_HASKELL__) + , openInputByteFile, openOutputByteFile, closeByteFile + , readBFile, readBytesFromByteFile + , shortIntToByteFile, bytesToShortIntIO + , ByteFile + , Byte +#endif + ) where + +import Ix -- 1.3 +import Array -- 1.3 + +#if defined(__YALE_HASKELL__) +import NativePrims + +-- these data types are completely opaque on the Haskell side. + +data Byte = Byte +data ByteFile = ByteFile +type Bytes = [Byte] + +instance Show(Byte) where + showsPrec _ _ = showString "Byte" + +instance Show(ByteFile) where + showsPrec _ _ = showString "ByteFile" + +-- Byte file primitives + +openInputByteFile :: String -> IO (ByteFile) +openOutputByteFile :: String -> IO (ByteFile) +closeByteFile :: ByteFile -> IO () + +openInputByteFile = primOpenInputByteFile +openOutputByteFile = primOpenOutputByteFile +closeByteFile = primCloseByteFile +#endif {- YALE-} + +#if defined(__GLASGOW_HASKELL__) +import ByteOps -- partain +type Bytes = [Char] +#endif + +#if defined(__HBC__) +import LMLbyteops +type Bytes = [Char] +#endif + +-- Here are the basic operations defined on the class. + +class Native a where + + -- these are primitives + showBytes :: a -> Bytes -> Bytes -- convert to bytes + readBytes :: Bytes -> Maybe (a, Bytes) -- get an item and the rest +#if defined(__YALE_HASKELL__) + showByteFile :: a -> ByteFile -> IO () + readByteFile :: ByteFile -> IO a +#endif + + -- these are derived + listShowBytes :: [a] -> Bytes -> Bytes -- convert a list to bytes + listReadBytes :: Int -> Bytes -> Maybe ([a], Bytes) -- get n items and the rest +#if defined(__YALE_HASKELL__) + listShowByteFile :: [a] -> ByteFile -> IO () + listReadByteFile :: Int -> ByteFile -> IO [a] +#endif + + -- here are defaults for the derived methods. + + listShowBytes [] bs = bs + listShowBytes (x:xs) bs = showBytes x (listShowBytes xs bs) + + listReadBytes 0 bs = Just ([], bs) + listReadBytes n bs = + case readBytes bs of + Nothing -> Nothing + Just (x,bs') -> + case listReadBytes (n-1) bs' of + Nothing -> Nothing + Just (xs,bs'') -> Just (x:xs, bs'') + +#if defined(__YALE_HASKELL__) + listShowByteFile l f = + foldr (\ head tail -> (showByteFile head f) >> tail) + (return ()) + l + + listReadByteFile 0 f = + return [] + listReadByteFile n f = + readByteFile f >>= \ h -> + listReadByteFile (n - 1) f >>= \ t -> + return (h:t) +#endif + +#if ! defined(__YALE_HASKELL__) +-- Some utilities that Yale doesn't use +hasNElems :: Int -> [a] -> Bool +hasNElems 0 _ = True +hasNElems 1 (_:_) = True -- speedup +hasNElems 2 (_:_:_) = True -- speedup +hasNElems 3 (_:_:_:_) = True -- speedup +hasNElems 4 (_:_:_:_:_) = True -- speedup +hasNElems _ [] = False +hasNElems n (_:xs) = hasNElems (n-1) xs + +lenLong = length (longToBytes 0 []) +lenInt = length (intToBytes 0 []) +lenShort = length (shortToBytes 0 []) +lenFloat = length (floatToBytes 0 []) +lenDouble = length (doubleToBytes 0 []) +#endif + +-- Basic instances, defined as primitives + +instance Native Char where +#if defined(__YALE_HASKELL__) + showBytes = primCharShowBytes + readBytes = primCharReadBytes + showByteFile = primCharShowByteFile + readByteFile = primCharReadByteFile +#else + showBytes c bs = c:bs + readBytes [] = Nothing + readBytes (c:cs) = Just (c,cs) + listReadBytes n bs = f n bs [] + where f 0 bs cs = Just (reverse cs, bs) + f _ [] _ = Nothing + f n (b:bs) cs = f (n-1::Int) bs (b:cs) +#endif + +instance Native Int where +#if defined(__YALE_HASKELL__) + showBytes = primIntShowBytes + readBytes = primIntReadBytes + showByteFile = primIntShowByteFile + readByteFile = primIntReadByteFile +#else + showBytes i bs = intToBytes i bs + readBytes bs = if hasNElems lenInt bs then Just (bytesToInt bs) else Nothing +#endif + +instance Native Float where +#if defined(__YALE_HASKELL__) + showBytes = primFloatShowBytes + readBytes = primFloatReadBytes + showByteFile = primFloatShowByteFile + readByteFile = primFloatReadByteFile +#else + showBytes i bs = floatToBytes i bs + readBytes bs = if hasNElems lenFloat bs then Just (bytesToFloat bs) else Nothing +#endif + +instance Native Double where +#if defined(__YALE_HASKELL__) + showBytes = primDoubleShowBytes + readBytes = primDoubleReadBytes + showByteFile = primDoubleShowByteFile + readByteFile = primDoubleReadByteFile +#else + showBytes i bs = doubleToBytes i bs + readBytes bs = if hasNElems lenDouble bs then Just (bytesToDouble bs) else Nothing +#endif + +instance Native Bool where +#if defined(__YALE_HASKELL__) + showBytes = primBoolShowBytes + readBytes = primBoolReadBytes + showByteFile = primBoolShowByteFile + readByteFile = primBoolReadByteFile +#else + showBytes b bs = if b then '\x01':bs else '\x00':bs + readBytes [] = Nothing + readBytes (c:cs) = Just(c/='\x00', cs) +#endif + +#if defined(__YALE_HASKELL__) +-- Byte instances, so you can write Bytes to a ByteFile + +instance Native Byte where + showBytes = (:) + readBytes l = + case l of + [] -> Nothing + h:t -> Just(h,t) + showByteFile = primByteShowByteFile + readByteFile = primByteReadByteFile +#endif + +-- A pair is stored as two consecutive items. +instance (Native a, Native b) => Native (a,b) where + showBytes (a,b) = showBytes a . showBytes b + readBytes bs = readBytes bs >>= \(a,bs') -> + readBytes bs' >>= \(b,bs'') -> + return ((a,b), bs'') +#if defined(__YALE_HASKELL__) + showByteFile (a,b) f = (showByteFile a f) >> (showByteFile b f) + + readByteFile f = + readByteFile f >>= \ a -> + readByteFile f >>= \ b -> + return (a,b) +#endif + +-- A triple is stored as three consectutive items. +instance (Native a, Native b, Native c) => Native (a,b,c) where + showBytes (a,b,c) = showBytes a . showBytes b . showBytes c + readBytes bs = readBytes bs >>= \(a,bs') -> + readBytes bs' >>= \(b,bs'') -> + readBytes bs'' >>= \(c,bs''') -> + return ((a,b,c), bs''') +#if defined(__YALE_HASKELL__) + showByteFile (a,b,c) f = + (showByteFile a f) >> + (showByteFile b f) >> + (showByteFile c f) + + readByteFile f = + readByteFile f >>= \ a -> + readByteFile f >>= \ b -> + readByteFile f >>= \ c -> + return (a,b,c) +#endif + +-- A list is stored with an Int with the number of items followed by the items. +instance (Native a) => Native [a] where + showBytes xs bs = showBytes (length xs) (f xs) where f [] = bs + f (x:xs) = showBytes x (f xs) + readBytes bs = readBytes bs >>= \(n,bs') -> + listReadBytes n bs' >>= \(xs, bs'') -> + return (xs, bs'') +#if defined(__YALE_HASKELL__) + showByteFile l f = (showByteFile (length l) f) >> (listShowByteFile l f) + readByteFile f = readByteFile f >>= \ n -> listReadByteFile n f +#endif + +-- A Maybe is stored as a Boolean possibly followed by a value +instance (Native a) => Native (Maybe a) where +#if !defined(__YALE_HASKELL__) + showBytes Nothing = ('\x00' :) + showBytes (Just x) = ('\x01' :) . showBytes x + readBytes ('\x00':bs) = Just (Nothing, bs) + readBytes ('\x01':bs) = readBytes bs >>= \(a,bs') -> + return (Just a, bs') + readBytes _ = Nothing +#else + showBytes (Just a) = showBytes True . showBytes a + showBytes Nothing = showBytes False + readBytes bs = + readBytes bs >>= \ (isJust, bs') -> + if isJust then + readBytes bs' >>= \ (a, bs'') -> + return (Just a, bs'') + else + return (Nothing, bs') + + showByteFile (Just a) f = showByteFile True f >> showByteFile a f + showByteFile Nothing f = showByteFile False f + readByteFile f = + readByteFile f >>= \ isJust -> + if isJust then + readByteFile f >>= \ a -> + return (Just a) + else + return Nothing +#endif + +instance (Native a, Ix a, Native b) => Native (Array a b) where + showBytes a = showBytes (bounds a) . showBytes (elems a) + readBytes bs = readBytes bs >>= \(b, bs')-> + readBytes bs' >>= \(xs, bs'')-> + return (listArray b xs, bs'') + +shortIntToBytes :: Int -> Bytes -> Bytes +bytesToShortInt :: Bytes -> Maybe (Int, Bytes) +longIntToBytes :: Int -> Bytes -> Bytes +bytesToLongInt :: Bytes -> Maybe (Int, Bytes) +#if defined(__YALE_HASKELL__) +shortIntToByteFile :: Int -> ByteFile -> IO () +bytesToShortIntIO :: ByteFile -> IO Int +#endif + +#if defined(__YALE_HASKELL__) +-- These functions are like the primIntxx but use a "short" rather than +-- "int" representation. +shortIntToBytes = primShortShowBytes +bytesToShortInt = primShortReadBytes +shortIntToByteFile = primShortShowByteFile +bytesToShortIntIO = primShortReadByteFile + +#else {-! YALE-} + +shortIntToBytes s bs = shortToBytes s bs + +bytesToShortInt bs = if hasNElems lenShort bs then Just (bytesToShort bs) else Nothing + +longIntToBytes s bs = longToBytes s bs + +bytesToLongInt bs = if hasNElems lenLong bs then Just (bytesToLong bs) else Nothing + +#endif {-! YALE-} + +showB :: (Native a) => a -> Bytes +showB x = showBytes x [] + +readB :: (Native a) => Bytes -> a +readB bs = + case readBytes bs of + Just (x,[]) -> x + Just (_,_) -> error "Native.readB data too long" + Nothing -> error "Native.readB data too short" + +#if defined(__YALE_HASKELL__) +readBFile :: String -> IO(Bytes) +readBFile name = + openInputByteFile name >>= \ f -> + readBytesFromByteFile f + +readBytesFromByteFile :: ByteFile -> IO(Bytes) +readBytesFromByteFile f = + try + (primByteReadByteFile f >>= \ h -> + readBytesFromByteFile f >>= \ t -> + return (h:t)) + onEOF + where + onEOF EOF = closeByteFile f >> return [] + onEOF err = closeByteFile f >> failwith err +#endif +\end{code} diff --git a/ghc/lib/misc/Printf.lhs b/ghc/lib/misc/Printf.lhs new file mode 100644 index 0000000..d11a539 --- /dev/null +++ b/ghc/lib/misc/Printf.lhs @@ -0,0 +1,225 @@ + + A C printf like formatter. + Conversion specs: + - left adjust + num field width + * as num, but taken from argument list + . separates width from precision + Formatting characters: + c Char, Int, Integer + d Char, Int, Integer + o Char, Int, Integer + x Char, Int, Integer + u Char, Int, Integer + f Float, Double + g Float, Double + e Float, Double + s String + +\begin{code} +module Printf(UPrintf(..), printf) where + +import Char ( isDigit ) -- 1.3 +import Array ( array, (!) ) -- 1.3 + + +#if defined(__HBC__) +import LMLfmtf +#endif + +#if defined(__YALE_HASKELL__) +import PrintfPrims +#endif + +#if defined(__GLASGOW_HASKELL__) +import GlaExts +import PrelArr (Array(..), ByteArray(..)) +import PrelBase hiding (itos) +#endif + +data UPrintf = UChar Char | UString String | UInt Int | UInteger Integer | UFloat Float | UDouble Double + +printf :: String -> [UPrintf] -> String +printf "" [] = "" +printf "" (_:_) = fmterr +printf ('%':'%':cs) us = '%':printf cs us +printf ('%':_) [] = argerr +printf ('%':cs) us@(_:_) = fmt cs us +printf (c:cs) us = c:printf cs us + +fmt :: String -> [UPrintf] -> String +fmt cs us = + let (width, prec, ladj, zero, cs', us') = getSpecs False False cs us + adjust (pre, str) = + let lstr = length str + lpre = length pre + fill = if lstr+lpre < width then take (width-(lstr+lpre)) (repeat (if zero then '0' else ' ')) else "" + in if ladj then pre ++ str ++ fill else if zero then pre ++ fill ++ str else fill ++ pre ++ str + in + case cs' of + [] -> fmterr + c:cs'' -> + case us' of + [] -> argerr + u:us'' -> + (case c of + 'c' -> adjust ("", [chr (toint u)]) + 'd' -> adjust (fmti u) + 'x' -> adjust ("", fmtu 16 u) + 'o' -> adjust ("", fmtu 8 u) + 'u' -> adjust ("", fmtu 10 u) +#if defined __YALE_HASKELL__ + 'e' -> adjust (fmte prec (todbl u)) + 'f' -> adjust (fmtf prec (todbl u)) + 'g' -> adjust (fmtg prec (todbl u)) +#else + 'e' -> adjust (dfmt c prec (todbl u)) + 'f' -> adjust (dfmt c prec (todbl u)) + 'g' -> adjust (dfmt c prec (todbl u)) +#endif + 's' -> adjust ("", tostr u) + c -> perror ("bad formatting char " ++ [c]) + ) ++ printf cs'' us'' + +fmti (UInt i) = if i < 0 then + if i == -i then fmti (UInteger (toInteger i)) else ("-", itos (-i)) + else + ("", itos i) +fmti (UInteger i) = if i < 0 then ("-", itos (-i)) else ("", itos i) +fmti (UChar c) = fmti (UInt (ord c)) +fmti u = baderr + +fmtu b (UInt i) = if i < 0 then + if i == -i then itosb b (maxi - toInteger (i+1) - 1) else itosb b (maxi - toInteger (-i)) + else + itosb b (toInteger i) +fmtu b (UInteger i) = itosb b i +fmtu b (UChar c) = itosb b (toInteger (ord c)) +fmtu b u = baderr + +maxi :: Integer +maxi = (toInteger (maxBound::Int) + 1) * 2 + +toint (UInt i) = i +toint (UInteger i) = toInt i +toint (UChar c) = ord c +toint u = baderr + +tostr (UString s) = s +tostr u = baderr + +todbl (UDouble d) = d +#if defined(__GLASGOW_HASKELL__) +todbl (UFloat (F# f)) = D# (float2Double# f) -- What a great system(TM) ! +#else +todbl (UFloat f) = fromRational (toRational f) +#endif +todbl u = baderr + +itos n = + if n < 10 then + [chr (ord '0' + toInt n)] + else + let (q, r) = quotRem n 10 in + itos q ++ [chr (ord '0' + toInt r)] + +chars :: Array Int Char +chars = array (0,15) (zipWith (\x y -> (x,y)) [0..] "0123456789abcdef") + +itosb :: Integer -> Integer -> String +itosb b n = + if n < b then + [chars ! fromInteger n] + else + let (q, r) = quotRem n b in + itosb b q ++ [chars ! fromInteger r] + +stoi :: Int -> String -> (Int, String) +stoi a (c:cs) | isDigit c = stoi (a*10 + ord c - ord '0') cs +stoi a cs = (a, cs) + +getSpecs :: Bool -> Bool -> String -> [UPrintf] -> (Int, Int, Bool, Bool, String, [UPrintf]) +getSpecs l z ('-':cs) us = getSpecs True z cs us +getSpecs l z ('0':cs) us = getSpecs l True cs us +getSpecs l z ('*':cs) us = + case us of + [] -> argerr + nu : us' -> + let n = toint nu + (p, cs'', us'') = + case cs of + '.':'*':r -> case us' of { [] -> argerr; pu:us'' -> (toint pu, r, us'') } + '.':r -> let (n, cs') = stoi 0 r in (n, cs', us') + _ -> (-1, cs, us') + in (n, p, l, z, cs'', us'') +getSpecs l z cs@(c:_) us | isDigit c = + let (n, cs') = stoi 0 cs + (p, cs'') = case cs' of + '.':r -> stoi 0 r + _ -> (-1, cs') + in (n, p, l, z, cs'', us) +getSpecs l z cs us = (0, -1, l, z, cs, us) + +#if !defined(__YALE_HASKELL__) +dfmt :: Char -> Int -> Double -> (String, String) +#endif + +#if defined(__GLASGOW_HASKELL__) +dfmt c{-e,f, or g-} prec d + = unsafePerformIO ( + stToIO (newCharArray (0 :: Int, 511)){-pathetic malloc-} + >>= \ sprintf_here -> + let + sprintf_fmt = "%1" ++ (if prec < 0 then "" else '.':itos prec) ++ [c] + in + _ccall_ sprintf sprintf_here sprintf_fmt d >> + stToIO (freezeCharArray sprintf_here) >>= \ (ByteArray _ arr#) -> + let + unpack :: Int# -> [Char] + unpack nh = case (ord# (indexCharArray# arr# nh)) of + 0# -> [] + ch -> case (nh +# 1#) of + mh -> C# (chr# ch) : unpack mh + in + return ( + case (indexCharArray# arr# 0#) of + '-'# -> ("-", unpack 1#) + _ -> ("" , unpack 0#) + ) + ) +#endif + +#if defined(__HBC__) +dfmt c p d = + case fmtf ("1" ++ (if p < 0 then "" else '.':itos p) ++ [c]) d of + '-':cs -> ("-", cs) + cs -> ("" , cs) +#endif + +#if defined(__YALE_HASKELL__) +fmte p d = + case (primFmte p d) of + '-':cs -> ("-",cs) + cs -> ("",cs) +fmtf p d = + case (primFmtf p d) of + '-':cs -> ("-",cs) + cs -> ("",cs) +fmtg p d = + case (primFmtg p d) of + '-':cs -> ("-",cs) + cs -> ("",cs) +#endif + +perror s = error ("Printf.printf: "++s) +fmterr = perror "formatting string ended prematurely" +argerr = perror "argument list ended prematurely" +baderr = perror "bad argument" + +#if defined(__YALE_HASKELL__) +-- This is needed because standard Haskell does not have toInt + +toInt :: Integral a => a -> Int +toInt x = fromIntegral x +#endif +\end{code}