| 656 |
|
|
| 657 |
let need_second = function _::_::_ -> true | _ -> false |
let need_second = function _::_::_ -> true | _ -> false |
| 658 |
|
|
| 659 |
let normal_aux d = |
let normal_aux = function |
| 660 |
|
| ([] | [ _ ]) as d -> d |
| 661 |
|
| d -> |
| 662 |
|
|
| 663 |
let res = ref [] in |
let res = ref [] in |
| 664 |
|
|
| 665 |
let add (t1,t2) = |
let add (t1,t2) = |
| 762 |
|
|
| 763 |
module Memo = Map.Make(struct type t = descr BoolPair.t let compare = BoolPair.compare end) |
module Memo = Map.Make(struct type t = descr BoolPair.t let compare = BoolPair.compare end) |
| 764 |
|
|
| 765 |
|
(* TODO: try with an hashtable *) |
| 766 |
|
(* Also, avoid lookup for simple products (t1,t2) *) |
| 767 |
let memo = ref Memo.empty |
let memo = ref Memo.empty |
| 768 |
let normal ?(kind=`Normal) d = |
let normal ?(kind=`Normal) d = |
| 769 |
let d = match kind with `Normal -> d.times | `XML -> d.xml in |
let d = match kind with `Normal -> d.times | `XML -> d.xml in |
| 777 |
memo := Memo.add d n !memo; |
memo := Memo.add d n !memo; |
| 778 |
n |
n |
| 779 |
|
|
| 780 |
|
let constraint_on_2 n t1 = |
| 781 |
|
List.fold_left |
| 782 |
|
(fun accu (d1,d2) -> |
| 783 |
|
if is_empty (cap d1 t1) then accu else cap accu d2) |
| 784 |
|
any |
| 785 |
|
n |
| 786 |
|
|
| 787 |
let any = { empty with times = any.times } |
let any = { empty with times = any.times } |
| 788 |
and any_xml = { empty with xml = any.xml } |
and any_xml = { empty with xml = any.xml } |
| 789 |
let is_empty d = d == [] |
let is_empty d = d == [] |