slime/bin/oo.slime

(define-syntax (define-class name members :rest body)
  "Macro for creating classes."
  (define (underscore sym)
    (string->symbol (concat-strings "_" (symbol->string sym))))

  (define underscored-members (map underscore members))

  ;; the wrapping let environment
  (define let-body `(let ,(zip members underscored-members)))

  ;; the body
  (extend let-body body)
  ;; (map (lambda (fun) (append let-body fun)) body)

  ;; the dispatch function
  (append let-body `(set-type
                     (special-lambda
                      (message :rest args)
                      "This is the docs for the handle"
                      (eval (extend (list message) args))) ,(symbol->keyword name)))

  ;; stuff it all in the constructor function
  `(define
     ;; The function definition
     ,(pair (string->symbol (concat-strings "make-" (symbol->string name))) underscored-members)
     ;; The docstring
     ,(concat-strings "This is the handle to an object of the class " (symbol->string name))
     ;; the body
     ,let-body))