(FILECREATED "29-Sep-86 19:26:14" {ERIS}<LISPCORE>SOURCES>CMLSEQ.;3
 20553  

      changes to:  (VARS CMLSEQCOMS)
                   (FUNCTIONS %%COERCE-SEQUENCE)

      previous date: " 2-Jul-86 18:18:40" {ERIS}<LISPCORE>SOURCES>CMLSEQ.;2)


(* "
Copyright (c) 1985, 1986 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT CMLSEQCOMS)

(RPAQQ CMLSEQCOMS
 ((FUNCTIONS CONCATENATE-TO-MUMBLE %%COERCE-SEQUENCE)
                   (FNS LIST-TO-STRING* LIST-TO-BIT-VECTOR* LIST-TO-VECTOR* VECTOR-TO-LIST* 
                        VECTOR-TO-VECTOR* VECTOR-TO-STRING* VECTOR-TO-BIT-VECTOR* 
                        STRING-TO-SIMPLE-STRING* BIT-VECTOR-TO-SIMPLE-BIT-VECTOR*)
                   (* "Left over.")
                   (FILES CMLSEQCOMMON CMLSEQBASICS CMLSEQMAPPERS CMLSEQMODIFY CMLSEQFINDER CMLSORT)
                   (PROP FILETYPE CMLSEQ)
                   (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
                          (ADDVARS (NLAMA)
                                 (NLAML)
                                 (LAMA BIT-VECTOR-TO-SIMPLE-BIT-VECTOR* STRING-TO-SIMPLE-STRING* 
                                       VECTOR-TO-BIT-VECTOR* VECTOR-TO-STRING* VECTOR-TO-VECTOR* 
                                       VECTOR-TO-LIST* LIST-TO-VECTOR* LIST-TO-BIT-VECTOR* 
                                       LIST-TO-STRING* CL:COERCE)))))
(DEFMACRO CONCATENATE-TO-MUMBLE
 (OUTPUT-TYPE-SPEC SEQUENCES)
   (BQUOTE (CL:DO ((SEQS (\, SEQUENCES)
                         (CDR SEQS))
                   (TOTAL-LENGTH 0)
                   (LENGTHS NIL))
                  ((NULL SEQS)
                   (CL:DO ((SEQUENCES (\, SEQUENCES)
                                  (CDR SEQUENCES))
                           (LENGTHS LENGTHS (CDR LENGTHS))
                           (INDEX 0)
                           (RESULT (MAKE-SEQUENCE-OF-TYPE (\, OUTPUT-TYPE-SPEC)
                                          TOTAL-LENGTH)))
                          ((= INDEX TOTAL-LENGTH)
                           RESULT)
                          (LET ((SEQUENCE (CAR SEQUENCES)))
                               (SEQ-DISPATCH SEQUENCE (CL:DO ((SEQUENCE SEQUENCE (CDR SEQUENCE)))
                                                             ((CL:ATOM SEQUENCE))
                                                             (SETF (AREF RESULT INDEX)
                                                                   (CAR SEQUENCE))
                                                             (INCF INDEX))
                                      (CL:DO ((JNDEX 0 (1+ JNDEX)))
                                             ((= JNDEX (CAR LENGTHS)))
                                             (SETF (AREF RESULT INDEX)
                                                   (AREF SEQUENCE JNDEX))
                                             (INCF INDEX))))))
                  (LET ((LENGTH (CL:LENGTH (CAR SEQS))))
                       (SETQ LENGTHS (NCONC LENGTHS (LIST LENGTH)))
                       (INCF TOTAL-LENGTH LENGTH)))))

