http://igstan.ro/posts/2017-04-08-a-safe-type-indexed-set-for-standard-ml.html

set.sml

signature TAGGED_ORD =
  sig
    type t
    type a
    val wrap : int -> t
    val compare : t * t -> order
    val asRecord : { wrap : a -> t, compare : t * t -> order }
  end


structure IntOrd :> TAGGED_ORD where type a = int =
  struct
    type t = int
    type a = int

    val wrap = Fn.id
    val compare = Int.compare
    val asRecord = { wrap = wrap, compare = compare }
  end


structure RevIntOrd :> TAGGED_ORD where type a = int =
  struct
    type t = int
    type a = int

    fun reverseOrd ord (a, b) =
     case ord (a, b) of
       LESS => GREATER
     | EQUAL => EQUAL
     | GREATER => LESS

    val wrap = Fn.id
    val compare = reverseOrd Int.compare
    val asRecord = { wrap = wrap, compare = compare }
  end


signature ORD_SET =
  sig
    type ('a, 'ord_t) set
    type ('a, 'ord_t) compare = {
      wrap : 'a -> 'ord_t,
      compare : 'ord_t * 'ord_t -> order
    }

    val empty : ('a, 'ord_t) compare -> ('a, 'ord_t) set
    val singleton : ('a, 'ord_t) compare -> 'a -> ('a, 'ord_t) set
    val toList : ('a, 'ord_t) set -> 'a list
    val insert : ('a, 'ord_t) set -> 'a -> ('a, 'ord_t) set
    val union : ('a, 'ord_t) set -> ('a, 'ord_t) set -> ('a, 'ord_t) set
  end


structure ListSet :> ORD_SET =
  struct
    type ('a, 'ord_t) set = {
      wrap : 'a -> 'ord_t,
      compare : 'ord_t * 'ord_t -> order,
      elems : 'a list
    }

    type ('a, 'ord_t) compare = {
      wrap : 'a -> 'ord_t,
      compare : 'ord_t * 'ord_t -> order
    }

    fun empty { wrap, compare } =
      {
        wrap = wrap,
        compare = compare,
        elems = []
      }

    fun singleton { wrap, compare } elem =
      {
        wrap = wrap,
        compare = compare,
        elems = [elem]
      }

    fun toList { wrap, compare, elems } =
      elems

    fun insert { wrap, compare, elems } elem =
      let
        fun loop elems =
          case elems of
            [] => [elem]
          | head :: tail =>
              case compare (wrap head, wrap elem) of
                LESS => head :: (loop tail)
              | EQUAL => elems
              | GREATER => elem :: elems
      in
        {
          wrap = wrap,
          compare = compare,
          elems = loop elems
        }
      end

    fun union set1 set2 =
      let
        val { wrap = wrap1, compare = compare1, elems = elems1 } = set1
        val { wrap = wrap2, compare = compare2, elems = elems2 } = set2
      in
        raise Fail "not implemented"
      end
  end