[lisplab-cvs] r232 - in trunk/src: interface/1 vector/1/df

[jivestgarden at common-lisp.net]

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