[lisplab-cvs] r232 - in trunk/src: interface/1 vector/1/df
jivestgarden at common-lisp.net
jivestgarden at common-lisp.net
Sun Apr 29 19:24:02 UTC 2012
Author: jivestgarden
Date: Sun Apr 29 12:24:01 2012
New Revision: 232
Log:
Unfinished macro stuff
Modified:
trunk/src/interface/1/vector1-base.lisp
trunk/src/vector/1/df/vector1-d.lisp
Modified: trunk/src/interface/1/vector1-base.lisp
==============================================================================
--- trunk/src/interface/1/vector1-base.lisp Sat Apr 28 08:37:42 2012 (r231)
+++ trunk/src/interface/1/vector1-base.lisp Sun Apr 29 12:24:01 2012 (r232)
@@ -31,5 +31,33 @@
:reader vector-store
:type (simple-array t (*)))))
+;;; TODO make similar macros for integer types, that would be more useful
+(defmacro ll-def-vector-class (class-name element-parent store-type)
+ `(defclass ,class-name (vector-base ,element-parent)
+ ((store :initarg :store
+ :initform nil
+ :reader vector-store
+ :type ,store-type))))
+(defmacro ll-def-vref (class-name store-type)
+ (let ((v (gensym "vector"))
+ (idx (gensym "idx")))
+ `(defmethod vref ((,v ,class-name) ,idx)
+ (aref (the ,store-type (slot-value ,v 'store)) ,idx))))
+
+(defmacro ll-def-setf-vref (class-name store-type element-type)
+ (let ((v (gensym "vector"))
+ (idx (gensym "idx"))
+ (value (gensym "value")))
+ `(defmethod (setf vref) (,value (,v ,class-name) ,idx)
+ (let ((,value (coerce ,value ',element-type)))
+ (declare (type ,element-type ,value))
+ (setf (aref (the ,store-type (slot-value ,v 'store)) ,idx)
+ ,value)
+ ,value))))
+
+(defmacro ll-def-vector1-class-and-vref (class-name element-parent store-type element-type)
+ `(progn (ll-def-vector-class ,class-name ,element-parent ,store-type)
+ (ll-def-vref ,class-name ,store-type)
+ (ll-def-setf-vref ,class-name ,store-type ,element-type)))
Modified: trunk/src/vector/1/df/vector1-d.lisp
==============================================================================
--- trunk/src/vector/1/df/vector1-d.lisp Sat Apr 28 08:37:42 2012 (r231)
+++ trunk/src/vector/1/df/vector1-d.lisp Sun Apr 29 12:24:01 2012 (r232)
@@ -19,6 +19,8 @@
(in-package :lisplab)
+;; (ll-def-vector1-class-and-vref vector-d element-double-float type-blas-store double-float)
+
(defclass vector-d (vector-base element-double-float)
((store :initarg :store
:initform nil
More information about the lisplab-cvs
mailing list