Commit 24163e5b authored by Pietro Abate's avatar Pietro Abate
Browse files

Merge branch 'master' into propagate

Conflicts:
	types/types.ml
parents 19474f4c 32eed1ae
......@@ -145,7 +145,7 @@ CLEAN_DIRS = $(DIRS) tools tests
OBJECTS = \
driver/cduce_config.cmo misc/stats.cmo misc/custom.cmo misc/encodings.cmo \
misc/upool.cmo misc/pretty.cmo misc/ns.cmo misc/imap.cmo misc/html.cmo \
misc/upool.cmo misc/pretty.cmo misc/ns.cmo misc/imap.cmo misc/html.cmo misc/utils.cmo \
\
types/compunit.cmo types/sortedList.cmo misc/bool.cmo types/ident.cmo \
types/intervals.cmo types/chars.cmo types/atoms.cmo types/normal.cmo \
......@@ -181,8 +181,6 @@ schema/schema_types.ml: schema/schema_types.mli
cp $^ $@
compile/auto_pat.ml: compile/auto_pat.mli
cp $^ $@
compile/lambda.ml: compile/lambda.mli
cp $^ $@
ML_INTERFACE_OBJS = \
ocamliface/caml_cduce.cmo \
......
......@@ -77,23 +77,6 @@ type code = code_item list
module Print = struct
let print_to_string f x =
let b = Buffer.create 1024 in
let ppf = Format.formatter_of_buffer b in
f ppf x;
Format.pp_print_flush ppf ();
Buffer.contents b
let print_lst f ppf l =
let rec aux ppf = function
|[] -> Format.fprintf ppf "@."
|[h] -> Format.fprintf ppf "%a" f h
|h::t -> Format.fprintf ppf "%a,%a" f h aux t
in
match l with
|[] -> Format.fprintf ppf ""
|_ -> Format.fprintf ppf "%a" aux l
let pp_vloc ppf = function
| Local(i) -> Format.fprintf ppf "Local(%d)" i
| Env(i) -> Format.fprintf ppf "Env(%d)" i
......@@ -104,7 +87,7 @@ module Print = struct
| Dummy -> Format.fprintf ppf "Dummy"
let pp_vloc_array ppf a =
print_lst pp_vloc ppf (Array.to_list a)
Utils.pp_list pp_vloc ppf (Array.to_list a)
let pp_binding ppf (id, name) value =
Format.fprintf ppf "((%d,%s),%a)\n"
......@@ -114,10 +97,10 @@ module Print = struct
let rec pp_lambda_sigma ppf =
let pp_aux ppf =
print_lst (fun ppf (t1,t2) ->
Format.fprintf ppf "(%a -> %a)"
Types.Print.print t1
Types.Print.print t2
Utils.pp_list (fun ppf (t1,t2) ->
Format.fprintf ppf "(%a -> %a)"
Types.Print.pp_type t1
Types.Print.pp_type t2
) ppf
in
function
......@@ -135,11 +118,11 @@ module Print = struct
| Abstraction (va, l, b, i) ->
Format.fprintf ppf "Abstraction(%a,,%a,,)" pp_vloc_array va pp_lbranches b
| Check(_) -> Format.fprintf ppf "Check"
| Const(v) -> Format.fprintf ppf "Const(%a)" Value.pp_value v
| Const(v) -> Format.fprintf ppf "Const(%a)" Value.Print.pp_value v
| Pair(e1, e2) -> Format.fprintf ppf "Pair(%a, %a)" pp_lambda e1 pp_lambda e2
| String(_) -> Format.fprintf ppf "String"
| Match(e, brs) -> Format.fprintf ppf "Match(%a, %a)" pp_lambda e pp_lbranches brs
| Op(str, le) -> Format.fprintf ppf "Op(%s, (" str; print_lst pp_lambda ppf le; Format.fprintf ppf "))"
| Op(str, le) -> Format.fprintf ppf "Op(%s, (%a))" str (Utils.pp_list pp_lambda) le
| _ -> ()
and pp_lbranches ppf brs =
......@@ -148,6 +131,6 @@ module Print = struct
and pp_patrhs ppf arr =
Array.iter (function | Auto_pat.Match(i, e) -> Format.fprintf ppf "(%d, %a)" i pp_lambda e | _ -> ()) arr
let lambda_to_string = print_to_string pp_lambda
let string_of_lambda = Utils.string_of_formatter pp_lambda
end
......@@ -77,5 +77,6 @@ type code_item =
type code = code_item list
module Print : sig
val lambda_to_string : expr -> string
val pp_lambda : Format.formatter -> expr -> unit
val string_of_lambda : expr -> string
end
......@@ -10,7 +10,7 @@ let rec_state ppf d =
let rec print_source lhs ppf = function
| Catch -> Format.fprintf ppf "v"
| Const c -> Types.Print.print_const ppf c
| Const c -> Types.Print.pp_const ppf c
| Nil -> Format.fprintf ppf "`nil"
| Left -> Format.fprintf ppf "v1"
| Right -> Format.fprintf ppf "v2"
......@@ -55,7 +55,7 @@ let print_kind ppf actions =
Format.fprintf ppf ")" in
let print_basic (t,ret) =
Format.fprintf ppf " | %a -> %a@\n"
Types.Print.print t
Types.Print.pp_type t
(print_ret []) ret
in
let print_prod2 lhs = function
......
......@@ -40,7 +40,7 @@ let rec is_abstraction = function
| _ -> false
let print_norm ppf d =
Types.Print.print ppf ((*Types.normalize*) d)
Types.Print.pp_type ppf ((*Types.normalize*) d)
let print_sample ppf s =
Sample.print ppf s
......@@ -159,16 +159,16 @@ let rec print_exn ppf = function
U.print ns2
| Sequence.Error (Sequence.CopyTag (t,expect)) ->
Format.fprintf ppf "Tags in %a will be copied, but only %a are allowed.@.Counter-example:%a@."
Types.Print.print t
Types.Print.print expect
Types.Print.pp_type t
Types.Print.pp_type expect
Sample.print (Sample.get (Types.diff t expect))
| Sequence.Error (Sequence.CopyAttr (t,expect)) ->
Format.fprintf ppf "Attributes in %a will be copied, but only %a are allowed.@.Counter-example:%a@."
Types.Print.print t
Types.Print.print expect
Types.Print.pp_type t
Types.Print.pp_type expect
Sample.print (Sample.get (Types.diff t expect))
| Sequence.Error (Sequence.UnderTag (t,exn)) ->
Format.fprintf ppf "Under tag %a:@." Types.Print.print t;
Format.fprintf ppf "Under tag %a:@." Types.Print.pp_type t;
print_exn ppf exn
| exn ->
......@@ -199,7 +199,7 @@ let debug ppf tenv cenv = function
let t = Typer.typ tenv t
and p = Typer.pat tenv p in
Format.fprintf ppf "[DEBUG:filter t=%a p=%a]@."
Types.Print.print (Types.descr t)
Types.Print.pp_type (Types.descr t)
Patterns.Print.print (Patterns.descr p);
let f = Patterns.filter (Types.descr t) p in
IdMap.iteri (fun x t ->
......@@ -210,7 +210,7 @@ let debug ppf tenv cenv = function
Format.fprintf ppf "[DEBUG:accept]@.";
let p = Typer.pat tenv p in
let t = Patterns.accept p in
Format.fprintf ppf " %a@." Types.Print.print (Types.descr t)
Format.fprintf ppf " %a@." Types.Print.pp_type (Types.descr t)
| `Compile (t,pl) ->
Format.fprintf ppf "[DEBUG:compile]@.";
let no = ref (-1) in
......@@ -230,7 +230,7 @@ let debug ppf tenv cenv = function
let t = Typer.typ tenv t in
(try
let c = Sample.single (Types.descr t) in
Format.fprintf ppf "Constant:%a@." Types.Print.print_const c
Format.fprintf ppf "Constant:%a@." Types.Print.pp_const c
with
| Exit -> Format.fprintf ppf "Non constant@."
| Not_found -> Format.fprintf ppf "Empty@.")
......@@ -247,7 +247,7 @@ let directive ppf tenv cenv = function
dump_env ppf tenv cenv
| `Print_type t ->
let t = Typer.typ tenv t in
Format.fprintf ppf "%a@." Types.Print.print_noname (Types.descr t)
Format.fprintf ppf "%a@." Types.Print.pp_noname (Types.descr t)
| `Reinit_ns ->
Typer.set_ns_table_for_printer tenv
| `Help ->
......
......@@ -70,7 +70,7 @@ let show ppf id t v =
| Some id ->
Format.fprintf ppf "@[val %a : @[%a@]@."
Ident.print id
Types.Print.print t
Types.Print.pp_type t
| None -> ()
......
let string_of_formatter pp t =
Format.fprintf Format.str_formatter "%a" pp t;
Format.flush_str_formatter ()
let pp_list ?(delim=("[","]")) ?(sep=",") f ppf l =
let rec aux ppf = function
|[] -> Format.fprintf ppf ""
|[h] -> Format.fprintf ppf "%a" f h
|h::t -> Format.fprintf ppf "%a%s%a" f h sep aux t
in
match l with
|[] -> Format.fprintf ppf "%s%s" (fst delim) (snd delim)
|_ -> Format.fprintf ppf "%s%a%s" (fst delim) aux l (snd delim)
......@@ -67,7 +67,7 @@ let pp_lambda_env ppf env locals =
let aux a =
let l = Array.to_list a in
let sl = List.mapi (fun i v ->
Format.fprintf Format.str_formatter "%d : %a@." i pp_value v;
Format.fprintf Format.str_formatter "%d : %a@." i Value.Print.pp_value v;
Format.flush_str_formatter ()
) l
in
......@@ -165,7 +165,7 @@ and eval_abstraction env locals slots iface body lsize sigma =
let f arg =
let v = eval_branches env (Array.create lsize Value.Absent) body arg in
if sigma <> Value.Mono then env.(1) <- arg;
pp_lambda_env Format.std_formatter env locals;
(* pp_lambda_env Format.std_formatter env locals; *)
v
in
let a = Value.Abstraction (Some iface,f,sigma) in
......
......@@ -38,11 +38,8 @@ let rec codomain = function
(* Comp for Value.sigma but simplify if possible. *)
let rec comp s1 s2 = match s1, s2 with
| Identity, _ -> s2
| _, Identity -> s1
| Mono, _ -> s2
| _, Mono -> s1
| Identity, _ | Mono, _ -> s2
| _, Identity | _, Mono -> s1
| Comp(s3, s4), List(_) -> (match comp s4 s2 with
| Comp(_) as s5 when s4 = s5 -> s1
......@@ -128,9 +125,7 @@ let concat v1 v2 =
let append v1 v2 =
concat v1 (Pair (v2,nil,Mono))
let raise' v = raise (CDuceExn v)
let failwith' s = raise' (string_latin1 s)
let failwith' s = raise (CDuceExn (string_latin1 s))
let rec const = function
| Types.Integer i -> Integer i
......@@ -177,8 +172,6 @@ let normalize_string_utf8 i j s q =
let (c,i) = Utf8.next s i in
Pair (Char (Chars.V.mk_int c), String_utf8 (i,j,s,q),Mono)
(***** The dirty things **********)
type pair = { dummy : t; mutable pair_tl : t }
......@@ -237,7 +230,6 @@ let eval_lazy_concat v =
Obj.set_field v 1 (Obj.field nv 1)
(******************************)
let normalize = function
......@@ -308,165 +300,148 @@ let rec is_str = function
| Concat (_,_) as v -> eval_lazy_concat v; is_str v
| _ -> false
let print_lst f ppf l =
let rec aux ppf = function
|[] -> Format.fprintf ppf "@."
|[h] -> Format.fprintf ppf "%a" f h
|h::t -> Format.fprintf ppf "%a,%a" f h aux t
in
match l with
|[] -> Format.fprintf ppf ""
|_ -> Format.fprintf ppf "%a" aux l
let rec pp_sigma ppf =
let pp_aux ppf =
print_lst (fun ppf (t1,t2) ->
Format.fprintf ppf "(%a -> %a)"
Types.Print.print t1
Types.Print.print t2
) ppf
in
function
|List ll -> Types.Tallying.CS.pp_sl ppf ll
|Comp(s1,s2) -> Format.fprintf ppf "Comp(%a,%a)" pp_sigma s1 pp_sigma s2
|Sel(x,iface,s) -> Format.fprintf ppf "Sel(%d,%a,%a)" x pp_aux iface pp_sigma s
|Identity -> Format.fprintf ppf "Id"
|Mono -> Format.fprintf ppf "Mono"
let pp_iface ppf l =
let f ppf (t1,t2) =
Format.fprintf ppf "(%a,%a)"
Types.Print.print t1
Types.Print.print t2
in
print_lst f ppf l
(* For debugging *)
let rec pp_value ppf = function
| Pair(v1, v2, sigma) ->
Format.fprintf ppf "(%a,%a,%a)"
pp_value v1
pp_value v2
pp_sigma sigma
| Xml(_,_,_,sigma) -> Format.fprintf ppf "Xml(%a)" pp_sigma sigma
| XmlNs(_,_,_,_,sigma) -> Format.fprintf ppf "XmlNs(%a)" pp_sigma sigma
| Record(_,sigma) -> Format.fprintf ppf "Record(%a)" pp_sigma sigma
| Atom(a) -> Format.fprintf ppf "Atom(%a)" Atoms.V.print a
| Integer(i) -> Format.fprintf ppf "%d" (Intervals.V.get_int i)
| Char(i) -> Format.fprintf ppf "'%c'" (Chars.V.to_char i)
| Abstraction(None, _, sigma) ->
Format.fprintf ppf "Abstraction(None,%a)" pp_sigma sigma
| Abstraction(Some t, _, sigma) ->
Format.fprintf ppf "Abstraction(%a,%a)"
pp_iface t
pp_sigma sigma
| Abstract((name, _)) -> Format.fprintf ppf "Abstract(%s)" name
| String_latin1(_,_,s,_) -> Format.fprintf ppf "\"%s\"" s
| String_utf8(_,_,s,_) -> Format.fprintf ppf "\"%s\"" (Encodings.Utf8.get_str s)
| Concat(v1, v2) ->
Format.fprintf ppf "Concat(%a, %a)"
pp_value v1
pp_value v2
| Absent -> Format.fprintf ppf "Absent"
let print_to_string f x =
let b = Buffer.create 1024 in
let ppf = Format.formatter_of_buffer b in
f ppf x;
Format.pp_print_flush ppf ();
Buffer.contents b
let print_value = Format.printf "%a" pp_value
let value_to_string = print_to_string pp_value
module Print = struct
let rec pp_sigma ppf =
let pp_aux ppf =
Utils.pp_list (fun ppf (t1,t2) ->
Format.fprintf ppf "(%a -> %a)"
Types.Print.pp_type t1
Types.Print.pp_type t2
) ppf
in
function
|List ll -> Types.Tallying.CS.pp_sl ppf ll
|Comp(s1,s2) -> Format.fprintf ppf "Comp(%a,%a)" pp_sigma s1 pp_sigma s2
|Sel(x,iface,s) -> Format.fprintf ppf "Sel(%d,%a,%a)" x pp_aux iface pp_sigma s
|Identity -> Format.fprintf ppf "Id"
|Mono -> Format.fprintf ppf "Mono"
let pp_iface ppf l =
let f ppf (t1,t2) =
Format.fprintf ppf "(%a,%a)"
Types.Print.pp_type t1
Types.Print.pp_type t2
in
Utils.pp_list f ppf l
let rec pp_value ppf = function
| Pair(v1, v2, sigma) ->
Format.fprintf ppf "(%a,%a,%a)"
pp_value v1
pp_value v2
pp_sigma sigma
| Xml(_,_,_,sigma) -> Format.fprintf ppf "Xml(%a)" pp_sigma sigma
| XmlNs(_,_,_,_,sigma) -> Format.fprintf ppf "XmlNs(%a)" pp_sigma sigma
| Record(_,sigma) -> Format.fprintf ppf "Record(%a)" pp_sigma sigma
| Atom(a) -> Format.fprintf ppf "Atom(%a)" Atoms.V.print a
| Integer(i) -> Format.fprintf ppf "%d" (Intervals.V.get_int i)
| Char(i) -> Format.fprintf ppf "'%c'" (Chars.V.to_char i)
| Abstraction(None, _, sigma) ->
Format.fprintf ppf "Abstraction(None,%a)" pp_sigma sigma
| Abstraction(Some t, _, sigma) ->
Format.fprintf ppf "Abstraction(%a,%a)"
pp_iface t
pp_sigma sigma
| Abstract((name, _)) -> Format.fprintf ppf "Abstract(%s)" name
| String_latin1(_,_,s,_) -> Format.fprintf ppf "\"%s\"" s
| String_utf8(_,_,s,_) -> Format.fprintf ppf "\"%s\"" (Encodings.Utf8.get_str s)
| Concat(v1, v2) ->
Format.fprintf ppf "Concat(%a, %a)"
pp_value v1
pp_value v2
| Absent -> Format.fprintf ppf "Absent"
let string_of_value = Utils.string_of_formatter pp_value
end
let rec print ppf v =
if is_str v then
(Format.fprintf ppf "\"";
ignore (print_quoted_str ppf v);
ignore (pp_quoted_str ppf v);
Format.fprintf ppf "\"")
else if is_seq v then Format.fprintf ppf "[ @[<hv>%a@]]" print_seq v
else if is_seq v then Format.fprintf ppf "[ @[<hv>%a@]]" pp_seq v
else match v with
| Pair (x,y,sigma) -> Format.fprintf ppf "(%a,%a,%a)" print x print y pp_sigma sigma
| Xml (x,y,z,sigma) | XmlNs (x,y,z,_,sigma) -> print_xml ppf x y z (* sigma *)
| Record (l,sigma) -> Format.fprintf ppf "@[{%a },%a@]" print_record (Imap.elements l) pp_sigma sigma
| Atom a -> Atoms.V.print_quote ppf a
| Pair (x,y,sigma) -> Format.fprintf ppf "(%a,%a,%a)" print x print y Print.pp_sigma sigma
| Xml (x,y,z,sigma) | XmlNs (x,y,z,_,sigma) -> pp_xml ppf x y z (* sigma *)
| Record (l,sigma) -> Format.fprintf ppf "@[{%a },%a@]" pp_record (Imap.elements l) Print.pp_sigma sigma
| Atom a -> Atoms.V.print ppf a
| Integer i -> Intervals.V.print ppf i
| Char c -> Chars.V.print ppf c
| Abstraction _ -> Format.fprintf ppf "<fun>"
| String_latin1 (i,j,s,q) ->
Format.fprintf ppf "<string_latin1:%i-%i,%S,%a>" i j s print q
Format.fprintf ppf "<string_latin1:%i-%i,%S,%a>" i j s print q
| String_utf8 (i,j,s,q) ->
Format.fprintf ppf "<string_utf8:%i-%i,%S,%a>"
(Utf8.get_idx i) (Utf8.get_idx j) (Utf8.get_str s) print q
Format.fprintf ppf "<string_utf8:%i-%i,%S,%a>"
(Utf8.get_idx i) (Utf8.get_idx j) (Utf8.get_str s) print q
| Concat (x,y) ->
Format.fprintf ppf "<concat:%a;%a>" print x print y
Format.fprintf ppf "<concat:%a;%a>" print x print y
| Abstract ("float",o) ->
Format.fprintf ppf "%f" (Obj.magic o : float)
Format.fprintf ppf "%f" (Obj.magic o : float)
| Abstract ("cdata",o) ->
let s = Utf8.get_str (Obj.magic o : Utf8.t) in
Format.fprintf ppf "'%s'" s
(* Format.fprintf ppf "%s" (Utf8.get_str (Obj.magic o :
* Encodings.Utf8.t)) *)
| Abstract (s,_) ->
Format.fprintf ppf "<abstract=%s>" s
Format.fprintf ppf "<abstract=%s>" s
| Absent ->
Format.fprintf ppf "<[absent]>"
and print_quoted_str ppf = function
Format.fprintf ppf "<[absent]>"
and pp_quoted_str ppf = function
| Pair (Char c, q,_) ->
Chars.V.print_in_string ppf c;
print_quoted_str ppf q
pp_quoted_str ppf q
| String_latin1 (i,j,s, q) ->
for k = i to j - 1 do
Chars.V.print_in_string ppf (Chars.V.mk_char s.[k])
Chars.V.print_in_string ppf (Chars.V.mk_char s.[k])
done;
print_quoted_str ppf q
pp_quoted_str ppf q
| String_utf8 (i,j,s, q) ->
(* Format.fprintf ppf "UTF8:{"; *)
let rec aux i =
if Utf8.equal_index i j then q
else
let (c,i) =Utf8.next s i in
Chars.V.print_in_string ppf (Chars.V.mk_int c);
aux i
if Utf8.equal_index i j then q
else
let (c,i) =Utf8.next s i in
Chars.V.print_in_string ppf (Chars.V.mk_int c);
aux i
in
let q = aux i in
(* Format.fprintf ppf "}"; *)
print_quoted_str ppf q
pp_quoted_str ppf q
| q -> q
and print_seq ppf = function
and pp_seq ppf = function
| (Pair(Char _, _,_)|String_latin1 (_,_,_,_)|String_utf8 (_,_,_,_)) as s ->
Format.fprintf ppf "'";
let q = print_quoted_str ppf s in
let q = pp_quoted_str ppf s in
Format.fprintf ppf "'@ ";
print_seq ppf q
pp_seq ppf q
| Pair (x,y,_) ->
Format.fprintf ppf "@[%a@]@ " print x;
print_seq ppf y
pp_seq ppf y
| _ -> ()
and print_xml ppf tag attr content =
and pp_xml ppf tag attr content =
if is_seq content then
Format.fprintf ppf "@[<hv2><%a%a>[@ %a@]]"
print_tag tag
print_attr attr
print_seq content
pp_tag tag
pp_attr attr
pp_seq content
else
Format.fprintf ppf "@[<hv2><%a%a>@ %a@]"
print_tag tag
print_attr attr
pp_tag tag
pp_attr attr
print content
and print_tag ppf = function
and pp_tag ppf = function
| Atom tag -> Atoms.V.print ppf tag
| tag -> Format.fprintf ppf "(%a)" print tag
and print_attr ppf = function
| Record (attr,_) -> print_record ppf (Imap.elements attr)
and pp_attr ppf = function
| Record (attr,_) -> pp_record ppf (Imap.elements attr)
| attr -> Format.fprintf ppf "(%a)" print attr
and print_record ppf = function
and pp_record ppf = function
| [] -> ()
| f :: rem -> Format.fprintf ppf "@ %a" print_field f; print_record ppf rem
and print_field ppf (l,v) =
| f :: rem -> Format.fprintf ppf "@ %a" pp_field f; pp_record ppf rem
and pp_field ppf (l,v) =
Format.fprintf ppf "%a=%a" Label.print_attr (Label.from_int l) print v
let dump_xml ppf v =
......@@ -480,7 +455,7 @@ let dump_xml ppf v =
| Record (x,sigma) ->
Format.fprintf ppf "@[<hv1>";
Format.fprintf ppf "<record>@,%a@,</record>@]"
(fun ppf x -> print_record ppf (Imap.elements x)) x
(fun ppf x -> pp_record ppf (Imap.elements x)) x
| Atom a ->
Format.fprintf ppf "@[<hv1>";
Format.fprintf ppf "<atom>@,%a@,</atom>@]"
......@@ -519,6 +494,22 @@ let dump_xml ppf v =
Format.fprintf ppf "@[<hv1>";
Format.fprintf ppf "<value>@,%a@,</value>@]" aux v
(*
let rec compare_sigma x y =
if (x == y) then 0
else
match x,y with
|Comp(sx1,sx2),Comp(sy1,xy2) ->
| List(sl1), List(sl2) ->
if List.for_all2 (fun v1 v2 ->
Types.Tallying.E.comparea v1 v2 ) sl1 sl2 = 0 then 0
else (List.length sl1) - (List.length sl2)
| Sel(t1,if1,s1), Sel(t2,if2,s2) ->
| _, _ -> Pervasives.compare x y
*)
(* XXX here I don't compare sigmas !!! *)
let rec compare x y =
if (x == y) then 0
......@@ -848,13 +839,10 @@ let cduce2ocaml_option f v =
| Pair (x,y,sigma) -> Some (f x)
| _ -> None
let ocaml2cduce_option f = function
| Some x -> Pair (f x, nil,Mono)
| None -> nil
let add v1 v2 = match (v1,v2) with
| (Integer x, Integer y) -> Integer (Intervals.V.add x y)
| (Record (r1,sigma1), Record (r2,sigma2)) -> Record (Imap.merge r1 r2,Mono) (* XXX *)
......@@ -880,7 +868,6 @@ let modulo v1 v2 = match (v1,v2) with
| (Integer x, Integer y) -> Integer (Intervals.V.modulo x y)
| _ -> assert false
let pair v1 v2 = Pair (v1,v2,Mono)
let xml v1 v2 v3 = Xml (v1,v2,v3,Mono)
......@@ -892,7 +879,6 @@ let mk_record labels fields =
done;
record !l
(* TODO: optimize cases
- (f x = [])
- all chars copied or deleted *)
......@@ -904,7 +890,6 @@ 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,sigma) ->
let accu = match f x with
......