Changeset 15328


Ignore:
Timestamp:
06/11/20 12:25:32 (3 years ago)
Author:
Mark Evenson
Message:

Normalize whitespace by removing tab characters

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/abcl/src/org/armedbear/lisp/sort.lisp

    r15327 r15328  
    5959(defmacro merge-vectors-body (type ref a start-a end-a b start-b end-b aux start-aux predicate &optional key)
    6060  (let ((i-a (gensym))
    61   (i-b (gensym))
    62   (i-aux (gensym))
    63   (v-a (gensym))
    64   (v-b (gensym))
    65   (k-a (gensym))
    66   (k-b (gensym))
    67   (merge-block (gensym)))
     61        (i-b (gensym))
     62        (i-aux (gensym))
     63        (v-a (gensym))
     64        (v-b (gensym))
     65        (k-a (gensym))
     66        (k-b (gensym))
     67        (merge-block (gensym)))
    6868    `(locally
    69   (declare (type fixnum ,start-a ,end-a ,start-b ,end-b ,start-aux)
    70       (type ,type ,a ,b)
    71       (type simple-vector ,aux)
    72       (type function ,predicate ,@(if key `(,key)))
    73       (optimize (speed 3) (safety 0)))
     69        (declare (type fixnum ,start-a ,end-a ,start-b ,end-b ,start-aux)
     70                  (type ,type ,a ,b)
     71                  (type simple-vector ,aux)
     72                  (type function ,predicate ,@(if key `(,key)))
     73                  (optimize (speed 3) (safety 0)))
    7474       (block ,merge-block
    75     (let ((,i-a ,start-a)
    76     (,i-b ,start-b)
    77     (,i-aux ,start-aux)
    78     ,v-a ,v-b ,k-a ,k-b)
    79       (declare (type fixnum ,i-a ,i-b ,i-aux))
    80       (cond ((= ,start-a ,end-a)
    81        (when (= ,start-b ,end-b)
    82          (return-from ,merge-block))
    83        (setf ,i-a ,start-b
    84       ,end-a ,end-b
    85       ,a ,b
    86       ,v-a (,ref ,a ,i-a)))
    87       ((= ,start-b ,end-b)
    88        (setf ,i-a ,start-a
    89       ,v-a (,ref ,a ,i-a)))
    90       (t
    91        (setf ,v-a (,ref ,a ,i-a)
    92       ,v-b (,ref ,b ,i-b)
    93       ,@(if key
    94              `(,k-a (funcall ,key ,v-a))
    95              `(,k-a ,v-a))
    96       ,@(if key
    97              `(,k-b (funcall ,key ,v-b))
    98              `(,k-b ,v-b)))
    99        (loop
    100          (if (funcall ,predicate ,k-b ,k-a)
    101       (progn
     75          (let ((,i-a ,start-a)
     76                (,i-b ,start-b)
     77                (,i-aux ,start-aux)
     78                ,v-a ,v-b ,k-a ,k-b)
     79            (declare (type fixnum ,i-a ,i-b ,i-aux))
     80            (cond ((= ,start-a ,end-a)
     81                   (when (= ,start-b ,end-b)
     82                     (return-from ,merge-block))
     83                   (setf ,i-a ,start-b
     84                        ,end-a ,end-b
     85                        ,a ,b
     86                        ,v-a (,ref ,a ,i-a)))
     87                  ((= ,start-b ,end-b)
     88                   (setf ,i-a ,start-a
     89                        ,v-a (,ref ,a ,i-a)))
     90                  (t
     91                   (setf ,v-a (,ref ,a ,i-a)
     92                        ,v-b (,ref ,b ,i-b)
     93                        ,@(if key
     94                               `(,k-a (funcall ,key ,v-a))
     95                               `(,k-a ,v-a))
     96                        ,@(if key
     97                               `(,k-b (funcall ,key ,v-b))
     98                               `(,k-b ,v-b)))
     99                   (loop
     100                     (if (funcall ,predicate ,k-b ,k-a)
     101                        (progn
    102102                           ,(if (subtypep type 'simple-vector)
    103               `(setf (svref ,aux ,i-aux) ,v-b
     103                                `(setf (svref ,aux ,i-aux) ,v-b
    104104                                       ,i-aux (+ ,i-aux 1)
    105                ,i-b (+ ,i-b 1))
     105                                       ,i-b (+ ,i-b 1))
    106106                                `(setf (aref ,aux ,i-aux) ,v-b
    107107                                       ,i-aux (+ ,i-aux 1)
    108                ,i-b (+ ,i-b 1)))
    109          (when (= ,i-b ,end-b) (return))
    110          (setf ,v-b (,ref ,b ,i-b)
    111         ,@(if key
    112                `(,k-b (funcall ,key ,v-b))
    113                `(,k-b ,v-b))))
    114       (progn
     108                                       ,i-b (+ ,i-b 1)))
     109                           (when (= ,i-b ,end-b) (return))
     110                           (setf ,v-b (,ref ,b ,i-b)
     111                                ,@(if key
     112                                       `(,k-b (funcall ,key ,v-b))
     113                                       `(,k-b ,v-b))))
     114                        (progn
    115115                           ,(if (subtypep type 'simple-vector)
    116               `(setf (svref ,aux ,i-aux) ,v-a
    117                ,i-aux (+ ,i-aux 1)
    118                ,i-a (+ ,i-a 1))
     116                                `(setf (svref ,aux ,i-aux) ,v-a
     117                                       ,i-aux (+ ,i-aux 1)
     118                                       ,i-a (+ ,i-a 1))
    119119                                `(setf (aref ,aux ,i-aux) ,v-a
    120120                                       ,i-aux (+ ,i-aux 1)
    121                ,i-a (+ ,i-a 1)))
    122          (when (= ,i-a ,end-a)
    123            (setf ,a ,b
    124            ,i-a ,i-b
    125            ,end-a ,end-b
    126            ,v-a ,v-b)
    127            (return))
    128          (setf ,v-a (,ref ,a ,i-a)
    129         ,@(if key
    130                `(,k-a (funcall ,key ,v-a))
    131                `(,k-a ,v-a))))))))
    132       (loop
     121                                       ,i-a (+ ,i-a 1)))
     122                           (when (= ,i-a ,end-a)
     123                             (setf ,a ,b
     124                                   ,i-a ,i-b
     125                                   ,end-a ,end-b
     126                                   ,v-a ,v-b)
     127                             (return))
     128                           (setf ,v-a (,ref ,a ,i-a)
     129                                ,@(if key
     130                                       `(,k-a (funcall ,key ,v-a))
     131                                       `(,k-a ,v-a))))))))
     132            (loop
    133133              ,(if (subtypep type 'simple-vector)
    134              `(setf (svref ,aux ,i-aux) ,v-a
     134                   `(setf (svref ,aux ,i-aux) ,v-a
    135135                          ,i-a (+ ,i-a 1))
    136              `(setf (aref ,aux ,i-aux) ,v-a
     136                   `(setf (aref ,aux ,i-aux) ,v-a
    137137                          ,i-a (+ ,i-a 1)))
    138         (when (= ,i-a ,end-a) (return))
    139         (setf ,v-a (,ref ,a ,i-a)
    140         ,i-aux (+ ,i-aux 1))))))))
     138              (when (= ,i-a ,end-a) (return))
     139              (setf ,v-a (,ref ,a ,i-a)
     140                    ,i-aux (+ ,i-aux 1))))))))
    141141
    142142(defmacro merge-sort-body (type ref mpredicate mkey msequence mstart mend)
    143143  (let ((merge-sort-call (gensym))
    144   (maux (gensym))
    145   (aux (gensym))
    146   (sequence (gensym))
    147   (start (gensym))
    148   (end (gensym))
    149   (predicate (gensym))
    150   (key (gensym))
    151   (mid (gensym))
    152   (direction (gensym)))
     144        (maux (gensym))
     145        (aux (gensym))
     146        (sequence (gensym))
     147        (start (gensym))
     148        (end (gensym))
     149        (predicate (gensym))
     150        (key (gensym))
     151        (mid (gensym))
     152        (direction (gensym)))
    153153    `(locally
    154   (declare (optimize (speed 3) (safety 0)))
     154        (declare (optimize (speed 3) (safety 0)))
    155155       (labels ((,merge-sort-call (,sequence ,start ,end ,predicate ,key ,aux ,direction)
    156       (declare (type function ,predicate ,@(if mkey `(,key)))
    157          (type fixnum ,start ,end)
    158          (type ,type ,sequence))
    159       (let ((,mid (+ ,start (ash (- ,end ,start) -1))))
    160         (declare (type fixnum ,mid))
    161         (if (<= (- ,mid 1) ,start)
    162       (unless ,direction (setf (,ref ,aux ,start) (,ref ,sequence ,start)))
    163       (,merge-sort-call ,sequence ,start ,mid ,predicate ,key ,aux (not ,direction)))
    164         (if (>= (+ ,mid 1) ,end)
    165       (unless ,direction (setf (,ref ,aux ,mid) (,ref ,sequence ,mid)))
    166       (,merge-sort-call ,sequence ,mid ,end ,predicate ,key ,aux (not ,direction)))
    167         (unless ,direction (psetq ,sequence ,aux ,aux ,sequence))
    168         ,(if mkey
    169       `(merge-vectors-body ,type ,ref ,sequence ,start ,mid ,sequence
    170                 ,mid ,end ,aux ,start ,predicate ,key)
    171       `(merge-vectors-body ,type ,ref ,sequence ,start ,mid ,sequence
    172                 ,mid ,end ,aux ,start ,predicate)))))
    173   (let ((,maux (make-array ,mend)))
     156                  (declare (type function ,predicate ,@(if mkey `(,key)))
     157                           (type fixnum ,start ,end)
     158                           (type ,type ,sequence))
     159                  (let ((,mid (+ ,start (ash (- ,end ,start) -1))))
     160                    (declare (type fixnum ,mid))
     161                    (if (<= (- ,mid 1) ,start)
     162                        (unless ,direction (setf (,ref ,aux ,start) (,ref ,sequence ,start)))
     163                        (,merge-sort-call ,sequence ,start ,mid ,predicate ,key ,aux (not ,direction)))
     164                    (if (>= (+ ,mid 1) ,end)
     165                        (unless ,direction (setf (,ref ,aux ,mid) (,ref ,sequence ,mid)))
     166                        (,merge-sort-call ,sequence ,mid ,end ,predicate ,key ,aux (not ,direction)))
     167                    (unless ,direction (psetq ,sequence ,aux ,aux ,sequence))
     168                    ,(if mkey
     169                        `(merge-vectors-body ,type ,ref ,sequence ,start ,mid ,sequence
     170                                              ,mid ,end ,aux ,start ,predicate ,key)
     171                        `(merge-vectors-body ,type ,ref ,sequence ,start ,mid ,sequence
     172                                              ,mid ,end ,aux ,start ,predicate)))))
     173        (let ((,maux (make-array ,mend)))
    174174           (declare (type ,maux ,type))
    175      (,merge-sort-call ,msequence ,mstart ,mend ,mpredicate ,mkey ,maux nil))))))
     175           (,merge-sort-call ,msequence ,mstart ,mend ,mpredicate ,mkey ,maux nil))))))
    176176
    177177(defun merge-sort-vectors (sequence predicate key)
    … …  
    181181        (simple-vector
    182182         (if key
    183        (merge-sort-body simple-vector svref predicate key sequence 0 end)
    184        (merge-sort-body simple-vector svref predicate nil sequence 0 end)))
     183             (merge-sort-body simple-vector svref predicate key sequence 0 end)
     184             (merge-sort-body simple-vector svref predicate nil sequence 0 end)))
    185185        (vector
    186186         (if key
    187        (merge-sort-body vector aref predicate key sequence 0 end)
    188        (merge-sort-body vector aref predicate nil sequence 0 end)))))
     187             (merge-sort-body vector aref predicate key sequence 0 end)
     188             (merge-sort-body vector aref predicate nil sequence 0 end)))))
    189189    sequence))
    190190
    … …  
    373373(defmacro quicksort-body (type ref mpredicate mkey sequence mstart mend)
    374374  (let ((quicksort-call (gensym))
    375   (predicate (gensym))
    376   (key (gensym))
    377   (vector (gensym))
    378   (start (gensym))
    379   (end (gensym))
    380   (i (gensym))
    381   (j (gensym))
    382   (p (gensym))
    383   (d (gensym))
    384   (kd (gensym)))
     375        (predicate (gensym))
     376        (key (gensym))
     377        (vector (gensym))
     378        (start (gensym))
     379        (end (gensym))
     380        (i (gensym))
     381        (j (gensym))
     382        (p (gensym))
     383        (d (gensym))
     384        (kd (gensym)))
    385385    `(locally
    386   (declare (speed 3) (safety 0))
     386        (declare (speed 3) (safety 0))
    387387       (labels ((,quicksort-call (,vector ,start ,end ,predicate ,key)
    388        (declare (type function ,predicate ,@(if mkey `(,key)))
    389           (type fixnum ,start ,end)
    390           (type ,type ,sequence))
    391        (if (< ,start ,end)
    392            (let* ((,i ,start)
    393             (,j (1+ ,end))
    394             (,p (the fixnum (+ ,start (ash (- ,end ,start) -1))))
    395             (,d (,ref ,vector ,p))
    396             ,@(if mkey
    397             `((,kd (funcall ,key ,d)))
    398             `((,kd ,d))))
    399       (rotatef (,ref ,vector ,p) (,ref ,vector ,start))
    400       (block outer-loop
    401          (loop
    402            (loop
    403              (unless (> (decf ,j) ,i) (return-from outer-loop))
    404              (when (funcall ,predicate
    405                 ,@(if mkey
    406                 `((funcall ,key (,ref ,vector ,j)))
    407                 `((,ref ,vector ,j)))
    408                 ,kd) (return)))
    409            (loop
    410              (unless (< (incf ,i) ,j) (return-from outer-loop))
    411              (unless (funcall ,predicate
    412             ,@(if mkey
    413                 `((funcall ,key (,ref ,vector ,i)))
    414                 `((,ref ,vector ,i)))
    415             ,kd) (return)))
    416            (rotatef (,ref ,vector ,i) (,ref ,vector ,j))))
    417       (setf (,ref ,vector ,start) (,ref ,vector ,j)
    418              (,ref ,vector ,j) ,d)
    419       (if (< (- ,j ,start) (- ,end ,j))
    420            (progn
    421              (,quicksort-call ,vector ,start (1- ,j) ,predicate ,key)
    422              (,quicksort-call ,vector (1+ ,j) ,end ,predicate ,key))
    423            (progn
    424              (,quicksort-call ,vector (1+ ,j) ,end ,predicate ,key)
    425              (,quicksort-call ,vector ,start (1- ,j) ,predicate ,key)))))))
    426   (,quicksort-call ,sequence ,mstart ,mend ,mpredicate ,mkey)))))
     388                   (declare (type function ,predicate ,@(if mkey `(,key)))
     389                            (type fixnum ,start ,end)
     390                            (type ,type ,sequence))
     391                   (if (< ,start ,end)
     392                       (let* ((,i ,start)
     393                              (,j (1+ ,end))
     394                              (,p (the fixnum (+ ,start (ash (- ,end ,start) -1))))
     395                              (,d (,ref ,vector ,p))
     396                              ,@(if mkey
     397                                    `((,kd (funcall ,key ,d)))
     398                                    `((,kd ,d))))
     399                        (rotatef (,ref ,vector ,p) (,ref ,vector ,start))
     400                        (block outer-loop
     401                           (loop
     402                             (loop
     403                               (unless (> (decf ,j) ,i) (return-from outer-loop))
     404                               (when (funcall ,predicate
     405                                              ,@(if mkey
     406                                                    `((funcall ,key (,ref ,vector ,j)))
     407                                                    `((,ref ,vector ,j)))
     408                                              ,kd) (return)))
     409                             (loop
     410                               (unless (< (incf ,i) ,j) (return-from outer-loop))
     411                               (unless (funcall ,predicate
     412                                                ,@(if mkey
     413                                                    `((funcall ,key (,ref ,vector ,i)))
     414                                                    `((,ref ,vector ,i)))
     415                                                ,kd) (return)))
     416                             (rotatef (,ref ,vector ,i) (,ref ,vector ,j))))
     417                        (setf (,ref ,vector ,start) (,ref ,vector ,j)
     418                               (,ref ,vector ,j) ,d)
     419                        (if (< (- ,j ,start) (- ,end ,j))
     420                             (progn
     421                               (,quicksort-call ,vector ,start (1- ,j) ,predicate ,key)
     422                               (,quicksort-call ,vector (1+ ,j) ,end ,predicate ,key))
     423                             (progn
     424                               (,quicksort-call ,vector (1+ ,j) ,end ,predicate ,key)
     425                               (,quicksort-call ,vector ,start (1- ,j) ,predicate ,key)))))))
     426        (,quicksort-call ,sequence ,mstart ,mend ,mpredicate ,mkey)))))
    427427
    428428(defun quicksort (sequence predicate key)
Note: See TracChangeset for help on using the changeset viewer.