From: David Vázquez Date: Fri, 26 Apr 2013 22:00:36 +0000 (+0100) Subject: Revert "Functions dump-array, dump-cons and dump-symbol" X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=6786ccd0852ef92bb195b387ad9e434da3353c3b;p=jscl.git Revert "Functions dump-array, dump-cons and dump-symbol" This reverts commit fe12fe5314125084a5960227207cf4d0426460f0. Conflicts: src/compiler.lisp --- diff --git a/src/compiler.lisp b/src/compiler.lisp index 36510f9..4d1cdbd 100644 --- 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) "\"")) - (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))