Changeset 919


Ignore:
Timestamp:
Feb 16, 2005, 7:41:19 PM (17 years ago)
Author:
bryan
Message:

rewrite #* handler

#* must signal a reader-error if any of the token characters
are not 0 or 1. previously it would stop at the first character
that was not 0 or 1. single- and multi-escape are not allowed
in the token for #*.

#n* when n > 0 must have at least one element. the number of
elements can not exceed n.

except if *read-suppress*, then anything goes until the next
whitespace or terminating macro.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/lib/read.lisp

    r271 r919  
    5353   &aux list list-length array array-length last-bit)
    5454  (declare (ignore sub-char))
    55   (do* ((char (read-char input-stream nil (code-char 50) t)
    56               (read-char input-stream nil (code-char 50) t))
    57         (number (- (char-code char) 48) (- (char-code char) 48)))
    58        ((not (<= 0 number 1))
    59         (if (not (= number 2)) ;not at eof
    60             (unread-char char input-stream)))
    61       (setq list (cons number list)))
     55  (do* ((char (read-char input-stream nil nil t)
     56              (read-char input-stream nil nil t))
     57        (attr (%character-attribute char (rdtab.ttab *readtable*))
     58              (%character-attribute char (rdtab.ttab *readtable*))))
     59       ((or (null char)
     60            (= $cht_tmac attr)
     61            (= $cht_wsp attr))
     62        (if char (unread-char char input-stream)))
     63    (let ((number (- (char-code char) 48)))
     64      (if (or (<= 0 number 1) *read-suppress*)
     65          (setq list (cons number list))
     66          (signal-reader-error input-stream "reader macro #* got illegal character ~S" char))))
    6267  (setq last-bit (car list))
    6368  (setq list (nreverse list))
    6469  (setq list-length (list-length list))
    65   (cond ((and (integerp int) (> list-length int))
    66          (signal-reader-error input-stream "reader macro #* got an array length shorter than the list ~S ~S" int list))
    67         (*read-suppress* nil)
     70  (if (not (integerp int))
     71      (setq int list-length))
     72  (cond (*read-suppress* nil)
     73        ((and (= 0 list-length) (> int 0))
     74         (signal-reader-error input-stream "reader macro #~S* needs something" int))
     75        ((> list-length int)
     76         (signal-reader-error input-stream "reader macro #~S* can't fit ~S" int list))
    6877        (t (setq array-length (if int int list-length))
    6978           (setq array (make-array array-length :element-type 'bit))
     
    7180                (bit-list list (cdr bit-list)))
    7281               ((>= i array-length))
    73               (aset array i (if bit-list
    74                                 (car bit-list)
    75                                 last-bit)))
     82             (aset array i (if bit-list
     83                               (car bit-list)
     84                               last-bit)))
    7685           array))))
    7786
Note: See TracChangeset for help on using the changeset viewer.