Changeset 14067

Timestamp:

08/09/12 09:19:40 (8 years ago)

Author:

ehuelsmann

Message:

Fix declarations being dropped on inline expansions.

Report by James M. Lawrence.

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• compile-file.lisp (modified) (1 diff)
• compiler-pass1.lisp (modified) (2 diffs)

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

@@ -529 +529 @@
             (setf (inline-expansion name)
                   (jvm::generate-inline-expansion block-name
-                                                  lambda-list body))
+                                                  lambda-list
+                                                  (append decls body)))
             (output-form `(setf (inline-expansion ',name)
                                 ',(inline-expansion name))))))

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

@@ -49 +49 @@
 It can work either per-function (no args provided) or per-call."
   (if args-p
-      (expand-function-call-inline nil lambda-list
-                                   (copy-tree `((block ,name ,@body)))
-                                   args)
+      (multiple-value-bind
+            (body decls)
+          (parse-body body)
+        (expand-function-call-inline nil lambda-list
+                                     ;; the forms below get wrapped
+                                     ;; in a LET, making the decls
+                                     ;; part of the decls of the LET.
+                                     (copy-tree `(,@decls (block ,name ,@body)))
+                                     args))
       (cond ((intersection lambda-list
                            '(&optional &rest &key &allow-other-keys &aux)
@@ -57 +63 @@
              nil)
             (t
-             (setf body (copy-tree body))
-             (list 'LAMBDA lambda-list
-                   (list* 'BLOCK name body))))))
+             (multiple-value-bind
+                   (body decls)
+                 (parse-body body)
+               (setf body (copy-tree body))
+               `(lambda ,lambda-list ,@decls
+                        (block ,name ,@body)))))))