2 #if defined(__YALE_HASKELL__)
3 -- Native.hs -- native data conversions and I/O
5 -- author : Sandra Loosemore
9 -- Unlike in the original hbc version of this library, a Byte is a completely
10 -- abstract data type and not a character. You can't read and write Bytes
11 -- to ordinary text files; you must use the operations defined here on
13 -- It's guaranteed to be more efficient to read and write objects directly
14 -- to a file than to do the conversion to a Byte stream and read/write
20 shortIntToBytes, bytesToShortInt,
21 longIntToBytes, bytesToLongInt,
23 #if defined(__YALE_HASKELL__)
24 , openInputByteFile, openOutputByteFile, closeByteFile
25 , readBFile, readBytesFromByteFile
26 , shortIntToByteFile, bytesToShortIntIO
35 #if defined(__YALE_HASKELL__)
38 -- these data types are completely opaque on the Haskell side.
41 data ByteFile = ByteFile
44 instance Show(Byte) where
45 showsPrec _ _ = showString "Byte"
47 instance Show(ByteFile) where
48 showsPrec _ _ = showString "ByteFile"
50 -- Byte file primitives
52 openInputByteFile :: String -> IO (ByteFile)
53 openOutputByteFile :: String -> IO (ByteFile)
54 closeByteFile :: ByteFile -> IO ()
56 openInputByteFile = primOpenInputByteFile
57 openOutputByteFile = primOpenOutputByteFile
58 closeByteFile = primCloseByteFile
61 #if defined(__GLASGOW_HASKELL__)
62 import ByteOps -- partain
71 -- Here are the basic operations defined on the class.
75 -- these are primitives
76 showBytes :: a -> Bytes -> Bytes -- convert to bytes
77 readBytes :: Bytes -> Maybe (a, Bytes) -- get an item and the rest
78 #if defined(__YALE_HASKELL__)
79 showByteFile :: a -> ByteFile -> IO ()
80 readByteFile :: ByteFile -> IO a
84 listShowBytes :: [a] -> Bytes -> Bytes -- convert a list to bytes
85 listReadBytes :: Int -> Bytes -> Maybe ([a], Bytes) -- get n items and the rest
86 #if defined(__YALE_HASKELL__)
87 listShowByteFile :: [a] -> ByteFile -> IO ()
88 listReadByteFile :: Int -> ByteFile -> IO [a]
91 -- here are defaults for the derived methods.
93 listShowBytes [] bs = bs
94 listShowBytes (x:xs) bs = showBytes x (listShowBytes xs bs)
96 listReadBytes 0 bs = Just ([], bs)
101 case listReadBytes (n-1) bs' of
103 Just (xs,bs'') -> Just (x:xs, bs'')
105 #if defined(__YALE_HASKELL__)
106 listShowByteFile l f =
107 foldr (\ head tail -> (showByteFile head f) >> tail)
111 listReadByteFile 0 f =
113 listReadByteFile n f =
114 readByteFile f >>= \ h ->
115 listReadByteFile (n - 1) f >>= \ t ->
119 #if ! defined(__YALE_HASKELL__)
120 -- Some utilities that Yale doesn't use
121 hasNElems :: Int -> [a] -> Bool
123 hasNElems 1 (_:_) = True -- speedup
124 hasNElems 2 (_:_:_) = True -- speedup
125 hasNElems 3 (_:_:_:_) = True -- speedup
126 hasNElems 4 (_:_:_:_:_) = True -- speedup
127 hasNElems _ [] = False
128 hasNElems n (_:xs) = hasNElems (n-1) xs
130 lenLong, lenInt, lenShort, lenFloat, lenDouble :: Int
131 lenLong = length (longToBytes 0 [])
132 lenInt = length (intToBytes 0 [])
133 lenShort = length (shortToBytes 0 [])
134 lenFloat = length (floatToBytes 0 [])
135 lenDouble = length (doubleToBytes 0 [])
138 -- Basic instances, defined as primitives
140 instance Native Char where
141 #if defined(__YALE_HASKELL__)
142 showBytes = primCharShowBytes
143 readBytes = primCharReadBytes
144 showByteFile = primCharShowByteFile
145 readByteFile = primCharReadByteFile
147 showBytes c bs = c:bs
148 readBytes [] = Nothing
149 readBytes (c:cs) = Just (c,cs)
150 listReadBytes n bs = f n bs []
151 where f 0 bs cs = Just (reverse cs, bs)
153 f n (b:bs) cs = f (n-1::Int) bs (b:cs)
156 instance Native Int where
157 #if defined(__YALE_HASKELL__)
158 showBytes = primIntShowBytes
159 readBytes = primIntReadBytes
160 showByteFile = primIntShowByteFile
161 readByteFile = primIntReadByteFile
163 showBytes i bs = intToBytes i bs
164 readBytes bs = if hasNElems lenInt bs then Just (bytesToInt bs) else Nothing
167 instance Native Float where
168 #if defined(__YALE_HASKELL__)
169 showBytes = primFloatShowBytes
170 readBytes = primFloatReadBytes
171 showByteFile = primFloatShowByteFile
172 readByteFile = primFloatReadByteFile
174 showBytes i bs = floatToBytes i bs
175 readBytes bs = if hasNElems lenFloat bs then Just (bytesToFloat bs) else Nothing
178 instance Native Double where
179 #if defined(__YALE_HASKELL__)
180 showBytes = primDoubleShowBytes
181 readBytes = primDoubleReadBytes
182 showByteFile = primDoubleShowByteFile
183 readByteFile = primDoubleReadByteFile
185 showBytes i bs = doubleToBytes i bs
186 readBytes bs = if hasNElems lenDouble bs then Just (bytesToDouble bs) else Nothing
189 instance Native Bool where
190 #if defined(__YALE_HASKELL__)
191 showBytes = primBoolShowBytes
192 readBytes = primBoolReadBytes
193 showByteFile = primBoolShowByteFile
194 readByteFile = primBoolReadByteFile
196 showBytes b bs = if b then '\x01':bs else '\x00':bs
197 readBytes [] = Nothing
198 readBytes (c:cs) = Just(c/='\x00', cs)
201 #if defined(__YALE_HASKELL__)
202 -- Byte instances, so you can write Bytes to a ByteFile
204 instance Native Byte where
210 showByteFile = primByteShowByteFile
211 readByteFile = primByteReadByteFile
214 -- A pair is stored as two consecutive items.
215 instance (Native a, Native b) => Native (a,b) where
216 showBytes (a,b) = showBytes a . showBytes b
217 readBytes bs = readBytes bs >>= \(a,bs') ->
218 readBytes bs' >>= \(b,bs'') ->
220 #if defined(__YALE_HASKELL__)
221 showByteFile (a,b) f = (showByteFile a f) >> (showByteFile b f)
224 readByteFile f >>= \ a ->
225 readByteFile f >>= \ b ->
229 -- A triple is stored as three consectutive items.
230 instance (Native a, Native b, Native c) => Native (a,b,c) where
231 showBytes (a,b,c) = showBytes a . showBytes b . showBytes c
232 readBytes bs = readBytes bs >>= \(a,bs') ->
233 readBytes bs' >>= \(b,bs'') ->
234 readBytes bs'' >>= \(c,bs''') ->
235 return ((a,b,c), bs''')
236 #if defined(__YALE_HASKELL__)
237 showByteFile (a,b,c) f =
238 (showByteFile a f) >>
239 (showByteFile b f) >>
243 readByteFile f >>= \ a ->
244 readByteFile f >>= \ b ->
245 readByteFile f >>= \ c ->
249 -- A list is stored with an Int with the number of items followed by the items.
250 instance (Native a) => Native [a] where
251 showBytes xs bs = showBytes (length xs) (f xs) where f [] = bs
252 f (x:xs) = showBytes x (f xs)
253 readBytes bs = readBytes bs >>= \(n,bs') ->
254 listReadBytes n bs' >>= \(xs, bs'') ->
256 #if defined(__YALE_HASKELL__)
257 showByteFile l f = (showByteFile (length l) f) >> (listShowByteFile l f)
258 readByteFile f = readByteFile f >>= \ n -> listReadByteFile n f
261 -- A Maybe is stored as a Boolean possibly followed by a value
262 instance (Native a) => Native (Maybe a) where
263 #if !defined(__YALE_HASKELL__)
264 showBytes Nothing = ('\x00' :)
265 showBytes (Just x) = ('\x01' :) . showBytes x
266 readBytes ('\x00':bs) = Just (Nothing, bs)
267 readBytes ('\x01':bs) = readBytes bs >>= \(a,bs') ->
269 readBytes _ = Nothing
271 showBytes (Just a) = showBytes True . showBytes a
272 showBytes Nothing = showBytes False
274 readBytes bs >>= \ (isJust, bs') ->
276 readBytes bs' >>= \ (a, bs'') ->
277 return (Just a, bs'')
279 return (Nothing, bs')
281 showByteFile (Just a) f = showByteFile True f >> showByteFile a f
282 showByteFile Nothing f = showByteFile False f
284 readByteFile f >>= \ isJust ->
286 readByteFile f >>= \ a ->
292 instance (Native a, Ix a, Native b) => Native (Array a b) where
293 showBytes a = showBytes (bounds a) . showBytes (elems a)
294 readBytes bs = readBytes bs >>= \(b, bs')->
295 readBytes bs' >>= \(xs, bs'')->
296 return (listArray b xs, bs'')
298 shortIntToBytes :: Int -> Bytes -> Bytes
299 bytesToShortInt :: Bytes -> Maybe (Int, Bytes)
300 longIntToBytes :: Int -> Bytes -> Bytes
301 bytesToLongInt :: Bytes -> Maybe (Int, Bytes)
302 #if defined(__YALE_HASKELL__)
303 shortIntToByteFile :: Int -> ByteFile -> IO ()
304 bytesToShortIntIO :: ByteFile -> IO Int
307 #if defined(__YALE_HASKELL__)
308 -- These functions are like the primIntxx but use a "short" rather than
309 -- "int" representation.
310 shortIntToBytes = primShortShowBytes
311 bytesToShortInt = primShortReadBytes
312 shortIntToByteFile = primShortShowByteFile
313 bytesToShortIntIO = primShortReadByteFile
317 shortIntToBytes s bs = shortToBytes s bs
319 bytesToShortInt bs = if hasNElems lenShort bs then Just (bytesToShort bs) else Nothing
321 longIntToBytes s bs = longToBytes s bs
323 bytesToLongInt bs = if hasNElems lenLong bs then Just (bytesToLong bs) else Nothing
327 showB :: (Native a) => a -> Bytes
328 showB x = showBytes x []
330 readB :: (Native a) => Bytes -> a
334 Just (_,_) -> error "Native.readB data too long"
335 Nothing -> error "Native.readB data too short"
337 #if defined(__YALE_HASKELL__)
338 readBFile :: String -> IO(Bytes)
340 openInputByteFile name >>= \ f ->
341 readBytesFromByteFile f
343 readBytesFromByteFile :: ByteFile -> IO(Bytes)
344 readBytesFromByteFile f =
346 (primByteReadByteFile f >>= \ h ->
347 readBytesFromByteFile f >>= \ t ->
351 onEOF EOF = closeByteFile f >> return []
352 onEOF err = closeByteFile f >> failwith err