(FILECREATED " 4-Jun-86 23:22:16" {ERIS}<LISPCORE>LIBRARY>CMLSORT.;10
 28370  

      changes to:  (VARS CMLSORTCOMS)
                   (FNS CL:SORT %%SORT-SIMPLE-VECTOR %%SORT-VECTOR %%SORT-LIST STABLE-SORT 
                        %%STABLE-SORT-SIMPLE-VECTOR %%STABLE-SORT-VECTOR CL:MERGE %%MERGE-LISTS* 
                        %%MERGE-VECTORS* %%MERGE-SIMPLE-VECTORS %%MERGE-NON-SIMPLE-VECTORS 
                        %%STABLE-%%SORT-SIMPLE-VECTOR %%STABLE-%%SORT-VECTOR MERGE-VECTORS* 
                        MERGE-NON-SIMPLE-VECTORS MERGE-LISTS* MERGE-SIMPLE-VECTORS)

      previous date: " 4-Jun-86 23:17:12" {ERIS}<LISPCORE>LIBRARY>CMLSORT.;8)


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

(PRETTYCOMPRINT CMLSORTCOMS)

(RPAQQ CMLSORTCOMS
 
       ((* * Section 14.5 Merging and Sorting -- By Kelly Roach. *)
        (DECLARE: DONTCOPY DOEVAL@COMPILE (MACROS APPLY-KEY APPLY-PRED SORT-PREFIX))
        (FNS CL:SORT %%SORT-SIMPLE-VECTOR %%SORT-VECTOR %%SORT-LIST)
        (FNS STABLE-SORT %%STABLE-SORT-SIMPLE-VECTOR %%STABLE-SORT-VECTOR)
        (FNS CL:MERGE %%MERGE-LISTS* %%MERGE-VECTORS* %%MERGE-SIMPLE-VECTORS 
             %%MERGE-NON-SIMPLE-VECTORS)
        (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
               (ADDVARS (NLAMA)
                      (NLAML)
                      (LAMA %%MERGE-NON-SIMPLE-VECTORS %%MERGE-SIMPLE-VECTORS %%MERGE-VECTORS* 
                            %%MERGE-LISTS* CL:MERGE %%STABLE-SORT-VECTOR %%STABLE-SORT-SIMPLE-VECTOR 
                            STABLE-SORT %%SORT-LIST %%SORT-VECTOR %%SORT-SIMPLE-VECTOR CL:SORT)))))
(* * Section 14.5 Merging and Sorting -- By Kelly Roach. *)


