From 5a69278ca017c4f1fe5c31f540bbed7c5777db84 Mon Sep 17 00:00:00 2001 From: Vladimir Sedach Date: Sat, 9 May 2009 17:24:22 -0600 Subject: [PATCH] Substantially modified the way Parenscript compilation and macro-expansion take place. This gives control of macroexpansion to special forms, and lets Parenscript do things like fake being a Lisp2 (different function and variable namespaces), and overall makes Parenscript compilation look a lot more like CL compilation. --- docs/reference.lisp | 150 ++++++++++----------- parenscript.asd | 2 +- src/compilation-interface.lisp | 47 +++++-- src/compiler.lisp | 177 +++++++++---------------- src/deprecated-interface.lisp | 4 +- src/package.lisp | 4 +- src/special-forms.lisp | 171 +++++++++++++----------- src/utils.lisp | 4 - t/package-system-tests.lisp | 16 +-- t/ps-tests.lisp | 231 ++++++++++++++++++--------------- t/reference-tests.lisp | 144 ++++++++++---------- 11 files changed, 472 insertions(+), 478 deletions(-) diff --git a/docs/reference.lisp b/docs/reference.lisp index fca8684..bc60bd7 100644 --- a/docs/reference.lisp +++ b/docs/reference.lisp @@ -26,14 +26,14 @@ ;;; 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} @@ -45,25 +45,25 @@ ;;; "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} @@ -97,13 +97,13 @@ UNDEFINED UNLESS VAR VOID VOLATILE WHEN WHILE WITH WITH-SLOTS ;;; 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} @@ -113,14 +113,14 @@ UNDEFINED UNLESS VAR VOID VOLATILE WHEN WHILE WITH WITH-SLOTS ;;; 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} @@ -139,26 +139,26 @@ UNDEFINED UNLESS VAR VOID VOLATILE WHEN WHILE WITH WITH-SLOTS ;;; 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 @@ -192,24 +192,24 @@ UNDEFINED UNLESS VAR VOID VOLATILE WHEN WHILE WITH WITH-SLOTS ;;; 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 @@ -235,13 +235,13 @@ UNDEFINED UNLESS VAR VOID VOLATILE WHEN WHILE WITH WITH-SLOTS ;;; 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} @@ -259,26 +259,26 @@ UNDEFINED UNLESS VAR VOID VOLATILE WHEN WHILE WITH WITH-SLOTS ;;; 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} @@ -292,11 +292,11 @@ THIS => this ;;; 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} @@ -317,16 +317,16 @@ a-variable => aVariable ;;; 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} @@ -353,11 +353,11 @@ a-variable => aVariable ;;; 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 @@ -366,31 +366,31 @@ a-variable => aVariable ;;; 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} @@ -418,7 +418,7 @@ a-variable => aVariable ;;; 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. @@ -447,7 +447,7 @@ a-variable => aVariable (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, @@ -456,7 +456,7 @@ a-variable => aVariable (lambda (a b) (return (+ a b))) => function (a, b) { return a + b; - } + }; ;;;# Assignment ;;;t \index{assignment} @@ -550,16 +550,16 @@ a-variable => aVariable (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 @@ -579,9 +579,9 @@ a-variable => aVariable ;;; `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} @@ -607,7 +607,7 @@ a-variable => aVariable ;;; `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)) @@ -616,7 +616,7 @@ a-variable => aVariable alert('blorg is a string: ' + blorg); } else { alert('blorg is not a string'); - } + }; ;;;# Conditional Statements ;;;t \index{conditional statements} @@ -649,10 +649,10 @@ a-variable => aVariable 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. @@ -663,13 +663,13 @@ a-variable => aVariable => 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} @@ -695,7 +695,7 @@ a-variable => aVariable ;;; 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 @@ -878,7 +878,7 @@ a-variable => aVariable ((@ this eat) (new *popcorn))) => while (film.isNotFinished()) { this.eat(new Popcorn); - } + }; ;;;# The `CASE' statement ;;;t \index{CASE} @@ -911,7 +911,7 @@ a-variable => aVariable break; default: alert('default clause'); - } + }; ; (SWITCH case-value clause*) ; clause ::= (value body) | (default body) @@ -928,7 +928,7 @@ a-variable => aVariable 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} @@ -950,7 +950,7 @@ a-variable => aVariable (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} @@ -981,7 +981,7 @@ a-variable => aVariable alert('an error happened: ' + error); } finally { alert('Leaving the try form'); - } + }; ;;;# The HTML Generator ;;;t \index{PS-HTML} @@ -996,10 +996,10 @@ a-variable => aVariable ;;; compiler. The resulting expression is a JavaScript expression. (ps-html ((:a :href "foobar") "blorg")) -=> 'blorg' +=> 'blorg'; (ps-html ((:a :href (generate-a-link)) "blorg")) -=> 'blorg' +=> 'blorg'; ;;; We can recursively call the Parenscript compiler in an HTML ;;; expression. @@ -1007,7 +1007,7 @@ a-variable => aVariable ((@ document write) (ps-html ((:a :href "#" :onclick (ps-inline (transport))) "link"))) -=> document.write('link') +=> document.write('link'); ;;; Forms may be used in attribute lists to conditionally generate ;;; the next attribute. In this example the textarea is sometimes disabled. @@ -1144,7 +1144,7 @@ a-variable => aVariable (return (+ x y))) -> function my_library_libraryFunction(x, y) { return x + y; - } + }; ;;;# Identifier obfuscation ;;;t \index{obfuscation} @@ -1175,7 +1175,7 @@ a-variable => aVariable (+ 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. diff --git a/parenscript.asd b/parenscript.asd index e31b99e..a4857e3 100755 --- a/parenscript.asd +++ b/parenscript.asd @@ -36,7 +36,7 @@ (: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*)) diff --git a/src/compilation-interface.lisp b/src/compilation-interface.lisp index a95c2a9..3c7ea77 100644 --- a/src/compilation-interface.lisp +++ b/src/compilation-interface.lisp @@ -7,6 +7,11 @@ 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) @@ -16,10 +21,7 @@ to a JavaScript string at macro-expansion time." (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) @@ -30,20 +32,41 @@ to a JavaScript string at macro-expansion time." 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))) diff --git a/src/compiler.lisp b/src/compiler.lisp index 0cc8dc7..4fed094 100644 --- a/src/compiler.lisp +++ b/src/compiler.lisp @@ -63,73 +63,42 @@ lexical block.") (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))) @@ -142,14 +111,13 @@ function and the parent macro environment of the macro." (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) @@ -176,14 +144,15 @@ CL environment)." (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) @@ -192,34 +161,24 @@ ParenScript representation. :expecting determines whether the form is 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) () @@ -243,7 +202,11 @@ the form cannot be compiled to a symbol." (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) @@ -261,16 +224,23 @@ the form cannot be compiled to a 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) @@ -309,34 +279,3 @@ gensym-prefix-string)." `(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))) - diff --git a/src/deprecated-interface.lisp b/src/deprecated-interface.lisp index dc1f2f6..4fd569f 100644 --- a/src/deprecated-interface.lisp +++ b/src/deprecated-interface.lisp @@ -56,11 +56,11 @@ (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)) diff --git a/src/package.lisp b/src/package.lisp index 41fbb6a..dee537f 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -222,9 +222,9 @@ #: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 @@ -366,7 +366,7 @@ ) (defpackage "PARENSCRIPT" - (:use "COMMON-LISP") + (:use "COMMON-LISP" "ANAPHORA") (:nicknames "JS" "PS") #.(cons :export *parenscript-lang-exports*) #.(cons :export *parenscript-interface-exports*) diff --git a/src/special-forms.lisp b/src/special-forms.lisp index 4e3acb8..ddbb3f0 100644 --- a/src/special-forms.lisp +++ b/src/special-forms.lisp @@ -1,5 +1,10 @@ (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) @@ -24,14 +29,16 @@ (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 @@ -41,7 +48,7 @@ (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))) @@ -49,10 +56,10 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 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 @@ -61,9 +68,9 @@ 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) @@ -75,10 +82,12 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 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) @@ -93,7 +102,7 @@ `(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) @@ -125,13 +134,14 @@ (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 @@ -338,16 +348,6 @@ lambda-list::= `(%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::= @@ -361,17 +361,39 @@ 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) @@ -389,7 +411,7 @@ lambda-list::= (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) @@ -402,27 +424,20 @@ lambda-list::= ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 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? @@ -453,10 +468,11 @@ lambda-list::= (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) @@ -494,8 +510,8 @@ lambda-list::= (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) '(+ *)) @@ -504,16 +520,13 @@ lambda-list::= `(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)) @@ -542,7 +555,7 @@ lambda-list::= (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? @@ -590,15 +603,15 @@ lambda-list::= ;;; 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) @@ -659,7 +672,7 @@ lambda-list::= (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) @@ -708,7 +721,7 @@ lambda-list::= (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 @@ -720,7 +733,7 @@ The body forms are evaluated only during the given SITUATION. The accepted SITUA 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) diff --git a/src/utils.lisp b/src/utils.lisp index 31c488c..b32d0a7 100644 --- a/src/utils.lisp +++ b/src/utils.lisp @@ -92,10 +92,6 @@ SOMEGLOBAL." (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)))) diff --git a/t/package-system-tests.lisp b/t/package-system-tests.lisp index 2fab062..c5c5a64 100644 --- a/t/package-system-tests.lisp +++ b/t/package-system-tests.lisp @@ -7,7 +7,7 @@ (test-ps-js operator-packages1 (#:new) - "new()") + "new();") (defpackage "PS-TEST.MY-LIBRARY" (:use "PARENSCRIPT")) @@ -18,7 +18,7 @@ (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) @@ -36,7 +36,7 @@ foo.my_library_foo;") (+ 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") @@ -49,7 +49,7 @@ foo.my_library_foo;") (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")) @@ -61,7 +61,7 @@ foo.my_library_foo;") (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;") diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp index 18e0566..a76d321 100644 --- a/t/ps-tests.lisp +++ b/t/ps-tests.lisp @@ -40,50 +40,50 @@ x1 = 2 + sideEffect() + x1 + 5;") (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 #\))) @@ -106,7 +106,7 @@ x1 = 2 + sideEffect() + x1 + 5;") (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. @@ -119,11 +119,11 @@ x1 = 2 + sideEffect() + x1 + 5;") (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) @@ -138,7 +138,7 @@ x1 = 2 + sideEffect() + x1 + 5;") alert('two'); break; default: alert('default clause'); - }") + };") (test-ps-js even-lispier-case @@ -155,7 +155,7 @@ x1 = 2 + sideEffect() + x1 + 5;") alert('Three'); break; default: alert('Something else'); - }") + };") (test-ps-js otherwise-case (case (aref blorg i) @@ -166,7 +166,7 @@ x1 = 2 + sideEffect() + x1 + 5;") alert('one'); break; default: alert('default clause'); - }") + };") (test escape-sequences-in-string (let ((escapes `((#\\ . #\\) @@ -191,11 +191,11 @@ x1 = 2 + sideEffect() + x1 + 5;") (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)))))) @@ -205,15 +205,15 @@ x1 = 2 + sideEffect() + x1 + 5;") (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)) @@ -223,6 +223,11 @@ var _js3_5 = 2; 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")) @@ -247,7 +252,7 @@ __setf_someThing(_js1_6, _js2_4, _js3_5);") x = null; }; return x ? 'yes' : 'no'; -}") +};") (test-ps-js defun-optional2 (defun foo (x &optional y) (+ x y)) @@ -256,7 +261,7 @@ __setf_someThing(_js1_6, _js2_4, _js3_5);") y = null; }; x + y; -}") +};") (test-ps-js defun-optional3 (defun blah (&optional (x 0)) @@ -266,38 +271,39 @@ __setf_someThing(_js1_6, _js2_4, _js3_5);") 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)) @@ -305,55 +311,55 @@ __setf_someThing(_js1_6, _js2_4, _js3_5);") (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))) @@ -363,7 +369,7 @@ __setf_someThing(_js1_6, _js2_4, _js3_5);") bar[i1] = arguments[i1 + 0]; }; alert(bar[1]); -}") +};") (test-ps-js defun-rest2 (defun foo (baz &rest bar) (return (+ baz (aref bar 1)))) @@ -373,7 +379,7 @@ __setf_someThing(_js1_6, _js2_4, _js3_5);") bar[i1] = arguments[i1 + 1]; }; return baz + bar[1]; -}") +};") (test-ps-js defun-keyword1 (defun zoo (foo bar &key baz) (return (+ foo bar baz))) @@ -392,7 +398,7 @@ __setf_someThing(_js1_6, _js2_4, _js3_5);") baz = null; }; return foo + bar + baz; -}") +};") (test-ps-js defun-keyword2 (defun zoo (&key baz) (return (* baz baz))) @@ -411,7 +417,7 @@ __setf_someThing(_js1_6, _js2_4, _js3_5);") baz = null; }; return baz * baz; -}") +};") (test-ps-js defun-keyword3 (defun zoo (&key baz (bar 4)) (return (* baz bar))) @@ -439,7 +445,7 @@ __setf_someThing(_js1_6, _js2_4, _js3_5);") bar = 4; }; return baz * bar; -}") +};") (test-ps-js defun-keyword4 (defun hello-world (&key ((:my-name-key my-name) 1)) @@ -459,25 +465,25 @@ __setf_someThing(_js1_6, _js2_4, _js3_5);") 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) @@ -487,39 +493,39 @@ __setf_someThing(_js1_6, _js2_4, _js3_5);") } 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) @@ -528,11 +534,11 @@ __setf_someThing(_js1_6, _js2_4, _js3_5);") :onclick (ps-inline (transport))) img)) img)) - "document.write(LINKORNOT == 1 ? '' + img + '' : img)") + "document.write(LINKORNOT == 1 ? '' + img + '' : 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))) @@ -565,7 +571,7 @@ __setf_someThing(_js1_6, _js2_4, _js3_5);") (test-ps-js keyword-consistent :x - "'x'") + "'x';") (test-ps-js simple-symbol-macrolet (symbol-macrolet ((x 1)) x) @@ -586,14 +592,14 @@ __setf_someThing(_js1_6, _js2_4, _js3_5);") (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))) @@ -626,7 +632,7 @@ try { (test-ps-js literal2 (aref this x) - "this[x]") + "this[x];") (test-ps-js setf-dec1 (setf x (- 1 x 2)) @@ -638,101 +644,101 @@ try { (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" @@ -740,7 +746,7 @@ try { (:a :href "http://foo.com" symbol) (:span :class "ticker-symbol-popup"))) - "'' + symbol + ''") + "'' + symbol + '';") (test-ps-js flet1 ((lambda () (flet ((foo (x) @@ -751,7 +757,7 @@ try { return x + 1; }; return foo1(1); -})()") +})();") (test-ps-js flet2 (flet ((foo (x) (return (1+ x))) @@ -788,7 +794,7 @@ bar2(foo1(1));") return 0 === x ? 0 : x + foo1(x - 1); }; return foo1(3); -})()") +})();") (test-ps-js labels2 (labels ((foo (x) (return (1+ (bar x)))) @@ -826,19 +832,19 @@ bar2(foo1(1));") }; 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)))))) @@ -859,16 +865,16 @@ bar2(foo1(1));") 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) @@ -926,7 +932,7 @@ x2 + y3;") "function () { var x1; return (x1 = null, x1 + x1); -}") +};") (test-ps-js let*1 (let* ((x 1)) (+ x x)) @@ -979,3 +985,20 @@ x3 + y2;") (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];") diff --git a/t/reference-tests.lisp b/t/reference-tests.lisp index f3f7f88..f749d18 100644 --- a/t/reference-tests.lisp +++ b/t/reference-tests.lisp @@ -9,7 +9,7 @@ (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) @@ -17,78 +17,78 @@ 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" @@ -96,15 +96,15 @@ :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 @@ -113,107 +113,107 @@ (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)) @@ -222,20 +222,20 @@ 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) @@ -286,7 +286,7 @@ __setf_color(_js1_4, _js2_3);") (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")) @@ -295,22 +295,22 @@ var _js1_4 = 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) @@ -320,7 +320,7 @@ _js2_3.style.left = _js1_4;") alert('blorg is a string: ' + blorg); } else { alert('blorg is not a string'); -}") +};") (test-ps-js conditional-statements-1 (if ((@ blorg is-correct)) @@ -331,11 +331,11 @@ _js2_3.style.left = _js1_4;") 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)) @@ -344,18 +344,18 @@ _js2_3.style.left = _js1_4;") "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 @@ -477,7 +477,7 @@ for (var i in obj1) { ((@ this eat) (new *popcorn))) "while (film.isNotFinished()) { this.eat(new Popcorn); -}") +};") (test-ps-js the-case-statement-1 (case (aref blorg i) @@ -494,7 +494,7 @@ for (var i in obj1) { break; default: alert('default clause'); - }") + };") (test-ps-js the-case-statement-2 (switch (aref blorg i) @@ -505,14 +505,14 @@ for (var i in obj1) { 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") @@ -526,21 +526,21 @@ for (var i in obj1) { alert('an error happened: ' + error); } finally { alert('Leaving the try form'); -}") +};") (test-ps-js the-html-generator-1 (ps-html ((:a :href "foobar") "blorg")) - "'blorg'") + "'blorg';") (test-ps-js the-html-generator-2 (ps-html ((:a :href (generate-a-link)) "blorg")) - "'blorg'") + "'blorg';") (test-ps-js the-html-generator-3 ((@ document write) (ps-html ((:a :href "#" :onclick (ps-inline (transport))) "link"))) - "document.write('link')") + "document.write('link');") (test-ps-js the-html-generator-4 (let ((disabled nil) -- 2.20.1