[armedbear-cvs] r11789 - trunk/abcl/src/org/armedbear/lisp

Ville Voutilainen vvoutilainen at common-lisp.net
Mon Apr 27 21:10:25 UTC 2009


Author: vvoutilainen
Date: Mon Apr 27 17:10:24 2009
New Revision: 11789

Log:
Tiny cleanup to invocations of compile-xep.


Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp	Mon Apr 27 17:10:24 2009
@@ -858,6 +858,13 @@
 
 (initialize-p1-handlers)
 
+(defun invoke-compile-xep (xep-lambda-expression compiland)
+  (let ((xep-compiland
+	 (make-compiland :lambda-expression 
+			 (precompile-form xep-lambda-expression t)
+			 :class-file (compiland-class-file compiland))))
+    (compile-xep xep-compiland)))
+
 (defun p1-compiland (compiland)
 ;;   (format t "p1-compiland name = ~S~%" (compiland-name compiland))
   (let ((form (compiland-lambda-expression compiland)))
@@ -901,19 +908,13 @@
                                           (,supplied-p-var nil))
                                      (%call-internal , at all-args)))))
                            (dformat t "xep-lambda-expression = ~S~%" xep-lambda-expression)
-                           (let ((xep-compiland
-                                  (make-compiland :lambda-expression (precompile-form xep-lambda-expression t)
-                                                  :class-file (compiland-class-file compiland))))
-                             (compile-xep xep-compiland)))
+			   (invoke-compile-xep xep-lambda-expression compiland))
                          (let ((xep-lambda-expression
                                 `(lambda ,(append required-args (list name))
                                    (let* ((,supplied-p-var t))
                                      (%call-internal , at all-args)))))
                            (dformat t "xep-lambda-expression = ~S~%" xep-lambda-expression)
-                           (let ((xep-compiland
-                                  (make-compiland :lambda-expression (precompile-form xep-lambda-expression t)
-                                                  :class-file (compiland-class-file compiland))))
-                             (compile-xep xep-compiland)))
+			   (invoke-compile-xep xep-lambda-expression compiland))
                          (setf lambda-list all-args)
                          (setf (compiland-kind compiland) :internal))
                         (t
@@ -922,10 +923,7 @@
                                    (let* ((,name ,initform))
                                      (,(compiland-name compiland) , at all-args)))))
                            (dformat t "xep-lambda-expression = ~S~%" xep-lambda-expression)
-                           (let ((xep-compiland
-                                  (make-compiland :lambda-expression (precompile-form xep-lambda-expression t)
-                                                  :class-file (compiland-class-file compiland))))
-                             (compile-xep xep-compiland)))
+			   (invoke-compile-xep xep-lambda-expression compiland))
                          (setf lambda-list all-args))))))))))
 
       (let* ((closure (make-closure `(lambda ,lambda-list nil) nil))




More information about the armedbear-cvs mailing list