(DECLARE: DONTCOPY DOEVAL@COMPILE 
(DECLARE: EVAL@COMPILE 
(DEFMACRO APPLY-KEY
 (KEY CL:ELT)                             (* Apply-key applies the key to elt, 

                                                             or if key is NIL %%, then returns elt.

                                                             *)
 (BQUOTE (CL:IF (\, KEY)
                                                                               (FUNCALL (\, KEY)
                                                                                      (\, CL:ELT))
                                                                               (\, CL:ELT))))

(DEFMACRO APPLY-PRED
 (ONE TWO PRED KEY) 
          
          (* apply-pred applies the predicate and the key functions to two arguments.

          if the key function is NIL then apply-pred calls only the predicate function.

          *)

                                                             (* Internal Macro *)

 (BQUOTE (CL:IF (\, KEY)
                (FUNCALL (\, PRED)
                       (FUNCALL (\, KEY)
                              (\, ONE))
                       (FUNCALL (\, KEY)
                              (\, TWO)))
                (FUNCALL (\, PRED)
                       (\, ONE)
                       (\, TWO)))))

(DEFMACRO SORT-PREFIX
 NIL                                    (* The slightly more complicated 

                                                             version which follows eliminates the 

                                                             function call overhead, and eliminates 

                                                             the need to make LIST a special 

                                                             variable *)

                          (QUOTE (PROG ((STACK NIL)
                                        (RES NIL))
                                       CALL
                                       (CL:WHEN (NULL LIST)
                                              (SETQ RES NIL)
                                              (GO RETURN))
                                       (CL:WHEN (< HEIGHT 1)
                                              (SETQ RES (RPLACD (PROG1 LIST (SETQ LIST (CDR LIST)))
                                                               NIL))
                                              (GO RETURN))
                                       (CL:PUSH HEIGHT STACK)
                                       (SETQ HEIGHT (1- HEIGHT))
                                       (CL:PUSH (QUOTE S1)
                                              STACK)
                                       (GO CALL)
                                       S1
                                       (SETQ HEIGHT (1- (CAR STACK)))
                                       (CL:PUSH RES STACK)
                                       (CL:PUSH (QUOTE S2)
                                              STACK)
                                       (GO CALL)
                                       S2
                                       (SETQ RES (%%MERGE-LISTS* (POP STACK)
                                                        RES PRED KEY))
                                       (SETQ HEIGHT (POP STACK))
                                       (GO RETURN)
                                       RETURN
                                       (LET ((FLAG (POP STACK)))
                                            (CASE FLAG (S1 (GO S1))
                                                  (S2 (GO S2))
                                                  (T (RETURN RES)))))))

)
)
(DEFINEQ

(CL:SORT

  (CL:LAMBDA (SEQUENCE PREDICATE &KEY KEY)
                   (* kbr: " 4-Jun-86 22:23")

                                                             (* Destructively sorts sequence.

                                                             Predicate should returns non-NIL if 

                                                             Arg1 is to precede Arg2.

                                                             *)

                                                             (* Sort dispatches to type specific 

                                                             sorting routines. *)

         (CL:IF (ARRAYP SEQUENCE)
                (CL:IF (> (CL:LENGTH SEQUENCE)
                          0)
                       (%%SORT-VECTOR
 SEQUENCE PREDICATE KEY)
                       SEQUENCE)
                (CL:IF (VECTORP SEQUENCE)
                       (CL:IF (> (CL:LENGTH (THE SIMPLE-VECTOR SEQUENCE))
                                 0)
                              (%%SORT-SIMPLE-VECTOR
 SEQUENCE PREDICATE KEY)
                              SEQUENCE)
                       (CL:IF (LISTP SEQUENCE)
                              (%%SORT-LIST
 SEQUENCE PREDICATE KEY)
                              (CL:ERROR "~S is not a sequence." SEQUENCE))))))

(%%SORT-SIMPLE-VECTOR

  (CL:LAMBDA (VECTOR PRED KEY)
                               (* kbr: " 4-Jun-86 17:21")

          
          (* %%SORT-SIMPLE-VECTOR sorts vector using the Quicksort algorithm.

          Subranges (from bottom through top inclusive) of vector are partitioned by 

          selecting the first element of the subrange as a pivot, and then rearranging 

          the elements of the subrange so that those less than the pivot come before it, 

          and the others come after. First, the whole vector is partitioned, then each of 

          the two partitions is partitioned. When a parition is trivial

          (0 or 1 elt) we don't bother to do it. Pending partitions are remembered on a 

          stack. When the stack becomes empty, then the array has been sorted.

          *)


         (PROG (STACK PIVOT PIVKEY TOP BOTTOM TT BB)
          
          (* STACK = stack of pending top/bottom pairs * PIVOT = initial pair for whole 

          vector. * PIVKEY = The pivot element for a partition pass.

          The extracted key for pivot. * TOP BOTTOM = The range being partitioned

          (inclusive) * TT BB = Working indices. *)


               (SETQ STACK (LIST (1- (CL:LENGTH VECTOR))
                                 0))
           START-PARTITION
               (SETQ TT (SETQ TOP (POP
 STACK)))
               (SETQ BB (SETQ BOTTOM (POP
 STACK)))
               (SETQ PIVKEY (APPLY-KEY KEY (SETQ PIVOT (AREF VECTOR BOTTOM))))
           DOWN
               (CL:WHEN (= BB TT)
                      (GO END-PARTITION))
               (LET
 ((TOP-ELT (AREF VECTOR TT)))
                    (COND
                       ((FUNCALL PRED (APPLY-KEY KEY TOP-ELT)
                               PIVKEY)
                        (SETF (AREF VECTOR BB)
                              TOP-ELT)
                        (SETQ BB (1+ BB))
                        (GO UP))
                       (T (SETQ TT (1- TT))
                          (GO DOWN))))
           UP  (CL:WHEN (= BB TT)
                      (GO END-PARTITION))
               (LET
 ((BOT-ELT (AREF VECTOR BB)))
                    (COND
                       ((FUNCALL PRED PIVKEY (APPLY-KEY KEY BOT-ELT))
                        (SETF (AREF VECTOR TT)
                              BOT-ELT)
                        (SETQ TT (1- TT))
                        (GO DOWN))
                       (T (SETQ BB (1+ BB))
                          (GO UP))))
           END-PARTITION
               (SETF (AREF VECTOR BB)
                     PIVOT)
               (CL:WHEN (< BOTTOM (1- BB))
                      (CL:PUSH BOTTOM STACK)
                      (CL:PUSH (1- BB)
                             STACK))
               (CL:WHEN (> TOP (1+ TT))
                      (CL:PUSH (1+ TT)
                             STACK)
                      (CL:PUSH TOP STACK))
               (CL:WHEN (NULL STACK)
                      (RETURN VECTOR))
               (GO START-PARTITION))))

(%%SORT-VECTOR

  (CL:LAMBDA (VECTOR PRED KEY)
                               (* kbr: " 4-Jun-86 17:24")

                                                             (* %%SORT-VECTOR is the same as 

                                                             sort-simple-vector except that vector 

                                                             is a "complex" array instead of a 

                                                             "simple" array. *)

         (PROG (STACK PIVOT PIVKEY TOP BOTTOM TT BB)
          
          (* STACK = stack of pending top/bottom pairs * PIVOT = initial pair for whole 

          vector. * PIVKEY = The pivot element for a partition pass.

          The extracted key for pivot. * TOP BOTTOM = The range being partitioned

          (inclusive) * TT BB = Working indices. *)


               (SETQ STACK (LIST (1- (CL:LENGTH VECTOR))
                                 0))
           START-PARTITION
               (SETQ TT (SETQ TOP (POP
 STACK)))
               (SETQ BB (SETQ BOTTOM (POP
 STACK)))
               (SETQ PIVKEY (APPLY-KEY KEY (SETQ PIVOT (AREF VECTOR BOTTOM))))
           DOWN
               (CL:WHEN (= BB TT)
                      (GO END-PARTITION))
               (LET
 ((TOP-ELT (AREF VECTOR TT)))
                    (COND
                       ((FUNCALL PRED (APPLY-KEY KEY TOP-ELT)
                               PIVKEY)
                        (SETF (AREF VECTOR BB)
                              TOP-ELT)
                        (SETQ BB (1+ BB))
                        (GO UP))
                       (T (SETQ TT (1- TT))
                          (GO DOWN))))
           UP  (CL:WHEN (= BB TT)
                      (GO END-PARTITION))
               (LET
 ((BOT-ELT (AREF VECTOR BB)))
                    (COND
                       ((FUNCALL PRED PIVKEY (APPLY-KEY KEY BOT-ELT))
                        (SETF (AREF VECTOR TT)
                              BOT-ELT)
                        (SETQ TT (1- TT))
                        (GO DOWN))
                       (T (SETQ BB (1+ BB))
                          (GO UP))))
           END-PARTITION
               (SETF (AREF VECTOR BB)
                     PIVOT)
               (CL:WHEN (< BOTTOM (1- BB))
                      (CL:PUSH BOTTOM STACK)
                      (CL:PUSH (1- BB)
                             STACK))
               (CL:WHEN (> TOP (1+ TT))
                      (CL:PUSH (1+ TT)
                             STACK)
                      (CL:PUSH TOP STACK))
               (CL:WHEN (NULL STACK)
                      (RETURN VECTOR))
               (GO START-PARTITION))))

(%%SORT-LIST

  (CL:LAMBDA (LIST PRED KEY)
          
          (* Sort-List returns a list containing the elements of LIST in sort.

          The original list is destroyed. Based on an algorithm described as:

          (BQUOTE a) "traditional" list merge sort' by Guy Steele in AI memo 587

          (aug (QUOTE 80)) %%. This sort is stable.

          *)


         (CL:DO ((HEIGHT 0 (1+ HEIGHT))
                 (RESULT NIL (%%MERGE-LISTS*
 RESULT (SORT-PREFIX)
                                    PRED KEY)))
                ((NULL LIST)
                 RESULT))))
)
(DEFINEQ

(STABLE-SORT

  (CL:LAMBDA (SEQUENCE PREDICATE &KEY KEY)
                   (* kbr: " 4-Jun-86 22:34")

          
          (* Stable sort is the same as sort, but it guarantees that equal elements will 

          not change places. For lists, use the normal sort-list function, but vectors 

          must use a less efficient algorithm. *)

                                                             (* Destructively sorts Sequence.

                                                             Predicate should return non-Nil if 

                                                             Arg1 is to precede Arg2.

                                                             *)

         (CL:IF (ARRAYP SEQUENCE)
                (%%STABLE-SORT-SIMPLE-VECTOR
 SEQUENCE PREDICATE KEY)
                (CL:IF (VECTORP SEQUENCE)
                       (%%STABLE-SORT-VECTOR
 SEQUENCE PREDICATE KEY)
                       (CL:IF (LISTP SEQUENCE)
                              (%%SORT-LIST
 SEQUENCE PREDICATE KEY)
                              (CL:ERROR "~S is not a sequence."))))))

(%%STABLE-SORT-SIMPLE-VECTOR

  (CL:LAMBDA (VECTOR PRED KEY)
                               (* kbr: " 4-Jun-86 17:26")

          
          (* Stable sorting arrays is hard. Knuth seems to think that finding an 

          algorithm which can stably sort a vector in n log n time without using gobs of 

          extra storage is a 47 point problem. We handle the problem by coercing the 

          vector into a list, sorting that, and then copying the list back into the 

          original vector. *)

                                                             (* This is an internal function.

                                                             Use STABLE-SORT instead.

                                                             *)

         (LET* ((HEADER (CONS (QUOTE HEADER)
                              NIL))
                (CL:LENGTH (CL:LENGTH VECTOR))
                (LIST (CL:DO ((I 0 (1+ I))
                              (TAIL HEADER (CDR (RPLACD TAIL (CONS (AREF VECTOR I)
                                                                   NIL)))))
                             ((= I CL:LENGTH)
                              (CDR HEADER)))))
               (CL:DO ((SORTED-LIST (%%SORT-LIST
 LIST PRED KEY)
                              (CDR SORTED-LIST))
                       (I 0 (1+ I)))
                      ((NULL SORTED-LIST)
                       VECTOR)
                      (SETF (AREF VECTOR I)
                            (CAR SORTED-LIST))))))

(%%STABLE-SORT-VECTOR

  (CL:LAMBDA (VECTOR PRED KEY)
                               (* kbr: " 4-Jun-86 17:27")

                                                             (* %%STABLE-SORT-VECTOR is the same as 

                                                             %%STABLE-SORT-SIMPLE-VECTOR except 

                                                             that the vector is a slisp array 

                                                             instead of a slisp vector.

                                                             *)

         (LET* ((HEADER (CONS (QUOTE HEADER)
                              NIL))
                (CL:LENGTH (CL:LENGTH VECTOR))
                (LIST (CL:DO ((I 0 (1+ I))
                              (TAIL HEADER (CDR (RPLACD TAIL (CONS (AREF VECTOR I)
                                                                   NIL)))))
                             ((= I CL:LENGTH)
                              (CDR HEADER)))))
               (CL:DO ((SORTED-LIST (%%SORT-LIST
 LIST PRED KEY)
                              (CDR SORTED-LIST))
                       (I 0 (1+ I)))
                      ((NULL SORTED-LIST)
                       VECTOR)
                      (SETF (AREF VECTOR I)
                            (CAR SORTED-LIST))))))
)
(DEFINEQ

(CL:MERGE

  (CL:LAMBDA (RESULT-TYPE SEQUENCE1 SEQUENCE2 PREDICATE &KEY (KEY (FUNCTION IDENTITY)))

                                                             (* kbr: " 4-Jun-86 22:04")

                                                             (* The sequences SEQUENCE1 and 

                                                             SEQUENCE2 are destructively merged 

                                                             into a sequence of type RESULT-TYPE 

                                                             using the PREDICATE to order the 

                                                             elements. *)

         (CASE (TYPE-SPECIFIER RESULT-TYPE)
               (LIST (TYPECASE SEQUENCE1 (LIST (TYPECASE SEQUENCE2 (LIST (%%MERGE-LISTS*
 SEQUENCE1 
                                                                                SEQUENCE2 PREDICATE 
                                                                                KEY))
                                                      (ARRAY (%%MERGE-LISTS*
 SEQUENCE1 (
                                                                                      VECTOR-TO-LIST*
                                                                                        SEQUENCE2)
                                                                    PREDICATE KEY))
                                                      (T (CL:ERROR "~S is not a sequence." SEQUENCE2)
                                                         )))
                            (ARRAY (TYPECASE SEQUENCE2 (LIST (%%MERGE-LISTS*
 (VECTOR-TO-LIST* 
                                                                                    SEQUENCE1)
                                                                    SEQUENCE2 PREDICATE KEY))
                                          (ARRAY (%%MERGE-LISTS*
 (VECTOR-TO-LIST* SEQUENCE1)
                                                        (VECTOR-TO-LIST* SEQUENCE2)
                                                        PREDICATE KEY))
                                          (T (CL:ERROR "~S is not a sequence." SEQUENCE2))))
                            (T (CL:ERROR "~S is not a sequence." SEQUENCE1))))
               ((VECTOR ARRAY STRING)
                (TYPECASE SEQUENCE1 (LIST (TYPECASE SEQUENCE2 (LIST (%%MERGE-VECTORS*

                                                                     (LIST-TO-VECTOR* SEQUENCE1
                                                                            (QUOTE VECTOR))
                                                                     (LIST-TO-VECTOR* SEQUENCE2
                                                                            (QUOTE VECTOR))
                                                                     PREDICATE KEY))
                                                 (ARRAY (%%MERGE-VECTORS*
 (LIST-TO-VECTOR*
                                                                           SEQUENCE1
                                                                           (QUOTE VECTOR))
                                                               SEQUENCE2 PREDICATE KEY))
                                                 (T (CL:ERROR "~S is not a sequence." SEQUENCE2))))
                       (ARRAY (TYPECASE SEQUENCE2 (LIST (%%MERGE-VECTORS*
 SEQUENCE1
                                                               (LIST-TO-VECTOR* SEQUENCE2
                                                                      (QUOTE VECTOR))
                                                               PREDICATE KEY))
                                     (ARRAY (%%MERGE-VECTORS*
 SEQUENCE1 SEQUENCE2 PREDICATE KEY))
                                     (T (CL:ERROR "~S is not a sequence." SEQUENCE2))))
                       (T (CL:ERROR "~S is not a sequence." SEQUENCE1))))
               (T (CL:ERROR "~S is not a subtype of SEQUENCE." RESULT-TYPE)))))

(%%MERGE-LISTS*

  (CL:LAMBDA (LIST1 LIST2 PRED KEY)
                          (* kbr: " 4-Jun-86 22:14")

                                                             (* %%MERGE-LISTS* destructively merges 

                                                             LIST1 with LIST2 In the resulting 

                                                             list, elements of LIST2 are guaranteed 

                                                             to come after equal elements of LIST1 

                                                             *)

         (CL:DO* ((RESULT (LIST (QUOTE HEADER)))
                  (P RESULT))
                ((OR (NULL LIST1)
                     (NULL LIST2))
                 (CL:IF (NULL LIST1)
                        (RPLACD P LIST2)
                        (RPLACD P LIST1))
                 (CDR RESULT))
          
          (* P = pointer to last cell of result. Done when either list used up in which 

          case, append the other list. Returns the result sans header.

          *)


                (COND
                   ((APPLY-PRED (CAR LIST2)
                           (CAR LIST1)
                           PRED KEY)
                    (RPLACD P LIST2)
          
          (* Append the lesser list to last cell of result.

          Note: test must bo done for LIST2 < LIST1 so merge will be stable for LIST1 *)


                    (SETQ P (CDR P))
                    (pop
 LIST2))
                   (T (RPLACD P LIST1)
                      (SETQ P (CDR P))
                      (pop
 LIST1))))))

(%%MERGE-VECTORS*

  (CL:LAMBDA (VECTOR1 VECTOR2 PRED KEY)
                      (* kbr: " 4-Jun-86 22:33")

                                                             (* %%MERGE-VECTORS* dispatches to 

                                                             either %%MERGE-SIMPLE-VECTORS or 

                                                             %%MERGE-NON-SIMPLE-VECTORS *)

         (CL:IF (OR (ARRAYP VECTOR1)
                    (ARRAYP VECTOR2))
                (%%MERGE-NON-SIMPLE-VECTORS
 VECTOR1 VECTOR2 PRED KEY)
                (%%MERGE-SIMPLE-VECTORS
 VECTOR1 VECTOR2 PRED KEY))))

(%%MERGE-SIMPLE-VECTORS

  (CL:LAMBDA (VECTOR1 VECTOR2 PRED KEY)
                      (* kbr: " 4-Jun-86 22:13")

          
          (* Merge-simple-vectors returns a new vector which contains an interleaving of 

          the elements of VECTOR1 and VECTOR2 Elements from VECTOR2 are chosen only if 

          they are strictly less than elements of VECTOR1

          (PRED ELT2 ELT1) %%, as specified in the manual.

          *)


         (CL:DECLARE (SIMPLE-VECTOR VECTOR1 VECTOR2))
         (CL:DO* ((LENGTH1 (CL:LENGTH VECTOR1))
                  (LENGTH2 (CL:LENGTH VECTOR2))
                  (RESULTLENGTH (+ LENGTH1 LENGTH2))
                  (RESULT (MAKE-ARRAY RESULTLENGTH :ELEMENT-TYPE (ARRAY-ELEMENT-TYPE VECTOR1)))
                  (FILL 0 (1+ FILL))
                  (I 0)
                  (J 0))
                ((>= FILL RESULTLENGTH)
                 RESULT)                                     (* FILL = index into result vector * I 

                                                             = index into VECTOR1 * J = index into 

                                                             VECTOR2 *)

                (COND
                   ((= I LENGTH1)
                    (CL:DO NIL ((= FILL RESULTLENGTH)
                                RESULT)
                           (SETF (AREF RESULT FILL)
                                 (AREF VECTOR2 J))
                           (SETQ FILL (1+ FILL))
                           (SETQ J (1+ J))))
                   ((= J LENGTH2)
                    (CL:DO NIL ((= FILL RESULTLENGTH)
                                RESULT)
                           (SETF (AREF RESULT FILL)
                                 (AREF VECTOR1 I))
                           (SETQ FILL (1+ FILL))
                           (SETQ I (1+ I))))
                   ((APPLY-PRED (AREF VECTOR2 J)
                           (AREF VECTOR1 I)
                           PRED KEY)
                    (SETF (AREF RESULT FILL)
                          (AREF VECTOR2 J))
                    (SETQ J (1+ J)))
                   (T (SETF (AREF RESULT FILL)
                            (AREF VECTOR1 I))
                      (SETQ I (1+ I)))))))

(%%MERGE-NON-SIMPLE-VECTORS

  (CL:LAMBDA (VECTOR1 VECTOR2 PRED KEY)
                      (* kbr: " 4-Jun-86 22:27")

                                                             (* %%MERGE-NON-SIMPLE-VECTORS is like 

                                                             %%MERGE-SIMPLE-VECTORS except that the 

                                                             vectors are either slisp arrays or 

                                                             slisp vectors. *)

         (CL:DO* ((LENGTH1 (CL:LENGTH VECTOR1))
                  (LENGTH2 (CL:LENGTH VECTOR2))
                  (RESULTLENGTH (+ (CL:LENGTH VECTOR1)
                                   (CL:LENGTH VECTOR2)))
                  (RESULT (MAKE-ARRAY RESULTLENGTH :ELEMENT-TYPE (ARRAY-ELEMENT-TYPE VECTOR1)))
                  (FILL 0 (1+ FILL))
                  (I 0)
                  (J 0))
                ((>= FILL RESULTLENGTH)
                 RESULT)
                (CL:DECLARE (VECTOR RESULT))                 (* FILL = index into result vector * I 

                                                             = index into VECTOR1 * J = index into 

                                                             VECTOR2 *)

                (COND
                   ((= I LENGTH1)
                    (CL:DO NIL ((= FILL RESULTLENGTH)
                                RESULT)
                           (SETF (AREF RESULT FILL)
                                 (AREF VECTOR2 J))
                           (SETQ FILL (1+ FILL))
                           (SETQ J (1+ J))))
                   ((= J LENGTH2)
                    (CL:DO NIL ((= FILL RESULTLENGTH)
                                RESULT)
                           (SETF (AREF RESULT FILL)
                                 (AREF VECTOR1 I))
                           (SETQ FILL (1+ FILL))
                           (SETQ I (1+ I))))
                   ((APPLY-PRED (AREF VECTOR2 J)
                           (AREF VECTOR1 I)
                           PRED KEY)
                    (SETF (AREF RESULT FILL)
                          (AREF VECTOR2 J))
                    (SETQ J (1+ J)))
                   (T (SETF (AREF RESULT FILL)
                            (AREF VECTOR1 I))
                      (SETQ I (1+ I)))))))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 %%MERGE-NON-SIMPLE-VECTORS %%MERGE-SIMPLE-VECTORS %%MERGE-VECTORS* %%MERGE-LISTS* 
                     CL:MERGE %%STABLE-SORT-VECTOR %%STABLE-SORT-SIMPLE-VECTOR STABLE-SORT 
                     %%SORT-LIST %%SORT-VECTOR %%SORT-SIMPLE-VECTOR CL:SORT)
)
(PUTPROPS CMLSORT COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (5363 13049 (CL:SORT 5373 . 6705) (%%SORT-SIMPLE-VECTOR 6707 . 9755) (%%SORT-VECTOR 9757
 . 12450) (%%SORT-LIST 12452 . 13047)) (13050 17060 (STABLE-SORT 13060 . 14190) (
%%STABLE-SORT-SIMPLE-VECTOR 14192 . 15725) (%%STABLE-SORT-VECTOR 15727 . 17058)) (17061 27910 (
CL:MERGE 17071 . 21070) (%%MERGE-LISTS* 21072 . 22708) (%%MERGE-VECTORS* 22710 . 23343) (
%%MERGE-SIMPLE-VECTORS 23345 . 25582) (%%MERGE-NON-SIMPLE-VECTORS 25584 . 27908)))))
STOP