浏览代码

made test file tests

master
FelixBrendel 7 年前
父节点
当前提交
e607ac4fd5
共有 3 个文件被更改,包括 85 次插入0 次删除
  1. +2
    -0
      .projectile
  2. +2
    -0
      .rgignore
  3. +81
    -0
      bin/tests/class_macro.slime

+ 2
- 0
.projectile 查看文件

@@ -0,0 +1,2 @@
-/vs
-/build

+ 2
- 0
.rgignore 查看文件

@@ -0,0 +1,2 @@
/vs
/build

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

@@ -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)

正在加载...
取消
保存