30 lines
1.0 KiB
Plaintext
30 lines
1.0 KiB
Plaintext
(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))
|