(DEFUN %%COERCE-SEQUENCE
 (OBJECT OUTPUT-TYPE-SPEC) (ETYPECASE OBJECT
                                                          (LIST (CASE (TYPE-SPECIFIER 
                                                                             OUTPUT-TYPE-SPEC)
                                                                      ((SIMPLE-STRING STRING)
                                                                       (LIST-TO-STRING* OBJECT))
                                                                      ((SIMPLE-BIT-VECTOR BIT-VECTOR)
                                                                       (LIST-TO-BIT-VECTOR* OBJECT))
                                                                      ((SIMPLE-VECTOR VECTOR ARRAY 
                                                                              SIMPLE-ARRAY)
                                                                       (LIST-TO-VECTOR* OBJECT 
                                                                              OUTPUT-TYPE-SPEC))
                                                                      (T (CL:ERROR 
                                                                        "Can't coerce ~S to type ~S." 
                                                                                OBJECT 
                                                                                OUTPUT-TYPE-SPEC))))
                                                          (SIMPLE-STRING (CASE (TYPE-SPECIFIER 
                                                                                     OUTPUT-TYPE-SPEC
                                                                                      )
                                                                               (LIST (VECTOR-TO-LIST*
                                                                                      OBJECT))
                                                                               ((SIMPLE-VECTOR VECTOR 
                                                                                       ARRAY 
                                                                                       SIMPLE-ARRAY)
                                                                                (VECTOR-TO-VECTOR*
                                                                                 OBJECT 
                                                                                 OUTPUT-TYPE-SPEC))
                                                                               (T (CL:ERROR 
                                                                        "Can't coerce ~S to type ~S." 
                                                                                         OBJECT 
                                                                                     OUTPUT-TYPE-SPEC
                                                                                         ))))
                                                          (SIMPLE-BIT-VECTOR
                                                           (CASE (TYPE-SPECIFIER OUTPUT-TYPE-SPEC)
                                                                 (LIST (VECTOR-TO-LIST* OBJECT))
                                                                 ((SIMPLE-VECTOR VECTOR ARRAY 
                                                                         SIMPLE-ARRAY)
                                                                  (VECTOR-TO-VECTOR* OBJECT 
                                                                         OUTPUT-TYPE-SPEC))
                                                                 (T (CL:ERROR 
                                                                        "Can't coerce ~S to type ~S." 
                                                                           OBJECT OUTPUT-TYPE-SPEC)))
                                                           )
                                                          (SIMPLE-VECTOR (CASE (TYPE-SPECIFIER 
                                                                                     OUTPUT-TYPE-SPEC
                                                                                      )
                                                                               (LIST (VECTOR-TO-LIST*
                                                                                      OBJECT))
                                                                               ((SIMPLE-STRING STRING
                                                                                       )
                                                                                (VECTOR-TO-STRING*
                                                                                 OBJECT))
                                                                               ((SIMPLE-BIT-VECTOR
                                                                                 BIT-VECTOR)
                                                                                (
                                                                                VECTOR-TO-BIT-VECTOR*
                                                                                 OBJECT))
                                                                               ((VECTOR ARRAY 
                                                                                       SIMPLE-ARRAY)
                                                                                (VECTOR-TO-VECTOR*
                                                                                 OBJECT 
                                                                                 OUTPUT-TYPE-SPEC))
                                                                               (T (CL:ERROR 
                                                                        "Can't coerce ~S to type ~S." 
                                                                                         OBJECT 
                                                                                     OUTPUT-TYPE-SPEC
                                                                                         ))))
                                                          (STRING (CASE (TYPE-SPECIFIER 
                                                                               OUTPUT-TYPE-SPEC)
                                                                        (LIST (VECTOR-TO-LIST* OBJECT
                                                                                     ))
                                                                        (SIMPLE-STRING (
                                                                             STRING-TO-SIMPLE-STRING*
                                                                                        OBJECT))
                                                                        ((SIMPLE-VECTOR VECTOR 
                                                                                SIMPLE-ARRAY ARRAY)
                                                                         (VECTOR-TO-VECTOR* OBJECT 
                                                                                OUTPUT-TYPE-SPEC))
                                                                        (T (CL:ERROR 
                                                                        "Can't coerce ~S to type ~S." 
                                                                                  OBJECT 
                                                                                  OUTPUT-TYPE-SPEC)))
                                                                 )
                                                          (BIT-VECTOR (CASE (TYPE-SPECIFIER 
                                                                                   OUTPUT-TYPE-SPEC)
                                                                            (LIST (VECTOR-TO-LIST*
                                                                                   OBJECT))
                                                                            (SIMPLE-BIT-VECTOR
                                                                             (
                                                                     BIT-VECTOR-TO-SIMPLE-BIT-VECTOR*
                                                                              OBJECT))
                                                                            ((SIMPLE-VECTOR VECTOR 
                                                                                    ARRAY 
                                                                                    SIMPLE-ARRAY)
                                                                             (VECTOR-TO-VECTOR*
                                                                              OBJECT OUTPUT-TYPE-SPEC
                                                                              ))
                                                                            (T (CL:ERROR 
                                                                        "Can't coerce ~S to type ~S." 
                                                                                      OBJECT 
                                                                                     OUTPUT-TYPE-SPEC
                                                                                      ))))
                                                          (VECTOR (CASE (TYPE-SPECIFIER 
                                                                               OUTPUT-TYPE-SPEC)
                                                                        (LIST (VECTOR-TO-LIST* OBJECT
                                                                                     ))
                                                                        ((SIMPLE-STRING STRING)
                                                                         (VECTOR-TO-STRING* OBJECT))
                                                                        ((SIMPLE-BIT-VECTOR 
                                                                                BIT-VECTOR)
                                                                         (VECTOR-TO-BIT-VECTOR*
                                                                          OBJECT))
                                                                        ((SIMPLE-VECTOR VECTOR ARRAY 
                                                                                SIMPLE-ARRAY)
                                                                         (VECTOR-TO-VECTOR* OBJECT 
                                                                                OUTPUT-TYPE-SPEC))
                                                                        (T (CL:ERROR 
                                                                        "Can't coerce ~S to type ~S." 
                                                                                  OBJECT 
                                                                                  OUTPUT-TYPE-SPEC)))
                                                                 )))

