/[svn]/types/types.ml

Diff of /types/types.ml

Parent Directory | Revision Log | View Patch Patch

-revision 109 by abate,
Tue Jul 10 17:05:54 2007 UTC
+revision 110 by abate,
Tue Jul 10 17:07:14 2007 UTC
 Line 20
  type const = Integer of Big_int.big_int | Atom of atom | Char of Chars.Unichar.t
+ type pair_kind = [ `Normal | `XML ]
  module I = struct
    type 'a t = {
      ints  : Intervals.t;
      atoms : atom Atoms.t;
      times : ('a * 'a) Boolean.t;
+     xml   : ('a * 'a) Boolean.t;
      arrow : ('a * 'a) Boolean.t;
      record: (label * bool * 'a) Boolean.t;
      chars : Chars.t;
-Line 32
+Line 35
    let empty = {
      times = Boolean.empty;
+     xml   = Boolean.empty;
      arrow = Boolean.empty;
      record= Boolean.empty;
      ints  = Intervals.empty;
      atoms = Atoms.empty;
      chars = Chars.empty;
    }
+ (*
    let any =  {
      times = Boolean.full;
+     xml   = Boolean.full;
      arrow = Boolean.full;
      record= Boolean.full;
      ints  = Intervals.any;
      atoms = Atoms.any;
      chars = Chars.any;
    }
+ *)
    let interval i = { empty with ints = i }
    let times x y = { empty with times = Boolean.atom (x,y) }
+   let xml x y = { empty with xml = Boolean.atom (x,y) }
    let arrow x y = { empty with arrow = Boolean.atom (x,y) }
    let record label opt t = { empty with record = Boolean.atom (label,opt,t) }
    let atom a = { empty with atoms = a }
-Line 60
+Line 67
      | Char c -> char (Chars.atom c)
-   let any_record = { empty with record = any.record }
    let cup x y =
      if x = y then x else {
        times = Boolean.cup x.times y.times;
+       xml   = Boolean.cup x.xml y.xml;
        arrow = Boolean.cup x.arrow y.arrow;
        record= Boolean.cup x.record y.record;
        ints  = Intervals.cup x.ints  y.ints;
-Line 75
+Line 81
    let cap x y =
      if x = y then x else {
        times = Boolean.cap x.times y.times;
+       xml   = Boolean.cap x.xml y.xml;
        record= Boolean.cap x.record y.record;
        arrow = Boolean.cap x.arrow y.arrow;
        ints  = Intervals.cap x.ints  y.ints;
-Line 85
+Line 92
    let diff x y =
      if x = y then empty else {
        times = Boolean.diff x.times y.times;
+       xml   = Boolean.diff x.xml y.xml;
        arrow = Boolean.diff x.arrow y.arrow;
        record= Boolean.diff x.record y.record;
        ints  = Intervals.diff x.ints  y.ints;
-Line 92
+Line 100
        chars = Chars.diff x.chars y.chars;
      }
-   let neg x = diff any x
    let equal e a b =
      if a.atoms <> b.atoms then raise NotEqual;
      if a.chars <> b.chars then raise NotEqual;
      if a.ints <> b.ints then raise NotEqual;
      Boolean.equal (fun (x1,x2) (y1,y2) -> e x1 y1; e x2 y2) a.times b.times;
+     Boolean.equal (fun (x1,x2) (y1,y2) -> e x1 y1; e x2 y2) a.xml b.xml;
      Boolean.equal (fun (x1,x2) (y1,y2) -> e x1 y1; e x2 y2) a.arrow b.arrow;
      Boolean.equal (fun (l1,o1,x1) (l2,o2,x2) ->
                       if (l1 <> l2) || (o1 <> o2) then raise NotEqual;
-Line 106
+Line 114
    let map f a =
      { times = Boolean.map (fun (x1,x2) -> (f x1, f x2)) a.times;
+       xml   = Boolean.map (fun (x1,x2) -> (f x1, f x2)) a.xml;
        arrow = Boolean.map (fun (x1,x2) -> (f x1, f x2)) a.arrow;
        record= Boolean.map (fun (l,o,x) -> (l,o, f x)) a.record;
        ints  = a.ints;
-Line 139
+Line 148
      end
    )
+ (*
+ let define n d = check d; define n d
+ *)
+ let cons d =
+   let n = make () in
+   define n d;
+   internalize n
+ let any_rec = cons { empty with record = Boolean.full }
+ let any_node = make ();;
+ define any_node   {
+   times = Boolean.full;
+   xml   = Boolean.atom
+             (cons { empty with atoms = Atoms.any },
+              cons (times any_rec any_node));
+   arrow = Boolean.full;
+   record= Boolean.full;
+   ints  = Intervals.any;
+   atoms = Atoms.any;
+   chars = Chars.any;
+ };;
+ internalize any_node;;
+ let any = descr any_node
+ let neg x = diff any x
+ let get_record r =
+   let add = SortedMap.add (fun (o1,t1) (o2,t2) -> (o1&&o2, cap t1 t2)) in
+   let line (p,n) =
+     let accu = List.fold_left
+                  (fun accu (l,o,t) -> add l (o,descr t) accu) [] p in
+     List.fold_left
+       (fun accu (l,o,t) -> add l (not o,neg (descr t)) accu) accu n in
+   List.map line r
  module DescrMap = Map.Make(struct type t = descr let compare = compare end)
  let check d =
    Boolean.check d.times;
+   Boolean.check d.xml;
    Boolean.check d.arrow;
    Boolean.check d.record;
    ()
+ (* Subtyping algorithm *)
+ let diff_t d t = diff d (descr t)
+ let cap_t d t = cap d (descr t)
+ let cup_t d t = cup d (descr t)
+ let cap_product l =
+   List.fold_left
+     (fun (d1,d2) (t1,t2) -> (cap_t d1 t1, cap_t d2 t2))
+     (any,any)
+     l
+ let cup_product l =
+   List.fold_left
+     (fun (d1,d2) (t1,t2) -> (cup_t d1 t1, cup_t d2 t2))
+     (empty,empty)
+     l
+ module Assumptions = Set.Make(struct type t = descr let compare = compare end)
+ let memo = ref Assumptions.empty
+ let cache_false = ref Assumptions.empty
+ exception NotEmpty
+ let rec empty_rec d =
+   if Assumptions.mem d !cache_false then false
+   else if Assumptions.mem d !memo then true
+   else if not (Intervals.is_empty d.ints) then false
+   else if not (Atoms.is_empty d.atoms) then false
+   else if not (Chars.is_empty d.chars) then false
+   else (
+     let backup = !memo in
+     memo := Assumptions.add d backup;
+     if
+       (empty_rec_times d.times) &&
+       (empty_rec_times d.xml) &&
+       (empty_rec_arrow d.arrow) &&
+       (empty_rec_record d.record)
+     then true
+     else (
+       memo := backup;
+       cache_false := Assumptions.add d !cache_false;
+       false
+     )
+   )
+ and empty_rec_times c =
+   List.for_all empty_rec_times_aux c
+ and empty_rec_times_aux (left,right) =
+   let rec aux accu1 accu2 = function
+     | (t1,t2)::right ->
+         let accu1' = diff_t accu1 t1 in
+         if not (empty_rec accu1') then aux accu1' accu2 right;
+         let accu2' = diff_t accu2 t2 in
+         if not (empty_rec accu2') then aux accu1 accu2' right
+     | [] -> raise NotEmpty
+   in
+   let (accu1,accu2) = cap_product left in
+   (empty_rec accu1) || (empty_rec accu2) ||
+ (* OPT? It does'nt seem so ...  The hope was to return false quickly
+    for large right hand-side *)
+   (
+     ((*if (List length right > 2) then
+        let (cup1,cup2) = cup_product right in
+        (empty_rec (diff accu1 cup1)) && (empty_rec (diff accu2 cup2))
+      else*) true)
+     &&
+     (try aux accu1 accu2 right; true with NotEmpty -> false)
+   )
+ and empty_rec_arrow c =
+   List.for_all empty_rec_arrow_aux c
+ and empty_rec_arrow_aux (left,right) =
+   let single_right (s1,s2) =
+     let rec aux accu1 accu2 = function
+       | (t1,t2)::left ->
+           let accu1' = diff_t accu1 t1 in
+           if not (empty_rec accu1') then aux accu1 accu2 left;
+           let accu2' = cap_t accu2 t2 in
+           if not (empty_rec accu2') then aux accu1 accu2 left
+       | [] -> raise NotEmpty
+     in
+     let accu1 = descr s1 in
+     (empty_rec accu1) ||
+     (try aux accu1 (diff any (descr s2)) left; true with NotEmpty -> false)
+   in
+   List.exists single_right right
+ and empty_rec_record c =
+   let aux = List.exists (fun (_,(opt,t)) -> (not opt) && (empty_rec t)) in
+   List.for_all aux (get_record c)
+ let is_empty d =
+   let old = !memo in
+   let r = empty_rec d in
+   if not r then memo := old;
+ (*  cache_false := Assumptions.empty;  *)
+   r
+ let non_empty d =
+   not (is_empty d)
+ let subtype d1 d2 =
+   is_empty (diff d1 d2)
+ module Product =
+ struct
+   type t = (descr * descr) list
+   let other ?(kind=`Normal) d =
+     match kind with
+       | `Normal -> { d with times = empty.times }
+       | `XML -> { d with xml = empty.xml }
+   let is_product ?kind d = is_empty (other ?kind d)
+   let need_second = function _::_::_ -> true | _ -> false
+   let normal_aux d =
+     let res = ref [] in
+     let add (t1,t2) =
+       let rec loop t1 t2 = function
+         | [] -> res := (ref (t1,t2)) :: !res
+         | ({contents = (d1,d2)} as r)::l ->
+             (*OPT*)
+             if d1 = t1 then r := (d1,cup d2 t2) else
+               let i = cap t1 d1 in
+               if is_empty i then loop t1 t2 l
+               else (
+                 r := (i, cup t2 d2);
+                 let k = diff d1 t1 in
+                 if non_empty k then res := (ref (k,d2)) :: !res;
+                 let j = diff t1 d1 in
+                 if non_empty j then loop j t2 l
+               )
+       in
+       loop t1 t2 !res
+     in
+     List.iter add d;
+     List.map (!) !res
  (*
- let define n d = check d; define n d
+ This version explodes when dealing with
+    Any - [ t1? t2? t3? ... tn? ]
+ ==> need partitioning
  *)
+   let get_aux d =
+     let line accu (left,right) =
+       let rec aux accu d1 d2 = function
+         | (t1,t2)::right ->
+             let accu =
+               let d1 = diff_t d1 t1 in
+               if is_empty d1 then accu else aux accu d1 d2 right in
+             let accu =
+               let d2 = diff_t d2 t2 in
+               if is_empty d2 then accu else aux accu d1 d2 right in
+             accu
+         | [] -> (d1,d2) :: accu
+       in
+       let (d1,d2) = cap_product left in
+       if (is_empty d1) || (is_empty d2) then accu else aux accu d1 d2 right
+     in
+     List.fold_left line [] d
- let cons d =
+ (* Partitioning:
-   let n = make () in
-   define n d;
+ (t,s) - ((t1,s1) | (t2,s2) | ... | (tn,sn))
-   internalize n
+ =
+ (t & t1, s - s1) | ... | (t & tn, s - sn) | (t - (t1|...|tn), s)
+ *)
+   let get_aux d =
+     let accu = ref [] in
+     let line (left,right) =
+       let (d1,d2) = cap_product left in
+       if (non_empty d1) && (non_empty d2) then
+         let right = List.map (fun (t1,t2) -> descr t1, descr t2) right in
+         let right = normal_aux right in
+         let resid1 = ref d1 in
+         let () =
+           List.iter
+             (fun (t1,t2) ->
+                let t1 = cap d1 t1 in
+                if (non_empty t1) then
+                  let () = resid1 := diff !resid1 t1 in
+                  let t2 = diff d2 t2 in
+                  if (non_empty t2) then accu := (t1,t2) :: !accu
+             ) right in
+         if non_empty !resid1 then accu := (!resid1, d2) :: !accu
+     in
+     List.iter line d;
+     !accu
+   let get ?(kind=`Normal) d =
+     match kind with
+       | `Normal -> get_aux d.times
+       | `XML -> get_aux d.xml
+   let pi1 = List.fold_left (fun acc (t1,_) -> cup acc t1) empty
+   let pi2 = List.fold_left (fun acc (_,t2) -> cup acc t2) empty
+   let restrict_1 rects pi1 =
+     let aux accu (t1,t2) =
+       let t1 = cap t1 pi1 in if is_empty t1 then accu else (t1,t2)::accu in
+     List.fold_left aux [] rects
+   type normal = t
+   module Memo = Map.Make(struct
+                            type t = (node * node) Boolean.t
+                            let compare = compare end)
+   let memo = ref Memo.empty
+   let normal ?(kind=`Normal) d =
+     let d = match kind with `Normal -> d.times | `XML -> d.xml in
+     try Memo.find d !memo
+     with
+         Not_found ->
+           let gd = get_aux d in
+           let n = normal_aux gd in
+           memo := Memo.add d n !memo;
+           n
+   let any = { empty with times = any.times }
+   and any_xml = { empty with xml = any.xml }
+   let is_empty d = d = []
+ end
  module Print =
  struct
+   let rec print_union ppf = function
+     | [] -> Format.fprintf ppf "Empty"
+     | [h] -> h ppf
+     | h::t -> Format.fprintf ppf "@[%t |@ %a@]" h print_union t
    let print_atom ppf a =
      Format.fprintf ppf "`%s" (AtomPool.value a)
+   let print_tag ppf a =
+     match Atoms.is_atom a with
+       | Some a -> Format.fprintf ppf "%s" (AtomPool.value a)
+       | None ->
+           Format.fprintf ppf "(%a)"
+             print_union
+                (Atoms.print "Atom" print_atom a)
    let print_const ppf = function
      | Integer i -> Format.fprintf ppf "%s" (Big_int.string_of_big_int i)
      | Atom a -> print_atom ppf a
-Line 200
+Line 490
        with Not_found ->
          DescrHash.add marks d (ref None);
          bool_iter (fun (n1,n2) -> mark n1; mark n2) d.times;
+         bool_iter (fun (n1,n2) -> mark n1; mark n2) d.xml;
          bool_iter (fun (n1,n2) -> mark n1; mark n2) d.arrow;
          bool_iter (fun (l,o,n) -> mark n) d.record
-   let rec print_union ppf = function
-     | [] -> Format.fprintf ppf "Empty"
-     | [h] -> h ppf
-     | h::t -> Format.fprintf ppf "@[%t |@ %a@]" h print_union t
    let rec print ppf n = print_descr ppf (descr n)
    and print_descr ppf d =
      try
-Line 221
+Line 506
            | Some n -> Format.fprintf ppf "%s" n
            | None -> real_print_descr ppf d
        with
-           Not_found -> Format.fprintf ppf "XXX"
+           Not_found -> assert false
    and real_print_descr ppf d =
      if d = any then Format.fprintf ppf "Any" else
        print_union ppf
-Line 229
+Line 514
           Chars.print d.chars @
           Atoms.print "Atom" print_atom d.atoms @
           Boolean.print "Pair" print_times d.times @
+          Boolean.print "XML" print_xml d.xml @
           Boolean.print "Arrow" print_arrow d.arrow @
           Boolean.print "Record" print_record d.record
          )
    and print_times ppf (t1,t2) =
      Format.fprintf ppf "@[(%a,%a)@]" print t1 print t2
+   and print_xml ppf (t1,t2) =
+     let l = Product.normal (descr t2) in
+     let l = List.map
+               (fun (d1,d2) ppf ->
+                  Format.fprintf ppf "@[<><%a%a>%a@]"
+                    print_tag (descr t1).atoms
+                    print_attribs d1.record
+                    print_descr d2) l
+     in
+     print_union ppf l
    and print_arrow ppf (t1,t2) =
      Format.fprintf ppf "@[(%a -> %a)@]" print t1 print t2
    and print_record ppf (l,o,t) =
      Format.fprintf ppf "@[{ %s =%s %a }@]"
        (LabelPool.value l) (if o then "?" else "") print t
+   and print_attribs ppf r =
+     let l = get_record r in
+     if l <> [ [] ] then
+     let l = List.map
+       (fun att ppf ->
+          let first = ref true in
+          Format.fprintf ppf "{" ;
+          List.iter (fun (l,(o,d)) ->
+                       Format.fprintf ppf "%s%s=%s%a"
+                         (if !first then "" else " ")
+                         (LabelPool.value l) (if o then "?" else "")
+                         print_descr d;
+                       first := false
+                    ) att;
+            Format.fprintf ppf "}"
+       ) l in
+     print_union ppf l
    let end_print ppf =
-Line 306
+Line 619
  end
- let get_record r =
-   let add = SortedMap.add (fun (o1,t1) (o2,t2) -> (o1&&o2, cap t1 t2)) in
-   let line (p,n) =
-     let accu = List.fold_left
-                  (fun accu (l,o,t) -> add l (o,descr t) accu) [] p in
-     List.fold_left
-       (fun accu (l,o,t) -> add l (not o,neg (descr t)) accu) accu n in
-   List.map line r
- (* Subtyping algorithm *)
- let diff_t d t = diff d (descr t)
- let cap_t d t = cap d (descr t)
- let cup_t d t = cup d (descr t)
- let cap_product l =
-   List.fold_left
-     (fun (d1,d2) (t1,t2) -> (cap_t d1 t1, cap_t d2 t2))
-     (any,any)
-     l
- let cup_product l =
-   List.fold_left
-     (fun (d1,d2) (t1,t2) -> (cup_t d1 t1, cup_t d2 t2))
-     (empty,empty)
-     l
- module Assumptions = Set.Make(struct type t = descr let compare = compare end)
- let memo = ref Assumptions.empty
- let cache_false = ref Assumptions.empty
- exception NotEmpty
- let rec empty_rec d =
-   if Assumptions.mem d !cache_false then false
-   else if Assumptions.mem d !memo then true
-   else if not (Intervals.is_empty d.ints) then false
-   else if not (Atoms.is_empty d.atoms) then false
-   else if not (Chars.is_empty d.chars) then false
-   else (
-     let backup = !memo in
-     memo := Assumptions.add d backup;
-     if
-       (empty_rec_times d.times) &&
-       (empty_rec_arrow d.arrow) &&
-       (empty_rec_record d.record)
-     then true
-     else (
-       memo := backup;
-       cache_false := Assumptions.add d !cache_false;
-       false
-     )
-   )
- and empty_rec_times c =
-   List.for_all empty_rec_times_aux c
- and empty_rec_times_aux (left,right) =
-   let rec aux accu1 accu2 = function
-     | (t1,t2)::right ->
-         let accu1' = diff_t accu1 t1 in
-         if not (empty_rec accu1') then aux accu1' accu2 right;
-         let accu2' = diff_t accu2 t2 in
-         if not (empty_rec accu2') then aux accu1 accu2' right
-     | [] -> raise NotEmpty
-   in
-   let (accu1,accu2) = cap_product left in
-   (empty_rec accu1) || (empty_rec accu2) ||
- (* OPT? It does'nt seem so ...  The hope was to return false quickly
-    for large right hand-side *)
-   (
-     ((*if (List length right > 2) then
-        let (cup1,cup2) = cup_product right in
-        (empty_rec (diff accu1 cup1)) && (empty_rec (diff accu2 cup2))
-      else*) true)
-     &&
-     (try aux accu1 accu2 right; true with NotEmpty -> false)
-   )
- and empty_rec_arrow c =
-   List.for_all empty_rec_arrow_aux c
- and empty_rec_arrow_aux (left,right) =
-   let single_right (s1,s2) =
-     let rec aux accu1 accu2 = function
-       | (t1,t2)::left ->
-           let accu1' = diff_t accu1 t1 in
-           if not (empty_rec accu1') then aux accu1 accu2 left;
-           let accu2' = cap_t accu2 t2 in
-           if not (empty_rec accu2') then aux accu1 accu2 left
-       | [] -> raise NotEmpty
-     in
-     let accu1 = descr s1 in
-     (empty_rec accu1) ||
-     (try aux accu1 (diff any (descr s2)) left; true with NotEmpty -> false)
-   in
-   List.exists single_right right
- and empty_rec_record c =
-   let aux = List.exists (fun (_,(opt,t)) -> (not opt) && (empty_rec t)) in
-   List.for_all aux (get_record c)
- let is_empty d =
-   let old = !memo in
-   let r = empty_rec d in
-   if not r then memo := old;
- (*  cache_false := Assumptions.empty;  *)
-   r
- let non_empty d =
-   not (is_empty d)
- let subtype d1 d2 =
-   is_empty (diff d1 d2)
  (* Sample value *)
  module Sample =
-Line 435
+Line 633
    | Int of Big_int.big_int
    | Atom of atom
    | Char of Chars.Unichar.t
-   | Pair of t * t
+   | Pair of (t * t)
+   | Xml of (t * t)
    | Record of (label * t) list
    | Fun of (node * node) list
-Line 450
+Line 649
      try sample_rec_arrow d.arrow with Not_found ->
      let memo = Assumptions.add d memo in
-     try sample_rec_times memo d.times with Not_found ->
+     try Pair (sample_rec_times memo d.times) with Not_found ->
+     try Xml (sample_rec_times memo d.xml) with Not_found ->
      try sample_rec_record memo d.record with Not_found ->
      raise Not_found
-Line 466
+Line 666
            let accu2' = diff_t accu2 t2 in
            if non_empty accu2' then aux accu1 accu2' right else
              raise Not_found
-     | [] -> Pair (sample_rec memo accu1, sample_rec memo accu2)
+     | [] -> (sample_rec memo accu1, sample_rec memo accu2)
    in
    let (accu1,accu2) = cap_product left in
    if (is_empty accu1) || (is_empty accu2) then raise Not_found;
-Line 520
+Line 720
            Format.fprintf ppf "`%s" (AtomPool.value a)
      | Char c -> Chars.Unichar.print ppf c
      | Pair (x1,x2) -> Format.fprintf ppf "(%a,%a)" print x1 print x2
+     | Xml (x1,x2) -> Format.fprintf ppf "XML(%a,%a)" print x1 print x2
      | Record r ->
          Format.fprintf ppf "{ %a }"
            (print_sep
-Line 542
+Line 743
  end
- module Product =
- struct
-   type t = (descr * descr) list
-   let other d = { d with times = empty.times }
-   let is_product d = is_empty (other d)
-   let need_second = function _::_::_ -> true | _ -> false
-   let normal_aux d =
-     let res = ref [] in
-     let add (t1,t2) =
-       let rec loop t1 t2 = function
-         | [] -> res := (ref (t1,t2)) :: !res
-         | ({contents = (d1,d2)} as r)::l ->
-             (*OPT*)
-             if d1 = t1 then r := (d1,cup d2 t2) else
-               let i = cap t1 d1 in
-               if is_empty i then loop t1 t2 l
-               else (
-                 r := (i, cup t2 d2);
-                 let k = diff d1 t1 in
-                 if non_empty k then res := (ref (k,d2)) :: !res;
-                 let j = diff t1 d1 in
-                 if non_empty j then loop j t2 l
-               )
-       in
-       loop t1 t2 !res
-     in
-     List.iter add d;
-     List.map (!) !res
- (*
- This version explodes when dealing with
-    Any - [ t1? t2? t3? ... tn? ]
- ==> need partitioning
- *)
-   let get_aux d =
-     let line accu (left,right) =
-       let debug = List.length right = 28 in
-       let rec aux accu d1 d2 = function
-         | (t1,t2)::right ->
-             let accu =
-               let d1 = diff_t d1 t1 in
-               if is_empty d1 then accu else aux accu d1 d2 right in
-             let accu =
-               let d2 = diff_t d2 t2 in
-               if is_empty d2 then accu else aux accu d1 d2 right in
-             accu
-         | [] -> (d1,d2) :: accu
-       in
-       let (d1,d2) = cap_product left in
-       if (is_empty d1) || (is_empty d2) then accu else aux accu d1 d2 right
-     in
-     List.fold_left line [] d
- (* Partitioning:
- (t,s) - ((t1,s1) | (t2,s2) | ... | (tn,sn))
- =
- (t & t1, s - s1) | ... | (t & tn, s - sn) | (t - (t1|...|tn), s)
- *)
-   let get_aux d =
-     let accu = ref [] in
-     let line (left,right) =
-       let (d1,d2) = cap_product left in
-       if (non_empty d1) && (non_empty d2) then
-         let right = List.map (fun (t1,t2) -> descr t1, descr t2) right in
-         let right = normal_aux right in
-         let resid1 = ref d1 in
-         let () =
-           List.iter
-             (fun (t1,t2) ->
-                let t1 = cap d1 t1 in
-                if (non_empty t1) then
-                  let () = resid1 := diff !resid1 t1 in
-                  let t2 = diff d2 t2 in
-                  if (non_empty t2) then accu := (t1,t2) :: !accu
-             ) right in
-         if non_empty !resid1 then accu := (!resid1, d2) :: !accu
-     in
-     List.iter line d;
-     !accu
-   let get d = get_aux d.times
-   let pi1 = List.fold_left (fun acc (t1,_) -> cup acc t1) empty
-   let pi2 = List.fold_left (fun acc (_,t2) -> cup acc t2) empty
-   let restrict_1 rects pi1 =
-     let aux accu (t1,t2) =
-       let t1 = cap t1 pi1 in if is_empty t1 then accu else (t1,t2)::accu in
-     List.fold_left aux [] rects
-   type normal = t
-   module Memo = Map.Make(struct
-                            type t = (node * node) Boolean.t
-                            let compare = compare end)
-   let memo = ref Memo.empty
-   let normal d =
-     let d = d.times in
-     try Memo.find d !memo
-     with
-         Not_found ->
-           let gd = get_aux d in
-           let n = normal_aux gd in
-           memo := Memo.add d n !memo;
-           n
-   let any = { empty with times = any.times }
-   let is_empty d = d = []
- end
  module Record =
  struct
-Line 837
+Line 916
          (fun (d1,d2) -> [(rec_normalize d1, rec_normalize d2)],[])
          (Product.normal d)
      in
+     let xml =
+       map_sort
+         (fun (d1,d2) -> [(rec_normalize d1, rec_normalize d2)],[])
+         (Product.normal ~kind:`XML d)
+     in
      let record =
        map_sort
          (fun f -> map_sort (fun (l,(o,d)) -> (l,o,rec_normalize d)) f, [])
          (Record.get d)
      in
-     define n { d with times = times; record = record };
+     define n { d with times = times; xml = xml; record = record };
      n
  let normalize n =

 Legend:



Removed from v.109
 


changed lines


 
Added in v.110
 Legend:



Removed from v.109
 


changed lines


 
Added in v.110
-Removed from v.109
+Added in v.110

CVS Admin">CVS Admin	ViewVC Help
Powered by ViewVC 1.1.5