Changeset 14027


Ignore:
Timestamp:
07/31/12 12:24:30 (8 years ago)
Author:
ehuelsmann
Message:

Add infrastructure to record toplevel names of functions and macros.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

    r14020 r14027  
    4040
    4141(defvar *output-file-pathname*)
     42
     43(defvar *toplevel-functions*)
     44(defvar *toplevel-macros*)
     45
    4246
    4347(defun base-classname (&optional (output-file-pathname *output-file-pathname*))
     
    404408  (note-toplevel-form form)
    405409  (note-name-defined (second form))
     410  (push (second form) *toplevel-functions*)
    406411  (let ((*compile-print* nil))
    407412    (process-toplevel-form (macroexpand-1 form *compile-file-environment*)
     
    429434  (let ((name (second form)))
    430435    (eval form)
     436    (push name *toplevel-macros*)
    431437    (let* ((expr (function-lambda-expression (macro-function name)))
    432438           (saved-class-number *class-number*)
     
    528534    (push name jvm::*functions-defined-in-current-file*)
    529535    (note-name-defined name)
     536    (push name *toplevel-functions*)
    530537    ;; If NAME is not fbound, provide a dummy definition so that
    531538    ;; getSymbolFunctionOrDie() will succeed when we try to verify that
     
    694701                     ((:verbose *compile-verbose*) *compile-verbose*)
    695702                     ((:print *compile-print*) *compile-print*)
     703                     (extract-toplevel-funcs-and-macros nil)
    696704                     external-format)
    697705  (declare (ignore external-format))    ; FIXME
     
    713721         (temp-file2 (merge-pathnames (make-pathname :type (concatenate 'string type "-tmp2"))
    714722                                     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*
    715727         (warnings-p nil)
    716728         (failure-p nil))
     
    767779                    (dolist (name *fbound-names*)
    768780                      (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)))))
    769809        (with-open-file (in temp-file :direction :input)
    770810          (with-open-file (out temp-file2 :direction :output
     
    836876           (if (or (null target-write-time)
    837877                   (<= target-write-time source-write-time))
    838                (apply 'compile-file input-file allargs)
     878               (apply #'compile-file input-file allargs)
    839879               output-file)))))
    840880
Note: See TracChangeset for help on using the changeset viewer.