run_dispatch.ml 18.3 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
153
154
  | _ ->  
      Format.fprintf Format.std_formatter "ERR: %a@." Value.print v;
      assert false
155

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

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

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

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

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

235
and run_disp_record2 other v1 r1 rem = function
236
  | Impossible -> assert false
237
  | Ignore r -> make_result_prod v1 r1 Absent 0 Absent r
238
239
  | TailCall d2 -> run_disp_record_loop other rem d2
  | Dispatch (d2,b2) ->
240
241
      let r2 = !cursor in
      let code2 = run_disp_record_loop other rem d2 in
242
243
244
245
246
      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
247
    | AKind k -> run_disp_record other Absent rem k.record
248
  
249

250
and run_disp_string_latin1 i j s q actions = 
251
  if i == j then run_disp_kind actions q 
252
253
  else match actions.prod with
    | Impossible -> assert false
254
    | TailCall d1 -> run_disp_string_latin1_char d1 (Chars.V.mk_char s.[i])
255
256
257
    | Ignore d2 -> run_disp_string_latin1_2 !cursor i j s q d2
    | Dispatch (d1,b1) ->
	let r1 = !cursor in
258
	let code1 = run_disp_string_latin1_char d1 (Chars.V.mk_char s.[i]) in
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
	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 =
274
275
  let i = succ i in
  if i == j then run_dispatcher d q else
276
  match actions d with
277
278
    | AIgnore r -> make_result_basic (Value.String_latin1 (i,j,s,q)) r
    | AKind k -> run_disp_string_latin1 i j s q k
279
280

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

let run_dispatcher d v =
  let code = run_dispatcher d v in
313
314
  cursor := 0;
  (code,!buffer) 
315
316

let old_dispatcher = run_dispatcher    
317

318
  
319
320
321
322
323
324
325
(*
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)
326

327
328
329
330
331
332

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


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




(* 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),
377
	       (match r with 
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
		  | 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; *)
412
(*  incr count;
413
414
415
416
417
  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
418
      Patterns.Compile2.print_dispatcher d;*)
419
420
421
422
423
424

  let res = 
    match actions d with
      | AResult r -> make_result_basic v r
      | AKind k -> run_disp_kind k v
  in 
425
(*  print_string "Y"; flush stdout;*)
426
427
428
429
430
431
432
  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
433
434
  | String_latin1 (i,j,s,q) ->
      run_disp_kind actions (Value.normalize v)
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
      (* 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
450
451
  | Absent ->
      run_disp_basic v (fun t -> Types.Record.has_absent t) actions.basic
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
  | Concat (_,_) as v -> run_disp_kind actions (Value.normalize v)


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

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

and run_disp_record sp other v fields = function
489
  | RecordLabel (l,d,cts) ->
490
491
492
493
      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)
494
495
	| rem -> 
	    do_record_tr sp other v Absent rem cts.(run_dispatcher d Absent)
496
497
      in
      aux other fields
498
  | RecordLabelSkip (l,pr) ->
499
500
501
      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
502
	| rem -> do_record_tr sp other v Absent rem pr
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
      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 =
572
(*   print_string "+"; flush stdout; *)
573
574
  let code = run_dispatcher d v in
  cursor := 0;
575
(*   print_string "-\n"; flush stdout; *)
576
577
578
579
580
  (code,!buffer) 



let run_dispatcher = old_dispatcher