1 #if defined(__YALE_HASKELL__)
2 -- Native.hs -- native data conversions and I/O
4 -- author : Sandra Loosemore
8 -- Unlike in the original hbc version of this library, a Byte is a completely
9 -- abstract data type and not a character. You can't read and write Bytes
10 -- to ordinary text files; you must use the operations defined here on
12 -- It's guaranteed to be more efficient to read and write objects directly
13 -- to a file than to do the conversion to a Byte stream and read/write
18 Native(..), Bytes(..),
19 shortIntToBytes, bytesToShortInt,
20 longIntToBytes, bytesToLongInt,
25 #if defined(__YALE_HASKELL__)
26 , openInputByteFile, openOutputByteFile, closeByteFile
27 , readBFile, readBytesFromByteFile
28 , shortIntToByteFile, bytesToShortIntIO
35 import {-flummox mkdependHS-}
39 #if defined(__YALE_HASKELL__)
42 -- these data types are completely opaque on the Haskell side.
45 data ByteFile = ByteFile
48 instance Text(Byte) where
49 showsPrec _ _ = showString "Byte"
51 instance Text(ByteFile) where
52 showsPrec _ _ = showString "ByteFile"
54 -- Byte file primitives
56 openInputByteFile :: String -> IO (ByteFile)
57 openOutputByteFile :: String -> IO (ByteFile)
58 closeByteFile :: ByteFile -> IO ()
60 openInputByteFile = primOpenInputByteFile
61 openOutputByteFile = primOpenOutputByteFile
62 closeByteFile = primCloseByteFile
65 #if defined(__GLASGOW_HASKELL__)
66 import ByteOps -- partain
75 -- Here are the basic operations defined on the class.
79 -- these are primitives
80 showBytes :: a -> Bytes -> Bytes -- convert to bytes
81 readBytes :: Bytes -> Maybe (a, Bytes) -- get an item and the rest
82 #if defined(__YALE_HASKELL__)
83 showByteFile :: a -> ByteFile -> IO ()
84 readByteFile :: ByteFile -> IO a
88 listShowBytes :: [a] -> Bytes -> Bytes -- convert a list to bytes
89 listReadBytes :: Int -> Bytes -> Maybe ([a], Bytes) -- get n items and the rest
90 #if defined(__YALE_HASKELL__)
91 listShowByteFile :: [a] -> ByteFile -> IO ()
92 listReadByteFile :: Int -> ByteFile -> IO [a]
95 -- here are defaults for the derived methods.
97 listShowBytes [] bs = bs
98 listShowBytes (x:xs) bs = showBytes x (listShowBytes xs bs)
100 listReadBytes 0 bs = Just ([], bs)
105 case listReadBytes (n-1) bs' of
107 Just (xs,bs'') -> Just (x:xs, bs'')
109 #if defined(__YALE_HASKELL__)
110 listShowByteFile l f =
111 foldr (\ head tail -> (showByteFile head f) >> tail)
115 listReadByteFile 0 f =
117 listReadByteFile n f =
118 readByteFile f >>= \ h ->
119 listReadByteFile (n - 1) f >>= \ t ->
123 #if ! defined(__YALE_HASKELL__)
124 -- Some utilities that Yale doesn't use
125 hasNElems :: Int -> [a] -> Bool
127 hasNElems 1 (_:_) = True -- speedup
128 hasNElems 2 (_:_:_) = True -- speedup
129 hasNElems 3 (_:_:_:_) = True -- speedup
130 hasNElems 4 (_:_:_:_:_) = True -- speedup
131 hasNElems _ [] = False
132 hasNElems n (_:xs) = hasNElems (n-1) xs
134 lenLong = length (longToBytes 0 [])
135 lenInt = length (intToBytes 0 [])
136 lenShort = length (shortToBytes 0 [])
137 lenFloat = length (floatToBytes 0 [])
138 lenDouble = length (doubleToBytes 0 [])
141 -- Basic instances, defined as primitives
143 instance Native Char where
144 #if defined(__YALE_HASKELL__)
145 showBytes = primCharShowBytes
146 readBytes = primCharReadBytes
147 showByteFile = primCharShowByteFile
148 readByteFile = primCharReadByteFile
150 showBytes c bs = c:bs
151 readBytes [] = Nothing
152 readBytes (c:cs) = Just (c,cs)
153 listReadBytes n bs = f n bs []
154 where f 0 bs cs = Just (reverse cs, bs)
156 f n (b:bs) cs = f (n-1::Int) bs (b:cs)
159 instance Native Int where
160 #if defined(__YALE_HASKELL__)
161 showBytes = primIntShowBytes
162 readBytes = primIntReadBytes
163 showByteFile = primIntShowByteFile
164 readByteFile = primIntReadByteFile
166 showBytes i bs = intToBytes i bs
167 readBytes bs = if hasNElems lenInt bs then Just (bytesToInt bs) else Nothing
170 instance Native Float where
171 #if defined(__YALE_HASKELL__)
172 showBytes = primFloatShowBytes
173 readBytes = primFloatReadBytes
174 showByteFile = primFloatShowByteFile
175 readByteFile = primFloatReadByteFile
177 showBytes i bs = floatToBytes i bs
178 readBytes bs = if hasNElems lenFloat bs then Just (bytesToFloat bs) else Nothing
181 instance Native Double where
182 #if defined(__YALE_HASKELL__)
183 showBytes = primDoubleShowBytes
184 readBytes = primDoubleReadBytes
185 showByteFile = primDoubleShowByteFile
186 readByteFile = primDoubleReadByteFile
188 showBytes i bs = doubleToBytes i bs
189 readBytes bs = if hasNElems lenDouble bs then Just (bytesToDouble bs) else Nothing
192 instance Native Bool where
193 #if defined(__YALE_HASKELL__)
194 showBytes = primBoolShowBytes
195 readBytes = primBoolReadBytes
196 showByteFile = primBoolShowByteFile
197 readByteFile = primBoolReadByteFile
199 showBytes b bs = if b then '\x01':bs else '\x00':bs
200 readBytes [] = Nothing
201 readBytes (c:cs) = Just(c/='\x00', cs)
204 #if defined(__YALE_HASKELL__)
205 -- Byte instances, so you can write Bytes to a ByteFile
207 instance Native Byte where
213 showByteFile = primByteShowByteFile
214 readByteFile = primByteReadByteFile
217 -- A pair is stored as two consecutive items.
218 instance (Native a, Native b) => Native (a,b) where
219 showBytes (a,b) = showBytes a . showBytes b
220 readBytes bs = readBytes bs `thenMaybe` \(a,bs') ->
221 readBytes bs' `thenMaybe` \(b,bs'') ->
223 #if defined(__YALE_HASKELL__)
224 showByteFile (a,b) f = (showByteFile a f) >> (showByteFile b f)
227 readByteFile f >>= \ a ->
228 readByteFile f >>= \ b ->
232 -- A triple is stored as three consectutive items.
233 instance (Native a, Native b, Native c) => Native (a,b,c) where
234 showBytes (a,b,c) = showBytes a . showBytes b . showBytes c
235 readBytes bs = readBytes bs `thenMaybe` \(a,bs') ->
236 readBytes bs' `thenMaybe` \(b,bs'') ->
237 readBytes bs'' `thenMaybe` \(c,bs''') ->
238 Just ((a,b,c), bs''')
239 #if defined(__YALE_HASKELL__)
240 showByteFile (a,b,c) f =
241 (showByteFile a f) >>
242 (showByteFile b f) >>
246 readByteFile f >>= \ a ->
247 readByteFile f >>= \ b ->
248 readByteFile f >>= \ c ->
252 -- A list is stored with an Int with the number of items followed by the items.
253 instance (Native a) => Native [a] where
254 showBytes xs bs = showBytes (length xs) (f xs) where f [] = bs
255 f (x:xs) = showBytes x (f xs)
256 readBytes bs = readBytes bs `thenMaybe` \(n,bs') ->
257 listReadBytes n bs' `thenMaybe` \(xs, bs'') ->
259 #if defined(__YALE_HASKELL__)
260 showByteFile l f = (showByteFile (length l) f) >> (listShowByteFile l f)
261 readByteFile f = readByteFile f >>= \ n -> listReadByteFile n f
264 -- A Maybe is stored as a Boolean possibly followed by a value
265 instance (Native a) => Native (Maybe a) where
266 #if !defined(__YALE_HASKELL__)
267 showBytes Nothing = ('\x00' :)
268 showBytes (Just x) = ('\x01' :) . showBytes x
269 readBytes ('\x00':bs) = Just (Nothing, bs)
270 readBytes ('\x01':bs) = readBytes bs `thenMaybe` \(a,bs') ->
272 readBytes _ = Nothing
274 showBytes (Just a) = showBytes True . showBytes a
275 showBytes Nothing = showBytes False
277 readBytes bs `thenMaybe` \ (isJust, bs') ->
279 readBytes bs' `thenMaybe` \ (a, bs'') ->
284 showByteFile (Just a) f = showByteFile True f >> showByteFile a f
285 showByteFile Nothing f = showByteFile False f
287 readByteFile f >>= \ isJust ->
289 readByteFile f >>= \ a ->
295 instance (Native a, Ix a, Native b) => Native (Array a b) where
296 showBytes a = showBytes (bounds a) . showBytes (elems a)
297 readBytes bs = readBytes bs `thenMaybe` \(b, bs')->
298 readBytes bs' `thenMaybe` \(xs, bs'')->
299 Just (listArray b xs, bs'')
301 shortIntToBytes :: Int -> Bytes -> Bytes
302 bytesToShortInt :: Bytes -> Maybe (Int, Bytes)
303 longIntToBytes :: Int -> Bytes -> Bytes
304 bytesToLongInt :: Bytes -> Maybe (Int, Bytes)
305 #if defined(__YALE_HASKELL__)
306 shortIntToByteFile :: Int -> ByteFile -> IO ()
307 bytesToShortIntIO :: ByteFile -> IO Int
310 #if defined(__YALE_HASKELL__)
311 -- These functions are like the primIntxx but use a "short" rather than
312 -- "int" representation.
313 shortIntToBytes = primShortShowBytes
314 bytesToShortInt = primShortReadBytes
315 shortIntToByteFile = primShortShowByteFile
316 bytesToShortIntIO = primShortReadByteFile
320 shortIntToBytes s bs = shortToBytes s bs
322 bytesToShortInt bs = if hasNElems lenShort bs then Just (bytesToShort bs) else Nothing
324 longIntToBytes s bs = longToBytes s bs
326 bytesToLongInt bs = if hasNElems lenLong bs then Just (bytesToLong bs) else Nothing
330 showB :: (Native a) => a -> Bytes
331 showB x = showBytes x []
333 readB :: (Native a) => Bytes -> a
337 Just (_,_) -> error "Native.readB data too long"
338 Nothing -> error "Native.readB data too short"
340 #if defined(__YALE_HASKELL__)
341 readBFile :: String -> IO(Bytes)
343 openInputByteFile name >>= \ f ->
344 readBytesFromByteFile f
346 readBytesFromByteFile :: ByteFile -> IO(Bytes)
347 readBytesFromByteFile f =
349 (primByteReadByteFile f >>= \ h ->
350 readBytesFromByteFile f >>= \ t ->
354 onEOF EOF = closeByteFile f >> return []
355 onEOF err = closeByteFile f >> failwith err