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 ;;;; fastmap -- Fast version of MAP
8 ;;;; Copyright (c) 1991, by Luke Tierney. Permission is granted for
11 ;;;; The FASTMAP function is a version of MAP that is assumed to
13 ;;;; a) be reasonable fast on any combination of lists and vectors
16 ;;;; b) not hang if at least one of its arguments is not a circular
19 ;;;; This function is the core of the vectorized arithmetic system, so it
20 ;;;; may be worth optimizing for each CL implementation. I tried to improve
21 ;;;; it for (A)KCL but have not yet been able to obtain a significant
22 ;;;; increase in speed.
30 (defpackage :lisp-stat-fastmap
34 (in-package :lisp-stat-fastmap
)
42 Returns NIL unless X is a list or vector."
43 (or (listp x
) (vectorp x
)))
45 (defun cdr-lists (args)
46 (do ((list args
(cdr list
)))
48 (if (consp (car list
)) (rplaca list
(cdar list
)))))
50 (defun get-result-size (args)
51 (macrolet ((any-nulls (ls) `(dolist (x ,ls
) (if (null x
) (return t
)))))
57 (setf n
(if n
(min n
(length x
)) (length x
)))))
62 (if (or (<= n m
) (any-nulls lists
)) (return))
69 (if (any-nulls lists
) (return))
75 (defun fastmap (type fcn
&rest args
)
76 (cond ((and (eq type
'list
) (every #'listp args
))
77 (apply #'mapcar fcn args
))
78 ((and (eq type
'vector
) (every #'vectorp args
))
79 (apply #'map
'vector fcn args
))
80 ((every #'sequencep args
)
81 (let* ((n (get-result-size args
))
82 (result (make-sequence type n
))
83 (farg (make-list (length args
))))
85 (macrolet ((fill-arglist ()
86 `(do ((f farg
(cdr f
))
98 (rplaca r
(apply fcn farg
))
101 (dotimes (i n result
)
104 (setf (aref result i
) (apply fcn farg
))
105 (cdr-lists args
))))))
106 (t (error "not all sequences"))))