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 make_result_prod v1 r1 v2 r2 v (code,r) = 
  let n = Array.length r in
  if n == 0 then code else (
  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
      | 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
    buf.(c + a) <- x
  done;
  if r1 != c then blit buf c buf r1 n;
  cursor := r1 + n;  (* clean space for GC ? *)
  code )

let make_result_basic v (code,r) = 
  let n = Array.length r in
  if n == 0 then code else (
  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 + a) <- x
  done;
  cursor := !cursor + n;
  code )


let make_result_char ch (code,r) = 
  let n = Array.length r in
  if n == 0 then code else (
  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 r1 r2 (code,r) = 
  let n = Array.length r in
  if n == 0 then code else (
  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_latin1 (i,j,s,q)
      | Const c -> const c
      | Left n -> if (n < 0) then Char (Chars.mk_char s.[i]) else buf.(r1 + n)
      | Right m -> if (m < 0) then tail_string_latin1 i j s q else buf.(r2 + m)
      | Recompose (n,m) -> 
          Pair ((if (n < 0) then Char (Chars.mk_char s.[i]) else buf.(r1 + n)),
                (if (m < 0) then tail_string_latin1 i j s q else buf.(r2 + m))) 
    in
    buf.(!cursor + a) <- x
  done;
  if r1 != !cursor then blit buf !cursor buf r1 n;
  cursor := r1 + 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 r1 r2 (code,r) = 
  let n = Array.length r in
  if n == 0 then code else (
  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
      | Left n -> if (n < 0) then Char (Chars.mk_int (Utf8.get s i)) else buf.(r1 + n)
      | Right m -> if (m < 0) then tail_string_utf8 i j s q else buf.(r2 + m)
      | Recompose (n,m) -> 
          Pair ((if (n < 0) then Char (Chars.mk_int (Utf8.get s i)) else buf.(r1 + n)),
                (if (m < 0) then tail_string_utf8 i j s q else buf.(r2 + m))) 
    in
    buf.(!cursor + a) <- x
  done;
  if r1 != !cursor then blit buf !cursor buf r1 n;
  cursor := r1 + 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 rec run_dispatcher d v = 
(*
  Format.fprintf Format.std_formatter "Matching (%a) with:@\n" 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) -> 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_string_latin1 i j s q actions
  | String_utf8 (i,j,s,q) -> 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,_) ->
      run_disp_basic v (fun t -> Types.Arrow.check_iface iface t) 
        actions.basic
  | Absent ->
      run_disp_basic v (fun t -> Types.Record.has_absent t) actions.basic


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

and run_disp_prod2 v1 r1 v v2 = function
  | Impossible -> assert false
  | 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 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 other vl rem d
        | rem -> 
            run_disp_record1 other Absent rem d
      in
      aux other fields
  | Some (RecNolabel (some,none)) ->
      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
  | Ignore d2 ->  run_disp_record2 other v1 !cursor rem d2
  | Dispatch (d1,b1) ->
      let r1 = !cursor in
      let code1 = run_dispatcher d1 v1 in
      run_disp_record2 other v1 r1 rem b1.(code1)

and run_disp_record2 other v1 r1 rem = function
  | Impossible -> assert false
  | Ignore r -> make_result_prod v1 r1 Absent 0 Absent r
  | TailCall d2 -> run_disp_record_loop other rem d2
  | Dispatch (d2,b2) ->
      let r2 = !cursor in
      let code2 = run_disp_record_loop other rem d2 in
      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
    | AKind k -> run_disp_record other Absent 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.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.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.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.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_dispatcher d v =
  let code = run_dispatcher d v in
(* for unknown reasons, it seems to be faster to copy the interesting prefix... *)
(*  cursor := 0;
  (code,!buffer) *)
  let r = Array.create !cursor Absent in
  blit !buffer 0 r 0 !cursor;
  cursor := 0;
  (code,r)
    

(*
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
37	let make_result_prod v1 r1 v2 r2 v (code,r) =
38	let n = Array.length r in
39	if n == 0 then code else (
40	ensure_room n;
41	let buf = !buffer in
42	let c = !cursor in
43	for a = 0 to n - 1 do
44	let x = match Array.unsafe_get r a with
45	\| Catch -> v
46	\| Const c -> const c
47	\| Left i -> if (i < 0) then v1 else buf.(r1 + i)
48	\| Right j -> if (j < 0) then v2 else buf.(r2 + j)
49	\| Recompose (i,j) ->
50	Pair ((if (i < 0) then v1 else buf.(r1 + i)),
51	(if (j < 0) then v2 else buf.(r2 + j)))
52	in
53	buf.(c + a) <- x
54	done;
55	if r1 != c then blit buf c buf r1 n;
56	cursor := r1 + n; (* clean space for GC ? *)
57	code )
58
59	let make_result_basic v (code,r) =
60	let n = Array.length r in
61	if n == 0 then code else (
62	ensure_room n;
63	let buf = !buffer in
64	for a = 0 to n - 1 do
65	let x = match Array.unsafe_get r a with
66	\| Catch -> v
67	\| Const c -> const c
68	\| _ -> assert false
69	in
70	buf.(!cursor + a) <- x
71	done;
72	cursor := !cursor + n;
73	code )
74
75
76	let make_result_char ch (code,r) =
77	let n = Array.length r in
78	if n == 0 then code else (
79	ensure_room n;
80	let buf = !buffer in
81	for a = 0 to n - 1 do
82	let x = match Array.unsafe_get r a with
83	\| Catch -> Char ch
84	\| Const c -> const c
85	\| _ -> assert false
86	in
87	buf.(!cursor + a) <- x
88	done;
89	cursor := !cursor + n;
90	code )
91
92	let tail_string_latin1 i j s q =
93	if i + 1 == j then q else String_latin1 (i + 1,j,s,q)
94
95	let make_result_string_latin1 i j s q r1 r2 (code,r) =
96	let n = Array.length r in
97	if n == 0 then code else (
98	ensure_room n;
99	let buf = !buffer in
100	for a = 0 to n - 1 do
101	let x = match Array.unsafe_get r a with
102	\| Catch -> String_latin1 (i,j,s,q)
103	\| Const c -> const c
104	\| Left n -> if (n < 0) then Char (Chars.mk_char s.[i]) else buf.(r1 + n)
105	\| Right m -> if (m < 0) then tail_string_latin1 i j s q else buf.(r2 + m)
106	\| Recompose (n,m) ->
107	Pair ((if (n < 0) then Char (Chars.mk_char s.[i]) else buf.(r1 + n)),
108	(if (m < 0) then tail_string_latin1 i j s q else buf.(r2 + m)))
109	in
110	buf.(!cursor + a) <- x
111	done;
112	if r1 != !cursor then blit buf !cursor buf r1 n;
113	cursor := r1 + n;
114	code )
115
116	let tail_string_utf8 i j s q =
117	let i = Utf8.advance s i in
118	if Utf8.equal_index i j then q else String_utf8 (i,j,s,q)
119
120	let make_result_string_utf8 i j s q r1 r2 (code,r) =
121	let n = Array.length r in
122	if n == 0 then code else (
123	ensure_room n;
124	let buf = !buffer in
125	for a = 0 to n - 1 do
126	let x = match Array.unsafe_get r a with
127	\| Catch -> String_utf8 (i,j,s,q)
128	\| Const c -> const c
129	\| Left n -> if (n < 0) then Char (Chars.mk_int (Utf8.get s i)) else buf.(r1 + n)
130	\| Right m -> if (m < 0) then tail_string_utf8 i j s q else buf.(r2 + m)
131	\| Recompose (n,m) ->
132	Pair ((if (n < 0) then Char (Chars.mk_int (Utf8.get s i)) else buf.(r1 + n)),
133	(if (m < 0) then tail_string_utf8 i j s q else buf.(r2 + m)))
134	in
135	buf.(!cursor + a) <- x
136	done;
137	if r1 != !cursor then blit buf !cursor buf r1 n;
138	cursor := r1 + n;
139	code )
140
141	let rec run_disp_basic v f = function
142	\| [(_,r)] -> make_result_basic v r
143	\| (t,r)::rem -> if f t then make_result_basic v r else run_disp_basic v f rem
144	\| _ -> assert false
145
146	let rec run_dispatcher d v =
147	(*
148	Format.fprintf Format.std_formatter "Matching (%a) with:@\n" Value.print v;
149	Patterns.Compile.print_dispatcher Format.std_formatter d;
150	*)
151	match actions d with
152	\| AIgnore r -> make_result_basic v r
153	\| AKind k -> run_disp_kind k v
154
155	and run_disp_kind actions v =
156	match v with
157	\| Pair (v1,v2) -> run_disp_prod v v1 v2 actions.prod
158	\| Xml (v1,v2,v3) -> run_disp_prod v v1 (Pair (v2,v3)) actions.xml
159	\| Record r -> run_disp_record false v (LabelMap.get r) actions.record
160	\| String_latin1 (i,j,s,q) -> run_disp_string_latin1 i j s q actions
161	\| String_utf8 (i,j,s,q) -> run_disp_string_utf8 i j s q actions
162	\| Atom a -> make_result_basic v (Atoms.get_map a actions.atoms)
163	\| Char c -> make_result_basic v (Chars.get_map c actions.chars)
164	\| Integer i ->
165	run_disp_basic v (fun t -> Types.Int.has_int t i) actions.basic
166	\| Abstraction (iface,_) ->
167	run_disp_basic v (fun t -> Types.Arrow.check_iface iface t)
168	actions.basic
169	\| Absent ->
170	run_disp_basic v (fun t -> Types.Record.has_absent t) actions.basic
171
172
173	and run_disp_prod v v1 v2 = function
174	\| Impossible -> assert false
175	\| TailCall d1 -> run_dispatcher d1 v1
176	\| Ignore d2 -> run_disp_prod2 v1 !cursor v v2 d2
177	\| Dispatch (d1,b1) ->
178	let r1 = !cursor in
179	let code1 = run_dispatcher d1 v1 in
180	run_disp_prod2 v1 r1 v v2 b1.(code1)
181
182	and run_disp_prod2 v1 r1 v v2 = function
183	\| Impossible -> assert false
184	\| Ignore r -> make_result_prod v1 r1 v2 !cursor v r
185	\| TailCall d2 -> run_dispatcher d2 v2
186	\| Dispatch (d2,b2) ->
187	let r2 = !cursor in
188	let code2 = run_dispatcher d2 v2 in
189	make_result_prod v1 r1 v2 r2 v b2.(code2)
190
191	and run_disp_record other v fields = function
192	\| None -> assert false
193	\| Some (RecLabel (l,d)) ->
194	let rec aux other = function
195	\| (l1,_) :: rem when l1 < l -> aux true rem
196	\| (l1,vl) :: rem when l1 == l ->
197	run_disp_record1 other vl rem d
198	\| rem ->
199	run_disp_record1 other Absent rem d
200	in
201	aux other fields
202	\| Some (RecNolabel (some,none)) ->
203	let r = if other then some else none in
204	match r with
205	\| Some r -> make_result_basic v r
206	\| None -> assert false
207
208	and run_disp_record1 other v1 rem = function
209	\| Impossible -> assert false
210	\| TailCall d1 -> run_dispatcher d1 v1
211	\| Ignore d2 -> run_disp_record2 other v1 !cursor rem d2
212	\| Dispatch (d1,b1) ->
213	let r1 = !cursor in
214	let code1 = run_dispatcher d1 v1 in
215	run_disp_record2 other v1 r1 rem b1.(code1)
216
217	and run_disp_record2 other v1 r1 rem = function
218	\| Impossible -> assert false
219	\| Ignore r -> make_result_prod v1 r1 Absent 0 Absent r
220	\| TailCall d2 -> run_disp_record_loop other rem d2
221	\| Dispatch (d2,b2) ->
222	let r2 = !cursor in
223	let code2 = run_disp_record_loop other rem d2 in
224	make_result_prod v1 r1 Absent r2 Absent b2.(code2)
225
226	and run_disp_record_loop other rem d =
227	match actions d with
228	\| AIgnore r -> make_result_basic Absent r
229	\| AKind k -> run_disp_record other Absent rem k.record
230
231
232	and run_disp_string_latin1 i j s q actions =
233	if i == j then run_disp_kind actions q
234	else match actions.prod with
235	\| Impossible -> assert false
236	\| TailCall d1 -> run_disp_string_latin1_char d1 (Chars.mk_char s.[i])
237	\| Ignore d2 -> run_disp_string_latin1_2 !cursor i j s q d2
238	\| Dispatch (d1,b1) ->
239	let r1 = !cursor in
240	let code1 = run_disp_string_latin1_char d1 (Chars.mk_char s.[i]) in
241	run_disp_string_latin1_2 r1 i j s q b1.(code1)
242	and run_disp_string_latin1_char d ch =
243	match actions d with
244	\| AIgnore r -> make_result_char ch r
245	\| AKind k -> make_result_char ch (Chars.get_map ch k.chars)
246	and run_disp_string_latin1_2 r1 i j s q = function
247	\| Impossible -> assert false
248	\| Ignore r ->
249	make_result_string_latin1 i j s q r1 0 r
250	\| TailCall d2 -> run_disp_string_latin1_loop i j s q d2
251	\| Dispatch (d2,b2) ->
252	let r2 = !cursor in
253	let code2 = run_disp_string_latin1_loop i j s q d2 in
254	make_result_string_latin1 i j s q r1 r2 b2.(code2)
255	and run_disp_string_latin1_loop i j s q d =
256	match actions d with
257	\| AIgnore r -> make_result_basic Absent r
258	\| AKind k -> run_disp_string_latin1 (succ i) j s q k
259
260	and run_disp_string_utf8 i j s q actions =
261	if Utf8.equal_index i j then run_disp_kind actions q
262	else match actions.prod with
263	\| Impossible -> assert false
264	\| TailCall d1 -> run_disp_string_utf8_char d1 (Chars.mk_int (Utf8.get s i))
265	\| Ignore d2 -> run_disp_string_utf8_2 !cursor i j s q d2
266	\| Dispatch (d1,b1) ->
267	let r1 = !cursor in
268	let code1 = run_disp_string_utf8_char d1 (Chars.mk_int (Utf8.get s i)) in
269	run_disp_string_utf8_2 r1 i j s q b1.(code1)
270	and run_disp_string_utf8_char d ch =
271	match actions d with
272	\| AIgnore r -> make_result_char ch r
273	\| AKind k -> make_result_char ch (Chars.get_map ch k.chars)
274	and run_disp_string_utf8_2 r1 i j s q = function
275	\| Impossible -> assert false
276	\| Ignore r ->
277	make_result_string_utf8 i j s q r1 0 r
278	\| TailCall d2 -> run_disp_string_utf8_loop i j s q d2
279	\| Dispatch (d2,b2) ->
280	let r2 = !cursor in
281	let code2 = run_disp_string_utf8_loop i j s q d2 in
282	make_result_string_utf8 i j s q r1 r2 b2.(code2)
283	and run_disp_string_utf8_loop i j s q d =
284	match actions d with
285	\| AIgnore r -> make_result_basic Absent r
286	\| AKind k -> run_disp_string_utf8 (Utf8.advance s i) j s q k
287
288	let run_dispatcher d v =
289	let code = run_dispatcher d v in
290	(* for unknown reasons, it seems to be faster to copy the interesting prefix... *)
291	(* cursor := 0;
292	(code,!buffer) *)
293	let r = Array.create !cursor Absent in
294	blit !buffer 0 r 0 !cursor;
295	cursor := 0;
296	(code,r)
297
298
299
300	(*
301	let rec check_overwrite_aux r i =
302	if i < 0 then true
303	else match r.(i) with
304	\| Right j \| Recompose (_,j) ->
305	if (j < 0) \|\| (j >=i ) then check_overwrite_aux r (i - 1) else false
306	\| _ -> check_overwrite_aux r (i - 1)
307
308
309	let check_overwrite r2 r =
310	(Array.length r2 = Array.length r) && (check_overwrite_aux r (Array.length r - 1))
311
312
313	*)