(module jclass mzscheme

  (require (prefix c: (lib "class.ss")))

  (define-syntax define-syntax*
    (syntax-rules ()
      ((_ name expr ...)
       (begin
	 (provide name)
	 (define-syntax name expr ...)))))

  (define-syntax* private-field
    (syntax-rules ()
      ((_ id) (private-field id #f))
      ((_ id expr)
       (define id expr))))

  (define-syntax* private-fields
    (syntax-rules ()
      ((_ id ...) (begin (private-field id) ...))))

  (define-syntax* inherit-field
    (syntax-rules ()
      ((_ id ...) (c:inherit-field id ...))))

  (define-syntax* public-field
    (syntax-rules ()
      ((_ id) (public-field id #f))
      ((_ id expr)
       (c:field (id expr)))))

  (define-syntax* public-fields
    (syntax-rules ()
      ((_ id ...) (begin (public-field id) ...))))

  (define-syntax* private-method
    (syntax-rules ()
      ((_ (id args ...) expr ...)
       (define (id args ...) expr ...))))

  (define-syntax* public-method
    (syntax-rules ()
      ((_ (id args ...) expr ...)
       (c:define/public (id args ...) expr ...))))

  (define-syntax* override-method
    (syntax-rules ()
      ((_ (id args ...) expr ...)
       (c:define/override (id args ...) expr ...))))

  (define-syntax (constructor* stx)
    (syntax-case stx (super-constructor)
      ((_ vars args (super-constructor super-args ...) expr ...)
       #'(begin
	   (apply (lambda args
		    (c:super-make-object super-args ...)
		    expr ...)
		  vars)))
      ((_ vars args expr ...)
       #'(_ vars args (super-constructor) expr ...))))

  (provide jinterface)
  (define-syntax (jinterface stx)
    (syntax-case stx (extends)
      ((_ extends (super ...) method ...)
       #'(c:interface (super ...) method ...))
      ((_ method ...)
       #'(_ extends () method ...))))

  (provide jclass)
  (define-syntax (jclass stx)
    (syntax-case stx (implements extends constructor)
		 ((_ (constructor c ...) body ...)
		  #'(_  extends c:object% implements () (constructor c ...)
			body ...))
		 ((_  extends <base> (constructor c ...)
		      body ...)
		  #'(_  extends <base> implements () (constructor c ...)
			body ...))
		 ((_  implements (<interface> ...) (constructor c ...)
		      body ...)
		  #'(_  extends c:object% implements (<interface> ...) (constructor c ...)
			body ...))
		 ((_  extends <base> implements (<interface> ...) (constructor c ...)
		      body ...)
		  #'(c:class* <base> (<interface> ...)
			    ;; (c:super-new)
			    ;; inspectors make get-class-from-object work
			    (c:inspect (make-inspector))
			    (init-rest rest)
			    body ...
			    (constructor* rest c ...)))))

  (define (get-class-from-object obj)
    (let-values (((a b) (c:object-info obj))) a))

  (define-syntax* set-field
     (syntax-rules ()
       ((_ id object expr)
	((c:class-field-mutator (get-class-from-object object) id)
	 object expr))))

  ;; rename all the identifiers imported from class with a prefix of `c:'
  (define-syntax (provide/rename:c stx)
    (define (append a: syn)
      (datum->syntax-object
	#'syn
	(string->symbol
	  (string-append
	    a:
	    (symbol->string
	      (syntax-object->datum syn))))))
    (syntax-case stx ()
      ((_ name ...)
       (with-syntax (((c:name ...)
		      (map (lambda (n)
			     (append "c:" n))
			   (syntax->list #'(name ...)))))
		    #'(provide (rename c:name name) ...)))))

  (provide/rename:c object=? super get-field
		    send is-a? object? class?
		    interface? class->interface
		    object-interface subclass?
		    implementation? interface-extension?
		    method-in-interface? interface->method-names
		    object-method-arity-includes?
		    field-names)

  (provide (rename c:make-object new)
	   (rename c:send ->))

  )