0.pre7.100:
authorWilliam Harold Newman <william.newman@airmail.net>
Thu, 27 Dec 2001 17:17:53 +0000 (17:17 +0000)
committerWilliam Harold Newman <william.newman@airmail.net>
Thu, 27 Dec 2001 17:17:53 +0000 (17:17 +0000)
deleted the rest of construct.lisp
merged APD sbcl-devel 2001-12-21 partial fix and testcases
for bug 134 (double backquotes)

CREDITS
NEWS
src/code/backq.lisp
src/cold/warm.lisp
src/pcl/construct.lisp [deleted file]
src/pcl/print-object.lisp
tests/backq.impure.lisp [new file with mode: 0644]
version.lisp-expr

diff --git a/CREDITS b/CREDITS
index 51039b7..61c2aa4 100644 (file)
--- 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 (file)
--- 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
index acc7839..4c13b43 100644 (file)
@@ -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)    | <hair>    a    | <hair>    a
 
 (/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)))
               (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))
               ((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)
        ((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))
index 680f57a..8199d50 100644 (file)
                "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 (file)
index e805749..0000000
+++ /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")
-\f
-;;; 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)))
-\f
-;;;; 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.
-\f
-;;;; 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))
index b31d7c8..6a91b50 100644 (file)
        (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 (file)
index 0000000..c9628a9
--- /dev/null
@@ -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)
index 86085c6..f6b1197 100644 (file)
@@ -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"