Changeset 12517


Ignore:
Timestamp:
03/03/10 22:23:53 (11 years ago)
Author:
astalla
Message:

Preliminary support for DOSEQUENCE.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/extensible-sequences.lisp

    r12516 r12517  
    980980 :preposition-groups '((:of :in)) :inclusive-permitted nil)
    981981
     982;;;DOSEQUENCE
     983
     984;;From SBCL
     985(eval-when (:compile-toplevel :load-toplevel :execute)
     986  (defun filter-dolist-declarations (decls)
     987    (mapcar (lambda (decl)
     988        `(declare ,@(remove-if
     989         (lambda (clause)
     990           (and (consp clause)
     991          (or (eq (car clause) 'type)
     992              (eq (car clause) 'ignore))))
     993         (cdr decl))))
     994      decls)))
     995
     996;; just like DOLIST, but with one-dimensional arrays
     997(defmacro dovector ((elt vector &optional result) &body body)
     998  (multiple-value-bind (forms decls)
     999      (sys:parse-body body :doc-string-allowed nil)
     1000    (let ((index (gensym "INDEX")) (length (gensym "LENGTH")) (vec (gensym "VEC")))
     1001      `(let ((,vec ,vector))
     1002        (declare (type vector ,vec))
     1003        (do ((,index 0 (1+ ,index))
     1004             (,length (length ,vec)))
     1005            ((>= ,index ,length) (let ((,elt nil))
     1006                                   ,@(filter-dolist-declarations decls)
     1007                                   ,elt
     1008                                   ,result))
     1009          (let ((,elt (aref ,vec ,index)))
     1010            ,@decls
     1011            (tagbody
     1012               ,@forms)))))))
     1013
     1014(defmacro sequence:dosequence ((e sequence &optional return &rest args &key
     1015          from-end start end) &body body)
     1016  (declare (ignore from-end start end))
     1017  (multiple-value-bind (forms decls)
     1018      (sys:parse-body body :doc-string-allowed nil)
     1019    (let ((s sequence)
     1020          (sequence (gensym "SEQUENCE")))
     1021      `(block nil
     1022        (let ((,sequence ,s))
     1023          (seq-dispatch ,sequence
     1024            (dolist (,e ,sequence ,return) ,@body)
     1025            (dovector (,e ,sequence ,return) ,@body)
     1026            (multiple-value-bind (state limit from-end step endp elt)
     1027                (sequence:make-sequence-iterator ,sequence ,@args)
     1028              (do ((state state (funcall step ,sequence state from-end)))
     1029                  ((funcall endp ,sequence state limit from-end)
     1030                   (let ((,e nil))
     1031                     ,@(filter-dolist-declarations decls)
     1032                     ,e
     1033                     ,return))
     1034                (let ((,e (funcall elt ,sequence state)))
     1035                  ,@decls
     1036                  (tagbody
     1037                     ,@forms))))))))))
     1038
    9821039(provide "EXTENSIBLE-SEQUENCES")
Note: See TracChangeset for help on using the changeset viewer.