genericSerializer.ml 6.08 KB
Newer Older
Benoit Barbot's avatar
Benoit Barbot committed
1
2
3
4
5
6
7
8
open Buffer

let b64_of_ui i =
  if i<26 then char_of_int (i+65)
  else if i < 52 then char_of_int (i-26+97)
  else if i < 62 then char_of_int (i-52+48)
  else if i=62 then '+'
  else '/'
Benoit Barbot's avatar
gen    
Benoit Barbot committed
9

Benoit Barbot's avatar
Benoit Barbot committed
10
11
12
13
14
15
let ui_of_b64 c =
  let i = int_of_char c in
  if i>=65 && i<91 then i -65
  else if i>= 97 && i<123 then i-97+26
  else if i>= 48 && i<58 then i-48+52
  else if i=43 then 62
Benoit Barbot's avatar
gen    
Benoit Barbot committed
16
17
18
19
20
21
22
  else 63

let print_buff s =
  String.iter (fun c -> let i = ui_of_b64 c in
                        Printf.printf "[%i]" i
    ) s

Benoit Barbot's avatar
Benoit Barbot committed
23
let buff_int b i =
Benoit Barbot's avatar
gen    
Benoit Barbot committed
24
25
26
27
28
29
30
  if i>=0 && i< 32 then add_char b (b64_of_ui i)
  else if i>=0 && i< (1 lsl 10) then (
  let i1 = i/32 + 32
  and i2 = i mod 32 in
  add_char b (b64_of_ui i1);
  add_char b (b64_of_ui i2);
  ) else
Benoit Barbot's avatar
Benoit Barbot committed
31
    let r = max 2 (int_of_float ((log @@ float @@ abs @@ i) /. log 2.0) / 5) in
Benoit Barbot's avatar
gen    
Benoit Barbot committed
32
33
34
35
    add_char b (b64_of_ui (32 + (if i<0 then 16 else 0) + ((abs i) lsr (r*5))));
    let j = ref ((abs i) mod (1 lsl (5*r))) in
    let r2 = ref (r*5) in
    while !r2 > 0 do
Benoit Barbot's avatar
Benoit Barbot committed
36
37
      (*print_string ((string_of_int !r2)^":");
      print_endline (string_of_int !j);*)
Benoit Barbot's avatar
gen    
Benoit Barbot committed
38
      r2:= !r2-5;
Benoit Barbot's avatar
Benoit Barbot committed
39
40
      add_char b (b64_of_ui ((if !r2>0 then 32 else 0) + (!j lsr !r2)));
      j:= !j mod (1 lsl !r2);
Benoit Barbot's avatar
gen    
Benoit Barbot committed
41
42
43
    done

let int_buff s pos =
Benoit Barbot's avatar
Benoit Barbot committed
44
45
  let r = ref 0 in
  while ui_of_b64 s.[pos+ !r] >= 32 do incr r done;
Benoit Barbot's avatar
gen    
Benoit Barbot committed
46
  let i1 = ui_of_b64 s.[pos] in
Benoit Barbot's avatar
Benoit Barbot committed
47
48
49
50
51
52
53
54
55
56
57
58
59
60
  if !r =0 then pos+1,i1
  else if !r =1 then
    let i2 = ui_of_b64 s.[pos+1] in
    pos+2, (i1 mod (1 lsl 5))*(1 lsl 5) + i2
  else
    let j = ref (i1 mod 16) in
    let r2 = ref 1 in
    while !r2 <= !r do
      let i2 = ui_of_b64 s.[pos+ !r2] in
      j := (!j lsl 5) + ( i2 mod 32);
      incr r2;
    done;
    if (i1 mod 32) >=16 then pos+ !r2, (- !j)
    else pos+ !r2, !j
Benoit Barbot's avatar
gen    
Benoit Barbot committed
61
62

(*let buff_int b i =
Benoit Barbot's avatar
Benoit Barbot committed
63
64
65
66
67
68
69
70
71
72
73
74
  let ui = (i + (1 lsl 17)) mod (1 lsl 18) in
  let i1 = ui / (1 lsl 12)
  and i2 = (ui / (1 lsl 6)) mod (1 lsl 6)
  and i3 = ui mod (1 lsl 6) in
  add_char b (b64_of_ui i1);
  add_char b (b64_of_ui i2);
  add_char b (b64_of_ui i3)
let int_buff s pos =
  let i1 = ui_of_b64 s.[pos]
  and i2 = ui_of_b64 s.[pos+1]
  and i3 = ui_of_b64 s.[pos+2] in
  let ui = i1*(1 lsl 12) + i2*(1 lsl 6) +i3 in
Benoit Barbot's avatar
gen    
Benoit Barbot committed
75
76
  ui - (1 lsl 17)*)

