Line | |
---|

1 | ;;; map.lisp |
---|

2 | ;;; |
---|

3 | ;;; Copyright (C) 2003 Peter Graves |
---|

4 | ;;; $Id: map.lisp,v 1.1 2003-06-10 19:03:50 piso Exp $ |
---|

5 | ;;; |
---|

6 | ;;; This program is free software; you can redistribute it and/or |
---|

7 | ;;; modify it under the terms of the GNU General Public License |
---|

8 | ;;; as published by the Free Software Foundation; either version 2 |
---|

9 | ;;; of the License, or (at your option) any later version. |
---|

10 | ;;; |
---|

11 | ;;; This program is distributed in the hope that it will be useful, |
---|

12 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
---|

13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
---|

14 | ;;; GNU General Public License for more details. |
---|

15 | ;;; |
---|

16 | ;;; You should have received a copy of the GNU General Public License |
---|

17 | ;;; along with this program; if not, write to the Free Software |
---|

18 | ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
---|

19 | |
---|

20 | (in-package "COMMON-LISP") |
---|

21 | |
---|

22 | (export 'map) |
---|

23 | |
---|

24 | ;;; MAP (from ECL) |
---|

25 | |
---|

26 | (defun map (result-type function sequence &rest more-sequences) |
---|

27 | (setq more-sequences (cons sequence more-sequences)) |
---|

28 | (let ((l (apply #'min (mapcar #'length more-sequences)))) |
---|

29 | (if (null result-type) |
---|

30 | (do ((i 0 (1+ i)) |
---|

31 | (l l)) |
---|

32 | ((>= i l) nil) |
---|

33 | (apply function (mapcar #'(lambda (z) (elt z i)) |
---|

34 | more-sequences))) |
---|

35 | (let ((x (make-sequence result-type l))) |
---|

36 | (do ((i 0 (1+ i)) |
---|

37 | (l l)) |
---|

38 | ((>= i l) x) |
---|

39 | (setf (elt x i) |
---|

40 | (apply function (mapcar #'(lambda (z) (elt z i)) |
---|

41 | more-sequences)))))))) |
---|

**Note:** See

TracBrowser
for help on using the repository browser.