[lisplab-cvs] r81 - in src: core matrix
Jørn Inge Vestgården
jivestgarden at common-lisp.net
Mon Aug 10 18:58:47 UTC 2009
Author: jivestgarden
Date: Mon Aug 10 14:58:46 2009
New Revision: 81
Log:
cleaned up on function expansions.
Modified:
src/core/level0-basic.lisp
src/core/level0-functions.lisp
src/core/level0-interface.lisp
src/matrix/level2-generic.lisp
src/matrix/level2-matrix-dge.lisp
src/matrix/level2-matrix-zge.lisp
Modified: src/core/level0-basic.lisp
==============================================================================
--- src/core/level0-basic.lisp (original)
+++ src/core/level0-basic.lisp Mon Aug 10 14:58:46 2009
@@ -26,7 +26,9 @@
;; Here non ansi stuff.
;; First we need the truely-the macro
-#+cbcl(import 'sb-ext::truly-the)
+#+sbcl(import 'sb-ext::truly-the)
+;; Help, not tested
+#-sbcl(defmacro truely-the (type val) `(the ,type ,val))
(setf *READ-DEFAULT-FLOAT-FORMAT* 'double-float) ; TODO make part of pacakge import?
Modified: src/core/level0-functions.lisp
==============================================================================
--- src/core/level0-functions.lisp (original)
+++ src/core/level0-functions.lisp Mon Aug 10 14:58:46 2009
@@ -92,31 +92,35 @@
(defmethod .>= ((a number) (b number))
(>= a b))
-(defmacro expand-on-numbers-lisplab-two-argument-functions-alist ()
- ;; TODO: optimize? why?
- (cons 'progn
- (mapcar (lambda (name)
- `(defmethod ,(car name) ((a number) (b number))
- (,(cdr name) a b)))
- +lisplab-two-argument-functions-alist+)))
-(expand-on-numbers-lisplab-two-argument-functions-alist)
+;;; The default operators on numbers
-#+why-did-I-do-this?(defmethod .expt ((a real) (b real))
- (expt (to-df a) b))
+(defmethod .add ((a number) (b number))
+ (+ a b))
+
+(defmethod .mul ((a number) (b number))
+ (* a b))
-(defmacro expand-on-numbers-lisplab-one-argument-functions-alist ()
+(defmethod .div ((a number) (b number))
+ (/ a b))
+
+(defmethod .sub ((a number) (b number))
+ (- a b))
+
+(defmethod .expt ((a number) (b number))
+ (expt a b))
+
+
+(defmacro expand-num-num ()
;; TODO: optimize? why?
(cons 'progn
(mapcar (lambda (name)
`(progn
(defmethod ,(car name) ((a number))
- (,(cdr name) a))
- (defmethod ,(car name) ((a real))
- (,(cdr name) (to-df a)))))
- +lisplab-one-argument-functions-alist+)))
+ (,(cdr name) a))))
+ +functions-real-to-real+)))
-(expand-on-numbers-lisplab-one-argument-functions-alist)
+(expand-num-num)
(defmethod .log ((x number) &optional (base nil))
(if base
@@ -131,28 +135,35 @@
(defmethod .sqr ((x number))
(* x x))
-(defmethod .sqr ((x real))
+(defmethod .sqr ((x float))
(let ((x (to-df x)))
(* x x)))
-#|
-(defmethod .add ((a number) (b number))
- (+ a b))
-(defmethod .mul ((a number) (b number))
- (* a b))
-(defmethod .div ((a number) (b number))
- (/ a b))
-(defmethod .sub ((a number) (b number))
- (- a b))
-(defmethod .expt ((a number) (b number))
- (expt a b))
+
+
+#+nil (defmacro expand-on-numbers-lisplab-two-argument-functions-alist ()
+ ;; TODO: optimize? why?
+ (cons 'progn
+ (mapcar (lambda (name)
+ `(defmethod ,(car name) ((a number) (b number))
+ (,(cdr name) a b)))
+ +lisplab-two-argument-functions-alist+)))
+
+#+nil (expand-on-numbers-lisplab-two-argument-functions-alist)
+
+#+why-did-I-do-this?(defmethod .expt ((a real) (b real))
+ (expt (to-df a) b))
+
+
+#|
+
(defmethod .expt ((a real) (b real))
Modified: src/core/level0-interface.lisp
==============================================================================
--- src/core/level0-interface.lisp (original)
+++ src/core/level0-interface.lisp Mon Aug 10 14:58:46 2009
@@ -43,32 +43,28 @@
.erf .erfc
.gamma))
-(define-constant +lisplab-one-argument-functions+
- '(.sin .cos .tan .asin .acos .atan
- .sinh .cosh .tanh .asinh .acosh .atanh
- .exp .sqr .sqrt .conj)
- ;; List of "nice" functions that output real to real, have one argument.
- ;; Not part of the list: .log, .conj, .realpart, .imagpart and most special functions
- "Functions functions that takes exactly one argument and preserve type.")
+(define-constant +functions-real-to-real+
+ '((.sin . sin) (.cos . cos) (.tan . tan)
+ (.asin . asin) (.acos . acos) (.atan . atan)
+ (.sinh . sinh) (.cosh . cosh) (.tanh . tanh)
+ (.asinh . asinh) (.acosh . acosh) (.atanh . atanh)
+ (.exp . exp) (.sqr . .sqr) (.sqrt . sqrt) (.conj . conjugate)
+ (.realpart . realpart) (.imagpart . imagpart) (.abs . abs)
+ (.erf . .erf) (.erfc . .erfc)
+ (.gamma . .gamma))
+ "Functions of one argument that map real to real.")
+
+;; Other functions: log, .besj, .besy, .besi, .besk, .besh1, .besh2, .ai
-(define-constant +lisplab-one-argument-functions-alist+
+(define-constant +functions-complex-to-complex+
'((.sin . sin) (.cos . cos) (.tan . tan)
(.asin . asin) (.acos . acos) (.atan . atan)
(.sinh . sinh) (.cosh . cosh) (.tanh . tanh)
(.asinh . asinh) (.acosh . acosh) (.atanh . atanh)
- (exp. . exp) (.sqrt . sqrt) (.conj . conjugate))
- ;; List of "nice" functions that output real to real, have one argument,
- ;; and a analogy in the Common Lisp package.
- ;; Note part of the list: .log, .sq, and all special functions
- "A map between lisplab and common lisp functions that take exactly one argument.")
-
-(define-constant +lisplab-two-argument-functions+
- '(.add .sub .mul .div .expt)
- "Functions functions that takes exactly one argument and preserve type.")
-
-(define-constant +lisplab-two-argument-functions-alist+
- '((.add . +) (.sub . -) (.mul . *) (.div . /) (.expt . expt))
- "A map between lisplab and common lisp functions that take exactly two arguments.")
+ (.exp . exp) (.sqrt . sqrt) (.conj . conjugate)
+ (.erf . .erf) (.erfc . .erfc)
+ (.gamma . .gamma))
+ "Functions of one argument that maps complex to complex.")
(defgeneric scalar? (x)
(:documentation "A scalar is a object with ignored internal structure."))
Modified: src/matrix/level2-generic.lisp
==============================================================================
--- src/matrix/level2-generic.lisp (original)
+++ src/matrix/level2-generic.lisp Mon Aug 10 14:58:46 2009
@@ -257,15 +257,6 @@
(setf (vref ,a ,i) (,op (vref ,a ,i) (vref ,b ,i))))
,a)))))
-(defmacro expand-on-matrix-ge-lisplab-two-argument-functions-alist ()
- (cons 'progn
- (mapcar (lambda (name)
- `(def-binary-op-matrix-ge ,(car name)))
- +lisplab-two-argument-functions-alist+)))
-
-(expand-on-matrix-ge-lisplab-two-argument-functions-alist)
-
-#|
(def-binary-op-matrix-ge .add)
(def-binary-op-matrix-ge .mul)
@@ -275,7 +266,10 @@
(def-binary-op-matrix-ge .div)
(def-binary-op-matrix-ge .expt)
-|#
+
+(def-binary-op-matrix-ge .min)
+
+(def-binary-op-matrix-ge .max)
(defmacro each-element-function-matrix-ge (x form)
"Applies a form on each element of an matrix-ge."
@@ -288,33 +282,19 @@
,form)))
,y)))
-(defmacro expand-on-matrix-ge-lisplab-one-argument-functions-alist ()
+(defmacro expand-matrix-ge-num-num ()
(cons 'progn
(mapcar (lambda (name)
+ ;; Note: not using the (cdr name) , which is only valid for build in lisp types.
`(defmethod ,(car name) ((x matrix-ge))
(each-element-function-matrix-ge x (,(car name) x))))
- +lisplab-one-argument-functions-alist+)))
-
-(expand-on-matrix-ge-lisplab-one-argument-functions-alist)
-
-
-
-(defmethod .imagpart ((x matrix-ge))
- (each-element-function-matrix-ge x (.imagpart x)))
-
-(defmethod .realpart ((x matrix-ge))
- (each-element-function-matrix-ge x (.realpart x)))
-
-(defmethod .abs ((x matrix-ge))
- (each-element-function-matrix-ge x (.abs x)))
+ +functions-real-to-real+)))
+(expand-matrix-ge-num-num)
(defmethod .log ((x matrix-ge) &optional base)
(each-element-function-matrix-ge x (.log x base)))
-(defmethod .sqr ((x matrix-ge))
- (each-element-function-matrix-ge x (.sqr x)))
-
;;; Bessel functions
Modified: src/matrix/level2-matrix-dge.lisp
==============================================================================
--- src/matrix/level2-matrix-dge.lisp (original)
+++ src/matrix/level2-matrix-dge.lisp Mon Aug 10 14:58:46 2009
@@ -50,18 +50,6 @@
(incf sum (aref m0 i)))
sum))
-
-(defmethod .imagpart ((a matrix-base-dge))
- (mcreate a 0))
-
-(defmethod .realpart ((a matrix-base-dge))
- (copy a))
-
-(defmethod .abs ((a matrix-base-dge))
- (let ((b (mcreate a)))
- (copy-contents a b #'abs)
- b))
-
(defmethod .some (pred (a matrix-base-dge) &rest args)
(let ((stores (mapcar #'matrix-store (cons a args))))
(apply #'some pred stores)))
@@ -112,13 +100,20 @@
(setf (aref ,store ,i) (,old (aref ,store ,i) (aref ,store2 ,i))))
,a)))))
-(defmacro expand-on-matrix-dge-lisplab-two-argument-functions-alist ()
- (cons 'progn
- (mapcar (lambda (name)
- `(def-binary-op-matrix-base-dge ,(car name) ,(cdr name)))
- +lisplab-two-argument-functions-alist+)))
+(def-binary-op-matrix-base-dge .add +)
+
+(def-binary-op-matrix-base-dge .sub -)
+
+(def-binary-op-matrix-base-dge .mul *)
+
+(def-binary-op-matrix-base-dge .div /)
+
+(def-binary-op-matrix-base-dge .expt expt)
+
+(def-binary-op-matrix-base-dge .min min)
+
+(def-binary-op-matrix-base-dge .max max)
-(expand-on-matrix-dge-lisplab-two-argument-functions-alist)
(defmacro each-matrix-element-df-to-df (x form)
"Applies a form on each element of an matrix-dge. The form must
@@ -133,36 +128,24 @@
(declare (type type-blas-idx ,i)
(type double-float ,x))
(setf (aref ,store ,i)
- ,form)))
+ ,form)))
,x)))
-(defmacro expand-on-matrix-dge-lisplab-one-argument-functions-alist ()
+(defmacro expand-matrix-dge-num-num ()
(cons 'progn
(mapcar (lambda (name)
`(defmethod ,(car name) ((x matrix-base-dge))
(each-matrix-element-df-to-df x (,(cdr name) x))))
- +lisplab-one-argument-functions-alist+)))
+ +functions-real-to-real+)))
+
+(expand-matrix-dge-num-num)
-(expand-on-matrix-dge-lisplab-one-argument-functions-alist)
(defmethod .log ((x matrix-base-dge) &optional base)
(if base
(each-matrix-element-df-to-df x (log x base))
(each-matrix-element-df-to-df x (log x))))
-(defmethod .sqr ((x matrix-base-dge))
- (each-matrix-element-df-to-df x (* x x)))
-
-;;; Other spacial functions
-
-(defmethod .erf ((x matrix-base-dge))
- (each-matrix-element-df-to-df x (.erf x)))
-
-(defmethod .erfc ((x matrix-base-dge))
- (each-matrix-element-df-to-df x (.erfc x)))
-
-(defmethod .gamma ((x matrix-base-dge))
- (each-matrix-element-df-to-df x (.gamma x)))
;;; Bessel functions
@@ -198,3 +181,27 @@
(defmethod .besh2 (n (x matrix-base-dge))
(each-matrix-element-df-to-complex-df x (.besh2 n x)))
+
+#|
+
+
+(defmethod .imagpart ((a matrix-base-dge))
+ (mcreate a 0))
+
+(defmethod .realpart ((a matrix-base-dge))
+ (copy a))
+
+(defmethod .abs ((a matrix-base-dge))
+ (let ((b (mcreate a)))
+ (copy-contents a b #'abs)
+ b))
+
+
+(defmacro expand-on-matrix-dge-lisplab-two-argument-functions-alist ()
+ (cons 'progn
+ (mapcar (lambda (name)
+ `(def-binary-op-matrix-base-dge ,(car name) ,(cdr name)))
+ +lisplab-two-argument-functions-alist+)))
+
+(expand-on-matrix-dge-lisplab-two-argument-functions-alist)
+|#
\ No newline at end of file
Modified: src/matrix/level2-matrix-zge.lisp
==============================================================================
--- src/matrix/level2-matrix-zge.lisp (original)
+++ src/matrix/level2-matrix-zge.lisp Mon Aug 10 14:58:46 2009
@@ -135,13 +135,16 @@
(ref-blas-complex-store ,store2 ,i 0 ,len))))
,b)))))
-(defmacro expand-on-matrix-zge-lisplab-two-argument-functions-alist ()
- (cons 'progn
- (mapcar (lambda (name)
- `(def-binary-op-matrix-base-zge ,(car name) ,(cdr name)))
- +lisplab-two-argument-functions-alist+)))
+(def-binary-op-matrix-base-zge .add +)
+
+(def-binary-op-matrix-base-zge .sub -)
+
+(def-binary-op-matrix-base-zge .mul *)
+
+(def-binary-op-matrix-base-zge .div /)
+
+(def-binary-op-matrix-base-zge .expt expt)
-(expand-on-matrix-zge-lisplab-two-argument-functions-alist)
(defmacro each-element-function-matrix-base-zge (x form)
"Applies a form on each element of an matrix-base-zge."
@@ -156,23 +159,20 @@
,form)))
,y)))
-(defmacro expand-on-matrix-zge-lisplab-one-argument-functions-alist ()
+(defmacro expand-matrix-zge-num-num ()
(cons 'progn
(mapcar (lambda (name)
`(defmethod ,(car name) ((x matrix-base-zge))
(each-element-function-matrix-base-zge x (,(cdr name) x))))
- +lisplab-one-argument-functions-alist+)))
+ +functions-complex-to-complex+)))
-(expand-on-matrix-zge-lisplab-one-argument-functions-alist)
+(expand-matrix-zge-num-num)
(defmethod .log ((x matrix-base-zge) &optional base)
(if base
(each-element-function-matrix-base-zge x (log x base))
(each-element-function-matrix-base-zge x (log x))))
-(defmethod .sqr ((x matrix-base-zge))
- (each-element-function-matrix-base-zge x (* x x)))
-
;;; Bessel functions
(defmethod .besj (n (x matrix-base-zge))
@@ -194,3 +194,20 @@
(each-element-function-matrix-base-zge x (.besh2 n x)))
+
+
+#|
+
+#+nil (defmethod .sqr ((x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (* x x)))
+
+
+(defmacro expand-on-matrix-zge-lisplab-two-argument-functions-alist ()
+ (cons 'progn
+ (mapcar (lambda (name)
+ `(def-binary-op-matrix-base-zge ,(car name) ,(cdr name)))
+ +lisplab-two-argument-functions-alist+)))
+
+(expand-on-matrix-zge-lisplab-two-argument-functions-alist)
+|#
+
More information about the lisplab-cvs
mailing list