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

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

Original author: afrisch
Date: 2005-03-23 16:03:29+00:00
parent 58cf790b
......@@ -360,7 +360,7 @@ struct
| Split (_,y,p,i,n) ->
let c = X.compare x y in
assert (c <> 0);
if x < y then
if (c < 0) then
if pos then split x a False False
else split x False False a
else split y (cap_atom x pos p) (cap_atom x pos i) (cap_atom x pos n)
......
......@@ -699,9 +699,14 @@ let mk_record labels fields =
Record (LabelMap.from_list_disj !l)
(* TODO: optimize cases
- (f x = [])
- all chars copied or deleted *)
let rec transform_aux f accu = function
| Pair (x,y) -> let accu = Concat (accu, f x) in transform_aux f accu y
| Atom _ -> accu
| v -> transform_aux f accu (normalize v)
let transform f v = transform_aux f nil v
......@@ -105,7 +105,6 @@ let approx t =
let map_tree f seq =
let memo = ref H.empty in
let rec aux t =
(* Printf.eprintf "A"; flush stderr; *)
try H.find t !memo
with Not_found ->
let v = V.forward () in
......@@ -126,18 +125,48 @@ let map_tree f seq =
if iter = [] then result else
V.cup [V.times (V.cup iter) v; result ]
in
let d = Types.descr (V.solve (aux seq)) in
(* Printf.eprintf "Done."; flush stderr; *)
(* Format.fprintf Format.std_formatter "%a\n" Types.Print.print_descr d; *)
d
Types.descr (V.solve (aux seq))
(* TODO: avoid flushing the memo between calls to mapping inside map_tree *)
let map_tree_mono domain seq =
let ts = ref [] in
let vs = ref [] in
(* <helpers> *)
let memo = ref H.empty in
let rec aux t =
try H.find t !memo
with Not_found ->
let v = V.forward () in
memo := H.add t v !memo;
let v' = mapping descr_aux t (V.ty nil_type) in
V.define v v';
v
and descr_aux t v =
let residual = Types.diff t domain in
let f2 (attr,child) = V.times (V.ty attr) (aux child) in
let f1 (tag,x) =
let x = V.cup (List.map f2 (Types.Product.get x)) in
V.xml (V.ty tag) x in
let iter = List.map f1 (Types.Product.get ~kind:`XML residual) in
let resid = Types.Product.other ~kind:`XML residual in
let iter = if Types.is_empty resid then iter else V.ty resid :: iter in
let result = V.forward () in
ts := (Types.cap domain t) :: !ts; vs := (result,v) :: !vs;
if iter = [] then result else
V.cup [V.times (V.cup iter) v; result ]
in
let r = aux seq in
!ts, (fun fts ->
List.iter2 (fun t (result,v) -> V.define result (aux_concat t v))
fts !vs;
solve r)
(* TODO: avoid flushing the memo between calls to mapping inside map_tree *)
let seq_of_list l =
let times' t acc = Types.times (Types.cons t) (Types.cons acc) in
List.fold_right times' l nil_type
(* </helpers> *)
......@@ -10,12 +10,14 @@ val concat: Types.t -> Types.t -> Types.t
val flatten: Types.t -> Types.t
val map: (Types.t -> Types.t) -> Types.t -> Types.t
val map_mono: Types.t -> Types.t list * (Types.t list -> Types.t)
val map_tree:
(Types.t -> Types.t * Types.t) -> Types.t -> Types.t
(* 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 star: Types.t -> Types.t
(* For a type t, returns [t*] *)
val plus: Types.t -> Types.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