1 ;;;; lsmacros -- Various macros
3 ;;;; Copyright (c) 1991, by Luke Tierney. Permission is granted for
9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11 ;;; Macros for LISP-STAT-BASICS Package
13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
21 (defpackage "LISP-STAT-BASICS"
22 (:nicknames
"LS-BASICS")
23 (:use
"COMMON-LISP" "LISP-STAT-OBJECT-SYSTEM"))
25 (in-package lisp-stat-basics
))
27 (in-package 'lisp-stat-basics
28 :nicknames
'(ls-basics)
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.")))))
49 (defmacro make-rv-function
(sym fcn
&rest args
)
51 ((and args
(= (length args
) 1))
53 ,@(fixup-vectorized-doc-list fcn
)
54 (declare (inline cmpndp
,fcn
,sym recursive-map-elements list
))
56 (recursive-map-elements #',fcn
#',sym
,@args
)
60 ,@(fixup-vectorized-doc-list fcn
)
61 (declare (inline cmpndp
,fcn
,sym recursive-map-elements list
))
62 (if ,(cons 'or
(mapcar #'(lambda (x) (list 'cmpndp x
)) args
))
63 (recursive-map-elements #',fcn
#',sym
,@args
)
66 `(defun ,sym
(&optional
(x nil has-x
) (y nil has-y
) &rest args
)
67 ,@(fixup-vectorized-doc-list fcn
)
68 (declare (inline cmpndp
,fcn
,sym recursive-map-elements list
))
71 (if (or args
(cmpndp x
) (cmpndp y
))
72 (apply #'recursive-map-elements
#',fcn
#',sym x y args
)
75 (recursive-map-elements #',fcn
#',sym x
)
79 (defmacro make-rv-function-1
(sym fcn
&rest args
)
81 ((and args
(= (length args
) 1))
83 ,@(fixup-vectorized-doc-list fcn
)
84 (declare (inline cmpndp
,fcn
,sym recursive-map-elements list
))
86 (recursive-map-elements #',fcn
#',sym
,@args
)
90 ,@(fixup-vectorized-doc-list fcn
)
91 (declare (inline cmpndp
,fcn
,sym recursive-map-elements list
))
92 (if ,(cons 'or
(mapcar #'(lambda (x) (list 'cmpndp x
)) args
))
93 (recursive-map-elements #',fcn
#',sym
,@args
)
96 `(defun ,sym
(x &optional
(y nil has-y
) &rest args
)
97 ,@(fixup-vectorized-doc-list fcn
)
98 (declare (inline cmpndp
,fcn
,sym recursive-map-elements list
))
100 (if (or args
(cmpndp x
) (cmpndp y
))
101 (apply #'recursive-map-elements
#',fcn
#',sym x y args
)
104 (recursive-map-elements #',fcn
#',sym x
)