(* set-func.sml *)

(* Copyright (C) 2006 Alley Stoughton

   This file is part of crypto, a cryptogram encoder/decoder.  See the
   file COPYING.txt for copying and usage restrictions *)

(* SetFunc takes in a LIN_ORD structure LinOrd, and returns a
   structure with signature SET where type LinOrd.elem = LinOrd.elem
   whose LinOrd structure is LinOrd *)

functor SetFunc(structure LinOrd : LIN_ORD) :>
          SET where type LinOrd.elem = LinOrd.elem =
struct

structure LinOrd : LIN_ORD = LinOrd

type elem = LinOrd.elem

(* sets are sorted in strictly ascending order (without duplicates)
   according to LinOrd.compare *)

type set = LinOrd.elem list

(* memb(x, ys) tests whether x appears in ys, using LinOrd.compare to
   do the equality testing *)

fun memb(_, nil)     = false
  | memb(x, y :: ys) =
      case LinOrd.compare(x, y) of
           LESS    => false
         | EQUAL   => true
         | GREATER => memb(x, ys)

(* in recursive calls, the length of the second argument decreases *)

fun subset(nil,             _)       = true
  | subset(_,               nil)     = false
  | subset(x_xs as x :: xs, y :: ys) =
      case LinOrd.compare(x, y) of
           LESS    => false
         | EQUAL   => subset(xs, ys)
         | GREATER => subset(x_xs, ys)

(* in recursive calls, the lengths of both arguments decrease *)

fun equal(nil,     nil)     = true
  | equal(x :: xs, y :: ys) =
      LinOrd.compare(x, y) = EQUAL andalso equal(xs, ys)
  | equal(_,       _)       = false

(* insert : elem * set -> set

   insert(x, ys) returns the set whose elements are x plus the
   elements of ys *)

fun insert (x, nil)           = [x]
  | insert (x, zs as y :: ys) =
      case LinOrd.compare(x, y) of
           LESS    => x :: zs
         | EQUAL   => zs
         | GREATER => y :: insert(x, ys)

fun fromList nil       = nil
  | fromList (x :: xs) = insert(x, fromList xs)

fun toList xs = xs

fun size xs = length xs

(* in recursive calls, the sum of the lengths of the arguments decreases *)

fun union(nil,             ys)              = ys
  | union(xs,              nil)             = xs
  | union(x_xs as x :: xs, y_ys as y :: ys) =
      case LinOrd.compare(x, y) of
           LESS    => x :: union(xs, y_ys)
         | EQUAL   => x :: union(xs, ys)
         | GREATER => y :: union(x_xs, ys)

(* in recursive calls, the sum of the lengths of the arguments decreases *)

fun inter(nil,             _)               = nil
  | inter(_,               nil)             = nil
  | inter(x_xs as x :: xs, y_ys as y :: ys) =
      case LinOrd.compare(x, y) of
           LESS    => inter(xs, y_ys)
         | EQUAL   => x :: inter(xs, ys)
         | GREATER => inter(x_xs, ys)

(* in recursive calls, the sum of the lengths of the arguments decreases *)

fun minus(nil,             _)               = nil
  | minus(xs,              nil)             = xs
  | minus(x_xs as x :: xs, y_ys as y :: ys) =
      case LinOrd.compare(x, y) of
           LESS    => x :: minus(xs, y_ys)
         | EQUAL   => minus(xs, ys)
         | GREATER => minus(x_xs, ys)

end;