| 1 | open Common |
| 2 | |
| 3 | open Ocollection |
| 4 | |
| 5 | class virtual ['a] oset = |
| 6 | object(o: 'o) |
| 7 | inherit ['a] ocollection |
| 8 | |
| 9 | (* no need virtual, but better to redefine (efficiency) *) |
| 10 | method virtual union: 'o -> 'o |
| 11 | method virtual inter: 'o -> 'o |
| 12 | method virtual minus: 'o -> 'o |
| 13 | |
| 14 | (* allow binary methods tricks, generate exception when not good type *) |
| 15 | method tosetb: 'a Setb.t = raise Impossible |
| 16 | method tosetpt: SetPt.t = raise Impossible |
| 17 | method toseti: Seti.seti = raise Impossible |
| 18 | method virtual toset: 'b. 'b (* generic (not safe) tricks *) |
| 19 | |
| 20 | (* is_intersect, equal, subset *) |
| 21 | method is_subset_of: 'o -> bool = fun o2 -> |
| 22 | ((o2#minus o)#cardinal >= 0) && ((o#minus o2)#cardinal =|= 0) |
| 23 | |
| 24 | method is_equal: 'o -> bool = fun o2 -> |
| 25 | ((o2#minus o)#cardinal =|= 0) && ((o#minus o2)#cardinal =|= 0) |
| 26 | |
| 27 | |
| 28 | method is_singleton: bool = (* can be short circuited *) |
| 29 | o#length =|= 1 |
| 30 | method cardinal: int = (* just to keep naming conventions *) |
| 31 | o#length |
| 32 | (* dont work: |
| 33 | method big_union: 'b. ('a -> 'b oset) -> 'b oset = fun f -> todo() |
| 34 | *) |
| 35 | |
| 36 | end |
| 37 | |
| 38 | let ($??$) e xs = xs#mem e |
| 39 | let ($++$) xs ys = xs#union ys |
| 40 | let ($**$) xs ys = xs#inter ys |
| 41 | let ($--$) xs ys = xs#minus ys |
| 42 | let ($<<=$) xs ys = xs#is_subset_of ys |
| 43 | let ($==$) xs ys = xs#is_equal ys |
| 44 | |
| 45 | (* todo: pas beau le seed. I dont put the type otherwise have to |
| 46 | * put explicit :> |
| 47 | *) |
| 48 | let (mapo: ('a -> 'b) -> 'b oset -> 'a oset -> 'b oset) = fun f seed xs -> |
| 49 | xs#fold (fun acc x -> acc#add (f x)) seed |
| 50 | |