(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED "18-Oct-93 14:37:58" "{Pele:mv:envos}<LispCore>Sources>CLTL2>CMLSEQBASICS.;2"
 10546  

      previous date%: "29-Aug-91 16:36:55" "{Pele:mv:envos}<LispCore>Sources>CLTL2>CMLSEQBASICS.;1"
)


(* ; "
Copyright (c) 1986, 1987, 1990, 1991, 1993 by Venue & Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT CMLSEQBASICSCOMS)

(RPAQQ CMLSEQBASICSCOMS

       ((DECLARE%: EVAL@COMPILE DONTCOPY (FILES CMLSEQCOMMON))
        (FUNCTIONS LISP:CONCATENATE LISP:COPY-SEQ LISP:ELT LISP:LENGTH LISP:MAKE-SEQUENCE 
               LISP:NREVERSE LISP:REVERSE LISP:SUBSEQ %%SETELT)
        (FUNCTIONS MAKE-SEQUENCE-OF-TYPE)
        (SETFS LISP:ELT LISP:SUBSEQ)
        (PROPS (CMLSEQBASICS FILETYPE))
        (DECLARE%: EVAL@COMPILE DONTCOPY DONTEVAL@LOAD (LOCALVARS . T))))
(DECLARE%: EVAL@COMPILE DONTCOPY 

(FILESLOAD CMLSEQCOMMON)
)

