some testing for equal

[jscl.git] / src / compiler.lisp

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 4d1cdbd..94f5c7a 100644 (file)
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -533,50 +533,50 @@
 (defun genlit ()
   (code "l" (incf *literal-counter*)))
 
+(defun dump-symbol (symbol)
+  #+common-lisp
+  (let ((package (symbol-package symbol)))
+    (if (eq package (find-package "KEYWORD"))
+        (code "{name: \"" (escape-string (symbol-name symbol))
+              "\", 'package': '" (package-name package) "'}")
+        (code "{name: \"" (escape-string (symbol-name symbol)) "\"}")))
+  #+jscl
+  (let ((package (symbol-package symbol)))
+    (if (null package)
+        (code "{name: \"" (escape-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("
+          (join-trailing (mapcar (lambda (x) (literal x t)) head) ",")
+          (literal (car tail) t)
+          ","
+          (literal (cdr tail) t)
+          ")")))
+
+(defun dump-array (array)
+  (let ((elements (vector-to-list array)))
+    (concat "[" (join (mapcar #'literal elements) ", ") "]")))
+
 (defun literal (sexp &optional recursive)
   (cond
     ((integerp sexp) (integer-to-string sexp))
     ((floatp sexp) (float-to-string sexp))
     ((stringp sexp) (code "\"" (escape-string sexp) "\""))
-    ((symbolp sexp)
-     (or (cdr (assoc sexp *literal-symbols*))
-        (let ((v (genlit))
-              (s #+common-lisp
-                 (let ((package (symbol-package sexp)))
-                   (if (eq package (find-package "KEYWORD"))
-                       (code "{name: \"" (escape-string (symbol-name sexp))
-                             "\", 'package': '" (package-name package) "'}")
-                       (code "{name: \"" (escape-string (symbol-name sexp)) "\"}")))
-                 #+jscl
-                 (let ((package (symbol-package sexp)))
-                   (if (null package)
-                       (code "{name: \"" (escape-string (symbol-name sexp)) "\"}")
-                       (ls-compile `(intern ,(symbol-name sexp) ,(package-name package)))))))
-          (push (cons sexp v) *literal-symbols*)
-          (toplevel-compilation (code "var " v " = " s))
-          v)))
-    ((consp sexp)
-     (let* ((head (butlast sexp))
-            (tail (last sexp))
-            (c (code "QIList("
-                     (join-trailing (mapcar (lambda (x) (literal x t)) head) ",")
-                     (literal (car tail) t)
-                     ","
-                     (literal (cdr tail) t)
-                     ")")))
-       (if recursive
-          c
-          (let ((v (genlit)))
-             (toplevel-compilation (code "var " v " = " c))
-             v))))
-    ((arrayp sexp)
-     (let ((elements (vector-to-list sexp)))
-       (let ((c (concat "[" (join (mapcar #'literal elements) ", ") "]")))
-        (if recursive
-            c
-            (let ((v (genlit)))
-              (toplevel-compilation (code "var " v " = " c))
-              v)))))))
+    (t
+     (or (cdr (assoc sexp *literal-table*))
+         (let ((dumped (typecase sexp
+                         (symbol (dump-symbol sexp))
+                         (cons (dump-cons sexp))
+                         (array (dump-array sexp)))))
+           (if (and recursive (not (symbolp sexp)))
+               dumped
+               (let ((jsvar (genlit)))
+                 (push (cons sexp jsvar) *literal-table*)
+                 (toplevel-compilation (code "var " jsvar " = " dumped))
+                 jsvar)))))))
 
 (define-compilation quote (sexp)
   (literal sexp))
@@ -1410,7 +1410,6 @@
   (code "(" x ").toString()"))
 
 (define-builtin eq    (x y) (js!bool (code "(" x " === " y ")")))
-(define-builtin equal (x y) (js!bool (code "(" x  " == " y ")")))
 
 (define-builtin char-to-string (x)
   (type-check (("x" "number" x))