Commit 322a5fa6 authored by Pietro Abate's avatar Pietro Abate
Browse files

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

Original author: afrisch
Date: 2005-03-23 16:36:58+00:00
parent ea396b0e
...@@ -77,7 +77,7 @@ module G = struct ...@@ -77,7 +77,7 @@ module G = struct
let (d,rhs) = PM.get mk_pm chunk.pm i in let (d,rhs) = PM.get mk_pm chunk.pm i in
let (code,bindings) = Run_dispatch.run_dispatcher d v in let (code,bindings) = Run_dispatch.run_dispatcher d v in
match rhs.(code) with match rhs.(code) with
| Patterns.Compile.Fail -> assert false | Patterns.Compile.Fail -> (-1,[||])
| Patterns.Compile.Match (bind,i) -> | Patterns.Compile.Match (bind,i) ->
i, i,
Array.map Array.map
......
...@@ -710,3 +710,25 @@ let rec transform_aux f accu = function ...@@ -710,3 +710,25 @@ let rec transform_aux f accu = function
let transform f v = transform_aux f nil v 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
...@@ -136,3 +136,4 @@ val xml: t -> t -> t -> t ...@@ -136,3 +136,4 @@ val xml: t -> t -> t -> t
val mk_record: (U.t * U.t) array -> t array -> t val mk_record: (U.t * U.t) array -> t array -> t
val transform: (t -> t) -> t -> t val transform: (t -> t) -> t -> t
val xtransform: (t -> t) -> t -> t
...@@ -128,6 +128,7 @@ let map_tree f seq = ...@@ -128,6 +128,7 @@ let map_tree f seq =
Types.descr (V.solve (aux seq)) Types.descr (V.solve (aux seq))
let map_tree_mono domain seq = let map_tree_mono domain seq =
let inp = ref Types.empty in
let ts = ref [] in let ts = ref [] in
let vs = ref [] in let vs = ref [] in
...@@ -141,6 +142,7 @@ let map_tree_mono domain seq = ...@@ -141,6 +142,7 @@ let map_tree_mono domain seq =
V.define v v'; V.define v v';
v v
and descr_aux t v = and descr_aux t v =
inp := Types.cup !inp t;
let residual = Types.diff t domain in let residual = Types.diff t domain in
let f2 (attr,child) = V.times (V.ty attr) (aux child) in let f2 (attr,child) = V.times (V.ty attr) (aux child) in
...@@ -158,7 +160,7 @@ let map_tree_mono domain seq = ...@@ -158,7 +160,7 @@ let map_tree_mono domain seq =
in in
let r = aux 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)) List.iter2 (fun t (result,v) -> V.define result (aux_concat t v))
fts !vs; fts !vs;
solve r) solve r)
......
...@@ -16,7 +16,7 @@ val map_tree: ...@@ -16,7 +16,7 @@ val map_tree:
(* input type -> (result, residual) *) (* sequence type *) (* input type -> (result, residual) *) (* sequence type *)
val map_mono: Types.t -> Types.t list * (Types.t list -> Types.t) 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 val star: Types.t -> Types.t
(* For a type t, returns [t*] *) (* For a type t, returns [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