(DEFINEQ

(LIST-TO-STRING*

  (CL:LAMBDA (OBJECT)
                                        (* amd " 1-Jul-86 18:38")

         (CL:DO* ((INDEX 0 (1+ INDEX))
                  (CL:LENGTH (CL:LENGTH OBJECT))
                  (RESULT (MAKE-STRING CL:LENGTH)))
                ((= INDEX CL:LENGTH)
                 RESULT)
                (SETF (SCHAR RESULT INDEX)
                      (pop
 OBJECT)))))

(LIST-TO-BIT-VECTOR*

  (CL:LAMBDA (OBJECT)
                                        (* amd " 1-Jul-86 18:38")

         (CL:DO* ((INDEX 0 (1+ INDEX))
                  (CL:LENGTH (CL:LENGTH OBJECT))
                  (RESULT (MAKE-ARRAY CL:LENGTH :ELEMENT-TYPE (QUOTE (MOD 2)))))
                ((= INDEX CL:LENGTH)
                 RESULT)
                (DECLARE
 (TYPE FIXNUM CL:LENGTH))
                (SETF (SBIT RESULT INDEX)
                      (pop
 OBJECT)))))

(LIST-TO-VECTOR*

  (CL:LAMBDA (OBJECT TYPE)
                                   (* amd " 1-Jul-86 18:38")

         (CL:DO* ((INDEX 0 (1+ INDEX))
                  (CL:LENGTH (CL:LENGTH OBJECT))
                  (RESULT (MAKE-SEQUENCE-OF-TYPE TYPE CL:LENGTH)))
                ((= INDEX CL:LENGTH)
                 RESULT)
                (SETF (AREF RESULT INDEX)
                      (pop
 OBJECT)))))

(VECTOR-TO-LIST*

  (CL:LAMBDA (OBJECT)
         (LET ((RESULT (LIST NIL))
               (CL:LENGTH (CL:LENGTH OBJECT)))
              (CL:DO ((INDEX 0 (1+ INDEX))
                      (SPLICE RESULT (CDR SPLICE)))
                     ((= INDEX CL:LENGTH)
                      (CDR RESULT))
                     (RPLACD SPLICE (LIST (AREF OBJECT INDEX)))))))

(VECTOR-TO-VECTOR*

  (CL:LAMBDA (OBJECT TYPE)
                                   (* raf "17-Dec-85 22:42")

         (CL:DO* ((INDEX 0 (1+ INDEX))
                  (CL:LENGTH (CL:LENGTH OBJECT))
                  (RESULT (MAKE-SEQUENCE-OF-TYPE TYPE CL:LENGTH)))
                ((= INDEX CL:LENGTH)
                 RESULT)
                (SETF (AREF RESULT INDEX)
                      (AREF OBJECT INDEX)))))

(VECTOR-TO-STRING*

  (CL:LAMBDA (OBJECT)
                                        (* raf "17-Dec-85 22:42")

         (CL:DO* ((INDEX 0 (1+ INDEX))
                  (CL:LENGTH (CL:LENGTH OBJECT))
                  (RESULT (MAKE-STRING CL:LENGTH)))
                ((= INDEX CL:LENGTH)
                 RESULT)
                (SETF (SCHAR RESULT INDEX)
                      (AREF OBJECT INDEX)))))

(VECTOR-TO-BIT-VECTOR*

  (CL:LAMBDA (OBJECT)
                                        (* raf "17-Dec-85 22:43")

         (CL:DO* ((INDEX 0 (1+ INDEX))
                  (CL:LENGTH (CL:LENGTH OBJECT))
                  (RESULT (MAKE-ARRAY CL:LENGTH :ELEMENT-TYPE (QUOTE (MOD 2)))))
                ((= INDEX CL:LENGTH)
                 RESULT)
                (DECLARE
 (TYPE FIXNUM CL:LENGTH))
                (SETF (SBIT RESULT INDEX)
                      (AREF OBJECT INDEX)))))

(STRING-TO-SIMPLE-STRING*

  (CL:LAMBDA (OBJECT)
                                        (* raf "18-Dec-85 01:52")

         (COND
            ((SIMPLE-STRING-P OBJECT)
             OBJECT)
            (T (CL:DO* ((LENGTH (CL:LENGTH OBJECT))
                        (SIMPLE-STRING (ALLOCSTRING LENGTH))
                        (I 0 (1+ I)))
                      ((= I LENGTH)
                       SIMPLE-STRING)
                      (SETF (AREF OBJECT I)
                            (AREF SIMPLE-STRING I)))))))

(BIT-VECTOR-TO-SIMPLE-BIT-VECTOR*

  (CL:LAMBDA (OBJECT)
                                        (* raf "18-Dec-85 01:53")

         (COND
            ((SIMPLE-BIT-VECTOR-P OBJECT)
             OBJECT)
            (T (CL:DO* ((LENGTH (CL:LENGTH OBJECT))
                        (SIMPLE-BIT-VECTOR (MAKE-ARRAY LENGTH :ELEMENT-TYPE (QUOTE BIT)))
                        (I 0 (1+ I)))
                      ((= I LENGTH)
                       SIMPLE-BIT-VECTOR)
                      (SETF (AREF OBJECT I)
                            (AREF SIMPLE-BIT-VECTOR I)))))))
)