(LISP:DEFUN LISP:CONCATENATE
 (RESULT-TYPE &REST SEQUENCES)
   [LET [(RESULT (MAKE-SEQUENCE-OF-TYPE
 RESULT-TYPE (LET ((CNT 0))
                                                             (LISP:DOLIST (SEQ SEQUENCES CNT)
                                                                 (SETQ CNT (+ CNT (LISP:LENGTH

                                                                                   SEQ))))]
        (SEQ-DISPATCH RESULT [LET ((TAIL RESULT))
                                  (LISP:DOLIST (SEQUENCE SEQUENCES RESULT)
                                      [SEQ-DISPATCH SEQUENCE (LISP:DOLIST (ELEMENT SEQUENCE)
                                                                 (RPLACA TAIL ELEMENT)
                                                                 (SETQ TAIL (CDR TAIL)))
                                             (LISP:DOTIMES (I (VECTOR-LENGTH SEQUENCE))
                                                 (RPLACA TAIL (LISP:AREF SEQUENCE I))
                                                 (SETQ TAIL (CDR TAIL)))])]
               (LET ((INDEX 0))
                    (LISP:DOLIST (SEQUENCE SEQUENCES RESULT)
                        [SEQ-DISPATCH SEQUENCE (LISP:DOLIST (ELEMENT SEQUENCE)
                                                   (LISP:SETF (LISP:AREF RESULT INDEX)
                                                          ELEMENT)
                                                   (SETQ INDEX (LISP:1+ INDEX)))
                               (LISP:DOTIMES (I (VECTOR-LENGTH SEQUENCE))
                                   (LISP:SETF (LISP:AREF RESULT INDEX)
                                          (LISP:AREF SEQUENCE I))
                                   (SETQ INDEX (LISP:1+ INDEX)))])])

(LISP:DEFUN LISP:COPY-SEQ
 (SEQUENCE)
   "Returns a copy of SEQUENCE which is EQUALP to SEQUENCE but not EQ."
   [LET ((LENGTH (LISP:LENGTH
 SEQUENCE)))
        (SEQ-DISPATCH SEQUENCE (FORWARD-LIST-LOOP SEQUENCE 0 LENGTH (INDEX CURRENT COPY TAIL)
                                      COPY
                                      (COLLECT-ITEM CURRENT COPY TAIL))
               (LET [(COPY (MAKE-VECTOR LENGTH :ELEMENT-TYPE (LISP:ARRAY-ELEMENT-TYPE SEQUENCE]
                    (COPY-VECTOR-SUBSEQ SEQUENCE 0 LENGTH COPY 0 LENGTH])

(LISP:DEFUN LISP:ELT
 (SEQUENCE INDEX)
                                                             (* amd " 5-Jun-86 17:48")

   (LISP:IF (NOT (< -1 INDEX (LISP:LENGTH
 SEQUENCE)))
       (LISP:ERROR 'INDEX-BOUNDS-ERROR :NAME SEQUENCE :INDEX INDEX))
   (SEQ-DISPATCH SEQUENCE (LISP:NTH INDEX SEQUENCE)
          (LISP:AREF SEQUENCE INDEX)))

(LISP:DEFUN LISP:LENGTH
 (SEQUENCE)
   (SEQ-DISPATCH SEQUENCE [LET ((SIZE 0)
                                (REST SEQUENCE))
                               (LISP:LOOP (LISP:IF (NOT (LISP:CONSP REST))
                                                 (RETURN SIZE))
                                      (SETQ REST (CDR REST))
                                      (SETQ SIZE (LISP:1+ SIZE]
          (VECTOR-LENGTH SEQUENCE)))

(LISP:DEFUN LISP:MAKE-SEQUENCE
 (TYPE LENGTH &KEY (INITIAL-ELEMENT NIL INITIAL-ELEMENT-P))
   "Make a sequnce of the specified type"
   (LISP:IF (EQ TYPE 'LIST)
       (LISP:MAKE-LIST LENGTH :INITIAL-ELEMENT INITIAL-ELEMENT)
       (LET ((VECTOR (MAKE-SEQUENCE-OF-TYPE
 TYPE LENGTH)))
            (LISP:IF INITIAL-ELEMENT-P (FILL-VECTOR-SUBSEQ VECTOR 0 LENGTH INITIAL-ELEMENT))
            VECTOR)))

(LISP:DEFUN LISP:NREVERSE
 (SEQUENCE)
   "Returns a sequence of the same elements in reverse order (the argument is destroyed)."
   [SEQ-DISPATCH SEQUENCE [LET ((REST SEQUENCE)
                                LIST-HEAD RESULT)
                               (LISP:LOOP (LISP:IF (NOT (LISP:CONSP (SETQ LIST-HEAD REST)))
                                                 (RETURN RESULT))
                                      (SETQ REST (CDR REST))
                                      (SETQ RESULT (RPLACD LIST-HEAD RESULT]
          (LET ((LENGTH (VECTOR-LENGTH SEQUENCE)))
               (LISP:DO ((LEFT-INDEX 0 (LISP:1+ LEFT-INDEX))
                         (RIGHT-INDEX (LISP:1- LENGTH)
                                (LISP:1- RIGHT-INDEX))
                         (HALF-LENGTH (LRSH LENGTH 1)))
                        ((EQL LEFT-INDEX HALF-LENGTH)
                         SEQUENCE)
                   (LISP:ROTATEF (LISP:AREF SEQUENCE LEFT-INDEX)
                          (LISP:AREF SEQUENCE RIGHT-INDEX)))])

(LISP:DEFUN LISP:REVERSE
 (SEQUENCE)
   "Returns a new sequence containing the same elements but in reverse order."
   [SEQ-DISPATCH SEQUENCE [LET ((REST SEQUENCE)
                                RESULT)
                               (LISP:LOOP (LISP:IF (NOT (LISP:CONSP REST))
                                                 (RETURN RESULT))
                                      (LISP:PUSH (CAR REST)
                                             RESULT)
                                      (SETQ REST (CDR REST]
          (LET ((LENGTH (VECTOR-LENGTH SEQUENCE)))
               (LISP:DO ((RESULT (MAKE-VECTOR LENGTH :ELEMENT-TYPE (LISP:ARRAY-ELEMENT-TYPE SEQUENCE)
                                        ))
                         (FORWARD-INDEX 0 (LISP:1+ FORWARD-INDEX))
                         (BACKWARD-INDEX (LISP:1- LENGTH)
                                (LISP:1- BACKWARD-INDEX)))
                        ((EQL FORWARD-INDEX LENGTH)
                         RESULT)
                   (LISP:SETF (LISP:AREF RESULT FORWARD-INDEX)
                          (LISP:AREF SEQUENCE BACKWARD-INDEX)))])

(LISP:DEFUN LISP:SUBSEQ
 (SEQUENCE START &OPTIONAL END)
   [LET ((LENGTH (LISP:LENGTH
 SEQUENCE)))
        (LISP:IF (NULL END)
               (SETQ END LENGTH))
        (CHECK-SUBSEQ SEQUENCE START END LENGTH)
        (SEQ-DISPATCH SEQUENCE (FORWARD-LIST-LOOP SEQUENCE START END (INDEX CURRENT COPY TAIL)
                                      COPY
                                      (COLLECT-ITEM CURRENT COPY TAIL))
               (LET [(COPY (MAKE-VECTOR (- END START)
                                  :ELEMENT-TYPE
                                  (LISP:ARRAY-ELEMENT-TYPE SEQUENCE]
                    (COPY-VECTOR-SUBSEQ SEQUENCE START END COPY 0])

(LISP:DEFUN %%SETELT
 (SEQUENCE INDEX NEWVAL)
   (LISP:IF (NOT (< -1 INDEX (LISP:LENGTH
 SEQUENCE)))
       (LISP:ERROR 'INDEX-BOUNDS-ERROR :NAME SEQUENCE :INDEX INDEX))
   (SEQ-DISPATCH SEQUENCE (LISP:SETF (LISP:NTH INDEX SEQUENCE)
                                 NEWVAL)
          (LISP:SETF (LISP:AREF SEQUENCE INDEX)
                 NEWVAL)))

(LISP:DEFUN MAKE-SEQUENCE-OF-TYPE
 (TYPE LENGTH)
   [LET ((BROAD-TYPE (TYPE-SPECIFIER TYPE))
         TYPE-LENGTH)
        (LISP:IF (EQ BROAD-TYPE 'LIST)
            (LISP:MAKE-LIST LENGTH)
            [LET [(ELEMENT-TYPE (CASE BROAD-TYPE
                                    ((LISP:SIMPLE-STRING STRING) 
                                       (SETQ TYPE-LENGTH (AND (LISP:CONSP TYPE)
                                                              (LISP:SECOND TYPE)))
                                       'LISP:STRING-CHAR)
                                    ((LISP:SIMPLE-BIT-VECTOR LISP:BIT-VECTOR) 
                                       (SETQ TYPE-LENGTH (AND (LISP:CONSP TYPE)
                                                              (LISP:SECOND TYPE)))
                                       'BIT)
                                    (LISP:SIMPLE-VECTOR 
                                       (SETQ TYPE-LENGTH (AND (LISP:CONSP TYPE)
                                                              (LISP:SECOND TYPE)))
                                       T)
                                    ((LISP:ARRAY LISP:VECTOR LISP:SIMPLE-ARRAY) 
                                       (LISP:IF (LISP:CONSP TYPE)
                                           (LET ((ELT-TYPE (CADR TYPE)))
                                                (SETQ TYPE-LENGTH (LISP:THIRD TYPE))
                                                (LISP:IF (LISP:CONSP TYPE-LENGTH)
                                                    (SETQ TYPE-LENGTH (CAR TYPE-LENGTH)))
                                                (LISP:IF [AND ELT-TYPE (NOT (EQ ELT-TYPE 'LISP:*]
                                                    ELT-TYPE
                                                    T))
                                           T)))]
                 (LISP:IF (AND (LISP:INTEGERP TYPE-LENGTH)
                               (NOT (EQUAL TYPE-LENGTH LENGTH)))
                        (LISP:ERROR "~D is not the length of type ~s" LENGTH TYPE))
                 (LISP:IF ELEMENT-TYPE
                     (MAKE-VECTOR LENGTH :ELEMENT-TYPE ELEMENT-TYPE)
                     (LET ((EXPANDER (LISP::TYPE-EXPANDER BROAD-TYPE)))
                          (LISP:IF EXPANDER
                              (MAKE-SEQUENCE-OF-TYPE
 (LISP::TYPE-EXPAND TYPE EXPANDER)
                                     LENGTH)
                              (LISP:ERROR "~S is a bad type specifier for sequences." TYPE))))])])

(LISP:DEFSETF LISP:ELT
 %%SETELT)

(LISP:DEFSETF LISP:SUBSEQ
 (SEQUENCE START &OPTIONAL END) (NEW-SEQUENCE)
   `(PROGN (LISP:REPLACE ,SEQUENCE ,NEW-SEQUENCE :START1 ,START :END1 ,END)
           ,NEW-SEQUENCE))

(PUTPROPS CMLSEQBASICS
 FILETYPE
 LISP:COMPILE-FILE)
(DECLARE%: EVAL@COMPILE DONTCOPY DONTEVAL@LOAD 
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
)
(PUTPROPS CMLSEQBASICS COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1991 1993))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL)))
STOP