table.ss
(module table mzscheme

  (require "private/require.ss")
  (require-contracts)
  (require-lists)
  (require-etc)

  (require (lib "class.ss")
           "private/contracts.ss"
           "table/table-interface.ss"
           "table/unordered-table.ss"
           "table/ordered-table.ss"
           "table/hashed-table.ss")

  (define key-list/c (listof any/c))
  (define value-list/c (listof any/c))
  (define key-value-sexp/c (listof (list/c any/c any/c)))
  (define key-value-alist/c (listof (cons/c any/c any/c)))
  (define key-value-list/c
    (flat-rec-contract key-value-list
      empty?
      (cons/c any/c (cons/c any/c key-value-list))))

  (provide/contract
   ;; Type predicate
   [table? predicate/c]
   [table/c flat-contract?]
   ;; Constructors
   [make-ordered ([comparison/c] key-value-list/c . ->* . [table/c])]
   [make-hashed ([hash-fn/c equality/c] key-value-list/c . ->* . [table/c])]
   [make-unordered ([equality/c] key-value-list/c . ->* . [table/c])]
   [make-eq ([] key-value-list/c . ->* . [table/c])]
   [make-eqv ([] key-value-list/c . ->* . [table/c])]
   [make-equal ([] key-value-list/c . ->* . [table/c])]
   [sexp->ordered (comparison/c key-value-sexp/c . -> . table/c)]
   [sexp->hashed (hash-fn/c equality/c key-value-sexp/c . -> . table/c)]
   [sexp->unordered (equality/c key-value-sexp/c . -> . table/c)]
   [sexp->eq (key-value-sexp/c . -> . table/c)]
   [sexp->eqv (key-value-sexp/c . -> . table/c)]
   [sexp->equal (key-value-sexp/c . -> . table/c)]
   [alist->ordered (comparison/c key-value-alist/c . -> . table/c)]
   [alist->hashed (hash-fn/c equality/c key-value-alist/c . -> . table/c)]
   [alist->unordered (equality/c key-value-alist/c . -> . table/c)]
   [alist->eq (key-value-alist/c . -> . table/c)]
   [alist->eqv (key-value-alist/c . -> . table/c)]
   [alist->equal (key-value-alist/c . -> . table/c)]
   [lists->ordered (comparison/c key-list/c value-list/c . -> . table/c)]
   [lists->hashed (hash-fn/c equality/c key-list/c value-list/c . -> . table/c)]
   [lists->unordered (equality/c key-list/c value-list/c . -> . table/c)]
   [lists->eq (key-list/c value-list/c . -> . table/c)]
   [lists->eqv (key-list/c value-list/c . -> . table/c)]
   [lists->equal (key-list/c value-list/c . -> . table/c)]
   ;; Operations
   [keys (table/c . -> . (listof any/c))]
   [rename table-values values (table/c . -> . (listof any/c))]
   [to-sexp (table/c . -> . (listof (list/c any/c any/c)))]
   [to-alist (table/c . -> . (listof (cons/c any/c any/c)))]
   [rename table-empty? empty? (table/c . -> . boolean?)]
   [size (table/c . -> . natural-number/c)]
   [contains? (any/c table/c . -> . boolean?)]
   [lookup ([any/c table/c] [(-> any) (any/c . -> . any)] . opt-> . any)]
   [lookup/key
    ([any/c table/c] [(-> any) (any/c any/c . -> . any)] . opt-> . any)]
   [insert (any/c any/c table/c . -> . table/c)]
   [rename table-remove remove (any/c table/c . -> . table/c)]
   [update (any/c (any/c any/c . -> . any) table/c . -> . table/c)]
   [update/value (any/c (any/c . -> . any) table/c . -> . table/c)]
   [update/insert (any/c (any/c any/c . -> . any) any/c table/c . -> . table/c)]
   [update/insert/value (any/c (any/c . -> . any) any/c table/c . -> . table/c)]
   [select (table/c . -> . (values any/c any/c))]
   [select/key (table/c . -> . any)]
   [select/value (table/c . -> . any)]
   [clear (table/c . -> . table/c)]
   [rename table-fold fold
           ((any/c any/c any/c . -> . any) any/c table/c . -> . any)]
   [rename table-fold/key fold/key
           ((any/c any/c . -> . any) any/c table/c . -> . any)]
   [rename table-fold/value fold/value
           ((any/c any/c . -> . any) any/c table/c . -> . any)]
   [rename table-for-each for-each
           ((any/c any/c . -> . any) table/c . -> . void?)]
   [rename table-for-each/key for-each/key
           ((any/c . -> . any) table/c . -> . void?)]
   [rename table-for-each/value for-each/value
           ((any/c . -> . any) table/c . -> . void?)]
   [rename table-map map
           ((any/c any/c . -> . any) table/c . -> . table/c)]
   [rename table-map/key map/key
           ((any/c . -> . any) table/c . -> . table/c)]
   [rename table-map/value map/value
           ((any/c . -> . any) table/c . -> . table/c)]
   [rename table-filter filter
           ((any/c any/c . -> . boolean?) table/c . -> . table/c)]
   [rename table-filter/key filter/key
           ((any/c . -> . boolean?) table/c . -> . table/c)]
   [rename table-filter/value filter/value
           ((any/c . -> . boolean?) table/c . -> . table/c)]
   [all? ((any/c any/c . -> . boolean?) table/c . -> . boolean?)]
   [all?/key ((any/c . -> . boolean?) table/c . -> . boolean?)]
   [all?/value ((any/c . -> . boolean?) table/c . -> . boolean?)]
   [rename table-andmap andmap
           ((any/c any/c . -> . boolean?) table/c . -> . boolean?)]
   [rename table-andmap/key andmap/key
           ((any/c . -> . boolean?) table/c . -> . boolean?)]
   [rename table-andmap/value andmap/value
           ((any/c . -> . boolean?) table/c . -> . boolean?)]
   [any? ((any/c any/c . -> . boolean?) table/c . -> . boolean?)]
   [any?/key ((any/c . -> . boolean?) table/c . -> . boolean?)]
   [any?/value ((any/c . -> . boolean?) table/c . -> . boolean?)]
   [rename table-ormap ormap
           ((any/c any/c . -> . boolean?) table/c . -> . boolean?)]
   [rename table-ormap/key ormap/key
           ((any/c . -> . boolean?) table/c . -> . boolean?)]
   [rename table-ormap/value ormap/value
           ((any/c . -> . boolean?) table/c . -> . boolean?)]
   [union
    ([table/c table/c] [(any/c any/c any/c . -> . any/c)] . opt-> . table/c)]
   [union/value
    ([table/c table/c] [(any/c any/c . -> . any/c)] . opt-> . table/c)]
   [intersection
    ([table/c table/c] [(any/c any/c any/c . -> . any/c)] . opt-> . table/c)]
   [intersection/value
    ([table/c table/c] [(any/c any/c . -> . any/c)] . opt-> . table/c)]
   [difference (table/c table/c . -> . table/c)]
   )

  ;; get-keys : (list Key Value ...) -> (Listof Key)
  ;; Produces the keys out of a list of alternating key/value pairs.
  (define (get-keys kvs)
    (if (null? kvs)
        null
        (cons (first kvs) (get-keys (rest (rest kvs))))))

  ;; get-values : (list Key Value ...) -> (Listof Value)
  ;; Produces the values out of a list of alternating key/value pairs.
  (define (get-values kvs)
    (if (null? kvs)
        null
        (cons (second kvs) (get-values (rest (rest kvs))))))

  ;; An (OrderedConstructor ARG ...) is:
  ;; (Key Key -> (Union -1 0 1)) ARG ... -> (Table Key Value)

  ;; lists->ordered : (OrderedConstructor (Listof Key) (Listof Value))
  ;; sexp->ordered : (OrderedConstructor (Listof (list Key Value)))
  ;; alist->ordered : (OrderedConstructor (Listof (cons Key Value)))
  ;; make-ordered : (OrderedConstructor Key Value ...)
  ;; Constructs a set with ordered keys.
  (define lists->ordered make-ordered-table)
  (define (sexp->ordered compare sexp)
    (lists->ordered compare (map first sexp) (map second sexp)))
  (define (alist->ordered compare alist)
    (lists->ordered compare (map car alist) (map cdr alist)))
  (define (make-ordered compare . kvs)
    (lists->ordered compare (get-keys kvs) (get-values kvs)))

  ;; An (UnorderedConstructor ARG ...) is:
  ;; (Key Key -> Boolean) ARG ... -> (Table Key Value)

  ;; lists->unordered : (UnorderedConstructor (Listof Key) (Listof Value))
  ;; sexp->unordered : (UnorderedConstructor (Listof (list Key Value)))
  ;; alist->unordered : (UnorderedConstructor (Listof (cons Key Value)))
  ;; make-unordered : (UnorderedConstructor Key Value ...)
  ;; Constructs a set with distinct keys.
  (define lists->unordered make-unordered-table)
  (define (sexp->unordered equ? sexp)
    (lists->unordered equ? (map first sexp) (map second sexp)))
  (define (alist->unordered equ? alist)
    (lists->unordered equ? (map car alist) (map cdr alist)))
  (define (make-unordered equ? . kvs)
    (lists->unordered equ? (get-keys kvs) (get-values kvs)))

  ;; A (HashedConstructor ARG ...) is:
  ;; (Key -> Integer) (Key Key -> Boolean) ARG ... -> (Table Key Value)

  ;; lists->hashed : (HashedConstructor (Listof Key) (Listof Value))
  ;; sexp->hashed : (HashedConstructor (Listof (list Key Value)))
  ;; alist->hashed : (HashedConstructor (Listof (cons Key Value)))
  ;; make-hashed : (HashedConstructor Key Value ...)
  ;; Constructs a set with hashed keys.
  (define lists->hashed make-hashed-table)
  (define (sexp->hashed hash equ? sexp)
    (lists->hashed hash equ? (map first sexp) (map second sexp)))
  (define (alist->hashed hash equ? alist)
    (lists->hashed hash equ? (map car alist) (map cdr alist)))
  (define (make-hashed hash equ? . kvs)
    (lists->hashed hash equ? (get-keys kvs) (get-values kvs)))

  ;; lists->eq : (List Key) (List Value) -> (Table Key Value)
  ;; sexp->eq : (List (list Key Value)) -> (Table Key Value)
  ;; alist->eq : (List (cons Key Value)) -> (Table Key Value)
  ;; make-eq : Key Value ... -> (Table Key Value)
  ;; Constructs a table with keys distinguished by eq?
  (define lists->eq (curry lists->hashed eq-hash-code eq?))
  (define sexp->eq (curry sexp->hashed eq-hash-code eq?))
  (define alist->eq (curry alist->hashed eq-hash-code eq?))
  (define (make-eq . kvs)
    (lists->eq (get-keys kvs) (get-values kvs)))

  ;; lists->eqv : (List Key) (List Value) -> (Table Key Value)
  ;; sexp->eqv : (List (list Key Value)) -> (Table Key Value)
  ;; alist->eqv : (List (cons Key Value)) -> (Table Key Value)
  ;; make-eqv : Key Value ... -> (Table Key Value)
  ;; Constructs a table with keys distinguished by eqv?
  (define lists->eqv (curry lists->unordered eqv?))
  (define sexp->eqv (curry sexp->unordered eqv?))
  (define alist->eqv (curry alist->unordered eqv?))
  (define (make-eqv . kvs)
    (lists->eqv (get-keys kvs) (get-values kvs)))

  ;; lists->equal : (List Key) (List Value) -> (Table Key Value)
  ;; sexp->equal : (List (list Key Value)) -> (Table Key Value)
  ;; alist->equal : (List (cons Key Value)) -> (Table Key Value)
  ;; make-equal : Key Value ... -> (Table Key Value)
  ;; Constructs a table with keys distinguished by equal?
  (define lists->equal (curry lists->hashed equal-hash-code equal?))
  (define sexp->equal (curry sexp->hashed equal-hash-code equal?))
  (define alist->equal (curry alist->hashed equal-hash-code equal?))
  (define (make-equal . kvs)
    (lists->equal (get-keys kvs) (get-values kvs)))

  ;; to-sexp : (Table Key Value) -> (List (list Key Value))
  ;; Constructs a list of all bindings in the table.
  (define (to-sexp table)
    (send table sexp))

  ;; to-alist : (Table Key Value) -> (List (cons Key Value))
  ;; Constructs an association list from the bindings in the table.
  (define (to-alist table)
    (send table alist))

  ;; keys : (Table Key Value) -> (List Key)
  ;; Produces the keys in the table.
  (define (keys table)
    (send table keys))

  ;; table-values : (Table Key Value) -> (List Value)
  ;; Produces the values in the table.
  (define (table-values table)
    (send table values))

  ;; insert : Key Value (Table Key Value) -> (Table Key Value)
  ;; Inserts a new binding into a table.
  (define (insert key value table)
    (send table insert key value))

  ;; lookup : Key (Table Key Value) [(-> T) (Value -> T)] -> T
  ;; Looks up the binding for a key in a table.
  ;; If found, applies the success function (defaults to identity).
  ;; If not found, applies the failure thunk (defaults to return #f).
  (define (lookup key table . rest)
    (send table lookup key . rest))

  ;; lookup/key : Key (Table Key Value) [(-> T) (Key Value -> T)] -> T
  ;; Looks up the binding for a key in a table.
  ;; If found, applies the success function (defaults to return the key).
  ;; If not found, applies the failure thunk (defaults to return #f).
  (define (lookup/key key table . rest)
    (send table lookup/key key . rest))

  ;; table-remove : Key (Table Key Value) -> (Table Key Value)
  ;; Produces an updated table that does not contain the given key.
  (define (table-remove key table)
    (send table remove key))

  ;; update : Key (Key Value -> Value) (Table Key Value) -> (Table Key Value)
  ;; Modifies the binding for the given key, if any.
  ;; Otherwise, returns the given table.
  (define (update key transform table)
    (send table update key transform))

  ;; update/value : Key (Value -> Value) (Table Key Value) -> (Table Key Value)
  ;; Modifies the binding for the given key, if any.
  ;; Otherwise, returns the given table.
  (define (update/value key transform table)
    (send table update/value key transform))

  ;; update/insert :
  ;; Key (Key Value -> Value) Value (Table Key Value) -> (Table Key Value)
  ;; Modifies the binding for the given key, if any.
  ;; Otherwise, binds the key to the given value.
  (define (update/insert key transform value table)
    (send table update/insert key transform value))

  ;; update/insert/value :
  ;; Key (Value -> Value) Value (Table Key Value) -> (Table Key Value)
  ;; Modifies the binding for the given key, if any.
  ;; Otherwise, binds the key to the given value.
  (define (update/insert/value key transform value table)
    (send table update/insert/value key transform value))

  ;; select : (Table Key Value) -> (values Key Value)
  ;; Produces a binding from a non-empty table.
  (define (select table)
    (send table select))

  ;; select/key : (Table Key Value) -> Key
  ;; Produces a key from a non-empty table.
  (define (select/key table)
    (send table select/key))

  ;; select/value : (Table Key Value) -> Value
  ;; Produces a value from a non-empty table.
  (define (select/value table)
    (send table select/value))

  ;; table-empty? : (Table Key Value) -> Boolean
  ;; Reports whether the table is empty.
  (define (table-empty? table)
    (send table empty?))

  ;; clear : (Table Key Value) -> (Table Key Value)
  ;; Produces an empty table with the same properties as the input.
  (define (clear table)
    (send table clear))

  ;; size : (Table Key Value) -> NaturalNumber
  ;; Produces the number of bindings in the table.
  (define (size table)
    (send table size))

  ;; contains? : Key (Table Key Value) -> Boolean
  ;; Reports whether the table contains the given key.
  (define (contains? key table)
    (send table contains? key))

  ;; table-fold : (Key Value T -> T) T (Table Key Value) -> T
  ;; Builds a result from each binding in the table.
  (define (table-fold combine init table)
    (send table fold combine init))

  ;; table-fold/key : (Key T -> T) T (Table Key Value) -> T
  ;; Builds a result from each key in the table.
  (define (table-fold/key combine init table)
    (send table fold/key combine init))

  ;; table-fold/value : (Value T -> T) T (Table Key Value) -> T
  ;; Builds a result from each value in the table.
  (define (table-fold/value combine init table)
    (send table fold/value combine init))

  ;; table-for-each : (Key Value -> Void) (Table Key Value) -> Void
  ;; Performs an action for each binding in the table.
  (define (table-for-each action table)
    (send table for-each action))

  ;; table-for-each/key : (Key -> Void) (Table Key Value) -> Void
  ;; Performs an action for each key in the table.
  (define (table-for-each/key action table)
    (send table for-each/key action))

  ;; table-for-each/value : (Value -> Void) (Table Key Value) -> Void
  ;; Performs an action for each value in the table.
  (define (table-for-each/value action table)
    (send table for-each/value action))

  ;; table-map : (Key A -> B) (Table Key A) -> (Table Key B)
  ;; Replaces each value in the table based on the previous binding.
  (define (table-map transform table)
    (send table map transform))

  ;; table-map/key : (Key -> B) (Table Key A) -> (Table Key B)
  ;; Replaces each value in the table based on the previous key.
  (define (table-map/key transform table)
    (send table map/key transform))

  ;; table-map/value : (A -> B) (Table Key A) -> (Table Key B)
  ;; Replaces each value in the table based on the previous value.
  (define (table-map/value transform table)
    (send table map/value transform))

  ;; table-filter : (Key Value -> Boolean) (Table Key Value) -> (Table Key Value)
  ;; Retains those bindings which satisfy the predicate.
  (define (table-filter predicate table)
    (send table filter predicate))

  ;; table-filter/key : (Key -> Boolean) (Table Key Value) -> (Table Key Value)
  ;; Retains those bindings whose keys satisfy the predicate.
  (define (table-filter/key predicate table)
    (send table filter/key predicate))

  ;; table-filter/value : (Value -> Boolean) (Table Key Value) -> (Table Key Value)
  ;; Retains those bindings whose values satisfy the predicate.
  (define (table-filter/value predicate table)
    (send table filter/value predicate))

  ;; all? : (Key Value -> Boolean) (Table Key Value) -> Boolean
  ;; Reports whether all bindings in the table satisfy the predicate.
  (define (all? predicate table)
    (send table all? predicate))
  (define table-andmap all?)

  ;; all?/key : (Key -> Boolean) (Table Key Value) -> Boolean
  ;; Reports whether all keys in the table satisfy the predicate.
  (define (all?/key predicate table)
    (send table all?/key predicate))
  (define table-andmap/key all?/key)

  ;; all?/value : (Value -> Boolean) (Table Key Value) -> Boolean
  ;; Reports whether all values in the table satisfy the predicate.
  (define (all?/value predicate table)
    (send table all?/value predicate))
  (define table-andmap/value all?/value)

  ;; any? : (Key Value -> Boolean) (Table Key Value) -> Boolean
  ;; Reports whether any bindings in the table satisfy the predicate.
  (define (any? predicate table)
    (send table any? predicate))
  (define table-ormap any?)

  ;; any?/key : (Key -> Boolean) (Table Key Value) -> Boolean
  ;; Reports whether any keys in the table satisfy the predicate.
  (define (any?/key predicate table)
    (send table any?/key predicate))
  (define table-ormap/key any?/key)

  ;; any?/value : (Value -> Boolean) (Table Key Value) -> Boolean
  ;; Reports whether any values in the table satisfy the predicate.
  (define (any?/value predicate table)
    (send table any?/value predicate))
  (define table-ormap/value any?/value)

  ;; union :
  ;; (Table Key Value) (Table Key Value) [(Key Value Value -> Value)]
  ;; -> (Table Key Value)
  ;; Produces a table containing all bindings from either argument.
  ;; Resolves duplicate bindings with the given function, defaulting to
  ;; choosing one value or the other.
  (define (union one two . rest)
    (send one union two . rest))

  ;; union/value :
  ;; (Table Key Value) (Table Key Value) [(Value Value -> Value)]
  ;; -> (Table Key Value)
  ;; Produces a table containing all bindings from either argument.
  ;; Resolves duplicate bindings with the given function, defaulting to
  ;; choosing one value or the other.
  (define (union/value one two . rest)
    (send one union/value two . rest))

  ;; intersection :
  ;; (Table Key Value) (Table Key Value) [(Key Value Value -> Value)]
  ;; -> (Table Key Value)
  ;; Produces a table containing all bindings from both arguments.
  ;; Resolves duplicate bindings with the given function, defaulting to
  ;; choosing one value or the other.
  (define (intersection one two . rest)
    (send one intersection two . rest))

  ;; intersection/value :
  ;; (Table Key Value) (Table Key Value) [(Value Value -> Value)]
  ;; -> (Table Key Value)
  ;; Produces a table containing all bindings from both arguments.
  ;; Resolves duplicate bindings with the given function, defaulting to
  ;; choosing one value or the other.
  (define (intersection/value one two . rest)
    (send one intersection/value two . rest))

  ;; difference : (Table Key Value) (Table Key Value) -> (Table Key Value)
  ;; Produces a table containing all bindings from the first argument that are
  ;; not present in the second.
  (define (difference one two)
    (send one difference two))

  )