home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / lib / set.ml < prev    next >
Encoding:
Text File  |  1993-09-24  |  2.1 KB  |  83 lines  |  [TEXT/MPS ]

  1. (* Sets over ordered types *)
  2.  
  3. #open "eq";;
  4. #open "int";;
  5. #open "baltree";;
  6.  
  7. (* Sets are represented by AVL trees. *)
  8.  
  9. type 'a t =
  10.   { tree: 'a baltree__t; order: 'a -> 'a -> int };;
  11.  
  12. let empty ord =
  13.   { tree = Empty; order = ord };;
  14.  
  15. let is_empty s =
  16.   match s.tree with Empty -> true | _ -> false;;
  17.  
  18. let mem x s =
  19.   baltree__contains (s.order x) s.tree;;
  20.  
  21. let add x s =
  22.   { tree = baltree__add (s.order x) x s.tree; order = s.order };;
  23.  
  24. let remove x s =
  25.   { tree = baltree__remove (s.order x) s.tree; order = s.order };;
  26.  
  27. let union s1 s2 =
  28.   let rec union = fun
  29.     Empty t2 -> t2
  30.   | t1 Empty -> t1
  31.   | (Node(l1, v1, r1, _)) t2 ->
  32.       let (l2, _, r2) = baltree__split (s1.order v1) t2 in
  33.       baltree__join (union l1 l2) v1 (union r1 r2) in
  34.   { tree = union s1.tree s2.tree; order = s1.order };;
  35.  
  36. let inter s1 s2 =
  37.   let rec inter = fun
  38.     Empty t2 -> Empty
  39.   | t1 Empty -> Empty
  40.   | (Node(l1, v1, r1, _)) t2 ->
  41.       match baltree__split (s1.order v1) t2 with
  42.         (l2, Nothing, r2) ->
  43.           baltree__concat (inter l1 l2) (inter r1 r2)
  44.       | (l2, Something _, r2) ->
  45.           baltree__join (inter l1 l2) v1 (inter r1 r2) in
  46.   { tree = inter s1.tree s2.tree; order = s1.order };;
  47.  
  48. let diff s1 s2 =
  49.   let rec diff = fun
  50.     Empty t2 -> Empty
  51.   | t1 Empty -> t1
  52.   | (Node(l1, v1, r1, _)) t2 ->
  53.       match baltree__split (s1.order v1) t2 with
  54.         (l2, Nothing, r2) ->
  55.           baltree__join (diff l1 l2) v1 (diff r1 r2)
  56.       | (l2, Something _, r2) ->
  57.           baltree__concat (diff l1 l2) (diff r1 r2) in
  58.   { tree = diff s1.tree s2.tree; order = s1.order };;
  59.  
  60. let compare s1 s2 =
  61.   baltree__compare s1.order s1.tree s2.tree;;
  62.  
  63. let equal s1 s2 =
  64.   compare s1 s2 == 0;;
  65.  
  66. let iter f s =
  67.   let rec iter = function
  68.     Empty -> ()
  69.   | Node(l, v, r, _) -> iter l; f v; iter r
  70.   in iter s.tree;;
  71.  
  72. let fold f s init =
  73.   let rec fold accu = function
  74.     Empty -> accu
  75.   | Node(l, v, r, _) -> fold (f v (fold accu r)) l
  76.   in fold init s.tree;;
  77.  
  78. let elements s =
  79.   let rec elements accu = function
  80.     Empty -> accu
  81.   | Node(l, v, r, _) -> elements (v :: elements accu r) l
  82.   in elements [] s.tree;;
  83.