(define-syntax defclass (name members :rest body) "Macro for creatating classes." (defun underscore (sym) (string->symbol (concat-strings "_" (symbol->string sym)))) (define underscored-members (map underscore members)) ;; the wrapping let environment (define let-body (list 'let (zip members underscored-members))) ;; the body (map (lambda (fun) (append let-body fun)) body) ;; the dispatch function (append let-body (list 'special-lambda '(message :rest args) "This is the docs for the handle" '(eval (extend (list message) args)))) ;; stuff it all in the constructor function (eval (list 'defun (string->symbol (concat-strings "make-" (symbol->string name))) underscored-members "This is the handle to an object of the class " let-body))) ;; (v1 print) ;; (v1 length) ;; (v1 get-x) ;; (v1 set-x 10) (defclass vector3 (x y z) (defun get-x () x) (defun get-y () y) (defun get-z () z) (defun set-x (new-x) (mutate x new-x)) (defun set-y (new-y) (mutate y new-y)) (defun set-z (new-z) (mutate z new-z)) (defun length () (** (+ (* x x) (* y y) (* z z)) 0.5)) (defun scale (fac) (mutate x (* fac x)) (mutate y (* fac y)) (mutate z (* fac z)) fac) (defun add (other) (make-vector3 (+ x (other get-x)) (+ y (other get-y)) (+ z (other get-z)))) (defun subtract (other) (make-vector3 (- x (other get-x)) (- y (other get-y)) (- z (other get-z)))) (defun scalar-product (other) (+ (* x (other get-x)) (* y (other get-y)) (* z (other get-z)))) (defun cross-product (other) (make-vector3 (- (* y (other get-z)) (* z (other get-y))) (- (* z (other get-x)) (* x (other get-z))) (- (* x (other get-y)) (* y (other get-x))))) (defun printout () (printf "[vector3] (" x y z ")")) ) (define v1 (make-vector3 1 2 3)) (define v2 (make-vector3 3 2 1))