2 ;;; Copyright (c) 2005--2007, by A.J. Rossini <blindglobe@gmail.com>
3 ;;; See COPYRIGHT file for any additional restrictions (BSD license).
4 ;;; Since 1991, ANSI was finally finished. Edited for ANSI Common Lisp.
6 ;;;; lsmacros -- Various macros
8 ;;;; Copyright (c) 1991, by Luke Tierney. Permission is granted for
12 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14 ;;; Macros for LISP-STAT-BASICS Package
16 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24 (defpackage :lisp-stat-macros
26 :lisp-stat-compound-data
)
27 (:export make-rv-function make-rv-function-1
))
29 (in-package :lisp-stat-macros
)
32 ;;; Floating Point Macros
35 (defmacro declare-double
(&rest vars
) `(declare (long-float ,@vars
)))
38 ;;; Macros for Defining Vectorized Funcitons
41 (defmacro make-vectorized-function
(sym fcn
)
42 `(defun ,sym
(&rest args
)
43 (apply #'map-elements
#',fcn args
)))
45 (defmacro fixup-vectorized-doc-list
(sym)
46 `(let ((doc (documentation ',sym
'function
)))
47 (if doc
(list (format nil
"~s~%Vectorized." ,sym
)))))
51 ;; recursively vectorizes (rv) functions in dists and lispstat-math.
52 (defmacro make-rv-function
(sym fcn
&rest args
)
54 ((and args
(= (length args
) 1))
56 ,@(fixup-vectorized-doc-list fcn
)
57 (declare (inline compound-data-p
,fcn
,sym recursive-map-elements list
))
58 (if (compound-data-p ,@args
)
59 (recursive-map-elements #',fcn
#',sym
,@args
)
63 ,@(fixup-vectorized-doc-list fcn
)
64 (declare (inline compound-data-p
,fcn
,sym recursive-map-elements list
))
65 (if ,(cons 'or
(mapcar #'(lambda (x) (list 'compound-data-p x
)) args
))
66 (recursive-map-elements #',fcn
#',sym
,@args
)
69 `(defun ,sym
(&optional
(x nil has-x
) (y nil has-y
) &rest args
)
70 ,@(fixup-vectorized-doc-list fcn
)
71 (declare (inline compound-data-p
,fcn
,sym recursive-map-elements list
))
74 (if (or args
(compound-data-p x
) (compound-data-p y
))
75 (apply #'recursive-map-elements
#',fcn
#',sym x y args
)
77 (if (compound-data-p x
)
78 (recursive-map-elements #',fcn
#',sym x
)
82 (defmacro make-rv-function-1
(sym fcn
&rest args
)
84 ((and args
(= (length args
) 1))
86 ,@(fixup-vectorized-doc-list fcn
)
87 (declare (inline compound-data-p
,fcn
,sym recursive-map-elements list
))
88 (if (compound-data-p ,@args
)
89 (recursive-map-elements #',fcn
#',sym
,@args
)
93 ,@(fixup-vectorized-doc-list fcn
)
94 (declare (inline compound-data-p
,fcn
,sym recursive-map-elements list
))
95 (if ,(cons 'or
(mapcar #'(lambda (x) (list 'compound-data-p x
)) args
))
96 (recursive-map-elements #',fcn
#',sym
,@args
)
99 `(defun ,sym
(x &optional
(y nil has-y
) &rest args
)
100 ,@(fixup-vectorized-doc-list fcn
)
101 (declare (inline compound-data-p
,fcn
,sym recursive-map-elements list
))
103 (if (or args
(compound-data-p x
) (compound-data-p y
))
104 (apply #'recursive-map-elements
#',fcn
#',sym x y args
)
106 (if (compound-data-p x
)
107 (recursive-map-elements #',fcn
#',sym x
)