[lisplab-cvs] r212 - in trunk: . src/core src/matrix1 src/util src/vector1 src/vector2
jivestgarden at common-lisp.net
jivestgarden at common-lisp.net
Fri Mar 30 17:52:31 UTC 2012
Author: jivestgarden
Date: Fri Mar 30 10:52:30 2012
New Revision: 212
Log:
prepear for integer type matrices
Added:
trunk/src/vector1/level1-element.lisp
Modified:
trunk/lisplab.asd
trunk/src/core/level0-functions.lisp
trunk/src/core/level0-interface.lisp
trunk/src/matrix1/level1-classes.lisp
trunk/src/util/level1-util.lisp
trunk/src/util/ref.lisp
trunk/src/util/type.lisp
trunk/src/vector1/level1-vector.lisp
trunk/src/vector2/vector2-function.lisp
trunk/src/vector2/vector2-operator.lisp
Modified: trunk/lisplab.asd
==============================================================================
--- trunk/lisplab.asd Sat Mar 24 12:32:20 2012 (r211)
+++ trunk/lisplab.asd Fri Mar 30 10:52:30 2012 (r212)
@@ -79,7 +79,8 @@
:depends-on (:src/core)
:serial t
:components
- ((:file "level1-interface")
+ ((:file "level1-interface")
+ (:file "level1-element")
(:file "level1-vector")
))
Modified: trunk/src/core/level0-functions.lisp
==============================================================================
--- trunk/src/core/level0-functions.lisp Sat Mar 24 12:32:20 2012 (r211)
+++ trunk/src/core/level0-functions.lisp Fri Mar 30 10:52:30 2012 (r212)
@@ -119,10 +119,30 @@
(defmethod .expt ((a number) (b number))
(expt a b))
+;;;; logiclas operators
+
+(defmethod .and ((a integer) (b integer))
+ (logand a b))
+
+(defmethod .nand ((a integer) (b integer))
+ (lognand a b))
+
+(defmethod .or ((a integer) (b integer))
+ (logior a b))
+
+(defmethod .nor ((a integer) (b integer))
+ (lognor a b))
+
+(defmethod .xor ((a integer) (b integer))
+ (logxor a b))
+
+;;; The one input argument functions
(define-constant +ordinary-functions-number-to-number-map+
'((.re . realpart)(.im . imagpart) (.abs . abs)
- (.conj . conjugate)))
+ (.conj . conjugate)
+ (.not . lognot)))
+
(defmacro expand-num-num ()
;; TODO: optimize? why?
@@ -151,7 +171,9 @@
(defmethod ,(car name) ((a number))
(,(cdr name)
(if (integerp a)
- (coerce a 'double-float)
+ ;; Coerce input to double float to prevent integer input
+ ;; from becoming single-float
+ (coerce a 'double-float)
a)))))
+ordinary-functions-number-to-real-map+ )))
Modified: trunk/src/core/level0-interface.lisp
==============================================================================
--- trunk/src/core/level0-interface.lisp Sat Mar 24 12:32:20 2012 (r211)
+++ trunk/src/core/level0-interface.lisp Fri Mar 30 10:52:30 2012 (r212)
@@ -195,3 +195,22 @@
(defgeneric .gamma (x)
(:documentation "The gamma function : gamma(x)"))
+;;; logical operations
+
+(defgeneric .not (a)
+ (:documentation "The logical .not operation."))
+
+(defgeneric .and (a b)
+ (:documentation "The logical and operation."))
+
+(defgeneric .nand (a b)
+ (:documentation "The logical nand operation."))
+
+(defgeneric .or (a b)
+ (:documentation "The logical or operation."))
+
+(defgeneric .nor (a b)
+ (:documentation "The logical nor operation."))
+
+(defgeneric .xor (a b)
+ (:documentation "The logical xor operation."))
\ No newline at end of file
Modified: trunk/src/matrix1/level1-classes.lisp
==============================================================================
--- trunk/src/matrix1/level1-classes.lisp Sat Mar 24 12:32:20 2012 (r211)
+++ trunk/src/matrix1/level1-classes.lisp Fri Mar 30 10:52:30 2012 (r212)
@@ -65,76 +65,9 @@
(find-structure-class structure)
(find-implementation-class implementation)))
-;;; The matrix element tells the element type of the matrix
-
-(defgeneric find-element-mixin (spec))
-(defclass element-base ()
- ((element-type :allocation :class
- :initform t
- :reader element-type)
- (element-type-class-name :allocation :class
- :initform 'element-base
- :reader element-type-class-name)
- (element-type-spec :allocation :class
- :initform :any
- :reader element-type-spec)))
-
-
-(defclass element-number (element-base)
- ((element-type :allocation :class
- :initform 'number
- :reader element-type)
- (element-type-class-name :allocation :class
- :initform 'element-number
- :reader element-type-class-name)
- (element-type-spec :allocation :class
- :initform :number
- :reader element-type-spec)))
-
-(defclass element-complex (element-number)
- ((element-type :allocation :class
- :initform 'complex
- :reader element-type)
- (element-type-class-name :allocation :class
- :initform 'element-complex
- :reader element-type-class-name)
- (element-type-spec :allocation :class
- :initform :complex
- :reader element-type-spec)))
-
-(defclass element-complex-double-float (element-complex)
- ((element-type :allocation :class
- :initform '(complex double-float)
- :reader element-type)
- (element-type-class-name :allocation :class
- :initform 'element-complex-double-float
- :reader element-type-class-name)
- (element-type-spec :allocation :class
- :initform :z
- :reader element-type-spec)))
-
-(defclass element-real (element-number)
- ((element-type :allocation :class
- :initform 'real
- :reader element-type)
- (element-type-class-name :allocation :class
- :initform 'element-real
- :reader element-type-class-name)
- (element-type-spec :allocation :class
- :initform :real
- :reader element-type-spec)))
-
-(defclass element-double-float (element-real)
- ((element-type :allocation :class
- :initform 'double-float
- :reader element-type)
- (element-type-class-name :allocation :class
- :initform 'element-double-float
- :reader element-type-class-name)
- (element-type-spec :allocation :class
- :initform :d
- :reader element-type-spec)))
+;;; The matrix element tells the element type of the matrix
+;; TOOD remove (defgeneric find-element-mixin (spec))
;;; The implementation is a mixin intended to solve conflicts
;;; when there is one foreign and one native implementation
@@ -241,6 +174,14 @@
(defmethod find-element-type-class ((spec (eql :z)))
(find-class 'element-complex-double-float))
+(defmethod find-element-type-class ((spec (eql :ub8)))
+ (find-class 'element-ub8))
+
+(defmethod find-element-type-class ((spec (eql :sb8)))
+ (find-class 'element-sb8))
+
+
+
(defmethod find-structure-class ((spec (eql :ge)))
(find-class 'structure-general))
Modified: trunk/src/util/level1-util.lisp
==============================================================================
--- trunk/src/util/level1-util.lisp Sat Mar 24 12:32:20 2012 (r211)
+++ trunk/src/util/level1-util.lisp Fri Mar 30 10:52:30 2012 (r212)
@@ -82,4 +82,18 @@
(setf (aref store i) rv)))
store))
+;;; The unsigend-byte 8 store
+(defun allocate-ub8-store (size &optional (initial-element 0))
+ (let ((x (coerce initial-element '(unsigned-byte 8))))
+ (declare (type (unsigned-byte 8) x)
+ (type type-blas-idx size))
+ ;; Stupid efficiency hack for SBCL. Allocations of arrays with zeros
+ ;; is significantly faster than others!
+ (if (= x 0)
+ (make-array size
+ :element-type '(unsigned-byte 8)
+ :initial-element 0)
+ (make-array size
+ :element-type '(unsigned-byte 8)
+ :initial-element x))))
\ No newline at end of file
Modified: trunk/src/util/ref.lisp
==============================================================================
--- trunk/src/util/ref.lisp Sat Mar 24 12:32:20 2012 (r211)
+++ trunk/src/util/ref.lisp Fri Mar 30 10:52:30 2012 (r212)
@@ -89,6 +89,8 @@
value)
value)
+;;; The complex store
+
(declaim (inline ref-blas-complex-store (setf ref-blas-complex-store)))
(declaim (ftype (function
@@ -209,3 +211,167 @@
(setf (aref store idx) (realpart value)
(aref store (1+ idx)) (imagpart value))
value))
+
+
+;;;; The idx store
+
+(declaim (inline ref-idx-store (setf ref-idx-store)))
+
+(declaim
+ (ftype (function (type-idx-store type-blas-idx type-blas-idx type-blas-idx)
+ type-blas-idx)
+ ref-idx-store))
+
+(defun ref-idx-store (store row col rows)
+ "Matrix accessor for the UB1 store"
+ (aref (truly-the type-idx-store store)
+ (truly-the type-blas-idx
+ (column-major-idx (truly-the type-blas-idx row)
+ (truly-the type-blas-idx col)
+ rows))))
+
+(declaim
+ (ftype (function
+ (type-blas-idx type-idx-store type-blas-idx type-blas-idx type-blas-idx)
+ type-blas-idx)
+ (setf ref-idx-store)))
+
+(defun (setf ref-idx-store) (value store row col rows)
+ (setf (aref (truly-the type-idx-store store)
+ (truly-the type-blas-idx
+ (column-major-idx (truly-the type-blas-idx row)
+ (truly-the type-blas-idx col)
+ rows)))
+ value)
+ value)
+
+
+;;;; The UB1 store
+
+(declaim (inline ref-ub1-store (setf ref-ub1-store)))
+
+(declaim
+ (ftype (function (type-ub1-store type-blas-idx type-blas-idx type-blas-idx)
+ (unsigned-byte 1))
+ ref-ub1-store))
+
+(defun ref-ub1-store (store row col rows)
+ "Matrix accessor for the UB1 store"
+ (aref (truly-the type-ub1-store store)
+ (truly-the type-blas-idx
+ (column-major-idx (truly-the type-blas-idx row)
+ (truly-the type-blas-idx col)
+ rows))))
+
+(declaim
+ (ftype (function
+ ((unsigned-byte 1) type-ub1-store type-blas-idx type-blas-idx type-blas-idx)
+ (unsigned-byte 1))
+ (setf ref-ub1-store)))
+
+(defun (setf ref-ub1-store) (value store row col rows)
+ (setf (aref (truly-the type-ub1-store store)
+ (truly-the type-blas-idx
+ (column-major-idx (truly-the type-blas-idx row)
+ (truly-the type-blas-idx col)
+ rows)))
+ value)
+ value)
+
+
+;;;; The UB8 store
+
+(declaim (inline ref-ub8-store (setf ref-ub8-store)))
+
+(declaim
+ (ftype (function (type-ub8-store type-blas-idx type-blas-idx type-blas-idx)
+ (unsigned-byte 8))
+ ref-ub8-store))
+
+(defun ref-ub8-store (store row col rows)
+ "Matrix accessor for the UB8 store"
+ (aref (truly-the type-ub8-store store)
+ (truly-the type-blas-idx
+ (column-major-idx (truly-the type-blas-idx row)
+ (truly-the type-blas-idx col)
+ rows))))
+
+(declaim
+ (ftype (function
+ ((unsigned-byte 8) type-ub8-store type-blas-idx type-blas-idx type-blas-idx)
+ (unsigned-byte 8))
+ (setf ref-ub8-store)))
+
+(defun (setf ref-ub8-store) (value store row col rows)
+ (setf (aref (truly-the type-ub8-store store)
+ (truly-the type-blas-idx
+ (column-major-idx (truly-the type-blas-idx row)
+ (truly-the type-blas-idx col)
+ rows)))
+ value)
+ value)
+
+;;;; The UB16 store
+
+(declaim (inline ref-ub16-store (setf ref-ub16-store)))
+
+(declaim
+ (ftype (function (type-ub16-store type-blas-idx type-blas-idx type-blas-idx)
+ (unsigned-byte 16))
+ ref-ub16-store))
+
+(defun ref-ub16-store (store row col rows)
+ "Matrix accessor for the UB16 store"
+ (aref (truly-the type-ub16-store store)
+ (truly-the type-blas-idx
+ (column-major-idx (truly-the type-blas-idx row)
+ (truly-the type-blas-idx col)
+ rows))))
+
+(declaim
+ (ftype (function
+ ((unsigned-byte 16) type-ub16-store type-blas-idx type-blas-idx type-blas-idx)
+ (unsigned-byte 16))
+ (setf ref-ub16-store)))
+
+(defun (setf ref-ub16-store) (value store row col rows)
+ (setf (aref (truly-the type-ub16-store store)
+ (truly-the type-blas-idx
+ (column-major-idx (truly-the type-blas-idx row)
+ (truly-the type-blas-idx col)
+ rows)))
+ value)
+ value)
+
+;;;; The UB32 store
+
+(declaim (inline ref-ub32-store (setf ref-ub32-store)))
+
+(declaim
+ (ftype (function (type-ub32-store type-blas-idx type-blas-idx type-blas-idx)
+ (unsigned-byte 32))
+ ref-ub32-store))
+
+(defun ref-ub32-store (store row col rows)
+ "Matrix accessor for the UB32 store"
+ (aref (truly-the type-ub32-store store)
+ (truly-the type-blas-idx
+ (column-major-idx (truly-the type-blas-idx row)
+ (truly-the type-blas-idx col)
+ rows))))
+
+(declaim
+ (ftype (function
+ ((unsigned-byte 32) type-ub32-store type-blas-idx type-blas-idx type-blas-idx)
+ (unsigned-byte 32))
+ (setf ref-ub32-store)))
+
+(defun (setf ref-ub32-store) (value store row col rows)
+ (setf (aref (truly-the type-ub32-store store)
+ (truly-the type-blas-idx
+ (column-major-idx (truly-the type-blas-idx row)
+ (truly-the type-blas-idx col)
+ rows)))
+ value)
+ value)
+
Modified: trunk/src/util/type.lisp
==============================================================================
--- trunk/src/util/type.lisp Sat Mar 24 12:32:20 2012 (r211)
+++ trunk/src/util/type.lisp Fri Mar 30 10:52:30 2012 (r212)
@@ -41,3 +41,30 @@
'(MOD #xFFFFFFFFFFFFFFD))
#-:sbcl (deftype type-blas-idx ()
'fixnum)
+
+(deftype type-idx-store ()
+ '(simple-array type-blas-idx (*)))
+
+(deftype type-ub1-store ()
+ '(simple-array (unsigned-byte 1) (*)))
+
+(deftype type-ub8-store ()
+ '(simple-array (unsigned-byte 8) (*)))
+
+(deftype type-ub16-store ()
+ '(simple-array (unsigned-byte 16) (*)))
+
+(deftype type-ub32-store ()
+ '(simple-array (unsigned-byte 32) (*)))
+
+(deftype type-sb8-store ()
+ '(simple-array (signed-byte 8) (*)))
+
+(deftype type-sb16-store ()
+ '(simple-array (signed-byte 16) (*)))
+
+(deftype type-sb32-store ()
+ '(simple-array (signed-byte 32) (*)))
+
+
+
Added: trunk/src/vector1/level1-element.lisp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/vector1/level1-element.lisp Fri Mar 30 10:52:30 2012 (r212)
@@ -0,0 +1,179 @@
+;;; Lisplab, level1-element.lisp
+;;; Classes to help denoting element types
+
+;;; Copyright (C) 2009 Joern Inge Vestgaarden
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License along
+;;; with this program; if not, write to the Free Software Foundation, Inc.,
+;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+(in-package :lisplab)
+
+(defclass element-base ()
+ ((element-type :allocation :class
+ :initform t
+ :reader element-type)
+ (element-type-class-name :allocation :class
+ :initform 'element-base
+ :reader element-type-class-name)
+ (element-type-spec :allocation :class
+ :initform :any
+ :reader element-type-spec)))
+
+
+(defclass element-number (element-base)
+ ((element-type :allocation :class
+ :initform 'number
+ :reader element-type)
+ (element-type-class-name :allocation :class
+ :initform 'element-number
+ :reader element-type-class-name)
+ (element-type-spec :allocation :class
+ :initform :number
+ :reader element-type-spec)))
+
+(defclass element-complex (element-number)
+ ((element-type :allocation :class
+ :initform 'complex
+ :reader element-type)
+ (element-type-class-name :allocation :class
+ :initform 'element-complex
+ :reader element-type-class-name)
+ (element-type-spec :allocation :class
+ :initform :complex
+ :reader element-type-spec)))
+
+(defclass element-complex-double-float (element-complex)
+ ((element-type :allocation :class
+ :initform '(complex double-float)
+ :reader element-type)
+ (element-type-class-name :allocation :class
+ :initform 'element-complex-double-float
+ :reader element-type-class-name)
+ (element-type-spec :allocation :class
+ :initform :z
+ :reader element-type-spec)))
+
+(defclass element-real (element-number)
+ ((element-type :allocation :class
+ :initform 'real
+ :reader element-type)
+ (element-type-class-name :allocation :class
+ :initform 'element-real
+ :reader element-type-class-name)
+ (element-type-spec :allocation :class
+ :initform :real
+ :reader element-type-spec)))
+
+(defclass element-double-float (element-real)
+ ((element-type :allocation :class
+ :initform 'double-float
+ :reader element-type)
+ (element-type-class-name :allocation :class
+ :initform 'element-double-float
+ :reader element-type-class-name)
+ (element-type-spec :allocation :class
+ :initform :d
+ :reader element-type-spec)))
+
+;;;; Finite integer types
+
+(defclass element-idx (element-base)
+ ((element-type :allocation :class
+ :initform 'type-blas-idx
+ :reader element-type)
+ (element-type-class-name :allocation :class
+ :initform 'element-idx
+ :reader element-type-class-name)
+ (element-type-spec :allocation :class
+ :initform :idx
+ :reader element-type-spec)))
+
+(defclass element-ub1 (element-base)
+ ((element-type :allocation :class
+ :initform '(unsigned-byte 1)
+ :reader element-type)
+ (element-type-class-name :allocation :class
+ :initform 'element-ub1
+ :reader element-type-class-name)
+ (element-type-spec :allocation :class
+ :initform :ub1
+ :reader element-type-spec)))
+
+(defclass element-ub8 (element-base)
+ ((element-type :allocation :class
+ :initform '(unsigned-byte 8)
+ :reader element-type)
+ (element-type-class-name :allocation :class
+ :initform 'element-ub8
+ :reader element-type-class-name)
+ (element-type-spec :allocation :class
+ :initform :ub8
+ :reader element-type-spec)))
+
+(defclass element-sb8 (element-base)
+ ((element-type :allocation :class
+ :initform '(signed-byte 8)
+ :reader element-type)
+ (element-type-class-name :allocation :class
+ :initform 'element-sb8
+ :reader element-type-class-name)
+ (element-type-spec :allocation :class
+ :initform :sb8
+ :reader element-type-spec)))
+
+(defclass element-ub16 (element-base)
+ ((element-type :allocation :class
+ :initform '(unsigned-byte 16)
+ :reader element-type)
+ (element-type-class-name :allocation :class
+ :initform 'element-ub16
+ :reader element-type-class-name)
+ (element-type-spec :allocation :class
+ :initform :ub16
+ :reader element-type-spec)))
+
+(defclass element-sb16 (element-base)
+ ((element-type :allocation :class
+ :initform '(signed-byte 16)
+ :reader element-type)
+ (element-type-class-name :allocation :class
+ :initform 'element-sb16
+ :reader element-type-class-name)
+ (element-type-spec :allocation :class
+ :initform :sb16
+ :reader element-type-spec)))
+
+(defclass element-ub32 (element-base)
+ ((element-type :allocation :class
+ :initform '(unsigned-byte 32)
+ :reader element-type)
+ (element-type-class-name :allocation :class
+ :initform 'element-ub32
+ :reader element-type-class-name)
+ (element-type-spec :allocation :class
+ :initform :ub32
+ :reader element-type-spec)))
+
+(defclass element-sb32 (element-base)
+ ((element-type :allocation :class
+ :initform '(signed-byte 32)
+ :reader element-type)
+ (element-type-class-name :allocation :class
+ :initform 'element-sb32
+ :reader element-type-class-name)
+ (element-type-spec :allocation :class
+ :initform :sb32
+ :reader element-type-spec)))
+
+
Modified: trunk/src/vector1/level1-vector.lisp
==============================================================================
--- trunk/src/vector1/level1-vector.lisp Sat Mar 24 12:32:20 2012 (r211)
+++ trunk/src/vector1/level1-vector.lisp Fri Mar 30 10:52:30 2012 (r212)
@@ -97,4 +97,5 @@
(declare (type (complex double-float) val2))
(setf (ref-blas-complex-store (slot-value vector 'store) i 0 1)
val2)
- val2))
\ No newline at end of file
+ val2))
+
Modified: trunk/src/vector2/vector2-function.lisp
==============================================================================
--- trunk/src/vector2/vector2-function.lisp Sat Mar 24 12:32:20 2012 (r211)
+++ trunk/src/vector2/vector2-function.lisp Fri Mar 30 10:52:30 2012 (r212)
@@ -30,7 +30,7 @@
.sinh .cosh .tanh
.asinh .acosh .atanh
.re .im .abs .sgn
- .exp .ln .sqr .sqrt .conj ))
+ .exp .ln .sqr .sqrt .conj .not))
(defmacro expand-each-element-ordinary-functions ()
(cons 'progn
Modified: trunk/src/vector2/vector2-operator.lisp
==============================================================================
--- trunk/src/vector2/vector2-operator.lisp Sat Mar 24 12:32:20 2012 (r211)
+++ trunk/src/vector2/vector2-operator.lisp Fri Mar 30 10:52:30 2012 (r212)
@@ -134,3 +134,9 @@
(def-each-element-operator .max)
(def-each-element-operator .min)
+(def-each-element-operator .and)
+(def-each-element-operator .nand)
+(def-each-element-operator .or)
+(def-each-element-operator .nor)
+(def-each-element-operator .xor)
+
More information about the lisplab-cvs
mailing list