From: Christophe Rhodes Date: Thu, 17 Apr 2003 13:05:41 +0000 (+0000) Subject: 0.pre8.62: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=96de323a7da5d9f72473b48625dcb6d084ec0a3b;p=sbcl.git 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 --- 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 --- 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 --- 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 --- 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 --- 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"