;;;# 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)))))
(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)))
#: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))
(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*
'((#\' . #\')
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
(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--)
(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 " }"))
(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+)
(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)
(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 ") ")
(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)
(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))
-
(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))
(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")
"(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 #\)))
("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)))))
(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")))
;; 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)))))))
(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))))))
HCoop / clinton / parenscript.git / commitdiff