made test file tests

This commit is contained in:
FelixBrendel
2019-03-02 22:41:09 +01:00
parent c04c2c62a0
commit e607ac4fd5
3 changed files with 85 additions and 0 deletions
+2
View File
@@ -0,0 +1,2 @@
-/vs
-/build
+2
View File
@@ -0,0 +1,2 @@
/vs
/build
+81
View File
@@ -0,0 +1,81 @@
(defun type-wrap (obj type)
(set-type obj type)
obj)
(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 '(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))
(v1 scalar-product v2)