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.
;;;This file only defines the minimum set of symbols and operators
;;;that is needed to make standard CL sequence functions refer to generic
;;;functions in the SEQUENCE package, without actually definining those
;;;generic functions and supporting code, which is in extensible-sequences.lisp.
;;;
;;;The rationale for splitting the code this way is that CLOS depends on
;;;some sequence functions, and if those in turn depend on CLOS we have
;;;a circular dependency.
(in-package :sequence)
(shadow '(ELT LENGTH COUNT "COUNT-IF" "COUNT-IF-NOT"
"FIND" "FIND-IF" "FIND-IF-NOT"
"POSITION" "POSITION-IF" "POSITION-IF-NOT"
"SUBSEQ" "COPY-SEQ" "FILL"
"NSUBSTITUTE" "NSUBSTITUTE-IF" "NSUBSTITUTE-IF-NOT"
"SUBSTITUTE" "SUBSTITUTE-IF" "SUBSTITUTE-IF-NOT"
"REPLACE" "REVERSE" "NREVERSE" "REDUCE"
"MISMATCH" "SEARCH"
"DELETE" "DELETE-IF" "DELETE-IF-NOT"
"REMOVE" "REMOVE-IF" "REMOVE-IF-NOT"
"DELETE-DUPLICATES" "REMOVE-DUPLICATES" "SORT" "STABLE-SORT"))
(export '(DOSEQUENCE
MAKE-SEQUENCE-ITERATOR MAKE-SIMPLE-SEQUENCE-ITERATOR
ITERATOR-STEP ITERATOR-ENDP ITERATOR-ELEMENT
ITERATOR-INDEX ITERATOR-COPY
WITH-SEQUENCE-ITERATOR WITH-SEQUENCE-ITERATOR-FUNCTIONS
CANONIZE-TEST CANONIZE-KEY
LENGTH ELT
MAKE-SEQUENCE-LIKE ADJUST-SEQUENCE
COUNT COUNT-IF COUNT-IF-NOT
FIND FIND-IF FIND-IF-NOT
POSITION POSITION-IF POSITION-IF-NOT
SUBSEQ COPY-SEQ FILL
NSUBSTITUTE NSUBSTITUTE-IF NSUBSTITUTE-IF-NOT
SUBSTITUTE SUBSTITUTE-IF SUBSTITUTE-IF-NOT
REPLACE REVERSE NREVERSE REDUCE
MISMATCH SEARCH
DELETE DELETE-IF DELETE-IF-NOT
REMOVE REMOVE-IF REMOVE-IF-NOT
DELETE-DUPLICATES REMOVE-DUPLICATES SORT STABLE-SORT))
;;; Adapted from SBCL
;;; SEQ-DISPATCH does an efficient type-dispatch on the given SEQUENCE.
;;;
;;; FIXME: It might be worth making three cases here, LIST,
;;; SIMPLE-VECTOR, and VECTOR, instead of the current LIST and VECTOR.
;;; It tends to make code run faster but be bigger; some benchmarking
;;; is needed to decide.
(defmacro seq-dispatch
(sequence list-form array-form &optional other-form)
`(if (listp ,sequence)
(let ((,sequence (ext:truly-the list ,sequence)))
(declare (ignorable ,sequence))
,list-form)
,@(if other-form
`((if (arrayp ,sequence)
(let ((,sequence (ext:truly-the vector ,sequence)))
(declare (ignorable ,sequence))
,array-form)
(if (typep ,sequence 'sequence)
,other-form
(error 'type-error
:datum ,sequence :expected-type 'sequence))))
`((let ((,sequence (ext:truly-the vector ,sequence)))
(declare (ignorable ,sequence))
,array-form)))))
(defun %check-generic-sequence-bounds (seq start end)
(let ((length (sequence:length seq)))
(if (<= 0 start (or end length) length)
(or end length)
(sequence-bounding-indices-bad-error seq start end))))
(defun sequence-bounding-indices-bad-error (sequence start end)
(let ((size (length sequence)))
(error "The bounding indices ~S and ~S are bad for a sequence of length ~S"
start end size)))
(defun %set-elt (sequence index value)
(seq-dispatch sequence
(sys::%set-elt sequence index value)
(sys::%set-elt sequence index value)
(setf (sequence:elt sequence index) value)))
(defsetf cl:elt %set-elt)
#|
(error 'bounding-indices-bad-error
:datum (cons start end)
:expected-type `(cons (integer 0 ,size)
(integer ,start ,size))
:object sequence)))|#
(provide "EXTENSIBLE-SEQUENCES-BASE")
