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 = length (longToBytes 0 [])
131 lenInt = length (intToBytes 0 [])
132 lenShort = length (shortToBytes 0 [])
133 lenFloat = length (floatToBytes 0 [])
134 lenDouble = length (doubleToBytes 0 [])
137 -- Basic instances, defined as primitives
139 instance Native Char where
140 #if defined(__YALE_HASKELL__)
141 showBytes = primCharShowBytes
142 readBytes = primCharReadBytes
143 showByteFile = primCharShowByteFile
144 readByteFile = primCharReadByteFile
146 showBytes c bs = c:bs
147 readBytes [] = Nothing
148 readBytes (c:cs) = Just (c,cs)
149 listReadBytes n bs = f n bs []
150 where f 0 bs cs = Just (reverse cs, bs)
152 f n (b:bs) cs = f (n-1::Int) bs (b:cs)
155 instance Native Int where
156 #if defined(__YALE_HASKELL__)
157 showBytes = primIntShowBytes
158 readBytes = primIntReadBytes
159 showByteFile = primIntShowByteFile
160 readByteFile = primIntReadByteFile
162 showBytes i bs = intToBytes i bs
163 readBytes bs = if hasNElems lenInt bs then Just (bytesToInt bs) else Nothing
166 instance Native Float where
167 #if defined(__YALE_HASKELL__)
168 showBytes = primFloatShowBytes
169 readBytes = primFloatReadBytes
170 showByteFile = primFloatShowByteFile
171 readByteFile = primFloatReadByteFile
173 showBytes i bs = floatToBytes i bs
174 readBytes bs = if hasNElems lenFloat bs then Just (bytesToFloat bs) else Nothing
177 instance Native Double where
178 #if defined(__YALE_HASKELL__)
179 showBytes = primDoubleShowBytes
180 readBytes = primDoubleReadBytes
181 showByteFile = primDoubleShowByteFile
182 readByteFile = primDoubleReadByteFile
184 showBytes i bs = doubleToBytes i bs
185 readBytes bs = if hasNElems lenDouble bs then Just (bytesToDouble bs) else Nothing
188 instance Native Bool where
189 #if defined(__YALE_HASKELL__)
190 showBytes = primBoolShowBytes
191 readBytes = primBoolReadBytes
192 showByteFile = primBoolShowByteFile
193 readByteFile = primBoolReadByteFile
195 showBytes b bs = if b then '\x01':bs else '\x00':bs
196 readBytes [] = Nothing
197 readBytes (c:cs) = Just(c/='\x00', cs)
200 #if defined(__YALE_HASKELL__)
201 -- Byte instances, so you can write Bytes to a ByteFile
203 instance Native Byte where
209 showByteFile = primByteShowByteFile
210 readByteFile = primByteReadByteFile
213 -- A pair is stored as two consecutive items.
214 instance (Native a, Native b) => Native (a,b) where
215 showBytes (a,b) = showBytes a . showBytes b
216 readBytes bs = readBytes bs >>= \(a,bs') ->
217 readBytes bs' >>= \(b,bs'') ->
219 #if defined(__YALE_HASKELL__)
220 showByteFile (a,b) f = (showByteFile a f) >> (showByteFile b f)
223 readByteFile f >>= \ a ->
224 readByteFile f >>= \ b ->
228 -- A triple is stored as three consectutive items.
229 instance (Native a, Native b, Native c) => Native (a,b,c) where
230 showBytes (a,b,c) = showBytes a . showBytes b . showBytes c
231 readBytes bs = readBytes bs >>= \(a,bs') ->
232 readBytes bs' >>= \(b,bs'') ->
233 readBytes bs'' >>= \(c,bs''') ->
234 return ((a,b,c), bs''')
235 #if defined(__YALE_HASKELL__)
236 showByteFile (a,b,c) f =
237 (showByteFile a f) >>
238 (showByteFile b f) >>
242 readByteFile f >>= \ a ->
243 readByteFile f >>= \ b ->
244 readByteFile f >>= \ c ->
248 -- A list is stored with an Int with the number of items followed by the items.
249 instance (Native a) => Native [a] where
250 showBytes xs bs = showBytes (length xs) (f xs) where f [] = bs
251 f (x:xs) = showBytes x (f xs)
252 readBytes bs = readBytes bs >>= \(n,bs') ->
253 listReadBytes n bs' >>= \(xs, bs'') ->
255 #if defined(__YALE_HASKELL__)
256 showByteFile l f = (showByteFile (length l) f) >> (listShowByteFile l f)
257 readByteFile f = readByteFile f >>= \ n -> listReadByteFile n f
260 -- A Maybe is stored as a Boolean possibly followed by a value
261 instance (Native a) => Native (Maybe a) where
262 #if !defined(__YALE_HASKELL__)
263 showBytes Nothing = ('\x00' :)
264 showBytes (Just x) = ('\x01' :) . showBytes x
265 readBytes ('\x00':bs) = Just (Nothing, bs)
266 readBytes ('\x01':bs) = readBytes bs >>= \(a,bs') ->
268 readBytes _ = Nothing
270 showBytes (Just a) = showBytes True . showBytes a
271 showBytes Nothing = showBytes False
273 readBytes bs >>= \ (isJust, bs') ->
275 readBytes bs' >>= \ (a, bs'') ->
276 return (Just a, bs'')
278 return (Nothing, bs')
280 showByteFile (Just a) f = showByteFile True f >> showByteFile a f
281 showByteFile Nothing f = showByteFile False f
283 readByteFile f >>= \ isJust ->
285 readByteFile f >>= \ a ->
291 instance (Native a, Ix a, Native b) => Native (Array a b) where
292 showBytes a = showBytes (bounds a) . showBytes (elems a)
293 readBytes bs = readBytes bs >>= \(b, bs')->
294 readBytes bs' >>= \(xs, bs'')->
295 return (listArray b xs, bs'')
297 shortIntToBytes :: Int -> Bytes -> Bytes
298 bytesToShortInt :: Bytes -> Maybe (Int, Bytes)
299 longIntToBytes :: Int -> Bytes -> Bytes
300 bytesToLongInt :: Bytes -> Maybe (Int, Bytes)
301 #if defined(__YALE_HASKELL__)
302 shortIntToByteFile :: Int -> ByteFile -> IO ()
303 bytesToShortIntIO :: ByteFile -> IO Int
306 #if defined(__YALE_HASKELL__)
307 -- These functions are like the primIntxx but use a "short" rather than
308 -- "int" representation.
309 shortIntToBytes = primShortShowBytes
310 bytesToShortInt = primShortReadBytes
311 shortIntToByteFile = primShortShowByteFile
312 bytesToShortIntIO = primShortReadByteFile
316 shortIntToBytes s bs = shortToBytes s bs
318 bytesToShortInt bs = if hasNElems lenShort bs then Just (bytesToShort bs) else Nothing
320 longIntToBytes s bs = longToBytes s bs
322 bytesToLongInt bs = if hasNElems lenLong bs then Just (bytesToLong bs) else Nothing
326 showB :: (Native a) => a -> Bytes
327 showB x = showBytes x []
329 readB :: (Native a) => Bytes -> a
333 Just (_,_) -> error "Native.readB data too long"
334 Nothing -> error "Native.readB data too short"
336 #if defined(__YALE_HASKELL__)
337 readBFile :: String -> IO(Bytes)
339 openInputByteFile name >>= \ f ->
340 readBytesFromByteFile f
342 readBytesFromByteFile :: ByteFile -> IO(Bytes)
343 readBytesFromByteFile f =
345 (primByteReadByteFile f >>= \ h ->
346 readBytesFromByteFile f >>= \ t ->
350 onEOF EOF = closeByteFile f >> return []
351 onEOF err = closeByteFile f >> failwith err