From: Vladimir Sedach Date: Tue, 30 Dec 2008 21:11:47 +0000 (-0700) Subject: Modified the printer so that PS and PS-INLINE compile and print X-Git-Url: https://git.hcoop.net/clinton/parenscript.git/commitdiff_plain/cb8f8e58295db370220ad7c2f0f3d8d48fdc2442 Modified the printer so that PS and PS-INLINE compile and print Parenscript code at macro-expansion time. Renamed COMPILE-SCRIPT to PS1* and got rid of its output-stream argument. --- diff --git a/docs/reference.lisp b/docs/reference.lisp index 9e0f190..b61fadf 100644 --- a/docs/reference.lisp +++ b/docs/reference.lisp @@ -1237,37 +1237,45 @@ a-variable => aVariable ;;;# The ParenScript Compiler ;;;t \index{compiler} ;;;t \index{ParenScript compiler} -;;;t \index{COMPILE-SCRIPT} ;;;t \index{PS} ;;;t \index{PS*} +;;;t \index{PS1*} ;;;t \index{PS-INLINE} +;;;t \index{PS-INLINE*} ;;;t \index{LISP} -;;;t \index{nested compilation} -; (COMPILE-SCRIPT script-form &key (output-stream nil)) ; (PS &body body) ; (PS* &body body) -; (PS-INLINE &body body) -; (LISP &body lisp-forms) +; (PS1* parenscript-form) +; (PS-INLINE form &optional *js-string-delimiter*) +; (PS-INLINE* form &optional *js-string-delimiter*) + +; (LISP lisp-forms) ; ; body ::= ParenScript statements comprising an implicit `PROGN' -;;; For static ParenScript code, the macros `PS' and `PS-INLINE', -;;; avoid the need to quote the ParenScript expression. `PS*' and -;;; `COMPILE-SCRIPT' evaluate their arguments. All these forms except -;;; for `COMPILE-SCRIPT' treat the given forms as an implicit -;;; `PROGN'. `PS' and `PS*' return a string of the compiled body, -;;; while `COMPILE-SCRIPT' takes an optional output-stream parameter -;;; that can be used to specify a stream to which the generated -;;; JavaScript will be written. `PS-INLINE' generates a string that -;;; can be used in HTML node attributes. - -;;; ParenScript can also call out to arbitrary Lisp code at -;;; compile-time using the special form `LISP'. This is typically used -;;; to insert the values of Lisp special variables into ParenScript -;;; code at compile-time, and can also be used to make nested calls to -;;; the ParenScript compiler, which comes in useful when you want to -;;; use the result of `PS-INLINE' in `PS-HTML' forms, for -;;; example. Alternatively the same thing can be accomplished by -;;; constructing ParenScript programs as lists and passing them to -;;; `PS*' or `COMPILE-SCRIPT'. +;;; For static ParenScript code, the macro `PS' compiles the provided +;;; forms at Common Lisp macro-expansion time. `PS*' and `PS1*' +;;; evaluate their arguments and then compile them. All these forms +;;; except for `PS1*' treat the given forms as an implicit +;;; `PROGN'. + +;;; `PS-INLINE' and `PS-INLINE*' take a single ParenScript form and +;;; output a string starting with "javascript:" that can be used in +;;; HTML node attributes. As well, they provide an argument to bind +;;; the value of *js-string-delimiter* to control the value of the +;;; JavaScript string escape character to be compatible with whatever +;;; the HTML generation mechanism is used (for example, if HTML +;;; strings are delimited using #\', using #\" will avoid conflicts +;;; without requiring the output JavaScript code to be escaped). By +;;; default the value is taken from *js-inline-string-delimiter*. + +;;; ParenScript can also call out to arbitrary Common Lisp code at +;;; code output time using the special form `LISP'. The form provided +;;; to `LISP' is evaluated, and its result is compiled as though it +;;; were ParenScript code. For `PS' and `PS-INLINE', the ParenScript +;;; output code is generated at macro-expansion time, and the `LISP' +;;; statements are inserted inline and have access to the enclosing +;;; Common Lisp lexical environment. `PS*' and `PS1*' evaluate the +;;; `LISP' forms with eval, providing them access to the current +;;; dynamic environment only. diff --git a/src/compilation-interface.lisp b/src/compilation-interface.lisp index bf60a36..e148901 100644 --- a/src/compilation-interface.lisp +++ b/src/compilation-interface.lisp @@ -1,34 +1,35 @@ (in-package :parenscript) -(defun compile-script (ps-form &key (output-stream nil)) - "Compiles the Parenscript form PS-FORM into Javascript. -If OUTPUT-STREAM is NIL, then the result is a string; otherwise code -is output to the OUTPUT-STREAM stream." - (parenscript-print (compile-parenscript-form ps-form :expecting :statement) output-stream)) - (defmacro ps (&body body) - "Given Parenscript forms (an implicit progn), expands to code which -compiles those forms to a JavaScript string." - `(ps* '(progn ,@body))) + "Given Parenscript forms (an implicit progn), compiles those forms +to a JavaScript string at macro-expansion time." + `(concatenate 'string ,@(parenscript-print (compile-parenscript-form `(progn ,@body) :expecting :statement)))) (defmacro ps-doc (&body body) "Expands Parenscript forms in a clean environment." - `(let ((*ps-gensym-counter* 0) - (*ps-special-variables* nil)) - (ps ,@body))) + (let ((*ps-gensym-counter* 0) + (*ps-special-variables* nil)) + (macroexpand-1 `(ps ,@body)))) + +(defun ps1* (ps-form) + (apply #'concatenate 'string + (mapcar (lambda (x) + (if (stringp x) + x + (eval x))) + (parenscript-print (compile-parenscript-form ps-form :expecting :statement))))) (defun ps* (&rest body) "Compiles BODY to a JavaScript string. Body is evaluated." - (compile-script `(progn ,@body))) + (ps1* `(progn ,@body))) (defvar *js-inline-string-delimiter* #\" "Controls the string delimiter char used when compiling Parenscript in ps-inline.") (defun ps-inline* (form &optional (*js-string-delimiter* *js-inline-string-delimiter*)) - (concatenate 'string - "javascript:" - (parenscript-print (compile-parenscript-form form :expecting :statement)))) + (concatenate 'string "javascript:" (ps1* form))) (defmacro ps-inline (form &optional (string-delimiter '*js-inline-string-delimiter*)) - `(ps-inline* ',form ,string-delimiter)) + `(let ((*js-string-delimiter* ,string-delimiter)) + (concatenate 'string "javascript:" ,@(parenscript-print (compile-parenscript-form form :expecting :statement))))) diff --git a/src/deprecated-interface.lisp b/src/deprecated-interface.lisp index 6e160c2..490120d 100644 --- a/src/deprecated-interface.lisp +++ b/src/deprecated-interface.lisp @@ -55,3 +55,9 @@ (defun-js js* ps* (&rest args) (apply #'ps* args)) + +(defun-js compile-script ps1* (ps-form &key (output-stream nil)) + "Compiles the Parenscript form PS-FORM into Javascript. +If OUTPUT-STREAM is NIL, then the result is a string; otherwise code +is output to the OUTPUT-STREAM stream." + (format output-stream "~A" (ps1* ps-form))) diff --git a/src/package.lisp b/src/package.lisp index 7ae55ce..179a715 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -201,6 +201,7 @@ #:ps #:ps-doc #:ps* + #:ps1* #:ps-inline #:ps-inline* diff --git a/src/printer.lisp b/src/printer.lisp index 0aef431..2edd1d0 100644 --- a/src/printer.lisp +++ b/src/printer.lisp @@ -1,22 +1,33 @@ (in-package :parenscript) -(defvar *ps-output-stream*) -(defparameter *indent-level* 0) - -(defmethod parenscript-print (ps-form &optional *ps-output-stream*) - (setf *indent-level* 0) - (flet ((print-ps (form) - (if (and (listp form) (eql 'js-block (car form))) ; ignore top-level block - (loop for (statement . remaining) on (third form) do - (ps-print statement) (psw ";") (when remaining (psw #\Newline))) - (ps-print form)))) - (if *ps-output-stream* - (print-ps ps-form) - (with-output-to-string (*ps-output-stream*) - (print-ps ps-form))))) - -(defun psw (obj) ; parenscript-write - (princ obj *ps-output-stream*)) +(defvar *ps-print-pretty* t) +(defvar *indent-num-spaces* 4) +(defvar *js-string-delimiter* #\' + "Specifies which character should be used for delimiting strings. + +This variable is used when you want to embed the resulting JavaScript +in an html attribute delimited by #\\\" as opposed to #\\', or +vice-versa.") + +(defvar *indent-level*) +(defvar *print-accumulator*) + +(defmethod parenscript-print (form) + (let ((*indent-level* 0) + (*print-accumulator* ())) + (if (and (listp form) (eql 'js-block (car form))) ; ignore top-level block + (loop for (statement . remaining) on (third form) do + (ps-print statement) (psw ";") (when remaining (psw #\Newline))) + (ps-print form)) + (reduce (lambda (acc next-token) + (if (and (stringp next-token) + (stringp (car (last acc)))) + (append (butlast acc) (list (concatenate 'string (car (last acc)) next-token))) + (append acc (list next-token)))) + (cons () (reverse *print-accumulator*))))) + +(defun psw (obj) + (push (if (characterp obj) (string obj) obj) *print-accumulator*)) (defgeneric ps-print% (special-form-name special-form-args)) @@ -33,34 +44,22 @@ arguments, defines a printer for that form using the given body." (defgeneric ps-print (compiled-form)) -(defmethod ps-print ((form null)) ; don't print top-level nils (ex: result of defining macros, etc.) - ) +(defmethod ps-print ((form null))) ; don't print top-level nils (ex: result of defining macros, etc.) (defmethod ps-print ((s symbol)) (assert (keywordp s)) (ps-print (js-translate-symbol s))) (defmethod ps-print ((compiled-form cons)) - "Prints the given compiled ParenScript form starting at the given -indent position." (ps-print% (car compiled-form) (cdr compiled-form))) -;;; indentation -(defvar *ps-print-pretty* t) -(defvar *indent-num-spaces* 4) - (defun newline-and-indent () - (when (and (fresh-line *ps-output-stream*) *ps-print-pretty*) - (loop repeat (* *indent-level* *indent-num-spaces*) - do (psw #\Space)))) - -;;; string literals -(defvar *js-string-delimiter* #\' - "Specifies which character should be used for delimiting strings. - -This variable is used when you want to embed the resulting JavaScript -in an html attribute delimited by #\\\" as opposed to #\\', or -vice-versa.") + (if *ps-print-pretty* + (when (and (stringp (car *print-accumulator*)) + (not (char= #\Newline (char (car *print-accumulator*) (1- (length (car *print-accumulator*)))))) + (psw #\Newline)) + (loop repeat (* *indent-level* *indent-num-spaces*) do (psw #\Space))) + (psw #\Space))) (defparameter *js-lisp-escaped-chars* '((#\' . #\') @@ -79,13 +78,12 @@ vice-versa.") for code = (char-code char) for special = (lisp-special-char-to-js char) do (cond (special (psw #\\) (psw special)) - ((or (<= code #x1f) (>= code #x80)) - (format *ps-output-stream* "\\u~4,'0x" code)) + ((or (<= code #x1f) (>= code #x80)) (psw (format nil "\\u~4,'0x" code))) (t (psw char)))) (psw *js-string-delimiter*))) (defmethod ps-print ((number number)) - (format *ps-output-stream* (if (integerp number) "~S" "~F") number)) + (psw (format nil (if (integerp number) "~S" "~F") number))) ;;; expression and operator precedence rules @@ -103,7 +101,6 @@ vice-versa.") (eval-when (:compile-toplevel :load-toplevel :execute) (defparameter *op-precedence-hash* (make-hash-table :test 'eq)) - ;;; generate the operator precedences from *OP-PRECEDENCES* (let ((precedence 1)) (dolist (ops '((new js-slot-value js-aref) (postfix++ postfix--) @@ -153,7 +150,7 @@ vice-versa.") (defprinter object-literal (&rest slot-definitions) (psw #\{) (loop for ((key . value) . remaining) on slot-definitions do - (format *ps-output-stream* "~A: " (js-translate-symbol key)) + (psw (format nil "~A: " (js-translate-symbol key))) (ps-print value) (when remaining (psw ", "))) (psw " }")) @@ -171,10 +168,10 @@ vice-versa.") (if (>= (expression-precedence arg) precedence) (parenthesize-print arg) (ps-print arg)) - (when remaining (format *ps-output-stream* " ~(~A~) " op)))) + (when remaining (psw (format nil " ~(~A~) " op))))) (defprinter unary-operator (op arg &key prefix space) - (when prefix (format *ps-output-stream* "~(~a~)~:[~; ~]" op space)) + (when prefix (psw (format nil "~(~a~)~:[~; ~]" op space))) (if (> (expression-precedence arg) (op-precedence (case op (+ 'unary+) @@ -182,7 +179,7 @@ vice-versa.") (t op)))) (parenthesize-print arg) (ps-print arg)) - (unless prefix (format *ps-output-stream* "~(~a~)" op))) + (unless prefix (psw (format nil "~(~a~)" op)))) ;;; function and method calls (defprinter js-funcall (fun-designator args) @@ -227,7 +224,7 @@ vice-versa.") (print-fun-def name args body)) (defun print-fun-def (name args body-block) - (format *ps-output-stream* "function ~:[~;~A~](" name (js-translate-symbol name)) + (psw (format nil "function ~:[~;~A~](" name (js-translate-symbol name))) (loop for (arg . remaining) on args do (psw (js-translate-symbol arg)) (when remaining (psw ", "))) (psw ") ") @@ -374,7 +371,7 @@ vice-versa.") (flet ((first-slash-p (string) (and (> (length string) 0) (char= (char string 0) #\/)))) (let ((slash (unless (first-slash-p regex) "/"))) - (format *ps-output-stream* (concatenate 'string slash "~A" slash) regex)))) + (psw (format nil (concatenate 'string slash "~A" slash) regex))))) ;;; conditional compilation (defprinter cc-if (test body-forms) @@ -398,12 +395,14 @@ vice-versa.") (ps-print type)) (psw #\))) +(defprinter js-escape (lisp-form) + (psw `(ps1* ,lisp-form))) + ;;; named statements (macrolet ((def-stmt-printer (&rest stmts) `(progn ,@(mapcar (lambda (stmt) `(defprinter ,(intern (format nil "JS-~a" stmt)) (expr) - (format *ps-output-stream* "~(~a~) " ',stmt) + (psw (format nil "~(~a~) " ',stmt)) (ps-print expr))) stmts)))) (def-stmt-printer throw return)) - diff --git a/src/special-forms.lisp b/src/special-forms.lisp index e2b6ec9..f410e11 100644 --- a/src/special-forms.lisp +++ b/src/special-forms.lisp @@ -788,9 +788,8 @@ pair in `array'." (declare (ignore expecting)) (list 'js-regex (string regex))) -(defpsmacro lisp (&body forms) - "Evaluates the given forms in Common Lisp at ParenScript -macro-expansion time. The value of the last form is treated as a -ParenScript expression and is inserted into the generated Javascript -\(use nil for no-op)." - (eval (cons 'progn forms))) +(define-ps-special-form lisp (expecting lisp-form) + ;; (ps (foo (lisp bar))) is in effect equivalent to (ps* `(foo ,bar)) + ;; when called from inside of ps*, lisp-form has access only to the dynamic environment (like for eval) + (declare (ignore expecting)) + (list 'js-escape lisp-form)) diff --git a/t/package-system-tests.lisp b/t/package-system-tests.lisp index d42858a..f486090 100644 --- a/t/package-system-tests.lisp +++ b/t/package-system-tests.lisp @@ -48,7 +48,7 @@ (test namespace1 () (setf (ps-package-prefix "PSTSTPKG") "prefix_") - (is (string= "prefix_foo;" (normalize-js-code (ps pststpkg::foo))))) + (is (string= "prefix_foo;" (normalize-js-code (ps* 'pststpkg::foo))))) (common-lisp:in-package "PSTSTPKG") diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp index dd96ba7..1dbe3ff 100644 --- a/t/ps-tests.lisp +++ b/t/ps-tests.lisp @@ -68,7 +68,7 @@ x = 2 + sideEffect() + x + 5;") "(function (x) { return x; })(10).toString()") (test no-whitespace-before-dot - (let* ((str (compile-script '(.to-string ((lambda (x) (return x)) 10)))) + (let* ((str (ps1* '(.to-string ((lambda (x) (return x)) 10)))) (dot-pos (position #\. str :test #'char=)) (char-before (elt str (1- dot-pos))) (a-parenthesis #\))) @@ -166,7 +166,7 @@ x = 2 + sideEffect() + x + 5;") ("u0080" . ,(code-char 128)) ;;Character over 127. Actually valid, parenscript escapes them to be sure. ("uABCD" . ,(code-char #xabcd)))));; Really above ascii. (loop for (js-escape . lisp-char) in escapes - for generated = (compile-script `(let* ((x ,(format nil "hello~ahi" lisp-char))))) + for generated = (ps1* `(let* ((x ,(format nil "hello~ahi" lisp-char))))) for wanted = (format nil "var x = 'hello\\~ahi';" js-escape) do (is (string= (normalize-js-code generated) wanted))))) @@ -228,10 +228,10 @@ x = 2 + sideEffect() + x + 5;") (test defun-setf1 (is (and (string= (normalize-js-code (ps:ps (defun (setf some-thing) (new-val i1 i2) - (setf (aref *some-thing* i1 i2) new-val)))) + (setf (aref *some-thing* i1 i2) new-val)))) "function __setf_someThing(newVal, i1, i2) { SOMETHING[i1][i2] = newVal; };") - (string= (let ((ps:*ps-gensym-counter* 0)) (normalize-js-code (ps:ps (setf (some-thing 1 2) "foo")))) - "var _js2 = 1; var _js3 = 2; var _js1 = 'foo'; __setf_someThing(_js1, _js2, _js3);")))) + (string= (normalize-js-code (ps:ps-doc (setf (some-thing 1 2) "foo"))) + "var _js2 = 1; var _js3 = 2; var _js1 = 'foo'; __setf_someThing(_js1, _js2, _js3);")))) (test-ps-js defun-optional1 (defun test-opt (&optional x) (return (if x "yes" "no"))) diff --git a/t/test.lisp b/t/test.lisp index be5acac..c39cef8 100644 --- a/t/test.lisp +++ b/t/test.lisp @@ -43,7 +43,7 @@ ;; is-macro expands its argument again when reporting failures, so ;; the reported temporary js-variables get wrong if we don't evalute first. - (let* ((generated-code (compile-script ',parenscript)) + (let* ((generated-code (ps1* ',parenscript)) (js-code ,javascript)) (is (string= (normalize-js-code generated-code) (normalize-js-code js-code))))))) @@ -52,7 +52,7 @@ (declare (ignore optimize)) `(test ,testname (setf ps:*ps-gensym-counter* 0) - (let* ((generated-code (compile-script ',parenscript)) + (let* ((generated-code (ps1* ',parenscript)) (js-code ,javascript)) (is (string= (normalize-js-code generated-code) (normalize-js-code js-code))))))