[r2005-03-23 16:36:58 by afrisch] Empty log message

Original author: afrisch
Date: 2005-03-23 16:36:58+00:00

runtime/serial.ml

@@ -77,7 +77,7 @@ module G = struct
     let (d,rhs) = PM.get mk_pm chunk.pm i in
     let (code,bindings) = Run_dispatch.run_dispatcher d v in
     match rhs.(code) with
-      | Patterns.Compile.Fail -> assert false
+      | Patterns.Compile.Fail -> (-1,[||])
       | Patterns.Compile.Match (bind,i) ->
 	  i,
 	  Array.map

runtime/value.ml

@@ -710,3 +710,25 @@ let rec transform_aux f accu = function
 
 let transform f v = transform_aux f nil v
 
+
+let rec xtransform_aux f accu = function
+  | Pair (x,y) -> 
+      let accu = match f x with
+	| Absent ->
+	    let x = match x with
+	      | Xml (tag, attr, child) -> 
+		  let child = xtransform_aux f nil child in
+		  Xml (tag, attr, child)
+	      | XmlNs (tag, attr, child, ns) ->
+		  let child = xtransform_aux f nil child in
+		  XmlNs (tag, attr, child, ns)
+	      | x -> x in
+	    Concat (accu, Pair (x,nil))
+	| x -> Concat (accu, x) 
+      in 
+      xtransform_aux f accu y
+  | Atom _ -> accu
+  | v -> xtransform_aux f accu (normalize v)
+
+let xtransform f v = xtransform_aux f nil v
+

runtime/value.mli

@@ -136,3 +136,4 @@ val xml: t -> t -> t -> t
 val mk_record: (U.t * U.t) array -> t array -> t
 
 val transform: (t -> t) -> t -> t
+val xtransform: (t -> t) -> t -> t

types/sequence.ml

@@ -128,6 +128,7 @@ let map_tree f seq =
   Types.descr (V.solve (aux seq))
 
 let map_tree_mono domain seq =
+  let inp = ref Types.empty in
   let ts = ref [] in
   let vs = ref [] in
 
@@ -141,6 +142,7 @@ let map_tree_mono domain seq =
       V.define v v';
       v
   and descr_aux t v =
+    inp := Types.cup !inp t;
     let residual = Types.diff t domain in
 
     let f2 (attr,child) = V.times (V.ty attr) (aux child) in
@@ -158,7 +160,7 @@ let map_tree_mono domain seq =
 
   in
   let r = aux seq in
-  !ts, (fun fts ->
+  !inp, !ts, (fun fts ->
 	  List.iter2 (fun t (result,v) -> V.define result (aux_concat t v))
 	    fts !vs;
 	  solve r)

types/sequence.mli

@@ -16,7 +16,7 @@ val map_tree:
  (* input type -> (result, residual) *)         (* sequence type *)
 
 val map_mono: Types.t -> Types.t list * (Types.t list -> Types.t)
-val map_tree_mono: Types.t -> Types.t -> Types.t list * (Types.t list -> Types.t)
+val map_tree_mono: Types.t -> Types.t -> Types.t * Types.t list * (Types.t list -> Types.t)
 
 val star: Types.t -> Types.t
   (* For a type t, returns [t*] *)