Skip to content

Instantly share code, notes, and snippets.

@igstan igstan/set.sml
Created Apr 8, 2017

Embed
What would you like to do?
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.