Changeset 7608


Ignore:
Timestamp:
Nov 8, 2007, 3:42:15 AM (12 years ago)
Author:
gb
Message:

Add READ-SYMBOL-TOKEN, use it in the sharp-colon reader macro function.

File:
1 edited

Legend:

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

    r7370 r7608  
    27052705           (list sharp-comma-token (read stream t nil t)))))))
    27062706
     2707;;; Read a valid, non-numeric token string from stream; *READ-SUPPRESS*
     2708;;; is known to be false.
     2709(defun read-symbol-token (stream)
     2710  (multiple-value-bind (firstch attr) (%next-non-whitespace-char-and-attr-no-eof stream)
     2711    (declare (fixnum attr))
     2712    (with-token-buffer (tb)
     2713      (if (or (= attr $CHT_ILL)
     2714              (logbitp $cht_macbit attr)
     2715              (multiple-value-bind (escapes explicit-package nondots) (%collect-xtoken tb stream firstch)
     2716                (declare (ignore nondots))
     2717                (%casify-token tb (unless (atom escapes) escapes))
     2718                (or explicit-package
     2719                    (and (not escapes)
     2720                         (%token-to-number tb (%validate-radix *read-base*))))))
     2721        (%err-disp $XBADSYM)
     2722        (%string-from-token tb)))))
     2723
    27072724(set-dispatch-macro-character
    27082725 #\#
     
    27112728     (require-no-numarg subchar numarg)
    27122729     (if (not *read-suppress*)
    2713          (multiple-value-bind (firstch attr) (%next-non-whitespace-char-and-attr-no-eof stream)
    2714            (declare (fixnum attr))
    2715            (with-token-buffer (tb)
    2716              (if (or (= attr $CHT_ILL)
    2717                      (logbitp $cht_macbit attr)
    2718                      (multiple-value-bind (escapes explicit-package nondots) (%collect-xtoken tb stream firstch)
    2719                        (declare (ignore nondots))
    2720                        (%casify-token tb (unless (atom escapes) escapes))
    2721                        (or explicit-package
    2722                            (and (not escapes)
    2723                                 (%token-to-number tb (%validate-radix *read-base*))))))
    2724                (%err-disp $XBADSYM)
    2725                (make-symbol (%string-from-token tb)))))
    2726          (progn
    2727            (%read-list-expression stream nil)
    2728            nil))))
     2730       (make-symbol (read-symbol-token stream))
     2731       (progn
     2732         (%read-list-expression stream nil)
     2733         nil))))
    27292734
    27302735(set-dispatch-macro-character
Note: See TracChangeset for help on using the changeset viewer.