(* "Left over.")


(FILESLOAD CMLSEQCOMMON CMLSEQBASICS CMLSEQMAPPERS CMLSEQMODIFY CMLSEQFINDER CMLSORT)

(PUTPROPS CMLSEQ FILETYPE
 COMPILE-FILE)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 BIT-VECTOR-TO-SIMPLE-BIT-VECTOR* STRING-TO-SIMPLE-STRING* VECTOR-TO-BIT-VECTOR* 
                     VECTOR-TO-STRING* VECTOR-TO-VECTOR* VECTOR-TO-LIST* LIST-TO-VECTOR* 
                     LIST-TO-BIT-VECTOR* LIST-TO-STRING* CL:COERCE)
)
(PRETTYCOMPRINT CMLSEQCOMS)

(RPAQQ CMLSEQCOMS
 ((FUNCTIONS CONCATENATE-TO-MUMBLE %%COERCE-SEQUENCE)
                   (FNS LIST-TO-STRING* LIST-TO-BIT-VECTOR* LIST-TO-VECTOR* VECTOR-TO-LIST* 
                        VECTOR-TO-VECTOR* VECTOR-TO-STRING* VECTOR-TO-BIT-VECTOR* 
                        STRING-TO-SIMPLE-STRING* BIT-VECTOR-TO-SIMPLE-BIT-VECTOR*)
                   (* "Left over.")
                   (FILES CMLSEQCOMMON CMLSEQBASICS CMLSEQMAPPERS CMLSEQMODIFY CMLSEQFINDER CMLSORT)
                   (PROP FILETYPE CMLSEQ)
                   (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
                          (ADDVARS (NLAMA)
                                 (NLAML)
                                 (LAMA BIT-VECTOR-TO-SIMPLE-BIT-VECTOR* STRING-TO-SIMPLE-STRING* 
                                       VECTOR-TO-BIT-VECTOR* VECTOR-TO-STRING* VECTOR-TO-VECTOR* 
                                       VECTOR-TO-LIST* LIST-TO-VECTOR* LIST-TO-BIT-VECTOR* 
                                       LIST-TO-STRING*)))))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 BIT-VECTOR-TO-SIMPLE-BIT-VECTOR* STRING-TO-SIMPLE-STRING* VECTOR-TO-BIT-VECTOR* 
                     VECTOR-TO-STRING* VECTOR-TO-VECTOR* VECTOR-TO-LIST* LIST-TO-VECTOR* 
                     LIST-TO-BIT-VECTOR* LIST-TO-STRING*)
)
(PUTPROPS CMLSEQ COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (14410 18533 (LIST-TO-STRING* 14420 . 14823) (LIST-TO-BIT-VECTOR* 14825 . 15314) (
LIST-TO-VECTOR* 15316 . 15733) (VECTOR-TO-LIST* 15735 . 16100) (VECTOR-TO-VECTOR* 16102 . 16524) (
VECTOR-TO-STRING* 16526 . 16934) (VECTOR-TO-BIT-VECTOR* 16936 . 17430) (STRING-TO-SIMPLE-STRING* 17432
 . 17956) (BIT-VECTOR-TO-SIMPLE-BIT-VECTOR* 17958 . 18531)))))
STOP