From 24466b987096dd6ec63067b1531367308f199c99 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Tue, 18 Feb 2003 12:55:36 +0000 Subject: [PATCH] 0.7.12.42: A couple of minor fixes for bugs caught by Paul Dietz' test suite. ... adjust source transform for CONSTANTLY to return a side-effect-free function; ... OTHERWISE only introduces an otherwise-clause in TYPECASE if it's the last clause; ... while I'm frobbing TYPECASE, make the style-warning format string such that output is pretty. ... NEWS update --- NEWS | 7 +++++++ src/code/macros.lisp | 13 ++++++++----- src/compiler/srctran.lisp | 12 +++++++----- tests/compiler.pure.lisp | 10 ++++++++++ version.lisp-expr | 2 +- 5 files changed, 33 insertions(+), 11 deletions(-) diff --git a/NEWS b/NEWS index f3a9e43..98a1fa2 100644 --- a/NEWS +++ b/NEWS @@ -1568,6 +1568,13 @@ changes in sbcl-0.7.13 relative to sbcl-0.7.12: ** the type system is now cleverer about negations of numeric types, and consequently understands the BIGNUM and RATIO types better; + ** the type system is now cleverer about the interaction between + INTEGER and RATIO types: while bugs still remain, many more + cases are accurately computed; + ** in TYPECASE, OTHERWISE now only introduces an otherwise-clause + if it is in the last clause; + ** CONSTANTLY now correctly returns a side-effect-free function in + all cases; planned incompatible changes in 0.7.x: * (not done yet, but planned:) When the profiling interface settles diff --git a/src/code/macros.lisp b/src/code/macros.lisp index b4453d1..f14e8e2 100644 --- a/src/code/macros.lisp +++ b/src/code/macros.lisp @@ -197,16 +197,19 @@ (let ((keyform-value (gensym)) (clauses ()) (keys ())) - (dolist (case cases) + (do* ((cases cases (cdr cases)) + (case (car cases) (car cases))) + ((null cases) nil) (unless (list-of-length-at-least-p case 1) (error "~S -- bad clause in ~S" case name)) (destructuring-bind (keyoid &rest forms) case - (cond ((memq keyoid '(t otherwise)) + (cond ((and (memq keyoid '(t otherwise)) + (null (cdr cases))) (if errorp (progn - ;; FIXME: this message could probably do with - ;; some loving pretty-printer format controls. - (style-warn "Treating bare ~A in ~A as introducing a normal-clause, not an otherwise-clause" keyoid name) + (style-warn "~@" + keyoid name) (push keyoid keys) (push `((,test ,keyform-value ',keyoid) nil ,@forms) clauses)) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 0661685..d7b8385 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -29,12 +29,14 @@ (define-source-transform identity (x) `(prog1 ,x)) (define-source-transform values (x) `(prog1 ,x)) -;;; Bind the values and make a closure that returns them. +;;; Bind the value and make a closure that returns them. (define-source-transform constantly (value) - (let ((rest (gensym "CONSTANTLY-REST-"))) - `(lambda (&rest ,rest) - (declare (ignore ,rest)) - ,value))) + (let ((rest (gensym "CONSTANTLY-REST-")) + (n-value (gensym "CONSTANTLY-VALUE-"))) + `(let ((,n-value ,value)) + (lambda (&rest ,rest) + (declare (ignore ,rest)) + ,n-value)))) ;;; If the function has a known number of arguments, then return a ;;; lambda with the appropriate fixed number of args. If the diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 0d4c271..130a5af 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -311,3 +311,13 @@ (push node path)) (when (funcall equalp key (node-key node)) (return (values node path t)))))))) + +;;; CONSTANTLY should return a side-effect-free function (bug caught +;;; by Paul Dietz' test suite) +(let ((i 0)) + (let ((fn (constantly (progn (incf i) 1)))) + (assert (= i 1)) + (assert (= (funcall fn) 1)) + (assert (= i 1)) + (assert (= (funcall fn) 1)) + (assert (= i 1)))) diff --git a/version.lisp-expr b/version.lisp-expr index c9edda2..01a8835 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.7.12.41" +"0.7.12.42" -- 1.7.10.4