Migrate DUMP-CONS

[jscl.git] / src / compiler.lisp

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 09abdeb..b7437e9 100644 (file)
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -60,6 +60,10 @@
 (defmacro js!selfcall (&body body)
   ``(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
 ;;; very slow and bootstraping was annoying.
@@ -190,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))
 
@@ -243,16 +246,14 @@
           (ll-optional-arguments-canonical lambda-list))))
     (remove nil (mapcar #'third args))))
 
-(defun lambda-name/docstring-wrapper (name docstring &rest code)
+(defun lambda-name/docstring-wrapper (name docstring code)
   (if (or name docstring)
-      (js!selfcall
-        "var func = " `(code ,@code) ";"
-        (when name
-          `(code "func.fname = " ,(js-escape-string name) ";"))
-        (when docstring
-          `(code "func.docstring = " ,(js-escape-string docstring) ";"))
-        "return func;")
-      `(code ,@code)))
+      (js!selfcall*
+        `(var (func ,code))
+        (when name      `(= (get func |fname|) ,name))
+        (when docstring `(= (get func |docstring|) ,docstring))
+        `(return func))
+      `(code ,code)))
 
 (defun lambda-check-argument-count
     (n-required-arguments n-optional-arguments rest-p)
@@ -500,30 +501,29 @@
   #-jscl
   (let ((package (symbol-package symbol)))
     (if (eq package (find-package "KEYWORD"))
-        `(code "(new Symbol(" ,(dump-string (symbol-name symbol)) ", " ,(dump-string (package-name package)) "))")
-        `(code "(new Symbol(" ,(dump-string (symbol-name symbol)) "))")))
+        `(new (call |Symbol| ,(dump-string (symbol-name symbol)) ,(dump-string (package-name package))))
+        `(new (call |Symbol| ,(dump-string (symbol-name symbol))))))
   #+jscl
   (let ((package (symbol-package symbol)))
     (if (null package)
-        `(code "(new Symbol(" ,(dump-string (symbol-name symbol)) "))")
+        `(new (call |Symbol| ,(dump-string (symbol-name symbol))))
         (ls-compile `(intern ,(symbol-name symbol) ,(package-name package))))))
 
 (defun dump-cons (cons)
   (let ((head (butlast cons))
         (tail (last cons)))
-    `(code "QIList("
-           ,@(interleave (mapcar (lambda (x) (literal x t)) head) "," t)
-           ,(literal (car tail) t)
-           ","
-           ,(literal (cdr tail) t)
-           ")")))
+    `(call |QIList|
+           ,@(mapcar (lambda (x) `(code ,(literal x t))) head)
+           (code ,(literal (car tail) t))
+           (code ,(literal (cdr tail) t)))))
 
 (defun dump-array (array)
   (let ((elements (vector-to-list array)))
-    `(code "[" ,(join (mapcar #'literal elements) ", ") "]")))
+    (list-to-vector (mapcar (lambda (x) `(code ,(literal x)))
+                            elements))))
 
 (defun dump-string (string)
-  `(code "make_lisp_string(" ,(js-escape-string string) ")"))
+  `(call |make_lisp_string| ,string))
 
 (defun literal (sexp &optional recursive)
   (cond
@@ -558,11 +558,13 @@
   (literal sexp))
 
 (define-compilation %while (pred &rest body)
-  (js!selfcall
-    "while(" (ls-compile pred) " !== " (ls-compile nil) "){" *newline*
-    `(code ,(ls-compile-block body))
-    "}" *newline*
-    "return " (ls-compile nil) ";" *newline*))
+  (js!selfcall*
+    `(while (!== ,(ls-compile pred) ,(ls-compile nil))
+       0                                ; TODO: Force
+                                        ; braces. Unnecesary when code
+                                        ; is gone
+       (code ,(ls-compile-block body)))
+   `(return ,(ls-compile nil))))
 
 (define-compilation function (x)
   (cond
@@ -1327,20 +1329,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
@@ -1503,7 +1505,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))))