瀏覽代碼

Before Lisp_Object SSO

master
FelixBrendel 7 年之前
父節點
當前提交
9f2b25486c
共有 2 個檔案被更改,包括 7 行新增7 行删除
  1. +4
    -4
      bin/tests/class_macro.slime
  2. +3
    -3
      bin/tests/class_macro.slime.expanded

+ 4
- 4
bin/tests/class_macro.slime 查看文件

@@ -3,7 +3,7 @@
obj)

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

@@ -70,12 +70,12 @@
(- (* z (other get-x)) (* x (other get-z)))
(- (* x (other get-y)) (* y (other get-x)))))

(define (printout)
(printf "[vector3] (" x y z ")"))
(define (print)
(printf :sep "" "[vector3] (" x y z ")"))
)

(define v1 (make-vector3 1 2 3))
(define v2 (make-vector3 3 2 1))

(assert (= (type v1) (type v2) :vector3))
(assert (= (v1 scalar-product v2) 10))
(assert (= (type v1) :vector3))

+ 3
- 3
bin/tests/class_macro.slime.expanded 查看文件

@@ -1,12 +1,12 @@
(define (type-wrap obj type) (set-type obj type) obj)

(define (make-vector3 _x _y _z) "This is the handle to an object of the class vector3" (let ((x _x) (y _y) (z _z)) (define (get-x) x) (define (get-y) y) (define (get-z) z) (define (set-x new-x) (mutate x new-x)) (define (set-y new-y) (mutate y new-y)) (define (set-z new-z) (mutate z new-z)) (define (length) (** (+ (* x x) (* y y) (* z z)) 0.500000)) (define (scale fac) (mutate x (* fac x)) (mutate y (* fac y)) (mutate z (* fac z)) fac) (define (add other) (make-vector3 (+ x (other get-x)) (+ y (other get-y)) (+ z (other get-z)))) (define (subtract other) (make-vector3 (- x (other get-x)) (- y (other get-y)) (- z (other get-z)))) (define (scalar-product other) (+ (* x (other get-x)) (* y (other get-y)) (* z (other get-z)))) (define (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))))) (define (printout) (printf "[vector3] (" x y z ")")) (type-wrap (special-lambda (message :rest args) "This is the docs for the handle" (eval (extend (list message) args))) :vector3)))
(define (make-vector3 _x _y _z) "This is the handle to an object of the class vector3" (let ((x _x) (y _y) (z _z)) (define (get-x) x) (define (get-y) y) (define (get-z) z) (define (set-x new-x) (mutate x new-x)) (define (set-y new-y) (mutate y new-y)) (define (set-z new-z) (mutate z new-z)) (define (length) (** (+ (* x x) (* y y) (* z z)) 0.500000)) (define (scale fac) (mutate x (* fac x)) (mutate y (* fac y)) (mutate z (* fac z)) fac) (define (add other) (make-vector3 (+ x (other get-x)) (+ y (other get-y)) (+ z (other get-z)))) (define (subtract other) (make-vector3 (- x (other get-x)) (- y (other get-y)) (- z (other get-z)))) (define (scalar-product other) (+ (* x (other get-x)) (* y (other get-y)) (* z (other get-z)))) (define (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))))) (define (print) (printf :sep "" "[vector3] (" x y z ")")) (type-wrap (special-lambda (message :rest args) "This is the docs for the handle" (eval (extend (list message) args))) :vector3)))

(define v1 (make-vector3 1.000000 2.000000 3.000000))

(define v2 (make-vector3 3.000000 2.000000 1.000000))

(assert (= (v1 scalar-product v2) 10.000000))
(assert (= (type v1) (type v2) :vector3))

(assert (= (type v1) :vector3))
(assert (= (v1 scalar-product v2) 10.000000))


Loading…
取消
儲存