(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))