Changeset 12905

Timestamp:

08/29/10 18:21:42 (13 years ago)

Author:

ehuelsmann

Message:

Eliminate SET-COMPILAND-AND-WRITE-CLASS, since it doesn't take care
of most of the other boiler plate.

File:

• branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (modified) (6 diffs)

branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -3790 +3790 @@
 
 (defun compile-and-write-to-stream (class-file compiland stream)
+  (setf (compiland-class-file compiland) class-file)
   (with-class-file class-file
     (let ((*current-compiland* compiland))
       (with-saved-compiler-policy
-    (p2-compiland compiland)
+        (p2-compiland compiland)
 ;;        (finalize-class-file (compiland-class-file compiland))
-  (finish-class (compiland-class-file compiland) stream)))))
-
-(defun set-compiland-and-write-class (class-file compiland stream)
-  (setf (compiland-class-file compiland) class-file)
-  (compile-and-write-to-stream class-file compiland stream))
-
+        (finish-class (compiland-class-file compiland) stream)))))
 
 (defmacro with-temp-class-file (pathname class-file lambda-list &body body)
@@ -3819 +3815 @@
                                                     :lambda-list lambda-list)))
              (with-open-class-file (f class-file)
-               (set-compiland-and-write-class class-file compiland f))
+               (compile-and-write-to-stream class-file compiland f))
              (setf (local-function-class-file local-function) class-file)))
           (t
            (let ((class-file (make-abcl-class-file :lambda-list lambda-list)))
              (with-open-stream (stream (sys::%make-byte-array-output-stream))
-               (set-compiland-and-write-class class-file compiland stream)
+               (compile-and-write-to-stream class-file compiland stream)
                (setf (local-function-class-file local-function) class-file)
                (setf (local-function-function local-function)
@@ -3853 +3849 @@
                                                     :lambda-list lambda-list)))
              (with-open-class-file (f class-file)
-               (set-compiland-and-write-class class-file compiland f))
+               (compile-and-write-to-stream class-file compiland f))
              (setf (local-function-class-file local-function) class-file)
              (let ((g (declare-local-function local-function)))
@@ -3861 +3857 @@
            (let ((class-file (make-abcl-class-file :lambda-list lambda-list)))
              (with-open-stream (stream (sys::%make-byte-array-output-stream))
-               (set-compiland-and-write-class class-file compiland stream)
+               (compile-and-write-to-stream class-file compiland stream)
                (setf (local-function-class-file local-function) class-file)
                (let ((g (declare-object
@@ -3911 +3907 @@
     (aver (null (compiland-class-file compiland)))
     (cond (*file-compilation*
-           (setf (compiland-class-file compiland)
-                 (make-abcl-class-file :pathname (funcall *pathnames-generator*)
-                                       :lambda-list lambda-list))
-           (let ((class-file (compiland-class-file compiland)))
+           (let ((class-file (make-abcl-class-file
+                                :pathname (funcall *pathnames-generator*)
+                                :lambda-list lambda-list)))
        (with-open-class-file (f class-file)
          (compile-and-write-to-stream class-file compiland f))
@@ -3922 +3917 @@
                    +lisp-object+)))
           (t
-           (setf (compiland-class-file compiland)
-                 (make-abcl-class-file :lambda-list lambda-list))
            (with-open-stream (stream (sys::%make-byte-array-output-stream))
-             (compile-and-write-to-stream (compiland-class-file compiland)
+             (compile-and-write-to-stream (make-abcl-class-file :lambda-list
+                                                                lambda-list)
                                           compiland stream)
              (emit-load-externalized-object (load-compiled-function