serialize.ml 2.01 KB
Newer Older
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
module Put = struct
  type t = { 
    buf : Buffer.t;
    mutable cur_byte : int; (* 0..255 *)
    mutable cur_bits : int; (* 0..7 *)
  }
  type 'a f = t -> 'a -> unit

  let run f x =
    let t = { buf = Buffer.create 1024; cur_byte = 0; cur_bits = 0 } in
    f t x;
    if t.cur_bits > 0 then Buffer.add_char t.buf (Char.chr t.cur_byte); 
    Buffer.contents t.buf

  let bool t b =
    if b then t.cur_byte <- t.cur_byte lor (1 lsl t.cur_bits);
    if t.cur_bits = 7 then (
      Buffer.add_char t.buf (Char.chr t.cur_byte);
      t.cur_byte <- 0;
      t.cur_bits <- 0
    ) else
      t.cur_bits <- succ t.cur_bits
    
  let rec bits t i nb = (* TODO: opt *)
    if (nb > 0) then (bool t ((i land 1) <> 0); bits t (i lsr 1) (pred nb))

  let rec int t i =
    bits t i 4;
    let i = i lsr 4 in
    if i <> 0 then (bool t true; int t i) else (bool t false)

  let string t s =
    let l = String.length s in 
    int t l;
    for i = 0 to l - 1 do
      bits t (Char.code (s.[i])) 8
    done

  let rec list f t = function
    | [] -> bool t false
    | hd::tl -> bool t true; f t hd; list f t tl

  let pair f1 f2 t (x,y) = f1 t x; f2 t y
end


module Get = struct
  type t = { buf : string; mutable idx : int; mutable idx_bits : int }
  type 'a f = t -> 'a

  let run f s =
    f { buf = s; idx = 0; idx_bits = 0 }

  let bool t =
    let b = ((Char.code t.buf.[t.idx]) lsr t.idx_bits) land 1 <> 0 in
    if t.idx_bits = 7 then (t.idx_bits <- 0; t.idx <- succ t.idx)
    else t.idx_bits <- succ t.idx_bits;
    b
    
  let rec bits t nb =
    if nb = 0 then 0 
    else if bool t 
    then succ (bits t (pred nb) lsl 1)
    else bits t (pred nb) lsl 1

  let rec int t =
    let i = bits t 4 in
    if bool t then i + (int t) lsl 4 
    else i

  let string t =
    let l = int t in
    let s = String.create l in
    for i = 0 to l - 1 do
      s.[i] <- Char.chr (bits t 8)
    done;
    s

  let rec list f t =
    if bool t then let hd = f t in hd::(list f t)
    else []

  let pair f1 f2 t =
    let x = f1 t in
    let y = f2 t in
    (x,y)
end