Changeset 14036


Ignore:
Timestamp:
08/01/12 11:53:36 (8 years ago)
Author:
ehuelsmann
Message:

Re #226: Automatically generate autoloads.

This commit adds the auto generation code and infrastructure. Next steps
include clean up of autoloads.lisp, deciding how to handle symbols in
multiple files and SETF functions/expanders.

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

Legend:

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

    r14031 r14036  
    147147  (sys::%nreverse sequence))
    148148
     149(load-system-file "autoloads-gen")
    149150(load-system-file "autoloads")
    150151(load-system-file "early-defuns")
  • trunk/abcl/src/org/armedbear/lisp/compile-system.lisp

    r14034 r14036  
    7979       (dolist (file files)
    8080         (grovel-java-definitions-in-file file stream))))))
     81
     82
     83;;
     84;; Functions to generate autoloads.lisp
     85;;
     86
     87(defun packages-from-combos (combos)
     88  (remove-duplicates (mapcar #'symbol-package
     89                             (mapcar #'sys:fdefinition-block-name
     90                                     (mapcar #'second combos)))))
     91
     92(defun remove-multi-combo-symbols (combos)
     93  (remove-if (lambda (x)
     94               (< 1 (count x combos :key #'second)))
     95             combos
     96             :key #'second))
     97
     98(defun set-equal (set1 set2 &key test)
     99  (or (eq set1 set2)
     100      (equal set1 set2)
     101      (and (subsetp set2 set1 :test test)
     102           (subsetp set1 set2 :test test))))
     103
     104(defun combos-to-symbol-filesets (combos)
     105  (let (filesets)
     106    (dolist (combo combos)
     107      (pushnew (list (second combo)) filesets :test #'equal :key #'first)
     108      (pushnew (first combo)
     109               (cdr (assoc (second combo) filesets :test #'equal))
     110               :test #'string=))
     111    filesets))
     112
     113(defun combos-to-fileset-symbols (combos)
     114  (let (fileset-symbols)
     115    (dolist (symbol-fileset (combos-to-symbol-filesets combos))
     116      (pushnew (list (cdr symbol-fileset)) fileset-symbols
     117               :test (lambda (x y) (set-equal x y :test #'string=))
     118               :key #'first)
     119      (pushnew (first symbol-fileset)
     120               (cdr (assoc (cdr symbol-fileset) fileset-symbols
     121                           :test (lambda (x y) (set-equal x y :test #'string=))))))
     122    fileset-symbols))
     123
     124(defun write-autoloader (stream package type fileset-symbols)
     125  (when fileset-symbols
     126    (write `(in-package ,package) :stream stream)
     127    (terpri stream)
     128    (let ((*package* (find-package package)))
     129      (write `(dolist (fs ',fileset-symbols)
     130                (funcall #',type (cdr fs) (car (car fs)))) :stream stream)
     131      (terpri stream))))
     132
     133(defun write-package-filesets (stream package type filesets-symbols)
     134  (let* ((filter-package (find-package package))
     135         (filtered-filesets
     136         (remove-if (lambda (x)
     137                      (null (cdr x)))
     138                    (mapcar (lambda (x)
     139                              (cons (car x)
     140                                    (remove-if-not (lambda (x)
     141                                                     ;;; ### TODO: Support SETF functions
     142                                                     (and (symbolp x)
     143                                                          (eq (symbol-package x)
     144                                                              filter-package)))
     145                                                   (cdr x))))
     146                            filesets-symbols))))
     147    (write-autoloader stream package type filtered-filesets)))
     148
     149(defun load-combos (path-spec)
     150  (let (all-functions)
     151    (dolist (functions-file (directory path-spec)
     152             all-functions)
     153      ;; every file has 1 form: the list of functions in it.
     154      (let ((base-name (pathname-name functions-file)))
     155        (unless (member base-name '("asdf" "gray-streams") :test #'string=)
     156          ;; exclude ASDF and GRAY-STREAMS: they have external
     157          ;; symbols we don't have until we load them, but we need
     158          ;; those symbols to read the symbols files
     159          (with-open-file (f functions-file
     160                             :direction :input)
     161            (dolist (function-name (read f))
     162              (push (list base-name function-name) all-functions))))))))
     163
     164(defun generate-autoloads (symbol-files-pathspec)
     165  (flet ((filter-combos (combos)
     166           (remove-if (lambda (x)
     167                        ;; exclude the symbols from the files
     168                        ;; below: putting autoloaders on some of
     169                        ;; the symbols conflicts with the bootstrapping
     170                        ;; Primitives which have been defined Java-side
     171                        (member x '( ;; function definitions to be excluded
     172                                    "fdefinition" "early-defuns"
     173                                    "require" "signal"
     174                                    "extensible-sequences-base" "restart"
     175                                    "extensible-sequences"
     176                                    ;; macro definitions to be excluded
     177                                    "macros" "backquote" "precompiler")
     178                                :test #'string=))
     179                      (remove-multi-combo-symbols combos)
     180                      :key #'first))
     181         (symbols-pathspec (filespec)
     182           (merge-pathnames filespec symbol-files-pathspec)))
     183    (let ((funcs (filter-combos (load-combos (symbols-pathspec "*.funcs"))))
     184          (macs (filter-combos (load-combos (symbols-pathspec "*.macs")))))
     185      (with-open-file (f (symbols-pathspec "autoloads-gen.lisp")
     186                         :direction :output :if-does-not-exist :create
     187                         :if-exists :supersede)
     188        ;; Generate the lisp file. This file will be included after compilation,
     189        ;; so any comments are just for debugging purposes.
     190        (terpri f)
     191        (write-line ";; ---- GENERATED CONTENT BELOW" f)
     192        (terpri f)
     193        (write '(identity T) :stream f)
     194        (dolist (package '(:format :sequence :loop :mop :xp :precompiler
     195                           :profiler :java :jvm :extensions :threads
     196                           :toplevel :system :cl))
     197          ;; Limit the set of packages:
     198          ;;  During incremental compilation, the packages GRAY-STREAMS
     199          ;;    and ASDF are not being created. Nor are these packages
     200          ;;    vital to the correct operation of the base system.
     201          (write-line ";; FUNCTIONS" f)
     202          (terpri f)
     203          (write-package-filesets f package 'ext:autoload
     204                                  (combos-to-fileset-symbols funcs))
     205          (write-line ";; MACROS" f)
     206          (terpri f)
     207          (write-package-filesets f package 'ext:autoload-macro
     208                                  (combos-to-fileset-symbols macs)))))))
     209
     210
     211;;
     212;; --- End of autoloads.lisp
     213;;
     214
    81215
    82216(defun %compile-system (&key output-path)
     
    139273                           "assert.lisp"
    140274                           "assoc.lisp"
    141                            "autoloads.lisp"
    142275                           "aver.lisp"
    143276                           "bit-array-ops.lisp"
    144277                           "boole.lisp"
    145                            ;;"boot.lisp"
    146278                           "butlast.lisp"
    147279                           "byte-io.lisp"
     
    191323                           "inline.lisp"
    192324                           "inspect.lisp"
    193                            ;;"j.lisp"
    194325                           "java.lisp"
    195326                           "java-collections.lisp"
     
    243374                           "revappend.lisp"
    244375                           "rotatef.lisp"
    245                            ;;"run-benchmarks.lisp"
    246376                           "run-program.lisp"
    247377                           "run-shell-command.lisp"
     
    273403                           "with-slots.lisp"
    274404                           "with-standard-io-syntax.lisp"
    275                            "write-sequence.lisp")))
     405                           "write-sequence.lisp"))
     406      ;; With all files compiled, we need to use the symbols collected
     407      ;; to generate and compile autoloads.lisp
     408
     409      ;; Generate the autoloads-gen file in the build directory in order
     410      ;; not to clobber the source file - that should keep the system
     411      ;; buildable
     412
     413      (format t "; Generating autoloads...~%")
     414      (generate-autoloads output-path)
     415      ;; Compile the file in the build directory instead of the one in the
     416      ;; sources directory - the latter being for bootstrapping only.
     417      (do-compile (merge-pathnames #p"autoloads-gen.lisp" output-path))
     418      (do-compile "autoloads.lisp"))
    276419    t))
    277420
  • trunk/abcl/src/org/armedbear/lisp/setf.lisp

    r12935 r14036  
    5959
    6060(defun get-setf-expansion (form &optional environment)
    61   (when (and (consp form)
    62              (autoloadp (%car form)))
    63     (resolve (%car form)))
     61;  ### FIXME: resolving here causes functions to be loaded at
     62;       Macro expansion time instead of upon their first call!
     63;       Discussion to be had on the mailing list.
     64;       EH 2012-08-01
     65;  (when (and (consp form)
     66;             (autoloadp (%car form)))
     67;    (resolve (%car form)))
    6468  (let (temp)
    6569    (cond ((symbolp form)
     
    8791            `(setq ,place ,value-form)
    8892            (progn
    89               (when (symbolp (%car place))
    90                 (resolve (%car place)))
     93;              ### FIXME: resolving here causes functions to be loaded at
     94;                   Macro expansion time instead of upon their first call!
     95;                   Discussion to be had on the mailing list.
     96;                   EH 2012-08-01
     97;              (when (symbolp (%car place))
     98;                (resolve (%car place)))
    9199              (multiple-value-bind (dummies vals store-vars setter getter)
    92100                  (get-setf-expansion place environment)
Note: See TracChangeset for help on using the changeset viewer.