/[gcl]/gcl/lsp/gcl_seqlib.lsp
ViewVC logotype

Diff of /gcl/lsp/gcl_seqlib.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8 by camm, Sun Sep 18 02:46:35 2005 UTC revision 1.9 by camm, Wed Oct 5 15:25:36 2005 UTC
# Line 78  Line 78 
78    
79  (eval-when (compile eval)  (eval-when (compile eval)
80  (proclaim '(function the-start (t) fixnum))  (proclaim '(function the-start (t) fixnum))
81  (proclaim '(function the-end (t t) fixnum))  (proclaim '(function the-end (t fixnum) fixnum))
82  (defmacro f+ (x y) `(the fixnum (+ (the fixnum ,x) (the fixnum ,y))))  (defmacro f+ (x y) `(the fixnum (+ (the fixnum ,x) (the fixnum ,y))))
83  (defmacro f- (x y) `(the fixnum (- (the fixnum ,x) (the fixnum ,y))))  (defmacro f- (x y) `(the fixnum (- (the fixnum ,x) (the fixnum ,y))))
84    
85  (defmacro with-start-end ( start end seq &body body)  (defmacro with-start-end ( start end seq &body body)
86    `(let ((,start (if ,start (the-start ,start) 0)))    `(let ((,start (if ,start (the-start ,start) 0)))
87       (declare (fixnum ,start))       (declare (fixnum ,start))
88       (let ((,end (the-end ,end ,seq)))       (check-type ,seq sequence)
89         (let ((,end (the-end ,end (length ,seq))))
90         (declare (fixnum ,end))         (declare (fixnum ,end))
91         (or (<= ,start ,end) (bad-seq-limit  ,start ,end))         (or (<= ,start ,end) (bad-seq-limit  ,start ,end))
92         ,@ body)))         ,@ body)))
# Line 93  Line 94 
94    
95  (defun the-end (x y)  (defun the-end (x y)
96    (cond ((fixnump x)    (cond ((fixnump x)
97           (or (<= (the fixnum x) (the fixnum (length y)))           (or (<= (the fixnum x) y)
98               (bad-seq-limit x))               (bad-seq-limit x))
99           x)           x)
100          ((null x)          ((null x) y)
          (length y))  
101          (t (bad-seq-limit x))))          (t (bad-seq-limit x))))
102                    
103  (defun the-start (x)  (defun the-start (x)
# Line 116  Line 116 
116                      end                      end
117                      (initial-value nil ivsp)                      (initial-value nil ivsp)
118                      (key #'identity))                      (key #'identity))
119      (declare (optimize (safety 1)))
120    (with-start-end  start end sequence    (with-start-end  start end sequence
121       (cond ((not from-end)       (cond ((not from-end)
122             (when (null ivsp)             (when (null ivsp)
# Line 143  Line 144 
144    
145  (defun fill (sequence item  (defun fill (sequence item
146                        &key start end )                        &key start end )
147      (declare (optimize (safety 1)))
148    (with-start-end start end sequence    (with-start-end start end sequence
149                    (do ((i start (f+ 1 i)))                    (do ((i start (f+ 1 i)))
150                        ((>= i end) sequence)                        ((>= i end) sequence)
# Line 153  Line 155 
155  (defun replace (sequence1 sequence2  (defun replace (sequence1 sequence2
156                  &key start1  end1                  &key start1  end1
157                       start2 end2 )                       start2 end2 )
158      (declare (optimize (safety 1)))
159    (with-start-end start1 end1 sequence1    (with-start-end start1 end1 sequence1
160       (with-start-end start2 end2 sequence2                       (with-start-end start2 end2 sequence2                
161      (if (and (eq sequence1 sequence2)      (if (and (eq sequence1 sequence2)
# Line 221  Line 224 
224                         &key from-end test test-not                         &key from-end test test-not
225                              start end                              start end
226                              ,@(if countp '(count))                              ,@(if countp '(count))
227                              (key #'identity)                              (key #'identity))
228                         ,@(if everywherep         (declare (optimize (safety 1)))
229                               (list '&aux '(l (length sequence)))         (if (eq key nil) (setq key #'identity))
                              nil))  
               ,@(if everywherep '((declare (fixnum l))))  
               (if (eq key nil) (setq key #'identity))  
230         (with-start-end start end sequence         (with-start-end start end sequence
231             (let (,@(when everywherep `((l (length sequence)))))          
232               ,@(when everywherep '((declare (fixnum l))))
233            (let ,@(if countp            (let ,@(if countp
234                       '(((count                       '(((count
235                           (cond ((null count) most-positive-fixnum)                           (cond ((null count) most-positive-fixnum)
# Line 246  Line 248 
248                                    iterate-i-everywhere-from-end                                    iterate-i-everywhere-from-end
249                                    endp-i-everywhere                                    endp-i-everywhere
250                                    endp-i-everywhere-from-end)                                    endp-i-everywhere-from-end)
251                              (eval-body)))))))                              (eval-body))))))))
252          `(defun ,(intern (si:string-concatenate (string f) "-IF")          `(defun ,(intern (si:string-concatenate (string f) "-IF")
253                           (symbol-package f))                           (symbol-package f))
254                  (,@args predicate sequence                  (,@args predicate sequence
# Line 254  Line 256 
256                        start end                        start end
257                        ,@(if countp '(count))                        ,@(if countp '(count))
258                        (key #'identity))                        (key #'identity))
259                  (if (eq key nil) (setq key #'identity))             (declare (optimize (safety 1)))
260               (if (eq key nil) (setq key #'identity))
261             (,f ,@args predicate sequence             (,f ,@args predicate sequence
262                 :from-end from-end                 :from-end from-end
263                 :test #'funcall                 :test #'funcall
# Line 267  Line 270 
270                   &key from-end start end                   &key from-end start end
271                        ,@(if countp '(count))                        ,@(if countp '(count))
272                        (key #'identity))                        (key #'identity))
273                  (if (eq key nil) (setq key #'identity))             (declare (optimize (safety 1)))
274               (if (eq key nil) (setq key #'identity))
275             (,f ,@args predicate sequence             (,f ,@args predicate sequence
276                 :from-end from-end                 :from-end from-end
277                 :test-not #'funcall                 :test-not #'funcall
# Line 416  Line 420 
420                                 test test-not                                 test test-not
421                                 start end                                 start end
422                                 (key #'identity))                                 (key #'identity))
423      (declare (optimize (safety 1)))
424    (and test test-not (test-error))    (and test test-not (test-error))
425    (when (and (listp sequence) (not from-end) (null start)    (when (and (listp sequence) (not from-end) (null start)
426               (null end))               (null end))
# Line 439  Line 444 
444                                 test test-not                                 test test-not
445                                 start                                 start
446                                 end                                 end
447                                 (key #'identity)                                 (key #'identity))
448                            &aux (l (length sequence)))    (declare (optimize (safety 1)))
   (declare (fixnum l))  
449    (and test test-not (test-error))    (and test test-not (test-error))
450    (when (and (listp sequence) (not from-end) (null start)    (when (and (listp sequence) (not from-end) (null start)
451               (null end))               (null end))
# Line 455  Line 459 
459                     (rplaca l (cadr l))                     (rplaca l (cadr l))
460                     (rplacd l (cddr l)))                     (rplacd l (cddr l)))
461                    (t (setq l (cdr l))))))                    (t (setq l (cdr l))))))
462    (with-start-end start end sequence    (with-start-end
463       start end sequence
464       (let ((l (length sequence)))
465      (if (not from-end)      (if (not from-end)
466          (do ((n 0)          (do ((n 0)
467               (i start (f+ 1  i)))               (i start (f+ 1  i)))
# Line 518  Line 524 
524                            :start start                            :start start
525                            :end i                            :end i
526                            :key key)                            :key key)
527                  (setf  n (f+ 1  n)))))))                  (setf  n (f+ 1  n))))))))
528                
529    
530  (defun mismatch (sequence1 sequence2  (defun mismatch (sequence1 sequence2
# Line 526  Line 532 
532                        (key #'identity)                        (key #'identity)
533                        start1 start2                        start1 start2
534                        end1 end2)                        end1 end2)
535      (declare (optimize (safety 1)))
536    (and test test-not (test-error))    (and test test-not (test-error))
537    (with-start-end start1 end1 sequence1    (with-start-end start1 end1 sequence1
538     (with-start-end start2 end2 sequence2     (with-start-end start2 end2 sequence2
# Line 555  Line 562 
562                      (key #'identity)                      (key #'identity)
563                      start1 start2                      start1 start2
564                      end1 end2)                      end1 end2)
565      (declare (optimize (safety 1)))
566    (and test test-not (test-error))    (and test test-not (test-error))
567    (with-start-end start1 end1 sequence1    (with-start-end start1 end1 sequence1
568     (with-start-end start2 end2 sequence2       (with-start-end start2 end2 sequence2  
# Line 584  Line 592 
592    
593    
594  (defun sort (sequence predicate &key (key #'identity))  (defun sort (sequence predicate &key (key #'identity))
595      (declare (optimize (safety 1)))
596      (check-type sequence sequence)
597    (if (listp sequence)    (if (listp sequence)
598        (list-merge-sort sequence predicate key)        (list-merge-sort sequence predicate key)
599        (quick-sort sequence 0 (the fixnum (length sequence)) predicate key)))        (quick-sort sequence 0 (the fixnum (length sequence)) predicate key)))
# Line 689  Line 699 
699          (quick-sort seq (f+ 1  j) end pred key))))          (quick-sort seq (f+ 1  j) end pred key))))
700    
701  (defun stable-sort (sequence predicate &key (key #'identity))  (defun stable-sort (sequence predicate &key (key #'identity))
702      (declare (optimize (safety 1)))
703      (check-type sequence sequence)
704    (if (listp sequence)    (if (listp sequence)
705        (list-merge-sort sequence predicate key)        (list-merge-sort sequence predicate key)
706        (if (or (stringp sequence) (bit-vector-p sequence))        (if (or (stringp sequence) (bit-vector-p sequence))
# Line 702  Line 714 
714  (defun merge (result-type sequence1 sequence2 predicate  (defun merge (result-type sequence1 sequence2 predicate
715                &key (key #'identity)                &key (key #'identity)
716                &aux (l1 (length sequence1)) (l2 (length sequence2)))                &aux (l1 (length sequence1)) (l2 (length sequence2)))
717      (declare (optimize (safety 1)))
718    (declare (fixnum l1 l2))    (declare (fixnum l1 l2))
719    (when (equal key 'nil) (setq key #'identity))    (when (equal key 'nil) (setq key #'identity))
720    (do ((newseq (make-sequence result-type (the fixnum (f+ l1 l2))))    (do ((newseq (make-sequence result-type (the fixnum (f+ l1 l2))))
# Line 733  Line 746 
746    
747  (defun map-into (result-sequence function &rest sequences)  (defun map-into (result-sequence function &rest sequences)
748  ;  "map-into:  (result-sequence function &rest sequences)"  ;  "map-into:  (result-sequence function &rest sequences)"
749      (declare (optimize (safety 1)))
750      (check-type result-sequence sequence)
751    (let ((nel (apply #'min (if (subtypep (type-of result-sequence) 'vector)    (let ((nel (apply #'min (if (subtypep (type-of result-sequence) 'vector)
752                                (array-dimension result-sequence 0)                                (array-dimension result-sequence 0)
753                              (length result-sequence))                              (length result-sequence))
# Line 748  Line 763 
763    
764    
765  (defmacro with-hash-table-iterator ((name hash-table) &body body)  (defmacro with-hash-table-iterator ((name hash-table) &body body)
766      (declare (optimize (safety 1)))
767    (let ((table (gensym ))    (let ((table (gensym ))
768          (ind (gensym "ind")))          (ind (gensym "ind")))
769      `(let ((,table ,hash-table)      `(let ((,table ,hash-table)

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26