viewcvs.cgi/runtime/run_dispatch.ml

(* Running dispatchers *)

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

(*
let (<) : int -> int -> bool = (<);;
*)

open Value
open Ident
open Patterns.Compile
open Encodings


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
(* important to do this in the increasing order ... *)


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'

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


(* Old dispatchers *)
    
let make_result_prod v1 v2 v (code,r,pop) = 
  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
    let x = match Array.unsafe_get r a with
      | Catch -> v
      | Const c -> const c
      | Nil -> nil
      | Left -> v1
      | Right -> v2
      | Stack i -> buf.(c - i)
      | Recompose (i,j) -> 
          Pair (
            (match i with (-1) -> v1 | (-2) -> nil | _ -> buf.(c - i)),
            (match j with (-1) -> v2 | (-2) -> nil | _ -> buf.(c - j))
          )
    in
    buf.(c + a) <- x
  done;
  if pop != 0 then blit buf c buf (c - pop) n);
  cursor := !cursor - pop + n;  (* clean space for GC ? *)
  code

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
    let x = match Array.unsafe_get r a with
      | Catch -> v
      | Const c -> const c 
      | _ -> assert false
    in
    buf.(!cursor) <- x;
    incr cursor
  done);
  code


let make_result_char ch (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
    let x = match Array.unsafe_get r a with
      | Catch -> Char ch
      | Const c -> const c
      | _ -> assert false
    in
    buf.(!cursor + a) <- x
  done;
  cursor := !cursor + n);
  code

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

let make_result_string_latin1 i j s q (code,r,pop) = 
  let n = Array.length r in
  if n > 0 then (
  ensure_room n;
  let c = !cursor in
  let buf = !buffer in
  for a = 0 to n - 1 do
    let x = match Array.unsafe_get r a with
      | Catch -> String_latin1 (i,j,s,q)
      | Const c -> const c
      | Nil -> nil
      | Left -> Char (Chars.V.mk_char s.[i])
      | Right -> tail_string_latin1 i j s q
      | Stack n -> buf.(c - n)
      | Recompose (n,m) -> 
          Pair (
            (match n with 
               | (-1) -> Char (Chars.V.mk_char s.[i]) 
               | (-2) -> nil 
               | _ -> buf.(c - n)),
            (match m with 
               | (-1) -> tail_string_latin1 i j s q 
               | (-2) -> nil 
               | _ -> buf.(c - m))
          )
    in
    buf.(c + a) <- x
  done;
  if pop != 0 then blit buf c buf (c - pop) n);
  cursor := !cursor - pop + n;
  code

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 (code,r,pop) = 
  let n = Array.length r in
  if n > 0 then (
  ensure_room n;
  let c = !cursor in
  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
      | Nil -> nil
      | Left -> Char (Chars.V.mk_int (Utf8.get s i))
      | Right -> tail_string_utf8 i j s q 
      | Stack n -> buf.(c - n)
      | Recompose (n,m) -> 
          Pair (
            (match n with 
               | (-1) -> Char (Chars.V.mk_int (Utf8.get s i)) 
               | (-2) -> nil 
               | _ -> buf.(c - n)),
            (match m with 
               | (-1) -> tail_string_utf8 i j s q 
               | (-2) -> nil 
               | _ -> buf.(c - m))
          )
    in
    buf.(c + a) <- x
  done;
  if pop != 0 then blit buf c buf (c - pop) n;
  );
  cursor := !cursor - pop + 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
  | _ ->  
      Format.fprintf Format.std_formatter "ERR: %a@." Value.print v;
      assert false

let rec run_dispatcher d v = 
(*  Format.fprintf Format.std_formatter "Matching (%a) with:@." Value.print v;
  Patterns.Compile.print_dispatcher Format.std_formatter d;  *)

  match actions d with
    | AIgnore r -> make_result_basic v r
    | AKind k -> run_disp_kind k v

