(* module about ordered polymorphic lists as sets *) open List type 'a t = 'a list (* return an empty set *) let empty : unit -> 'a list = fun () -> [] (* test if a set is empty or not *) let is_empty : 'a list -> bool = function [] -> true | _ -> false (* return true if the first set contains the second *) let rec contains : 'a list -> 'a list -> bool = fun l1 l2 -> match l1, l2 with _, [] -> true | [], _ -> false | x1::l1, x2::l2 -> let comp = compare x1 x2 in if comp < 0 then contains l1 (x2::l2) else if comp > 0 then false else contains l1 l2 (* return the union of 2 and several sets *) let rec union : 'a list -> 'a list -> 'a list = fun l1 l2 -> match l1, l2 with [], l2 -> l2 | l1, [] -> l1 | x1::l1, x2::l2 -> let comp = compare x1 x2 in if comp < 0 then x1::union l1 (x2::l2) else if comp > 0 then x2::union (x1::l1) l2 else x1::union l1 l2 let union_r : 'a list list -> 'a list = fun sets -> List.fold_left (fun res set -> union res set) [] sets (* return the intersection of 2 sets *) let rec inter : 'a list -> 'a list -> 'a list = fun l1 l2 -> match l1, l2 with [], _ -> [] | _, [] -> [] | x1::l1, x2:: l2 -> let comp = compare x1 x2 in if comp < 0 then inter l1 (x2::l2) else if comp > 0 then inter (x1::l1) l2 else x1::inter l1 l2 let rec inter_r : 'a list list -> 'a list = function [] -> raise (Invalid_argument "inter_r : empty list of sets") | set::sets -> List.fold_right (fun set res -> inter set res) sets set (* return the subtraction of 2 sets *) let rec subtract : 'a list -> 'a list -> 'a list = fun l1 l2 -> match l1, l2 with [], _ -> [] | l1, [] -> l1 | x1::l1, x2::l2 -> let comp = compare x1 x2 in if comp < 0 then x1::subtract l1 (x2::l2) else if comp > 0 then subtract (x1::l1) l2 else subtract l1 l2 let subtract_r : 'a list -> 'a list list -> 'a list = fun set sets -> List.fold_left (fun res set -> subtract res set) set sets (* iterative functions on lists can also be applied, at least in some cases *)