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

[Alessio Stalla]

Author: astalla
Date: Sun Feb  7 17:08:01 2010
New Revision: 12428

Log:
Corrected bugs: inline declaration for local functions was ignored as for
r12420, and the bug r12420 was supposed to fix has been fixed, too.



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	Sun Feb  7 17:08:01 2010
@@ -51,10 +51,7 @@
     (if args-p
 	(expand-function-call-inline
 	 nil lambda-list
-	 (copy-tree `((block ,name
-			(locally
-			    (declare (notinline ,name))
-			  , at body))))
+	 (copy-tree `((block ,name , at body)))
 	 args)
 	(cond ((intersection lambda-list
 			     '(&optional &rest &key &allow-other-keys &aux)
@@ -927,20 +924,18 @@
 	     (p1-compiland compiland)))
 	 (push local-function local-functions)))
       ((with-saved-compiler-policy
-	 (let ((inline-decls *inline-declarations*))
-	   (process-optimization-declarations (cddr form))
-	   (let* ((block (make-flet-node))
-		  (*blocks* (cons block *blocks*))
-		  (body (cddr form))
-		  (*visible-variables* *visible-variables*))
-	     (setf (flet-free-specials block)
-		   (process-declarations-for-vars body nil block))
-	     (dolist (special (flet-free-specials block))
-	       (push special *visible-variables*))
-	     (setf (flet-form block)
-		   (let ((*inline-declarations* inline-decls))
-		     (list* (car form) local-functions (p1-body (cddr form)))))
-	     block))))))
+	 (process-optimization-declarations (cddr form))
+	 (let* ((block (make-flet-node))
+		(*blocks* (cons block *blocks*))
+		(body (cddr form))
+		(*visible-variables* *visible-variables*))
+	   (setf (flet-free-specials block)
+		 (process-declarations-for-vars body nil block))
+	   (dolist (special (flet-free-specials block))
+	     (push special *visible-variables*))
+	   (setf (flet-form block)
+		 (list* (car form) local-functions (p1-body (cddr form))))
+	   block)))))
 
 
 (defun p1-labels (form)
@@ -951,6 +946,8 @@
 						   :compiland compiland
 						   :variable variable))
               (block-name (fdefinition-block-name name)))
+	 (setf (local-function-definition local-function)
+	       (copy-tree (cons lambda-list body)))
 	 (multiple-value-bind (body decls) (parse-body body)
 	   (setf (compiland-lambda-expression compiland)
                  (rewrite-lambda
@@ -1287,7 +1284,6 @@
     (cond (local-function
 ;;            (format t "p1 local call to ~S~%" op)
 ;;            (format t "inline-p = ~S~%" (inline-p op))
-
            (when (and *enable-inline-expansion* (inline-p op)
 		      (local-function-definition local-function))
              (let* ((definition (local-function-definition local-function))
@@ -1300,7 +1296,9 @@
                    (when (and explain (memq :calls explain))
                      (format t ";   inlining call to local function ~S~%" op)))
                  (return-from p1-function-call
-		   (p1 expansion)))))
+		   (let ((*inline-declarations*
+			  (remove op *inline-declarations* :key #'car)))
+		     (p1 expansion))))))
 
            ;; FIXME
            (dformat t "local function assumed not single-valued~%")