Ticket #339: ccl.with-readtable-iterator.3.diff

File ccl.with-readtable-iterator.3.diff, 3.3 KB (added by S11001001, 12 years ago)

based on proposed changes to the CDR

  • lib/ccl-export-syms.lisp

     
    637637     unmap-octet-vector
    638638     ;; Miscellany
    639639     heap-utilization
     640     with-readtable-iterator
    640641                                     
    641642     ) "CCL"
    642643   )
  • level-1/l1-reader.lisp

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