From f4f423b699b25a78e70fb990ca3a434f3e2cbba2 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Thu, 27 Dec 2001 17:17:53 +0000 Subject: [PATCH] 0.pre7.100: deleted the rest of construct.lisp merged APD sbcl-devel 2001-12-21 partial fix and testcases for bug 134 (double backquotes) --- CREDITS | 17 ++++++- NEWS | 1 + src/code/backq.lisp | 40 +++++++++++---- src/cold/warm.lisp | 1 - src/pcl/construct.lisp | 124 --------------------------------------------- src/pcl/print-object.lisp | 6 --- tests/backq.impure.lisp | 59 +++++++++++++++++++++ version.lisp-expr | 2 +- 8 files changed, 106 insertions(+), 144 deletions(-) delete mode 100644 src/pcl/construct.lisp create mode 100644 tests/backq.impure.lisp diff --git a/CREDITS b/CREDITS index 51039b7..61c2aa4 100644 --- a/CREDITS +++ b/CREDITS @@ -523,7 +523,7 @@ Douglas Crosher: many patches which were directly applicable to SBCL. Notable examples include fixes for various compiler bugs, and a generalization of the type system's handling of the CONS type to allow ANSI-style - (CONS FOO BAR) types. + (CONS FOO BAR) types. Alexey Dejneka: He has fixed many bugs in SBCL. There's no single summary theme, but @@ -532,6 +532,9 @@ Alexey Dejneka: public-spiritedness, fixing bugs as they show up in sbcl-devel or as archived in the BUGS file. +Nathan Froyd: + He has reported bugs and ported fixes from CMU CL. + Robert MacLachlan: He has continued to answer questions about, and contribute fixes to, the CMU CL project. Some of these fixes, especially for compiler @@ -567,3 +570,15 @@ Raymond Wiker: CMU CL support for FreeBSD and updating it for the changes made from FreeBSD version 3 to FreeBSD version 4. He also ported the CMU CL extension RUN-PROGRAM, and related code, to SBCL. + + +INITIALS GLOSSARY (helpful when reading comments, commit notes, etc.) + +MNA Martin Atzmueller +DB Daniel Barlow +DTC Douglas Crosher +APD Alexey Dejneka +NJF Nathan Froyd +RAM Robert MacLachlan +WHN William Newman +PVE Peter Van Eynde diff --git a/NEWS b/NEWS index 7ecaf9e..7fc8e2a 100644 --- a/NEWS +++ b/NEWS @@ -899,6 +899,7 @@ changes in sbcl-0.7.0 relative to sbcl-0.6.13: ** bug in the optimization of ARRAY-ELEMENT-TYPE ** argument ordering in FIND with :TEST option ** mishandled package designator argument in APROPOS-LIST + ** various problems in the backquote readmacro He also pointed out some bogus old entries in BUGS, and fixed a number of bugs which came into existence in the pre7 branch (internal to the CVS repository), so that they never showed diff --git a/src/code/backq.lisp b/src/code/backq.lisp index acc7839..4c13b43 100644 --- a/src/code/backq.lisp +++ b/src/code/backq.lisp @@ -28,7 +28,7 @@ ;;; ([a] means that a should be converted according to the previous table) ;;; ;;; \ car || otherwise | QUOTE or | |`,@| | |`,.| -;;;cdr \ || | T or NIL | | +;;;cdr \ || | T or NIL | | ;;;================================================================================ ;;; |`,| || LIST* ([a] [d]) | LIST* ([a] [d]) | APPEND (a [d]) | NCONC (a [d]) ;;; NIL || LIST ([a]) | QUOTE (a) | a | a @@ -82,15 +82,22 @@ (/show0 "backq.lisp 83") +;;; +(defun expandable-backq-expression-p (object) + (and (consp object) + (let ((flag (car object))) + (or (eq flag *bq-at-flag*) + (eq flag *bq-dot-flag*))))) + ;;; This does the expansion from table 2. (defun backquotify (stream code) (cond ((atom code) (cond ((null code) (values nil nil)) - ((or (numberp code) - (eq code t)) + ((or (consp code) + (symbolp code)) ;; Keywords are self-evaluating. Install after packages. - (values t code)) - (t (values 'quote code)))) + (values 'quote code)) + (t (values t code)))) ((or (eq (car code) *bq-at-flag*) (eq (car code) *bq-dot-flag*)) (values (car code) (cdr code))) @@ -109,14 +116,18 @@ (cond ((eq aflag *bq-at-flag*) (if (null dflag) - (comma a) + (if (expandable-backq-expression-p a) + (values 'append (list a)) + (comma a)) (values 'append (cond ((eq dflag 'append) (cons a d )) (t (list a (backquotify-1 dflag d))))))) ((eq aflag *bq-dot-flag*) (if (null dflag) - (comma a) + (if (expandable-backq-expression-p a) + (values 'nconc (list a)) + (comma a)) (values 'nconc (cond ((eq dflag 'nconc) (cons a d)) @@ -146,8 +157,9 @@ ((or (numberp code) (eq code t)) (values t code)) (t (values *bq-comma-flag* code)))) - ((eq (car code) 'quote) - (values (car code) (cadr code))) + ((and (eq (car code) 'quote) + (not (expandable-backq-expression-p (cadr code)))) + (values (car code) (cadr code))) ((member (car code) '(append list list* nconc)) (values (car code) (cdr code))) ((eq (car code) 'cons) @@ -164,9 +176,15 @@ ((eq flag 'quote) (list 'quote thing)) ((eq flag 'list*) - (cond ((null (cddr thing)) + (cond ((and (null (cddr thing)) + (not (expandable-backq-expression-p (cadr thing)))) (cons 'backq-cons thing)) - (t + ((expandable-backq-expression-p (car (last thing))) + (list 'backq-append + (cons 'backq-list (butlast thing)) + ;; Can it be optimized further? -- APD, 2001-12-21 + (car (last thing)))) + (t (cons 'backq-list* thing)))) ((eq flag 'vector) (list 'backq-vector thing)) diff --git a/src/cold/warm.lisp b/src/cold/warm.lisp index 680f57a..8199d50 100644 --- a/src/cold/warm.lisp +++ b/src/cold/warm.lisp @@ -189,7 +189,6 @@ "src/pcl/fixup" "src/pcl/defcombin" "src/pcl/ctypes" - "src/pcl/construct" "src/pcl/env" "src/pcl/documentation" "src/pcl/print-object" diff --git a/src/pcl/construct.lisp b/src/pcl/construct.lisp deleted file mode 100644 index e805749..0000000 --- a/src/pcl/construct.lisp +++ /dev/null @@ -1,124 +0,0 @@ -;;;; This file defines MAKE-INSTANCE optimization mechanisms. -;;;; -;;;; KLUDGE: I removed the old DEFCONSTRUCTOR, MAKE-CONSTRUCTOR, and -;;;; LOAD-CONSTRUCTOR families of definitions in sbcl-0.pre7.99, since -;;;; it was clear from a few minutes with egrep that they were dead -;;;; code, but I suspect more dead code remains in this file. (Maybe -;;;; it's all dead?) -- WHN 2001-12-26 - -;;;; This software is part of the SBCL system. See the README file for -;;;; more information. - -;;;; This software is derived from software originally released by Xerox -;;;; Corporation. Copyright and release statements follow. Later modifications -;;;; to the software are in the public domain and are provided with -;;;; absolutely no warranty. See the COPYING and CREDITS files for more -;;;; information. - -;;;; copyright information from original PCL sources: -;;;; -;;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. -;;;; All rights reserved. -;;;; -;;;; Use and copying of this software and preparation of derivative works based -;;;; upon this software are permitted. Any distribution of this software or -;;;; derivative works must comply with all applicable United States export -;;;; control laws. -;;;; -;;;; This software is made available AS IS, and Xerox Corporation makes no -;;;; warranty about the software, its performance or its conformity to any -;;;; specification. - -(in-package "SB-PCL") - -;;; The actual constructor objects. -(defclass constructor (funcallable-standard-object) - ((class ;The class with which this - :initarg :class ;constructor is associated. - :reader constructor-class) ;The actual class object, - ;not the class name. - - (name ;The name of this constructor. - :initform nil ;This is the symbol in whose - :initarg :name ;function cell the constructor - :reader constructor-name) ;usually sits. Of course, this - ;is optional. The old - ;DEFCONSTRUCTOR macro made - ;named constructors, but - ;it is possible to manipulate - ;anonymous constructors also. - - (supplied-initarg-names ;The names of the initargs this - :initarg :supplied-initarg-names ;constructor supplies when it - :reader ;"calls" make-instance. - constructor-supplied-initarg-names) ; - - (code-generators ;Generators for the different - :initarg :code-generators ;types of code this constructor - :reader constructor-code-generators)) ;could use. - (:metaclass funcallable-standard-class)) - -(defmethod describe-object ((constructor constructor) stream) - (format stream - "~S is a constructor for the class ~S.~%" - constructor (constructor-class constructor))) - -;;;; Here is the actual smarts for making the code generators and then -;;;; trying each generator to get constructor code. This extensible -;;;; mechanism allows new kinds of constructor code types to be added. -;;;; A programmer defining a specialization of the constructor class -;;;; can use this mechanism to define new code types. -;;;; -;;;; original PCL comment from before dead COMPUTE-CONSTRUCTOR-CODE -;;;; was deleted: -;;;; When compute-constructor-code is called, it first performs -;;;; basic checks to make sure that the basic assumptions common to -;;;; all the code types are valid. (For details see method -;;;; definition). If any of the tests fail, the fallback -;;;; constructor code type is used. If none of the tests fail, the -;;;; constructor code generators are called in order. They receive -;;;; 5 arguments: -;;;; -;;;; CLASS the class the constructor is making instances of -;;;; WRAPPER that class's wrapper -;;;; DEFAULTS the result of calling class-default-initargs on class -;;;; INITIALIZE the applicable methods on initialize-instance -;;;; SHARED the applicable methosd on shared-initialize -;;;; -;;;; The first code generator to return code is used. The code -;;;; generators are called in reverse order of definition, so forms -;;;; which define better code should appear after ones that define -;;;; less good code. The fallback code type appears first. Note that -;;;; redefining a code type does not change its position in the list. -;;;; To do that, define a new type at the end with the behavior. - -;;;; helper functions and utilities that are shared by all of the code -;;;; types - -(defvar *standard-initialize-instance-method* - (get-method #'initialize-instance - () - (list *the-class-slot-object*))) - -(defvar *standard-shared-initialize-method* - (get-method #'shared-initialize - () - (list *the-class-slot-object* *the-class-t*))) - -(defun non-pcl-initialize-instance-methods-p (methods) - (notevery #'(lambda (m) (eq m *standard-initialize-instance-method*)) - methods)) - -(defun non-pcl-shared-initialize-methods-p (methods) - (notevery #'(lambda (m) (eq m *standard-shared-initialize-method*)) - methods)) - -(defun non-pcl-or-after-initialize-instance-methods-p (methods) - (notevery #'(lambda (m) (or (eq m *standard-initialize-instance-method*) - (equal '(:after) (method-qualifiers m)))) - methods)) - -(defun non-pcl-or-after-shared-initialize-methods-p (methods) - (notevery #'(lambda (m) (or (eq m *standard-shared-initialize-method*) - (equal '(:after) (method-qualifiers m)))) - methods)) diff --git a/src/pcl/print-object.lisp b/src/pcl/print-object.lisp index b31d7c8..6a91b50 100644 --- a/src/pcl/print-object.lisp +++ b/src/pcl/print-object.lisp @@ -122,12 +122,6 @@ (list (length (generic-function-methods generic-function))) "?"))) -(defmethod print-object ((constructor constructor) stream) - (print-unreadable-object (constructor stream :type t :identity t) - (format stream - "~S" - (slot-value-or-default constructor 'name)))) - (defmethod print-object ((cache cache) stream) (print-unreadable-object (cache stream :type t :identity t) (format stream diff --git a/tests/backq.impure.lisp b/tests/backq.impure.lisp new file mode 100644 index 0000000..c9628a9 --- /dev/null +++ b/tests/backq.impure.lisp @@ -0,0 +1,59 @@ +;;;; tests of backquote readmacro + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; While most of SBCL is derived from the CMU CL system, the test +;;;; files (like this one) were written from scratch after the fork +;;;; from CMU CL. +;;;; +;;;; This software is in the public domain and is provided with +;;;; absolutely no warranty. See the COPYING and CREDITS files for +;;;; more information. + +(in-package "CL-USER") + +(defparameter *qq* '(*rr* *ss*)) +(defparameter *rr* '(3 5)) +(defparameter *ss* '(4 6)) + +(defun *rr* (x) + (reduce #'* x)) + +(defparameter *x* '(a b)) +(defparameter *y* '(c)) +(defparameter *p* '(append *x* *y*)) +(defparameter *q* '((append *x* *y*) (list 'sqrt 9))) +(defparameter *r* '(append *x* *y*)) +(defparameter *s* '((append *x* *y*))) + +(defun test-double-backquote (expression value) + (format t "~&Testing: ~A... " expression) + (assert (equal (eval (eval (read-from-string expression))) + value)) + (format t "Ok. Look at PPRINTed version: ") + (pprint (read-from-string expression))) + +(defparameter *backquote-tests* + '(("``(,,*QQ*)" . (24)) + ("``(,@,*QQ*)" . 24) + ("``(,,@*QQ*)" . ((3 5) (4 6))) + ("``(FOO ,,*P*)" . (foo (a b c))) + ("``(FOO ,,@*Q*)" . (foo (a b c) (sqrt 9))) + ("``(FOO ,',*R*)" . (foo (append *x* *y*))) + ("``(FOO ,',@*S*)" . (foo (append *x* *y*))) + ("``(FOO ,@,*P*)" . (foo a b c)) + ("``(FOO ,@',*R*)" . (foo append *x* *y*)) + ;; The following expression produces different result under LW. + ("``(FOO . ,,@*Q*)" . (foo a b c sqrt 9)) + ;; These three did not work. + ("``(FOO ,@',@*S*)" . (foo append *x* *y*)) + ("``(FOO ,@,@*Q*)" . (foo a b c sqrt 9)) + ("``(,@,@*QQ*)" . (3 5 4 6)))) + +(mapc #'(lambda (test) + (test-double-backquote (car test) (cdr test))) + *backquote-tests*) + +;;; success +(quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 86085c6..f6b1197 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.pre7.99" +"0.pre7.100" -- 1.7.10.4