Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!usc!sdd.hp.com!spool.mu.edu!snorkelwacker.mit.edu!bloom-beacon!eru!hagbard!sunic!mcsun!ukc!edcastle!aiai!jeff
From: jeff@aiai.ed.ac.uk (Jeff Dalton)
Newsgroups: comp.lang.lisp
Subject: Re: weird common lisp feature
Keywords: read, read-line
Message-ID: <4211@skye.ed.ac.uk>
Date: 22 Feb 91 12:32:10 GMT
References: <12413@helios.TAMU.EDU> <12414@helios.TAMU.EDU>
Reply-To: jeff@aiai.UUCP (Jeff Dalton)
Organization: AIAI, University of Edinburgh, Scotland
Lines: 65

In article <12414@helios.TAMU.EDU> e343ca@tamuts.tamu.edu (Colin Allen) writes:
>In article <12413@helios.TAMU.EDU> e343ca@tamuts.tamu.edu I asked:
>>Can anyone tell me why foo1 below appears to execute the read-line
>>before the print, but foo2 executes the print before the read?
>>
>>(defun foo1 () (print 'hello) (read-line))
>>(defun foo2 () (print 'hello) (read))
>
>I should add that I have checked this code now in Kyoto and Franz
>Allegro Common Lisp and the weird behavior occurs only in kcl.  So
>possibly this is a bug in kcl.  Anyone run into this before?

The behavior I get in KCL is that foo2 does what yuo expect but
foo1 does something like this:

   >(foo1)
   HELLO ""

   >

That is, read-line returns an empty string and I don't have to type
anything.  There is no evidence that the read-line happens before the
print, and indeed it doesn't.

What happens is that the newline after "(foo1)" is still there when
read-line is called, and since read-line takes the characters up to
the next newline and returns them as a string, you get "".

This is, in my opinion, a bug in KCL.  But it could be argued that
such behavior is allowed by CLtL.

One way to deal with the problem is to call clear-input.  Another,
less reputable, solution would be to redefine read:

(defun fix-read ()
  (unless (fboundp 'real-read)
    (setf (symbol-function 'real-read) (symbol-function 'read)
	  (symbol-function 'read) (symbol-function 'patched-read))))

(defun patched-read (&optional (stream *standard-input*)
			       (eof-error-p t) (eof-value nil)
			       (recursive-p nil))
  (let ((object (real-read stream eof-error-p eof-value recursive-p)))
    (unless recursive-p ;???
      (loop
        (let ((c (read-char-no-hang stream nil nil nil)))
	  (cond ((null c)
		 (return))
		((not (whitespace-p c))
		 (unread-char c stream)
		 (return))))))
    object))

(defun whitespace-p (c)
  (member c '(#\space #\newline #\tab #\return) :test #'char=))

(defun listen-test ()
  (loop
    (format t "test> ")
    (do ((args (list (read)) (cons (read) args)))
	((not (listen))
	 (prin1 (nreverse args))))
    (terpri)))

-- jeff