(module class-utils mzscheme

  (require (lib "contract.ss")
           (lib "class.ss"))

  (define class-or-iface/c (or/c class? interface?))

  (define (subclass-or-implements/c class-or-iface)
    (cond
     [(class? class-or-iface) (subclass?/c class-or-iface)]
     [(interface? class-or-iface) (implementation?/c class-or-iface)]
     [else (error 'subclass-or-implements/c
                  "not a class or interface: ~s"
                  class-or-iface)]))

  (define (object/c . class-or-ifaces)
    (apply and/c object? (map is-a?/c class-or-ifaces)))

  (define (class/c . class-or-ifaces)
    (apply and/c class? (map subclass-or-implements/c class-or-ifaces)))

  (define-syntax (mixin/c stx)
    (syntax-case stx ()
      [(form (super-in ...)
             (other-in ...)
             (sub-out ...))
       (with-syntax ([(super-var ...)
                      (generate-temporaries (syntax (super-in ...)))]
                     [(other-var ...)
                      (generate-temporaries (syntax (other-in ...)))]
                     [(dummy ...)
                      (generate-temporaries (syntax (other-in ...)))]
                     [(sub-var ...)
                      (generate-temporaries (syntax (sub-out ...)))])
         (syntax/loc stx
           (let* ([super-var super-in] ...
                  [other-var other-in] ...
                  [sub-var sub-out] ...)
             (->d (class/c super-var ...)
                  other-var ...
                  (lambda (super dummy ...)
                    (class/c super sub-var ...))))))]))

  (define-syntax (send+ stx)
    (syntax-case stx ()
      [(s+ expr clause ...)
       (syntax/loc stx
         (let* ([obj expr])
           (send* obj clause ...)
           obj))]))

  (define-syntax (send-each stx)
    (syntax-case stx ()
      [(se objs-expr method arg-expr ...)
       (with-syntax ([(arg-var ...) (generate-temporaries #'(arg-expr ...))])
         (syntax/loc stx
           (let ([objs-var objs-expr]
                 [arg-var arg-expr]
                 ...)
             (for-each (lambda (obj)
                         (send obj method arg-var ...))
                       objs-var))))]))

  (define (ensure-iface iface<%> mx class%)
    (if (implementation? class% iface<%>)
        class%
        (mx class%)))

  (provide/contract
   [class-or-iface/c flat-contract?]
   [subclass-or-implements/c (class-or-iface/c . -> . flat-contract?)]
   [object/c ([] (listof class-or-iface/c) . ->* . [flat-contract?])]
   [class/c ([] (listof class-or-iface/c) . ->* . [flat-contract?])]
   [ensure-iface (([iface<%> interface?]
                   [mx (mixin/c [] [] [iface<%>])]
                   [class% class?])
                  . ->r . (class/c class% iface<%>))])

  (provide mixin/c send+ send-each))