;;; -*- Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Copyright (C) 1999, 2002, 2009, 2015 Marek Rychlik ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2 of the License, or ;;; (at your option) any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defpackage "UTILS" (:use :cl) (:export "MAKELIST-1" "MAKELIST")) ;; Macros for making lists with iterators ;; ;; MAKELIST-1 makes a list with one iterator, while MAKELIST accepts an ;; arbitrary number of iterators ;; Sample usage: ;; Without a step: ;; >(makelist-1 (* 2 i) i 0 10) ;; (0 2 4 6 8 10 12 14 16 18 20) ;; With a step of 3: ;; >(makelist-1 (* 2 i) i 0 10 3) ;; (0 6 12 18) ;; Generate sums of squares of numbers between 1 and 4: ;; >(makelist (+ (* i i) (* j j)) (i 1 4) (j 1 i)) ;; (2 5 8 10 13 18 17 20 25 32) ;; >(makelist (list i j '---> (+ (* i i) (* j j))) (i 1 4) (j 1 i)) ;; ((1 1 ---> 2) (2 1 ---> 5) (2 2 ---> 8) (3 1 ---> 10) (3 2 ---> 13) ;; (3 3 ---> 18) (4 1 ---> 17) (4 2 ---> 20) (4 3 ---> 25) (4 4 ---> 32)) ;; Evaluate expression expr with variable set to lo, lo+1,... ,hi ;; and put the results in a list. (defmacro makelist-1 (expr var lo hi &optional (step 1)) (let ((l (gensym))) `(do ((,var ,lo (+ ,var ,step)) (,l nil (cons ,expr ,l))) ((> ,var ,hi) (reverse ,l)) (declare (fixnum ,var))))) (defmacro makelist (expr (var lo hi &optional (step 1)) &rest more) (if (endp more) `(makelist-1 ,expr ,var ,lo ,hi ,step) (let* ((l (gensym))) `(do ((,var ,lo (+ ,var ,step)) (,l nil (nconc ,l `,(makelist ,expr ,@more)))) ((> ,var ,hi) ,l) (declare (fixnum ,var))))))