X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler.lisp;h=3fe2823e8f67d853cc885b1cc6324c72a25b620c;hb=74568bb8cdadfcb6bf5429976b92f3afb748b0c2;hp=61c57a46df2e105f39bc822f52fa670da5132b34;hpb=7ba17946b3b08bf2767f5d2f9f99772e63c7acfe;p=jscl.git diff --git a/src/compiler.lisp b/src/compiler.lisp index 61c57a4..3fe2823 100644 --- a/src/compiler.lisp +++ b/src/compiler.lisp @@ -1,4 +1,4 @@ -;;; compiler.lisp --- +;;; compiler.lisp --- ;; copyright (C) 2012, 2013 David Vazquez ;; Copyright (C) 2012 Raimon Grau @@ -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,7 +524,7 @@ (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)) "))") @@ -558,7 +558,7 @@ ((floatp sexp) (float-to-string sexp)) ((characterp sexp) (code "\"" (escape-string (string sexp)) "\"")) (t - (or (cdr (assoc sexp *literal-table* :test #'equal)) + (or (cdr (assoc sexp *literal-table* :test #'eql)) (let ((dumped (typecase sexp (symbol (dump-symbol sexp)) (string (dump-string sexp)) @@ -1390,6 +1390,9 @@ (define-builtin boundp (x) (js!bool (code "(" x ".value !== undefined)"))) +(define-builtin fboundp (x) + (js!bool (code "(" x ".fvalue !== undefined)"))) + (define-builtin symbol-value (x) (js!selfcall "var symbol = " x ";" *newline* @@ -1609,7 +1612,7 @@ `(%js-vref ,var)))) -#+common-lisp +#-jscl (defvar *macroexpander-cache* (make-hash-table :test #'eq)) @@ -1620,7 +1623,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) @@ -1633,7 +1636,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))) @@ -1667,7 +1670,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)))))