(FILECREATED "16-Jul-86 01:24:44" {ERIS}<LISPCORE>EVAL>CMLSEQCOMMON.;1
 1578   

      changes to:  (FUNCTIONS MAKE-SEQUENCE-LIKE)

      previous date: " 2-Jul-86 18:01:08" {ERIS}<LISPCORE>LIBRARY>CMLSEQCOMMON.;2)


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

(PRETTYCOMPRINT CMLSEQCOMMONCOMS)

(RPAQQ CMLSEQCOMMONCOMS
 ((FUNCTIONS MAKE-SEQUENCE-LIKE SEQ-DISPATCH TYPE-SPECIFIER)
                         (PROP FILETYPE CMLSEQCOMMON)))
(DEFMACRO MAKE-SEQUENCE-LIKE
 (SEQUENCE LENGTH) 
                              "Returns a sequence of the same type as SEQUENCE and the given LENGTH."
   (BQUOTE (LET ((SEQ (\, SEQUENCE)))
                (ETYPECASE SEQ (LIST (MAKE-LIST (\, LENGTH)))
                       (STRING (MAKE-STRING (\, LENGTH)))
                       (ARRAY (MAKE-ARRAY (\, LENGTH)
                                     :ELEMENT-TYPE
                                     (ARRAY-ELEMENT-TYPE SEQ)))))))

(DEFMACRO SEQ-DISPATCH
 (SEQUENCE LIST-FORM VECTOR-FORM) (BQUOTE (ETYPECASE (\, SEQUENCE)
                                                                       (LIST (\, LIST-FORM))
                                                                       (VECTOR (\, VECTOR-FORM)))))

(DEFMACRO TYPE-SPECIFIER
 (TYPE) "Returns the broad class of which TYPE is a specific subclass."
   (BQUOTE (CL:IF (CL:ATOM (\, TYPE))
                  (\, TYPE)
                  (CAR (\, TYPE)))))


(PUTPROPS CMLSEQCOMMON FILETYPE
 COMPILE-FILE)
(PUTPROPS CMLSEQCOMMON COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL)))
STOP