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

Original author: afrisch
Date: 2005-06-17 15:58:51+00:00

runtime/run_dispatch.ml

@@ -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 =