0.pre8.62:

	Merge tonyms query patch (Antonio Martinez sbcl-devel 2002-04-03)
	... keep BEEP in, since ANSI suggests it
	... also a FIXME and BUG report about NTH-VALUE's lame scaling
		properties.

diff --git a/BUGS b/BUGS
index 3f95ef7..47768d1 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -1300,6 +1300,14 @@ WORKAROUND:
   On X86 IMUL instruction with an immediate operand is printed
   incorrectly.
 
+246: "NTH-VALUE scaling problem"
+  NTH-VALUE's current implementation for constant integers scales in
+  compile-time as O(n^4), as indeed must the optional dispatch
+  mechanism on which it is implemented.  While it is unlikely to
+  matter in real user code, it's still unpleasant to observe that
+  (NTH-VALUE 1000 (VALUES-LIST (MAKE-LIST 1001))) takes several hours
+  to compile.
+
 DEFUNCT CATEGORIES OF BUGS
   IR1-#:
     These labels were used for bugs related to the old IR1 interpreter.

diff --git a/NEWS b/NEWS
index 38017d6..bb57798 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1635,8 +1635,11 @@ changes in sbcl-0.8.0 relative to sbcl-0.7.14
     sbcl --eval "(defpackage :foo)" --eval "(print 'foo::bar)" now work
     as the user might reasonably expect.)
   * minor incompatible change: *STANDARD-INPUT* is now only an
-    INPUT-STREAM, not a BIDIRECTIONAL-STREAM. (thanks to Antonio 
+    INPUT-STREAM, not a BIDIRECTIONAL-STREAM.  (thanks to Antonio 
     Martinez)
+  * minor incompatible change: Y-OR-N-P is now character-oriented, not
+    line oriented.  Also, YES-OR-NO-P now works without errors.
+    (thanks to Antonio Martinez)
   * known functions, which cannot be open coded by backend, are
     considered to be able to check types of their arguments.
     (reported by Nathan J. Froyd)

diff --git a/src/code/macros.lisp b/src/code/macros.lisp
index f14e8e2..51214a4 100644 (file)
--- a/src/code/macros.lisp
+++ b/src/code/macros.lisp
@@ -384,6 +384,13 @@
   #!+sb-doc
   "Evaluate FORM and return the Nth value (zero based). This involves no
   consing when N is a trivial constant integer."
+  ;; FIXME: The above is true, if slightly misleading.  The
+  ;; MULTIPLE-VALUE-BIND idiom [ as opposed to MULTIPLE-VALUE-CALL
+  ;; (LAMBDA (&REST VALUES) (NTH N VALUES)) ] does indeed not cons at
+  ;; runtime.  However, for large N (say N = 200), COMPILE on such a
+  ;; form will take longer than can be described as adequate, as the
+  ;; optional dispatch mechanism for the M-V-B gets increasingly
+  ;; hairy.
   (if (integerp n)
       (let ((dummy-list nil)
            (keeper (gensym "KEEPER-")))

diff --git a/src/code/query.lisp b/src/code/query.lisp
index c3836e5..4cbe3f8 100644 (file)
--- a/src/code/query.lisp
+++ b/src/code/query.lisp
@@ -11,55 +11,53 @@
 
 (in-package "SB!IMPL")
 
-(defun query-readline ()
+(defun query-read-char ()
+  (clear-input *query-io*)
+  (prog1 (read-char *query-io*)
+    (clear-input *query-io*)))
+
+(defun query-read-line ()
   (force-output *query-io*)
-  (string-trim "       " (read-line *query-io*)))
+  (string-trim #.(concatenate 'string '(#\Space #\Tab))
+              (read-line *query-io*)))
+
+(defun maybe-print-query (hint format-string &rest format-args)
+  (fresh-line *query-io*)
+  (when format-string
+    (apply #'format *query-io* format-string format-args)
+    (write-char #\Space *query-io*))
+  (format *query-io* "~A " hint)
+  (finish-output *query-io*))
 
-;;; FIXME: The ANSI documentation for these says that they
-;;; prompt with strings like "(Y or N)" or "(Yes or No)", but
-;;; these implementations don't.
+(defun clarify-legal-query-input (yes no)
+  (format *query-io* "~&Please type \"~A\" for yes or \"~A\" for no.~%"
+         yes no))
 
 (defun y-or-n-p (&optional format-string &rest arguments)
   #!+sb-doc
-  "Y-OR-N-P prints the message, if any, and reads characters from *QUERY-IO*
-   until the user enters y or Y as an affirmative, or either n or N as a
-   negative answer. It ignores preceding whitespace and asks again if you
-   enter any other characters."
-  (when format-string
-    (fresh-line *query-io*)
-    (apply #'format *query-io* format-string arguments))
-  (loop
-    (let* ((line (query-readline))
-          (ans (if (string= line "")
-                   #\? ;Force CASE below to issue instruction.
-                   (schar line 0))))
-      (unless (sb!impl::whitespacep ans)
-       (case ans
-         ((#\y #\Y) (return t))
-         ((#\n #\N) (return nil))
-         (t
-          (write-line "Please type \"y\" for yes or \"n\" for no. "
-                      *query-io*)
-          (when format-string
-            (apply #'format *query-io* format-string arguments))
-          (force-output *query-io*)))))))
-
+  "Y-OR-N-P prints the message, if any, and reads characters from
+   *QUERY-IO* until the user enters y or Y as an affirmative, or either
+   n or N as a negative answer. It asks again if you enter any other
+   characters."
+  (flet ((print-query ()
+          (maybe-print-query "(y or n)" format-string arguments)))
+    (loop (print-query)
+         (case (query-read-char)
+           ((#\y #\Y) (return t))
+           ((#\n #\N) (return nil))
+           (t (clarify-legal-query-input "y" "n"))))))
+     
 (defun yes-or-no-p (&optional format-string &rest arguments)
   #!+sb-doc
   "YES-OR-NO-P is similar to Y-OR-N-P, except that it clears the
    input buffer, beeps, and uses READ-LINE to get the strings
    YES or NO."
-  (clear-input *query-io*)
-  (beep)
-  (when format-string
-    (fresh-line *query-io*)
-    (apply #'format *query-io* format-string arguments))
-  (do ((ans (query-readline) (query-readline)))
-      (())
-    (cond ((string-equal ans "YES") (return t))
-         ((string-equal ans "NO") (return nil))
-         (t
-          (write-line "Please type \"yes\" for yes or \"no\" for no. "
-                      *query-io*)
-          (when format-string
-            (apply #'format *query-io* format-string arguments))))))
+  (flet ((print-query ()
+          (maybe-print-query "(yes or no)" format-string arguments)))
+    (beep *query-io*)
+    (loop (print-query)
+         (let ((input (query-read-line)))
+           (cond
+             ((string-equal input "yes") (return t))
+             ((string-equal input "no") (return nil))
+             (t (clarify-legal-query-input "yes" "no")))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index e2de068..bc6c594 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.pre8.61"
+"0.pre8.62"