X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler.lisp;h=4a274133e68418e58f875825f528b228a9d8e9e2;hb=dfca8efb6fdc56c94d954d0c29eaebafd53aec58;hp=6a0d3e2c864c3921348d4dd5fdb4a148d2bcacea;hpb=66d48cef940c15fff41f02a92ec27a9be801eaa9;p=jscl.git diff --git a/src/compiler.lisp b/src/compiler.lisp index 6a0d3e2..4a27413 100644 --- a/src/compiler.lisp +++ b/src/compiler.lisp @@ -68,7 +68,7 @@ (incf index)) output))) -#+common-lisp +#-jscl (defun indent (&rest string) (with-output-to-string (*standard-output*) (with-input-from-string (input (apply #'code string)) @@ -511,7 +511,7 @@ ;;; evaluated. For this reason we define a valid macro-function for ;;; this symbol. (defvar *magic-unquote-marker* (gensym "MAGIC-UNQUOTE")) -#+common-lisp +#-jscl (setf (macro-function *magic-unquote-marker*) (lambda (form &optional environment) (declare (ignore environment)) @@ -524,11 +524,10 @@ (code "l" (incf *literal-counter*))) (defun dump-symbol (symbol) - #+common-lisp + #-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)) ", " (dump-string (package-name package)) "))") (code "(new Symbol(" (dump-string (symbol-name symbol)) "))"))) #+jscl (let ((package (symbol-package symbol))) @@ -577,6 +576,8 @@ (let ((jsvar (genlit))) (push (cons sexp jsvar) *literal-table*) (toplevel-compilation (code "var " jsvar " = " dumped)) + (when (keywordp sexp) + (toplevel-compilation (code jsvar ".value = " jsvar))) jsvar))))))) @@ -1608,7 +1609,7 @@ `(%js-vref ,var)))) -#+common-lisp +#-jscl (defvar *macroexpander-cache* (make-hash-table :test #'eq)) @@ -1619,7 +1620,7 @@ (if (and b (eq (binding-type b) 'macro)) (let ((expander (binding-value b))) (cond - #+common-lisp + #-jscl ((gethash b *macroexpander-cache*) (setq expander (gethash b *macroexpander-cache*))) ((listp expander) @@ -1632,7 +1633,7 @@ ;; function with the compiled one. ;; #+jscl (setf (binding-value b) compiled) - #+common-lisp (setf (gethash b *macroexpander-cache*) compiled) + #-jscl (setf (gethash b *macroexpander-cache*) compiled) (setq expander compiled)))) expander) nil))) @@ -1666,7 +1667,7 @@ (concat (translate-function function) arglist)) ((and (symbolp function) #+jscl (eq (symbol-package function) (find-package "COMMON-LISP")) - #+common-lisp t) + #-jscl t) (code (ls-compile `',function) ".fvalue" arglist)) (t (code (ls-compile `#',function) arglist)))))