Fix empty toplevel progn

[jscl.git] / src / compiler.lisp

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 3b3d0c9..6605dde 100644 (file)
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -18,6 +18,8 @@
 
 ;;;; Compiler
 
+(/debug "loading compiler.lisp!")
+
 ;;; Translate the Lisp code to Javascript. It will compile the special
 ;;; forms. Some primitive functions are compiled as special forms
 ;;; too. The respective real functions are defined in the target (see
@@ -48,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
@@ -56,10 +58,11 @@
 ;;; 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))))
+
+(defmacro js!selfcall* (&body body)
+  ``(call (function nil ,,@body)))
+
 
 ;;; Like CODE, but prefix each line with four spaces. Two versions
 ;;; of this function are available, because the Ecmalisp version is
@@ -114,7 +117,7 @@
 
 (defun gvarname (symbol)
   (declare (ignore symbol))
-  (format nil "v~d" (incf *variable-counter*)))
+  (code "v" (incf *variable-counter*)))
 
 (defun translate-variable (symbol)
   (awhen (lookup-in-lexenv symbol *environment* 'variable)
@@ -191,10 +194,9 @@
          *compilations*))
 
 (define-compilation if (condition true &optional false)
-  `(code "(" ,(ls-compile condition) " !== " ,(ls-compile nil)
-         " ? " ,(ls-compile true *multiple-value-p*)
-         " : " ,(ls-compile false *multiple-value-p*)
-         ")"))
+  `(if (!== ,(ls-compile condition) ,(ls-compile nil))
+       ,(ls-compile true *multiple-value-p*)
+       ,(ls-compile false *multiple-value-p*)))
 
 (defvar *ll-keywords* '(&optional &rest &key))
 
@@ -495,7 +497,7 @@
 (defvar *literal-counter* 0)
 
 (defun genlit ()
-  (format nil "l~d" (incf *literal-counter*)))
+  (code "l" (incf *literal-counter*)))
 
 (defun dump-symbol (symbol)
   #-jscl
@@ -610,7 +612,7 @@
            ,@(interleave (mapcar #'translate-function fnames) ",")
            "){"
            ,(ls-compile-block body t)
-           "})(" ,@cfuncs ")")))
+           "})(" ,@(interleave cfuncs ",") ")")))
 
 (define-compilation labels (definitions &rest body)
   (let* ((fnames (mapcar #'car definitions))
@@ -933,8 +935,8 @@
         ,@(mapcar (lambda (form)
                     `(code "vs = " ,(ls-compile form t) ";"
                            "if (typeof vs === 'object' && 'multiple-value' in vs)"
-                           (code "args = args.concat(vs);" )
-                           "else"
+                           (code " args = args.concat(vs);" )
+                           " else "
                            (code "args.push(vs);" )))
                   forms))
       "args[1] = args.length-2;"
@@ -1003,11 +1005,10 @@
       (cond
         ((floatp x) (push (float-to-string x) fargs))
         ((numberp x) (push (integer-to-string x) fargs))
-        (t (let ((v (format nil "x~d" (incf counter))))
+        (t (let ((v (code "x" (incf counter))))
              (push v fargs)
              (push `(code "var " ,v " = " ,(ls-compile x) ";"
-                          "if (typeof " v " !== 'number') throw 'Not a number!';"
-                          )
+                          "if (typeof " ,v " !== 'number') throw 'Not a number!';")
                    prelude)))))
     (js!selfcall
       `(code ,@(reverse prelude))
@@ -1243,6 +1244,9 @@
 (define-builtin %write-string (x)
   `(code "lisp.write(" ,x ")"))
 
+(define-builtin /debug (x)
+  `(code "console.log(xstring(" ,x "))"))
+
 
 ;;; Storage vectors. They are used to implement arrays and (in the
 ;;; future) structures.
@@ -1326,20 +1330,20 @@
       "return tmp === undefined? " (ls-compile nil) " : tmp;" )))
 
 (define-raw-builtin oget (object key &rest keys)
-  `(code "js_to_lisp(" ,(ls-compile `(oget* ,object ,key ,@keys)) ")"))
+  `(call |js_to_lisp| ,(ls-compile `(oget* ,object ,key ,@keys))))
 
 (define-raw-builtin oset (value object key &rest keys)
   (ls-compile `(oset* (lisp-to-js ,value) ,object ,key ,@keys)))
 
 (define-builtin objectp (x)
-  (js!bool `(code "(typeof (" ,x ") === 'object')")))
+  (js!bool `(=== (typeof ,x) "object")))
 
-(define-builtin lisp-to-js (x) `(code "lisp_to_js(" ,x ")"))
-(define-builtin js-to-lisp (x) `(code "js_to_lisp(" ,x ")"))
+(define-builtin lisp-to-js (x) `(call |lisp_to_js| ,x))
+(define-builtin js-to-lisp (x) `(call |js_to_lisp| ,x))
 
 
 (define-builtin in (key object)
-  (js!bool `(code "(xstring(" ,key ") in (" ,object "))")))
+  (js!bool `(in (call |xstring| ,key) ,object)))
 
 (define-builtin map-for-in (function object)
   (js!selfcall
@@ -1451,10 +1455,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
@@ -1488,6 +1492,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)
 
@@ -1499,7 +1506,10 @@
 (defun convert-toplevel (sexp &optional multiple-value-p)
   (let ((*toplevel-compilations* nil))
     (cond
-      ((and (consp sexp) (eq (car sexp) 'progn))
+      ;; Non-empty toplevel progn
+      ((and (consp sexp)
+            (eq (car sexp) 'progn)
+            (cdr sexp))
        `(progn
           ,@(mapcar (lambda (s) (convert-toplevel s t))
                     (cdr sexp))))