From: David Vázquez <davazp@gmail.com>
Date: Thu, 20 Jun 2013 14:24:42 +0000 (+0200)
Subject: Improvements to nested groups handling
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=afb6a14b45bf0734ce9b06d3c299036ad8792d40;p=jscl.git

Improvements to nested groups handling
---

diff --git a/src/compiler-codegen.lisp b/src/compiler-codegen.lisp
index 5b8d028..fbb3952 100644
--- a/src/compiler-codegen.lisp
+++ b/src/compiler-codegen.lisp
@@ -352,78 +352,87 @@
       (t
        (js-operator-expression (car form) (cdr form))))))
 
-(defun js-stmt (form)
-  (if (atom form)
-      (progn
-        (js-expr form)
-        (js-format ";"))
-      (case (car form)
-        (label
-         (destructuring-bind (label &body body) (cdr form)
-           (js-identifier label)
-           (js-format ":")
-           (js-stmt `(progn ,@body))))
-        (break
-         (destructuring-bind (label) (cdr form)
-           (js-format "break ")
-           (js-identifier label)
-           (js-format ";")))
-        (return
-          (destructuring-bind (value) (cdr form)
-            (js-format "return ")
-            (js-expr value)
-            (js-format ";")))
-        (var
-         (flet ((js-var (spec)
-                  (destructuring-bind (variable &optional initial)
-                      (ensure-list spec)
-                    (js-identifier variable)
-                    (when initial
-                      (js-format "=")
-                      (js-expr initial)))))
-           (destructuring-bind (var &rest vars) (cdr form)
-             (let ((*js-operator-precedence* 12))
-               (js-format "var ")
-               (js-var var)
-               (dolist (var vars)
-                 (js-format ",")
-                 (js-var var))
-               (js-format ";")))))
-        (if
-         (destructuring-bind (condition true &optional false) (cdr form)
-           (js-format "if (")
-           (js-expr condition)
-           (js-format ") ")
-           (js-stmt true)
-           (when false
-             (js-format " else ")
-             (js-stmt false))))
-        (group
-         (js-format "{")
-         (mapc #'js-stmt (cdr form))
-         (js-format "}"))
-        (progn
-          (cond
-            ((null (cdr form))
-             (js-format ";"))
-            ((null (cddr form))
-             (js-stmt (cadr form)))
+(defun js-expand-stmt (form)
+  (cond
+    ((and (consp form) (eq (car form) 'progn))
+     (destructuring-bind (&body body) (cdr form)
+       (cond
+         ((null body)           '(empty))
+         ((null (cdr body))     (car body))
+         (t                     `(group ,@(cdr form))))))
+    (t
+     form)))
+
+(defun js-stmt (form &optional parent)
+  (let ((form (js-expand-stmt form)))
+    (flet ((js-stmt (x) (js-stmt x form)))
+      (if (atom form)
+          (progn
+            (js-expr form)
+            (js-format ";"))
+          (case (car form)
+            (empty
+             (unless (and (consp parent) (eq (car parent) 'group))
+               (js-format ";")))
+            (label
+             (destructuring-bind (label &body body) (cdr form)
+               (js-identifier label)
+               (js-format ":")
+               (js-stmt `(progn ,@body))))
+            (break
+             (destructuring-bind (label) (cdr form)
+               (js-format "break ")
+               (js-identifier label)
+               (js-format ";")))
+            (return
+              (destructuring-bind (value) (cdr form)
+                (js-format "return ")
+                (js-expr value)
+                (js-format ";")))
+            (var
+             (flet ((js-var (spec)
+                      (destructuring-bind (variable &optional initial)
+                          (ensure-list spec)
+                        (js-identifier variable)
+                        (when initial
+                          (js-format "=")
+                          (js-expr initial)))))
+               (destructuring-bind (var &rest vars) (cdr form)
+                 (let ((*js-operator-precedence* 12))
+                   (js-format "var ")
+                   (js-var var)
+                   (dolist (var vars)
+                     (js-format ",")
+                     (js-var var))
+                   (js-format ";")))))
+            (if
+             (destructuring-bind (condition true &optional false) (cdr form)
+               (js-format "if (")
+               (js-expr condition)
+               (js-format ") ")
+               (js-stmt true)
+               (when false
+                 (js-format " else ")
+                 (js-stmt false))))
+            (group
+             (let ((in-group-p (and (consp parent) (eq (car parent) 'group))))
+               (unless  in-group-p (js-format "{"))
+               (mapc #'js-stmt (cdr form))
+               (unless in-group-p (js-format "}"))))
+            (while
+                (destructuring-bind (condition &body body) (cdr form)
+                  (js-format "while (")
+                  (js-expr condition)
+                  (js-format ")")
+                  (js-stmt `(progn ,@body))))
+            (throw
+                (destructuring-bind (object) (cdr form)
+                  (js-format "throw ")
+                  (js-expr object)
+                  (js-format ";")))
             (t
-             (js-stmt `(group ,@(cdr form))))))
-        (while
-            (destructuring-bind (condition &body body) (cdr form)
-              (js-format "while (")
-              (js-expr condition)
-              (js-format ")")
-              (js-stmt `(group ,@body))))
-        (throw
-            (destructuring-bind (object) (cdr form)
-              (js-format "throw ")
-              (js-expr object)
-              (js-format ";")))
-        (t
-         (js-expr form)
-         (js-format ";")))))
+             (js-expr form)
+             (js-format ";")))))))
 
 (defun js (&rest stmts)
   (mapc #'js-stmt stmts)