;;;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")
