felix/slime
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

auto doc generation

Browse Source
This commit is contained in:
Felix Brendel
2019-06-11 01:17:36 +02:00
parent d01269aa13
commit 6f5ecc87b0
22 changed files with 2375 additions and 229 deletions
Download Patch File Download Diff File Expand all files Collapse all files
bin/tests/class_macro.slime
+21 -17
View File
@@ -1,10 +1,6 @@
(import "oo.slime")
(define-class (vector3 x y 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))
@@ -20,26 +16,31 @@
(define (add other)
(make-vector3
(+ x (other 'get-x))
(+ y (other 'get-y))
(+ z (other 'get-z))))
(+ (-> other x) x)
(+ (-> other y) y)
(+ (-> other z) z)))
(define (subtract other)
(make-vector3
(- x (other 'get-x))
(- y (other 'get-y))
(- z (other 'get-z))))
(- (-> other x) x)
(- (-> other y) y)
(- (-> other z) z)))
(define (equal? other)
(and (= (-> other x) x)
(= (-> other y) y)
(= (-> other z) z)))
(define (scalar-product other)
(+ (* x (other 'get-x))
(* y (other 'get-y))
(* z (other 'get-z))))
(+ (* (-> other x) x)
(* (-> other y) y)
(* (-> other z) 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)))))
(- (* (-> other z) y) (* (-> other y) z))
(- (* (-> other x) z) (* (-> other z) x))
(- (* (-> other y) x) (* (-> other x) y))))
(define (print)
(printf :sep " " "[vector3] (" x y z ")"))
@@ -49,4 +50,7 @@
(define v2 (make-vector3 3 2 1))
(assert (= (type v1) (type v2) :vector3))
;; (assert (= (v1 'scalar-product v2) 10))
(assert (= (v1 'scalar-product v2) 10))
(assert (-> (-> v1 cross-product v2)
equal?
(make-vector3 -4 8 -4)))
bin/tests/class_macro.slime.expanded
+5 -1
View File
@@ -1,6 +1,6 @@
(import "oo.slime")
(define-class (vector3 x y 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 ")")))
(define-class (vector3 x y 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 (+ (-> other x) x) (+ (-> other y) y) (+ (-> other z) z))) (define (subtract other) (make-vector3 (- (-> other x) x) (- (-> other y) y) (- (-> other z) z))) (define (equal? other) (and (= (-> other x) x) (= (-> other y) y) (= (-> other z) z))) (define (scalar-product other) (+ (* (-> other x) x) (* (-> other y) y) (* (-> other z) z))) (define (cross-product other) (make-vector3 (- (* (-> other z) y) (* (-> other y) z)) (- (* (-> other x) z) (* (-> other z) x)) (- (* (-> other y) x) (* (-> other x) y)))) (define (print) (printf :sep " " "[vector3] (" x y z ")")))
(define v1 (make-vector3 1 2 3))
@@ -8,3 +8,7 @@
(assert (= (type v1) (type v2) :vector3))
(assert (= (v1 'scalar-product v2) 10))
(assert (-> (-> v1 cross-product v2) equal? (make-vector3 -4 8 -4)))