Changeset 12693 for trunk/source/level-1


Ignore:
Timestamp:
Aug 26, 2009, 3:54:40 PM (10 years ago)
Author:
gz
Message:

with-readtable-iterator from Stephen Compall (S11001001)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-reader.lisp

    r12633 r12693  
    21512151    t))
    21522152
     2153(defun %make-readtable-iterator (readtable macs? dmacs?)
     2154  (setq readtable (readtable-arg (or readtable %initial-readtable%)))
     2155  (let ((char-macro-alist (rdtab.alist readtable)))
     2156    (labels ((generate ()
     2157               (if char-macro-alist
     2158                   (destructuring-bind (char . defn) (pop char-macro-alist)
     2159                     (if (consp defn)
     2160                         (if dmacs?
     2161                             (values t char (car defn) t (cdr defn))
     2162                             (generate))
     2163                         (if macs?
     2164                             (values t char defn nil nil)
     2165                             (generate))))
     2166                   (values nil nil nil nil nil))))
     2167      #'generate)))
     2168
     2169(defmacro with-readtable-iterator ((name readtable &rest macro-char-types) &body body)
     2170  "While executing BODY, bind NAME to a macro that iterates over
     2171   READTABLE's macros.  Each invocation of NAME yields five values:
     2172
     2173   VALUE? CHAR FUNCTION DISPATCH? DISPATCH-ALIST
     2174
     2175   VALUE? is true until the iterator runs out of items.  CHAR is the
     2176   macro character.  FUNCTION is the primary value of
     2177   `get-macro-character' for CHAR.  DISPATCH? is true if and only if
     2178   CHAR is a dispatching macro character.  DISPATCH-ALIST is an alist
     2179   mapping sub-characters to their respective values of
     2180   `get-dispatch-macro-character', and is NIL unless DISPATCH?.
     2181
     2182   MACRO-CHAR-TYPES, which defaults
     2183   to (:macro-char :dispatch-macro-char) thereby yielding all items,
     2184   selects subsets of the iterated items.  When `:macro-char' is
     2185   present, yield those values where DISPATCH? is false; when
     2186   `:dispatch-macro-char' is present, yield those values where
     2187   DISPATCH? is true.
     2188
     2189   The consequences of modifying READTABLE after entering BODY and
     2190   before the final invocation of NAME or final use of a
     2191   DISPATCH-ALIST are undefined."
     2192  (unless (symbolp name)
     2193    (signal-program-error
     2194     "~S is not a variable name" name))
     2195  (let ((it (gensym)) macs? dmacs?)
     2196    (if macro-char-types
     2197        (dolist (mct macro-char-types)
     2198          (case mct
     2199            ((:macro-char) (setq macs? t))
     2200            ((:dispatch-macro-char) (setq dmacs? t))
     2201            (otherwise
     2202               (signal-program-error    ;can't be type-error
     2203                "~S is not one of ~S or ~S"
     2204                mct :macro-char :dispatch-macro-char))))
     2205        (setq macs? t dmacs? t))
     2206    `(let ((,it (%make-readtable-iterator ,readtable ,macs? ,dmacs?)))
     2207       (macrolet ((,name () `(funcall ,',it)))
     2208         ,@body))))
     2209
     2210
     2211
    21532212;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    21542213;;                              Reader                                  ;;
Note: See TracChangeset for help on using the changeset viewer.