[Sbcl-commits] master: Make READ-MAYBE-NOTHING the only right way to call a reader macro.

[Douglas K. <sn...@us...>]

The branch "master" has been updated in SBCL:
       via  bdfbf52d52fd7f544f2983466ea34a5a54e95e3e (commit)
      from  aad1b1096f9f96ec2ee9b78ea0084fd2f45af660 (commit)

- Log -----------------------------------------------------------------
commit bdfbf52d52fd7f544f2983466ea34a5a54e95e3e
Author: Douglas Katzman <do...@go...>
Date:   Wed Sep 10 12:21:00 2014 -0400

    Make READ-MAYBE-NOTHING the only right way to call a reader macro.
    
    By eliminating the WITH-CHAR-MACRO-RESULT macro, the functionality of
    which is entirely absorbed into READ-MAYBE-NOTHING, alternate
    implementations of READ-MAYBE-NOTHING can be considered
    - such as alluded to in my recent posting to sbcl-devel - without
    reimplementing large parts of the reader as, for instance, in sb-cover.
    
    The present change to sb-cover is just minimally compatible, and
    ridiculous, since the entire point of this change is to avoid that.
    
    Also eliminate a needless (DECLARE (SPECIAL)).
---
 contrib/sb-cover/cover.lisp |   12 ++++----
 src/code/reader.lisp        |   67 ++++++++++++++++++------------------------
 tests/reader.pure.lisp      |    1 -
 3 files changed, 35 insertions(+), 45 deletions(-)

diff --git a/contrib/sb-cover/cover.lisp b/contrib/sb-cover/cover.lisp
index 134b8e7..a5009cd 100644
--- a/contrib/sb-cover/cover.lisp
+++ b/contrib/sb-cover/cover.lisp
@@ -501,16 +501,16 @@ The source locations are stored in SOURCE-MAP."
                                "Nothing appears before . in list.")))
                            ((sb-impl::whitespace[2]p nextchar)
                             (setq nextchar (sb-impl::flush-whitespace stream))))
-                     (rplacd listtail
-                             ;; Return list containing last thing.
-                             (car (sb-impl::read-after-dot stream nextchar)))
+                     (rplacd listtail (sb-impl::read-after-dot stream nextchar))
                      (return (cdr thelist)))
                     ;; Put back NEXTCHAR so that we can read it normally.
                     (t (unread-char nextchar stream)))))
           ;; Next thing is not an isolated dot.
-          (let ((start (file-position stream))
-                (listobj (sb-impl::read-maybe-nothing stream firstchar))
-                (end (file-position stream)))
+          (sb-int:binding*
+              ((start (file-position stream))
+               ((winp obj) (sb-impl::read-maybe-nothing stream firstchar))
+               (listobj (if winp (list obj)))
+               (end (file-position stream)))
             ;; allows the possibility that a comment was read
             (when listobj
              (unless (consp (car listobj))
diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index f8ef23f..de61c0c 100644
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -127,19 +127,6 @@
   `(let ((x ,val))
      (if (fdefn-p x) (fdefn-name x) x)))
 
-;;; Call the macro function for CHAR on STREAM, bind RESULT-VAR to
-;;; its result, and execute BODY.
-(defmacro !with-char-macro-result ((result-var supplied-p-var)
-                                   (stream char) &body body)
-  (with-unique-names (proc)
-    `(dx-flet ((,proc (&optional (,result-var nil ,supplied-p-var) &rest junk)
-                 (declare (ignore junk)) ; is this ANSI-specified?
-                 ,@body))
-       (multiple-value-call #',proc
-         (let ((entry (get-raw-cmt-entry ,char *readtable*)))
-           (funcall (!cmt-entry-to-function entry #'read-token)
-                    ,stream ,char))))))
-
 ;;; The character attribute table is a BASE-CHAR-CODE-LIMIT vector
 ;;; of (unsigned-byte 8) plus a hashtable to handle higher character codes.
 
@@ -660,7 +647,7 @@ standard Lisp readtable when NIL."
 ;;; as an alist, so maybe we should. -- WHN 19991202
 (defvar *sharp-equal-alist* ())
 
-(declaim (special *standard-input*))
+(declaim (ftype (sfunction (t t) (values t t)) read-maybe-nothing))
 
 ;;; Like READ-PRESERVING-WHITESPACE, but doesn't check the read buffer
 ;;; for being set up properly.
@@ -673,7 +660,8 @@ standard Lisp readtable when NIL."
          (cond ((eq char +EOF+) (return eof-value))
                ((whitespace[2]p char))
                (t
-                (!with-char-macro-result (result result-p) (stream char)
+                (multiple-value-bind (result-p result)
+                    (read-maybe-nothing stream char)
                   ;; Repeat if macro returned nothing.
                   (when result-p
                     (return (unless *read-suppress* result))))))))
@@ -694,13 +682,18 @@ standard Lisp readtable when NIL."
   (check-for-recursive-read stream recursive-p 'read-preserving-whitespace)
   (%read-preserving-whitespace stream eof-error-p eof-value recursive-p))
 
-;;; Return NIL or a list with one thing, depending.
-;;;
+;;; Read from STREAM given starting CHAR, returning T and the resulting
+;;; object, unless CHAR is a macro yielding no value, then NIL and NIL,
 ;;; for functions that want comments to return so that they can look
 ;;; past them. We assume CHAR is not whitespace.
 (defun read-maybe-nothing (stream char)
-  (!with-char-macro-result (retval retval-p) (stream char)
-    (if retval-p (list retval))))
+  (multiple-value-call
+   (lambda (&optional (result nil supplied-p) &rest junk)
+     (declare (ignore junk)) ; is this ANSI-specified?
+     (values supplied-p result))
+   (funcall (!cmt-entry-to-function
+             (get-raw-cmt-entry char *readtable*) #'read-token)
+            stream char)))
 
 (defun read (&optional (stream *standard-input*)
                        (eof-error-p t)
@@ -735,8 +728,10 @@ standard Lisp readtable when NIL."
                 (retlist ()))
                ((char= char endchar)
                 (unless *read-suppress* (nreverse retlist)))
-             (setq retlist (nconc (read-maybe-nothing input-stream char)
-                                  retlist)))))
+             (multiple-value-bind (winp obj)
+                 (read-maybe-nothing input-stream char)
+               (when winp
+                 (push obj retlist))))))
     (declare (inline %read-delimited-list))
     (if recursive-p
         (%read-delimited-list endchar input-stream)
@@ -792,9 +787,7 @@ standard Lisp readtable when NIL."
                                "Nothing appears before . in list.")))
                        ((whitespace[2]p nextchar)
                         (setq nextchar (flush-whitespace stream))))
