functor mkEq (eqtype t) : EQ = struct type t = t val equal = Fn.equal end structure IntEq = mkEq(type t = int) structure BoolEq = mkEq(type t = bool) structure StringEq = mkEq(type t = string) structure IntListEq = mkEq(type t = int list) structure IntTreeEq = mkEq(type t = int Tree.tree) structure IntOrd : ORD = struct type t = int val cmp = Int.compare end structure stringOrd : ORD = struct type t = string val cmp = String.compare end functor cmpEqual (K : ORD):EQ = struct type t = K.t fun equal x y = K.cmp(x,y) = EQUAL end functor Fst ( structure T1 : ORD type t2 ) : ORD = struct type t = T1.t * t2 val fst : t -> T1.t = fn (a,b) => a val fstPair = fn (P1,P2) => (fst P1,fst P2) val cmp = T1.cmp o fstPair end functor Snd ( type t1 structure T2 : ORD ) : ORD = struct type t = t1 * T2.t val snd : t -> T2.t = fn (a,b) => b val sndPair = fn (P1,P2) => (snd P1,snd P2) val cmp = T2.cmp o sndPair end functor Lex ( structure T1 : ORD structure T2 : ORD ) : ORD = struct type t = T1.t * T2.t fun cmp ((x1,x2),(y1,y2)) = case T1.cmp(x1,y1) of EQUAL => T2.cmp(x2,y2) | O => O end functor ListSet (Elt : EQ):>SET where type Elt.t = Elt.t = struct structure Elt = Elt (* INVARIANT: S : Set contains no duplicates * (according to Elt.equal) *) type Set = Elt.t list val empty = [] fun lookup [] y = NONE | lookup (x::xs) y = if (Elt.equal x y) then SOME(x) else lookup xs y exception ExistingElt fun insert (y,S) = case lookup S y of NONE => y::S | (SOME _) => raise ExistingElt fun remove (y,L) = List.filter (not o (Elt.equal y)) L fun overwrite (y,S) = y::remove(y,S) val union = List.foldr insert fun toString toStr S = "{" ^ (String.concatWith "," (map toStr S)) ^ "}" end functor OrdListSet (EltOrd : ORD):> SET where type Elt.t = EltOrd.t= struct structure Elt = cmpEqual(EltOrd) (* INVARIANT: S : Set contains no duplicates * (according to Elt.equal) and is sorted * (according to EltOrd.cmp) *) type Set = Elt.t list val empty = [] fun lookup [] y = NONE | lookup (x::xs) y = case EltOrd.cmp(y,x) of LESS => NONE | EQUAL => SOME(x) | GREATER => lookup xs y exception ExistingElt fun insert (y,[]) = [y] | insert (y,(x::xs)) = case EltOrd.cmp(y,x) of LESS => y::x::xs | EQUAL => raise ExistingElt | GREATER => x::insert(y,xs) fun overwrite (y,[]) = [y] | overwrite (y,(x::xs)) = case EltOrd.cmp(y,x) of LESS => y::x::xs | EQUAL => y::xs | GREATER => x::overwrite(y,xs) fun remove (y,[]) = [] | remove (y,(x::xs)) = case EltOrd.cmp(y,x) of LESS => x::xs | EQUAL => xs | GREATER => x::remove(y,xs) val union = List.foldr insert fun toString toStr S = "{" ^ (String.concatWith "," (map toStr S)) ^ "}" end functor OrdTreeSet (EltOrd : ORD):> SET where type Elt.t = EltOrd.t = struct structure Elt = cmpEqual(EltOrd) (* INVARIANT: S : Set contains no duplicates * (according to Elt.equal) and is sorted * (according to EltOrd.cmp) *) type Set = Elt.t Tree.tree open Tree val empty = Empty fun lookup Empty y = NONE | lookup (Node(L,x,R)) y = case EltOrd.cmp(y,x) of LESS => lookup L y | EQUAL => SOME(x) | GREATER => lookup R y fun singleton x = Node(Empty,x,Empty) exception ExistingElt fun insert (y,Empty) = singleton y | insert (y,Node(L,x,R)) = case EltOrd.cmp(y,x) of LESS => Node(insert(y,L),x,R) | EQUAL => raise ExistingElt | GREATER => Node(L,x,insert(y,R)) fun overwrite (y,Empty) = singleton y | overwrite (y,Node(L,x,R)) = case EltOrd.cmp(y,x) of LESS => Node(overwrite(y,L),x,R) | EQUAL => Node(L,y,R) | GREATER => Node(L,x,overwrite(y,R)) fun splitAt y Empty = (Empty,Empty) | splitAt y (Node(L,x,R)) = case EltOrd.cmp(y,x) of LESS => let val (t1,t2) = splitAt y L in (t1,Node(t2,x,R)) end | EQUAL => (L,R) | _ => let val (t1,t2) = splitAt y R in (Node(L,x,t1),t2) end fun union Empty S2 = S2 | union S1 Empty = S1 | union (Node(L1,x1,R1)) S2 = let val (L2,R2) = splitAt x1 S2 in Node(union L1 L2,x1,union R1 R2) end fun remove (y,Empty) = Empty | remove (y,Node(L,x,R)) = case EltOrd.cmp(y,x) of LESS => Node(remove(y,L),x,R) | EQUAL => union L R | GREATER => Node(L,x,remove(y,R)) fun toString toStr S = "{" ^ (String.concatWith "," (map toStr (inord S))) ^ "}" end