Benoit Barbot's avatar
Benoit Barbot committed
77
let buff_float b f =
Benoit Barbot's avatar
Benoit Barbot committed
78
  let i = int_of_float (f *. 100.0) in
Benoit Barbot's avatar
Benoit Barbot committed
79
80
  buff_int b i
let float_buff b pos =
Benoit Barbot's avatar
Benoit Barbot committed
81
82
  let p,f = int_buff b pos in
  p, ((float_of_int f) /. 100.)
Benoit Barbot's avatar
Benoit Barbot committed
83

Benoit Barbot's avatar
prog    
Benoit Barbot committed
84
85
86
87
88
89
90
91
92
93
94
95
96
97

let check f =
  let t = Buffer.create 10 in
  buff_float t f;
  let str = (Bytes.to_string @@ Buffer.to_bytes t) in
  print_buff str;
  let p1,f1= float_buff str 0 in
  print_endline (string_of_float f);
  print_endline (string_of_float f1);
  assert(f1=f);;

check (10000.0)

let _ =
Benoit Barbot's avatar
gen    
Benoit Barbot committed
98
  let t = Buffer.create 100 in
Benoit Barbot's avatar
Benoit Barbot committed
99
  for i = -1025 to 1020 do
Benoit Barbot's avatar
gen    
Benoit Barbot committed
100
101
102
103
104
105
106
107
108
109
    buff_int t i;
  done;
  let str = (Bytes.to_string @@ Buffer.to_bytes t) in
  print_buff str;
  print_newline ();
  let pos = ref 0 in
  while !pos < String.length str do
    let p1,i1= int_buff str !pos in
    pos := p1;
    print_endline (string_of_int i1);
Benoit Barbot's avatar
prog    
Benoit Barbot committed
110
  done
Benoit Barbot's avatar
bug    
Benoit Barbot committed
111

Benoit Barbot's avatar
Benoit Barbot committed
112
113
let buff_string b str =
  let n = String.length str in
Benoit Barbot's avatar
bug    
Benoit Barbot committed
114
  buff_int b (((n+2)/3)*4);
Benoit Barbot's avatar
Benoit Barbot committed
115
116
117
118
119
120
121
122
  let pos = ref 0 in
  let pi i = add_char b (b64_of_ui i) in
  while !pos < n do
    let v1 = int_of_char str.[!pos] in
    pi (v1/4);
    begin if !pos+1 < n then
            let v2 = 256*(v1 mod 4) + int_of_char str.[!pos+1] in
            pi (v2/16);
Benoit Barbot's avatar
gen    
Benoit Barbot committed
123

Benoit Barbot's avatar
Benoit Barbot committed
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
            if !pos+2 < n then
              let v3 = 256*(v2 mod 16) + int_of_char str.[!pos+2] in
              pi (v3/64);
              pi (v3 mod 64)
            else
              let vp3 = 256*(v2 mod 16) + 0 in
              pi (vp3/64);
              add_char b '='
          else
            let vp2 = 256*(v1 mod 4) + 0 in
            pi (vp2/16);
            add_char b '=';
            add_char b '='
    end;
    pos := !pos+3
Benoit Barbot's avatar
bug    
Benoit Barbot committed
139
140
141
  done

let string_buff b pin =
Benoit Barbot's avatar
Benoit Barbot committed
142
143
  let p,n = int_buff b pin in
  let pos = ref p in
Benoit Barbot's avatar
bug    
Benoit Barbot committed
144
145
  let pos2 = ref 0 in
  let str = Bytes.create ((n/4)*3) in
Benoit Barbot's avatar
Benoit Barbot committed
146
  while !pos < n+p do
