Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge branch 'master' of git+ssh://git.cyrusharmon.org/pub/git/clem

  • Loading branch information...
commit b59cbfcf9e358654fbf063049f750c9658dc3983 2 parents be59c58 + 2288b47
Cyrus Harmon authored
6 clem-benchmark.asd
View
@@ -5,10 +5,8 @@
(defsystem :clem-benchmark
:name "clem-benchmark"
:author "Cyrus Harmon <ch-lisp@bobobeach.com>"
- :version #.(with-open-file
- (vers (merge-pathnames "version.lisp-expr" *load-truename*))
- (read vers))
- :depends-on (ch-util clem)
+ :version "0.4.8"
+ :depends-on (clem)
:components
((:module :benchmark
:components
4 clem-doc.asd
View
@@ -10,9 +10,7 @@
(defsystem :clem-doc
:name "clem-doc"
:author "Cyrus Harmon"
- :version #.(with-open-file
- (vers (merge-pathnames "version.lisp-expr" *load-truename*))
- (read vers))
+ :version "0.4.8"
:licence "BSD"
:depends-on (ch-asdf ch-bib ch-util clem smarkup)
:components
23 clem-test.asd
View
@@ -2,20 +2,19 @@
(asdf:defsystem :clem-test
:name "clem-test"
:author "Cyrus Harmon <ch-lisp@bobobeach.com>"
- :version #.(with-open-file
- (vers (merge-pathnames "version.lisp-expr" *load-truename*))
- (read vers))
- :depends-on (ch-util clem)
+ :version "0.4.8"
+ :depends-on (clem)
:components
((:module :test
:components
((:cl-source-file "defpackage")
- (:cl-source-file "test-clem" :depends-on ("defpackage"))
- (:cl-source-file "test-clem2" :depends-on ("defpackage"))
- (:cl-source-file "test-clem3" :depends-on ("defpackage"))
- (:cl-source-file "test-defmatrix" :depends-on ("defpackage"))
- (:cl-source-file "test-transform" :depends-on ("defpackage"))
- (:cl-source-file "test-convolve" :depends-on ("defpackage"))
- (:cl-source-file "bench-matrix" :depends-on ("defpackage"))
- (:cl-source-file "test-hprod" :depends-on ("defpackage"))))))
+ (:cl-source-file "testharness" :depends-on ("defpackage"))
+ (:cl-source-file "test-clem" :depends-on ("defpackage" "testharness"))
+ (:cl-source-file "test-clem2" :depends-on ("defpackage" "testharness"))
+ (:cl-source-file "test-clem3" :depends-on ("defpackage" "testharness"))
+ (:cl-source-file "test-defmatrix" :depends-on ("defpackage" "testharness"))
+ (:cl-source-file "test-transform" :depends-on ("defpackage" "testharness"))
+ (:cl-source-file "test-convolve" :depends-on ("defpackage" "testharness"))
+ (:cl-source-file "bench-matrix" :depends-on ("defpackage" "testharness"))
+ (:cl-source-file "test-hprod" :depends-on ("defpackage" "testharness"))))))
11 clem.asd
View
@@ -2,17 +2,14 @@
(asdf:defsystem :clem
:name "clem"
:author "Cyrus Harmon <ch-lisp@bobobeach.com>"
- :version #.(with-open-file
- (vers (merge-pathnames "version.lisp-expr" *load-truename*))
- (read vers))
+ :version "0.4.8"
:licence "BSD"
- :depends-on (ch-util)
:components
- ((:static-file "version" :pathname #p"version.lisp-expr")
- (:module
+ ((:module
:src
:components
((:cl-source-file "defpackage")
+ (:cl-source-file "utilities" :depends-on ("defpackage"))
(:cl-source-file "metaclasses" :depends-on ("defpackage"))
(:cl-source-file "early-matrix" :depends-on ("defpackage" "metaclasses"))
(:cl-source-file "mref" :depends-on ("early-matrix"))
@@ -21,7 +18,7 @@
"metaclasses"
"mref"
"macros"))
- (:cl-source-file "matrix" :depends-on ("matrix-classes"))
+ (:cl-source-file "matrix" :depends-on ("matrix-classes" "utilities"))
(:cl-source-file "print" :depends-on ("matrix"))
(:cl-source-file "typed-matrix" :depends-on ("defpackage" "matrix"))
(:cl-source-file "mloop" :depends-on ("defpackage" "matrix"))
12 src/abs.lisp
View
@@ -41,7 +41,7 @@
(let ((element-type-1 (element-type (find-class `,type-1)))
(accumulator-element-type (element-type (find-class `,accumulator-type))))
`(progn
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-abs-range" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mat-abs-range" suffix))
((m ,type-1) startr endr startc endc)
(destructuring-bind (mr mc) (dim m)
(let ((p (make-instance ',accumulator-type :rows mr :cols mc)))
@@ -57,16 +57,16 @@
(abs (aref a i j)))))))
p)))
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-abs" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mat-abs" suffix))
((m ,type-1))
(destructuring-bind (mr mc) (dim m)
- (,(ch-util:make-intern (concatenate 'string "mat-abs-range" suffix))
+ (,(make-intern (concatenate 'string "mat-abs-range" suffix))
m 0 (1- mr) 0 (1- mc)))))))
(defmacro def-matrix-abs! (type-1 &key suffix)
(let ((element-type-1 (element-type (find-class `,type-1))))
`(progn
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-abs-range!" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mat-abs-range!" suffix))
((m ,type-1) startr endr startc endc)
(with-matrix-vals (m ,element-type-1 a)
(do ((i startr (1+ i)))
@@ -78,10 +78,10 @@
(setf (aref a i j) (abs (aref a i j))))))
m)
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-abs!" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mat-abs!" suffix))
((m ,type-1))
(destructuring-bind (mr mc) (dim m)
- (,(ch-util:make-intern (concatenate 'string "mat-abs-range!" suffix))
+ (,(make-intern (concatenate 'string "mat-abs-range!" suffix))
m 0 (1- mr) 0 (1- mc)))))))
(macrolet ((frob (type-1 type-2 &key suffix)
10 src/add.lisp
View
@@ -43,7 +43,7 @@
(element-type-2 (element-type (find-class `,type-2)))
(accumulator-element-type (element-type (find-class `,accumulator-type))))
`(progn
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-add-range" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mat-add-range" suffix))
((m ,type-1) (n ,type-2) startr endr startc endc &key in-place)
(destructuring-bind (mr mc) (dim m)
(if in-place
@@ -164,7 +164,7 @@
(let ((element-type-1 (element-type (find-class `,type-1)))
(accumulator-element-type (element-type (find-class `,accumulator-type))))
`(progn
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-add-range-"
+ (defmethod ,(make-intern (concatenate 'string "mat-add-range-"
(symbol-name type-2)
suffix))
((m ,type-1) n startr endr startc endc &key in-place)
@@ -199,7 +199,7 @@
(+ (mref m i j) n))))))
p))))
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-add"
+ (defmethod ,(make-intern (concatenate 'string "mat-add"
(symbol-name type-2)
suffix))
((m ,type-1) n &key in-place)
@@ -245,7 +245,7 @@
(element-type-2 (element-type (find-class `,type-2)))
(accumulator-element-type (element-type (find-class `,accumulator-type))))
`(progn
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-add-range" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mat-add-range" suffix))
((m ,type-1) (n ,type-2) startr endr startc endc &key in-place)
(declare (type ,type-2 n))
(let ((val (clem::scalar-val n)))
@@ -276,7 +276,7 @@
(+ (mref m i j) val))))))
p)))))
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-add" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mat-add" suffix))
((m ,type-1) (n ,type-2) &key in-place)
(let ((val (clem::scalar-val n)))
(declare (type ,element-type-2 val))
8 src/defmatrix.lisp
View
@@ -63,9 +63,9 @@
(with-typed-matrix-vals (m ,element-type a)
(setf (aref a row col) v)))
- (defgeneric ,(ch-util:make-intern
+ (defgeneric ,(make-intern
(concatenate 'string "array->" (symbol-name type))) (a))
- (defmethod ,(ch-util:make-intern
+ (defmethod ,(make-intern
(concatenate 'string "array->" (symbol-name type))) ((a array))
(array->matrix a :matrix-class ',type))
@@ -114,10 +114,10 @@
m)
(defgeneric
- ,(ch-util:make-intern (concatenate 'string "random-" (symbol-name type)))
+ ,(make-intern (concatenate 'string "random-" (symbol-name type)))
(rows cols &key max))
(defmethod
- ,(ch-util:make-intern (concatenate 'string "random-" (symbol-name type)))
+ ,(make-intern (concatenate 'string "random-" (symbol-name type)))
(rows cols &key (max nil))
(let ((a (make-instance ',type :rows rows :cols cols))
(maxvalue (if max
2  src/interpolation.lisp
View
@@ -9,7 +9,7 @@
(defmacro bilinear-interpolate
(g00 g01 g10 g11 a b)
- (ch-util::once-only (g00 g01 g10 g11 a b)
+ (once-only (g00 g01 g10 g11 a b)
`(+ ,g00
(* ,a (- ,g10 ,g00))
(* ,b (- ,g01 ,g00))
12 src/log.lisp
View
@@ -12,7 +12,7 @@
(let ((element-type-1 (element-type (find-class `,type-1)))
(accumulator-element-type (element-type (find-class `,accumulator-type))))
`(progn
- (defmethod ,(ch-util:make-intern (concatenate 'string "mlog-range" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mlog-range" suffix))
((m ,type-1) startr endr startc endc &optional base)
(destructuring-bind (mr mc) (dim m)
(let ((p (make-instance ',accumulator-type :rows mr :cols mc)))
@@ -28,16 +28,16 @@
(apply #'log (mref m i j) (when base (list base))))))))
p)))
- (defmethod ,(ch-util:make-intern (concatenate 'string "mlog" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mlog" suffix))
((m ,type-1) &optional base)
(destructuring-bind (mr mc) (dim m)
- (apply #',(ch-util:make-intern (concatenate 'string "mlog-range" suffix))
+ (apply #',(make-intern (concatenate 'string "mlog-range" suffix))
m 0 (1- mr) 0 (1- mc) (when base (list base))))))))
(defmacro def-matrix-log! (type-1 &key suffix)
(let ((element-type-1 (element-type (find-class `,type-1))))
`(progn
- (defmethod ,(ch-util:make-intern (concatenate 'string "mlog-range!" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mlog-range!" suffix))
((m ,type-1) startr endr startc endc &optional base)
(with-typed-mref (m ,element-type-1)
(do ((i startr (1+ i)))
@@ -49,10 +49,10 @@
(setf (mref m i j) (apply #'log (mref m i j) (when base (list base)))))))
m)
- (defmethod ,(ch-util:make-intern (concatenate 'string "mlog!" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mlog!" suffix))
((m ,type-1) &optional base)
(destructuring-bind (mr mc) (dim m)
- (apply #',(ch-util:make-intern (concatenate 'string "mlog-range!" suffix))
+ (apply #',(make-intern (concatenate 'string "mlog-range!" suffix))
m 0 (1- mr) 0 (1- mc) (when base (list base))))))))
(macrolet ((frob (type-1 type-2 &key suffix)
12 src/logical-operations.lisp
View
@@ -67,7 +67,7 @@
(accumulator-element-type (element-type (find-class `,accumulator-type))))
(let ((max (max (maxval class-1) (maxval class-2))))
`(progn
- (defmethod ,(ch-util:make-intern (concatenate 'string name "-range" suffix))
+ (defmethod ,(make-intern (concatenate 'string name "-range" suffix))
((m ,type-1) (n ,type-2) startr endr startc endc)
(destructuring-bind (mr mc) (dim m)
(let ((p (make-instance ',accumulator-type :rows mr :cols mc)))
@@ -84,10 +84,10 @@
(logand ,max (lognor (mref m i j) (mref n i j)))))))))
p)))
- (defmethod ,(ch-util:make-intern (concatenate 'string name suffix))
+ (defmethod ,(make-intern (concatenate 'string name suffix))
((m ,type-1) (n ,type-2))
(destructuring-bind (mr mc) (dim m)
- (,(ch-util:make-intern (concatenate 'string name "-range" suffix)) m n 0 (1- mr) 0 (1- mc)))))))))
+ (,(make-intern (concatenate 'string name "-range" suffix)) m n 0 (1- mr) 0 (1- mc)))))))))
(defmacro defmbitnor! (name type-1 type-2 accumulator-type &key suffix)
(declare (ignore accumulator-type))
@@ -97,7 +97,7 @@
(element-type-2 (element-type class-2)))
(let ((max (max (maxval class-1) (maxval class-2))))
`(progn
- (defmethod ,(ch-util:make-intern (concatenate 'string name "!-range" suffix))
+ (defmethod ,(make-intern (concatenate 'string name "!-range" suffix))
((m ,type-1) (n ,type-2) startr endr startc endc)
(with-typed-mref (m ,element-type-1)
(with-typed-mref (n ,element-type-2)
@@ -111,10 +111,10 @@
(logand ,max (lognor (mref m i j) (mref n i j)))))))
m))
- (defmethod ,(ch-util:make-intern (concatenate 'string name "!" suffix))
+ (defmethod ,(make-intern (concatenate 'string name "!" suffix))
((m ,type-1) (n ,type-2))
(destructuring-bind (mr mc) (dim m)
- (,(ch-util:make-intern (concatenate 'string name "!-range" suffix)) m n 0 (1- mr) 0 (1- mc))))
+ (,(make-intern (concatenate 'string name "!-range" suffix)) m n 0 (1- mr) 0 (1- mc))))
)))))
8 src/macros.lisp
View
@@ -5,7 +5,7 @@
(let ((element-type-1 (element-type (find-class `,type-1)))
(accumulator-element-type (element-type (find-class `,accumulator-type))))
`(progn
- (defmethod ,(ch-util:make-intern (concatenate 'string name "-range" suffix))
+ (defmethod ,(make-intern (concatenate 'string name "-range" suffix))
((m ,type-1) startr endr startc endc &key in-place)
(destructuring-bind (mr mc) (dim m)
(if in-place
@@ -32,7 +32,7 @@
(,op (mref m i j)))))))
p))))
- (defmethod ,(ch-util:make-intern (concatenate 'string name suffix))
+ (defmethod ,(make-intern (concatenate 'string name suffix))
((m ,type-1) &key in-place)
(if in-place
(with-typed-mref (m ,element-type-1)
@@ -53,7 +53,7 @@
(element-type-2 (element-type (find-class `,type-2)))
(accumulator-element-type (element-type (find-class `,accumulator-type))))
`(progn
- (defmethod ,(ch-util:make-intern (concatenate 'string name "-range" suffix))
+ (defmethod ,(make-intern (concatenate 'string name "-range" suffix))
((m ,type-1) (n ,type-2) startr endr startc endc &key in-place)
(destructuring-bind (mr mc) (dim m)
(if in-place
@@ -87,7 +87,7 @@
(,op (mref m i j) (mref n i j))))))))
p))))
- (defmethod ,(ch-util:make-intern (concatenate 'string name suffix))
+ (defmethod ,(make-intern (concatenate 'string name suffix))
((m ,type-1) (n ,type-2) &key in-place)
(if in-place
,(if allow-in-place
19 src/matrix.lisp
View
@@ -241,9 +241,18 @@
mpl)
)))
+(flet ((cca (l1 l2)
+ (dolist (x l1)
+ (let ((y (member x l2)))
+ (if y (return y))))))
+ (defun closest-common-ancestor (itm &rest lis)
+ (if (null lis)
+ itm
+ (cca itm (apply #'closest-common-ancestor lis)))))
+
(defgeneric closest-common-matrix-class (m1 &rest mr)
(:method ((m1 matrix) &rest mr)
- (car (apply #'ch-util:closest-common-ancestor
+ (car (apply #'closest-common-ancestor
(mapcar #'(lambda (x) (matrix-precedence-list (class-of x)))
(cons m1 mr))))))
@@ -456,16 +465,16 @@
(macrolet ((frob (name op)
`(progn
;;; define the row op
- (defgeneric ,(ch-util:make-intern (concatenate 'string "scalar-" name "-row"))
+ (defgeneric ,(make-intern (concatenate 'string "scalar-" name "-row"))
(a k q))
- (defmethod ,(ch-util:make-intern (concatenate 'string "scalar-" name "-row"))
+ (defmethod ,(make-intern (concatenate 'string "scalar-" name "-row"))
((a matrix) k q)
(map-row a k #'(lambda (x) (apply ,op (list x q))))
a)
;;; define the column op
- (defgeneric ,(ch-util:make-intern (concatenate 'string "scalar-" name "-col"))
+ (defgeneric ,(make-intern (concatenate 'string "scalar-" name "-col"))
(a k q))
- (defmethod ,(ch-util:make-intern (concatenate 'string "scalar-" name "-col"))
+ (defmethod ,(make-intern (concatenate 'string "scalar-" name "-col"))
((a matrix) k q)
(map-col a k #'(lambda (x) (apply ,op (list x q))))
a))))
15 src/matrixops.lisp
View
@@ -406,6 +406,19 @@
(mat-scale x (/ n) :in-place t)
x)))))
+(defun median (seq)
+ (let ((v (cond ((vectorp seq) (copy-seq seq))
+ ((listp seq) (coerce seq 'vector)))))
+ (when (and v (plusp (length v)))
+ (sort v #'<)
+ (let ((f (floor (length v) 2)))
+ (cond ((oddp (length v))
+ (elt v f))
+ (t
+ (/ (+ (elt v (1- f))
+ (elt v f))
+ 2)))))))
+
(defun matrix-medians (matrices)
(cond ((null matrices) nil)
((= (length matrices) 1) (car matrices))
@@ -420,7 +433,7 @@
with l
do (push (mref m i j) l)
finally (setf (mref x i j)
- (coerce (ch-util::median l)
+ (coerce (median l)
'double-float)))))
x)))))
2  src/subtr.lisp
View
@@ -97,7 +97,7 @@
(defmethod %get-subtr-matrix-class ((a ,type-1) (b ,type-2))
',accumulator-type)
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-subtr-range3" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mat-subtr-range3" suffix))
((m ,type-1) (n ,type-2) (p ,accumulator-type) startr endr startc endc)
(with-matrix-vals (m ,element-type-1 a)
(with-matrix-vals (n ,element-type-2 b)
6 src/typed-ops/defmatrix-equal.lisp
View
@@ -10,7 +10,7 @@
(let ((element-type-1 (element-type (find-class `,type-1)))
(element-type-2 (element-type (find-class `,type-2))))
`(progn
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-equal-range" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mat-equal-range" suffix))
((m ,type-1) (n ,type-2) startr endr startc endc)
(let ((equal t))
(clem::mloop-range (((m ,element-type-1 a)
@@ -19,10 +19,10 @@
(setf equal (and equal (= (aref a i j) (aref b i j)))))
equal))
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-equal" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mat-equal" suffix))
((m ,type-1) (n ,type-2))
(destructuring-bind (mr mc) (dim m)
- (,(ch-util:make-intern (concatenate 'string "mat-equal-range" suffix)) m n 0 (1- mr) 0 (1- mc)))))))
+ (,(make-intern (concatenate 'string "mat-equal-range" suffix)) m n 0 (1- mr) 0 (1- mc)))))))
(macrolet ((frob (type-1 type-2 &key suffix)
`(progn
8 src/typed-ops/defmatrix-hprod.lisp
View
@@ -6,7 +6,7 @@
(element-type-2 (element-type (find-class `,type-2)))
(accumulator-element-type (element-type (find-class `,accumulator-type))))
`(progn
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-hprod-range" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mat-hprod-range" suffix))
((m ,type-1) (n ,type-2) startr endr startc endc)
(destructuring-bind (mr mc) (dim m)
(let ((p (make-instance ',accumulator-type :rows mr :cols mc)))
@@ -23,7 +23,7 @@
(* (aref a i j) (aref b i j))))))))
p)))
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-hprod" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mat-hprod" suffix))
((m ,type-1) (n ,type-2))
(destructuring-bind (mr mc) (dim m)
(mat-hprod-range m n 0 (1- mr) 0 (1- mc)))))))
@@ -33,7 +33,7 @@
(let ((element-type-1 (element-type (find-class `,type-1)))
(element-type-2 (element-type (find-class `,type-2))))
`(progn
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-hprod-range!" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mat-hprod-range!" suffix))
((m ,type-1) (n ,type-2) startr endr startc endc)
(with-matrix-vals (m ,element-type-1 a)
(with-matrix-vals (n ,element-type-2 b)
@@ -47,7 +47,7 @@
(* (aref a i j) (aref b i j))))))
m))
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-hprod!" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mat-hprod!" suffix))
((m ,type-1) (n ,type-2))
(destructuring-bind (mr mc) (dim m)
(mat-hprod-range! m n 0 (1- mr) 0 (1- mc)))))))
6 src/typed-ops/defmatrix-mult.lisp
View
@@ -19,7 +19,7 @@
`(progn
#+sbcl
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-mult3" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mat-mult3" suffix))
((m ,type-1) (n ,type-2) (p ,accumulator-type))
(declare (optimize (speed 3) (safety 0)))
(let ((a (displace-to-1d-array m))
@@ -57,7 +57,7 @@
p)
#-sbcl
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-mult3" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mat-mult3" suffix))
((m ,type-1) (n ,type-1) (p ,type-1))
(declare (optimize (speed 3) (safety 0)))
(let ((a (clem::matrix-vals m))
@@ -90,7 +90,7 @@
:format-arguments (list mr mc nr nc pr pc)))))
p)
- (defmethod ,(ch-util:make-intern (concatenate 'string "mat-mult" suffix))
+ (defmethod ,(make-intern (concatenate 'string "mat-mult" suffix))
((m ,type-1) (n ,type-2))
(declare (optimize (speed 3) (safety 0)))
(let ((mr (rows m))
15 src/utilities.lisp
View
@@ -0,0 +1,15 @@
+
+(in-package :clem)
+
+(defun make-intern (x &optional (package *package*))
+ (intern (string-upcase x) package))
+
+;;; this is taken from Peter Seibel's Practical Common Lisp
+;;; book, p. 102
+(defmacro once-only ((&rest names) &body body)
+ (let ((gensyms (loop for n in names collect (gensym))))
+ `(let (,@(loop for g in gensyms collect `(,g (gensym))))
+ `(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n)))
+ ,(let (,@(loop for n in names for g in gensyms collect `(,n ,g)))
+ ,@body)))))
+
24 test/test-clem.lisp
View
@@ -111,18 +111,18 @@
t)
(defun run-tests ()
- (let ((run (ch-util:make-test-run)))
- (ch-util:run-test #'matrix-test-1 "matrix-test-1" run)
- (ch-util:run-test #'matrix-test-2 "matrix-test-2" run)
- (ch-util:run-test #'matrix-test-3 "matrix-test-3" run)
- (ch-util:run-test #'matrix-test-4 "matrix-test-4" run)
- (ch-util:run-test #'matrix-test-5 "matrix-test-5" run)
- (ch-util:run-test #'matrix-test-6 "matrix-test-6" run)
- (ch-util:run-test #'matrix-test-7 "matrix-test-7" run)
- (ch-util:run-test #'matrix-test-7 "matrix-test-9" run)
- (ch-util:run-test #'matrix-test-7 "matrix-test-10" run)
- (ch-util:run-test #'matrix-test-7 "matrix-test-11" run)
- (format t "~&~A of ~A tests passed" (ch-util:test-run-passed run) (ch-util:test-run-tests run))
+ (let ((run (make-test-run)))
+ (run-test #'matrix-test-1 "matrix-test-1" run)
+ (run-test #'matrix-test-2 "matrix-test-2" run)
+ (run-test #'matrix-test-3 "matrix-test-3" run)
+ (run-test #'matrix-test-4 "matrix-test-4" run)
+ (run-test #'matrix-test-5 "matrix-test-5" run)
+ (run-test #'matrix-test-6 "matrix-test-6" run)
+ (run-test #'matrix-test-7 "matrix-test-7" run)
+ (run-test #'matrix-test-7 "matrix-test-9" run)
+ (run-test #'matrix-test-7 "matrix-test-10" run)
+ (run-test #'matrix-test-7 "matrix-test-11" run)
+ (format t "~&~A of ~A tests passed" (test-run-passed run) (test-run-tests run))
))
(defparameter m2 (make-instance 'double-float-matrix :dimensions '(1000 1000)))
14 test/test-defmatrix.lisp
View
@@ -55,14 +55,14 @@
t)
(defun run-tests-1 ()
- (let ((run (ch-util:make-test-run)))
- (ch-util:run-test #'matrix-test-1 "matrix-test-1" run)
- (ch-util:run-test #'matrix-test-2 "matrix-test-2" run)
- (ch-util:run-test #'matrix-test-3 "matrix-test-3" run)
- (ch-util:run-test #'matrix-test-4 "matrix-test-4" run)
- (ch-util:run-test #'matrix-test-5 "matrix-test-5" run)
+ (let ((run (make-test-run)))
+ (run-test #'matrix-test-1 "matrix-test-1" run)
+ (run-test #'matrix-test-2 "matrix-test-2" run)
+ (run-test #'matrix-test-3 "matrix-test-3" run)
+ (run-test #'matrix-test-4 "matrix-test-4" run)
+ (run-test #'matrix-test-5 "matrix-test-5" run)
(format t "~&~A of ~A tests passed"
- (ch-util:test-run-passed run) (ch-util:test-run-tests run))))
+ (test-run-passed run) (test-run-tests run))))
(defun run-defmatrix-tests ()
(clem::defmatrixclass ape-matrix ()
16 test/test-not.lisp
View
@@ -3,29 +3,29 @@
(macrolet ((define-test (type)
`(progn
- (defun ,(ch-util:make-intern (concatenate 'string "test-not/" type)) ()
+ (defun ,(clem::make-intern (concatenate 'string "test-not/" type)) ()
(let ((m (array->matrix #2A((1 2 3)(4 5 6)(7 8 9))
- :matrix-class ',(ch-util:make-intern
+ :matrix-class ',(clem::make-intern
(concatenate 'string type "-matrix")))))
(let ((n (clem::mlognot m)))
(print n))))
- (defun ,(ch-util:make-intern (concatenate 'string "test-not/" type "/in-place")) ()
+ (defun ,(clem::make-intern (concatenate 'string "test-not/" type "/in-place")) ()
(let ((m (array->matrix #2A((1 2 3)(4 5 6)(7 8 9))
- :matrix-class ',(ch-util:make-intern
+ :matrix-class ',(clem::make-intern
(concatenate 'string type "-matrix")))))
(clem::mlognot m :in-place t)
(print m)))
- (defun ,(ch-util:make-intern (concatenate 'string "test-not/" type "/3d")) ()
+ (defun ,(clem::make-intern (concatenate 'string "test-not/" type "/3d")) ()
(let ((m (array->matrix #3A(((1 2 3)(4 5 6)(7 8 9))
((11 12 13)(14 15 16)(17 18 19)))
- :matrix-class ',(ch-util:make-intern
+ :matrix-class ',(clem::make-intern
(concatenate 'string type "-matrix")))))
(let ((n (clem::mlognot m)))
(print n))))
- (defun ,(ch-util:make-intern (concatenate 'string "test-not/" type "/3d/in-place")) ()
+ (defun ,(clem::make-intern (concatenate 'string "test-not/" type "/3d/in-place")) ()
(let ((m (array->matrix #3A(((1 2 3)(4 5 6)(7 8 9))
((11 12 13)(14 15 16)(17 18 19)))
- :matrix-class ',(ch-util:make-intern
+ :matrix-class ',(clem::make-intern
(concatenate 'string type "-matrix")))))
(clem::mlognot m :in-place t)
(print m))))))
16 test/test-sum.lisp
View
@@ -3,30 +3,30 @@
(macrolet ((define-test (type)
`(progn
- (defun ,(ch-util:make-intern (concatenate 'string "test-sum/" type)) ()
+ (defun ,(clem::make-intern (concatenate 'string "test-sum/" type)) ()
(let ((m (array->matrix #2A((1 2 3)(4 5 6)(7 8 9))
- :matrix-class ',(ch-util:make-intern
+ :matrix-class ',(clem::make-intern
(concatenate 'string type "-matrix")))))
(let ((n (clem::sum m)))
(print n))))
- (defun ,(ch-util:make-intern (concatenate 'string "test-sum/" type "/3d")) ()
+ (defun ,(clem::make-intern (concatenate 'string "test-sum/" type "/3d")) ()
(let ((m (array->matrix #3A(((1 2 3)(4 5 6)(7 8 9))
((11 12 13)(14 15 16)(17 18 19)))
- :matrix-class ',(ch-util:make-intern
+ :matrix-class ',(clem::make-intern
(concatenate 'string type "-matrix")))))
(let ((n (clem::sum m)))
(print n))))
- (defun ,(ch-util:make-intern (concatenate 'string "test-sum-square/" type)) ()
+ (defun ,(clem::make-intern (concatenate 'string "test-sum-square/" type)) ()
(let ((m (array->matrix #2A((1 2 3)(4 5 6)(7 8 9))
- :matrix-class ',(ch-util:make-intern
+ :matrix-class ',(clem::make-intern
(concatenate 'string type "-matrix")))))
(let ((n (clem::sum-square m)))
(print n))))
- (defun ,(ch-util:make-intern (concatenate 'string "test-sum-square/" type "/3d")) ()
+ (defun ,(clem::make-intern (concatenate 'string "test-sum-square/" type "/3d")) ()
(let ((m (array->matrix #3A(((1 2 3)(4 5 6)(7 8 9))
((11 12 13)(14 15 16)(17 18 19)))
- :matrix-class ',(ch-util:make-intern
+ :matrix-class ',(clem::make-intern
(concatenate 'string type "-matrix")))))
(let ((n (clem::sum-square m)))
(print n)))))))
26 test/testharness.lisp
View
@@ -0,0 +1,26 @@
+;;;
+;;; testharness.cl -- various lisp utilities for hash-tables
+;;;
+;;; Author: Cyrus Harmon <ch-lisp@bobobeach.com>
+;;; Time-stamp: <2010-06-11 13:23:44 sly>
+;;;
+
+(in-package :clem-test)
+
+(defparameter *verbose-test-results* nil)
+
+(defstruct test-run
+ (tests 0)
+ (passed 0))
+
+(defun run-test (f test-name run)
+ (if (funcall f)
+ (progn
+ (when *verbose-test-results*
+ (format t "~&Test ~A Succeeded" test-name))
+ (incf (test-run-passed run))
+ (incf (test-run-tests run)))
+ (progn
+ (format t "~&Test ~A Failed!" test-name)
+ (incf (test-run-tests run)))))
+
1  version.lisp-expr
View
@@ -1 +0,0 @@
-"0.4.5"
Please sign in to comment.
Something went wrong with that request. Please try again.