Skip to content

Instantly share code, notes, and snippets.

@igstan
Created April 8, 2017 03:06
Show Gist options
  • Save igstan/d2585427d4911cda667d42615fce6eda to your computer and use it in GitHub Desktop.
Save igstan/d2585427d4911cda667d42615fce6eda to your computer and use it in GitHub Desktop.
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