Benoit Barbot's avatar
bug    
Benoit Barbot committed
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
    let v1 = ui_of_b64 b.[!pos] in
    let v2 = ui_of_b64 b.[!pos+1] in
    Bytes.set str !pos2 @@ char_of_int (v1*4 + v2/16);
    if b.[!pos+2] <> '=' then
      let v3 = ui_of_b64 b.[!pos+2] in
      if b.[!pos+3] <> '=' then
        let v4 = ui_of_b64 b.[!pos+3] in
        Bytes.set str (!pos2+1) @@ char_of_int ((v2 mod 16)*16 + v3/4);
        Bytes.set str (!pos2+2) @@ char_of_int ((v3 mod 4)*64 + v4);
        pos2:= !pos2+3;
      else begin
          Bytes.set str (!pos2+1) @@ char_of_int ((v2 mod 16)*16 + v3/4);
          pos2:= !pos2+2;
        end;
    else pos2:= !pos2+1;
    pos:= !pos+4;
  done;
  !pos,Bytes.sub_string str 0 !pos2;;
Benoit Barbot's avatar
Benoit Barbot committed
165

Benoit Barbot's avatar
gen    
Benoit Barbot committed
166

Benoit Barbot's avatar
Benoit Barbot committed
167
168
(*let t = Buffer.create 1000 in
    buff_int t (-5024);
Benoit Barbot's avatar
bug    
Benoit Barbot committed
169
    buff_string t "Mandsflsdh sdlhkfsd sd h % ^& # ";
Benoit Barbot's avatar
Benoit Barbot committed
170
171
172
173
174
175
    let str = Bytes.to_string @@ Buffer.to_bytes t in
    print_endline str;
    let p,i = int_buff str 0 in
    print_endline (string_of_int i);
    print_endline (string_of_int p);
    string_buff str p*)
Benoit Barbot's avatar
bug    
Benoit Barbot committed
176
177
178
179

let buff_list b f l =
  List.iter (fun x -> Buffer.add_char b 'l'; f b x) l

Benoit Barbot's avatar
gen    
Benoit Barbot committed
180

Benoit Barbot's avatar
bug    
Benoit Barbot committed
181
182
183
184
185
186
187
188
189
190
191
192
193
let rec list_buff b f pos =
  if pos < String.length b && b.[pos] = 'l' then
    let p,le = f b (pos+1) in
    let p2,lq = list_buff b f p in
    p2,le::lq
  else pos,[]


(*let t = Buffer.create 10 in
    buff_list t buff_int [54443;1;1;1;1;1;-2556;5];
    let s = Bytes.to_string @@ Buffer.to_bytes t in
    print_endline s;
    list_buff s (fun b p -> p+3,int_buff b p) 0  ;;*)
Benoit Barbot's avatar
gen    
Benoit Barbot committed
194
195


Benoit Barbot's avatar
bug    
Benoit Barbot committed
196
197
198
199
200
201
let buff_attribute b = function
    `Color c -> Buffer.add_char b 'c'; buff_string b c
  | `ControlPoint (f1,f2)-> Buffer.add_char b 'P'; buff_float b f1; buff_float b f2
  | `String s -> Buffer.add_char b 'S'; buff_string b s
  | `Choice sl -> buff_list b buff_string sl

Benoit Barbot's avatar
gen    
Benoit Barbot committed
202

Benoit Barbot's avatar
bug    
Benoit Barbot committed
203
204
205
let attribute_buff b pos = match b.[pos] with
    'c' -> let p,s = string_buff b (pos+1) in
           p,(`Color s)
Benoit Barbot's avatar
Benoit Barbot committed
206
207
  | 'P' -> let p1,f1 = float_buff b (pos+1) in
           let p2,f2 = float_buff b p1 in p2,`ControlPoint (f1,f2)
Benoit Barbot's avatar
bug    
Benoit Barbot committed
208
209
210
211
212
  | 'S' -> let p,s = string_buff b (pos+1) in
           p,(`String s)
  | 'd' -> let p,s = list_buff b string_buff (pos+1) in
           p,(`Choice s)
  | _ -> failwith "bad serialization"
Benoit Barbot's avatar
gen    
Benoit Barbot committed
213
214


Benoit Barbot's avatar
Benoit Barbot committed
215
let write_attribute b (_,s,a) =
Benoit Barbot's avatar
bug    
Benoit Barbot committed
216
217
218
  add_char b 'T';
  buff_string b s;
  buff_attribute b a
Benoit Barbot's avatar
prog    
Benoit Barbot committed
219
220
221
222
223
224

let read_attribute b pos =
  assert (b.[pos] = 'T');
  let pos2,s = string_buff b (pos+1) in
  let pos3,at = attribute_buff b pos2 in
  pos3,(s,at)