Changeset 12925
- Timestamp:
- Oct 8, 2009, 11:36:47 AM (11 years ago)
- Location:
- trunk/source
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/level-1/l1-reader.lisp
r12854 r12925 2151 2151 t)) 2152 2152 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-alist2158 (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 over2171 READTABLE's macros. Each invocation of NAME yields five values:2172 2173 VALUE? CHAR FUNCTION DISPATCH? DISPATCH-ALIST2174 2175 VALUE? is true until the iterator runs out of items. CHAR is the2176 macro character. FUNCTION is the primary value of2177 `get-macro-character' for CHAR. DISPATCH? is true if and only if2178 CHAR is a dispatching macro character. DISPATCH-ALIST is an alist2179 mapping sub-characters to their respective values of2180 `get-dispatch-macro-character', and is NIL unless DISPATCH?.2181 2182 MACRO-CHAR-TYPES, which defaults2183 to (:macro-char :dispatch-macro-char) thereby yielding all items,2184 selects subsets of the iterated items. When `:macro-char' is2185 present, yield those values where DISPATCH? is false; when2186 `:dispatch-macro-char' is present, yield those values where2187 DISPATCH? is true.2188 2189 The consequences of modifying READTABLE after entering BODY and2190 before the final invocation of NAME or final use of a2191 DISPATCH-ALIST are undefined."2192 (unless (symbolp name)2193 (signal-program-error2194 "~S is not a variable name" name))2195 (let ((it (gensym)) macs? dmacs?)2196 (if macro-char-types2197 (dolist (mct macro-char-types)2198 (case mct2199 ((:macro-char) (setq macs? t))2200 ((:dispatch-macro-char) (setq dmacs? t))2201 (otherwise2202 (signal-program-error ;can't be type-error2203 "~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 2153 2212 2154 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -
trunk/source/lib/ccl-export-syms.lisp
r12693 r12925 706 706 ;; Miscellany 707 707 heap-utilization 708 with-readtable-iterator709 708 710 709 external-process-creation-failure
Note: See TracChangeset
for help on using the changeset viewer.