and run_disp_kind actions v =
  match v with
  | Pair (v1,v2) -> run_disp_prod v v1 v2 actions.prod
  | Xml (v1,v2,v3) 
  | XmlNs (v1,v2,v3,_) -> run_disp_prod v v1 (Pair (v2,v3)) actions.xml
  | Record r -> run_disp_record false v (LabelMap.get r) actions.record
  | 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  
  | 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 (None,_) ->
      run_disp_basic v (fun t -> failwith "Run-time inspection of external abstraction")
        actions.basic
  | Abstraction (Some 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
  | Absent ->
      run_disp_basic v (fun t -> Types.Record.has_absent t) actions.basic
  | Concat (_,_) as v -> run_disp_kind actions (Value.normalize v)

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

and run_disp_prod2 v1 v v2 = function
  | Impossible -> assert false
  | Ignore r -> make_result_prod v1 v2 v r
  | TailCall d2 -> run_dispatcher d2 v2
  | Dispatch (d2,b2) ->
      let code2 = run_dispatcher d2 v2 in
      make_result_prod v1 v2 v b2.(code2)

and run_disp_record other v fields = function
  | None -> assert false
  | Some (RecLabel (l,d)) ->
      let rec aux other = function
        | (l1,_) :: rem when l1 < l -> aux true rem
        | (l1,vl) :: rem when l1 == l ->
            run_disp_record1 v other vl rem d
        | rem -> 
            run_disp_record1 v other Absent rem d
      in
      aux other fields
  | Some (RecNolabel (some,none)) ->
      let other = other || (fields != []) in
      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 v other v1 rem = function
  | Impossible -> assert false
  | TailCall d1 -> run_dispatcher d1 v1
  | Ignore d2 ->  run_disp_record2 v other v1 rem d2
  | Dispatch (d1,b1) ->
      let code1 = run_dispatcher d1 v1 in
      run_disp_record2 v other v1 rem b1.(code1)

and run_disp_record2 v other v1 rem = function
  | Impossible -> assert false
  | Ignore r -> make_result_prod v1 Absent v r
  | TailCall d2 -> run_disp_record_loop v other rem d2
  | Dispatch (d2,b2) ->
      let code2 = run_disp_record_loop v other rem d2 in
      make_result_prod v1 Absent v b2.(code2)

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

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 i j s q d2
    | Dispatch (d1,b1) ->
        let code1 = run_disp_string_latin1_char d1 (Chars.V.mk_char s.[i]) in
        run_disp_string_latin1_2 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 i j s q = function
  | Impossible -> assert false
  | Ignore r -> 
      make_result_string_latin1 i j s q r
  | TailCall d2 -> run_disp_string_latin1_loop i j s q d2
  | Dispatch (d2,b2) ->
      let code2 = run_disp_string_latin1_loop i j s q d2 in
      make_result_string_latin1 i j s q b2.(code2)
and run_disp_string_latin1_loop i j s q d =
  let i = succ i in
  if i == j then run_dispatcher d q else
  match actions d with
    | AIgnore r -> make_result_basic (Value.String_latin1 (i,j,s,q)) r
    | AKind k -> run_disp_string_latin1 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 i j s q d2
    | Dispatch (d1,b1) ->
        let code1 = run_disp_string_utf8_char d1 (Chars.V.mk_int (Utf8.get s i)) in
        run_disp_string_utf8_2 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 i j s q = function
  | Impossible -> assert false
  | Ignore r -> 
      make_result_string_utf8 i j s q r
  | TailCall d2 -> run_disp_string_utf8_loop i j s q d2
  | Dispatch (d2,b2) ->
      let code2 = run_disp_string_utf8_loop i j s q d2 in
      make_result_string_utf8 i j s q b2.(code2)
and run_disp_string_utf8_loop i j s q d =
  let i = Utf8.advance s i in
  if Utf8.equal_index i j then run_dispatcher d q else
  match actions d with
    | AIgnore r -> make_result_basic (Value.String_utf8 (i,j,s,q)) r
    | AKind k -> run_disp_string_utf8 i j s q k

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

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


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


*)
1	(* Running dispatchers *)
2
3	(* Possible simple optimizations:
4	- in make_result_prod, see if buffer can be simply overwritten
5	(precompute this ...)
6	- optimize for Xml elements (don't build the Pair (attr,content))
7	*)
8
9	(*
10	let (<) : int -> int -> bool = (<);;
11	*)
12
13	open Value
14	open Ident
15	open Patterns.Compile
16	open Encodings
17
18
19	let buffer = ref (Array.create 127 Absent)
20	let cursor = ref 0
21
22	let blit a1 ofs1 a2 ofs2 len =
23	for i = 0 to len - 1 do
24	Array.unsafe_set a2 (ofs2 + i) (Array.unsafe_get a1 (ofs1 + i))
25	done
26	(* important to do this in the increasing order ... *)
27
28
29	let ensure_room n =
30	let l = Array.length !buffer in
31	if !cursor + n > l then
32	let buffer' = Array.create (l * 2 + n) Absent in
33	blit !buffer 0 buffer' 0 !cursor;
34	buffer := buffer'
35
36	let push v =
37	ensure_room 1;
38	!buffer.(!cursor) <- v;
39	incr cursor
40
41
42	(* Old dispatchers *)
43
44	let make_result_prod v1 v2 v (code,r,pop) =
45	let n = Array.length r in
46	if n > 0 then (
47	ensure_room n;
48	let buf = !buffer in
49	let c = !cursor in
50	for a = 0 to n - 1 do
51	let x = match Array.unsafe_get r a with
52	\| Catch -> v
53	\| Const c -> const c
54	\| Nil -> nil
55	\| Left -> v1
56	\| Right -> v2
57	\| Stack i -> buf.(c - i)
58	\| Recompose (i,j) ->
59	Pair (
60	(match i with (-1) -> v1 \| (-2) -> nil \| _ -> buf.(c - i)),
61	(match j with (-1) -> v2 \| (-2) -> nil \| _ -> buf.(c - j))
62	)
63	in
64	buf.(c + a) <- x
65	done;
66	if pop != 0 then blit buf c buf (c - pop) n);
67	cursor := !cursor - pop + n; (* clean space for GC ? *)
68	code
69
70	let make_result_basic v (code,r,_) =
71	let n = Array.length r in
72	if n > 0 then (
73	ensure_room n;
74	let buf = !buffer in
75	for a = 0 to n - 1 do
76	let x = match Array.unsafe_get r a with
77	\| Catch -> v
78	\| Const c -> const c
79	\| _ -> assert false
80	in
81	buf.(!cursor) <- x;
82	incr cursor
83	done);
84	code
85
86
87	let make_result_char ch (code,r,_) =
88	let n = Array.length r in
89	if n > 0 then (
90	ensure_room n;
91	let buf = !buffer in
92	for a = 0 to n - 1 do
93	let x = match Array.unsafe_get r a with
94	\| Catch -> Char ch
95	\| Const c -> const c
96	\| _ -> assert false
97	in
98	buf.(!cursor + a) <- x
99	done;
100	cursor := !cursor + n);
101	code
102
103	let tail_string_latin1 i j s q =
104	if i + 1 == j then q else String_latin1 (i + 1,j,s,q)
105
106	let make_result_string_latin1 i j s q (code,r,pop) =
107	let n = Array.length r in
108	if n > 0 then (
109	ensure_room n;
110	let c = !cursor in
111	let buf = !buffer in
112	for a = 0 to n - 1 do
113	let x = match Array.unsafe_get r a with
114	\| Catch -> String_latin1 (i,j,s,q)
115	\| Const c -> const c
116	\| Nil -> nil
117	\| Left -> Char (Chars.V.mk_char s.[i])
118	\| Right -> tail_string_latin1 i j s q
119	\| Stack n -> buf.(c - n)
120	\| Recompose (n,m) ->
121	Pair (
122	(match n with
123	\| (-1) -> Char (Chars.V.mk_char s.[i])
124	\| (-2) -> nil
125	\| _ -> buf.(c - n)),
126	(match m with
127	\| (-1) -> tail_string_latin1 i j s q
128	\| (-2) -> nil
129	\| _ -> buf.(c - m))
130	)
131	in
132	buf.(c + a) <- x
133	done;
134	if pop != 0 then blit buf c buf (c - pop) n);
135	cursor := !cursor - pop + n;
136	code
137
138	let tail_string_utf8 i j s q =
139	let i = Utf8.advance s i in
140	if Utf8.equal_index i j then q else String_utf8 (i,j,s,q)
141
142	let make_result_string_utf8 i j s q (code,r,pop) =
143	let n = Array.length r in
144	if n > 0 then (
145	ensure_room n;
146	let c = !cursor in
147	let buf = !buffer in
148	for a = 0 to n - 1 do
149	let x = match Array.unsafe_get r a with
150	\| Catch -> String_utf8 (i,j,s,q)
151	\| Const c -> const c
152	\| Nil -> nil
153	\| Left -> Char (Chars.V.mk_int (Utf8.get s i))
154	\| Right -> tail_string_utf8 i j s q
155	\| Stack n -> buf.(c - n)
156	\| Recompose (n,m) ->
157	Pair (
158	(match n with
159	\| (-1) -> Char (Chars.V.mk_int (Utf8.get s i))
160	\| (-2) -> nil
161	\| _ -> buf.(c - n)),
162	(match m with
163	\| (-1) -> tail_string_utf8 i j s q
164	\| (-2) -> nil
165	\| _ -> buf.(c - m))
166	)
167	in
168	buf.(c + a) <- x
169	done;
170	if pop != 0 then blit buf c buf (c - pop) n;
171	);
172	cursor := !cursor - pop + n;
173	code
174
175	let rec run_disp_basic v f = function
176	\| [(_,r)] -> make_result_basic v r
177	\| (t,r)::rem -> if f t then make_result_basic v r else run_disp_basic v f rem
178	\| _ ->
179	Format.fprintf Format.std_formatter "ERR: %a@." Value.print v;
180	assert false
181
182	let rec run_dispatcher d v =
183	(* Format.fprintf Format.std_formatter "Matching (%a) with:@." Value.print v;
184	Patterns.Compile.print_dispatcher Format.std_formatter d; *)
185
186	match actions d with
187	\| AIgnore r -> make_result_basic v r
188	\| AKind k -> run_disp_kind k v
189
190	and run_disp_kind actions v =
191	match v with
192	\| Pair (v1,v2) -> run_disp_prod v v1 v2 actions.prod
193	\| Xml (v1,v2,v3)
194	\| XmlNs (v1,v2,v3,_) -> run_disp_prod v v1 (Pair (v2,v3)) actions.xml
195	\| Record r -> run_disp_record false v (LabelMap.get r) actions.record
196	\| String_latin1 (i,j,s,q) ->
197	(* run_disp_kind actions (Value.normalize v) *)
198	run_disp_string_latin1 i j s q actions
199	\| String_utf8 (i,j,s,q) ->
200	(* run_disp_kind actions (Value.normalize v) *)
201	run_disp_string_utf8 i j s q actions
202	\| Atom a -> make_result_basic v (Atoms.get_map a actions.atoms)
203	\| Char c -> make_result_basic v (Chars.get_map c actions.chars)
204	\| Integer i ->
205	run_disp_basic v (fun t -> Types.Int.has_int t i) actions.basic
206	\| Abstraction (None,_) ->
207	run_disp_basic v (fun t -> failwith "Run-time inspection of external abstraction")
208	actions.basic
209	\| Abstraction (Some iface,_)
210	\| Abstraction2 (_,iface,_) ->
211	run_disp_basic v (fun t -> Types.Arrow.check_iface iface t)
212	actions.basic
213	\| Abstract (abs,_) ->
214	run_disp_basic v (fun t -> Types.Abstract.contains abs (Types.get_abstract t))
215	actions.basic
216	\| Absent ->
217	run_disp_basic v (fun t -> Types.Record.has_absent t) actions.basic
218	\| Concat (_,_) as v -> run_disp_kind actions (Value.normalize v)
219
220	and run_disp_prod v v1 v2 = function
221	\| Impossible -> assert false
222	\| TailCall d1 -> run_dispatcher d1 v1
223	\| Ignore d2 -> run_disp_prod2 v1 v v2 d2
224	\| Dispatch (d1,b1) ->
225	let code1 = run_dispatcher d1 v1 in
226	run_disp_prod2 v1 v v2 b1.(code1)
227
228	and run_disp_prod2 v1 v v2 = function
229	\| Impossible -> assert false
230	\| Ignore r -> make_result_prod v1 v2 v r
231	\| TailCall d2 -> run_dispatcher d2 v2
232	\| Dispatch (d2,b2) ->
233	let code2 = run_dispatcher d2 v2 in
234	make_result_prod v1 v2 v b2.(code2)
235
236	and run_disp_record other v fields = function
237	\| None -> assert false
238	\| Some (RecLabel (l,d)) ->
239	let rec aux other = function
240	\| (l1,_) :: rem when l1 < l -> aux true rem
241	\| (l1,vl) :: rem when l1 == l ->
242	run_disp_record1 v other vl rem d
243	\| rem ->
244	run_disp_record1 v other Absent rem d
245	in
246	aux other fields
247	\| Some (RecNolabel (some,none)) ->
248	let other = other \|\| (fields != []) in
249	let r = if other then some else none in
250	match r with
251	\| Some r -> make_result_basic v r
252	\| None -> assert false
253
254	and run_disp_record1 v other v1 rem = function
255	\| Impossible -> assert false
256	\| TailCall d1 -> run_dispatcher d1 v1
257	\| Ignore d2 -> run_disp_record2 v other v1 rem d2
258	\| Dispatch (d1,b1) ->
259	let code1 = run_dispatcher d1 v1 in
260	run_disp_record2 v other v1 rem b1.(code1)
261
262	and run_disp_record2 v other v1 rem = function
263	\| Impossible -> assert false
264	\| Ignore r -> make_result_prod v1 Absent v r
265	\| TailCall d2 -> run_disp_record_loop v other rem d2
266	\| Dispatch (d2,b2) ->
267	let code2 = run_disp_record_loop v other rem d2 in
268	make_result_prod v1 Absent v b2.(code2)
269
270	and run_disp_record_loop v other rem d =
271	match actions d with
272	\| AIgnore r -> make_result_basic v r
273	\| AKind k -> run_disp_record other v rem k.record
274
275
276	and run_disp_string_latin1 i j s q actions =
277	if i == j then run_disp_kind actions q
278	else match actions.prod with
279	\| Impossible -> assert false
280	\| TailCall d1 -> run_disp_string_latin1_char d1 (Chars.V.mk_char s.[i])
281	\| Ignore d2 -> run_disp_string_latin1_2 i j s q d2
282	\| Dispatch (d1,b1) ->
283	let code1 = run_disp_string_latin1_char d1 (Chars.V.mk_char s.[i]) in
284	run_disp_string_latin1_2 i j s q b1.(code1)
285	and run_disp_string_latin1_char d ch =
286	match actions d with
287	\| AIgnore r -> make_result_char ch r
288	\| AKind k -> make_result_char ch (Chars.get_map ch k.chars)
289	and run_disp_string_latin1_2 i j s q = function
290	\| Impossible -> assert false
291	\| Ignore r ->
292	make_result_string_latin1 i j s q r
293	\| TailCall d2 -> run_disp_string_latin1_loop i j s q d2
294	\| Dispatch (d2,b2) ->
295	let code2 = run_disp_string_latin1_loop i j s q d2 in
296	make_result_string_latin1 i j s q b2.(code2)
297	and run_disp_string_latin1_loop i j s q d =
298	let i = succ i in
299	if i == j then run_dispatcher d q else
300	match actions d with
301	\| AIgnore r -> make_result_basic (Value.String_latin1 (i,j,s,q)) r
302	\| AKind k -> run_disp_string_latin1 i j s q k
303
304	and run_disp_string_utf8 i j s q actions =
305	if Utf8.equal_index i j then run_disp_kind actions q
306	else
307	match actions.prod with
308	\| Impossible -> assert false
309	\| TailCall d1 -> run_disp_string_utf8_char d1 (Chars.V.mk_int (Utf8.get s i))
310	\| Ignore d2 -> run_disp_string_utf8_2 i j s q d2
311	\| Dispatch (d1,b1) ->
312	let code1 = run_disp_string_utf8_char d1 (Chars.V.mk_int (Utf8.get s i)) in
313	run_disp_string_utf8_2 i j s q b1.(code1)
314	and run_disp_string_utf8_char d ch =
315	match actions d with
316	\| AIgnore r -> make_result_char ch r
317	\| AKind k -> make_result_char ch (Chars.get_map ch k.chars)
318	and run_disp_string_utf8_2 i j s q = function
319	\| Impossible -> assert false
320	\| Ignore r ->
321	make_result_string_utf8 i j s q r
322	\| TailCall d2 -> run_disp_string_utf8_loop i j s q d2
323	\| Dispatch (d2,b2) ->
324	let code2 = run_disp_string_utf8_loop i j s q d2 in
325	make_result_string_utf8 i j s q b2.(code2)
326	and run_disp_string_utf8_loop i j s q d =
327	let i = Utf8.advance s i in
328	if Utf8.equal_index i j then run_dispatcher d q else
329	match actions d with
330	\| AIgnore r -> make_result_basic (Value.String_utf8 (i,j,s,q)) r
331	\| AKind k -> run_disp_string_utf8 i j s q k
332
333	let run_dispatcher d v =
334	let code = run_dispatcher d v in
335	cursor := 0;
336	(code,!buffer)
337
338	(*
339	let rec check_overwrite_aux r i =
340	if i < 0 then true
341	else match r.(i) with
342	\| Right j \| Recompose (_,j) ->
343	if (j < 0) \|\| (j >=i ) then check_overwrite_aux r (i - 1) else false
344	\| _ -> check_overwrite_aux r (i - 1)
345
346
347	let check_overwrite r2 r =
348	(Array.length r2 = Array.length r) && (check_overwrite_aux r (Array.length r - 1))
349
350
351	*)