Changeset 14027

Timestamp:

07/31/12 12:24:30 (9 years ago)

Author:

ehuelsmann

Message:

Add infrastructure to record toplevel names of functions and macros.

File:

• trunk/abcl/src/org/armedbear/lisp/compile-file.lisp (modified) (8 diffs)

trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

@@ -40 +40 @@
 
 (defvar *output-file-pathname*)
+
+(defvar *toplevel-functions*)
+(defvar *toplevel-macros*)
+
 
 (defun base-classname (&optional (output-file-pathname *output-file-pathname*))
@@ -404 +408 @@
   (note-toplevel-form form)
   (note-name-defined (second form))
+  (push (second form) *toplevel-functions*)
   (let ((*compile-print* nil))
     (process-toplevel-form (macroexpand-1 form *compile-file-environment*)
@@ -429 +434 @@
   (let ((name (second form)))
     (eval form)
+    (push name *toplevel-macros*)
     (let* ((expr (function-lambda-expression (macro-function name)))
            (saved-class-number *class-number*)
@@ -528 +534 @@
     (push name jvm::*functions-defined-in-current-file*)
     (note-name-defined name)
+    (push name *toplevel-functions*)
     ;; If NAME is not fbound, provide a dummy definition so that
     ;; getSymbolFunctionOrDie() will succeed when we try to verify that
@@ -694 +701 @@
                      ((:verbose *compile-verbose*) *compile-verbose*)
                      ((:print *compile-print*) *compile-print*)
+                     (extract-toplevel-funcs-and-macros nil)
                      external-format)
   (declare (ignore external-format))    ; FIXME
@@ -713 +721 @@
          (temp-file2 (merge-pathnames (make-pathname :type (concatenate 'string type "-tmp2"))
                                      output-file))
+         (functions-file (merge-pathnames (make-pathname :type "funcs") output-file))
+         (macros-file (merge-pathnames (make-pathname :type "macs") output-file))
+         *toplevel-functions*
+         *toplevel-macros*
          (warnings-p nil)
          (failure-p nil))
@@ -767 +779 @@
                     (dolist (name *fbound-names*)
                       (fmakunbound name)))))))
+        (when extract-toplevel-funcs-and-macros
+          (setf *toplevel-functions*
+                (remove-if-not (lambda (func-name)
+                                 (if (symbolp func-name)
+                                     (symbol-package func-name)
+                                     T))
+                               (remove-duplicates *toplevel-functions*)))
+          (when *toplevel-functions*
+            (with-open-file (f-out functions-file
+                                   :direction :output
+                                   :if-does-not-exist :create
+                                   :if-exists :supersede)
+
+              (let ((*package* (find-package :keyword)))
+                (write *toplevel-functions* :stream f-out))))
+          (setf *toplevel-macros*
+                (remove-if-not (lambda (mac-name)
+                                 (if (symbolp mac-name)
+                                     (symbol-package mac-name)
+                                     T))
+                               (remove-duplicates *toplevel-macros*)))
+          (when *toplevel-macros*
+            (with-open-file (m-out macros-file
+                                   :direction :output
+                                   :if-does-not-exist :create
+                                   :if-exists :supersede)
+              (let ((*package* (find-package :keyword)))
+                (write *toplevel-macros* :stream m-out)))))
         (with-open-file (in temp-file :direction :input)
           (with-open-file (out temp-file2 :direction :output
@@ -836 +876 @@
            (if (or (null target-write-time)
                    (<= target-write-time source-write-time))
-               (apply 'compile-file input-file allargs)
+               (apply #'compile-file input-file allargs)
                output-file)))))