| 382 |
let other d = { d with times = empty.times } |
let other d = { d with times = empty.times } |
| 383 |
let is_product d = is_empty (other d) |
let is_product d = is_empty (other d) |
| 384 |
|
|
| 385 |
|
let need_second = function _::_::_ -> true | _ -> false |
| 386 |
|
|
| 387 |
let get d = |
let get d = |
| 388 |
let line accu (left,right) = |
let line accu (left,right) = |
| 389 |
let rec aux accu d1 d2 = function |
let rec aux accu d1 d2 = function |
| 439 |
List.map (!) !res |
List.map (!) !res |
| 440 |
|
|
| 441 |
let any = { empty with times = any.times } |
let any = { empty with times = any.times } |
| 442 |
|
let is_empty d = d = [] |
| 443 |
end |
end |
| 444 |
|
|
| 445 |
|
|
| 704 |
|
|
| 705 |
module Arrow = |
module Arrow = |
| 706 |
struct |
struct |
| 707 |
|
let check_simple left s1 s2 = |
| 708 |
|
let rec aux accu1 accu2 = function |
| 709 |
|
| (t1,t2)::left -> |
| 710 |
|
let accu1' = diff_t accu1 t1 in |
| 711 |
|
if not (empty_rec accu1') then aux accu1 accu2 left; |
| 712 |
|
let accu2' = cap_t accu2 t2 in |
| 713 |
|
if not (empty_rec accu2') then aux accu1 accu2 left |
| 714 |
|
| [] -> raise NotEmpty |
| 715 |
|
in |
| 716 |
|
let accu1 = descr s1 in |
| 717 |
|
(is_empty accu1) || |
| 718 |
|
(try aux accu1 (diff any (descr s2)) left; true with NotEmpty -> false) |
| 719 |
|
|
| 720 |
|
let check_strenghten t s = |
| 721 |
|
let left = match t.arrow with [ (p,[]) ] -> p | _ -> assert false in |
| 722 |
|
let rec aux = function |
| 723 |
|
| [] -> raise Not_found |
| 724 |
|
| (p,n) :: rem -> |
| 725 |
|
if (List.for_all (fun (a,b) -> check_simple left a b) p) && |
| 726 |
|
(List.for_all (fun (a,b) -> not (check_simple left a b)) n) then |
| 727 |
|
{ empty with arrow = [ (SortedList.cup left p, n) ] } |
| 728 |
|
else aux rem |
| 729 |
|
in |
| 730 |
|
aux s.arrow |
| 731 |
|
|
| 732 |
type t = descr * (descr * descr) list list |
type t = descr * (descr * descr) list list |
| 733 |
|
|
| 734 |
let get t = |
let get t = |
| 770 |
let apply (_,arr) t = |
let apply (_,arr) t = |
| 771 |
List.fold_left (apply_simple t) empty arr |
List.fold_left (apply_simple t) empty arr |
| 772 |
|
|
| 773 |
|
let need_arg (dom, arr) = |
| 774 |
|
List.exists (function [_] -> false | _ -> true) arr |
| 775 |
|
|
| 776 |
|
let apply_noarg (_,arr) = |
| 777 |
|
List.fold_left |
| 778 |
|
(fun accu -> |
| 779 |
|
function |
| 780 |
|
| [(t,s)] -> cup accu s |
| 781 |
|
| _ -> assert false |
| 782 |
|
) |
| 783 |
|
empty arr |
| 784 |
|
|
| 785 |
let any = { empty with arrow = any.arrow } |
let any = { empty with arrow = any.arrow } |
| 786 |
|
let is_empty (_,arr) = arr = [] |
| 787 |
end |
end |
| 788 |
|
|
| 789 |
|
|