(module contracts mzscheme

  (require (lib "contract.ss")
           (lib "etc.ss")
           (lib "list.ss")
           (lib "67.ss" "srfi"))

  ;; equality/c : Contract
  ;; This contract recognizes equality predicates.
  (define equality/c (any/c any/c . -> . boolean?))

  ;; hash-fn/c : Contract
  ;; This contract recognizes hash functions.
  (define hash-fn/c (any/c . -> . integer?))

  ;; comparison/c : Contract
  ;; This contract recognizes comparison procedures as used by SRFI 67.
  (define comparison/c (any/c any/c . -> . (integer-in -1 1)))

  ;; listof-unique/c : Equality -> FlatContract
  ;; Produces a flat contract that recognizes lists whose elements are
  ;; unique with respect to the given equality predicate.
  (define (listof-unique/c equ?)
    (flat-named-contract "list of unique elements"
      (lambda (elems)
        (recur scan ([elems elems])
          (if (null? elems)
              #t
              (let* ([elem (car elems)]
                     [rest (cdr elems)])
                (and (andmap (lambda (other) (not (equ? elem other))) rest)
                     (scan rest))))))))

  ;; listof-unique-compare/c : Comparison -> FlatContract
  ;; Produces a flat contract that recognizes lists whose elements are
  ;; unique with respect to the given comparison procedure.
  (define (listof-unique-compare/c cmp)
    (flat-named-contract "list of unique elements"
      (lambda (elems)
        (apply chain<? cmp (sort elems (<? cmp))))))

  (provide/contract
   [equality/c contract?]
   [hash-fn/c contract?]
   [comparison/c contract?]
   [listof-unique/c (equality/c . -> . flat-contract?)]
   [listof-unique-compare/c (comparison/c . -> . flat-contract?)])

  )