forked from svn2github/freearc
-
Notifications
You must be signed in to change notification settings - Fork 1
/
ByteStream.hs
812 lines (700 loc) · 36.7 KB
/
ByteStream.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
{-# OPTIONS_GHC -cpp #-}
----------------------------------------------------------------------------------------------------
---- Êîäèðîâàíèå ñòðóêòóð äàííûõ â âèäå ïîòîêà áàéòîâ è áóôåðèçàöèÿ åãî çàïèñè/÷òåíèÿ --------------
----------------------------------------------------------------------------------------------------
-----------------------------------------------------------------------------
-- |
-- Module : ByteStream
-- Copyright : (c) Bulat Ziganshin <[email protected]>
-- License : Public domain
--
-- Maintainer : [email protected]
-- Stability : experimental
-- Portability : GHC/Hugs on x86 processors
--
-- This module is like 'Binary' module from NHC - it supports writing data
-- structures to binary files or memory buffers and reading them back.
--
-- This module features:
-- * Compatibility with last versions of GHC and Hugs
-- * Lightning speed, especially for large strings and lists of Ints/Words
-- (i have seen a 10mb/s speed on my 1.2 ghz machine)
-- * Flexibility of input/output - data may be hold in files, memory buffers,
-- or reading/writing may be performed via callbacks
--
-- This module currently DON'T supports:
-- * Haskell'98 compatibility (because it uses "too complex" class scheme)
-- * Compatibility with MSB (most significant byte first) processors,
-- including Power PC, Motorola and Sparc
-- * Compatibility with processors, which require aligning of Ints on word
-- boundaries
-- * Bit-oriented compression (instead it uses byte-oriented compression,
-- which is faster and simplier)
-- * Writing strings which contains null chars
-- * Tell/Seek-like operations on streams and "freezing" streams
-- * Reading input streams via fixed-size buffer (buffering at this time
-- supported only for output streams, input streams must be placed
-- in one memory buffer containing all the data. MOREOVER, YOU MUST
-- ALLOCATE BUFFER WITH 8 ADDITIONAL BYTES AFTER END OF REAL DATA.
-- It's because Integer demarshalling can pre-read whole 9 bytes
-- even for values which use only 1 byte)
--
-- Example of simple usage you can see in the last section of this file,
-- and examples of defining functions to read/write values of some type -
-- in two preceding sections of file. If you need more explanations -
-- please write me.
--
-----------------------------------------------------------------------------
module ByteStream where
import Prelude hiding (read,readList)
import Control.Exception
import Control.Monad
import Control.Monad.Fix
import Data.Bits
import Data.Char
import Data.IORef
import Data.Word
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Marshal.Utils
import Foreign.Storable
import System.IO hiding (openFile)
import GHC.Base (unsafeChr)
import Files
import Utils
aTYPICAL_BUFFER = 64*1024
----------------------------------------------------------------------------------------------------
---- Âûõîäíîé áóôåð äëÿ áûñòðîé çàïèñè ñòðóêòóðèðîâàííûõ äàííûõ ------------------------------------
----------------------------------------------------------------------------------------------------
data OutStream = OutStream
{ ref_buf :: (IORef (Ptr CChar)) -- áóôåð â ïàìÿòè, èñïîëüçóåìûé â íàñòîÿùèé ìîìåíò
, ref_size :: (IORef Int) -- åãî ðàçìåð â áàéòàõ
, ref_pos :: (IORef Int) -- òåêóùàÿ ïîçèöèÿ çàïèñè â áóôåðå
, functions :: ( RecvBuf -- ôóíêöèè, îáåñïå÷èâàþùèå ñâÿçü ñ âíåøíèì ìèðîì
, SendBuf -- (ñì. îïèñàíèå create)
, Cleanup )
}
type RecvBuf = IO (Ptr CChar, Int)
type SendBuf = Ptr CChar -> Int -> Int -> IO ()
type Cleanup = IO ()
-- |Çàïèñàòü âûâîäèìûå äàííûå â ôàéë `filename`, áóôåðèçóÿ èõ â áóôåðå ðàçìåðîì `size` áàéò
createFile filename size = do
file <- fileCreate filename
createBuffered size (fileWriteBuf file) (fileClose file)
-- |Ñîçäàòü âûõîäíîé ïîòîê, âûäåëèâ äëÿ íåãî áóôåð ðàçìåðîì `size` áàéò.
-- Äàííûå, íàêàïëèâàåìûå â áóôåðå, ñïëàâëÿòü íàðóæó ôóíêöèåé `writer`
createBuffered size writer closer = do
buf <- mallocBytes size
let sendBuf buf size len = writer buf len
create (return (buf,size)) sendBuf (free buf >> closer)
-- |Ñîçäàòü âûõîäíîé ïîòîê, âûäåëèâ äëÿ íåãî áóôåð ðàçìåðîì `size` áàéò.
-- Äàííûå, íàêàïëèâàåìûå â áóôåðå, ñïëàâëÿòü íàðóæó ôóíêöèåé `writer`
createMemBuf buf size = do
create (return (buf,size)) (\buf size len -> fail "createMemBuf: Buffer overflow") (return ())
-- |Ñîçäàòü óíèâåðñàëüíûé âûõîäíîé ïîòîê, èñïîëüçóÿ ñëåäóþùèå ôóíêöèè:
-- receiveBuf : IO (buf,size) - ïîëó÷èòü â ñâî¸ ðàñïîðÿæåíèå î÷åðåäíîé áóôåð
-- sendBuf : buf -> size -> len -> IO () - îòïðàâèòü áóôåð íà âûõîä ñ äàííûìè äëèíîé `len`
-- cleanup : IO () - cleanup ïðè çàâåðøåíèè ðàáîòû
create receiveBuf sendBuf cleanup = do
(buf, size) <- receiveBuf -- ñðàçó ïîëó÷èòü ïåðâûé â ñâîåé æèçíè áóôåð
ref_buf <- ref buf
ref_size <- ref size
ref_pos <- ref 0
return (OutStream ref_buf ref_size ref_pos (receiveBuf, sendBuf, cleanup))
-- |Ïîëó÷èòü î÷åðåäíîé áóôåð äëÿ çàïèñè äàííûõ
receiveBuffer (OutStream ref_buf ref_size ref_pos (receiveBuf, _, _)) = do
(buf, size) <- receiveBuf
ref_buf =: buf
ref_size =: size
ref_pos =: 0
-- |Óäîñòîâåðèòüñÿ, ÷òî â áóôåðå åù¸ åñòü ìåñòî äëÿ çàïèñè `bytes` áàéò.
-- Åñëè íåò - ñïëàâèòü ýòîò áóôåð ïåðåêóïùèêàì è ïîëó÷èòü íîâûé, ÷èñòåíüêèé, ãäå ìåñòà óæ òî÷íî äîëæíî õâàòèòü!
ensureFreeSpaceInOutStream buffer@(OutStream _ ref_size ref_pos _) bytes = do
size <- val ref_size
pos <- val ref_pos
when (pos+bytes>size-1) $ do
sendBuffer buffer
receiveBuffer buffer
size <- val ref_size
pos <- val ref_pos
when (pos+bytes>size-1) $
fail$ "OutStream: needs "++show bytes++" bytes, but entire new buffer contains only "++show size++" bytes"
-- |Îòîñëàòü íàêîïëåííîå ñîäåðæèìîå áóôåðà ÷åðåç âûõîäíóþ ôóíêöèþ è ïðåêðàòèòü åãî èñïîëüçîâàíèå
sendBuffer (OutStream ref_buf ref_size ref_pos (_, sendBuf, _)) = do
modifyIORefIO ref_buf $ \buf -> do
size <- val ref_size
pos <- val ref_pos
sendBuf buf size pos
return (error "OutStream::buf undefined")
-- |Îòîñëàòü íàêîïëåííîå ñîäåðæèìîå áóôåðà è çàêðûòü ïîòîê
closeOut buffer@(OutStream _ _ _ (_, _, cleanup)) = do
sendBuffer buffer
cleanup
-- |All-in-one îïåðàöèÿ: ñîçäà¸ò âûõîäíîé ïîòîê, çàïèñûâàåò â íåãî çíà÷åíèå è çàêðûâàåò ïîòîê.
-- Åñëè âàì íóæíî çàïèñàòü íåñêîëüêî çíà÷åíèé - ñîáåðèòå èõ â tuple
writeAll :: (BufferData a) => RecvBuf -> SendBuf -> Cleanup -> a -> IO ()
writeAll receiveBuf sendBuf cleanup x =
bracket (create receiveBuf sendBuf cleanup) (closeOut)
(\buf -> write buf x)
-- |All-in-one îïåðàöèÿ: çàïèñûâàåò çíà÷åíèå â ôàéë è çàêðûâàåò åãî.
-- Åñëè âàì íóæíî çàïèñàòü íåñêîëüêî çíà÷åíèé - ñîáåðèòå èõ â tuple
writeFile filename x =
bracket (createFile filename aTYPICAL_BUFFER) (closeOut)
(\buf -> write buf x)
{-# NOINLINE createFile #-}
{-# NOINLINE createBuffered #-}
{-# NOINLINE create #-}
{-# NOINLINE receiveBuffer #-}
{-# NOINLINE ensureFreeSpaceInOutStream #-}
{-# NOINLINE sendBuffer #-}
{-# NOINLINE closeOut #-}
{-# NOINLINE writeAll #-}
----------------------------------------------------------------------------------------------------
---- Âõîäíîé áóôåð äëÿ áûñòðîãî ÷òåíèÿ ñòðóêòóðèðîâàííûõ äàííûõ ------------------------------------
----------------------------------------------------------------------------------------------------
data InStream = InStream
{ iref_buf :: (IORef (Ptr CChar)) -- áóôåð â ïàìÿòè, èñïîëüçóåìûé â íàñòîÿùèé ìîìåíò
, iref_size :: (IORef Int) -- åãî ðàçìåð â áàéòàõ
, iref_pos :: (IORef Int) -- òåêóùàÿ ïîçèöèÿ çàïèñè â áóôåðå
, ifunctions :: ( RecvBuf -- ôóíêöèè, îáåñïå÷èâàþùèå ñâÿçü ñ âíåøíèì ìèðîì
, SendBuf -- (ñì. îïèñàíèå open)
, Cleanup )
}
-- |to do: Äåêîäèðîâàòü äàííûå èç ôàéëà, ÷èòàÿ èõ ÷åðåç áóôåð ðàçìåðîì `size` áàéò
--  íàñòîÿùèé ìîìåíò ôàéë ÷èòàåòñÿ â ïàìÿòü öåëèêîì,
-- ÷òî âûçâàíî îòñóòñòâèåì ïîääåðæêè ïåðåõîäà ê ñëåäóþùåìó áóôåðó
openFile filename _size = do
file <- fileOpen filename
filesize <- fileGetSize file -- temporary solution
let size = 8 + i filesize -- ditto
buf <- mallocBytes size
let receiveBuf = do len <- fileReadBuf file buf size; return (buf, len)
sendBuf buf size len = return ()
open receiveBuf sendBuf (free buf >> fileClose file)
-- |Äåêîäèðîâàòü äàííûå, ñîäåðæàùèåñÿ â áóôåðå `buf` äëèíîé `size`
openMemory buf size = do
ref_bytes_read <- ref 0 -- ñêîëüêî áàéò â áóôåðå óæå îáðàáîòàíî
let -- receiveBuf âîçâðàùàåò (buf,size) áåç òîé ÷àñòè äàííûõ, êîòîðûå óæå áûëè îáðàáîòàíû
receiveBuf = do bytes_read <- val ref_bytes_read
return (buf+:bytes_read, size-bytes_read)
-- sendBuf îòìå÷àåò, ÷òî åù¸ `len` áàéòîâ áûëî îáðàáîòàíî
sendBuf buf size len = ref_bytes_read += len
-- Èñïîëüçîâàòü óíèâåðñàëüíûé `open`; ïðè ïîïûòêå ïåðåéòè ê ñëåäóþùåìó áóôåðó ïðîñòî âîçâðàùàòü
-- îñòàòîê äàííûõ â `buf`
open receiveBuf sendBuf (return ())
-- |to do: Ñîçäàòü óíèâåðñàëüíûé âõîäíîé ïîòîê, èñïîëüçóÿ ñëåäóþùèå ôóíêöèè:
-- receiveBuf : IO (buf,size) - ïîëó÷èòü áóôåð `buf` ñ äàííûìè ðàçìåðîì `size`
-- sendBuf : buf -> size -> len -> IO () - îñâîáîäèòü ïîëó÷åííûé áóôåð, èç êîòîðîãî ïðî÷èòàíî `len` áàéò
-- cleanup : IO () - cleanup ïðè çàâåðøåíèè ðàáîòû
open receiveBuf sendBuf cleanup = do
(buf, size) <- receiveBuf -- ñðàçó ïîëó÷èòü ïåðâûé â ñâîåé æèçíè áóôåð
ref_buf <- ref buf
ref_size <- ref size
ref_pos <- ref 0
return (InStream ref_buf ref_size ref_pos (receiveBuf, sendBuf, cleanup))
-- |Çàêðûòü âõîäíîé ïîòîê è âûïîëíèòü ïðîöåäóðó `cleanup`
closeIn (InStream _ _ _ (_, _, cleanup)) = do
cleanup
-- |Âîçâðàùàåò óêàçàòåëü ÷òåíèÿ â íà÷àëî òåêóùåãî áóôåðà
rewindMemory buffer@(InStream _ _ pos _) = do
pos =: 0
-- |Ïðîïóñêàåò çàäàííîå ÷èñëî áàéò
skipBytes buffer@(InStream _ _ pos _) bytes = do
pos += bytes
-- |Ïðîâåðÿåò, ÷òî ìû äîñòèãëè êîíöà òåêóùåãî áóôåðà
isEOFMemory buffer@(InStream _ size' pos' _) = do
size <- val size'
pos <- val pos'
return (pos==size)
-- |All-in-one îïåðàöèÿ: ñîçäà¸ò âõîäíîé ïîòîê, ÷èòàåò çíà÷åíèå è çàêðûâàåò ïîòîê.
-- Åñëè âàì íóæíî ïðî÷èòàòü íåñêîëüêî çíà÷åíèé - ñîáåðèòå èõ â tuple
readMemory :: (BufferData a) => Ptr CChar -> Int -> IO a
readMemory buf size = do
bracket (openMemory buf size) (closeIn) (read)
-- |All-in-one îïåðàöèÿ: îòêðûâàåò ôàéë, ÷èòàåò çíà÷åíèå è çàêðûâàåò ôàéë.
-- Åñëè âàì íóæíî ïðî÷èòàòü íåñêîëüêî çíà÷åíèé - ñîáåðèòå èõ â tuple
readFile filename = do
bracket (openFile filename aTYPICAL_BUFFER) (closeIn) (read)
{-# NOINLINE openFile #-}
{-# NOINLINE openMemory #-}
{-# NOINLINE open #-}
{-# NOINLINE closeIn #-}
{-# NOINLINE readMemory #-}
----------------------------------------------------------------------------------------------------
---- Çàïèñü áëîêà ïàìÿòè ---------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
writeBuf :: OutStream -> Ptr a -> Int -> IO ()
writeBuf buffer@(OutStream ref_buf ref_size ref_pos _) dataptr datasize = do
when (datasize>0) $ do
ensureFreeSpaceInOutStream buffer 1
buf <- val ref_buf
size <- val ref_size
pos <- val ref_pos
let len = min datasize (size-pos)
copyBytes (buf+:pos) dataptr len
ref_pos =: pos+len
writeBuf buffer (dataptr+:len) (datasize-len)
----------------------------------------------------------------------------------------------------
---- Êëàññû òèïîâ äàííûõ, äëÿ êîòîðûõ ðåàëèçîâàíî ÷òåíèå/çàïèñü â áóôåð ----------------------------
----------------------------------------------------------------------------------------------------
-- |Ýëåìåíòû ýòîãî êëàññà ìîãóò çàïèñûâàòüñÿ â âûõîäíîé áóôåð è ÷èòàòüñÿ èç âõîäíîãî
class BufferData a where
-- |Çàïèñàòü îäíî çíà÷åíèå â âûõîäíîé áóôåð
write :: OutStream -> a -> IO ()
-- |Çàïèñàòü â áóôåð öåëûé ñïèñîê çíà÷åíèé - ðåàëèçàöèÿ ïî óìîë÷àíèþ äåëàåò ýòî ìåäëåííî è ïå÷àëüíî :)
writeList :: OutStream -> [a] -> IO ()
writeList buffer list = mapM_ (write buffer) list
-- |Ïðî÷èòàòü îäíî çíà÷åíèå èç âõîäíîãî áóôåðà
read :: InStream -> IO a
-- |Ïðî÷èòàòü èç âõîäíîãî áóôåðà öåëûé ñïèñîê çíà÷åíèé - è òîæå ðåàëèçàöèÿ ïî óìîë÷àíèþ ñëåãêà çàäóì÷èâà :)
readList :: InStream -> Int -> IO [a]
readList buffer length = replicateM length (read buffer)
{-# NOINLINE read #-}
{-# NOINLINE write #-}
{-# NOINLINE readList #-}
{-# NOINLINE writeList #-}
-- Óòâåðäèòü íà äîëæíîñòè ïðîöåäóðû êëàññà FastBufferData, âûïîëíÿþùèå ôóíêöèè ïðîöåäóð êëàññà BufferData :)
instance (FastBufferData a) => BufferData a where
write = writeFast
writeList = writeListFast
read = readFast
readList = readListFast
-- |Ýëåìåíòû ýòîãî êëàññà ìîãóò Î×ÅÍÜ ÁÛÑÒÐÎ çàïèñûâàòüñÿ â âûõîäíîé áóôåð è ÷èòàòüñÿ èç âõîäíîãî
class FastBufferData a where
-- Äëÿ ýòîãî îíè äîëæíû ïðåäîñòàâèòü ñëåäóþùèå ñïðàâêè:
-- Ìàêñèìàëüíîå êîë-âî áàéò, êîòîðîå ìîæåò çàíèìàòü îäíî çíà÷åíèå (1 äëÿ CChar, 4 äëÿ Int32 è ò.ä.)
maxSizeOf :: a -> Int
-- Ïðîöåäóðà, çàïèñûâàþùàÿ â áóôåð `buf` íà ïîçèöèþ `pos` çíà÷åíèå `x`, è âîçâðàùàþùàÿ
-- ïîçèöèþ â áóôåðå ïîñëå çàïèñàííûõ äàííûõ (äëÿ òèïîâ, çàíèìàþùèõ ôèêñèðîâàííîå ÷èñëî áàéò,
-- ýòî áóäåò ïðîñòî "pos+maxSizeOf x")
writeUnchecked :: Ptr CChar -> a -> Int -> IO Int
-- Ïðîöåäóðà, ÷èòàþùàÿ èç áóôåðà `buf` ñ ïîçèöèè `pos` çíà÷åíèå, âîçâðàùàþùàÿ ýòî çíà÷åíèå,
-- è îáíîâëÿþùàÿ ïîçèöèþ â áóôåðå
readUnchecked :: Ptr CChar -> Int -> IO (a, Int)
-- |Çàïèñàòü â áóôåð îäíî çíà÷åíèå - è ïîáûñòðåå
writeFast :: OutStream -> a -> IO ()
writeFast buffer@(OutStream ref_buf _ ref_pos _) x = do
ensureFreeSpaceInOutStream buffer (maxSizeOf x) -- ïðîâåðèòü, ÷òî â áóôåðå õâàòèò ìåñòà
buf <- val ref_buf
modifyIORefIO ref_pos (writeUnchecked buf x) -- çàïèñàòü äàííûå â áóôåð è îáíîâèòü çíà÷åíèå ref_pos
-- |Áûñòðî-áûñòðî çàïèñàòü â áóôåð öåëûé ñïèñîê!
writeListFast :: OutStream -> [a] -> IO ()
writeListFast buffer@(OutStream ref_buf _ ref_pos _) list = do
let aSIZE = 100
-- Ïðîâåðèòü, ÷òî â áóôåðå õâàòèò ìåñòà íà `aSIZE` çíà÷åíèé äàííîãî òèïà
ensureFreeSpaceInOutStream buffer (aSIZE * maxSizeOf (head list))
buf <- val ref_buf
pos <- val ref_pos
-- Ïðîöåäóðà "go list pos n" çàïèñûâàåò áåç âñÿêèõ ïðîâåðîê, íà÷èíàÿ ñ ïîçèöèè `pos`,
-- äàííûå èç ñïèñêà `list`, íî íå áîëåå `n` çíà÷åíèé. Åñëè ñïèñîê îêàçàëñÿ
-- äëèííåå - ñíîâà âûçûâàåòñÿ ïðîöåäóðà `writeListFast`, êîòîðàÿ ïðîâåðèò,
-- ÷òî â áóôåðå íàéä¸òñÿ ìåñòî äëÿ åù¸ 100 çíà÷åíèé, è ïðîäîëæèò çàïèñü ñïèñêà ñ òîãî
-- ìåñòà, íà êîòîðîì ìû îñòàíîâèëèñü
--
let --go :: (FastBufferData a) => [a] -> Int -> Int -> IO ()
go [] pos _ = ref_pos =: pos -- Ìû êîí÷èëè! Íàäî òîëüêî çàïèñàòü íîâóþ ïîçèöèþ â áóôåðå!
go list pos 0 = do ref_pos =: pos -- Çàïèñûâàåì íîâóþ ïîçèöèþ â áóôåðå
writeListFast buffer list -- ... è âûçûâàåì ôóíêöèþ ðåêóðñèâíî äëÿ îñòàòêà ñïèñêà
go (x:xs) pos n = do new_pos <- writeUnchecked buf x pos -- çàïèñàòü î÷åðåäíîé ýëåìåíò
go xs new_pos (n-1) -- ... è ïåðåéòè ê ñëåäóþùåìó
go list pos aSIZE -- çàïèñàòü ñïèñîê â ïàìÿòü áåç ïðîâåðîê, íî íå áîëåå `aSIZE` çíà÷åíèé
-- |Áûñòðîå ÷òåíèå îäíîãî çíà÷åíèÿ èç âõîäíîãî áóôåðà
readFast :: InStream -> IO a
readFast buffer@(InStream buf _ pos _) = do
abuf <- val buf
apos <- val pos
(x, new_pos) <- readUnchecked abuf apos
pos =: new_pos
return x
-- |Áûñòðîå ÷òåíèå öåëîãî ñïèñêà èç âõîäíîãî áóôåðà
readListFast :: InStream -> Int -> IO [a]
readListFast buffer@(InStream buf _ pos _) length = do
abuf <- val buf
apos <- val pos
let --go :: (FastBufferData a) => Int -> Int -> [a] -> IO [a]
go apos 0 xs = do pos =: apos
return (reverse xs)
go apos n xs = do (x, new_pos) <- readUnchecked abuf apos
go new_pos (n-1) (x:xs)
go apos length []
{-# NOINLINE readFast #-}
{-# NOINLINE writeFast #-}
{-# NOINLINE readListFast #-}
{-# NOINLINE writeListFast #-}
----------------------------------------------------------------------------------------------------
---- Ðåàëèçàöèè äëÿ ïðîñòûõ òèïîâ äàííûõ -----------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- Ëþáàÿ èíñòàíöèÿ êëàññà Storable àâòîìàòè÷åñêè ñòàíîâèòñÿ èíñòàíöèåé êëàññà FastBufferData:
-- ìû çíàåì, ñêîëüêî äàííûå òàêîãî òèïà çàíèìàþò áàéò, è êàê çàïèñàòü èõ â ïàìÿòü/ïðî÷èòàòü èç ïàìÿòè
instance (Storable a) => FastBufferData a where
maxSizeOf x = sizeOf x
writeUnchecked buf x pos = do
pokeByteOff buf pos x
return (pos + sizeOf x)
readUnchecked buf pos = do
x <- peekByteOff buf pos
return (x, pos + sizeOf x)
-- Ñèìâîëû çàïèñûâàþòñÿ â UTF-8
instance BufferData Char where
write buf c = writeList buf (toUTF8List [c])
read buffer@(InStream buf _ pos _) = do
buf' <- val buf
pos' <- val pos
unpackCharUtf8 buf' pos' pos
-- Ñòðîêà çàïèñûâàåòñÿ êàê îáû÷íûé ñïèñîê ñèìâîëîâ, íî ñ íóëåâûì ñèìâîëîì â êîíöå (â ñòèëå Ñè)
instance BufferData String where
write buf str = writeList buf (toUTF8List str) >> write buf (0::Word8)
read buffer@(InStream buf _ pos _) = do
buf' <- val buf
pos' <- val pos
unpackCStringUtf8 buf' pos' pos
-- Öåëûå ÷èñëà íåîãðàíè÷åííîé òî÷íîñòè êîäèðóþòñÿ ìåòîäîì, ÿâëÿþùèìñÿ óëó÷øåíèåì èñïîëüçóåìîãî â 7-zip.
-- Ïðè ýòîì âåëè÷èíû âïëîòü äî 2^64 òðåáóþò äëÿ çàïèñè ïåðåìåííîå ÷èñëî áàéò: îò 1 äî 9
instance FastBufferData Integer where
maxSizeOf x = 9 -- ìàêñèìóì: 1 áàéò èç åäèíè÷åê è 8 áàéòîâ äàííûõ
writeUnchecked buf x pos = do
let write1 x pos = writeUnchecked buf (x::Word8) pos
write4 x pos = writeUnchecked buf (x::Word32) pos
write_8 x pos = writeUnchecked buf (x::Word64) pos
-- Â ïàìÿòü çàïèñûâàåòñÿ ñðàçó 4 èëè 8 áàéò, íî óêàçàòåëü ïîçèöèè èçìåíÿåòñÿ òîëüêî íà íóæíîå
-- ÷èñëî áàéò. Êîë-âî ìëàäøèõ áèòîâ-åäèíè÷åê â ïåðâîì çàïèñàííîì áàéòå îïðåäåëÿåò, ñêîëüêî
-- äîïîëíèòåëüíûõ áàéò íóæíî ïðî÷èòàòü, ÷òîáû ïîëó÷èòü âñ¸ ÷èñëî
-- Ýòà ðåàëèçàöèÿ ðàññ÷èòàíà òîëüêî íà ìàøèíû, ãäå ïåðâûì â ïàìÿòè èä¸ò ìëàäøèé çíà÷àùèé áàéò!!!
-- Êðîìå òîãî, îíà îïòèìèçèðîâàíà äëÿ 32-ðàçðÿäíûõ ìàøèí, äëÿ 64-áèòíûõ ýòîò êîä áóäåò íåîïòèìàëåí
case () of
_ | x<0 -> fail$ "Sorry, FastBufferData.Integer.writeUnchecked don't support negative values like this: "++show x
| x<128 -> do write4 (i x* 2+ 0) pos; return (pos+1)
| x<128^2 -> do write4 (i x* 4+ 1) pos; return (pos+2)
| x<128^3 -> do write4 (i x* 8+ 3) pos; return (pos+3)
| x<128^4 -> do write4 (i x* 16+ 7) pos; return (pos+4)
| x<128^5 -> do write_8 (i x* 32+ 15) pos; return (pos+5)
| x<128^6 -> do write_8 (i x* 64+ 31) pos; return (pos+6)
| x<128^7 -> do write_8 (i x*128+ 63) pos; return (pos+7)
| x<128^8 -> do write_8 (i x*256+127) pos; return (pos+8)
| x<256^8 -> do write1 255 pos >>= write_8 (i x); return (pos+9)
| otherwise -> fail$ "Sorry, FastBufferData.Integer.writeUnchecked don't support numbers larger than 256^8, like this: "++show x
readUnchecked buf pos = do
-- Èç ïàìÿòè ÷èòàþòñÿ ñðàçó 4 áàéòà, íî èç íèõ èñïîëüçóþòñÿ òîëüêî ìëàäøèå áàéòû, îñòàëüíûå ìàñêèðóþòñÿ
(x::Word32,_) <- readUnchecked buf pos
case () of
_ | x .&. 1 == 0 -> return (i$ (x `mod` 256^1) `shiftR` 1, pos+1)
| x .&. 3 == 1 -> return (i$ (x `mod` 256^2) `shiftR` 2, pos+2)
| x .&. 7 == 3 -> return (i$ (x `mod` 256^3) `shiftR` 3, pos+3)
| x .&. 15 == 7 -> return (i$ (x ) `shiftR` 4, pos+4)
| otherwise -> do
-- Åñëè çíà÷åíèå çàíèìàåò áîëüøå 4-õ áàéò, òî ïðî÷èòàòü èç ïàìÿòè 8 áàéòîâ è îïÿòü æå çàìàñêèðîâàòü ñòàðøèå
(x::Word64,_) <- readUnchecked buf pos
case () of
_ | x .&. 31 == 15 -> return (i$ (x `mod` 256^5) `shiftR` 5, pos+5)
| x .&. 63 == 31 -> return (i$ (x `mod` 256^6) `shiftR` 6, pos+6)
| x .&.127 == 63 -> return (i$ (x `mod` 256^7) `shiftR` 7, pos+7)
| x .&.255 == 127 -> return (i$ (x ) `shiftR` 8, pos+8)
| otherwise -> do
-- È ïîñëåäíèé âàðèàíò - áàéò èç åäèíè÷íûõ áèòîâ ïëþñ 8 áàéò ñîáñòâåííî çíà÷åíèÿ
(x::Word64, _) <- readUnchecked buf (pos+1); return (i x, pos+9)
-- Áóëåâñêèå âåëè÷èíû ïîîäèíî÷êå çàïèñûâàþòñÿ êàê çíà÷åíèÿ òèïà Word8 (ò.å íà êàæäîå
-- ðàñõîäóåòñÿ öåëûé áàéò), à ïðè çàïèñè ñïèñêà ãðóïïèðóþòñÿ ïî âîñåìü çíà÷åíèé íà îäèí áàéò
instance FastBufferData Bool where
maxSizeOf x = maxSizeOf (undefined :: Word8)
writeUnchecked buf x pos = writeUnchecked buf (toWord8 x) pos
readUnchecked buf pos = do (x, new_pos) <- readUnchecked buf pos; return (fromWord8 x, new_pos)
{-
writeListFast buffer = writeListFast buffer . makeBytes
where
makeBytes (a:b:c:d:e:f:g:h:xs) = (((((((n a*2+n b)*2+n c)*2+n d)*2+n e)*2+n f)*2+n g)*2+n h) : makeBytes xs
makeBytes [a,b,c,d,e,f,g] = (((((((n a*2+n b)*2+n c)*2+n d)*2+n e)*2+n f)*2+n g)*2) : []
makeBytes [a,b,c,d,e,f] = (((((((n a*2+n b)*2+n c)*2+n d)*2+n e)*2+n f)*2)*2) : []
makeBytes [a,b,c,d,e] = (((((((n a*2+n b)*2+n c)*2+n d)*2+n e)*2)*2)*2) : []
makeBytes [a,b,c,d] = (((((((n a*2+n b)*2+n c)*2+n d)*2)*2)*2)*2) : []
makeBytes [a,b,c] = (((((((n a*2+n b)*2+n c)*2)*2)*2)*2)*2) : []
makeBytes [a,b] = (((((((n a*2+n b)*2)*2)*2)*2)*2)*2) : []
makeBytes [a] = (((((((n a*2)*2)*2)*2)*2)*2)*2) : []
makeBytes [] = []
n = toWord8
-}
----------------------------------------------------------------------------------------------------
---- Ðåàëèçàöèè äëÿ ñîñòàâíûõ òèïîâ äàííûõ ---------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- |Ôóíêöèè, ïîçâîëÿþùèå çàïèñûâàòü çíà÷åíèÿ ëþáûõ öåëî÷èñëåííûõ òèïîâ â ôîðìàòå ñ ïåðåìåííîé äëèíîé
writeInteger buf = write buf.toInteger
readInteger buf = read buf >>= return.fromInteger
{-
-- |Çàïèñàòü ñïèñîê íåîòðèöàòåëüíûõ çíà÷åíèé, îãðàíè÷åííûõ ñâåðõó âåëè÷èíîé max'
-- Äëÿ ýôôåêòèâíîñòè ïðîöåññà çàïèñè è áîëüøåé ñæèìàåìîñòè ïðåäñòàâëåíèÿ âñå çíà÷åíèÿ ïðè ýòîì
-- ïðåäñòàâëÿþòñÿ 1/2/4/8 áàéòàìè
writeBoundList buf max =
case () of
_ | toInteger max <= toInteger (maxBound::Word8) -> writeList buf . map toWord8
| toInteger max <= toInteger (maxBound::Word16) -> writeList buf . map toWord16
| toInteger max <= toInteger (maxBound::Word32) -> writeList buf . map toWord32
| toInteger max <= toInteger (maxBound::Word64) -> writeList buf . map toWord64
| otherwise -> writeList buf
-- |Ïðî÷èòàòü ñïèñîê íåîòðèöàòåëüíûõ çíà÷åíèé, îãðàíè÷åííûõ ñâåðõó âåëè÷èíîé max'
-- Äëÿ ýôôåêòèâíîñòè ïðîöåññà çàïèñè è áîëüøåé ñæèìàåìîñòè ïðåäñòàâëåíèÿ âñå çíà÷åíèÿ ïðè ýòîì
-- ïðåäñòàâëÿþòñÿ 1/2/4/8 áàéòàìè
readBoundList buf max n =
case () of
_ | toInteger max <= toInteger (maxBound::Word8) -> readList buf n >>= return.map fromWord8
| toInteger max <= toInteger (maxBound::Word16) -> readList buf n >>= return.map fromWord16
| toInteger max <= toInteger (maxBound::Word32) -> readList buf n >>= return.map fromWord32
| toInteger max <= toInteger (maxBound::Word64) -> readList buf n >>= return.map fromWord64
| otherwise -> readList buf n
-}
instance (BufferData a) => BufferData [a] where
write buf list = writeInteger buf (length list) >> writeList buf list
read buf = readInteger buf >>= readList buf
instance (BufferData a, BufferData b) => BufferData (a,b) where
write buf (a,b) = write buf a >> write buf b
read buf = do a <- read buf; b <- read buf; return (a,b)
instance (BufferData a, BufferData b, BufferData c) => BufferData (a,b,c) where
write buf (a,b,c) = write buf ((a,b),c)
read buf = do ((a,b),c) <- read buf; return (a,b,c)
instance (BufferData a, BufferData b, BufferData c, BufferData d) => BufferData (a,b,c,d) where
write buf (a,b,c,d) = write buf ((a,b),c,d)
read buf = do ((a,b),c,d) <- read buf; return (a,b,c,d)
instance (BufferData a, BufferData b, BufferData c, BufferData d, BufferData e) => BufferData (a,b,c,d,e) where
write buf (a,b,c,d,e) = write buf ((a,b),c,d,e)
read buf = do ((a,b),c,d,e) <- read buf; return (a,b,c,d,e)
instance (BufferData a, BufferData b, BufferData c, BufferData d, BufferData e, BufferData f) => BufferData (a,b,c,d,e,f) where
write buf (a,b,c,d,e,f) = write buf ((a,b),c,d,e,f)
read buf = do ((a,b),c,d,e,f) <- read buf; return (a,b,c,d,e,f)
instance (BufferData a, BufferData b, BufferData c, BufferData d, BufferData e, BufferData f, BufferData g) => BufferData (a,b,c,d,e,f,g) where
write buf (a,b,c,d,e,f,g) = write buf ((a,b),c,d,e,f,g)
read buf = do ((a,b),c,d,e,f,g) <- read buf; return (a,b,c,d,e,f,g)
instance (BufferData a, BufferData b, BufferData c, BufferData d, BufferData e, BufferData f, BufferData g, BufferData h) => BufferData (a,b,c,d,e,f,g,h) where
write buf (a,b,c,d,e,f,g,h) = write buf ((a,b),c,d,e,f,g,h)
read buf = do ((a,b),c,d,e,f,g,h) <- read buf; return (a,b,c,d,e,f,g,h)
instance (BufferData a) => BufferData (Maybe a) where
write buf (Just a) = write buf (True,a)
write buf (Nothing) = write buf False
read buf = do x <- read buf; if x then (return.Just =<< read buf) else (return Nothing)
instance (BufferData a, BufferData b) => BufferData (Either a b) where
write buf (Left a) = write buf (True, a)
write buf (Right b) = write buf (False,b)
read buf = do x <- read buf; if x then (return.Left =<< read buf) else (return.Right =<< read buf)
{- Ïîïûòêà ñäåëàòü óíèâåðñàëüíûé êëàññ äëÿ ÷òåíèÿ/çàïèñè äàííûõ
class DerivedBufferData a where
toTuple :: BufferData b => a -> b
fromTuple :: BufferData b => b -> a
instance DerivedBufferData a => BufferData a where
write buf a = write buf (toTuple a)
read buf = do a <- read buf; return (fromTuple a)
instance (BufferData a, BufferData b) => DerivedBufferData (Either a b) where
toTuple (Left a) = (True, a)
toTuple (Right b) = (False, b)
fromTuple (True, a) = (Left a)
fromTuple (False, b) = (Right b)
instance (Enum a) => BufferData a where
write buf a = writeInteger buf (fromEnum a)
read buf = readInteger buf >>= return.toEnum
-}
instance (FastBufferData a, FastBufferData b) => FastBufferData (a,b) where
maxSizeOf (a,b) = maxSizeOf a + maxSizeOf b
writeUnchecked buf (a,b) pos = writeUnchecked buf a pos >>= writeUnchecked buf b
readUnchecked buf pos = do
(a, pos) <- readUnchecked buf pos
(b, pos) <- readUnchecked buf pos
return ((a,b), pos)
{-# NOINLINE writeUnchecked #-}
{-# NOINLINE readUnchecked #-}
instance (FastBufferData a, FastBufferData b, FastBufferData c) => FastBufferData (a,b,c) where
maxSizeOf (a,b,c) = maxSizeOf a + maxSizeOf b + maxSizeOf c
writeUnchecked buf (a,b,c) pos =
writeUnchecked buf a pos
>>= writeUnchecked buf b
>>= writeUnchecked buf c
readUnchecked buf pos = do
(a, pos) <- readUnchecked buf pos
(b, pos) <- readUnchecked buf pos
(c, pos) <- readUnchecked buf pos
return ((a,b,c), pos)
{-# NOINLINE writeUnchecked #-}
{-# NOINLINE readUnchecked #-}
instance (FastBufferData a, FastBufferData b, FastBufferData c, FastBufferData d) => FastBufferData (a,b,c,d) where
maxSizeOf (a,b,c,d) = maxSizeOf a + maxSizeOf b + maxSizeOf c + maxSizeOf d
writeUnchecked buf (a,b,c,d) pos =
writeUnchecked buf a pos
>>= writeUnchecked buf b
>>= writeUnchecked buf c
>>= writeUnchecked buf d
readUnchecked buf pos = do
(a, pos) <- readUnchecked buf pos
(b, pos) <- readUnchecked buf pos
(c, pos) <- readUnchecked buf pos
(d, pos) <- readUnchecked buf pos
return ((a,b,c,d), pos)
{-# NOINLINE writeUnchecked #-}
{-# NOINLINE readUnchecked #-}
----------------------------------------------------------------------------------------------------
---- Âñïîìîãàòåëüíûå ôóíêöèè -----------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- |Ôóíêöèè ïðåîáðàçîâàíèÿ ê çàäàííûì òèïàì
toWord8 x = toEnum (fromEnum x) :: Word8
toWord16 x = toEnum (fromEnum x) :: Word16
toWord32 x = toEnum (fromEnum x) :: Word32
toWord64 x = i x :: Word64
-- |Ôóíêöèè ïðåîáðàçîâàíèÿ èç çàäàííûõ òèïîâ
fromWord8 (x::Word8 ) = toEnum (fromEnum x)
fromWord16 (x::Word16) = toEnum (fromEnum x)
fromWord32 (x::Word32) = toEnum (fromEnum x)
fromWord64 (x::Word64) = i x
#define STRICT1(f) f a | a `seq` False = undefined
#define STRICT2(f) f a b | a `seq` b `seq` False = undefined
#define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined
#define STRICT4(f) f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined
#define STRICT5(f) f a b c d e | a `seq` b `seq` c `seq` d `seq` e `seq` False = undefined
#define STRICT6(f) f a b c d e f | a `seq` b `seq` c `seq` d `seq` e `seq` f `seq` False = undefined
toUTF8List :: String -> [Word8]
STRICT1(toUTF8List)
toUTF8List [] = []
toUTF8List (x:xs)
| ord x<=0x007f = fromIntegral (ord x):
toUTF8List xs
| ord x<=0x07ff = fromIntegral (0xC0 .|. ((ord x `shiftR` 6) .&. 0x1F)):
fromIntegral (0x80 .|. (ord x .&. 0x3F)):
toUTF8List xs
| ord x<=0xffff = fromIntegral (0xE0 .|. ((ord x `shiftR` 12) .&. 0x0F)):
fromIntegral (0x80 .|. ((ord x `shiftR` 6) .&. 0x3F)):
fromIntegral (0x80 .|. (ord x .&. 0x3F)):
toUTF8List xs
| otherwise = fromIntegral (0xF0 .|. (ord x `shiftR` 18)) :
fromIntegral (0x80 .|. ((ord x `shiftR` 12) .&. 0x3F)) :
fromIntegral (0x80 .|. ((ord x `shiftR` 6) .&. 0x3F)) :
fromIntegral (0x80 .|. (ord x .&. 0x3F)) :
toUTF8List xs
-- | Convert UTF-8 to Unicode.
fromUTF8 :: [Word8] -> String
fromUTF8 xs = fromUTF' (map fromIntegral xs) where
fromUTF' [] = []
fromUTF' (all@(x:xs))
| x<=0x7F = (chr (x)):fromUTF' xs
| x<=0xBF = err
| x<=0xDF = twoBytes all
| x<=0xEF = threeBytes all
| otherwise = fourBytes all
twoBytes (x1:x2:xs) = chr ((((x1 .&. 0x1F) `shift` 6) .|.
(x2 .&. 0x3F))):fromUTF' xs
twoBytes _ = error "fromUTF8: illegal two byte sequence"
threeBytes (x1:x2:x3:xs) = chr ((((x1 .&. 0x0F) `shift` 12) .|.
((x2 .&. 0x3F) `shift` 6) .|.
(x3 .&. 0x3F))):fromUTF' xs
threeBytes _ = error "fromUTF8: illegal three byte sequence"
fourBytes (x1:x2:x3:x4:xs) = chr ((((x1 .&. 0x0F) `shift` 18) .|.
((x2 .&. 0x3F) `shift` 12) .|.
((x3 .&. 0x3F) `shift` 6) .|.
(x4 .&. 0x3F))):fromUTF' xs
fourBytes _ = error "fromUTF8: illegal four byte sequence"
err = error "fromUTF8: illegal UTF-8 character"
-- |Convert UTF8-encoded byte array to Char
STRICT3(unpackCharUtf8)
unpackCharUtf8 buf pos ref_pos = do
let addr = castPtr buf :: Ptr Word8
ch0 <- fromIntegral `liftM` peekElemOff addr pos
case () of
_ | ch0 <= 0x7F -> do
ref_pos =: pos+1
return $! (unsafeChr (fromIntegral ch0))
| ch0 <= 0xDF -> do
ref_pos =: pos+2
ch1 <- fromIntegral `liftM` peekElemOff addr (pos+1)
return $! (unsafeChr (((ch0 - 0xC0) `shiftL` 6) +
(ch1 - 0x80)))
| ch0 <= 0xEF -> do
ref_pos =: pos+3
ch1 <- fromIntegral `liftM` peekElemOff addr (pos+1)
ch2 <- fromIntegral `liftM` peekElemOff addr (pos+2)
return $! (unsafeChr (((ch0 - 0xE0) `shiftL` 12) +
((ch1 - 0x80) `shiftL` 6) +
(ch2 - 0x80)))
| otherwise -> do
ref_pos =: pos+4
ch1 <- fromIntegral `liftM` peekElemOff addr (pos+1)
ch2 <- fromIntegral `liftM` peekElemOff addr (pos+2)
ch3 <- fromIntegral `liftM` peekElemOff addr (pos+3)
return $! (unsafeChr (((ch0 - 0xF0) `shiftL` 18) +
((ch1 - 0x80) `shiftL` 12) +
((ch2 - 0x80) `shiftL` 6) +
(ch3 - 0x80)))
-- |Convert UTF8-encoded byte array to String
--unpackCStringUtf8 :: Ptr Word8 -> Int -> IO String
STRICT3(unpackCStringUtf8)
unpackCStringUtf8 buf pos ref_pos = do
unpack pos
where
addr = castPtr buf :: Ptr Word8
unpack nh = do
ch0 <- fromIntegral `liftM` peekElemOff addr nh
case () of
_ | ch0 == 0 -> do
ref_pos =: nh + 1
return []
| ch0 <= 0x7F -> do
chs <- unpack (nh + 1)
return $! (unsafeChr (fromIntegral ch0) : chs)
| ch0 <= 0xDF -> do
ch1 <- fromIntegral `liftM` peekElemOff addr (nh+1)
chs <- unpack (nh + 2)
return $! (unsafeChr (((ch0 - 0xC0) `shiftL` 6) +
(ch1 - 0x80)) : chs)
| ch0 <= 0xEF -> do
ch1 <- fromIntegral `liftM` peekElemOff addr (nh+1)
ch2 <- fromIntegral `liftM` peekElemOff addr (nh+2)
chs <- unpack (nh + 3)
return $! (unsafeChr (((ch0 - 0xE0) `shiftL` 12) +
((ch1 - 0x80) `shiftL` 6) +
(ch2 - 0x80)) : chs)
| otherwise -> do
ch1 <- fromIntegral `liftM` peekElemOff addr (nh+1)
ch2 <- fromIntegral `liftM` peekElemOff addr (nh+2)
ch3 <- fromIntegral `liftM` peekElemOff addr (nh+3)
chs <- unpack (nh + 4)
return $! (unsafeChr (((ch0 - 0xF0) `shiftL` 18) +
((ch1 - 0x80) `shiftL` 12) +
((ch2 - 0x80) `shiftL` 6) +
(ch3 - 0x80)) : chs)
----------------------------------------------------------------------------------------------------
---- Example of simple usage of in/out byte streams ------------------------------------------------
----------------------------------------------------------------------------------------------------
{-
test = do
-- Writing and reading memory buffer as one operation
--to do: (buf,bufsize) <- ByteStream.writeMemory (sign, block_type, crc)
(sign::Word32, block_type::Int16, crc::Word64) <- ByteStream.readMemory buf bufsize
-- Writing and reading file as one operation
ByteStream.writeFile "test" [1..1000::Integer]
(restored::[Integer]) <- ByteStream.readFile "test"
-- Writing and reading file, divided to low-level operations
stream <- ByteStream.createFile "test" 5000
ByteStream.write stream "asdfr"
ByteStream.write stream "12345"
ByteStream.write stream [10,20..500::Int]
ByteStream.write stream ([10,20..500] ++ [103*10^3, 106*10^6, 109*10^9, 112*10^12, 115*10^15::Integer])
ByteStream.write stream (concat$ replicate 100 [True,False,True])
ByteStream.closeOut stream
stream <- ByteStream.openFile "test" 5000
(x::String) <- ByteStream.read stream
(y::String) <- ByteStream.read stream
(a::[Int]) <- ByteStream.read stream
(b::[Integer]) <- ByteStream.read stream
(c::[Bool]) <- ByteStream.read stream
ByteStream.closeIn stream
print [x,y]
print a
print b
print c
-}
--Checklist:
--1. +ïîëó÷àòü áóôåðà ôóíêöèåé receiveBuf = receiveP pipe
--2. +write äëÿ Storable ïî óìîë÷àíèþ - ïðîâåðÿåò íàëè÷èå ñâîáîäíîãî ìåñòà è äåëàåò pokeByteOff elem
--3. +áûñòðàÿ çàïèñü ñòðîê
--4. +èñïîëüçîâàòü writeUnchecked
--5. +äîäåëàòü êîäèðîâàíèå Integer
--6. +ïåðåèìåíîâàòü WriteList â WriteListWithoutLength
--7. +óïðîñòèòü èìåíà ôóíêöèé äëÿ êâàëèôèöèðîâàííîãî èìïîðòà è ñäåëàòü read/writeList=writeLength+writeListWithoutLength
--8. ïðàâèëüíî ïåðåõîäèòü ñ îäíîãî áóôåðà íà äðóãîé
--9. ÷èòàòü áîëåå 100 ýëåìåíòîâ â ñïèñêå
--10. âîññòàíîâèòü êîäèðîâàíèå [Bool]
--11. ïåðåäåëàòü ÷òåíèå ñòðîê ÷òîá èçáàâèòüñÿ îò reverse (â ñò¸ê ïîìåùàòü ïîðìåæóòî÷íûå äàííûå - áåç tail recursion)
--12. ÷òåíèå FastBufferData îðãàíèçîâàòü áåç âîçâðàøåíèÿ tuple - pos ñäåëàòü èëè IORef Int, èëè FastMutInt, èëè IORef (Ptr CChar)