Merge branch 'codegen' into codegen-migration

diff --git a/src/compiler-codegen.lisp b/src/compiler-codegen.lisp
index 50f33af..674ace6 100644 (file)
--- a/src/compiler-codegen.lisp
+++ b/src/compiler-codegen.lisp
@@ -154,7 +154,7 @@
       (js-format ",")
       (js-identifier arg)))
   (js-format ")")
-  (js-stmt `(group ,@body)))
+  (js-stmt `(group ,@body) t))
 
 (defun check-lvalue (x)
   (unless (or (symbolp x)
@@ -362,86 +362,92 @@
     ((and (consp form) (eq (car form) 'progn))
      (destructuring-bind (&body body) (cdr form)
        (cond
-         ((null body)           '(empty))
-         ((null (cdr body))     (js-expand-stmt (car body)))
-         (t                     `(group ,@(cdr form))))))
+         ((null body)
+          nil)
+         ((null (cdr body))
+          (js-expand-stmt (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)
-            (code
-             (js-format "~a" (apply #'code (cdr 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)
+      (cond
+        ((null form)
+         (unless (or (and (consp parent) (eq (car parent) 'group))
+                     (null parent))
+           (js-format ";")))
+        ((atom form)
+         (progn
+           (js-expr form)
+           (js-format ";")))
+        (t
+         (case (car form)
+           (code
+            (js-format "~a" (apply #'code (cdr 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 ";")))
-            (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
-                    (or (null parent)
-                        (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-expr form)
-             (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
+                   (or (null parent)
+                       (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-expr form)
+            (js-format ";"))))))))
 
 (defun js (&rest stmts)
   (mapc #'js-stmt stmts)

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 2d51fb2..09abdeb 100644 (file)
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -50,7 +50,7 @@
 ;;; Wrap X with a Javascript code to convert the result from
 ;;; Javascript generalized booleans to T or NIL.
 (defun js!bool (x)
-  `(code "(" ,x "?" ,(ls-compile t) ": " ,(ls-compile nil) ")"))
+  `(if ,x ,(ls-compile t) ,(ls-compile nil)))
 
 ;;; Concatenate the arguments and wrap them with a self-calling
 ;;; Javascript anonymous function. It is used to make some Javascript
@@ -58,10 +58,7 @@
 ;;; It could be defined as function, but we could do some
 ;;; preprocessing in the future.
 (defmacro js!selfcall (&body body)
-  ``(code "(function(){" ,*newline*
-          (code ,,@body)
-          ,*newline*
-          "})()"))
+  ``(call (function nil (code ,,@body))))
 
 ;;; Like CODE, but prefix each line with four spaces. Two versions
 ;;; of this function are available, because the Ecmalisp version is
@@ -1455,10 +1452,10 @@
 " *newline*)
           ";" ,*newline*))))
 
-(defun ls-compile (sexp &optional multiple-value-p)
+(defun ls-compile* (sexp &optional multiple-value-p)
   (multiple-value-bind (sexp expandedp) (!macroexpand-1 sexp)
     (when expandedp
-      (return-from ls-compile (ls-compile sexp multiple-value-p)))
+      (return-from ls-compile* (ls-compile sexp multiple-value-p)))
     ;; The expression has been macroexpanded. Now compile it!
     (let ((*multiple-value-p* multiple-value-p))
       (cond
@@ -1492,6 +1489,9 @@
         (t
          (error "How should I compile `~S'?" sexp))))))
 
+(defun ls-compile (sexp &optional multiple-value-p)
+  `(code "(" ,(ls-compile* sexp multiple-value-p) ")"))
+
 
 (defvar *compile-print-toplevels* nil)