lib/mlton/set/poly-unordered.fun

   1 (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  *
   4  * MLton is released under a BSD-style license.
   5  * See the file MLton-LICENSE for details.
   6  *)
   7
   8 functor PolyUnorderedSet(): POLY_SET =
   9 struct
  10
  11 structure I = Int
  12 structure L = List
  13
  14 type 'a info = {equal: 'a * 'a -> bool,
  15                 output: 'a * Out.t -> unit}
  16
  17 datatype 'a t = T of 'a List.t * 'a info
  18
  19 fun elts(T(xs, _)) = xs
  20
  21 fun empty info = T([], info)
  22
  23 fun isEmpty s = List.isEmpty(elts s)
  24
  25 fun forall(s, f) = L.forall(elts s, f)
  26 fun exists(s, f) = L.exists(elts s, f)
  27 fun foreach(s, f) = L.foreach(elts s, f)
  28
  29 fun contains(T(elts, {equal, ...}), x) =
  30    L.exists(elts, fn x' => equal(x, x'))
  31
  32 fun s <= s' = forall(s, fn x => contains(s', x))
  33
  34 fun equal(s, s') = s <= s' andalso s' <= s
  35
  36 fun s >= s' = s' <= s
  37
  38 val equals = equal
  39
  40 fun s < s' = s <= s' andalso exists(s', fn x => not(contains(s, x)))
  41
  42 fun s > s' = s' < s
  43
  44 fun add(s as T(elts, info), x) =
  45    if contains(s, x) then s
  46    else T(x :: elts, info)
  47
  48 fun subset(T(elts, info), f) =
  49    T(L.keepAll(elts, f), info)
  50
  51 fun s1 - s2 = subset(s1, fn x => not(contains(s2, x)))
  52
  53 fun s1 + (s2 as T(x2s, _)) = let val T(x1s, info) = s1 - s2
  54                             in T(L.append(x1s, x2s), info)
  55                             end
  56
  57 (*fun union ss = L.foldl(ss, empty, op +)*)
  58
  59 fun intersect(s, s') = subset(s, fn x => contains(s', x))
  60
  61 fun toList(T(xs, _)) = xs
  62
  63 fun remove(T(xs, info as {equal, ...}), x) =
  64    T(L.remove(xs, fn x' => equal(x, x')),
  65      info)
  66
  67 fun size(T(xs, _)) = L.length xs
  68 (*
  69 fun output(T(elts, {output, ...}), out) =
  70    let val print = Outstream.outputc out
  71    in (print "{" ;
  72        L.output(", ", output) (elts, out) ;
  73        print "}")
  74    end
  75 *)
  76 end
  77
  78 structure PolySet = PolyUnorderedSet()