Many resources are needed to download a project. Please understand that we have to compensate our server costs. Thank you in advance. Project price only 1 $
You can buy this project and download/modify it how often you want.
;;; find.lisp
;;;
;;; Copyright (C) 2003-2005 Peter Graves
;;; $Id$
;;;
;;; 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.
;;;
;;; As a special exception, the copyright holders of this library give you
;;; permission to link this library with independent modules to produce an
;;; executable, regardless of the license terms of these independent
;;; modules, and to copy and distribute the resulting executable under
;;; terms of your choice, provided that you also meet, for each linked
;;; independent module, the terms and conditions of the license of that
;;; module. An independent module is a module which is not derived from
;;; or based on this library. If you modify this library, you may extend
;;; this exception to your version of the library, but you are not
;;; obligated to do so. If you do not wish to do so, delete this
;;; exception statement from your version.
(in-package #:system)
(require "EXTENSIBLE-SEQUENCES-BASE")
;;; From CMUCL.
(defmacro vector-locater-macro (sequence body-form return-type)
`(let ((incrementer (if from-end -1 1))
(start (if from-end (1- (the fixnum end)) start))
(end (if from-end (1- (the fixnum start)) end)))
(declare (fixnum start end incrementer))
(do ((index start (+ index incrementer))
,@(case return-type (:position nil) (:element '(current))))
((= index end) ())
(declare (fixnum index))
,@(case return-type
(:position nil)
(:element `((setf current (aref ,sequence index)))))
,body-form)))
(defmacro locater-test-not (item sequence seq-type return-type)
(let ((seq-ref (case return-type
(:position
(case seq-type
(:vector `(aref ,sequence index))
(:list `(pop ,sequence))))
(:element 'current)))
(return (case return-type
(:position 'index)
(:element 'current))))
`(if test-not
(if (not (funcall test-not ,item (sys::apply-key key ,seq-ref)))
(return ,return))
(if (funcall test ,item (sys::apply-key key ,seq-ref))
(return ,return)))))
(defmacro vector-locater (item sequence return-type)
`(vector-locater-macro ,sequence
(locater-test-not ,item ,sequence :vector ,return-type)
,return-type))
(defmacro locater-if-test (test sequence seq-type return-type sense)
(let ((seq-ref (case return-type
(:position
(case seq-type
(:vector `(aref ,sequence index))
(:list `(pop ,sequence))))
(:element 'current)))
(return (case return-type
(:position 'index)
(:element 'current))))
(if sense
`(if (funcall ,test (sys::apply-key key ,seq-ref))
(return ,return))
`(if (not (funcall ,test (sys::apply-key key ,seq-ref)))
(return ,return)))))
(defmacro vector-locater-if-macro (test sequence return-type sense)
`(vector-locater-macro ,sequence
(locater-if-test ,test ,sequence :vector ,return-type ,sense)
,return-type))
(defmacro vector-locater-if (test sequence return-type)
`(vector-locater-if-macro ,test ,sequence ,return-type t))
(defmacro vector-locater-if-not (test sequence return-type)
`(vector-locater-if-macro ,test ,sequence ,return-type nil))
(defmacro list-locater-macro (sequence body-form return-type)
`(if from-end
(do ((sequence (nthcdr (- (the fixnum (length sequence))
(the fixnum end))
(reverse (the list ,sequence))))
(index (1- (the fixnum end)) (1- index))
(terminus (1- (the fixnum start)))
,@(case return-type (:position nil) (:element '(current))))
((or (= index terminus) (null sequence)) ())
(declare (fixnum index terminus))
,@(case return-type
(:position nil)
(:element `((setf current (pop ,sequence)))))
,body-form)
(do ((sequence (nthcdr start ,sequence))
(index start (1+ index))
,@(case return-type (:position nil) (:element '(current))))
((or (= index (the fixnum end)) (null sequence)) ())
(declare (fixnum index))
,@(case return-type
(:position nil)
(:element `((setf current (pop ,sequence)))))
,body-form)))
(defmacro list-locater (item sequence return-type)
`(list-locater-macro ,sequence
(locater-test-not ,item ,sequence :list ,return-type)
,return-type))
(defmacro list-locater-if-macro (test sequence return-type sense)
`(list-locater-macro ,sequence
(locater-if-test ,test ,sequence :list ,return-type ,sense)
,return-type))
(defmacro list-locater-if (test sequence return-type)
`(list-locater-if-macro ,test ,sequence ,return-type t))
(defmacro list-locater-if-not (test sequence return-type)
`(list-locater-if-macro ,test ,sequence ,return-type nil))
(defmacro vector-position (item sequence)
`(vector-locater ,item ,sequence :position))
(defmacro list-position (item sequence)
`(list-locater ,item ,sequence :position))
(defun position (item sequence &rest args &key from-end (test #'eql) test-not
(start 0) end key)
(sequence::seq-dispatch sequence
(list-position* item sequence from-end test test-not start end key)
(vector-position* item sequence from-end test test-not start end key)
(apply #'sequence:position item sequence args)))
(defun list-position* (item sequence from-end test test-not start end key)
(declare (type fixnum start))
(let ((end (or end (length sequence))))
(declare (type fixnum end))
(list-position item sequence)))
(defun vector-position* (item sequence from-end test test-not start end key)
(declare (type fixnum start))
(let ((end (or end (length sequence))))
(declare (type fixnum end))
(vector-position item sequence)))
(defmacro vector-position-if (test sequence)
`(vector-locater-if ,test ,sequence :position))
(defmacro list-position-if (test sequence)
`(list-locater-if ,test ,sequence :position))
(defun position-if (test sequence &rest args &key from-end (start 0) key end)
(declare (type fixnum start))
(let ((end (or end (length sequence))))
(declare (type fixnum end))
(sequence::seq-dispatch sequence
(list-position-if test sequence)
(vector-position-if test sequence)
(apply #'sequence:position-if test sequence args))))
(defmacro vector-position-if-not (test sequence)
`(vector-locater-if-not ,test ,sequence :position))
(defmacro list-position-if-not (test sequence)
`(list-locater-if-not ,test ,sequence :position))
(defun position-if-not (test sequence &rest args &key from-end (start 0) key end)
(declare (type fixnum start))
(let ((end (or end (length sequence))))
(declare (type fixnum end))
(sequence::seq-dispatch sequence
(list-position-if-not test sequence)
(vector-position-if-not test sequence)
(apply #'sequence:position-if-not test sequence args))))
(defmacro vector-find (item sequence)
`(vector-locater ,item ,sequence :element))
(defmacro list-find (item sequence)
`(list-locater ,item ,sequence :element))
(defun list-find* (item sequence from-end test test-not start end key)
(declare (type fixnum start end))
(unless (or test test-not)
(setf test 'eql))
(list-find item sequence))
(defun vector-find* (item sequence from-end test test-not start end key)
(declare (type fixnum start end))
(unless (or test test-not)
(setf test 'eql))
(vector-find item sequence))
(defun find (item sequence &rest args &key from-end (test #'eql) test-not
(start 0) end key)
(let ((end (check-sequence-bounds sequence start end)))
(sequence::seq-dispatch sequence
(list-find* item sequence from-end test test-not start end key)
(vector-find* item sequence from-end test test-not start end key)
(apply #'sequence:find item sequence args))))
(defmacro vector-find-if (test sequence)
`(vector-locater-if ,test ,sequence :element))
(defmacro list-find-if (test sequence)
`(list-locater-if ,test ,sequence :element))
(defun find-if (test sequence &rest args &key from-end (start 0) end key)
(let ((end (or end (length sequence))))
(declare (type fixnum end))
(sequence::seq-dispatch sequence
(list-find-if test sequence)
(vector-find-if test sequence)
(apply #'sequence:find-if test sequence args))))
(defmacro vector-find-if-not (test sequence)
`(vector-locater-if-not ,test ,sequence :element))
(defmacro list-find-if-not (test sequence)
`(list-locater-if-not ,test ,sequence :element))
(defun find-if-not (test sequence &rest args &key from-end (start 0) end key)
(let ((end (or end (length sequence))))
(declare (type fixnum end))
(sequence::seq-dispatch sequence
(list-find-if-not test sequence)
(vector-find-if-not test sequence)
(apply #'sequence:find-if-not test sequence args))))
