Changeset 14027
- Timestamp:
- 07/31/12 12:24:30 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
r14020 r14027 40 40 41 41 (defvar *output-file-pathname*) 42 43 (defvar *toplevel-functions*) 44 (defvar *toplevel-macros*) 45 42 46 43 47 (defun base-classname (&optional (output-file-pathname *output-file-pathname*)) … … 404 408 (note-toplevel-form form) 405 409 (note-name-defined (second form)) 410 (push (second form) *toplevel-functions*) 406 411 (let ((*compile-print* nil)) 407 412 (process-toplevel-form (macroexpand-1 form *compile-file-environment*) … … 429 434 (let ((name (second form))) 430 435 (eval form) 436 (push name *toplevel-macros*) 431 437 (let* ((expr (function-lambda-expression (macro-function name))) 432 438 (saved-class-number *class-number*) … … 528 534 (push name jvm::*functions-defined-in-current-file*) 529 535 (note-name-defined name) 536 (push name *toplevel-functions*) 530 537 ;; If NAME is not fbound, provide a dummy definition so that 531 538 ;; getSymbolFunctionOrDie() will succeed when we try to verify that … … 694 701 ((:verbose *compile-verbose*) *compile-verbose*) 695 702 ((:print *compile-print*) *compile-print*) 703 (extract-toplevel-funcs-and-macros nil) 696 704 external-format) 697 705 (declare (ignore external-format)) ; FIXME … … 713 721 (temp-file2 (merge-pathnames (make-pathname :type (concatenate 'string type "-tmp2")) 714 722 output-file)) 723 (functions-file (merge-pathnames (make-pathname :type "funcs") output-file)) 724 (macros-file (merge-pathnames (make-pathname :type "macs") output-file)) 725 *toplevel-functions* 726 *toplevel-macros* 715 727 (warnings-p nil) 716 728 (failure-p nil)) … … 767 779 (dolist (name *fbound-names*) 768 780 (fmakunbound name))))))) 781 (when extract-toplevel-funcs-and-macros 782 (setf *toplevel-functions* 783 (remove-if-not (lambda (func-name) 784 (if (symbolp func-name) 785 (symbol-package func-name) 786 T)) 787 (remove-duplicates *toplevel-functions*))) 788 (when *toplevel-functions* 789 (with-open-file (f-out functions-file 790 :direction :output 791 :if-does-not-exist :create 792 :if-exists :supersede) 793 794 (let ((*package* (find-package :keyword))) 795 (write *toplevel-functions* :stream f-out)))) 796 (setf *toplevel-macros* 797 (remove-if-not (lambda (mac-name) 798 (if (symbolp mac-name) 799 (symbol-package mac-name) 800 T)) 801 (remove-duplicates *toplevel-macros*))) 802 (when *toplevel-macros* 803 (with-open-file (m-out macros-file 804 :direction :output 805 :if-does-not-exist :create 806 :if-exists :supersede) 807 (let ((*package* (find-package :keyword))) 808 (write *toplevel-macros* :stream m-out))))) 769 809 (with-open-file (in temp-file :direction :input) 770 810 (with-open-file (out temp-file2 :direction :output … … 836 876 (if (or (null target-write-time) 837 877 (<= target-write-time source-write-time)) 838 (apply 'compile-file input-file allargs)878 (apply #'compile-file input-file allargs) 839 879 output-file))))) 840 880
Note: See TracChangeset
for help on using the changeset viewer.