structure Tree: TREE = struct
  datatype ('k, 'v) t = Node of 'k * 'v * ('k, 'v) t * ('k, 'v) t | Empty

  exception Exists

  val empty = Empty

  fun insert _ Empty k v = Node (k, v, Empty, Empty)
    | insert cmp (Node (k', v', left, right)) k v =
        case cmp k k' of
          LESS => Node (k', v', insert cmp left k v, right)
        | EQUAL => raise Exists
        | GREATER => Node (k', v', left, insert cmp right k v)

  fun lookup _ Empty _ = NONE
    | lookup cmp (Node (k', v', left, right)) k =
        case cmp k k' of
          LESS => lookup cmp left k
        | EQUAL => SOME v'
        | GREATER => lookup cmp right k

  datatype ('k, 'v) arc =
    Left of 'k * 'v * ('k, 'v) t |
    Right of 'k * 'v * ('k, 'v) t

  fun assemble n buf =
  let
    fun assemble' tree (Left (k, v, right) :: tail) =
      assemble' (Node (k, v, tree, right)) tail
      | assemble' tree (Right (k, v, left) :: tail) =
      assemble' (Node (k, v, left, tree)) tail
      | assemble' tree [] = tree
  in
    assemble' n buf
  end

  fun lookup' _ _ Empty _ _ g = (g, NONE)
    | lookup' buf cmp (Node (k', v', left, right)) k f g =
        case cmp k k' of
          LESS => lookup' (Left (k', v', right) :: buf) cmp left k f g
        | GREATER => lookup' (Right (k', v', left) :: buf) cmp right k f g
        | EQUAL =>
        let
          val (newV, result) = f v'
        in
          case newV of
               NONE => (result, NONE)
             | SOME v => (result, SOME (assemble (Node (k', v, left, right)) buf))
        end

  fun lookup2 cmp t k (f, g) =
  let
    val (result, newTree) = lookup' [] cmp t k f g
  in
    (result, case newTree of
         NONE => t
       | SOME t => t)
  end

  fun print t key2str value2str =
  let
    fun Pkey z = bindWith2str key2str z
    fun Pvalue z = bindWith2str value2str z

    fun print' off Empty = printf R off `"()\n" %
      | print' off (Node (k, v, left, right)) = (
        printf R off `"(" Pkey k `", " Pvalue v `"\n";
        print' (off + 1) left;
        print' (off + 1) right;
        printf R off `")\n" %
      )
  in
    print' 0 t
  end
end