/[emacs]/emacs/lisp/emacs-lisp/cl-seq.el
ViewVC logotype

Diff of /emacs/lisp/emacs-lisp/cl-seq.el

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

revision 1.10 by eliz, Fri Jan 25 18:46:37 2002 UTC revision 1.10.4.1 by miles, Fri Apr 4 06:20:16 2003 UTC
# Line 48  Line 48 
48      (error "Tried to load `cl-seq' before `cl'!"))      (error "Tried to load `cl-seq' before `cl'!"))
49    
50    
 ;;; We define these here so that this file can compile without having  
 ;;; loaded the cl.el file already.  
   
 (defmacro cl-push (x place) (list 'setq place (list 'cons x place)))  
 (defmacro cl-pop (place)  
   (list 'car (list 'prog1 place (list 'setq place (list 'cdr place)))))  
   
   
51  ;;; Keyword parsing.  This is special-cased here so that we can compile  ;;; Keyword parsing.  This is special-cased here so that we can compile
52  ;;; this file independent from cl-macs.  ;;; this file independent from cl-macs.
53    
# Line 140  Keywords supported:  :start :end :from-e Line 132  Keywords supported:  :start :end :from-e
132      (setq cl-seq (subseq cl-seq cl-start cl-end))      (setq cl-seq (subseq cl-seq cl-start cl-end))
133      (if cl-from-end (setq cl-seq (nreverse cl-seq)))      (if cl-from-end (setq cl-seq (nreverse cl-seq)))
134      (let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value)      (let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value)
135                            (cl-seq (cl-check-key (cl-pop cl-seq)))                            (cl-seq (cl-check-key (pop cl-seq)))
136                            (t (funcall cl-func)))))                            (t (funcall cl-func)))))
137        (if cl-from-end        (if cl-from-end
138            (while cl-seq            (while cl-seq
139              (setq cl-accum (funcall cl-func (cl-check-key (cl-pop cl-seq))              (setq cl-accum (funcall cl-func (cl-check-key (pop cl-seq))
140                                      cl-accum)))                                      cl-accum)))
141          (while cl-seq          (while cl-seq
142            (setq cl-accum (funcall cl-func cl-accum            (setq cl-accum (funcall cl-func cl-accum
143                                    (cl-check-key (cl-pop cl-seq))))))                                    (cl-check-key (pop cl-seq))))))
144        cl-accum)))        cl-accum)))
145    
146  (defun fill (seq item &rest cl-keys)  (defun fill (seq item &rest cl-keys)
# Line 518  Keywords supported:  :test :test-not :ke Line 510  Keywords supported:  :test :test-not :ke
510        (or cl-end (setq cl-end (length cl-seq)))        (or cl-end (setq cl-end (length cl-seq)))
511        (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))        (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
512        (while (< cl-start cl-end)        (while (< cl-start cl-end)
513          (setq cl-x (if (consp cl-seq) (cl-pop cl-seq) (aref cl-seq cl-start)))          (setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start)))
514          (if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count)))          (if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count)))
515          (setq cl-start (1+ cl-start)))          (setq cl-start (1+ cl-start)))
516        cl-count)))        cl-count)))
# Line 618  Keywords supported:  :key" Line 610  Keywords supported:  :key"
610        (while (and cl-seq1 cl-seq2)        (while (and cl-seq1 cl-seq2)
611          (if (funcall cl-pred (cl-check-key (car cl-seq2))          (if (funcall cl-pred (cl-check-key (car cl-seq2))
612                       (cl-check-key (car cl-seq1)))                       (cl-check-key (car cl-seq1)))
613              (cl-push (cl-pop cl-seq2) cl-res)              (push (pop cl-seq2) cl-res)
614            (cl-push (cl-pop cl-seq1) cl-res)))            (push (pop cl-seq1) cl-res)))
615        (coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type))))        (coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type))))
616    
617  ;;; See compiler macro in cl-macs.el  ;;; See compiler macro in cl-macs.el
# Line 716  Keywords supported:  :test :test-not :ke Line 708  Keywords supported:  :test :test-not :ke
708             (if (or cl-keys (numberp (car cl-list2)))             (if (or cl-keys (numberp (car cl-list2)))
709                 (setq cl-list1 (apply 'adjoin (car cl-list2) cl-list1 cl-keys))                 (setq cl-list1 (apply 'adjoin (car cl-list2) cl-list1 cl-keys))
710               (or (memq (car cl-list2) cl-list1)               (or (memq (car cl-list2) cl-list1)
711                   (cl-push (car cl-list2) cl-list1)))                   (push (car cl-list2) cl-list1)))
712             (cl-pop cl-list2))             (pop cl-list2))
713           cl-list1)))           cl-list1)))
714    
715  (defun nunion (cl-list1 cl-list2 &rest cl-keys)  (defun nunion (cl-list1 cl-list2 &rest cl-keys)
# Line 746  Keywords supported:  :test :test-not :ke Line 738  Keywords supported:  :test :test-not :ke
738                         (apply 'member* (cl-check-key (car cl-list2))                         (apply 'member* (cl-check-key (car cl-list2))
739                                cl-list1 cl-keys)                                cl-list1 cl-keys)
740                       (memq (car cl-list2) cl-list1))                       (memq (car cl-list2) cl-list1))
741                     (cl-push (car cl-list2) cl-res))                     (push (car cl-list2) cl-res))
742                 (cl-pop cl-list2))                 (pop cl-list2))
743               cl-res)))))               cl-res)))))
744    
745  (defun nintersection (cl-list1 cl-list2 &rest cl-keys)  (defun nintersection (cl-list1 cl-list2 &rest cl-keys)
# Line 772  Keywords supported:  :test :test-not :ke Line 764  Keywords supported:  :test :test-not :ke
764                    (apply 'member* (cl-check-key (car cl-list1))                    (apply 'member* (cl-check-key (car cl-list1))
765                           cl-list2 cl-keys)                           cl-list2 cl-keys)
766                  (memq (car cl-list1) cl-list2))                  (memq (car cl-list1) cl-list2))
767                (cl-push (car cl-list1) cl-res))                (push (car cl-list1) cl-res))
768            (cl-pop cl-list1))            (pop cl-list1))
769          cl-res))))          cl-res))))
770    
771  (defun nset-difference (cl-list1 cl-list2 &rest cl-keys)  (defun nset-difference (cl-list1 cl-list2 &rest cl-keys)
# Line 817  Keywords supported:  :test :test-not :ke Line 809  Keywords supported:  :test :test-not :ke
809               (while (and cl-list1               (while (and cl-list1
810                           (apply 'member* (cl-check-key (car cl-list1))                           (apply 'member* (cl-check-key (car cl-list1))
811                                  cl-list2 cl-keys))                                  cl-list2 cl-keys))
812                 (cl-pop cl-list1))                 (pop cl-list1))
813               (null cl-list1)))))               (null cl-list1)))))
814    
815  (defun subst-if (cl-new cl-pred cl-tree &rest cl-keys)  (defun subst-if (cl-new cl-pred cl-tree &rest cl-keys)

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.10.4.1

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