Changeset 14036
- Timestamp:
- 08/01/12 11:53:36 (8 years ago)
- 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 147 147 (sys::%nreverse sequence)) 148 148 149 (load-system-file "autoloads-gen") 149 150 (load-system-file "autoloads") 150 151 (load-system-file "early-defuns") -
trunk/abcl/src/org/armedbear/lisp/compile-system.lisp
r14034 r14036 79 79 (dolist (file files) 80 80 (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 81 215 82 216 (defun %compile-system (&key output-path) … … 139 273 "assert.lisp" 140 274 "assoc.lisp" 141 "autoloads.lisp"142 275 "aver.lisp" 143 276 "bit-array-ops.lisp" 144 277 "boole.lisp" 145 ;;"boot.lisp"146 278 "butlast.lisp" 147 279 "byte-io.lisp" … … 191 323 "inline.lisp" 192 324 "inspect.lisp" 193 ;;"j.lisp"194 325 "java.lisp" 195 326 "java-collections.lisp" … … 243 374 "revappend.lisp" 244 375 "rotatef.lisp" 245 ;;"run-benchmarks.lisp"246 376 "run-program.lisp" 247 377 "run-shell-command.lisp" … … 273 403 "with-slots.lisp" 274 404 "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")) 276 419 t)) 277 420 -
trunk/abcl/src/org/armedbear/lisp/setf.lisp
r12935 r14036 59 59 60 60 (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))) 64 68 (let (temp) 65 69 (cond ((symbolp form) … … 87 91 `(setq ,place ,value-form) 88 92 (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))) 91 99 (multiple-value-bind (dummies vals store-vars setter getter) 92 100 (get-setf-expansion place environment)
Note: See TracChangeset
for help on using the changeset viewer.