Commit c47519c9 authored by Christophe Rhodes's avatar Christophe Rhodes
Browse files

0.8.7.19: 

	Fix for PEEK-CHAR: whitespace means "according to the
	readtable", not "static list of characters"
	... but that's complicated for efficiency: we need WHITESPACEP
		defined before peek-char so that it can be expanded
		inline
	... so move peek-charish things into a new later file
	... delete unused-by-core WHITESPACE-CHAR-P, and adjust
		contribs to accomodate this
	... also add #\page to sb-aclrepl's static whitespace characters
parent fa646256

NEWS

+2 −0
Original line number Diff line number Diff line
@@ -2258,6 +2258,8 @@ changes in sbcl-0.8.8 relative to sbcl-0.8.7: 
       host is already defined.

    ** RENAME-FILE works on streams instead of signalling an internal

       type error.

    ** PEEK-CHAR now uses the current readtable when determining

       whether a character is whitespace.



planned incompatible changes in 0.8.x:

  * (not done yet, but planned:) When the profiling interface settles

build-order.lisp-expr

+1 −0
Original line number Diff line number Diff line
@@ -613,6 +613,7 @@ 
 ("src/code/target-random"     :not-host) ; needs "code/random"

 ("src/code/target-hash-table" :not-host) ; needs "code/hash-table"

 ("src/code/reader"            :not-host) ; needs "code/readtable"

 ("src/code/target-stream"     :not-host) ; needs WHITESPACEP from "code/reader"

 ("src/code/target-pathname"   :not-host) ; needs "code/pathname"

 ("src/code/filesys"           :not-host) ; needs HOST from "code/pathname"

 ("src/code/save"              :not-host) ; uses the definition of PATHNAME

contrib/sb-aclrepl/repl.lisp

