Changeset 14369


Ignore:
Timestamp:
02/13/13 19:01:20 (8 years ago)
Author:
Mark Evenson
Message:

Implementation of autoloader for SETF generalized references.

Fixes #296. Fixes #266. Fixes #228.

For forms which set the symbol properties of SETF-EXPANDER or
SETF-FUNCTION to function definitions, places stub of type
AutoloadGeneralizedReference? to be resolved when first invoked.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
1 added
7 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/Autoload.java

    r14368 r14369  
    4444    protected final String className;
    4545
    46     private final Symbol symbol;
     46    protected final Symbol symbol;
    4747
    4848    protected Autoload(Symbol symbol)
     
    263263        StringBuilder sb = new StringBuilder();
    264264        sb.append(symbol.princToString());
    265         sb.append(" \"");
     265        sb.append(" stub to be autoloaded from \"");
    266266        if (className != null) {
    267267            int index = className.lastIndexOf('.');
     
    273273        } else
    274274            sb.append(getFileName());
     275        sb.append("\"");
    275276        return unreadableString(sb.toString());
    276277    }
     
    278279    public static final Primitive AUTOLOAD = new pf_autoload();
    279280    @DocString(name="autoload",
    280                args="symbol-or-symbols filename",
     281               args="symbol-or-symbols &optional filename",
    281282               doc="Setup the autoload for SYMBOL-OR-SYMBOLS optionally corresponding to FILENAME.")
    282283    private static final class pf_autoload extends Primitive {
     
    732733        autoload(PACKAGE_JAVA, "%jget-property-value", "JavaBeans", false);
    733734        autoload(PACKAGE_JAVA, "%jset-property-value", "JavaBeans", false);
     735
     736        autoload(PACKAGE_EXT, "autoload-setf-expander", "AutoloadGeneralizedReference", true);
     737        autoload(PACKAGE_EXT, "autoload-setf-function", "AutoloadGeneralizedReference", true);
     738        autoload(PACKAGE_EXT, "autoload-ref-p", "AutoloadGeneralizedReference", true);
    734739    }
    735740}
  • trunk/abcl/src/org/armedbear/lisp/Lisp.java

    r14256 r14369  
    27702770    loadClass("org.armedbear.lisp.Autoload");
    27712771    loadClass("org.armedbear.lisp.AutoloadMacro");
     2772    loadClass("org.armedbear.lisp.AutoloadGeneralizedReference");
    27722773    loadClass("org.armedbear.lisp.cxr");
    27732774    loadClass("org.armedbear.lisp.Do");
  • trunk/abcl/src/org/armedbear/lisp/Primitives.java

    r14254 r14369  
    35753575
    35763576    // ### put symbol indicator value => value
    3577     private static final Primitive PUT = new pf_put();
     3577    public static final Primitive PUT = new pf_put();
    35783578    private static final class pf_put extends Primitive {
    35793579        pf_put() {
  • trunk/abcl/src/org/armedbear/lisp/asdf.lisp

    r14362 r14369  
    5050(in-package :cl-user)
    5151
    52 #+abcl
    53 (eval-when (:load-toplevel :compile-toplevel :execute)
    54   (documentation 'car 'function)) ;; workaround (SETF DOCUMENTATION) autoloader bug
     52;; #+abcl
     53;; (eval-when (:load-toplevel :compile-toplevel :execute)
     54;;   (documentation 'car 'function)) ;; workaround (SETF DOCUMENTATION) autoloader bug
    5555
    5656#+cmu
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r14347 r14369  
    17811781                          ;; a good option either: we've seen that lead to
    17821782                          ;; recursive loading of the same file
    1783                           (not (autoloadp function-name))))
     1783                          (and (not (autoloadp function-name))
     1784                               (and (consp function-name)
     1785                                    (eq 'setf (first function-name))
     1786                                    (not (autoload-ref-p (second function-name)))))))
    17841787            (error 'program-error
    17851788                   :format-control "~A already names an ordinary function, macro, or special operator."
     
    44794482    (setf generic-function-class (find-class generic-function-class)))
    44804483  (when (and (null *clos-booting*) (fboundp function-name))
    4481     (if (autoloadp function-name)
     4484    (if (or (autoloadp function-name)
     4485            (and (consp function-name)
     4486                 (eq 'setf (first function-name))
     4487                 (autoload-ref-p (second function-name))))
    44824488        (fmakunbound function-name)
    44834489        (error 'program-error
  • trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

    r14260 r14369  
    4747(defvar *toplevel-macros*)
    4848(defvar *toplevel-exports*)
     49(defvar *toplevel-setf-expanders*)
     50(defvar *toplevel-setf-functions*)
    4951
    5052
     
    424426  (note-name-defined (second form))
    425427  (push (second form) *toplevel-functions*)
     428  (when (and (consp (second form))
     429             (eq 'setf (first (second form))))
     430    (push (second (second form))
     431          *toplevel-setf-functions*))
    426432  (let ((*compile-print* nil))
    427433    (process-toplevel-form (macroexpand-1 form *compile-file-environment*)
     
    551557    (note-name-defined name)
    552558    (push name *toplevel-functions*)
     559    (when (and (consp name)
     560               (eq 'setf (first name)))
     561      (push (second name) *toplevel-setf-functions*))
    553562    ;; If NAME is not fbound, provide a dummy definition so that
    554563    ;; getSymbolFunctionOrDie() will succeed when we try to verify that
     
    606615      (when (and (symbolp operator)
    607616                 (macro-function operator *compile-file-environment*))
     617        (when (eq operator 'define-setf-expander) ;; ??? what if the symbol is package qualified?
     618          (push (second form) *toplevel-setf-expanders*))
     619        (when (and (eq operator 'defsetf) ;; ??? what if the symbol is package qualified?
     620                   (consp (third form))) ;; long form of DEFSETF
     621          (push (second form) *toplevel-setf-expanders*))
    608622        (note-toplevel-form form)
    609623        ;; Note that we want MACROEXPAND-1 and not MACROEXPAND here, in
     
    614628                                 stream compile-time-too))
    615629        (return-from process-toplevel-form))
    616 
    617630      (cond
    618631        ((and (symbolp operator)
     
    718731(defun compile-from-stream (in output-file temp-file temp-file2
    719732                            extract-toplevel-funcs-and-macros
    720                             functions-file macros-file exports-file)
     733                            functions-file macros-file exports-file
     734                            setf-functions-file setf-expanders-file)
    721735  (let* ((*compile-file-pathname* (make-pathname :defaults (pathname in)
    722736                                                 :version nil))
     
    778792                                     (symbol-package func-name)
    779793                                     T))
    780                                (remove-duplicates *toplevel-functions*)))
     794                               (remove-duplicates
     795                            *toplevel-functions*)))
    781796          (when *toplevel-functions*
    782797            (with-open-file (f-out functions-file
     
    812827                                   :if-exists :supersede)
    813828              (let ((*package* (find-package :keyword)))
    814                 (write *toplevel-exports* :stream e-out)))))
     829                (write *toplevel-exports* :stream e-out))))
     830          (setf *toplevel-setf-functions*
     831                (remove-if-not (lambda (sym)
     832                                 (if (symbolp sym)
     833                                     (symbol-package sym)
     834                                     T))
     835                               (remove-duplicates *toplevel-setf-functions*)))
     836          (when *toplevel-setf-functions*
     837            (with-open-file (e-out setf-functions-file
     838                                   :direction :output
     839                                   :if-does-not-exist :create
     840                                   :if-exists :supersede)
     841              (let ((*package* (find-package :keyword)))
     842                (write *toplevel-setf-functions* :stream e-out))))
     843          (setf *toplevel-setf-expanders*
     844                (remove-if-not (lambda (sym)
     845                                 (if (symbolp sym)
     846                                     (symbol-package sym)
     847                                     T))
     848                               (remove-duplicates *toplevel-setf-expanders*)))
     849          (when *toplevel-setf-expanders*
     850            (with-open-file (e-out setf-expanders-file
     851                                   :direction :output
     852                                   :if-does-not-exist :create
     853                                   :if-exists :supersede)
     854              (let ((*package* (find-package :keyword)))
     855                (write *toplevel-setf-expanders* :stream e-out)))))
    815856        (with-open-file (in temp-file :direction :input :external-format *fasl-external-format*)
    816857          (with-open-file (out temp-file2 :direction :output
     
    901942           (macros-file (pathname-with-type output-file "macs"))
    902943           (exports-file (pathname-with-type output-file "exps"))
     944           (setf-functions-file (pathname-with-type output-file "setf-functions"))
     945           (setf-expanders-file (pathname-with-type output-file "setf-expanders"))
    903946           *toplevel-functions*
    904947           *toplevel-macros*
    905            *toplevel-exports*)
     948           *toplevel-exports*
     949           *toplevel-setf-functions*
     950           *toplevel-setf-expanders*)
    906951      (with-open-file (in input-file :direction :input :external-format external-format)
    907952        (multiple-value-bind (output-file-truename warnings-p failure-p)
    908953            (compile-from-stream in output-file temp-file temp-file2
    909954                                 extract-toplevel-funcs-and-macros
    910                                  functions-file macros-file exports-file)
     955                                 functions-file macros-file exports-file
     956                                 setf-functions-file setf-expanders-file)
    911957          (values (truename output-file) warnings-p failure-p))))))
    912958
  • trunk/abcl/src/org/armedbear/lisp/compile-system.lisp

    r14346 r14369  
    149149                      (null (cdr x)))
    150150                    (mapcar (lambda (x)
    151                               (cons (car x)
     151                               (cons (car x)
    152152                                    (remove-if-not (lambda (x)
    153                                                      ;;; ### TODO: Support SETF functions
    154                                                      (and (symbolp x)
    155                                                           (eq (symbol-package x)
    156                                                               filter-package)))
     153                                                      (and (symbolp x)
     154                                                           (eq (symbol-package x)
     155                                                               filter-package)))
    157156                                                   (cdr x))))
    158157                            filesets-symbols))))
     
    175174
    176175(defun generate-autoloads (symbol-files-pathspec)
    177   (flet ((filter-combos (combos)
    178            (remove-multi-combo-symbols
    179             (remove-if (lambda (x)
    180                          ;; exclude the symbols from the files
    181                          ;; below: putting autoloaders on some of
    182                          ;; the symbols conflicts with the bootstrapping
    183                          ;; Primitives which have been defined Java-side
    184                          (member x '( ;; function definitions to be excluded
    185                                      "fdefinition" "early-defuns"
    186                                      "require" "signal" "restart"
    187 
    188                                      ;; extensible sequences override
    189                                      ;; lots of default functions;
    190                                      ;; java-collections implements
    191                                      ;; extensible sequences
    192                                      "extensible-sequences-base"
    193                                      "extensible-sequences" "java-collections"
    194 
    195                                      ;; macro definitions to be excluded
    196                                      "macros" ;; "backquote"
    197                                      "precompiler")
    198                                  :test #'string=))
    199                        combos
    200                        :key #'first)))
    201          (symbols-pathspec (filespec)
    202            (merge-pathnames filespec symbol-files-pathspec)))
     176  (labels ((filter-combos (combos)
     177             (remove-multi-combo-symbols
     178              (remove-if (lambda (x)
     179                           ;; exclude the symbols from the files
     180                           ;; below: putting autoloaders on some of
     181                           ;; the symbols conflicts with the bootstrapping
     182                           ;; Primitives which have been defined Java-side
     183                           (member x '( ;; function definitions to be excluded
     184                                       "fdefinition" "early-defuns"
     185                                       "require" "signal" "restart"
     186
     187                                       ;; extensible sequences override
     188                                       ;; lots of default functions;
     189                                       ;; java-collections implements
     190                                       ;; extensible sequences
     191                                       "extensible-sequences-base"
     192                                       "extensible-sequences" "java-collections"
     193
     194                                       ;; macro definitions to be excluded
     195                                       "macros" ;; "backquote"
     196                                       "precompiler")
     197                                   :test #'string=))
     198                         combos
     199                         :key #'first)))
     200           (filter-setf-combos (combos)
     201             (filter-combos
     202              (remove-multi-combo-symbols
     203               (remove-if (lambda (x) (member x '("clos") :test #'string=)) combos :key #'first))))
     204           (symbols-pathspec (filespec)
     205             (merge-pathnames filespec symbol-files-pathspec)))
    203206    (let ((funcs (filter-combos (load-combos (symbols-pathspec "*.funcs"))))
    204207          (macs (filter-combos (load-combos (symbols-pathspec "*.macs"))))
     208          (setf-functions (filter-setf-combos (load-combos (symbols-pathspec "*.setf-functions"))))
     209          (setf-expanders (filter-setf-combos (load-combos (symbols-pathspec "*.setf-expanders"))))
    205210          (exps (filter-combos (load-combos (symbols-pathspec "*.exps")))))
    206211      (with-open-file (f (symbols-pathspec "autoloads-gen.lisp")
     
    244249          (terpri f)
    245250          (write-package-filesets f package 'ext:autoload-macro
    246                                   (combos-to-fileset-symbols macs)))))))
    247 
     251                                  (combos-to-fileset-symbols macs))
     252
     253          (terpri f)
     254
     255          (write-line ";; SETF-FUNCTIONS" f)
     256          (terpri f)
     257          (write-package-filesets f package 'ext:autoload-setf-function
     258                                    (combos-to-fileset-symbols setf-functions))
     259          (terpri f)
     260          (write-line ";; SETF-EXPANDERS" f)
     261          (terpri f)
     262          (write-package-filesets f package 'ext:autoload-setf-expander
     263                                  (combos-to-fileset-symbols setf-expanders)))))))
    248264
    249265;;
Note: See TracChangeset for help on using the changeset viewer.