Commit 25b118ff authored by Pietro Abate's avatar Pietro Abate

[r2005-06-17 15:58:51 by afrisch] Empty log message

Original author: afrisch
Date: 2005-06-17 15:58:51+00:00
parent a858d2b0
......@@ -190,7 +190,7 @@ and run_disp_kind actions v =
| 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 (Imap.elements r) actions.record
| Record r -> run_disp_record 0 v 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
......@@ -231,44 +231,38 @@ and run_disp_prod2 v1 v v2 = function
let code2 = run_dispatcher d2 v2 in
make_result_prod v1 v2 v b2.(code2)
and run_disp_record other v fields = function
and run_disp_record n 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
(* TODO: get rid of this exception... *)
(try run_disp_record1 v (succ n) (Imap.find fields l) fields d
with Not_found -> run_disp_record1 v n Absent fields d)
| Some (RecNolabel (some,none)) ->
let other = other || (fields != []) in
let r = if other then some else none in
let r = if (n < Imap.cardinal fields) 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
and run_disp_record1 v n v1 rem = function
| Impossible -> assert false
| TailCall d1 -> run_dispatcher d1 v1
| Ignore d2 -> run_disp_record2 v other v1 rem d2
| Ignore d2 -> run_disp_record2 v n v1 rem d2
| Dispatch (d1,b1) ->
let code1 = run_dispatcher d1 v1 in
run_disp_record2 v other v1 rem b1.(code1)
run_disp_record2 v n v1 rem b1.(code1)
and run_disp_record2 v other v1 rem = function
and run_disp_record2 v n 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
| TailCall d2 -> run_disp_record_loop v n rem d2
| Dispatch (d2,b2) ->
let code2 = run_disp_record_loop v other rem d2 in
let code2 = run_disp_record_loop v n rem d2 in
make_result_prod v1 Absent v b2.(code2)
and run_disp_record_loop v other rem d =
and run_disp_record_loop v n rem d =
match actions d with
| AIgnore r -> make_result_basic v r
| AKind k -> run_disp_record other v rem k.record
| AKind k -> run_disp_record n v rem k.record
and run_disp_string_latin1 i j s q actions =
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment