;;; JavaScript constructs whether they are used in an expression
;;; context or a statement context. For example:
-(+ i (if 1 2 3)) => i + (1 ? 2 : 3)
+(+ i (if 1 2 3)) => i + (1 ? 2 : 3);
(if 1 2 3)
=> if (1) {
2;
} else {
3;
- }
+ };
;;;# Symbol conversion
;;;t \index{symbol}
;;; "bang", "what", "hash", "at", "percent", "slash",
;;; "start" and "plus" respectively. The `$' character is untouched.
-!?#@% => bangwhathashatpercent
+!?#@% => bangwhathashatpercent;
;;; The `-' is an indication that the following character should be
;;; converted to uppercase. Thus, `-' separated symbols are converted
;;; to camelcase. The `_' character however is left untouched.
-bla-foo-bar => blaFooBar
+bla-foo-bar => blaFooBar;
;;; If you want a JavaScript symbol beginning with an uppercase, you
;;; can either use a leading `-', which can be misleading in a
;;; mathematical context, or a leading `*'.
-*array => Array
+*array => Array;
;;; A symbol beggining and ending with `+' or `*' is converted to all
;;; uppercase, to signify that this is a constant or a global
;;; variable.
-*global-array* => GLOBALARRAY
+*global-array* => GLOBALARRAY;
;;;## Reserved Keywords
;;;t \index{keyword}
;;; Parenscript supports the standard JavaScript literal
;;; values. Numbers are compiled into JavaScript numbers.
-1 => 1
+1 => 1;
-123.123 => 123.123
+123.123 => 123.123;
;;; Note that the base is not conserved between Lisp and JavaScript.
-#x10 => 16
+#x10 => 16;
;;;## String literals
;;;t \index{string}
;;; Lisp strings are converted into JavaScript literals.
-"foobar" => 'foobar'
+"foobar" => 'foobar';
-"bratzel bub" => 'bratzel bub'
+"bratzel bub" => 'bratzel bub';
;;; Special characters such as newline and backspace are converted
;;; into their corresponding JavaScript escape sequences.
-" " => '\\t'
+" " => '\\t';
;;;## Array literals
;;;t \index{array}
;;; Array literals can be created using the `ARRAY' form.
-(array) => [ ]
+(array) => [ ];
-(array 1 2 3) => [ 1, 2, 3 ]
+(array 1 2 3) => [ 1, 2, 3 ];
(array (array 2 3)
(array "foobar" "bratzel bub"))
-=> [ [ 2, 3 ], [ 'foobar', 'bratzel bub' ] ]
+=> [ [ 2, 3 ], [ 'foobar', 'bratzel bub' ] ];
;;; Arrays can also be created with a call to the `Array' function
;;; using the `MAKE-ARRAY'. The two forms have the exact same semantic
;;; on the JavaScript side.
-(make-array) => new Array()
+(make-array) => new Array();
-(make-array 1 2 3) => new Array(1, 2, 3)
+(make-array 1 2 3) => new Array(1, 2, 3);
(make-array
(make-array 2 3)
(make-array "foobar" "bratzel bub"))
-=> new Array(new Array(2, 3), new Array('foobar', 'bratzel bub'))
+=> new Array(new Array(2, 3), new Array('foobar', 'bratzel bub'));
;;; Indexing arrays in Parenscript is done using the form `AREF'. Note
;;; that JavaScript knows of no such thing as an array. Subscripting
;;; more "lispy", the property names can be keywords.
(create :foo "bar" :blorg 1)
-=> { foo : 'bar', blorg : 1 }
+=> { foo : 'bar', blorg : 1 };
(create :foo "hihi"
:blorg (array 1 2 3)
:another-object (create :schtrunz 1))
=> { foo : 'hihi',
blorg : [ 1, 2, 3 ],
- anotherObject : { schtrunz : 1 } }
+ anotherObject : { schtrunz : 1 } };
;;; Object properties can be accessed using the `SLOT-VALUE' form,
;;; which takes an object and a slot-name.
-(slot-value an-object 'foo) => anObject.foo
+(slot-value an-object 'foo) => anObject.foo;
;;; The convenience macro `@' is provided to make multiple levels of
;;; indirection easy to express
-(@ an-object foo bar) => anObject.foo.bar
+(@ an-object foo bar) => anObject.foo.bar;
;;; The form `WITH-SLOTS' can be used to bind the given slot-name
;;; symbols to a macro that will expand into a `SLOT-VALUE' form at
;;; to use modifiers such as slash-i (case-insensitive) or
;;; slash-g (match-globally (all)).
-(regex "foobar") => /foobar/
+(regex "foobar") => /foobar/;
-(regex "/foobar/i") => /foobar/i
+(regex "/foobar/i") => /foobar/i;
;;; Here CL-INTERPOL proves really useful.
-(regex #?r"/([^\s]+)foobar/i") => /([^\s]+)foobar/i
+(regex #?r"/([^\s]+)foobar/i") => /([^\s]+)foobar/i;
;;;## Literal symbols
;;;t \index{T}
;;; The Lisp symbols `T' and `FALSE' (or `F') are converted to their
;;; JavaScript boolean equivalents `true' and `false'.
-T => true
+T => true;
-FALSE => false
+FALSE => false;
-F => false
+F => false;
;;; The Lisp symbol `NIL' is converted to the JavaScript keyword
;;; `null'.
-NIL => null
+NIL => null;
;;; The Lisp symbol `UNDEFINED' is converted to the JavaScript keyword
;;; `undefined'.
-UNDEFINED => undefined
+UNDEFINED => undefined;
;;; The Lisp symbol `THIS' is converted to the JavaScript keyword
;;; `this'.
-THIS => this
+THIS => this;
;;;# Variables
;;;t \index{variable}
;;; allows the Parenscript programmer to be flexible, as flexible as
;;; JavaScript itself.
-variable => variable
+variable => variable;
-a-variable => aVariable
+a-variable => aVariable;
-*math => Math
+*math => Math;
;;;# Function calls and method calls
;;;t \index{function}
;;; the normal JavaScript function call representation, with the
;;; arguments given in paren after the function name.
-(blorg 1 2) => blorg(1, 2)
+(blorg 1 2) => blorg(1, 2);
(foobar (blorg 1 2) (blabla 3 4) (array 2 3 4))
-=> foobar(blorg(1, 2), blabla(3, 4), [ 2, 3, 4 ])
+=> foobar(blorg(1, 2), blabla(3, 4), [ 2, 3, 4 ]);
-((slot-value this 'blorg) 1 2) => this.blorg(1, 2)
+((slot-value this 'blorg) 1 2) => this.blorg(1, 2);
-((aref foo i) 1 2) => foo[i](1, 2)
+((aref foo i) 1 2) => foo[i](1, 2);
-((slot-value (aref foobar 1) 'blorg) NIL T) => foobar[1].blorg(null, true)
+((slot-value (aref foobar 1) 'blorg) NIL T) => foobar[1].blorg(null, true);
;;;# Operator Expressions
;;;t \index{operator}
;;; JavaScript, Parenscript supports multiple arguments to the
;;; operators.
-(* 1 2) => 1 * 2
+(* 1 2) => 1 * 2;
-(= 1 2) => 1 == 2
+(= 1 2) => 1 == 2;
-(eql 1 2) => 1 == 2
+(eql 1 2) => 1 == 2;
;;; Note that the resulting expression is correctly parenthesized,
;;; according to the JavaScript operator precedence that can be found
;;; http://www.codehouse.com/javascript/precedence/
(* 1 (+ 2 3 4) 4 (/ 6 7))
-=> 1 * (2 + 3 + 4) * 4 * (6 / 7)
+=> 1 * (2 + 3 + 4) * 4 * (6 / 7);
;;; The pre increment and decrement operators are also
;;; available. `INCF' and `DECF' are the pre-incrementing and
;;; pre-decrementing operators. These operators can
;;; take only one argument.
-(incf i) => ++i
+(incf i) => ++i;
-(decf i) => --i
+(decf i) => --i;
;;; The `1+' and `1-' operators are shortforms for adding and
;;; substracting 1.
-(1- i) => i - 1
+(1- i) => i - 1;
-(1+ i) => i + 1
+(1+ i) => i + 1;
;;; The `not' operator actually optimizes the code a bit. If `not' is
;;; used on another boolean-returning operator, the operator is
;;; reversed.
-(not (< i 2)) => i >= 2
+(not (< i 2)) => i >= 2;
-(not (eql i 2)) => i != 2
+(not (eql i 2)) => i != 2;
;;;# Body forms
;;;t \index{body form}
;;; In an expression context:
(+ i (progn (blorg i) (blafoo i)))
-=> i + (blorg(i), blafoo(i))
+=> i + (blorg(i), blafoo(i));
;;; A `PROGN' form doesn't lead to additional indentation or
;;; additional braces around it's body.
(return (+ a b)))
=> function aFunction(a, b) {
return a + b;
- }
+ };
;;; Anonymous functions can be created using the `LAMBDA' form, which
;;; is the same as `DEFUN', but without function name. In fact,
(lambda (a b) (return (+ a b)))
=> function (a, b) {
return a + b;
- }
+ };
;;;# Assignment
;;;t \index{assignment}
(defsetf left (el) (offset)
`(setf (slot-value (slot-value ,el 'style) 'left) ,offset))
-=> null
+=> null;
(setf (left some-div) (+ 123 "px"))
=> var _js2_3 = someDiv;
var _js1_4 = 123 + 'px';
_js2_3.style.left = _js1_4;
-(progn (defmacro left (el)
- `(slot-value ,el 'offset-left))
- (left some-div))
+(macrolet ((left (el)
+ `(slot-value ,el 'offset-left)))
+ (left some-div))
=> someDiv.offsetLeft;
;;;# Single argument statements
;;; `TRY' form. `RETURN' is used to return a value from a function
;;; call.
-(return 1) => return 1
+(return 1) => return 1;
-(throw "foobar") => throw 'foobar'
+(throw "foobar") => throw 'foobar';
;;;# Single argument expression
;;;t \index{single-argument expression}
;;; `VOID', `TYPEOF', `INSTANCEOF' and `NEW'. They all take a
;;; Parenscript expression.
-(delete (new (*foobar 2 3 4))) => delete new Foobar(2, 3, 4)
+(delete (new (*foobar 2 3 4))) => delete new Foobar(2, 3, 4);
(if (= (typeof blorg) *string)
(alert (+ "blorg is a string: " blorg))
alert('blorg is a string: ' + blorg);
} else {
alert('blorg is not a string');
- }
+ };
;;;# Conditional Statements
;;;t \index{conditional statements}
return i;
} else {
alert('blorg is not correct!');
- }
+ };
(+ i (if ((@ blorg add-one)) 1 2))
-=> i + (blorg.addOne() ? 1 : 2)
+=> i + (blorg.addOne() ? 1 : 2);
;;; The `WHEN' and `UNLESS' forms can be used as shortcuts for the
;;; `IF' form.
=> if (blorg.isCorrect()) {
carryOn();
return i;
- }
+ };
(unless ((@ blorg is-correct))
(alert "blorg is not correct!"))
=> if (!blorg.isCorrect()) {
alert('blorg is not correct!');
- }
+ };
;;;# Variable declaration
;;;t \index{variable}
;;; Lisp. Note that the result is undefined if `DEFVAR' is not used as
;;; a top-level form.
-(defvar *a* (array 1 2 3)) => var A = [ 1, 2, 3 ]
+(defvar *a* (array 1 2 3)) => var A = [ 1, 2, 3 ];
;;; One feature present in Parenscript that is not part of Common Lisp
;;; are lexically-scoped global variables, which are declared using
((@ this eat) (new *popcorn)))
=> while (film.isNotFinished()) {
this.eat(new Popcorn);
- }
+ };
;;;# The `CASE' statement
;;;t \index{CASE}
break;
default:
alert('default clause');
- }
+ };
; (SWITCH case-value clause*)
; clause ::= (value body) | (default body)
case 1: alert('If I get here');
case 2: alert('I also get here');
default: alert('I always get here');
- }
+ };
;;;# The `WITH' statement
;;;t \index{WITH}
(alert (+ "i is now intermediary scoped: " i)))
=> with ({ foo : 'foo', i : 'i' }) {
alert('i is now intermediary scoped: ' + i);
- }
+ };
;;;# The `TRY' statement
;;;t \index{TRY}
alert('an error happened: ' + error);
} finally {
alert('Leaving the try form');
- }
+ };
;;;# The HTML Generator
;;;t \index{PS-HTML}
;;; compiler. The resulting expression is a JavaScript expression.
(ps-html ((:a :href "foobar") "blorg"))
-=> '<A HREF=\"foobar\">blorg</A>'
+=> '<A HREF=\"foobar\">blorg</A>';
(ps-html ((:a :href (generate-a-link)) "blorg"))
-=> '<A HREF=\"' + generateALink() + '\">blorg</A>'
+=> '<A HREF=\"' + generateALink() + '\">blorg</A>';
;;; We can recursively call the Parenscript compiler in an HTML
;;; expression.
((@ document write)
(ps-html ((:a :href "#"
:onclick (ps-inline (transport))) "link")))
-=> document.write('<A HREF=\"#\" ONCLICK=\"' + ('javascript:' + 'transport' + '(' + ')') + '\">link</A>')
+=> document.write('<A HREF=\"#\" ONCLICK=\"' + ('javascript:' + 'transport' + '(' + ')') + '\">link</A>');
;;; Forms may be used in attribute lists to conditionally generate
;;; the next attribute. In this example the textarea is sometimes disabled.
(return (+ x y)))
-> function my_library_libraryFunction(x, y) {
return x + y;
- }
+ };
;;;# Identifier obfuscation
;;;t \index{obfuscation}
(+ a (ps-ref.my-library::library-function b ps-ref.obfuscate-me::foo)))
-> function è³±(a, b, è³²) {
a + my_library_libraryFunction(b, è³²);
- }
+ };
;;; The obfuscation and namespace facilities can be used on packages
;;; at the same time.
(:module :runtime
:components ((:file "ps-runtime-lib"))
:depends-on (:src)))
- :depends-on (:cl-ppcre))
+ :depends-on (:cl-ppcre :anaphora))
(defmethod asdf:perform :after ((op asdf:load-op) (system (eql (asdf:find-system :parenscript))))
(pushnew :parenscript cl:*features*))
to a JavaScript string at macro-expansion time."
`(concatenate 'string ,@(parenscript-print (compile-parenscript-form `(progn ,@body) :expecting :statement))))
+(defun ps* (&rest body)
+ "Compiles BODY to a JavaScript string.
+Body is evaluated."
+ (compiled-form-to-string (compile-parenscript-form `(progn ,@body) :expecting :statement)))
+
(defmacro ps-doc (&body body)
"Expands Parenscript forms in a clean environment."
(let ((*ps-gensym-counter* 0)
(defun ps-doc* (ps-form)
(let ((*ps-gensym-counter* 0)
(*ps-special-variables* nil))
- (ps1* ps-form)))
-
-(defun ps1* (ps-form)
- (compiled-form-to-string (compile-parenscript-form ps-form :expecting :statement)))
+ (ps* ps-form)))
(defun compiled-form-to-string (ps-compiled-form)
(with-output-to-string (s)
s))
(parenscript-print ps-compiled-form))))
-
-
-(defun ps* (&rest body)
- "Compiles BODY to a JavaScript string.
-Body is evaluated."
- (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:" (ps1* form)))
+ (concatenate 'string "javascript:" (ps* form)))
(defmacro/ps ps-inline (form &optional (string-delimiter *js-inline-string-delimiter*))
`(concatenate 'string "javascript:"
,@(let ((*js-string-delimiter* string-delimiter))
(parenscript-print (compile-parenscript-form form :expecting :statement)))))
+
+(defvar *ps-read-function* #'read
+ "This should be a function that takes the same inputs and returns the same
+outputs as the common lisp read function. We declare it as a variable to allow
+a user-supplied reader instead of the default lisp reader.")
+
+(defun ps-compile-stream (stream)
+ "Compiles a source stream as if it were a file. Outputs a Javascript string."
+ (let ((*ps-compilation-level* :toplevel)
+ (*package* *package*)
+ (end-read-form '#:unique))
+ (flet ((read-form () (funcall *ps-read-function* stream nil end-read-form)))
+ (let* ((js-string
+ ;; cons up the forms, compiling as we go, and print the result
+ (do ((form (read-form) (read-form))
+ (compiled-forms nil))
+ ((eql form end-read-form)
+ (format nil "~{~A~^;~%~}"
+ (remove-if
+ #'(lambda (x) (or (null x) (= 0 (length x))))
+ (mapcar 'compiled-form-to-string (nreverse compiled-forms)))))
+ (push (compile-parenscript-form form :expecting :statement) compiled-forms))))
+ js-string))))
+
+(defun ps-compile-file (source-file)
+ "Compiles the given Parenscript source file and returns a Javascript string."
+ (with-open-file (stream source-file :direction :input)
+ (ps-compile-stream stream)))
(not (null (op-precedence (first form))))))
(defun funcall-form-p (form)
- (and (listp form)
+ (and form
+ (listp form)
(not (op-form-p form))
(not (ps-special-form-p form))))
;;; macro expansion
(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun make-macro-env-dictionary ()
+ (defun make-macro-dictionary ()
(make-hash-table :test 'eq))
- (defvar *ps-macro-toplevel* (make-macro-env-dictionary)
- "Toplevel macro environment dictionary. Key is the symbol name of
- the macro, value is (symbol-macro-p . expansion-function).")
+
+ (defvar *ps-macro-toplevel* (make-macro-dictionary)
+ "Toplevel macro environment dictionary.")
(defvar *ps-macro-env* (list *ps-macro-toplevel*)
"Current macro environment.")
- (defvar *ps-setf-expanders* (make-macro-env-dictionary)
+ (defvar *ps-symbol-macro-toplevel* (make-macro-dictionary))
+
+ (defvar *ps-symbol-macro-env* (list *ps-symbol-macro-toplevel*))
+
+ (defvar *ps-local-function-names* ())
+
+ (defvar *ps-setf-expanders* (make-macro-dictionary)
"Setf expander dictionary. Key is the symbol of the access
function of the place, value is an expansion function that takes the
arguments of the access functions as a first value and the form to be
stored as the second value.")
- (defparameter *toplevel-compilation-level* :toplevel
+ (defparameter *ps-compilation-level* :toplevel
"This value takes on the following values:
:toplevel indicates that we are traversing toplevel forms.
:inside-toplevel-form indicates that we are inside a call to compile-parenscript-form
-nil indicates we are no longer toplevel-related.")
-
- (defun get-macro-spec (name env-dict)
- "Retrieves the macro spec of the given name with the given environment dictionary.
-SPEC is of the form (symbol-macro-p . expansion-function)."
- (gethash name env-dict))
- (defsetf get-macro-spec (name env-dict)
- (spec)
- `(setf (gethash ,name ,env-dict) ,spec)))
-
-(defun lookup-macro-spec (name &optional (environment *ps-macro-env*))
- "Looks up the macro spec associated with NAME in the given environment. A
-macro spec is of the form (symbol-macro-p . function). Returns two values:
-the SPEC and the parent macro environment.
-
-NAME must be a symbol."
- (when (symbolp name)
- (do ((env environment (cdr env)))
- ((null env) nil)
- (let ((val (get-macro-spec name (car env))))
- (when val
- (return-from lookup-macro-spec
- (values val (or (cdr env)
- (list *ps-macro-toplevel*)))))))))
-
-(defun ps-symbol-macro-p (name &optional (environment *ps-macro-env*))
- "True if there is a Parenscript symbol macro named by the symbol NAME."
- (and (symbolp name) (car (lookup-macro-spec name environment))))
-
-(defun ps-macro-p (name &optional (environment *ps-macro-env*))
- "True if there is a Parenscript macro named by the symbol NAME."
- (and (symbolp name)
- (let ((macro-spec (lookup-macro-spec name environment)))
- (and macro-spec (not (car macro-spec))))))
-
-(defun lookup-macro-expansion-function (name &optional (environment *ps-macro-env*))
- "Lookup NAME in the given macro expansion environment (which
-defaults to the current macro environment). Returns the expansion
-function and the parent macro environment of the macro."
- (multiple-value-bind (macro-spec parent-env)
- (lookup-macro-spec name environment)
- (values (cdr macro-spec) parent-env)))
+nil indicates we are no longer toplevel-related."))
+
+(defun lookup-macro-def (name env)
+ (loop for e in env thereis (gethash name e)))
(defun make-ps-macro-function (args body)
(let* ((whole-var (when (eql '&whole (first args)) (second args)))
(defmacro defpsmacro (name args &body body)
`(progn (undefine-ps-special-form ',name)
- (setf (get-macro-spec ',name *ps-macro-toplevel*)
- (cons nil ,(make-ps-macro-function args body)))
+ (setf (gethash ',name *ps-macro-toplevel*) ,(make-ps-macro-function args body))
',name))
(defmacro define-ps-symbol-macro (symbol expansion)
(let ((x (gensym)))
`(progn (undefine-ps-special-form ',symbol)
- (setf (get-macro-spec ',symbol *ps-macro-toplevel*) (cons t (lambda (,x) (declare (ignore ,x)) ',expansion)))
+ (setf (gethash ',symbol *ps-symbol-macro-toplevel*) (lambda (,x) (declare (ignore ,x)) ',expansion))
',symbol)))
(defun import-macros-from-lisp (&rest names)
(defpsmacro ,name ,args ,@body)))
(defun ps-macroexpand (form)
- "Recursively macroexpands ParenScript macros and symbol-macros in
-the given ParenScript form. Returns two values: the expanded form, and
-whether any expansion was performed on the form or not."
- (let ((macro-function (cond ((ps-symbol-macro-p form) form)
- ((and (consp form) (ps-macro-p (car form))) (car form)))))
- (if macro-function
- (values (ps-macroexpand (funcall (lookup-macro-expansion-function macro-function) form)) t)
- (values form nil))))
+ (aif (or (lookup-macro-def form *ps-symbol-macro-env*)
+ (and (consp form) (lookup-macro-def (car form) *ps-macro-env*)))
+ (values (ps-macroexpand (funcall it form)) t)
+ form))
+
+(defun maybe-rename-local-function (fun-name)
+ (aif (lookup-macro-def fun-name *ps-local-function-names*)
+ it
+ fun-name))
;;;; compiler interface
(defgeneric compile-parenscript-form (form &key expecting)
compiled to an :expression (the default), a :statement, or a
:symbol."))
-(defun adjust-toplevel-compilation-level (form level)
- (let ((default-level (if (eql :toplevel level)
- :inside-toplevel-form
- nil)))
- (if (consp form)
- (case (car form)
- ('progn level)
- (t default-level))
- default-level)))
+(defun adjust-ps-compilation-level (form level)
+ (cond ((or (and (consp form) (eq 'progn (car form)))
+ (and (symbolp form) (eq :toplevel level)))
+ level)
+ ((eq :toplevel level) :inside-toplevel-form)))
(defmethod compile-parenscript-form :around (form &key expecting)
(assert (if expecting (member expecting '(:expression :statement :symbol)) t))
- (if (eql expecting :symbol)
+ (if (eq expecting :symbol)
(compile-to-symbol form)
- (multiple-value-bind (expanded-form expanded-p)
- (ps-macroexpand form)
- (if expanded-p
- (compile-parenscript-form expanded-form :expecting expecting)
- (let ((*toplevel-compilation-level*
- (progn
- (adjust-toplevel-compilation-level form *toplevel-compilation-level*))))
- (call-next-method))))))
+ (let ((*ps-compilation-level* (adjust-ps-compilation-level form *ps-compilation-level*)))
+ (call-next-method))))
(defun compile-to-symbol (form)
"Compiles the given Parenscript form and guarantees that the
resultant symbol has an associated script-package. Raises an error if
the form cannot be compiled to a symbol."
- (let ((exp (compile-parenscript-form form)))
+ (let ((exp (compile-parenscript-form form :expecting :expression)))
(when (eq (first exp) 'js:variable)
(setf exp (second exp)))
(assert (symbolp exp) ()
(compile-parenscript-form (string form)))
(defmethod compile-parenscript-form ((symbol symbol) &key expecting)
- (declare (ignore expecting))
+ (when (eq *ps-compilation-level* :toplevel)
+ (multiple-value-bind (expansion expanded-p)
+ (ps-macroexpand symbol)
+ (when expanded-p
+ (return-from compile-parenscript-form (compile-parenscript-form expansion :expecting expecting)))))
(cond ((keywordp symbol) symbol)
((ps-special-form-p (list symbol))
(if (ps-literal-p symbol)
(t op)))
(defmethod compile-parenscript-form ((form cons) &key (expecting :statement))
- (let* ((name (car form))
- (args (cdr form)))
- (cond ((ps-special-form-p form) (apply (get-ps-special-form name) (cons expecting args)))
+ (multiple-value-bind (form expanded-p)
+ (ps-macroexpand form)
+ (cond (expanded-p (compile-parenscript-form form :expecting expecting))
+ ((ps-special-form-p form) (apply (get-ps-special-form (car form)) (cons expecting (cdr form))))
((op-form-p form)
- `(js:operator
- ,(ps-convert-op-name (compile-parenscript-form (first form) :expecting :symbol))
- ,@(mapcar (lambda (form) (compile-parenscript-form form :expecting :expression)) (rest form))))
+ `(js:operator ,(ps-convert-op-name (compile-parenscript-form (car form) :expecting :symbol))
+ ,@(mapcar (lambda (form)
+ (compile-parenscript-form (ps-macroexpand form) :expecting :expression))
+ (cdr form))))
((funcall-form-p form)
- `(js:funcall ,(compile-parenscript-form name :expecting :expression)
- ,@(mapcar (lambda (arg) (compile-parenscript-form arg :expecting :expression)) args)))
+ `(js:funcall ,(compile-parenscript-form (if (symbolp (car form))
+ (maybe-rename-local-function (car form))
+ (ps-macroexpand (car form)))
+ :expecting :expression)
+ ,@(mapcar (lambda (arg)
+ (compile-parenscript-form (ps-macroexpand arg) :expecting :expression))
+ (cdr form))))
(t (error "Cannot compile ~S to a ParenScript form." form)))))
(defvar *ps-gensym-counter* 0)
`(let* (,,@(mapcar (lambda (g v) ``(,,g ,,v)) gensyms vars))
,(let ,(mapcar (lambda (g v) `(,v ,g)) gensyms vars)
,@body)))))
-
-(defvar *read-function* #'read
- "This should be a function that takes the same inputs and returns the same
-outputs as the common lisp read function. We declare it as a variable to allow
-a user-supplied reader instead of the default lisp reader.")
-
-(defun ps-compile-stream (stream)
- "Compiles a source stream as if it were a file. Outputs a Javascript string."
-
- (let ((*toplevel-compilation-level* :toplevel)
- (*package* *package*)
- (end-read-form '#:unique))
- (flet ((read-form () (funcall *read-function* stream nil end-read-form)))
- (let* ((js-string
- ;; cons up the forms, compiling as we go, and print the result
- (do ((form (read-form) (read-form))
- (compiled-forms nil))
- ((eql form end-read-form)
- (format nil "~{~A~^;~%~}"
- (remove-if
- #'(lambda (x) (or (null x) (= 0 (length x))))
- (mapcar 'compiled-form-to-string (nreverse compiled-forms)))))
- (push (compile-parenscript-form form :expecting :statement) compiled-forms))))
- js-string))))
-
-
-(defun ps-compile-file (source-file)
- "Compiles the given Parenscript source file and returns a Javascript string."
- (with-open-file (stream source-file :direction :input)
- (ps-compile-stream stream)))
-
(defun-js js* ps* (&rest args)
(apply #'ps* args))
-(defun-js compile-script ps1* (ps-form &key (output-stream nil))
+(defun-js compile-script ps* (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)))
+ (format output-stream "~A" (ps* ps-form)))
(defun-js symbol-to-js symbol-to-js-string (symbol)
(symbol-to-js-string symbol))
#:ps-doc
#:ps-doc*
#:ps*
- #:ps1*
#:ps-inline
#:ps-inline*
+ #:*ps-read-function*
#:ps-compile-file
#:ps-compile-stream
;; for parenscript macro definition within lisp
)
(defpackage "PARENSCRIPT"
- (:use "COMMON-LISP")
+ (:use "COMMON-LISP" "ANAPHORA")
(:nicknames "JS" "PS")
#.(cons :export *parenscript-lang-exports*)
#.(cons :export *parenscript-interface-exports*)
(in-package "PARENSCRIPT")
+(defmacro with-local-macro-environment ((var env) &body body)
+ `(let* ((,var (make-macro-dictionary))
+ (,env (cons ,var ,env)))
+ ,@body))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; literals
(defmacro defpsliteral (name string)
(def-for-literal break js:break)
(def-for-literal continue js:continue))
-(defpsmacro quote (x)
- (typecase x
- (cons (cons 'array (mapcar (lambda (x) (when x `',x)) x)))
- (null '(array))
- (keyword x)
- (symbol (symbol-to-js-string x))
- (number x)
- (string x)))
+(define-ps-special-form quote (x)
+ (compile-parenscript-form
+ (typecase x
+ (cons `(array ,@(mapcar (lambda (x) (when x `',x)) x)))
+ (null '(array))
+ (keyword x)
+ (symbol (symbol-to-js-string x))
+ (number x)
+ (string x))
+ :expecting expecting))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; unary operators
(spacep (if (listp op) (second op) nil)))
`(define-ps-special-form ,op (x)
(list 'js:unary-operator ',op
- (compile-parenscript-form x :expecting :expression)
+ (compile-parenscript-form (ps-macroexpand x) :expecting :expression)
:prefix t :space ,spacep))))
ops))))
(def-unary-ops ~ ! (new t) (delete t) (void t) (typeof t)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; statements
(define-ps-special-form return (&optional value)
- `(js:return ,(compile-parenscript-form value :expecting :expression)))
+ `(js:return ,(compile-parenscript-form (ps-macroexpand value) :expecting :expression)))
(define-ps-special-form throw (value)
- `(js:throw ,(compile-parenscript-form value :expecting :expression)))
+ `(js:throw ,(compile-parenscript-form (ps-macroexpand value) :expecting :expression)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; arrays
values)))
(define-ps-special-form aref (array &rest coords)
- `(js:aref ,(compile-parenscript-form array :expecting :expression)
+ `(js:aref ,(compile-parenscript-form (ps-macroexpand array) :expecting :expression)
,(mapcar (lambda (form)
- (compile-parenscript-form form :expecting :expression))
+ (compile-parenscript-form (ps-macroexpand form) :expecting :expression))
coords)))
(defpsmacro list (&rest values)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; operators
(define-ps-special-form incf (x &optional (delta 1))
- (if (eql delta 1)
- `(js:unary-operator js:++ ,(compile-parenscript-form x :expecting :expression) :prefix t)
- `(js:operator js:+= ,(compile-parenscript-form x :expecting :expression)
- ,(compile-parenscript-form delta :expecting :expression))))
+ (let ((x (ps-macroexpand x))
+ (delta (ps-macroexpand delta)))
+ (if (eql delta 1)
+ `(js:unary-operator js:++ ,(compile-parenscript-form x :expecting :expression) :prefix t)
+ `(js:operator js:+= ,(compile-parenscript-form x :expecting :expression)
+ ,(compile-parenscript-form delta :expecting :expression)))))
(define-ps-special-form decf (x &optional (delta 1))
(if (eql delta 1)
`(js:unary-operator js:- ,(compile-parenscript-form first :expecting :expression) :prefix t)))
(define-ps-special-form not (x)
- (let ((form (compile-parenscript-form x :expecting :expression))
+ (let ((form (compile-parenscript-form (ps-macroexpand x) :expecting :expression))
inverse-op)
(if (and (eq (car form) 'js:operator)
(= (length (cddr form)) 2)
(eq 'js:literal (car form)))))
(define-ps-special-form progn (&rest body)
- (if (and (eq expecting :expression) (= 1 (length body)))
- (compile-parenscript-form (car body) :expecting :expression)
- `(,(if (eq expecting :expression) 'js:|,| 'js:block)
- ,@(let* ((block (flatten-blocks (remove nil (mapcar (lambda (form)
- (compile-parenscript-form form :expecting expecting))
- body)))))
- (append (remove-if #'constant-literal-form-p (butlast block)) (last block))))))
+ (let ((body (mapcar #'ps-macroexpand body)))
+ (if (and (eq expecting :expression) (= 1 (length body)))
+ (compile-parenscript-form (car body) :expecting :expression)
+ `(,(if (eq expecting :expression) 'js:|,| 'js:block)
+ ,@(let* ((block (flatten-blocks (remove nil (mapcar (lambda (form)
+ (compile-parenscript-form form :expecting expecting))
+ body)))))
+ (append (remove-if #'constant-literal-form-p (butlast block)) (last block)))))))
(define-ps-special-form cond (&rest clauses)
(ecase expecting
`(%js-defun ,name ,effective-args
,@effective-body)))
-(defvar *defun-setf-name-prefix* "__setf_")
-
-(defpsmacro defun-setf (setf-name lambda-list &body body)
- (let ((mangled-function-name (intern (concatenate 'string *defun-setf-name-prefix* (symbol-name (second setf-name)))
- (symbol-package (second setf-name))))
- (function-args (cdr (ordered-set-difference lambda-list lambda-list-keywords))))
- `(progn (defsetf ,(second setf-name) ,(cdr lambda-list) (store-var)
- `(,',mangled-function-name ,store-var ,@(list ,@function-args)))
- (defun ,mangled-function-name ,lambda-list ,@body))))
-
(defpsmacro lambda (lambda-list &body body)
"An extended defun macro that allows cool things like keyword arguments.
lambda-list::=
`(%js-lambda ,effective-args
,@effective-body)))
-(defpsmacro flet (fn-defs &rest body)
- `(let ,(mapcar (lambda (def) `(,(car def) (lambda ,@(cdr def)))) fn-defs)
- ,@body))
+(define-ps-special-form flet (fn-defs &rest body)
+ (let ((fn-renames (make-macro-dictionary)))
+ (loop for (fn-name . def) in fn-defs do
+ (setf (gethash fn-name fn-renames) (ps-gensym fn-name)))
+ (let ((fn-defs (compile-parenscript-form
+ `(progn ,@(loop for (fn-name . def) in fn-defs collect
+ `(var ,(gethash fn-name fn-renames) (lambda ,@def))))
+ :expecting expecting))
+ (*ps-local-function-names* (cons fn-renames *ps-local-function-names*)))
+ (append fn-defs (cdr (compile-parenscript-form `(progn ,@body) :expecting expecting))))))
+
+(define-ps-special-form labels (fn-defs &rest body)
+ (with-local-macro-environment (local-fn-renames *ps-local-function-names*)
+ (loop for (fn-name . def) in fn-defs do
+ (setf (gethash fn-name local-fn-renames) (ps-gensym fn-name)))
+ (compile-parenscript-form
+ `(progn ,@(loop for (fn-name . def) in fn-defs collect
+ `(var ,(gethash fn-name local-fn-renames) (lambda ,@def)))
+ ,@body)
+ :expecting expecting)))
-(defpsmacro labels (fn-defs &rest body)
- `(symbol-macrolet ,(mapcar (lambda (x) (list (car x) (ps-gensym (car x)))) fn-defs)
- ,@(mapcar (lambda (def) `(var ,(car def) (lambda ,@(cdr def)))) fn-defs)
- ,@body))
+(defvar *defun-setf-name-prefix* "__setf_")
+
+(defpsmacro defun-setf (setf-name lambda-list &body body)
+ (let ((mangled-function-name (intern (concatenate 'string *defun-setf-name-prefix* (symbol-name (second setf-name)))
+ (symbol-package (second setf-name))))
+ (function-args (cdr (ordered-set-difference lambda-list lambda-list-keywords))))
+ (ps* `(defsetf ,(second setf-name) ,(cdr lambda-list) (store-var)
+ `(,',mangled-function-name ,store-var ,@(list ,@function-args))))
+ `(defun ,mangled-function-name ,lambda-list ,@body)))
(defpsmacro defsetf-long (access-fn lambda-list (store-var) form)
- (setf (get-macro-spec access-fn *ps-setf-expanders*)
+ (setf (gethash access-fn *ps-setf-expanders*)
(compile nil
(let ((var-bindings (ordered-set-difference lambda-list lambda-list-keywords)))
`(lambda (access-fn-args store-form)
(defpsmacro defsetf-short (access-fn update-fn &optional docstring)
(declare (ignore docstring))
- (setf (get-macro-spec access-fn *ps-setf-expanders*)
+ (setf (gethash access-fn *ps-setf-expanders*)
(lambda (access-fn-args store-form)
`(,update-fn ,@access-fn-args ,store-form)))
nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; macros
-(defmacro with-temp-macro-environment ((var) &body body)
- `(let* ((,var (make-macro-env-dictionary))
- (*ps-macro-env* (cons ,var *ps-macro-env*)))
- ,@body))
-
(define-ps-special-form macrolet (macros &body body)
- (with-temp-macro-environment (macro-env-dict)
+ (with-local-macro-environment (local-macro-dict *ps-macro-env*)
(dolist (macro macros)
(destructuring-bind (name arglist &body body)
macro
- (setf (get-macro-spec name macro-env-dict)
- (cons nil (eval (make-ps-macro-function arglist body))))))
+ (setf (gethash name local-macro-dict) (eval (make-ps-macro-function arglist body)))))
(compile-parenscript-form `(progn ,@body) :expecting expecting)))
(define-ps-special-form symbol-macrolet (symbol-macros &body body)
- (with-temp-macro-environment (macro-env-dict)
+ (with-local-macro-environment (local-macro-dict *ps-symbol-macro-env*)
(dolist (macro symbol-macros)
(destructuring-bind (name expansion)
macro
- (setf (get-macro-spec name macro-env-dict)
- (cons t (lambda (x) (declare (ignore x)) expansion)))))
+ (setf (gethash name local-macro-dict) (lambda (x) (declare (ignore x)) expansion))))
(compile-parenscript-form `(progn ,@body) :expecting expecting)))
(define-ps-special-form defmacro (name args &body body) ;; should this be a macro?
(cons key (compile-parenscript-form val-expr :expecting :expression))))))
(define-ps-special-form %js-slot-value (obj slot)
- `(js:slot-value ,(compile-parenscript-form obj :expecting :expression)
- ,(if (and (listp slot) (eq 'quote (car slot)))
- (second slot) ;; assume we're quoting a symbol
- (compile-parenscript-form slot))))
+ (let ((slot (ps-macroexpand slot)))
+ `(js:slot-value ,(compile-parenscript-form (ps-macroexpand obj) :expecting :expression)
+ ,(if (and (listp slot) (eq 'quote (car slot)))
+ (second slot) ;; assume we're quoting a symbol
+ (compile-parenscript-form slot)))))
(define-ps-special-form instanceof (value type)
`(js:instanceof ,(compile-parenscript-form value :expecting :expression)
(t nil)))
(define-ps-special-form setf1% (lhs rhs)
- (let ((lhs (compile-parenscript-form lhs :expecting :expression))
- (rhs (compile-parenscript-form rhs :expecting :expression)))
+ (let ((lhs (compile-parenscript-form (ps-macroexpand lhs) :expecting :expression))
+ (rhs (compile-parenscript-form (ps-macroexpand rhs) :expecting :expression)))
(if (and (listp rhs)
(eq 'js:operator (car rhs))
(member (cadr rhs) '(+ *))
`(js:= ,lhs ,rhs))))
(defpsmacro setf (&rest args)
- (flet ((process-setf-clause (place value-form)
- (if (and (listp place) (get-macro-spec (car place) *ps-setf-expanders*))
- (funcall (get-macro-spec (car place) *ps-setf-expanders*) (cdr place) value-form)
- (let ((exp-place (ps-macroexpand place)))
- (if (and (listp exp-place) (get-macro-spec (car exp-place) *ps-setf-expanders*))
- (funcall (get-macro-spec (car exp-place) *ps-setf-expanders*) (cdr exp-place) value-form)
- `(setf1% ,exp-place ,value-form))))))
- (assert (evenp (length args)) ()
- "~s does not have an even number of arguments." (cons 'setf args))
- `(progn ,@(loop for (place value) on args by #'cddr collect (process-setf-clause place value)))))
+ (assert (evenp (length args)) ()
+ "~s does not have an even number of arguments." `(setf ,args))
+ `(progn ,@(loop for (place value) on args by #'cddr collect
+ (let ((place (ps-macroexpand place)))
+ (aif (and (listp place) (gethash (car place) *ps-setf-expanders*))
+ (funcall it (cdr place) value)
+ `(setf1% ,place ,value))))))
(defpsmacro psetf (&rest args)
(let ((places (loop for x in args by #'cddr collect x))
(ecase expecting
(:statement
`(js:var ,name ,@(when value-provided?
- (list (compile-parenscript-form value :expecting :expression)))))
+ (list (compile-parenscript-form (ps-macroexpand value) :expecting :expression)))))
(:expression
(push name *enclosing-lexical-block-declarations*)
(when value-provided?
;;; iteration
(defun make-for-vars/inits (init-forms)
(mapcar (lambda (x)
- (cons (compile-parenscript-form (if (atom x) x (first x)) :expecting :symbol)
- (compile-parenscript-form (if (atom x) nil (second x)) :expecting :expression)))
+ (cons (compile-parenscript-form (ps-macroexpand (if (atom x) x (first x))) :expecting :symbol)
+ (compile-parenscript-form (ps-macroexpand (if (atom x) nil (second x))) :expecting :expression)))
init-forms))
(define-ps-special-form labeled-for (label init-forms cond-forms step-forms &rest body)
`(js:for ,label
,(make-for-vars/inits init-forms)
- ,(mapcar (lambda (x) (compile-parenscript-form x :expecting :expression)) cond-forms)
- ,(mapcar (lambda (x) (compile-parenscript-form x :expecting :expression)) step-forms)
+ ,(mapcar (lambda (x) (compile-parenscript-form (ps-macroexpand x) :expecting :expression)) cond-forms)
+ ,(mapcar (lambda (x) (compile-parenscript-form (ps-macroexpand x) :expecting :expression)) step-forms)
,(compile-parenscript-form `(progn ,@body))))
(defpsmacro for (init-forms cond-forms step-forms &body body)
(define-ps-special-form for-in ((var object) &rest body)
`(js:for-in ,(compile-parenscript-form var :expecting :expression)
- ,(compile-parenscript-form object :expecting :expression)
+ ,(compile-parenscript-form (ps-macroexpand object) :expecting :expression)
,(compile-parenscript-form `(progn ,@body))))
(define-ps-special-form while (test &rest body)
(define-ps-special-form lisp (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)
- `(js:escape (ps1* ,lisp-form)))
+ `(js:escape (compiled-form-to-string (compile-parenscript-form ,lisp-form :expecting ,expecting))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; eval-when
COMMON-LISP code in :compile-toplevel and :load-toplevel sitations, and parenscript code in
:execute. "
(when (and (member :compile-toplevel situation-list)
- (member *toplevel-compilation-level* '(:toplevel :inside-toplevel-form)))
+ (member *ps-compilation-level* '(:toplevel :inside-toplevel-form)))
(eval `(progn ,@body)))
(if (member :execute situation-list)
(compile-parenscript-form `(progn ,@body) :expecting expecting)
(reduce (lambda (list el) (remove el list :test test))
(cons list1 list2)))
-(defmacro aif (test-form then-form &optional else-form)
- `(let ((it ,test-form))
- (if it ,then-form ,else-form)))
-
(defmacro once-only ((&rest names) &body body) ;; the version from PCL
(let ((gensyms (loop for nil in names collect (gensym))))
`(let (,@(loop for g in gensyms collect `(,g (gensym))))
(test-ps-js operator-packages1
(#:new)
- "new()")
+ "new();")
(defpackage "PS-TEST.MY-LIBRARY"
(:use "PARENSCRIPT"))
(return (+ x y)))
"function my_library_libraryFunction(x, y) {
return x + y;
- }")
+ };")
(test-ps-js uniform-symbol-handling1
(progn (create 'ps-test.my-library::foo 1)
(+ a (ps-test.my-library::library-function b ps-test.obfuscate-me::foo)))
"function g1(a, b, g2) {
a + my_library_libraryFunction(b, g2);
-}")
+};")
(defpackage "PS-TEST.OBFUSCATE-AND-PREFIX")
(obfuscate-package "PS-TEST.OBFUSCATE-AND-PREFIX")
(ps-test.my-library::library-function ps-test.my-library::d ps-test.obfuscate-and-prefix::b)))
"function __FOO___g1(a, __FOO___g2, my_library_d) {
a * g1(__FOO___g2, a) * my_library_libraryFunction(my_library_d, __FOO___g2);
-}")
+};")
(defpackage "PS-TEST.PSTSTPKG"
(:use "PARENSCRIPT"))
(common-lisp:in-package "PS-TEST.PSTSTPKG")
(ps-test::test-ps-js namespace-and-special-forms
- (let ((foo (create :bar 1 not-a-keyword something)))
- (return (and (not foo) (+ (slot-value foo bar) some-other-var))))
-"var prefix_foo1 = { bar : 1, prefix_notAKeyword : prefix_something };
-return !prefix_foo1 && prefix_foo1[prefix_bar] + prefix_someOtherVar;")
+ (let ((foo (create bar 1 not-a-keyword something)))
+ (return (and (not foo) (+ (slot-value foo 'bar) some-other-var))))
+"var prefix_foo1 = { prefix_bar : 1, prefix_notAKeyword : prefix_something };
+return !prefix_foo1 && prefix_foo1.prefix_bar + prefix_someOtherVar;")
(test-ps-js method-call-op-form
((@ (+ "" x) to-string))
- "('' + x).toString()")
+ "('' + x).toString();")
(test-ps-js method-call-op-form-args
((@ (+ "" x) to-string) 1 2 :baz 3)
- "('' + x).toString(1, 2, 'baz', 3)")
+ "('' + x).toString(1, 2, 'baz', 3);")
(test-ps-js method-call-number
((@ 10 to-string))
- "( 10 ).toString()")
+ "( 10 ).toString();")
(test-ps-js method-call-string
((@ "hi" to-string))
- "'hi'.toString()")
+ "'hi'.toString();")
(test-ps-js method-call-lit-object
((@ (create :to-string (lambda () (return "it works"))) to-string))
- "( { toString : function () { return 'it works'; } } ).toString()")
+ "( { toString : function () { return 'it works'; } } ).toString();")
(test-ps-js method-call-conditional
((if a x y) 1)
- "(a ? x : y)(1)")
+ "(a ? x : y)(1);")
(test-ps-js method-call-variable
((@ x to-string))
- "x.toString()")
+ "x.toString();")
(test-ps-js method-call-array
((@ (list 10 20) to-string))
- "[ 10, 20 ].toString()")
+ "[ 10, 20 ].toString();")
(test-ps-js method-call-fn-call
((@ (foo) to-string))
- "foo().toString()")
+ "foo().toString();")
(test-ps-js method-call-lambda-fn
((@ (lambda () (alert 10)) to-string))
- "( function () { alert(10); } ).toString()")
+ "( function () { alert(10); } ).toString();")
(test-ps-js method-call-lambda-call
((@ ((lambda (x) (return x)) 10) to-string))
- "(function (x) { return x; })(10).toString()")
+ "(function (x) { return x; })(10).toString();")
(test no-whitespace-before-dot
- (let* ((str (ps1* '((@ ((lambda (x) (return x)) 10) to-string))))
+ (let* ((str (ps* '((@ ((lambda (x) (return x)) 10) to-string))))
(dot-pos (position #\. str :test #'char=))
(char-before (elt str (1- dot-pos)))
(a-parenthesis #\)))
(test-ps-js buggy-slot-value-two
(slot-value foo (get-slot-name))
- "foo[getSlotName()]")
+ "foo[getSlotName()];")
(test-ps-js old-case-is-now-switch
;; Switch was "case" before, but that was very non-lispish.
(1 (alert "one"))
(2 (alert "two"))
(default (alert "default clause")))
- "switch (blorg[i]) {
+ "switch (blorg[i]) {
case 1: alert('one');
case 2: alert('two');
default: alert('default clause');
- }")
+ };")
(test-ps-js lisp-like-case
(case (aref blorg i)
alert('two');
break;
default: alert('default clause');
- }")
+ };")
(test-ps-js even-lispier-case
alert('Three');
break;
default: alert('Something else');
- }")
+ };")
(test-ps-js otherwise-case
(case (aref blorg i)
alert('one');
break;
default: alert('default clause');
- }")
+ };")
(test escape-sequences-in-string
(let ((escapes `((#\\ . #\\)
(test-ps-js slot-value-conditional1
(slot-value (if zoo foo bar) 'x)
- "(zoo ? foo : bar).x")
+ "(zoo ? foo : bar).x;")
(test-ps-js slot-value-conditional2
(slot-value (if (not zoo) foo bar) 'x)
- "(!zoo ? foo : bar).x")
+ "(!zoo ? foo : bar).x;")
(test script-star-eval1
(is (string= "x = 1; y = 2;" (normalize-js-code (ps* '(setf x 1) '(setf y 2))))))
(test-ps-js unquoted-nil
nil
- "null")
+ "null;")
(test-ps-js list-with-single-nil
(array nil)
- "[null]")
+ "[null];")
(test-ps-js quoted-nil-is-array
'nil
- "[]")
+ "[];")
(test-ps-js defsetf1
(progn (defsetf baz (x y) (newval) `(set-baz ,x ,y ,newval))
var _js1_6 = 3;
setBaz(_js2_4, _js3_5, _js1_6);")
+(test-ps-js setf-macroexpands1
+ (macrolet ((baz (x y) `(aref ,x ,y 1)))
+ (setf (baz foo 2) 3))
+ "foo[2][1] = 3;")
+
(test-ps-js defsetf-short
(progn (defsetf baz set-baz "docstring")
(setf (baz 1 2 3) "foo"))
x = null;
};
return x ? 'yes' : 'no';
-}")
+};")
(test-ps-js defun-optional2
(defun foo (x &optional y) (+ x y))
y = null;
};
x + y;
-}")
+};")
(test-ps-js defun-optional3
(defun blah (&optional (x 0))
x = 0;
};
return x;
-}")
+};")
(test-ps-js return-nothing
(return)
- "return null")
+ "return null;")
(test-ps-js set-timeout
(do-set-timeout (10) (alert "foo"))
- "setTimeout(function () { alert('foo'); }, 10)")
+ "setTimeout(function () { alert('foo'); }, 10);")
+
(test-ps-js operator-precedence
(* 3 (+ 4 5) 6)
- "3 * (4 + 5) * 6")
+ "3 * (4 + 5) * 6;")
(test-ps-js operators-1
(in prop obj)
- "prop in obj")
+ "prop in obj;")
(test-ps-js incf1
(incf foo bar)
- "foo += bar")
+ "foo += bar;")
(test-ps-js decf1
(decf foo bar)
- "foo -= bar")
+ "foo -= bar;")
(test-ps-js incf2
(incf x 5)
- "x += 5")
+ "x += 5;")
(test-ps-js decf2
(decf y 10)
- "y -= 10")
+ "y -= 10;")
(test-ps-js setf-conditional
(setf foo (if x 1 2))
(test-ps-js obj-literal-numbers
(create 1 "foo")
- "{ 1 : 'foo' }")
+ "{ 1 : 'foo' };")
(test-ps-js obj-literal-strings
(create "foo" 2)
- "{ 'foo' : 2 }")
+ "{ 'foo' : 2 };")
(test-ps-js slot-value-string
(slot-value foo "bar")
- "foo['bar']")
+ "foo['bar'];")
(test-ps-js slot-value-string1
(slot-value "bar" 'length)
- "'bar'.length")
+ "'bar'.length;")
(test-ps-js slot-value-progn
(slot-value (progn (some-fun "abc") "123") "length")
- "(someFun('abc'), '123')['length']")
+ "(someFun('abc'), '123')['length'];")
(test-ps-js method-call-block
((@ (progn (some-fun "abc") "123") to-string))
- "(someFun('abc'), '123').toString()")
+ "(someFun('abc'), '123').toString();")
(test-ps-js create-blank
(create)
- "{ }")
+ "{ };")
(test-ps-js blank-object-literal
{}
- "{ }")
+ "{ };")
(test-ps-js array-literal1
[]
- "[]")
+ "[];")
(test-ps-js array-literal2
([])
- "[]")
+ "[];")
(test-ps-js array-literal3
([] 1 2 3)
- "[1, 2, 3]")
+ "[1, 2, 3];")
(test-ps-js array-literal4
([] 1 (2 3))
- "[1, [2, 3]]")
+ "[1, [2, 3]];")
(test-ps-js array-literal5
([] (1 2) ("a" "b"))
- "[[1, 2], ['a', 'b']]")
+ "[[1, 2], ['a', 'b']];")
(test-ps-js defun-rest1
(defun foo (&rest bar) (alert (aref bar 1)))
bar[i1] = arguments[i1 + 0];
};
alert(bar[1]);
-}")
+};")
(test-ps-js defun-rest2
(defun foo (baz &rest bar) (return (+ baz (aref bar 1))))
bar[i1] = arguments[i1 + 1];
};
return baz + bar[1];
-}")
+};")
(test-ps-js defun-keyword1
(defun zoo (foo bar &key baz) (return (+ foo bar baz)))
baz = null;
};
return foo + bar + baz;
-}")
+};")
(test-ps-js defun-keyword2
(defun zoo (&key baz) (return (* baz baz)))
baz = null;
};
return baz * baz;
-}")
+};")
(test-ps-js defun-keyword3
(defun zoo (&key baz (bar 4)) (return (* baz bar)))
bar = 4;
};
return baz * bar;
-}")
+};")
(test-ps-js defun-keyword4
(defun hello-world (&key ((:my-name-key my-name) 1))
myName = 1;
};
myName;
-}")
+};")
(test-ps-js keyword-funcall1
(func :baz 1)
- "func('baz', 1)")
+ "func('baz', 1);")
(test-ps-js keyword-funcall2
(func :baz 1 :bar foo)
- "func('baz', 1, 'bar', foo)")
+ "func('baz', 1, 'bar', foo);")
(test-ps-js keyword-funcall3
(fun a b :baz c)
- "fun(a, b, 'baz', c)")
+ "fun(a, b, 'baz', c);")
(test-ps-js cond1
(cond ((= x 1) 1))
"if (x == 1) {
1;
-}")
+};")
(test-ps-js cond2
(cond ((= x 1) 2)
} else if (y == x * 4) {
foo('blah');
x * y;
-}")
+};")
(test-ps-js if-exp-without-else-returns-null
(return (if x 1))
- "return x ? 1 : null")
+ "return x ? 1 : null;")
(test-ps-js progn-expression-single-statement
(return (progn (* x y)))
- "return x * y")
+ "return x * y;")
(test-ps-js cond-expression1
(defun foo () (return (cond ((< 1 2) (bar "foo") (* 4 5)))))
"function foo() {
return 1 < 2 ? (bar('foo'), 4 * 5) : null;
-}")
+};")
(test-ps-js cond-expression2
(defun foo () (return (cond ((< 2 1) "foo") ((= 7 7) "bar"))))
"function foo() {
return 2 < 1 ? 'foo' : (7 == 7 ? 'bar' : null);
-}")
+};")
(test-ps-js cond-expression-final-t-clause
(defun foo () (return (cond ((< 1 2) (bar "foo") (* 4 5)) ((= a b) (+ c d)) ((< 1 2 3 4 5) x) (t "foo"))))
"function foo() {
return 1 < 2 ? (bar('foo'), 4 * 5) : (a == b ? c + d : (1 < 2 < 3 < 4 < 5 ? x : 'foo'));
-}")
+};")
(test-ps-js cond-expression-middle-t-clause ;; should this signal a warning?
(defun foo () (return (cond ((< 2 1) 5) (t "foo") ((< 1 2) "bar"))))
"function foo() {
return 2 < 1 ? 5 : 'foo';
-}")
+};")
(test-ps-js funcall-if-expression
((@ document write)
:onclick (ps-inline (transport)))
img))
img))
- "document.write(LINKORNOT == 1 ? '<A HREF=\"#\" ONCLICK=\"' + ('javascript:' + 'transport' + '(' + ')') + '\">' + img + '</A>' : img)")
+ "document.write(LINKORNOT == 1 ? '<A HREF=\"#\" ONCLICK=\"' + ('javascript:' + 'transport' + '(' + ')') + '\">' + img + '</A>' : img);")
(test-ps-js negate-number-literal ;; ok, this was broken and fixed before, but no one bothered to add the test!
(- 1)
- "-1")
+ "-1;")
(test macro-environment1
(is (string= (normalize-js-code (let* ((macroname (gensym)))
(test-ps-js keyword-consistent
:x
- "'x'")
+ "'x';")
(test-ps-js simple-symbol-macrolet
(symbol-macrolet ((x 1)) x)
(defun f () (return (progn (foo) (if x 1 2))))
"function f() {
return (foo(), x ? 1 : 2);
-}")
+};")
(test-ps-js let-decl-in-expression
(defun f (x) (return (if x 1 (let* ((foo x)) foo))))
"function f(x) {
var foo1;
return x ? 1 : (foo1 = x, foo1);
-}")
+};")
(test-ps-js special-var1
(progn (defvar *foo*) (let* ((*foo* 2)) (* *foo* 2)))
(test-ps-js literal2
(aref this x)
- "this[x]")
+ "this[x];")
(test-ps-js setf-dec1
(setf x (- 1 x 2))
(test-ps-js special-char-equals
blah=
- "blahequals")
+ "blahequals;")
(test-ps-js setf-operator-priority
(return (or (slot-value cache id)
(setf (slot-value cache id) ((@ document get-element-by-id) id))))
- "return cache[id] || (cache[id] = document.getElementById(id))")
+ "return cache[id] || (cache[id] = document.getElementById(id));")
(test-ps-js aref-operator-priority
(aref (if (and x (> (length x) 0))
(aref x 0)
y)
z)
- "(x && x.length > 0 ? x[0] : y)[z]")
+ "(x && x.length > 0 ? x[0] : y)[z];")
(test-ps-js aref-operator-priority1
(aref (or (slot-value x 'y)
(slot-value a 'b))
z)
- "(x.y || a.b)[z]")
+ "(x.y || a.b)[z];")
(test-ps-js aref-operator-priority2
(aref (if a b c) 0)
- "(a ? b : c)[0]")
+ "(a ? b : c)[0];")
(test-ps-js negative-operator-priority
(- (if x y z))
- "-(x ? y : z)")
+ "-(x ? y : z);")
(test-ps-js op-p1
(new (or a b))
- "new (a || b)")
+ "new (a || b);")
(test-ps-js op-p2
(delete (if a (or b c) d))
- "delete (a ? b || c : d)")
+ "delete (a ? b || c : d);")
(test-ps-js op-p3
(not (if (or x (not y)) z))
- "!(x || !y ? z : null)")
+ "!(x || !y ? z : null);")
(test-ps-js op-p4
(- (- (* 1 2) 3))
- "-(1 * 2 - 3)")
+ "-(1 * 2 - 3);")
(test-ps-js op-p5
(instanceof (or a b) (if x y z))
- "((a || b) instanceof (x ? y : z))")
+ "((a || b) instanceof (x ? y : z));")
(test-ps-js op-p7
(or x (if (= x 0) "zero" "empty"))
- "x || (x == 0 ? 'zero' : 'empty')")
+ "x || (x == 0 ? 'zero' : 'empty');")
(test-ps-js named-op-expression
(throw (if a b c))
- "throw a ? b : c")
+ "throw a ? b : c;")
(test-ps-js named-op-expression1
(typeof (or x y))
- "typeof (x || y)")
+ "typeof (x || y);")
(test-ps-js aref-array-expression
(aref (or a b c) 0)
- "(a || b || c)[0]")
+ "(a || b || c)[0];")
(test-ps-js slot-value-operator
(slot-value (or a b c) 'd)
- "(a || b || c).d")
+ "(a || b || c).d;")
(test-ps-js slot-value-parens
(slot-value (slot-value foo 'bar) 'baz)
- "foo.bar.baz")
+ "foo.bar.baz;")
(test-ps-js funcall-funcall
((foo))
- "foo()()")
+ "foo()();")
(test-ps-js expression-funcall
((or (@ window eval) eval) foo nil)
- "(window.eval || eval)(foo, null)")
+ "(window.eval || eval)(foo, null);")
(test-ps-js expression-funcall1
(((or (@ window eval) eval) foo nil))
- "(window.eval || eval)(foo, null)()")
+ "(window.eval || eval)(foo, null)();")
(test-ps-js expression-funcall2
(((or (@ window eval) eval)) foo nil)
- "(window.eval || eval)()(foo, null)")
+ "(window.eval || eval)()(foo, null);")
(test-ps-js slot-value-object-literal
(slot-value (create :a 1) 'a)
- "({ a : 1 }).a")
+ "({ a : 1 }).a;")
(test-ps-js slot-value-lambda
(slot-value (lambda ()) 'prototype)
- "(function () { }).prototype")
+ "(function () { }).prototype;")
(test-ps-js who-html1
(who-ps-html (:span :class "ticker-symbol"
(:a :href "http://foo.com"
symbol)
(:span :class "ticker-symbol-popup")))
- "'<SPAN CLASS=\"ticker-symbol\" TICKER-SYMBOL=\"' + symbol + '\"><A HREF=\"http://foo.com\">' + symbol + '</A><SPAN CLASS=\"ticker-symbol-popup\"></SPAN></SPAN>'")
+ "'<SPAN CLASS=\"ticker-symbol\" TICKER-SYMBOL=\"' + symbol + '\"><A HREF=\"http://foo.com\">' + symbol + '</A><SPAN CLASS=\"ticker-symbol-popup\"></SPAN></SPAN>';")
(test-ps-js flet1
((lambda () (flet ((foo (x)
return x + 1;
};
return foo1(1);
-})()")
+})();")
(test-ps-js flet2
(flet ((foo (x) (return (1+ x)))
return 0 === x ? 0 : x + foo1(x - 1);
};
return foo1(3);
-})()")
+})();")
(test-ps-js labels2
(labels ((foo (x) (return (1+ (bar x))))
};
return z;
})();
-})(true)")
+})(true);")
(test-ps-js math-pi
pi
- "Math.PI")
+ "Math.PI;")
(test-ps-js literal-array
'(1 2 3)
- "[1, 2, 3]")
+ "[1, 2, 3];")
(test-ps-js literal-array-1
'(1 foo 3)
- "[1, 'foo', 3]")
+ "[1, 'foo', 3];")
(test ps-lisp-expands-in-lexical-environment
(is (string= "5;" (let ((x 5)) (ps (lisp x))))))
var bar = -1 == x1_3 ? null : arguments[x1_3 + 1];
var x2_4 = Array.prototype.indexOf.call(arguments, 'baz', 2);
var baz = -1 == x2_4 ? null : arguments[x2_4 + 1];
-}"
+};"
:js-target-version 1.6)
(test-ps-js nested-if-expressions1
(return (if (if x y z) a b))
- "return (x ? y : z) ? a : b")
+ "return (x ? y : z) ? a : b;")
(test-ps-js nested-if-expressions2
(return (if x y (if z a b)))
- "return x ? y : (z ? a : b)")
+ "return x ? y : (z ? a : b);")
(test-ps-js let1
(let (x)
"function () {
var x1;
return (x1 = null, x1 + x1);
-}")
+};")
(test-ps-js let*1
(let* ((x 1)) (+ x x))
(unless (null a)
(1+ a))))
"x = (a1 = foo(), a1 != null ? a1 + 1 : null);")
+
+(test-ps-js symbol-macro-env1
+ (symbol-macrolet ((bar 1))
+ (macrolet ((bar (x y) `(+ ,x ,y)))
+ (bar bar bar)))
+ "1 + 1;")
+
+(test-ps-js symbol-macrolet-fun1
+ (symbol-macrolet ((baz +))
+ (baz 1 2))
+ "baz(1, 2);")
+
+(test-ps-js lisp2-namespaces1
+ (let ((list nil))
+ (setf list (list 1 2 3)))
+ "var list1 = null;
+list1 = [1, 2, 3];")
(test-ps-js statements-and-expressions-1
(+ i (if 1 2 3))
- "i + (1 ? 2 : 3)")
+ "i + (1 ? 2 : 3);")
(test-ps-js statements-and-expressions-2
(if 1 2 3)
2;
} else {
3;
-}")
+};")
(test-ps-js symbol-conversion-1
!?#@%
- "bangwhathashatpercent")
+ "bangwhathashatpercent;")
(test-ps-js symbol-conversion-2
bla-foo-bar
- "blaFooBar")
+ "blaFooBar;")
(test-ps-js symbol-conversion-3
*array
- "Array")
+ "Array;")
(test-ps-js symbol-conversion-4
*global-array*
- "GLOBALARRAY")
+ "GLOBALARRAY;")
(test-ps-js number-literals-1
1
- "1")
+ "1;")
(test-ps-js number-literals-2
123.123
- "123.123")
+ "123.123;")
(test-ps-js number-literals-3
#x10
- "16")
+ "16;")
(test-ps-js string-literals-1
"foobar"
- "'foobar'")
+ "'foobar';")
(test-ps-js string-literals-2
"bratzel bub"
- "'bratzel bub'")
+ "'bratzel bub';")
(test-ps-js string-literals-3
" "
- "'\\t'")
+ "'\\t';")
(test-ps-js array-literals-1
(array)
- "[ ]")
+ "[ ];")
(test-ps-js array-literals-2
(array 1 2 3)
- "[ 1, 2, 3 ]")
+ "[ 1, 2, 3 ];")
(test-ps-js array-literals-3
(array (array 2 3)
(array "foobar" "bratzel bub"))
- "[ [ 2, 3 ], [ 'foobar', 'bratzel bub' ] ]")
+ "[ [ 2, 3 ], [ 'foobar', 'bratzel bub' ] ];")
(test-ps-js array-literals-4
(make-array)
- "new Array()")
+ "new Array();")
(test-ps-js array-literals-5
(make-array 1 2 3)
- "new Array(1, 2, 3)")
+ "new Array(1, 2, 3);")
(test-ps-js array-literals-6
(make-array
(make-array 2 3)
(make-array "foobar" "bratzel bub"))
- "new Array(new Array(2, 3), new Array('foobar', 'bratzel bub'))")
+ "new Array(new Array(2, 3), new Array('foobar', 'bratzel bub'));")
(test-ps-js object-literals-1
(create :foo "bar" :blorg 1)
- "{ foo : 'bar', blorg : 1 }")
+ "{ foo : 'bar', blorg : 1 };")
(test-ps-js object-literals-2
(create :foo "hihi"
:another-object (create :schtrunz 1))
"{ foo : 'hihi',
blorg : [ 1, 2, 3 ],
- anotherObject : { schtrunz : 1 } }")
+ anotherObject : { schtrunz : 1 } };")
(test-ps-js object-literals-3
(slot-value an-object 'foo)
- "anObject.foo")
+ "anObject.foo;")
(test-ps-js object-literals-4
(@ an-object foo bar)
- "anObject.foo.bar")
+ "anObject.foo.bar;")
(test-ps-js object-literals-5
(with-slots (a b c) this
(test-ps-js regular-expression-literals-1
(regex "foobar")
- "/foobar/")
+ "/foobar/;")
(test-ps-js regular-expression-literals-2
(regex "/foobar/i")
- "/foobar/i")
+ "/foobar/i;")
(test-ps-js literal-symbols-1
T
- "true")
+ "true;")
(test-ps-js literal-symbols-2
FALSE
- "false")
+ "false;")
(test-ps-js literal-symbols-3
F
- "false")
+ "false;")
(test-ps-js literal-symbols-4
NIL
- "null")
+ "null;")
(test-ps-js literal-symbols-5
UNDEFINED
- "undefined")
+ "undefined;")
(test-ps-js literal-symbols-6
THIS
- "this")
+ "this;")
(test-ps-js variables-1
variable
- "variable")
+ "variable;")
(test-ps-js variables-2
a-variable
- "aVariable")
+ "aVariable;")
(test-ps-js variables-3
*math
- "Math")
+ "Math;")
(test-ps-js function-calls-and-method-calls-1
(blorg 1 2)
- "blorg(1, 2)")
+ "blorg(1, 2);")
(test-ps-js function-calls-and-method-calls-2
(foobar (blorg 1 2) (blabla 3 4) (array 2 3 4))
- "foobar(blorg(1, 2), blabla(3, 4), [ 2, 3, 4 ])")
+ "foobar(blorg(1, 2), blabla(3, 4), [ 2, 3, 4 ]);")
(test-ps-js function-calls-and-method-calls-3
((slot-value this 'blorg) 1 2)
- "this.blorg(1, 2)")
+ "this.blorg(1, 2);")
(test-ps-js function-calls-and-method-calls-4
((aref foo i) 1 2)
- "foo[i](1, 2)")
+ "foo[i](1, 2);")
(test-ps-js function-calls-and-method-calls-5
((slot-value (aref foobar 1) 'blorg) NIL T)
- "foobar[1].blorg(null, true)")
+ "foobar[1].blorg(null, true);")
(test-ps-js operator-expressions-1
(* 1 2)
- "1 * 2")
+ "1 * 2;")
(test-ps-js operator-expressions-2
(= 1 2)
- "1 == 2")
+ "1 == 2;")
(test-ps-js operator-expressions-3
(eql 1 2)
- "1 == 2")
+ "1 == 2;")
(test-ps-js operator-expressions-4
(* 1 (+ 2 3 4) 4 (/ 6 7))
- "1 * (2 + 3 + 4) * 4 * (6 / 7)")
+ "1 * (2 + 3 + 4) * 4 * (6 / 7);")
(test-ps-js operator-expressions-5
(incf i)
- "++i")
+ "++i;")
(test-ps-js operator-expressions-6
(decf i)
- "--i")
+ "--i;")
(test-ps-js operator-expressions-7
(1- i)
- "i - 1")
+ "i - 1;")
(test-ps-js operator-expressions-8
(1+ i)
- "i + 1")
+ "i + 1;")
(test-ps-js operator-expressions-9
(not (< i 2))
- "i >= 2")
+ "i >= 2;")
(test-ps-js operator-expressions-10
(not (eql i 2))
- "i != 2")
+ "i != 2;")
(test-ps-js body-forms-1
(progn (blorg i) (blafoo i))
(test-ps-js body-forms-2
(+ i (progn (blorg i) (blafoo i)))
- "i + (blorg(i), blafoo(i))")
+ "i + (blorg(i), blafoo(i));")
(test-ps-js function-definition-1
(defun a-function (a b)
(return (+ a b)))
"function aFunction(a, b) {
return a + b;
-}")
+};")
(test-ps-js function-definition-2
(lambda (a b) (return (+ a b)))
"function (a, b) {
return a + b;
-}")
+};")
(test-ps-js assignment-1
(setf a 1)
(test-ps-js assignment-10
(defsetf left (el) (offset)
`(setf (slot-value (slot-value ,el 'style) 'left) ,offset))
- "null")
+ "null;")
(test-ps-js assignment-11
(setf (left some-div) (+ 123 "px"))
_js2_3.style.left = _js1_4;")
(test-ps-js assignment-12
- (progn (defmacro left (el)
- `(slot-value ,el 'offset-left))
- (left some-div))
+ (macrolet ((left (el)
+ `(slot-value ,el 'offset-left)))
+ (left some-div))
"someDiv.offsetLeft;")
(test-ps-js single-argument-statements-1
(return 1)
- "return 1")
+ "return 1;")
(test-ps-js single-argument-statements-2
(throw "foobar")
- "throw 'foobar'")
+ "throw 'foobar';")
(test-ps-js single-argument-expression-1
(delete (new (*foobar 2 3 4)))
- "delete new Foobar(2, 3, 4)")
+ "delete new Foobar(2, 3, 4);")
(test-ps-js single-argument-expression-2
(if (= (typeof blorg) *string)
alert('blorg is a string: ' + blorg);
} else {
alert('blorg is not a string');
-}")
+};")
(test-ps-js conditional-statements-1
(if ((@ blorg is-correct))
return i;
} else {
alert('blorg is not correct!');
-}")
+};")
(test-ps-js conditional-statements-2
(+ i (if ((@ blorg add-one)) 1 2))
- "i + (blorg.addOne() ? 1 : 2)")
+ "i + (blorg.addOne() ? 1 : 2);")
(test-ps-js conditional-statements-3
(when ((@ blorg is-correct))
"if (blorg.isCorrect()) {
carryOn();
return i;
-}")
+};")
(test-ps-js conditional-statements-4
(unless ((@ blorg is-correct))
(alert "blorg is not correct!"))
"if (!blorg.isCorrect()) {
alert('blorg is not correct!');
-}")
+};")
(test-ps-js variable-declaration-1
(defvar *a* (array 1 2 3))
- "var A = [ 1, 2, 3 ]")
+ "var A = [ 1, 2, 3 ];")
(test-ps-js variable-declaration-2
(progn
((@ this eat) (new *popcorn)))
"while (film.isNotFinished()) {
this.eat(new Popcorn);
-}")
+};")
(test-ps-js the-case-statement-1
(case (aref blorg i)
break;
default:
alert('default clause');
- }")
+ };")
(test-ps-js the-case-statement-2
(switch (aref blorg i)
case 1: alert('If I get here');
case 2: alert('I also get here');
default: alert('I always get here');
-}")
+};")
(test-ps-js the-with-statement-1
(with (create :foo "foo" :i "i")
(alert (+ "i is now intermediary scoped: " i)))
"with ({ foo : 'foo', i : 'i' }) {
alert('i is now intermediary scoped: ' + i);
-}")
+};")
(test-ps-js the-try-statement-1
(try (throw "i")
alert('an error happened: ' + error);
} finally {
alert('Leaving the try form');
-}")
+};")
(test-ps-js the-html-generator-1
(ps-html ((:a :href "foobar") "blorg"))
- "'<A HREF=\"foobar\">blorg</A>'")
+ "'<A HREF=\"foobar\">blorg</A>';")
(test-ps-js the-html-generator-2
(ps-html ((:a :href (generate-a-link)) "blorg"))
- "'<A HREF=\"' + generateALink() + '\">blorg</A>'")
+ "'<A HREF=\"' + generateALink() + '\">blorg</A>';")
(test-ps-js the-html-generator-3
((@ document write)
(ps-html ((:a :href "#"
:onclick (ps-inline (transport))) "link")))
- "document.write('<A HREF=\"#\" ONCLICK=\"' + ('javascript:' + 'transport' + '(' + ')') + '\">link</A>')")
+ "document.write('<A HREF=\"#\" ONCLICK=\"' + ('javascript:' + 'transport' + '(' + ')') + '\">link</A>');")
(test-ps-js the-html-generator-4
(let ((disabled nil)
HCoop / clinton / parenscript.git / commitdiff