From 510a9c48b7a80bf89ee54bdbd92519e76e8e178d Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Mon, 28 Jan 2002 01:25:20 +0000 Subject: [PATCH] 0.7.1.1: merged APD patch for bug 112 (sbcl-devel 2002-01-27) removed 56 from BUGS, since (COMPILE 'FOO) is a no-op now that the interpreters are gone --- BUGS | 31 ------------------------------- src/compiler/ir1-translators.lisp | 21 +++++++++++---------- src/compiler/ir1tran.lisp | 27 +++++++++++++-------------- tests/compiler.pure.lisp | 29 +++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 54 insertions(+), 56 deletions(-) diff --git a/BUGS b/BUGS index 14bfd66..e70a656 100644 --- a/BUGS +++ b/BUGS @@ -365,13 +365,6 @@ WORKAROUND: The implementation of #'+ returns its single argument without type checking, e.g. (+ "illegal") => "illegal". -56: - Attempting to use COMPILE on something defined by DEFMACRO fails: - (DEFMACRO FOO (X) (CONS X X)) - (COMPILE 'FOO) -Error in function C::GET-LAMBDA-TO-COMPILE: - # was defined in a non-null environment. - 58: (SUBTYPEP '(AND ZILCH INTEGER) 'ZILCH) => NIL, NIL Note: I looked into fixing this in 0.6.11.15, but gave up. The @@ -805,30 +798,6 @@ Error in function C::GET-LAMBDA-TO-COMPILE: type declarations are supposed to be treated as assertions unless SAFETY 0, so we should be getting a TYPE-ERROR. -112: - reported by Martin Atzmueller 2001-06-25; taken from CMU CL bugs - collection; apparently originally reported by Bruno Haible - (in-package :cl-user) - ;;; From: Bruno Haible - ;;; Subject: scope of SPECIAL declarations - ;;; It seems CMUCL has a bug relating to the scope of SPECIAL - ;;; declarations. I observe this with "CMU Common Lisp 18a x86-linux - ;;; 1.4.0 cvs". - (let ((x 0)) - (declare (special x)) - (let ((x 1)) - (let ((y x)) - (declare (special x)) y))) - ;;; Gives: 0 (this should return 1 according to CLHS) - (let ((x 0)) - (declare (special x)) - (let ((x 1)) - (let ((y x) (x 5)) - (declare (special x)) y))) - ;;; Gives: 1 (correct). - The reported results match what we get from the interpreter - in sbcl-0.6.12.42. - 113: reported by Martin Atzmueller 2001-06-25; originally from CMU CL bugs collection: diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index e809bb3..c749de9 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -509,14 +509,14 @@ ;;;; any pervasive declarations also affect the evaluation of the ;;;; arguments.) -;;; Given a list of binding specifiers in the style of Let, return: +;;; Given a list of binding specifiers in the style of LET, return: ;;; 1. The list of var structures for the variables bound. ;;; 2. The initial value form for each variable. ;;; ;;; The variable names are checked for legality and globally special ;;; variables are marked as such. Context is the name of the form, for ;;; error reporting purposes. -(declaim (ftype (function (list symbol) (values list list list)) +(declaim (ftype (function (list symbol) (values list list)) extract-let-vars)) (defun extract-let-vars (bindings context) (collect ((vars) @@ -531,7 +531,7 @@ (cond ((atom spec) (let ((var (get-var spec))) (vars var) - (names (cons spec var)) + (names spec) (vals nil))) (t (unless (proper-list-of-length-p spec 1 2) @@ -544,7 +544,7 @@ (names name) (vals (second spec))))))) - (values (vars) (vals) (names)))) + (values (vars) (vals)))) (def-ir1-translator let ((bindings &body body) start cont) @@ -555,12 +555,13 @@ evaluated." (multiple-value-bind (forms decls) (sb!sys:parse-body body nil) (multiple-value-bind (vars values) (extract-let-vars bindings 'let) - (let* ((*lexenv* (process-decls decls vars nil cont)) - (fun-cont (make-continuation)) - (fun (ir1-convert-lambda-body - forms vars :debug-name (debug-namify "LET ~S" bindings)))) - (reference-leaf start fun-cont fun) - (ir1-convert-combination-args fun-cont cont values))))) + (let ((fun-cont (make-continuation))) + (let* ((*lexenv* (process-decls decls vars nil cont)) + (fun (ir1-convert-lambda-body + forms vars + :debug-name (debug-namify "LET ~S" bindings)))) + (reference-leaf start fun-cont fun)) + (ir1-convert-combination-args fun-cont cont values))))) (def-ir1-translator let* ((bindings &body body) start cont) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 6d07722..559df42 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -712,9 +712,9 @@ ;;;; converting combinations -;;; Convert a function call where the function (i.e. the FUN argument) -;;; is a LEAF. We return the COMBINATION node so that the caller can -;;; poke at it if it wants to. +;;; Convert a function call where the function FUN is a LEAF. FORM is +;;; the source for the call. We return the COMBINATION node so that +;;; the caller can poke at it if it wants to. (declaim (ftype (function (continuation continuation list leaf) combination) ir1-convert-combination)) (defun ir1-convert-combination (start cont form fun) @@ -722,11 +722,10 @@ (reference-leaf start fun-cont fun) (ir1-convert-combination-args fun-cont cont (cdr form)))) -;;; Convert the arguments to a call and make the COMBINATION node. -;;; FUN-CONT is the continuation which yields the function to call. -;;; FORM is the source for the call. ARGS is the list of arguments for -;;; the call, which defaults to the cdr of source. We return the -;;; COMBINATION node. +;;; Convert the arguments to a call and make the COMBINATION +;;; node. FUN-CONT is the continuation which yields the function to +;;; call. ARGS is the list of arguments for the call, which defaults +;;; to the cdr of source. We return the COMBINATION node. (defun ir1-convert-combination-args (fun-cont cont args) (declare (type continuation fun-cont cont) (list args)) (let ((node (make-combination fun-cont))) @@ -1126,22 +1125,22 @@ ;;;; function representation" before you seriously mess with this ;;;; stuff. -;;; Verify that a thing is a legal name for a variable and return a -;;; Var structure for it, filling in info if it is globally special. -;;; If it is losing, we punt with a Compiler-Error. Names-So-Far is an -;;; alist of names which have previously been bound. If the name is in +;;; Verify that the NAME is a legal name for a variable and return a +;;; VAR structure for it, filling in info if it is globally special. +;;; If it is losing, we punt with a COMPILER-ERROR. NAMES-SO-FAR is a +;;; list of names which have previously been bound. If the NAME is in ;;; this list, then we error out. (declaim (ftype (function (t list) lambda-var) varify-lambda-arg)) (defun varify-lambda-arg (name names-so-far) (declare (inline member)) (unless (symbolp name) - (compiler-error "The lambda-variable ~S is not a symbol." name)) + (compiler-error "The lambda variable ~S is not a symbol." name)) (when (member name names-so-far :test #'eq) (compiler-error "The variable ~S occurs more than once in the lambda-list." name)) (let ((kind (info :variable :kind name))) (when (or (keywordp name) (eq kind :constant)) - (compiler-error "The name of the lambda-variable ~S is a constant." + (compiler-error "The name of the lambda variable ~S is already in use to name a constant." name)) (cond ((eq kind :special) (let ((specvar (find-free-var name))) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 1fa6e25..41baa31 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -56,3 +56,32 @@ (frob (mrstk x))) nil)))) 13) + +;;; bug 112, reported by Martin Atzmueller 2001-06-25 (originally +;;; from Bruno Haible in CMU CL bugs collection), fixed by +;;; Alexey Dejneka 2002-01-27 +(assert (= 1 ; (used to give 0 under bug 112) + (let ((x 0)) + (declare (special x)) + (let ((x 1)) + (let ((y x)) + (declare (special x)) y))))) +(assert (= 1 ; (used to give 1 even under bug 112, still works after fix) + (let ((x 0)) + (declare (special x)) + (let ((x 1)) + (let ((y x) (x 5)) + (declare (special x)) y))))) + +;;; another LET-related bug fixed by Alexey Dejneka at the same +;;; time as bug 112 +(multiple-value-bind (value error) + (ignore-errors + ;; should complain about duplicate variable names in LET binding + (compile nil + '(lambda () + (let (x + (x 1)) + (list x))))) + (assert (null value)) + (assert (typep error 'error))) diff --git a/version.lisp-expr b/version.lisp-expr index 25b8f9c..1ead54c 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.1" +"0.7.1.1" -- 1.7.10.4