Revert "Functions dump-array, dump-cons and dump-symbol"
authorDavid Vázquez <davazp@gmail.com>
Fri, 26 Apr 2013 22:00:36 +0000 (23:00 +0100)
committerDavid Vázquez <davazp@gmail.com>
Fri, 26 Apr 2013 22:00:36 +0000 (23:00 +0100)
This reverts commit fe12fe5314125084a5960227207cf4d0426460f0.

Conflicts:
src/compiler.lisp

src/compiler.lisp

index 36510f9..4d1cdbd 100644 (file)
 (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) "\""))
-    (t
-     (or (cdr (assoc sexp *literal-table*))
-        (let ((dumped (typecase sexp
-                         (symbol (dump-symbol sexp))
-                         (cons (dump-cons sexp))
-                         (array (dump-array sexp)))))
-           (if recursive
-               dumped
-               (let ((jsvar (genlit)))
-                 (push (cons sexp jsvar) *literal-table*)
-                 (toplevel-compilation (code "var " jsvar " = " dumped))
-                 jsvar)))))))
+    ((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)))))))
 
 (define-compilation quote (sexp)
   (literal sexp))