diff options
Diffstat (limited to 'ghc/lib/misc/Native.lhs')
| -rw-r--r-- | ghc/lib/misc/Native.lhs | 354 |
1 files changed, 0 insertions, 354 deletions
diff --git a/ghc/lib/misc/Native.lhs b/ghc/lib/misc/Native.lhs deleted file mode 100644 index 5c35ac41eb..0000000000 --- a/ghc/lib/misc/Native.lhs +++ /dev/null @@ -1,354 +0,0 @@ -\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, lenInt, lenShort, lenFloat, lenDouble :: Int -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} |