Menu
▾
▴
[Matlisp-commit] [matlisp-git]matlisp branch classy updated. 2012-02-23-243-g228188f
|
From: Akshay S. <ak...@us...> - 2013-08-10 05:22:02
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "matlisp".
The branch, classy has been updated
via 228188fe426f884dd6a1743578e879350b7050ec (commit)
from 03eedb3f3faa199ef9b76c30b95d4222d98dd9be (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 228188fe426f884dd6a1743578e879350b7050ec
Author: Akshay Srinivasan <aks...@gm...>
Date: Fri Aug 9 22:21:50 2013 -0700
Added routines for automatic loop-order generation.
diff --git a/src/base/einstein.lisp b/src/base/einstein.lisp
index 648d4f8..ac0ada7 100644
--- a/src/base/einstein.lisp
+++ b/src/base/einstein.lisp
@@ -18,7 +18,25 @@
(if (atom tlst) tlst
(mapcar #'(lambda (x) (mapcons func x keys)) tlst)))))
-(defun loop-generator (type index-order place clause &key (testp t) (tight-iloop nil))
+;;Only works for distinct objects
+(defun generate-permutations (lst)
+ (if (null (cdr lst)) (list lst)
+ (apply #'append (mapcar #'(lambda (x)
+ (let ((pop-x (setrem lst x)))
+ (mapcar #'(lambda (y) (cons x y)) (generate-permutations pop-x))))
+ lst))))
+
+(defun set-eq (a b &key (test #'eql))
+ (and (loop :for ele :in a
+ :do (unless (member ele b :test test)
+ (return nil))
+ :finally (return t))
+ (loop :for ele :in b
+ :do (unless (member ele a :test test)
+ (return nil))
+ :finally (return t))))
+
+(defun parse-loopx (type place clause)
(let* ((refs (let ((tmp (get-cons (list place clause) 'ref))
(ret nil))
(loop :for ele :in tmp
@@ -48,135 +66,177 @@
(if cdim
(rplacd (last cdim) (cdr ipos))
(push ipos tmp))))
- (loop :for idx :in tmp
- :do (assert (member (car idx) index-order) nil "Error index ~a not found in the index-order." (car idx)))
- (loop :for idx :in index-order
- :collect (let ((cdim (find idx tmp :key #'car)))
- (assert (not (null cdim)) nil "Error index ~a not found in the expression." idx)
- cdim))))
- (idx-d (let ((refrem (mapcons #'(lambda (x) (declare (ignore x)) t)
- clause '(ref))))
- (remove-if #'null (mapcar #'(lambda (x) (when (has-sym refrem x) x)) (mapcar #'car indices))))))
- (labels ((get-prop (x &optional prop)
- (let ((plst (find x tlist :key #'(lambda (x) (cadr (getf x :tensor))))))
- (if prop
- (getf plst prop)
- plst)))
- (get-offset (x)
- (caar (second (find (cdr x) (get-prop (car x) :offsets) :key #'car :test #'list-eq)))))
- ;;Populate offsets
- (loop :for ref :in refs
- :do (let* ((plist (get-prop (second ref)))
- (ofsym (gensym (string+ "offset-" (symbol-name (second (getf plist :tensor))))))
- (ret `((,ofsym ,(car (getf plist :head)) :type index-type)
- (,(gensym (string+ "ref-" (symbol-name (second (getf plist :tensor))))) (t/store-ref ,type ,(car (getf plist :store)) ,ofsym) :type ,(field-type type)))))
- (if (getf plist :offsets)
- (setf (getf plist :offsets) (append (getf plist :offsets) (list (list (cddr ref) ret))))
- (rplacd (last plist) (list :offsets (list (list (cddr ref) ret)))))))
- ;;Compute offset increments
- (let ((rev (reverse indices)))
- (labels ((get-incs (idxs acc decl incs ten ofst)
- (if (null idxs) (values decl incs)
- (let* ((clst (car idxs))
- (cidx (car clst))
- (idx-rem (mapcar #'car idxs))
- (tloop (and tight-iloop (eql cidx (car (last index-order))))))
- (cond
- ((loop :for ele :in (car ofst)
- :do (when (member ele idx-rem)
- (return nil))
- :finally (return t))
- (values (append (make-list (length idxs)) decl)
- (append (make-list (1- (length idxs))) (cons `(setf ,(caar (cadr ofst)) ,(car (get-prop ten :head))) incs))))
- (t
- (let* ((plst (get-prop ten))
- (dsym (gensym (string+ "d-stp-" (symbol-name cidx) "-" (symbol-name ten))))
- (memp (member cidx (car ofst)))
- (stp (when memp `(aref ,(car (getf plst :strides)) ,(position cidx (car ofst))))))
- (get-incs (cdr idxs) (if memp (list `(the index-type (* ,(if tloop 1 stp) (aref ,(car (getf plst :dimensions)) ,(position cidx (car ofst)))))) nil)
- (if (or tloop (and (null acc) (not memp))) (cons nil decl)
- (cons
- (if memp
- `(,dsym ,(if (null acc) stp `(the index-type (- ,stp ,@acc))) :type index-type)
- `(,dsym (the index-type (- ,@acc)) :type index-type))
- decl))
- (if (and (null acc) (not memp)) (cons nil incs)
- (cons `(incf ,(caar (cadr ofst)) ,@(unless tloop `(,dsym))) incs))
- ten ofst))))))))
- (mapcar #'(lambda (ten)
- (loop :for ofst :in (get-prop ten :offsets)
- :do (rplacd (last ofst) (multiple-value-list (get-incs rev nil nil nil ten ofst)))))
- tens)))
- ;;
- (labels ((testgen ()
- `((assert (and ,@(mapcar #'(lambda (idx)
- `(= ,@(mapcar #'(lambda (x) `(aref ,(car (get-prop (car x) :dimensions)) ,(cadr x))) (cdr idx)))) indices))
- nil "error: arguments are not of appropriate sizes.")
- ,@(when tight-iloop
- `((assert (= 1 ,@(mapcar #'(lambda (x) `(aref ,(car (get-prop (car x) :strides)) ,(cadr x))) (cdar (last indices)))) nil "error: Inner loop strides are not 1.")))))
- (t/compile (place clause)
- (let* ((cclause (mapcons #'(lambda (x)
- (let* ((plst (get-prop (cadr x)))
- (ofset-sym (get-offset (cdr x))))
- `(t/store-ref ,type ,(car (getf plst :store)) ,ofset-sym)))
- clause '(ref)))
- (ftype (field-type type)))
- (setf cclause
- (mapcons #'(lambda (x)
- (let ((op (car x)))
- `(,(case op (* 't/f*) (+ 't/f+) (- 't/f-) (/ 't/f/))
- ,ftype
- ,@(cdr x))))
- cclause '(* + - /)))
- (let ((plst (get-prop (cadr place)))
- (valsym (gensym "value")))
- `((let-typed ((,valsym (t/f+ ,ftype (t/store-ref ,type ,(car (getf plst :store)) ,(get-offset (cdr place)))
- ,cclause ) :type ,ftype))
- (t/store-set ,type ,valsym ,(car (getf plst :store)) ,(get-offset (cdr place))))))))
- (loopgen (idxs place clause)
- (if (null idxs) (t/compile place clause)
- (let ((cidx (caar idxs))
- (clst (car idxs)))
- (let ((tdecl (let ((ilist (mapcar #'car idxs)))
- (remove-if #'null
- (apply #'append
- (mapcar #'(lambda (ten)
- (mapcar #'(lambda (ofs)
- (when (loop :for idx :in (car ofs)
- :do (when (member idx ilist)
- (return nil))
- :finally (return t))
- (let ((decl (cadr (cadr ofs))))
- (setf clause (mapcons #'(lambda (x)
- (if (and (eql (cadr x) ten) (equal (cddr x) (car ofs)))
- (car decl)
- x))
- clause '(ref)))
- decl)))
- (get-prop ten :offsets)))
- (setrem tens (cadr place))))))))
- (list
- (recursive-append
- (unless (null tdecl)
- `(let-typed (,@tdecl)))
- `(loop ,@(let ((repl `(aref ,(car (get-prop (car (cadr clst)) :dimensions)) ,(cadr (cadr clst)))))
- (if (member cidx idx-d)
- `(:for ,cidx :of-type index-type :from 0 :below ,repl)
- `(:repeat ,repl)))
- :do (progn
- ,@(loopgen (cdr idxs) place clause)
- ,@(remove-if #'null (apply #'append
- (mapcar #'(lambda (ten) (mapcar #'(lambda (x) (elt (fourth x) (position cidx index-order))) (get-prop ten :offsets))) tens))))))))))))
+ tmp)))
+ (values refs tlist indices)))
+
+(defun loop-generator-base (type index-order place clause &key (testp t) (tight-iloop nil))
+ (multiple-value-bind (refs tlist indices) (parse-loopx type place clause)
+ (let* ((tens (mapcar #'(lambda (x) (second (getf x :tensor))) tlist))
+ (indices (progn
+ (loop :for idx :in indices
+ :do (assert (member (car idx) index-order) nil "Error index ~a not found in the index-order." (car idx)))
+ (loop :for idx :in index-order
+ :collect (let ((cdim (find idx indices :key #'car)))
+ (assert (not (null cdim)) nil "Error index ~a not found in the expression." idx)
+ cdim))))
+ (idx-d (let ((refrem (mapcons #'(lambda (x) (declare (ignore x)) t)
+ clause '(ref))))
+ (remove-if #'null (mapcar #'(lambda (x) (when (has-sym refrem x) x)) (mapcar #'car indices))))))
+ (labels ((get-prop (x &optional prop)
+ (let ((plst (find x tlist :key #'(lambda (x) (cadr (getf x :tensor))))))
+ (if prop
+ (getf plst prop)
+ plst)))
+ (get-offset (x)
+ (caar (second (find (cdr x) (get-prop (car x) :offsets) :key #'car :test #'list-eq)))))
+ ;;Populate offsets
+ (loop :for ref :in refs
+ :do (let* ((plist (get-prop (second ref)))
+ (ofsym (gensym (string+ "offset-" (symbol-name (second (getf plist :tensor))))))
+ (ret `((,ofsym ,(car (getf plist :head)) :type index-type)
+ (,(gensym (string+ "ref-" (symbol-name (second (getf plist :tensor))))) (t/store-ref ,type ,(car (getf plist :store)) ,ofsym) :type ,(field-type type)))))
+ (if (getf plist :offsets)
+ (setf (getf plist :offsets) (append (getf plist :offsets) (list (list (cddr ref) ret))))
+ (rplacd (last plist) (list :offsets (list (list (cddr ref) ret)))))))
+ ;;Compute offset increments
+ (let ((rev (reverse indices)))
+ (labels ((get-incs (idxs acc decl incs ten ofst)
+ (if (null idxs) (values decl incs)
+ (let* ((clst (car idxs))
+ (cidx (car clst))
+ (idx-rem (mapcar #'car idxs))
+ (tloop (and tight-iloop (eql cidx (car (last index-order))))))
+ (cond
+ ((loop :for ele :in (car ofst)
+ :do (when (member ele idx-rem)
+ (return nil))
+ :finally (return t))
+ (values (append (make-list (length idxs)) decl)
+ (append (make-list (1- (length idxs))) (cons `(setf ,(caar (cadr ofst)) ,(car (get-prop ten :head))) incs))))
+ (t
+ (let* ((plst (get-prop ten))
+ (dsym (gensym (string+ "d-stp-" (symbol-name cidx) "-" (symbol-name ten))))
+ (memp (member cidx (car ofst)))
+ (stp (when memp `(aref ,(car (getf plst :strides)) ,(position cidx (car ofst))))))
+ (get-incs (cdr idxs) (if memp (list `(the index-type (* ,(if tloop 1 stp) (aref ,(car (getf plst :dimensions)) ,(position cidx (car ofst)))))) nil)
+ (if (or tloop (and (null acc) (not memp))) (cons nil decl)
+ (cons
+ (if memp
+ `(,dsym ,(if (null acc) stp `(the index-type (- ,stp ,@acc))) :type index-type)
+ `(,dsym (the index-type (- ,@acc)) :type index-type))
+ decl))
+ (if (and (null acc) (not memp)) (cons nil incs)
+ (cons `(incf ,(caar (cadr ofst)) ,@(unless tloop `(,dsym))) incs))
+ ten ofst))))))))
+ (mapcar #'(lambda (ten)
+ (loop :for ofst :in (get-prop ten :offsets)
+ :do (rplacd (last ofst) (multiple-value-list (get-incs rev nil nil nil ten ofst)))))
+ tens)))
;;
- `(locally
- (declare (type ,type ,@tens))
- (let-typed (,@(apply #'append (mapcar #'(lambda (ten) (mapcar #'(lambda (prop) (get-prop ten prop)) '(:head :store :strides :dimensions))) tens)))
- (let-typed (,@(apply #'append (mapcar #'(lambda (ten) (mapcar #'(lambda (x) (car (second x))) (get-prop ten :offsets))) tens))
- ,@(remove-if #'null (apply #'append (mapcar #'(lambda (ten) (apply #'append (mapcar #'third (get-prop ten :offsets)))) tens))))
- ,@(when testp (testgen))
- (very-quickly
- ,@(loopgen indices place clause))))
- ,(cadr place))))))
+ (labels ((testgen ()
+ `((assert (and ,@(mapcar #'(lambda (idx)
+ `(= ,@(mapcar #'(lambda (x) `(aref ,(car (get-prop (car x) :dimensions)) ,(cadr x))) (cdr idx)))) indices))
+ nil "error: arguments are not of appropriate sizes.")
+ ,@(when tight-iloop
+ `((assert (= 1 ,@(mapcar #'(lambda (x) `(aref ,(car (get-prop (car x) :strides)) ,(cadr x))) (cdar (last indices)))) nil "error: Inner loop strides are not 1.")))))
+ ;;
+ (t/compile (place clause)
+ (let* ((cclause (mapcons #'(lambda (x)
+ (let* ((plst (get-prop (cadr x)))
+ (ofset-sym (get-offset (cdr x))))
+ `(t/store-ref ,type ,(car (getf plst :store)) ,ofset-sym)))
+ clause '(ref)))
+ (ftype (field-type type)))
+ (setf cclause
+ (mapcons #'(lambda (x)
+ (let ((op (car x)))
+ `(,(case op (* 't/f*) (+ 't/f+) (- 't/f-) (/ 't/f/))
+ ,ftype
+ ,@(cdr x))))
+ cclause '(* + - /)))
+ (let ((plst (get-prop (cadr place)))
+ (valsym (gensym "value")))
+ `((let-typed ((,valsym (t/f+ ,ftype (t/store-ref ,type ,(car (getf plst :store)) ,(get-offset (cdr place)))
+ ,cclause ) :type ,ftype))
+ (t/store-set ,type ,valsym ,(car (getf plst :store)) ,(get-offset (cdr place))))))))
+ ;;
+ (loopgen (idxs place clause)
+ (if (null idxs) (t/compile place clause)
+ (let ((cidx (caar idxs))
+ (clst (car idxs)))
+ (let ((tdecl (let ((ilist (mapcar #'car idxs)))
+ (remove-if #'null
+ (apply #'append
+ (mapcar #'(lambda (ten)
+ (mapcar #'(lambda (ofs)
+ (when (loop :for idx :in (car ofs)
+ :do (when (member idx ilist)
+ (return nil))
+ :finally (return t))
+ (let ((decl (cadr (cadr ofs))))
+ (setf clause (mapcons #'(lambda (x)
+ (if (and (eql (cadr x) ten) (equal (cddr x) (car ofs)))
+ (car decl)
+ x))
+ clause '(ref)))
+ decl)))
+ (get-prop ten :offsets)))
+ (setrem tens (cadr place))))))))
+ (list
+ (recursive-append
+ (unless (null tdecl)
+ `(let-typed (,@tdecl)))
+ `(loop ,@(let ((repl `(aref ,(car (get-prop (car (cadr clst)) :dimensions)) ,(cadr (cadr clst)))))
+ (if (member cidx idx-d)
+ `(:for ,cidx :of-type index-type :from 0 :below ,repl)
+ `(:repeat ,repl)))
+ :do (progn
+ ,@(loopgen (cdr idxs) place clause)
+ ,@(remove-if #'null (apply #'append
+ (mapcar #'(lambda (ten) (mapcar #'(lambda (x) (elt (fourth x) (position cidx index-order))) (get-prop ten :offsets))) tens))))))))))))
+ ;;
+ `(locally
+ (declare (type ,type ,@tens))
+ (let-typed (,@(apply #'append (mapcar #'(lambda (ten) (mapcar #'(lambda (prop) (get-prop ten prop)) '(:head :store :strides :dimensions))) tens)))
+ (let-typed (,@(apply #'append (mapcar #'(lambda (ten) (mapcar #'(lambda (x) (car (second x))) (get-prop ten :offsets))) tens))
+ ,@(remove-if #'null (apply #'append (mapcar #'(lambda (ten) (apply #'append (mapcar #'third (get-prop ten :offsets)))) tens))))
+ ,@(when testp (testgen))
+ (very-quickly
+ ,@(loopgen indices place clause))))
+ ,(cadr place)))))))
+
+(defmacro einstein-sum-base (type idx-order place clause &optional (testp t) (tight-iloop nil))
+ (loop-generator-base type idx-order place clause :testp testp :tight-iloop tight-iloop))
+
+;;Push this code into loop-generator-base ?
+(defun loop-generator (type index-order place clause &key (testp t))
+ (multiple-value-bind (refs tlist indices) (parse-loopx type place clause)
+ (let ((in-idx (find (car (last index-order)) indices :key #'car)))
+ `(if (= 1 ,@(mapcar #'(lambda (x) `(aref (the index-store-vector (strides ,(car x))) ,(cadr x))) (cdr in-idx)))
+ ,(loop-generator-base type index-order place clause :testp testp :tight-iloop t)
+ ,(loop-generator-base type index-order place clause :testp testp :tight-iloop nil)))))
+
+(defmacro einstein-sum (type idx-order place clause &optional (testp t))
+ (loop-generator type idx-order place clause :testp testp))
-(defmacro einstein-sum (type idx-order place clause &optional (tightp nil))
- (loop-generator type idx-order place clause :tight-iloop tightp))
+;;Yes this is slow, but if you're *really* worried about computation then roll your custom loops
+;;with einstein-sum-base. This is a super-adaptive on-the-fly loop generation function generation
+;;macro. You have the power now, without any of the tedium :)
+(defmacro define-einstein-sum (name args (type place clause &optional (testp t)))
+ (multiple-value-bind (refs tlist indices) (parse-loopx type place clause)
+ (declare (ignore refs))
+ (let ((tens (mapcar #'(lambda (x) (second (getf x :tensor))) tlist)))
+ (assert (set-eq tens args) nil "Error args and the list of tensor do not match."))
+ (with-gensyms (functable)
+ `(let ((,functable (make-hash-table :test 'equal)))
+ (defun ,name (,@args)
+ (declare (type ,type ,@args))
+ (let* ((idx-ord (mapcar #'car (very-quickly (sort (list ,@(mapcar #'(lambda (idx) `(list ',(car idx) (+ ,@(mapcar #'(lambda (x) `(aref (the index-store-vector (strides ,(car x))) ,(cadr x))) (cdr idx))))) indices)) #'(lambda (a b) (declare (type index-type a b)) (> a b)) :key #'cadr))))
+ (func (or (gethash idx-ord ,functable)
+ (let* ((code (loop-generator ',type idx-ord ',place ',clause :testp ,testp))
+ (funcnew (compile-and-eval
+ (list 'lambda '(,@args) code))))
+ (format t "Compiling code for index-order : ~a~%" idx-ord)
+ (setf (gethash idx-ord ,functable) funcnew)
+ funcnew))))
+ (apply func (list ,@args))))))))
diff --git a/tests/loopy-tests.lisp b/tests/loopy-tests.lisp
index b7ad434..cceb145 100644
--- a/tests/loopy-tests.lisp
+++ b/tests/loopy-tests.lisp
@@ -156,6 +156,54 @@
(setf of-B hd-B))))))
t)))
+(defun test-mm-lisp-blk (n bs)
+ (declare (type fixnum n))
+ (let ((*default-stride-ordering* :row-major))
+ (let ((A (zeros (list n n)))
+ (B (zeros (list n n)))
+ (C (zeros (list n n))))
+ (let-typed ((nr-C (nrows C) :type index-type)
+ (nc-C (ncols C) :type index-type)
+ (dotl (ncols A) :type index-type)
+ ;
+ (rstp-A (row-stride A) :type index-type)
+ (cstp-A (col-stride A) :type index-type)
+ (hd-A (head A) :type index-type)
+ (sto-A (store A) :type real-store-vector)
+ ;
+ (rstp-B (row-stride B) :type index-type)
+ (cstp-B (col-stride B) :type index-type)
+ (hd-B (head B) :type index-type)
+ (sto-B (store B) :type real-store-vector)
+ ;
+ (rstp-C (row-stride C) :type index-type)
+ (cstp-C (col-stride C) :type index-type)
+ (hd-C (head C) :type index-type)
+ (sto-C (store C) :type real-store-vector))
+ (time
+ (let-typed ((of-A hd-A :type index-type)
+ (of-B hd-B :type index-type)
+ (of-C hd-C :type index-type)
+ (r.cstp-C (* cstp-C nc-C) :type index-type)
+ (d.rstp-B (- rstp-B (* cstp-B nc-C)) :type index-type)
+ (d.rstp-A (- rstp-A (* cstp-A dotl)) :type index-type))
+ (very-quickly
+ (loop :repeat (floor nr-C bs)
+ :do (progn
+ (loop :repeat (floor dotl bs)
+ :do (loop :repeat (min ( (let-typed ((ele-A (aref sto-A of-A) :type real-type))
+ (loop :repeat nc-C
+ :do (progn
+ (incf (aref sto-C of-C) (* ele-A (aref sto-B of-B)))
+ (incf of-C #+nil cstp-C)
+ (incf of-B #+nil cstp-B)))
+ (decf of-C r.cstp-C)
+ (incf of-A cstp-A)
+ (incf of-B d.rstp-B)))
+ (incf of-C (* rstp-C bs))
+ (incf of-A d.rstp-A)
+ (setf of-B hd-B))))))
+ t))))
(defun test-mm-lisp-lin (n)
(declare (type fixnum n))
diff --git a/tests/tcomp.lisp b/tests/tcomp.lisp
new file mode 100644
index 0000000..36c0683
--- /dev/null
+++ b/tests/tcomp.lisp
@@ -0,0 +1,47 @@
+(in-package :matlisp)
+
+(defparameter *tclause* '(einstein-sum (ref C i j) (* (ref A i k) (ref A j k))))
+(defparameter *mclause* '(einstein-sum (ref C i j) (* (ref A i k) (ref B k j))))
+
+(loop-generator 'real-tensor '(k j i) (second *tclause*) (third *tclause*))
+(loop-generator 'real-tensor '(i j k) (second *mclause*) (third *mclause*) :tight-iloop t)
+
+(defun mm-test-simple (a b c)
+ (declare (type real-tensor a b c))
+ (einstein-sum real-tensor (j k i) (ref c i j) (* (ref a i k) (ref b k j))))
+
+(define-einstein-sum mm-test (a b c) (real-tensor (ref c i j) (* (ref a i k) (ref b k j))))
+
+(let ((thingy #'(lambda (a b c) (einstein-sum real-tensor (j k i) (ref c i j) (* (ref a i k) (ref b k j))))))
+ (let ((x (copy! #2a((1 2) (3 4)) (zeros '(2 2))))
+ (y (copy! #2a((4 5) (6 5)) (zeros '(2 2))))
+ (z (zeros '(2 2))))
+ (time (dotimes (i 1000) (funcall thingy x y z)))))
+
+(defun mat-square (a c)
+ (einstein-sum real-tensor (j k i) (ref c i j) (* (ref a i k) (ref a k j)) t))
+
+(let ((x (copy! #2a((1 2) (3 4)) (zeros '(2 2))))
+ (y (copy! #2a((4 5) (6 5)) (zeros '(2 2))))
+ (z (zeros '(2 2))))
+ (time
+ (dotimes (i 1000)
+ (copy! 0 z)
+ (mm-test x y z)))
+ (print (mm-test x y (zeros '(2 2) 'real-tensor))))
+
+(let ((x (copy! #2a((1 2) (3 4)) (zeros '(2 2))))
+ (y (copy! #2a((4 5) (6 5)) (zeros '(2 2))))
+ (z (zeros '(2 2))))
+ (time (mm-test x y z)))
+
+(let ((x (zeros '(1000 1000)))
+ (y (transpose! (zeros '(1000 1000))))
+ (z (zeros '(1000 1000))))
+ (let-typed ((sto-x (store x) :type (simple-array double-float))
+ (sto-y (store y) :type (simple-array double-float)))
+ (loop :for i :from 0 :below (array-dimension sto-x 0)
+ :do (setf (aref sto-x i) (random 1d0)
+ (aref sto-y i) (random 1d0))))
+ (time (mm-test x y z))
+ t)
-----------------------------------------------------------------------
Summary of changes:
src/base/einstein.lisp | 322 ++++++++++++++++++++++++++++--------------------
tests/loopy-tests.lisp | 48 +++++++
tests/tcomp.lisp | 47 +++++++
3 files changed, 286 insertions(+), 131 deletions(-)
create mode 100644 tests/tcomp.lisp
hooks/post-receive
--
matlisp
|