-                 (rplacd listtail
-                             ;; Return list containing last thing.
-                         (car (read-after-dot stream nextchar)))
+                 (rplacd listtail (read-after-dot stream nextchar))
                  ;; Check for improper ". ,@" or ". ,." now rather than
                  ;; in the #\` reader. The resulting QUASIQUOTE macro might
                  ;; never be exapanded, but nonetheless could be erroneous.
@@ -808,11 +801,10 @@ standard Lisp readtable when NIL."
                     ;; Put back NEXTCHAR so that we can read it normally.
                 (t (unread-char nextchar stream)))))
       ;; Next thing is not an isolated dot.
-      (let ((listobj (read-maybe-nothing stream firstchar)))
+      (multiple-value-bind (winp obj) (read-maybe-nothing stream firstchar)
         ;; allows the possibility that a comment was read
-        (when listobj
-          (rplacd listtail listobj)
-          (setq listtail listobj))))))
+        (when winp
+          (setq listtail (cdr (rplacd listtail (list obj)))))))))
 
 (defun read-after-dot (stream firstchar)
   ;; FIRSTCHAR is non-whitespace!
@@ -823,18 +815,17 @@ standard Lisp readtable when NIL."
              (return-from read-after-dot nil)
              (simple-reader-error stream "Nothing appears after . in list.")))
       ;; See whether there's something there.
-      (setq lastobj (read-maybe-nothing stream char))
-      (when lastobj (return t)))
+      (multiple-value-bind (winp obj) (read-maybe-nothing stream char)
+        (when winp (return (setq lastobj obj)))))
     ;; At least one thing appears after the dot.
     ;; Check for more than one thing following dot.
-    (do ((lastchar (flush-whitespace stream)
-                   (flush-whitespace stream)))
-        ((char= lastchar #\) ) lastobj) ;success!
-      ;; Try reading virtual whitespace.
-      (if (and (read-maybe-nothing stream lastchar)
-               (not *read-suppress*))
-          (simple-reader-error stream
-                               "More than one object follows . in list.")))))
+    (loop
+     (let ((char (flush-whitespace stream)))
+       (cond ((char= #\) char) (return lastobj)) ;success!
+             ;; Try reading virtual whitespace.
+             ((and (read-maybe-nothing stream char) (not *read-suppress*))
+              (simple-reader-error
+               stream "More than one object follows . in list.")))))))
 
 (defun read-string (stream closech)
   ;; This accumulates chars until it sees same char that invoked it.
diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp
index db22446..f2cae1e 100644
--- a/tests/reader.pure.lisp
+++ b/tests/reader.pure.lisp
@@ -308,7 +308,6 @@
 ;; instead of using dx allocation or a recyclable resource:
 ;;  - most obviously, a 128-character buffer per invocation of READ
 ;;  - calling SUBSEQ for package names
-;;  - multiple-value-call in WITH-CHAR-MACRO-RESULT
 ;;  - the initial cons cell in READ-LIST
 (with-test (:name :read-does-not-cons-per-se)
   (flet ((test-reading (string)

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL