From: David Vazquez <davazp@gmail.com>
Date: Thu, 17 Jan 2013 01:53:09 +0000 (+0000)
Subject: Add RETURN-LAST-P argument to LS-COMPILE-BLOCK
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=0f2ea1483ea09443ff9473df9d9bb4b675f4c059;p=jscl.git

Add RETURN-LAST-P argument to LS-COMPILE-BLOCK
---

diff --git a/ecmalisp.lisp b/ecmalisp.lisp
index 56a70c6..5ae918f 100644
--- a/ecmalisp.lisp
+++ b/ecmalisp.lisp
@@ -822,10 +822,13 @@
 
 (defvar *compilations* nil)
 
-(defun ls-compile-block (sexps)
-  (join-trailing
-   (remove-if #'null-or-empty-p  (mapcar #'ls-compile sexps))
-   (concat ";" *newline*)))
+(defun ls-compile-block (sexps &optional return-last-p)
+  (if return-last-p
+      (concat (ls-compile-block (butlast sexps))
+              "return " (ls-compile (car (last sexps))) ";")
+      (join-trailing
+       (remove-if #'null-or-empty-p (mapcar #'ls-compile sexps))
+       (concat ";" *newline*))))
 
 (defmacro define-compilation (name args &body body)
   ;; Creates a new primitive `name' with parameters args and
@@ -922,8 +925,7 @@
                              *newline*))
                    "")
                ;; Body
-               (concat (ls-compile-block (butlast body))
-                       "return " (ls-compile (car (last body))) ";")) *newline*
+               (ls-compile-block body t)) *newline*
               "})"))))
 
 (define-compilation setq (var val)
@@ -1010,10 +1012,7 @@
      (ls-compile ,form)))
 
 (define-compilation progn (&rest body)
-  (js!selfcall
-    (ls-compile-block (butlast body))
-    "return " (ls-compile (car (last body))) ";" *newline*))
-
+  (js!selfcall (ls-compile-block body t)))
 
 (defun dynamic-binding-wrapper (bindings body)
   (if (null bindings)
@@ -1059,10 +1058,7 @@
                               variables)
                       ",")
                 "){" *newline*
-                (let ((body
-                       (concat (ls-compile-block (butlast body))
-                               "return " (ls-compile (car (last body)))
-                               ";" *newline*)))
+                (let ((body (ls-compile-block body t)))
                   (indent (dynamic-binding-wrapper dynamic-bindings body)))
                 "})(" (join cvalues ",") ")")))))