Commit 149a06b7 authored by Pietro Abate's avatar Pietro Abate

[r2003-03-11 19:19:48 by cvscast] Empty log message

Original author: cvscast
Date: 2003-03-11 19:19:48+00:00
parent f2eb8125
......@@ -75,7 +75,7 @@ let cup t s =
(fun (p,n) -> not (SSList.exists (may_remove (p,n)) s)) t in
SSList.cup s t
let tot = ref 0
(*
let clean accu t =
let rec aux accu = function
| (p,n) :: rem ->
......@@ -86,7 +86,7 @@ let clean accu t =
| [] -> accu
in
SSList.from_list (aux accu t)
*)
......@@ -99,6 +99,16 @@ let rec fold2 f x l1 l2 =
| [] -> x
| h :: t -> fold2 f (fold2_aux f h x l2) t l2
let rec should_add x = function
| [] -> true
| y::rem -> if may_remove x y then false else should_add x rem
let rec clean_add accu x = function
| [] -> accu
| y::rem ->
if may_remove y x then clean_add accu x rem
else clean_add (y::accu) x rem
let cap s t =
if s == t then s
else if s == full then t
......@@ -107,14 +117,17 @@ let cap s t =
else
let (lines1,common,lines2) = SSList.split s t in
let rec aux lines (p1,n1) (p2,n2) =
if (SList.disjoint p1 n2) && (SList.disjoint p2 n1)
then (SList.cup p1 p2, SList.cup n1 n2) :: lines
if (SList.disjoint p1 n2) && (SList.disjoint p2 n1)
then
let x = (SList.cup p1 p2, SList.cup n1 n2) in
if should_add x lines then clean_add [x] x lines else lines
else lines
in
clean (SSList.get common) (fold2 aux [] (SSList.get lines1) (SSList.get lines2))
SSList.from_list
(fold2 aux (SSList.get common) (SSList.get lines1) (SSList.get lines2))
let diff c1 c2 =
if c2 == full then empty
if (c2 == full) || (c1 == c2) then empty
else if (c1 == empty) || (c2 == empty) then c1
else
let c1 = SSList.diff c1 c2 in
......
......@@ -125,6 +125,7 @@ module Make_transp(X : ARG) = struct
let is_empty l = l = []
let rec disjoint l1 l2 =
if l1 == l2 then l1 == [] else
match (l1,l2) with
| (t1::q1, t2::q2) ->
let c = X.compare t1 t2 in
......@@ -134,6 +135,7 @@ let rec disjoint l1 l2 =
| _ -> true
let rec cup l1 l2 =
if l1 == l2 then l1 else
match (l1,l2) with
| (t1::q1, t2::q2) ->
let c = X.compare t1 t2 in
......@@ -156,6 +158,7 @@ let rec split l1 l2 =
let rec diff l1 l2 =
if l1 == l2 then [] else
match (l1,l2) with
| (t1::q1, t2::q2) ->
let c = X.compare t1 t2 in
......@@ -167,6 +170,7 @@ let rec diff l1 l2 =
let remove x l = diff l [x]
let rec cap l1 l2 =
if l1 == l2 then l1 else
match (l1,l2) with
| (t1::q1, t2::q2) ->
let c = X.compare t1 t2 in
......@@ -177,14 +181,23 @@ let rec cap l1 l2 =
let rec subset l1 l2 =
(l1 == l2) ||
match (l1,l2) with
| (t1::q1, t2::q2) ->
let c = X.compare t1 t2 in
if c = 0 then subset q1 q2
if c = 0 then (
(* inlined: subset q1 q2 *)
(q1 == q2) || match (q1,q2) with
| (t1::qq1, t2::qq2) ->
let c = X.compare t1 t2 in
if c = 0 then subset qq1 qq2
else if c < 0 then false
else subset q1 qq2
| [],_ -> true | _ -> false
)
else if c < 0 then false
else subset l1 q2
| [],_ -> true
| _ -> false
| [],_ -> true | _ -> false
......
......@@ -464,8 +464,7 @@ let rec big_conj f l n =
let rec guard a f n =
match slot a with
| { status = Empty } -> ()
| { status = Maybe } as s ->
n.active <- true; s.notify <- Do (n,f,s.notify)
| { status = Maybe } as s -> n.active <- true; s.notify <- Do (n,f,s.notify)
| { status = NEmpty } -> f n
and slot d =
......@@ -654,7 +653,7 @@ and empty_rec_record c =
(*
let is_empty d =
empty_rec d
*)
*)
let non_empty d =
not (is_empty d)
......
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