Commit cb8f8e58 authored by Vladimir Sedach's avatar Vladimir Sedach
Browse files

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.
parent ce44c98c
......@@ -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.
(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)))))
......@@ -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)))
......@@ -201,6 +201,7 @@
#:ps
#:ps-doc
#:ps*
#:ps1*
#:ps-inline
#:ps-inline*
......
(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))
......@@ -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))
......@@ -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")
......
......@@ -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")))
......
......@@ -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))))))
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment