source: trunk/abcl/src/org/armedbear/lisp/extensible-sequences-base.lisp

Last change on this file was 12516, checked in by astalla, 11 years ago

Support for user-extensible sequences, adapted from SBCL.

File size: 3.6 KB
Line 
1;;;This file only defines the minimum set of symbols and operators
2;;;that is needed to make standard CL sequence functions refer to generic
3;;;functions in the SEQUENCE package, without actually definining those
4;;;generic functions and supporting code, which is in extensible-sequences.lisp.
5;;;
6;;;The rationale for splitting the code this way is that CLOS depends on
7;;;some sequence functions, and if those in turn depend on CLOS we have
8;;;a circular dependency.
9
10(in-package :sequence)
11
12(shadow '(ELT LENGTH COUNT "COUNT-IF" "COUNT-IF-NOT"
13    "FIND" "FIND-IF" "FIND-IF-NOT"
14    "POSITION" "POSITION-IF" "POSITION-IF-NOT"
15    "SUBSEQ" "COPY-SEQ" "FILL"
16    "NSUBSTITUTE" "NSUBSTITUTE-IF" "NSUBSTITUTE-IF-NOT"
17    "SUBSTITUTE" "SUBSTITUTE-IF" "SUBSTITUTE-IF-NOT"
18    "REPLACE" "REVERSE" "NREVERSE" "REDUCE"
19    "MISMATCH" "SEARCH"
20    "DELETE" "DELETE-IF" "DELETE-IF-NOT"
21    "REMOVE" "REMOVE-IF" "REMOVE-IF-NOT"
22    "DELETE-DUPLICATES" "REMOVE-DUPLICATES" "SORT" "STABLE-SORT"))
23
24(export '(DOSEQUENCE
25   
26    MAKE-SEQUENCE-ITERATOR MAKE-SIMPLE-SEQUENCE-ITERATOR
27   
28    ITERATOR-STEP ITERATOR-ENDP ITERATOR-ELEMENT
29    ITERATOR-INDEX ITERATOR-COPY
30   
31    WITH-SEQUENCE-ITERATOR WITH-SEQUENCE-ITERATOR-FUNCTIONS
32   
33    CANONIZE-TEST CANONIZE-KEY
34   
35    LENGTH ELT
36    MAKE-SEQUENCE-LIKE ADJUST-SEQUENCE
37     
38    COUNT COUNT-IF COUNT-IF-NOT
39    FIND FIND-IF FIND-IF-NOT
40    POSITION POSITION-IF POSITION-IF-NOT
41    SUBSEQ COPY-SEQ FILL
42    NSUBSTITUTE NSUBSTITUTE-IF NSUBSTITUTE-IF-NOT
43    SUBSTITUTE SUBSTITUTE-IF SUBSTITUTE-IF-NOT
44    REPLACE REVERSE NREVERSE REDUCE
45    MISMATCH SEARCH
46    DELETE DELETE-IF DELETE-IF-NOT
47    REMOVE REMOVE-IF REMOVE-IF-NOT
48    DELETE-DUPLICATES REMOVE-DUPLICATES SORT STABLE-SORT))
49
50;;; Adapted from SBCL
51;;; SEQ-DISPATCH does an efficient type-dispatch on the given SEQUENCE.
52;;;
53;;; FIXME: It might be worth making three cases here, LIST,
54;;; SIMPLE-VECTOR, and VECTOR, instead of the current LIST and VECTOR.
55;;; It tends to make code run faster but be bigger; some benchmarking
56;;; is needed to decide.
57(defmacro seq-dispatch
58    (sequence list-form array-form &optional other-form)
59  `(if (listp ,sequence)
60       (let ((,sequence (ext:truly-the list ,sequence)))
61         (declare (ignorable ,sequence))
62         ,list-form)
63       ,@(if other-form
64             `((if (arrayp ,sequence)
65                   (let ((,sequence (ext:truly-the vector ,sequence)))
66                     (declare (ignorable ,sequence))
67                     ,array-form)
68                   (if (typep ,sequence 'sequence)
69           ,other-form
70           (error 'type-error
71            :datum ,sequence :expected-type 'sequence))))
72             `((let ((,sequence (ext:truly-the vector ,sequence)))
73                 (declare (ignorable ,sequence))
74                 ,array-form)))))
75
76(defun %check-generic-sequence-bounds (seq start end)
77  (let ((length (sequence:length seq)))
78    (if (<= 0 start (or end length) length)
79        (or end length)
80        (sequence-bounding-indices-bad-error seq start end))))
81
82(defun sequence-bounding-indices-bad-error (sequence start end)
83  (let ((size (length sequence)))
84    (error "The bounding indices ~S and ~S are bad for a sequence of length ~S"
85     start end size)))
86
87(defun %set-elt (sequence index value)
88  (seq-dispatch sequence
89     (sys::%set-elt sequence index value)
90     (sys::%set-elt sequence index value)
91     (setf (sequence:elt sequence index) value)))
92
93(defsetf cl:elt %set-elt)
94
95#|
96    (error 'bounding-indices-bad-error
97           :datum (cons start end)
98           :expected-type `(cons (integer 0 ,size)
99                                 (integer ,start ,size))
100           :object sequence)))|#
101
102(provide "EXTENSIBLE-SEQUENCES-BASE")
Note: See TracBrowser for help on using the repository browser.