+1 −2
Original line number Diff line number Diff line
@@ -760,17 +760,16 @@ 
  (and (characterp x)

       (or (char= x #\space)

	   (char= x #\tab)

	   (char= x #\page)

	   (char= x #\newline)

	   (char= x #\return))))



(defun whitespace-char-not-newline-p (x)

  (and (whitespace-char-p x)

       (not (char= x #\newline))))





;;;; linking into SBCL hooks





(defun repl-prompt-fun (stream)

  (let ((break-level (when (plusp *break-level*)

		       *break-level*))

contrib/sb-simple-streams/impl.lisp

+4 −2
Original line number Diff line number Diff line
@@ -953,6 +953,8 @@ 
    (etypecase stream

      (simple-stream

       (%peek-char stream peek-type eof-error-p eof-value recursive-p))

      ;; FIXME: Broken on ECHO-STREAM (cf internal implementation?) --

      ;; CSR, 2004-01-19

      (ansi-stream

       (let ((char (%ansi-stream-read-char stream eof-error-p eof-value t)))

          (cond ((eq char eof-value) char)
@@ -967,7 +969,7 @@ 
                 (do ((char char (%ansi-stream-read-char stream eof-error-p

                                                         eof-value t)))

                     ((or (eq char eof-value)

			  (not (sb-int:whitespace-char-p char)))

			  (not (sb-impl::whitespacep char)))

                      (unless (eq char eof-value)

                        (%ansi-stream-unread-char char stream))

                      char)))
@@ -987,7 +989,7 @@ 
	     ((eq peek-type t)

	      (do ((char (sb-gray:stream-read-char stream)

			 (sb-gray:stream-read-char stream)))

		  ((or (eq char :eof) (not (sb-int:whitespace-char-p char)))

		  ((or (eq char :eof) (not (sb-impl::whitespacep char)))

		   (cond ((eq char :eof)

			  (sb-impl::eof-or-lose stream eof-error-p eof-value))

			 (t

src/code/stream.lisp

+0 −142
Original line number Diff line number Diff line
@@ -277,86 +277,6 @@ 
	(stream-unread-char stream character)))

  nil)





;;; In the interest of ``once and only once'' this macro contains the

;;; framework necessary to implement a peek-char function, which has

;;; two special-cases (one for gray streams and one for echo streams)

;;; in addition to the normal case.

;;;

;;; All arguments are forms which will be used for a specific purpose

;;; PEEK-TYPE - the current peek-type as defined by ANSI CL

;;; EOF-VALUE - the eof-value argument to peek-char

;;; CHAR-VAR - the variable which will be used to store the current character

;;; READ-FORM - the form which will be used to read a character

;;; UNREAD-FORM - ditto for unread-char

;;; SKIPPED-CHAR-FORM - the form to execute when skipping a character

;;; EOF-DETECTED-FORM - the form to execute when EOF has been detected

;;;                     (this will default to CHAR-VAR)

(defmacro generalized-peeking-mechanism (peek-type eof-value char-var read-form unread-form &optional (skipped-char-form nil) (eof-detected-form nil))

  `(let ((,char-var ,read-form))

    (cond ((eql ,char-var ,eof-value) 

	   ,(if eof-detected-form

		eof-detected-form

		char-var))

	  ((characterp ,peek-type)

	   (do ((,char-var ,char-var ,read-form))

	       ((or (eql ,char-var ,eof-value) 

		    (char= ,char-var ,peek-type))

		(cond ((eql ,char-var ,eof-value)

		       ,(if eof-detected-form

			    eof-detected-form

			    char-var))

		      (t ,unread-form

			 ,char-var)))

	     ,skipped-char-form))

	  ((eql ,peek-type t)

	   (do ((,char-var ,char-var ,read-form))

	       ((or (eql ,char-var ,eof-value)

		    (not (whitespace-char-p ,char-var)))

		(cond ((eql ,char-var ,eof-value)

		       ,(if eof-detected-form

			    eof-detected-form

			    char-var))

		      (t ,unread-form

			 ,char-var)))

	     ,skipped-char-form))

	  ((null ,peek-type)

	   ,unread-form

	   ,char-var)

	  (t

	   (bug "Impossible case reached in PEEK-CHAR")))))



(defun peek-char (&optional (peek-type nil)

			    (stream *standard-input*)

			    (eof-error-p t)

			    eof-value

			    recursive-p)

  (declare (ignore recursive-p))

  (the (or character boolean) peek-type)

  (let ((stream (in-synonym-of stream)))

    (cond ((typep stream 'echo-stream)

	   (echo-misc stream

		      :peek-char

		      peek-type

		      (list eof-error-p eof-value)))

	  ((ansi-stream-p stream)

	   (generalized-peeking-mechanism

	    peek-type eof-value char

	    (read-char stream eof-error-p eof-value)

	    (unread-char char stream)))

	  (t

	   ;; by elimination, must be Gray streams FUNDAMENTAL-STREAM

	   (generalized-peeking-mechanism

	    peek-type :eof char

	    (if (null peek-type)

		(stream-peek-char stream)

		(stream-read-char stream))

	    (if (null peek-type)

		()

		(stream-unread-char stream char))

	    ()

	    (eof-or-lose stream eof-error-p eof-value))))))



(defun listen (&optional (stream *standard-input*))

  (let ((stream (in-synonym-of stream)))

    (if (ansi-stream-p stream)
@@ -1005,68 +925,6 @@ 
		      result)))))

  (in-fun echo-in read-char write-char eof-error-p eof-value)

  (in-fun echo-bin read-byte write-byte eof-error-p eof-value))



(defun echo-misc (stream operation &optional arg1 arg2)

  (let* ((in (two-way-stream-input-stream stream))

	 (out (two-way-stream-output-stream stream)))

    (case operation

      (:listen

       (or (not (null (echo-stream-unread-stuff stream)))

	   (if (ansi-stream-p in)

	       (or (/= (the fixnum (ansi-stream-in-index in))

		       +ansi-stream-in-buffer-length+)

		   (funcall (ansi-stream-misc in) in :listen))

	       (stream-misc-dispatch in :listen))))

      (:unread (push arg1 (echo-stream-unread-stuff stream)))

      (:element-type

       (let ((in-type (stream-element-type in))

	     (out-type (stream-element-type out)))

	 (if (equal in-type out-type)

	     in-type `(and ,in-type ,out-type))))

      (:close

       (set-closed-flame stream))

      (:peek-char

       ;; For the special case of peeking into an echo-stream

       ;; arg1 is PEEK-TYPE, arg2 is (EOF-ERROR-P EOF-VALUE)

       ;; returns peeked-char, eof-value, or errors end-of-file

       ;;

       ;; Note: This code could be moved into PEEK-CHAR if desired.

       ;; I am unsure whether this belongs with echo-streams because it is

       ;; echo-stream specific, or PEEK-CHAR because it is peeking code.

       ;; -- mrd 2002-11-18

       ;;

       ;; UNREAD-CHAR-P indicates whether the current character was one

       ;; that was previously unread.  In that case, we need to ensure that

       ;; the semantics for UNREAD-CHAR are held; the character should

       ;; not be echoed again.

       (let ((unread-char-p nil))

	 (flet ((outfn (c)

		  (unless unread-char-p

		    (if (ansi-stream-p out)

			(funcall (ansi-stream-out out) out c)

			;; gray-stream

			(stream-write-char out c))))

		(infn ()

		  ;; Obtain input from unread buffer or input stream,

		  ;; and set the flag appropriately.

		  (cond ((not (null (echo-stream-unread-stuff stream)))

			 (setf unread-char-p t)

			 (pop (echo-stream-unread-stuff stream)))

			(t

			 (setf unread-char-p nil)

			 (read-char in (first arg2) (second arg2))))))

	   (generalized-peeking-mechanism

	    arg1 (second arg2) char

	    (infn)

	    (unread-char char in)

	    (outfn char)))))

      (t

       (or (if (ansi-stream-p in)

	       (funcall (ansi-stream-misc in) in operation arg1 arg2)

	       (stream-misc-dispatch in operation arg1 arg2))

	   (if (ansi-stream-p out)

	       (funcall (ansi-stream-misc out) out operation arg1 arg2)

	       (stream-misc-dispatch out operation arg1 arg2)))))))



;;;; base STRING-STREAM stuff