run_dispatch.ml 18.1 KB
Newer Older
1
2
(* Running dispatchers *)

3
4
5
(* Possible simple optimizations:
     - in make_result_prod, see if buffer can be simply overwritten
       (precompute this ...)
6
     - optimize for Xml elements (don't build the Pair (attr,content))
7
8
*)

9
10
11
12
(*
let (<) : int -> int -> bool = (<);;
*)

13
open Value
14
open Ident
15
open Patterns.Compile
16
open Encodings
17

18
19
20
21
22
23
24
25

let buffer = ref (Array.create 127 Absent)
let cursor = ref 0

let blit a1 ofs1 a2 ofs2 len =
  for i = 0 to len - 1 do
    Array.unsafe_set a2 (ofs2 + i) (Array.unsafe_get a1 (ofs1 + i))
  done
26
(* important to do this in the increasing order ... *)
27
28
29
30
31
32
33
34


let ensure_room n =
  let l = Array.length !buffer in
  if !cursor + n > l then
    let buffer' = Array.create (l * 2 + n) Absent in
    blit !buffer 0 buffer' 0 !cursor;
    buffer := buffer'
35
36
37
38
39
40
41
42

let push v =
  ensure_room 1;
  !buffer.(!cursor) <- v;
  incr cursor


(* Old dispatchers *)
43
    
44

45
let make_result_prod v1 r1 v2 r2 v (code,r) = 
46
  let n = Array.length r in
47
  if n == 0 then code else (
48
49
  ensure_room n;
  let buf = !buffer in
50
  let c = !cursor in
51
52
53
54
55
56
57
58
59
60
  for a = 0 to n - 1 do
    let x = match Array.unsafe_get r a with
      | Catch -> v
      | Const c -> const c
      | Left i -> if (i < 0) then v1 else buf.(r1 + i)
      | Right j -> if (j < 0) then v2 else buf.(r2 + j)
      | Recompose (i,j) -> 
	  Pair ((if (i < 0) then v1 else buf.(r1 + i)),
		(if (j < 0) then v2 else buf.(r2 + j))) 
    in
61
    buf.(c + a) <- x
62
  done;
63
  if r1 != c then blit buf c buf r1 n;
64
65
  cursor := r1 + n;  (* clean space for GC ? *)
  code )
66
67

let make_result_basic v (code,r) = 
68
  let n = Array.length r in
69
  if n == 0 then code else (
70
71
72
73
74
75
76
77
  ensure_room n;
  let buf = !buffer in
  for a = 0 to n - 1 do
    let x = match Array.unsafe_get r a with
      | Catch -> v
      | Const c -> const c 
      | _ -> assert false
    in
78
79
    buf.(!cursor) <- x;
    incr cursor
80
81
82
  done;
  code )

83

84
let make_result_char ch (code,r) = 
85
  let n = Array.length r in
86
  if n == 0 then code else (
87
88
89
90
91
92
93
94
95
96
  ensure_room n;
  let buf = !buffer in
  for a = 0 to n - 1 do
    let x = match Array.unsafe_get r a with
      | Catch -> Char ch
      | Const c -> const c
      | _ -> assert false
    in
    buf.(!cursor + a) <- x
  done;
97
  cursor := !cursor + n;
98
  code )
99

100
let tail_string_latin1 i j s q =
101
  if i + 1 == j then q else String_latin1 (i + 1,j,s,q)
102

103
let make_result_string_latin1 i j s q r1 r2 (code,r) = 
104
  let n = Array.length r in
105
  if n == 0 then code else (
106
107
108
109
  ensure_room n;
  let buf = !buffer in
  for a = 0 to n - 1 do
    let x = match Array.unsafe_get r a with
110
      | Catch -> String_latin1 (i,j,s,q)
111
      | Const c -> const c
112
      | Left n -> if (n < 0) then Char (Chars.V.mk_char s.[i]) else buf.(r1 + n)
113
      | Right m -> if (m < 0) then tail_string_latin1 i j s q else buf.(r2 + m)
114
      | Recompose (n,m) -> 
115
	  Pair ((if (n < 0) then Char (Chars.V.mk_char s.[i]) else buf.(r1 + n)),
116
		(if (m < 0) then tail_string_latin1 i j s q else buf.(r2 + m))) 
117
118
119
    in
    buf.(!cursor + a) <- x
  done;
120
  if r1 != !cursor then blit buf !cursor buf r1 n;
121
122
  cursor := r1 + n;
  code )
123

124
125
126
127
128
129
let tail_string_utf8 i j s q =
  let i = Utf8.advance s i in
  if Utf8.equal_index i j then q else String_utf8 (i,j,s,q)

let make_result_string_utf8 i j s q r1 r2 (code,r) = 
  let n = Array.length r in
130
  if n == 0 then code else (
131
132
133
134
135
136
  ensure_room n;
  let buf = !buffer in
  for a = 0 to n - 1 do
    let x = match Array.unsafe_get r a with
      | Catch -> String_utf8 (i,j,s,q)
      | Const c -> const c
137
      | Left n -> if (n < 0) then Char (Chars.V.mk_int (Utf8.get s i)) else buf.(r1 + n)
138
139
      | Right m -> if (m < 0) then tail_string_utf8 i j s q else buf.(r2 + m)
      | Recompose (n,m) -> 
140
	  Pair ((if (n < 0) then Char (Chars.V.mk_int (Utf8.get s i)) else buf.(r1 + n)),
141
142
143
144
		(if (m < 0) then tail_string_utf8 i j s q else buf.(r2 + m))) 
    in
    buf.(!cursor + a) <- x
  done;
145
  if r1 != !cursor then blit buf !cursor buf r1 n;
146
147
  cursor := r1 + n;
  code )
148

149
150
151
let rec run_disp_basic v f =  function
  | [(_,r)] -> make_result_basic v r
  | (t,r)::rem -> if f t then make_result_basic v r else run_disp_basic v f rem
152
  | _ -> assert false
153

154
let rec run_dispatcher d v = 
155
156
157
158
(*
  Format.fprintf Format.std_formatter "Matching (%a) with:@\n" Value.print v;
  Patterns.Compile.print_dispatcher Format.std_formatter d;
*)
159
160
161
  match actions d with
    | AIgnore r -> make_result_basic v r
    | AKind k -> run_disp_kind k v
162

163
164
and run_disp_kind actions v =
  match v with
165
  | Pair (v1,v2) -> run_disp_prod v v1 v2 actions.prod
166
  | Xml (v1,v2,v3) -> run_disp_prod v v1 (Pair (v2,v3)) actions.xml
167
  | Record r -> run_disp_record false v (LabelMap.get r) actions.record
168
169
170
171
172
173
  | String_latin1 (i,j,s,q) -> 
(*      run_disp_kind actions (Value.normalize v) *)
      run_disp_string_latin1 i j s q actions
  | String_utf8 (i,j,s,q) -> 
(*      run_disp_kind actions (Value.normalize v) *)
	run_disp_string_utf8 i j s q actions 
174
175
  | Atom a -> make_result_basic v (Atoms.get_map a actions.atoms) 
  | Char c -> make_result_basic v (Chars.get_map c actions.chars) 
176
  | Integer i ->
177
      run_disp_basic v (fun t -> Types.Int.has_int t i) actions.basic
178
179
  | Abstraction (iface,_)
  | Abstraction2 (_,iface,_) ->
180
      run_disp_basic v (fun t -> Types.Arrow.check_iface iface t) 
181
        actions.basic
182
183
184
  | Abstract (abs,_) -> 
      run_disp_basic v (fun t -> Types.Abstract.contains abs (Types.get_abstract t))
	actions.basic
185
186
  | Absent ->
      run_disp_basic v (fun t -> Types.Record.has_absent t) actions.basic
187
  | Concat (_,_) as v -> run_disp_kind actions (Value.normalize v)
188
  | Delayed _ -> assert false
189
190


191
and run_disp_prod v v1 v2 = function
192
193
  | Impossible -> assert false
  | TailCall d1 -> run_dispatcher d1 v1
194
  | Ignore d2 -> run_disp_prod2 v1 !cursor v v2 d2
195
  | Dispatch (d1,b1) ->
196
197
      let r1 = !cursor in
      let code1 = run_dispatcher d1 v1 in
198
199
      run_disp_prod2 v1 r1 v v2 b1.(code1)

200
and run_disp_prod2 v1 r1 v v2 = function
201
  | Impossible -> assert false
202
  | Ignore r -> make_result_prod v1 r1 v2 !cursor v r
203
204
  | TailCall d2 -> run_dispatcher d2 v2
  | Dispatch (d2,b2) ->
205
206
      let r2 = !cursor in
      let code2 = run_dispatcher d2 v2 in
207
      make_result_prod v1 r1 v2 r2 v b2.(code2)
208

209
and run_disp_record other v fields = function
210
  | None -> assert false
211
  | Some (RecLabel (l,d)) ->
212
213
      let rec aux other = function
	| (l1,_) :: rem when l1 < l -> aux true rem
214
	| (l1,vl) :: rem when l1 == l ->
215
216
217
	    run_disp_record1 other vl rem d
	| rem -> 
	    run_disp_record1 other Absent rem d
218
      in
219
      aux other fields
220
  | Some (RecNolabel (some,none)) ->
221
      let other = other || (fields != []) in
222
223
224
225
226
227
228
229
      let r = if other then some else none in
      match r with
	| Some r -> make_result_basic v r
	| None -> assert false
      
and run_disp_record1 other v1 rem = function
  | Impossible -> assert false
  | TailCall d1 -> run_dispatcher d1 v1
230
  | Ignore d2 ->  run_disp_record2 other v1 !cursor rem d2
231
  | Dispatch (d1,b1) ->
232
233
      let r1 = !cursor in
      let code1 = run_dispatcher d1 v1 in
234
      run_disp_record2 other v1 r1 rem b1.(code1)
235

236
and run_disp_record2 other v1 r1 rem = function
237
  | Impossible -> assert false
238
  | Ignore r -> make_result_prod v1 r1 Absent 0 Absent r
239
240
  | TailCall d2 -> run_disp_record_loop other rem d2
  | Dispatch (d2,b2) ->
241
242
      let r2 = !cursor in
      let code2 = run_disp_record_loop other rem d2 in
243
244
245
246
247
      make_result_prod v1 r1 Absent r2 Absent b2.(code2)

and run_disp_record_loop other rem d =
  match actions d with
    | AIgnore r -> make_result_basic Absent r
248
    | AKind k -> run_disp_record other Absent rem k.record
249
  
250

251
and run_disp_string_latin1 i j s q actions = 
252
  if i == j then run_disp_kind actions q 
253
254
  else match actions.prod with
    | Impossible -> assert false
255
    | TailCall d1 -> run_disp_string_latin1_char d1 (Chars.V.mk_char s.[i])
256
257
258
    | Ignore d2 -> run_disp_string_latin1_2 !cursor i j s q d2
    | Dispatch (d1,b1) ->
	let r1 = !cursor in
259
	let code1 = run_disp_string_latin1_char d1 (Chars.V.mk_char s.[i]) in
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
	run_disp_string_latin1_2 r1 i j s q b1.(code1)
and run_disp_string_latin1_char d ch =
  match actions d with
    | AIgnore r -> make_result_char ch r
    | AKind k -> make_result_char ch (Chars.get_map ch k.chars) 
and run_disp_string_latin1_2 r1 i j s q = function
  | Impossible -> assert false
  | Ignore r -> 
      make_result_string_latin1 i j s q r1 0 r
  | TailCall d2 -> run_disp_string_latin1_loop i j s q d2
  | Dispatch (d2,b2) ->
      let r2 = !cursor in
      let code2 = run_disp_string_latin1_loop i j s q d2 in
      make_result_string_latin1 i j s q r1 r2 b2.(code2)
and run_disp_string_latin1_loop i j s q d =
  match actions d with
    | AIgnore r -> make_result_basic Absent r
    | AKind k -> run_disp_string_latin1 (succ i) j s q k

and run_disp_string_utf8 i j s q actions = 
  if Utf8.equal_index i j then run_disp_kind actions q 
  else match actions.prod with
    | Impossible -> assert false
283
    | TailCall d1 -> run_disp_string_utf8_char d1 (Chars.V.mk_int (Utf8.get s i))
284
    | Ignore d2 -> run_disp_string_utf8_2 !cursor i j s q d2
285
    | Dispatch (d1,b1) ->
286
	let r1 = !cursor in
287
	let code1 = run_disp_string_utf8_char d1 (Chars.V.mk_int (Utf8.get s i)) in
288
289
	run_disp_string_utf8_2 r1 i j s q b1.(code1)
and run_disp_string_utf8_char d ch =
290
291
  match actions d with
    | AIgnore r -> make_result_char ch r
292
    | AKind k -> make_result_char ch (Chars.get_map ch k.chars) 
293
and run_disp_string_utf8_2 r1 i j s q = function
294
295
  | Impossible -> assert false
  | Ignore r -> 
296
297
      make_result_string_utf8 i j s q r1 0 r
  | TailCall d2 -> run_disp_string_utf8_loop i j s q d2
298
  | Dispatch (d2,b2) ->
299
      let r2 = !cursor in
300
301
302
      let code2 = run_disp_string_utf8_loop i j s q d2 in
      make_result_string_utf8 i j s q r1 r2 b2.(code2)
and run_disp_string_utf8_loop i j s q d =
303
304
  match actions d with
    | AIgnore r -> make_result_basic Absent r
305
    | AKind k -> run_disp_string_utf8 (Utf8.advance s i) j s q k
306
307
308

let run_dispatcher d v =
  let code = run_dispatcher d v in
309
310
  cursor := 0;
  (code,!buffer) 
311
312

let old_dispatcher = run_dispatcher    
313

314
  
315
316
317
318
319
320
321
(*
let rec check_overwrite_aux r i =
  if i < 0 then true
  else match r.(i) with
    | Right j | Recompose (_,j) -> 
	if (j < 0) || (j >=i ) then check_overwrite_aux r (i - 1) else false
    | _ -> check_overwrite_aux r (i - 1)
322

323
324
325
326
327
328

let check_overwrite r2 r =
  (Array.length r2 = Array.length r) && (check_overwrite_aux r (Array.length r - 1))


*)
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




(* New dispatcher *)

open Patterns.Compile2

let make_result_basic v (code,r) = 
  let n = Array.length r in
  if n > 0 then (
    ensure_room n;
    let buf = !buffer in
    for a = 0 to n - 1 do
      buf.(!cursor) <- begin match Array.unsafe_get r a with
	| SrcCapture -> v
	| SrcCst c -> const c
	| _ -> assert false
      end;
      incr cursor
    done);
  code


let make_result_prod v1 r1 v2 r2 v (code,r) = 
  let n = Array.length r in
  if n > 0 then (
    ensure_room n;
    let buf = !buffer in
    let c = !cursor in
    for a = 0 to n - 1 do
       buf.(c + a) <- match Array.unsafe_get r a with
	 | SrcCapture -> v
	 | SrcLeft -> v1
	 | SrcRight -> v2
	 | SrcCst c -> const c
	 | SrcFetchLeft i -> buf.(r1+i)
	 | SrcFetchRight i -> buf.(r2+i)
	 | SrcPair (l,r) ->
	     Pair (
	       (match l with 
		  | SrcLeft -> v1 | SrcRight -> v2 
		  | SrcFetchLeft i -> buf.(r1+i) 
		  | SrcFetchRight i -> buf.(r2+i) | _ -> assert false),
373
	       (match r with 
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
		  | SrcLeft -> v1 | SrcRight -> v2 
		  | SrcFetchLeft i -> buf.(r1+i) 
		  | SrcFetchRight i -> buf.(r2+i) | _ -> assert false))
	 | _ -> assert false
    done;
    if r1 != c then blit buf c buf r1 n;
    cursor := r1 + n);
  code

let make_result_record sp v (code,r) = 
  let n = Array.length r in
  if n > 0 then (
    ensure_room n;
    let buf = !buffer in
    let c = !cursor in
    for a = 0 to n - 1 do
       buf.(c + a) <- match Array.unsafe_get r a with
	 | SrcLocal i -> buf.(sp+i)
	 | _ -> assert false
    done;
    if sp != c then blit buf c buf sp n;
    cursor := sp + n);
  code

let rec run_disp_basic v f =  function
  | [(_,r)] -> make_result_basic v r
  | (t,r)::rem -> if f t then make_result_basic v r else run_disp_basic v f rem
  | _ -> assert false

let count = ref 0
let rec run_dispatcher d v = 
(*  Format.fprintf Format.std_formatter "Matching (%a)@." Value.print v; *)
(*   Patterns.Compile.print_dispatcher Format.std_formatter d; *)
(*  print_string "."; flush stdout; *)
408
(*  incr count;
409
410
411
412
413
  print_int !count;
  print_string "X"; flush stdout;
  if !count = 9685 then
    Format.fprintf Format.std_formatter "Matching (%a)@\n with:@\n%a@." 
      Value.print v
414
      Patterns.Compile2.print_dispatcher d;*)
415
416
417
418
419
420

  let res = 
    match actions d with
      | AResult r -> make_result_basic v r
      | AKind k -> run_disp_kind k v
  in 
421
(*  print_string "Y"; flush stdout;*)
422
423
424
425
426
427
428
  res

and run_disp_kind actions v =
  match v with
  | Pair (v1,v2) -> run_disp_prod v v1 v2 actions.prod
  | Xml (v1,v2,v3) -> run_disp_prod v v1 (Pair (v2,v3)) actions.xml
  | Record r -> run_disp_record !cursor false v (LabelMap.get r) actions.record
429
430
  | String_latin1 (i,j,s,q) ->
      run_disp_kind actions (Value.normalize v)
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
      (* run_disp_string_latin1 i j s q actions *)
  | String_utf8 (i,j,s,q) as v ->
      run_disp_kind actions (Value.normalize v)
      (* run_disp_string_utf8 i j s q actions *)
  | Atom a -> make_result_basic v (Atoms.get_map a actions.atoms) 
  | Char c -> make_result_basic v (Chars.get_map c actions.chars) 
  | Integer i ->
      run_disp_basic v (fun t -> Types.Int.has_int t i) actions.basic
  | Abstraction (iface,_)
  | Abstraction2 (_,iface,_) ->
      run_disp_basic v (fun t -> Types.Arrow.check_iface iface t) 
        actions.basic
  | Abstract (abs,_) -> 
      run_disp_basic v (fun t -> Types.Abstract.contains abs (Types.get_abstract t))
	actions.basic
446
447
  | Absent ->
      run_disp_basic v (fun t -> Types.Record.has_absent t) actions.basic
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
  | Concat (_,_) as v -> run_disp_kind actions (Value.normalize v)
  | Delayed _ -> assert false


and run_disp_prod v v1 v2 = function
  | Impossible -> assert false
  | LeftRight rdd -> run_disp_prod' v v1 v2 rdd
  | RightLeft rdd -> run_disp_prod' v v2 v1 rdd
  
and run_disp_prod' v v1 v2 = function
  | Dispatch (d1,b1) ->
      let r1 = !cursor in
      let code1 = run_dispatcher d1 v1 in
      run_disp_prod2 v1 r1 v v2 b1.(code1)
  | TailCall d1 -> run_dispatcher d1 v1
  | Ignore d2 -> run_disp_prod2 v1 !cursor v v2 d2

and run_disp_prod2 v1 r1 v v2 = function
  | Ignore r -> make_result_prod v1 r1 v2 !cursor v r
  | TailCall d2 -> run_dispatcher d2 v2
  | Dispatch (d2,b2) ->
      let r2 = !cursor in
      let code2 = run_dispatcher d2 v2 in
      make_result_prod v1 r1 v2 r2 v b2.(code2)

and do_pushes v vl = function
  | [] -> ()
  | PushConst c :: rem -> push (const c); do_pushes v vl rem
  | PushField   :: rem -> push vl; do_pushes v vl rem
  | PushCapture :: rem -> push v; do_pushes v vl rem

479
480
481
and do_record_tr sp other v vl fields tr =
  let (pushes,ct) = Lazy.force tr in
(*   print_string "*"; flush stdout; *)
482
483
484
485
  do_pushes v vl pushes;
  run_disp_record sp other v fields ct

and run_disp_record sp other v fields = function
486
  | RecordLabel (l,d,cts) ->
487
488
489
490
      let rec aux other = function
	| (l1,_) :: rem when l1 < l -> aux true rem
	| (l1,vl) :: rem when l1 == l ->
	    do_record_tr sp other v vl rem cts.(run_dispatcher d vl)
491
492
	| rem -> 
	    do_record_tr sp other v Absent rem cts.(run_dispatcher d Absent)
493
494
      in
      aux other fields
495
  | RecordLabelSkip (l,pr) ->
496
497
498
      let rec aux other = function
	| (l1,_) :: rem when l1 < l -> aux true rem
	| (l1,vl) :: rem when l1 == l -> do_record_tr sp other v vl rem pr
499
	| rem -> do_record_tr sp other v Absent rem pr
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
      in
      aux other fields
  | RecordResult r ->
      make_result_record sp v r
  | RecordMore (nomore,more) ->
      let other = other || (fields != []) in
      make_result_record sp v (if other then more else nomore)
  | RecordImpossible -> assert false
      
(*  

and run_disp_string_latin1 i j s q actions = 
  if i == j then run_disp_kind actions q 
  else match actions.prod with
    | Impossible -> assert false
    | TailCall d1 -> run_disp_string_latin1_char d1 (Chars.V.mk_char s.[i])
    | Ignore d2 -> run_disp_string_latin1_2 !cursor i j s q d2
    | Dispatch (d1,b1) ->
	let r1 = !cursor in
	let code1 = run_disp_string_latin1_char d1 (Chars.V.mk_char s.[i]) in
	run_disp_string_latin1_2 r1 i j s q b1.(code1)
and run_disp_string_latin1_char d ch =
  match actions d with
    | AIgnore r -> make_result_char ch r
    | AKind k -> make_result_char ch (Chars.get_map ch k.chars) 
and run_disp_string_latin1_2 r1 i j s q = function
  | Impossible -> assert false
  | Ignore r -> 
      make_result_string_latin1 i j s q r1 0 r
  | TailCall d2 -> run_disp_string_latin1_loop i j s q d2
  | Dispatch (d2,b2) ->
      let r2 = !cursor in
      let code2 = run_disp_string_latin1_loop i j s q d2 in
      make_result_string_latin1 i j s q r1 r2 b2.(code2)
and run_disp_string_latin1_loop i j s q d =
  match actions d with
    | AIgnore r -> make_result_basic Absent r
    | AKind k -> run_disp_string_latin1 (succ i) j s q k

and run_disp_string_utf8 i j s q actions = 
  if Utf8.equal_index i j then run_disp_kind actions q 
  else match actions.prod with
    | Impossible -> assert false
    | TailCall d1 -> run_disp_string_utf8_char d1 (Chars.V.mk_int (Utf8.get s i))
    | Ignore d2 -> run_disp_string_utf8_2 !cursor i j s q d2
    | Dispatch (d1,b1) ->
	let r1 = !cursor in
	let code1 = run_disp_string_utf8_char d1 (Chars.V.mk_int (Utf8.get s i)) in
	run_disp_string_utf8_2 r1 i j s q b1.(code1)
and run_disp_string_utf8_char d ch =
  match actions d with
    | AIgnore r -> make_result_char ch r
    | AKind k -> make_result_char ch (Chars.get_map ch k.chars) 
and run_disp_string_utf8_2 r1 i j s q = function
  | Impossible -> assert false
  | Ignore r -> 
      make_result_string_utf8 i j s q r1 0 r
  | TailCall d2 -> run_disp_string_utf8_loop i j s q d2
  | Dispatch (d2,b2) ->
      let r2 = !cursor in
      let code2 = run_disp_string_utf8_loop i j s q d2 in
      make_result_string_utf8 i j s q r1 r2 b2.(code2)
and run_disp_string_utf8_loop i j s q d =
  match actions d with
    | AIgnore r -> make_result_basic Absent r
    | AKind k -> run_disp_string_utf8 (Utf8.advance s i) j s q k
*)

let run_dispatcher2 d v =
569
(*   print_string "+"; flush stdout; *)
570
571
  let code = run_dispatcher d v in
  cursor := 0;
572
(*   print_string "-\n"; flush stdout; *)
573
574
575
576
577
  (code,!buffer) 



let run_dispatcher = old_dispatcher