[r2003-06-13 10:02:09 by cvscast] removed explode_rev in favor of a new iter_xml function

Original author: cvscast
Date: 2003-06-13 10:02:09+00:00

runtime/eval.ml

@@ -38,6 +38,11 @@ let rec eval env e0 = match e0.Typed.exp_descr with
   | Typed.BinaryOp (o,e1,e2) -> o.Typed.bin_op_eval (eval env e1) (eval env e2)
   | Typed.Validate (e, schema, name) ->
       let validator = Typer.get_schema_validator (schema, name) in
+(*
+        (* DEBUG *)
+      let s = Schema_xml.pxp_stream_of_value (eval env e) in
+      Schema_xml.dump_stream s;
+*)
       Schema_validator.validate ~validator
         (Schema_xml.pxp_stream_of_value (eval env e))
 

runtime/value.ml

@@ -194,14 +194,6 @@ and print_record ppf = function
 and print_field ppf (l,v) = 
   Format.fprintf ppf "%a=%a" U.print (LabelPool.value l) print v  
 
-let explode_rev s =
-  let rec aux acc = function
-    | v when v = nil -> acc
-    | Pair (v, seq) -> aux (v::acc) seq
-    | v -> [v]
-  in
-  aux [] s
-
 let normalize_string_latin1 i j s q = 
   if i = j then q else
     Pair (Char (Chars.mk_char (String.unsafe_get s i)), String_latin1 (succ i,j,s,q))
@@ -283,5 +275,37 @@ let rec compare x y =
       | Integer _,_ -> -1 | _, Integer _ -> 1
 
 
+(* (* BUGGY *)
+let explode_rev s =
+  let rec aux acc = function
+    | v when v = nil -> acc
+    | Pair (v, seq) -> aux (v::acc) seq
+    | v -> [v]
+  in
+  aux [] s
+*)
 
+let iter_xml pcdata_callback other_callback =
+  let rec aux = function
+    | v when compare v nil = 0 -> ()
+    | Pair ((Char c) as hd, tl) ->
+        pcdata_callback (U.mk (String.make 1 (Chars.to_char c)));
+        aux tl
+    | Pair ((String_latin1 (i,j,s,_)) as hd, tl) ->
+        pcdata_callback (U.mk (String.sub s i j));
+        aux tl
+    | Pair ((String_utf8 (i,j,s,_)) as hd, tl) ->
+        pcdata_callback (U.mk (U.get_substr s i j));
+        aux tl
+    | Pair (hd, tl) ->
+        other_callback hd;
+        aux tl
+    | String_latin1 (i,j,s,_) -> pcdata_callback (U.mk (String.sub s i j))
+    | String_utf8 (i,j,s,_) -> pcdata_callback (U.mk (U.get_substr s i j))
+    | v -> other_callback v
+  in
+  function
+    | Xml (_,_,cont) -> aux cont
+    | _ -> raise (Invalid_argument "Value.iter_xml")
+;;
 

runtime/value.mli

@@ -40,7 +40,9 @@ val vbool : bool -> t
 val vrecord : (string * t) list -> t
 
 val sequence : t list -> t
-val explode_rev : t -> t list (* tail recursive *)
+  (* iterator on the content of an Xml value. First callback is invoked on Utf8
+  character children; second callback is invoked on other children values *)
+val iter_xml : (U.t -> unit) -> (t -> unit) -> t -> unit
 val concat : t -> t -> t
 val flatten : t -> t