Commit b1974d71 authored by Pietro Abate's avatar Pietro Abate
Browse files

[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
parent 05a1b7bc
......@@ -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))
......
......@@ -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")
;;
......@@ -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
......
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