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

[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 = ...@@ -190,7 +190,7 @@ and run_disp_kind actions v =
| Pair (v1,v2) -> run_disp_prod v v1 v2 actions.prod | Pair (v1,v2) -> run_disp_prod v v1 v2 actions.prod
| Xml (v1,v2,v3) | Xml (v1,v2,v3)
| XmlNs (v1,v2,v3,_) -> run_disp_prod v v1 (Pair (v2,v3)) actions.xml | 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) -> | String_latin1 (i,j,s,q) ->
(* run_disp_kind actions (Value.normalize v) *) (* run_disp_kind actions (Value.normalize v) *)
run_disp_string_latin1 i j s q actions run_disp_string_latin1 i j s q actions
...@@ -231,44 +231,38 @@ and run_disp_prod2 v1 v v2 = function ...@@ -231,44 +231,38 @@ and run_disp_prod2 v1 v v2 = function
let code2 = run_dispatcher d2 v2 in let code2 = run_dispatcher d2 v2 in
make_result_prod v1 v2 v b2.(code2) 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 | None -> assert false
| Some (RecLabel (l,d)) -> | Some (RecLabel (l,d)) ->
let rec aux other = function (* TODO: get rid of this exception... *)
| (l1,_) :: rem when l1 < l -> aux true rem (try run_disp_record1 v (succ n) (Imap.find fields l) fields d
| (l1,vl) :: rem when l1 == l -> with Not_found -> run_disp_record1 v n Absent fields d)
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)) -> | Some (RecNolabel (some,none)) ->
let other = other || (fields != []) in let r = if (n < Imap.cardinal fields) then some else none in
let r = if other then some else none in
match r with match r with
| Some r -> make_result_basic v r | Some r -> make_result_basic v r
| None -> assert false | None -> assert false
and run_disp_record1 v other v1 rem = function and run_disp_record1 v n v1 rem = function
| Impossible -> assert false | Impossible -> assert false
| TailCall d1 -> run_dispatcher d1 v1 | 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) -> | Dispatch (d1,b1) ->
let code1 = run_dispatcher d1 v1 in 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 | Impossible -> assert false
| Ignore r -> make_result_prod v1 Absent v r | 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) -> | 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) 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 match actions d with
| AIgnore r -> make_result_basic v r | 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 = 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