*array => Array
-;;; The `.' character is left as is in symbols. This allows the
-;;; Parenscript programmer to use a practical shortcut when accessing
-;;; slots or methods of JavaScript objects. Instead of writing
-
-(slot-value foobar 'slot)
-
-;;; we can write
-
-foobar.slot
-
;;; 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*.length => GLOBALARRAY.length
-
;;;## Reserved Keywords
;;;t \index{keyword}
;;;t \index{reserved keywords}
;;; and should not be used as variable names.
! ~ ++ -- * / % + - << >> >>> < > <= >= == != ==== !== & ^ | && || *=
-/= %= += -= <<= >>= >>>= &= ^= |= 1- 1+ ABSTRACT AND AREF ARRAY
+/= %= += -= <<= >>= >>>= &= ^= |= 1- 1+ @ ABSTRACT AND AREF ARRAY
BOOLEAN BREAK BYTE CASE CATCH CC-IF CHAR CLASS COMMA CONST CONTINUE
CREATE DEBUGGER DECF DEFAULT DEFUN DEFVAR DELETE DO DO* DOEACH DOLIST
DOTIMES DOUBLE ELSE ENUM EQL EXPORT EXTENDS F FALSE FINAL FINALLY
FLOAT FLOOR FOR FOR-IN FUNCTION GOTO IF IMPLEMENTS IMPORT IN INCF
-INSTANCEOF INT INTERFACE JS LABELED-FOR LAMBDA LET LET* LEXICAL-LET
-LEXICAL-LET* LISP LIST LONG MAKE-ARRAY NATIVE NEW NIL NOT OR PACKAGE
-PRIVATE PROGN PROTECTED PUBLIC RANDOM REGEX RETURN SETF SHORT
-SLOT-VALUE STATIC SUPER SWITCH SYMBOL-MACROLET SYNCHRONIZED T THIS
-THROW THROWS TRANSIENT TRY TYPEOF UNDEFINED UNLESS VAR VOID VOLATILE
-WHEN WHILE WITH WITH-SLOTS
+INSTANCEOF INT INTERFACE JS LABELED-FOR LAMBDA LET LET* LISP LIST LONG
+MAKE-ARRAY NATIVE NEW NIL NOT OR PACKAGE PRIVATE PROGN PROTECTED
+PUBLIC RANDOM REGEX RETURN SETF SHORT SLOT-VALUE STATIC SUPER SWITCH
+SYMBOL-MACROLET SYNCHRONIZED T THIS THROW THROWS TRANSIENT TRY TYPEOF
+UNDEFINED UNLESS VAR VOID VOLATILE WHEN WHILE WITH WITH-SLOTS
;;;# Literal values
;;;t \index{literal value}
;;;## Object literals
;;;t \index{CREATE}
;;;t \index{SLOT-VALUE}
+;;;t \index{@}
;;;t \index{WITH-SLOTS}
;;;t \index{object literal}
;;;t \index{object}
(slot-value an-object 'foo) => anObject.foo
-;;; A programmer can also use the "." symbol notation explained above.
+;;; The convenience macro `@' is provided to make multiple levels of
+;;; indirection easy to express
-an-object.foo => anObject.foo
+(@ 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
*math => Math
-*math.floor => Math.floor
-
;;;# Function calls and method calls
;;;t \index{function}
;;;t \index{function call}
((slot-value (aref foobar 1) 'blorg) NIL T) => foobar[1].blorg(null, true)
-;;; Note that while most method calls can be abbreviated using the "."
-;;; trick in symbol names (see "Symbol Conversion" above), this is not
-;;; advised due to the fact that "object.function" is treated as a
-;;; symbol distinct from both "object" and "function," which will
-;;; cause problems if Parenscript package prefixes or package
-;;; obfuscation is used.
-
-(this.blorg 1 2) => this.blorg(1, 2)
-
;;;# Operator Expressions
;;;t \index{operator}
;;;t \index{operator expression}
;;; places or variables using a number of temporary variables created
;;; by `PS-GENSYM'. For example:
-(let* ((a 1) (b 2))
+(let ((a 1) (b 2))
(psetf a b b a))
-=> var a = 1;
- var b = 2;
- var _js1 = b;
- var _js2 = a;
- a = _js1;
- b = _js2;
+=> var a1 = 1;
+ var b2 = 2;
+ var _js3_5 = b2;
+ var _js4_6 = a1;
+ a1 = _js3_5;
+ b2 = _js4_6;
;;; The `SETQ' and `PSETQ' forms operate identically to `SETF' and
;;; `PSETF', but throw a compile-time error if the left-hand side form
};
(setf (color some-div) (+ 23 "em"))
-=> var _js2 = someDiv;
- var _js1 = 23 + 'em';
- __setf_color(_js1, _js2);
+=> var _js2_3 = someDiv;
+ var _js1_4 = 23 + 'em';
+ __setf_color(_js1_4, _js2_3);
;;; Note that temporary variables are generated to preserve evaluation
;;; order of the arguments as they would be in Lisp.
=> null
(setf (left some-div) (+ 123 "px"))
-=> var _js2 = someDiv;
- var _js1 = 123 + 'px';
- _js2.style.left = _js1;
+=> var _js2_3 = someDiv;
+ var _js1_4 = 123 + 'px';
+ _js2_3.style.left = _js1_4;
(progn (defmacro left (el)
`(slot-value ,el 'offset-left))
;;; form is used in an expression context, a JavaScript `?', `:'
;;; operator form is generated.
-(if (blorg.is-correct)
+(if ((@ blorg is-correct))
(progn (carry-on) (return i))
(alert "blorg is not correct!"))
=> if (blorg.isCorrect()) {
alert('blorg is not correct!');
}
-(+ i (if (blorg.add-one) 1 2))
+(+ i (if ((@ blorg add-one)) 1 2))
=> i + (blorg.addOne() ? 1 : 2)
;;; The `WHEN' and `UNLESS' forms can be used as shortcuts for the
;;; `IF' form.
-(when (blorg.is-correct)
+(when ((@ blorg is-correct))
(carry-on)
(return i))
=> if (blorg.isCorrect()) {
return i;
}
-(unless (blorg.is-correct)
+(unless ((@ blorg is-correct))
(alert "blorg is not correct!"))
=> if (!blorg.isCorrect()) {
alert('blorg is not correct!');
;;;t \index{VAR}
;;;t \index{LET}
;;;t \index{LET*}
-;;;t \index{LEXICAL-LET}
-;;;t \index{LEXICAL-LET*}
; (DEFVAR var {value}?)
; (VAR var {value}?)
; (LET ({var | (var value)}*) body)
; (LET* ({var | (var value)}*) body)
-; (LEXICAL-LET ({var | (var value)}*) body)
-; (LEXICAL-LET* ({var | (var value)}*) body)
;
; var ::= a Lisp symbol
; value ::= a Parenscript expression
;;; are lexically-scoped global variables, which are declared using
;;; the `VAR' special form.
-;;; Parenscript provides two versions of the `LET' and `LET*' special
-;;; forms for manipulating local variables: `SIMPLE-LET' /
-;;; `SIMPLE-LET*' and `LEXICAL-LET' / `LEXICAL-LET*'. By default,
-;;; `LET' and `LET*' are aliased to `SIMPLE-LET' and `SIMPLE-LET*',
-;;; respectively.
+;;; Parenscript provides the `LET' and `LET*' special forms for
+;;; creating new variable bindings. Both special forms implement
+;;; lexical scope by renaming the provided variables via `GENSYM', and
+;;; implement dynamic binding using `TRY'-`FINALY'. Note that
+;;; top-level `LET' and `LET*' forms will create new global variables.
-;;; `SIMPLE-LET' and `SIMPLE-LET*' bind their variable lists using
-;;; simple JavaScript assignment. This means that you cannot rely on
-;;; the bindings going out of scope at the end of the form.
-
-;;; `LEXICAL-LET' and `LEXICAL-LET*' actually introduce new lexical
-;;; environments for the variable bindings by creating anonymous
-;;; functions.
+;;; Moreover, beware that scoping rules in Lisp and JavaScript are
+;;; quite different. For example, don't rely on closures capturing
+;;; local variables in the way that you would normally expect.
-;;; As you would expect, `SIMPLE-LET' and `LEXICAL-LET' do parallel
-;;; binding of their variable lists, while `SIMPLE-LET*' and
-;;; `LEXICAL-LET*' bind their variable lists sequentially.
;;; examples:
-(simple-let* ((a 0) (b 1))
- (alert (+ a b)))
-=> var a = 0;
- var b = 1;
- alert(a + b);
-
-(simple-let* ((a "World") (b "Hello"))
- (simple-let ((a b) (b a))
- (alert (+ a b))))
-=> var a = 'World';
- var b = 'Hello';
- var _js_a1 = b;
- var _js_b2 = a;
- var a = _js_a1;
- var b = _js_b2;
- delete _js_a1;
- delete _js_b2;
- alert(a + b);
-
-(simple-let* ((a 0) (b 1))
- (lexical-let* ((a 9) (b 8))
- (alert (+ a b)))
- (alert (+ a b)))
-=> var a = 0;
- var b = 1;
- (function () {
- var a = 9;
- var b = 8;
- alert(a + b);
- })();
- alert(a + b);
-
-(simple-let* ((a "World") (b "Hello"))
- (lexical-let ((a b) (b a))
- (alert (+ a b)))
- (alert (+ a b)))
-=> var a = 'World';
- var b = 'Hello';
- (function (a, b) {
- alert(a + b);
- })(b, a);
- alert(a + b);
-
-;;; Moreover, beware that scoping rules in Lisp and JavaScript are
-;;; quite different. For example, don't rely on closures capturing
-;;; local variables in the way that you would normally expect.
+(progn
+ (defvar *a* 4)
+ (let ((x 1)
+ (*a* 2))
+ (let* ((y (+ x 1))
+ (x (+ x y)))
+ (+ *a* x y))))
+=> var A = 4;
+ var x1 = 1;
+ var A2;
+ try {
+ A2 = A;
+ A = 2;
+ var y3 = x1 + 1;
+ var x4 = x1 + y3;
+ A + x4 + y3;
+ } finally {
+ A = A2;
+ };
;;;# Iteration constructs
;;;t \index{iteration}
(do* ((a) b (c (array "a" "b" "c" "d" "e"))
(d 0 (1+ d))
(e (aref c d) (aref c d)))
- ((or (= d c.length) (eql e "x")))
+ ((or (= d (@ c length)) (eql e "x")))
(setf a d b e)
- (document.write (+ "a: " a " b: " b "<br/>")))
+ ((@ document write) (+ "a: " a " b: " b "<br/>")))
=> for (var a = null, b = null, c = ['a', 'b', 'c', 'd', 'e'], d = 0, e = c[d]; !(d == c.length || e == 'x'); d += 1, e = c[d]) {
a = d;
b = e;
document.write('a: ' + a + ' b: ' + b + '<br/>');
};
-;;; `DO' (note the parallel assignment):
+;;; `DO'
(do ((i 0 (1+ i))
(s 0 (+ s i (1+ i))))
((> i 10))
- (document.write (+ "i: " i " s: " s "<br/>")))
-=> var _js_i1 = 0;
- var _js_s2 = 0;
- var i = _js_i1;
- var s = _js_s2;
- delete _js_i1;
- delete _js_s2;
- for (; i <= 10; ) {
- document.write('i: ' + i + ' s: ' + s + '<br/>');
- var _js3 = i + 1;
- var _js4 = s + i + (i + 1);
- i = _js3;
- s = _js4;
+ ((@ document write) (+ "i: " i " s: " s "<br/>")))
+=> var i1 = 0;
+ var s2 = 0;
+ for (; i1 <= 10; ) {
+ document.write('i: ' + i1 + ' s: ' + s2 + '<br/>');
+ var _js3_5 = i1 + 1;
+ var _js4_6 = s2 + i1 + (i1 + 1);
+ i1 = _js3_5;
+ s2 = _js4_6;
};
;;; compare to `DO*':
(do* ((i 0 (1+ i))
(s 0 (+ s i (1- i))))
((> i 10))
- (document.write (+ "i: " i " s: " s "<br/>")))
+ ((@ document write) (+ "i: " i " s: " s "<br/>")))
=> for (var i = 0, s = 0; i <= 10; i += 1, s += i + (i - 1)) {
document.write('i: ' + i + ' s: ' + s + '<br/>');
};
;;; `DOTIMES':
-(let* ((arr (array "a" "b" "c" "d" "e")))
- (dotimes (i arr.length)
- (document.write (+ "i: " i " arr[i]: " (aref arr i) "<br/>"))))
-=> var arr = ['a', 'b', 'c', 'd', 'e'];
- for (var i = 0; i < arr.length; i += 1) {
- document.write('i: ' + i + ' arr[i]: ' + arr[i] + '<br/>');
+(let ((arr (array "a" "b" "c" "d" "e")))
+ (dotimes (i (@ arr length))
+ ((@ document write) (+ "i: " i " arr[i]: " (aref arr i) "<br/>"))))
+=> var arr1 = ['a', 'b', 'c', 'd', 'e'];
+ for (var i = 0; i < arr1.length; i += 1) {
+ document.write('i: ' + i + ' arr[i]: ' + arr1[i] + '<br/>');
};
;;; `DOTIMES' with return value:
-(let* ((res 0))
+(let ((res 0))
(alert (+ "Summation to 10 is "
(dotimes (i 10 res)
(incf res (1+ i))))))
-=> var res = 0;
+=> var res1 = 0;
alert('Summation to 10 is ' + (function () {
for (var i = 0; i < 10; i += 1) {
- res += i + 1;
+ res1 += i + 1;
};
- return res;
+ return res1;
})());
;;; `DOLIST' is like CL:DOLIST, but that it operates on numbered JS
;;; arrays/vectors.
-(let* ((l (list 1 2 4 8 16 32)))
+(let ((l (list 1 2 4 8 16 32)))
(dolist (c l)
- (document.write (+ "c: " c "<br/>"))))
-=> var l = [1, 2, 4, 8, 16, 32];
- for (var c = null, _js_arrvar2 = l, _js_idx1 = 0; _js_idx1 < _js_arrvar2.length; _js_idx1 += 1) {
- c = _js_arrvar2[_js_idx1];
+ ((@ document write) (+ "c: " c "<br/>"))))
+=> var l1 = [1, 2, 4, 8, 16, 32];
+ for (var c = null, _js_arrvar3 = l1, _js_idx2 = 0; _js_idx2 < _js_arrvar3.length; _js_idx2 += 1) {
+ c = _js_arrvar3[_js_idx2];
document.write('c: ' + c + '<br/>');
};
-(let* ((l (list 1 2 4 8 16 32))
- (s 0))
+(let ((l '(1 2 4 8 16 32))
+ (s 0))
(alert (+ "Sum of " l " is: "
(dolist (c l s)
(incf s c)))))
-=> var l = [1, 2, 4, 8, 16, 32];
- var s = 0;
- alert('Sum of ' + l + ' is: ' + (function () {
- for (var c = null, _js_arrvar2 = l, _js_idx1 = 0; _js_idx1 < _js_arrvar2.length; _js_idx1 += 1) {
- c = _js_arrvar2[_js_idx1];
- s += c;
+=> var l1 = [1, 2, 4, 8, 16, 32];
+ var s2 = 0;
+ alert('Sum of ' + l1 + ' is: ' + (function () {
+ for (var c = null, _js_arrvar4 = l1, _js_idx3 = 0; _js_idx3 < _js_arrvar4.length; _js_idx3 += 1) {
+ c = _js_arrvar4[_js_idx3];
+ s2 += c;
};
- return s;
+ return s2;
})());
;;; `FOR-IN' is translated to the JS `for...in' statement.
-(let* ((obj (create :a 1 :b 2 :c 3)))
+(let ((obj (create :a 1 :b 2 :c 3)))
(for-in (i obj)
- (document.write (+ i ": " (aref obj i) "<br/>"))))
-=> var obj = { a : 1, b : 2, c : 3 };
- for (var i in obj) {
- document.write(i + ': ' + obj[i] + '<br/>');
+ ((@ document write) (+ i ": " (aref obj i) "<br/>"))))
+=> var obj1 = { a : 1, b : 2, c : 3 };
+ for (var i in obj1) {
+ document.write(i + ': ' + obj1[i] + '<br/>');
};
;;; The `WHILE' form is transformed to the JavaScript form `while',
;;; and loops until a termination test evaluates to false.
-(while (film.is-not-finished)
- (this.eat (new *popcorn)))
+(while ((@ film is-not-finished))
+ ((@ this eat) (new *popcorn)))
=> while (film.isNotFinished()) {
this.eat(new Popcorn);
}
;;; We can recursively call the Parenscript compiler in an HTML
;;; expression.
-(document.write
+((@ document write)
(ps-html ((:a :href "#"
:onclick (ps-inline (transport))) "link")))
=> 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.
-(let* ((disabled nil)
+(let ((disabled nil)
(authorized t))
- (setf element.inner-h-t-m-l
+ (setf (@ element inner-h-t-m-l)
(ps-html ((:textarea (or disabled (not authorized)) :disabled "disabled")
"Edit me"))))
-=> var disabled = null;
- var authorized = true;
+=> var disabled1 = null;
+ var authorized2 = true;
element.innerHTML =
'<TEXTAREA'
- + (disabled || !authorized ? ' DISABLED=\"' + 'disabled' + '\"' : '')
+ + (disabled1 || !authorized2 ? ' DISABLED=\"' + 'disabled' + '\"' : '')
+ '>Edit me</TEXTAREA>';
;;;# Macrology
(:module :runtime
:components ((:file "ps-runtime-lib"))
:depends-on (:src)))
- :depends-on ())
+ :depends-on (:cl-ppcre))
(defmethod asdf:perform :after ((op asdf:load-op) (system (eql (asdf:find-system :parenscript))))
(pushnew :parenscript cl:*features*))
(:file "reference-tests")
(:file "ps-tests")
(:file "package-system-tests"))))
- :depends-on (:parenscript :fiveam :cl-ppcre))
+ :depends-on (:parenscript :fiveam))
(defmethod asdf:perform ((o test-op) (c (eql (find-system :parenscript.test))))
(asdf:operate 'asdf:load-op :parenscript.test)
(defvar *ps-special-variables* ())
+(defun ps-special-variable-p (sym)
+ (member sym *ps-special-variables*))
+
;;; form predicates
(defun op-form-p (form)
(defvar *ps-gensym-counter* 0)
(defun ps-gensym (&optional (prefix "_js"))
- (make-symbol (format nil "~A~A" prefix (incf *ps-gensym-counter*))))
+ (let ((prefix (if (stringp prefix) prefix (symbol-to-js-string prefix nil))))
+ (make-symbol (format nil "~A~:[~;_~]~A" prefix
+ (digit-char-p (char prefix (1- (length prefix))))
+ (incf *ps-gensym-counter*)))))
(defmacro with-ps-gensyms (symbols &body body)
"Evaluate BODY with SYMBOLS bound to unique ParenScript identifiers.
-(in-package :parenscript)
+(in-package "PARENSCRIPT")
;;; Handy utilities for doing common tasks found in many web browser
;;; JavaScript implementations
`(progn ,@(mapcar (lambda (def) (cons 'defpsmacro def)) mathdefs)))
(def-js-maths
- (max (&rest nums) `(*math.max ,@nums))
- (min (&rest nums) `(*math.min ,@nums))
- (floor (n &optional divisor) `(*math.floor ,(if divisor `(/ ,n ,divisor) n)))
- (ceiling (n &optional divisor) `(*math.ceil ,(if divisor `(/ ,n ,divisor) n)))
- (round (n &optional divisor) `(*math.round ,(if divisor `(/ ,n ,divisor) n)))
- (sin (n) `(*math.sin ,n))
- (cos (n) `(*math.cos ,n))
- (tan (n) `(*math.tan ,n))
- (asin (n) `(*math.asin ,n))
- (acos (n) `(*math.acos ,n))
- (atan (y &optional x) (if x `(*math.atan2 ,y ,x) `(*math.atan ,y)))
+ (max (&rest nums) `((@ *math max) ,@nums))
+ (min (&rest nums) `((@ *math min) ,@nums))
+ (floor (n &optional divisor) `((@ *math floor) ,(if divisor `(/ ,n ,divisor) n)))
+ (ceiling (n &optional divisor) `((@ *math ceil) ,(if divisor `(/ ,n ,divisor) n)))
+ (round (n &optional divisor) `((@ *math round) ,(if divisor `(/ ,n ,divisor) n)))
+ (sin (n) `((@ *math sin) ,n))
+ (cos (n) `((@ *math cos) ,n))
+ (tan (n) `((@ *math tan) ,n))
+ (asin (n) `((@ *math asin) ,n))
+ (acos (n) `((@ *math acos) ,n))
+ (atan (y &optional x) (if x `((@ *math atan2) ,y ,x) `((@ *math atan) ,y)))
(sinh (n) `((lambda (x) (return (/ (- (exp x) (exp (- x))) 2))) ,n))
(cosh (n) `((lambda (x) (return (/ (+ (exp x) (exp (- x))) 2))) ,n))
(tanh (n) `((lambda (x) (return (/ (- (exp x) (exp (- x))) (+ (exp x) (exp (- x)))))) ,n))
(atanh (n) `((lambda (x) (return (/ (- (log (+ 1 x)) (log (- 1 x))) 2))) ,n))
(1+ (n) `(+ ,n 1))
(1- (n) `(- ,n 1))
- (abs (n) `(*math.abs ,n))
+ (abs (n) `((@ *math abs) ,n))
(evenp (n) `(not (oddp ,n)))
(oddp (n) `(% ,n 2))
- (exp (n) `(*math.exp ,n))
- (expt (base power) `(*math.pow ,base ,power))
+ (exp (n) `((@ *math exp) ,n))
+ (expt (base power) `((@ *math pow) ,base ,power))
(log (n &optional base)
- (or (and (null base) `(*math.log ,n))
- (and (numberp base) (= base 10) `(* (log ,n) *math.*log10e*))
+ (or (and (null base) `((@ *math log) ,n))
+ (and (numberp base) (= base 10) `(* (log ,n) (@ *math *log10e*)))
`(/ (log ,n) (log ,base))))
- (sqrt (n) `(*math.sqrt ,n))
+ (sqrt (n) `((@ *math sqrt) ,n))
(random (&optional upto) (if upto
- `(floor (* ,upto (*math.random)))
- '(*math.random))))
+ `(floor (* ,upto ((@ *math random))))
+ '((@ *math random)))))
-(define-ps-symbol-macro pi *math.*pi*)
+(define-ps-symbol-macro pi (@ *math *pi*))
;;; Exception handling
designated package when translating ParenScript code."
`(gethash (find-package ,package) *package-prefix-table*))
-(defun symbol-to-js-string (symbol)
- (let ((symbol-name (symbol-name-to-js-string (maybe-obfuscate-symbol symbol))))
+(defun symbol-to-js-string (symbol &optional (mangle-symbol-name t))
+ (let ((symbol-name (funcall (if mangle-symbol-name
+ #'symbol-name-to-js-string
+ #'symbol-name)
+ (maybe-obfuscate-symbol symbol))))
(aif (ps-package-prefix (symbol-package symbol))
(format nil "~A~A" it symbol-name)
symbol-name)))
#:psetf
#:setq
#:psetq
- #:simple-let*
- #:simple-let
- #:lexical-let*
- #:lexical-let
#:let*
#:let
(ps-print body-block))
(defprinter js:for-in (var object body-block)
- (psw "for (") (ps-print var) (psw " in ")
+ (psw "for (var ") (ps-print var) (psw " in ")
(if (> (expression-precedence object) (op-precedence 'in))
(parenthesize-print object)
(ps-print object))
;;; function definition
(defun compile-function-definition (args body)
(list (mapcar (lambda (arg) (compile-parenscript-form arg :expecting :symbol)) args)
- (let ((*enclosing-lexical-block-declarations* ()))
- ;; the first compilation will produce a list of variables we need to declare in the function body
- (compile-parenscript-form `(progn ,@body) :expecting :statement)
- ;; now declare and compile
- (compile-parenscript-form `(progn
- ,@(mapcar (lambda (var) `(var ,var)) *enclosing-lexical-block-declarations*)
- ,@body)
- :expecting :statement))))
+ (let* ((*enclosing-lexical-block-declarations* ())
+ (body (compile-parenscript-form `(progn ,@body)))
+ (var-decls (compile-parenscript-form
+ `(progn ,@(mapcar (lambda (var) `(var ,var)) *enclosing-lexical-block-declarations*)))))
+ `(js:block ,@(cdr var-decls) ,@(cdr body)))))
(define-ps-special-form %js-lambda (args &rest body)
`(js:lambda ,@(compile-function-definition args body)))
`(progn ,@(loop for (place value) on args by #'cddr collect (process-setf-clause place value)))))
(defpsmacro psetf (&rest args)
- (let ((vars (loop for x in args by #'cddr collect x))
+ (let ((places (loop for x in args by #'cddr collect x))
(vals (loop for x in (cdr args) by #'cddr collect x)))
- (let ((gensyms (mapcar (lambda (x) (declare (ignore x)) (ps-gensym)) vars)))
- `(simple-let* ,(mapcar #'list gensyms vals)
- (setf ,@(mapcan #'list vars gensyms))))))
+ (let ((gensyms (mapcar (lambda (x) (declare (ignore x)) (ps-gensym)) places)))
+ `(let ,(mapcar #'list gensyms vals)
+ (setf ,@(mapcan #'list places gensyms))))))
(defun check-setq-args (args)
(let ((vars (loop for x in args by #'cddr collect x)))
(define-ps-special-form var (name &optional (value (values) value-provided?) documentation)
(declare (ignore documentation))
- `(js:var ,name ,@(when value-provided?
- (list (compile-parenscript-form value :expecting :expression)))))
+ (ecase expecting
+ (:statement
+ `(js:var ,name ,@(when value-provided?
+ (list (compile-parenscript-form value :expecting :expression)))))
+ (:expression
+ (push name *enclosing-lexical-block-declarations*)
+ (when value-provided?
+ (compile-parenscript-form `(setf ,name ,value) :expecting :expression)))))
(defpsmacro defvar (name &optional (value (values) value-provided?) documentation)
- "Note: this must be used as a top-level form, otherwise the result will be undefined behavior."
+ ;; this must be used as a top-level form, otherwise the resulting behavior will be undefined.
+ (declare (ignore documentation))
(pushnew name *ps-special-variables*)
`(var ,name ,@(when value-provided? (list value))))
-(defun make-let-vars (bindings)
- (mapcar (lambda (x) (if (listp x) (car x) x)) bindings))
-
-(defun make-let-vals (bindings)
- (mapcar (lambda (x) (if (or (atom x) (endp (cdr x))) nil (second x))) bindings))
-
-(defpsmacro lexical-let* (bindings &body body)
- `((lambda ()
- (let* ,bindings
- ,@body))))
-
-(defpsmacro lexical-let (bindings &body body)
- `((lambda ,(make-let-vars bindings)
- ,@body)
- ,@(make-let-vals bindings)))
+(defpsmacro let (bindings &body body)
+ (flet ((add-renamed-vars (bindings predicate)
+ (mapcar (lambda (x) (append x (list (ps-gensym (car x)))))
+ (remove-if predicate bindings :key #'car)))
+ (var (x) (first x))
+ (val (x) (second x))
+ (renamed (x) (third x)))
+ (let* ((normalized-bindings (mapcar (lambda (x) (if (symbolp x) `(,x nil) x)) bindings))
+ (lexical-bindings (add-renamed-vars normalized-bindings #'ps-special-variable-p))
+ (dynamic-bindings (add-renamed-vars normalized-bindings (complement #'ps-special-variable-p)))
+ (renamed-body `(symbol-macrolet ,(mapcar (lambda (x) (list (var x) (renamed x)))
+ lexical-bindings)
+ ,@body)))
+ `(progn
+ ,@(mapcar (lambda (x) `(var ,(renamed x) ,(val x))) lexical-bindings)
+ ,(if dynamic-bindings
+ `(progn ,@(mapcar (lambda (x) `(var ,(renamed x))) dynamic-bindings)
+ (try (progn (setf ,@(loop for x in dynamic-bindings append
+ `(,(renamed x) ,(var x)
+ ,(var x) ,(val x))))
+ ,renamed-body)
+ (:finally
+ (setf ,@(mapcan (lambda (x) `(,(var x) ,(renamed x))) dynamic-bindings)))))
+ renamed-body)))))
-(defpsmacro simple-let* (bindings &body body)
+(defpsmacro let* (bindings &body body)
(if bindings
- (let ((var (if (listp (car bindings)) (caar bindings) (car bindings))))
- `(,(if (member var *ps-special-variables*) 'let1-dynamic 'let1) ,(car bindings)
- (simple-let* ,(cdr bindings) ,@body)))
+ `(let (,(car bindings))
+ (let* ,(cdr bindings)
+ ,@body))
`(progn ,@body)))
-(defpsmacro simple-let (bindings &body body)
- (let ((vars (mapcar (lambda (x) (if (atom x) x (first x))) bindings))
- (vals (mapcar (lambda (x) (if (or (atom x) (endp (cdr x))) nil (second x))) bindings)))
- (let ((gensyms (mapcar (lambda (x) (ps-gensym (format nil "_js_~a" x))) vars)))
- `(simple-let* ,(mapcar #'list gensyms vals)
- (simple-let* ,(mapcar #'list vars gensyms)
- ,@(mapcar (lambda (x) `(delete ,x)) gensyms)
- ,@body)))))
-
-(defpsmacro let* (bindings &body body)
- `(simple-let* ,bindings ,@body))
-
-(defpsmacro let (bindings &body body)
- `(,(if (= 1 (length bindings)) 'simple-let* 'simple-let) ,bindings ,@body))
-
-(define-ps-special-form let1 (binding &rest body)
- (ecase expecting
- (:statement
- (compile-parenscript-form `(progn ,(if (atom binding) `(var ,binding) `(var ,@binding)) ,@body) :expecting :statement))
- (:expression
- (let ((var (if (atom binding) binding (car binding)))
- (variable-assignment (when (listp binding) (cons 'setf binding))))
- (push var *enclosing-lexical-block-declarations*)
- (compile-parenscript-form `(progn ,variable-assignment ,@body) :expecting :expression)))))
-
-(defpsmacro let1-dynamic ((var value) &rest body)
- (with-ps-gensyms (temp-stack-var)
- `(progn (var ,temp-stack-var)
- (try (progn (setf ,temp-stack-var ,var)
- (setf ,var ,value)
- ,@body)
- (:finally
- (setf ,var ,temp-stack-var)
- (delete ,temp-stack-var))))))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; iteration
(defun make-for-vars/inits (init-forms)
,(do-make-iter-psteps decls)))))
(define-ps-special-form for-in ((var object) &rest body)
- `(js:for-in ,(compile-parenscript-form `(var ,var) :expecting :expression)
+ `(js:for-in ,(compile-parenscript-form var :expecting :expression)
,(compile-parenscript-form object :expecting :expression)
,(compile-parenscript-form `(progn ,@body))))
;;; Parenscript-style symbol -> Javascript-style symbol
-(defun constant-string-p (string)
- (let ((len (length string))
- (constant-chars '(#\+ #\*)))
- (and (> len 2)
- (member (char string 0) constant-chars)
- (member (char string (1- len)) constant-chars))))
+(defun special-symbol-delimiter? (char)
+ (or (eql char #\+) (eql char #\*)))
+
+(defun special-symbol-name? (string)
+ (nth-value 1 (cl-ppcre:scan-to-strings "[\\*|\\+](.*)[\\*|\\+]([0-9]*)" string)))
(defun first-uppercase-p (string)
(and (> (length string) 1)
- (member (char string 0) '(#\+ #\*))))
+ (special-symbol-delimiter? (char string 0))))
(defun untouchable-string-p (string)
(and (> (length string) 1)
identifier by following transformation heuristics case conversion. For
example, paren-script becomes parenScript, *some-global* becomes
SOMEGLOBAL."
- (when (symbolp symbol)
- (setf symbol (symbol-name symbol)))
- (let ((symbols (string-split symbol '(#\. #\[ #\]) :keep-separators t :remove-empty-subseqs t)))
- (cond ((null symbols) "")
- ((= (length symbols) 1)
- (let (res
- (do-not-touch nil)
- (lowercase t)
- (all-uppercase nil))
- (cond ((constant-string-p symbol)
- (setf all-uppercase t
- symbol (subseq symbol 1 (1- (length symbol)))))
- ((first-uppercase-p symbol)
- (setf lowercase nil
- symbol (subseq symbol 1)))
- ((untouchable-string-p symbol)
- (setf do-not-touch t
- symbol (subseq symbol 1))))
- (flet ((reschar (c)
- (push (cond
- (do-not-touch c)
- ((and lowercase (not all-uppercase))
- (char-downcase c))
- (t (char-upcase c)))
- res)
- (setf lowercase t)))
- (dotimes (i (length symbol))
- (let ((c (char symbol i)))
- (cond
- ((eql c #\-)
- (setf lowercase (not lowercase)))
- ((assoc c *special-chars*)
- (dolist (i (coerce (cdr (assoc c *special-chars*)) 'list))
- (reschar i)))
- (t (reschar c))))))
- (coerce (nreverse res) 'string)))
- (t (string-join (mapcar #'symbol-name-to-js-string symbols) "")))))
+ (let ((sym-name (string symbol))
+ res
+ (do-not-touch nil)
+ (lowercase t)
+ (all-uppercase nil))
+ (when (and (not (eq symbol '[]))
+ (find-if (lambda (x) (member x '(#\. #\[ #\]))) sym-name))
+ (warn "Symbol ~A contains one of '.[]' - this compound naming convention is no longer supported by Parenscript!"
+ symbol))
+ (cond ((special-symbol-name? sym-name)
+ (setf all-uppercase t
+ sym-name (let ((parts (special-symbol-name? sym-name)))
+ (concatenate 'string (aref parts 0) (aref parts 1)))))
+ ((first-uppercase-p sym-name)
+ (setf lowercase nil
+ sym-name (subseq sym-name 1)))
+ ((untouchable-string-p sym-name)
+ (setf do-not-touch t
+ sym-name (subseq sym-name 1))))
+ (flet ((reschar (c)
+ (push (cond (do-not-touch c)
+ ((and lowercase (not all-uppercase)) (char-downcase c))
+ (t (char-upcase c)))
+ res)
+ (setf lowercase t)))
+ (dotimes (i (length sym-name))
+ (let ((c (char sym-name i)))
+ (cond ((eql c #\-)
+ (setf lowercase (not lowercase)))
+ ((assoc c *special-chars*)
+ (dolist (i (coerce (cdr (assoc c *special-chars*)) 'list))
+ (reschar i)))
+ (t (reschar c))))))
+ (coerce (nreverse res) 'string)))
(defun ordered-set-difference (list1 list2 &key (test #'eql)) ; because the CL set-difference may not preserve order
(reduce (lambda (list el) (remove el list :test test))
(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)))
+ (let ((foo (create :bar 1 not-a-keyword something)))
(return (and (not foo) (+ (slot-value foo bar) some-other-var))))
- " var prefix_foo =
- { bar : 1,
- prefix_notAKeyword : prefix_something };
- return !prefix_foo && prefix_foo[prefix_bar] + prefix_someOtherVar;")
+"var prefix_foo1 = { bar : 1, prefix_notAKeyword : prefix_something };
+return !prefix_foo1 && prefix_foo1[prefix_bar] + prefix_someOtherVar;")
(test-ps-js setf-side-effects
(progn
- (let* ((x 10))
+ (let ((x 10))
(defun side-effect()
(setf x 4)
(return 3))
(setf x (+ 2 (side-effect) x 5))))
- "var x = 10;
+ "var x1 = 10;
function sideEffect() {
- x = 4;
+ x1 = 4;
return 3;
};
-x = 2 + sideEffect() + x + 5;")
+x1 = 2 + sideEffect() + x1 + 5;")
;; Parenscript used to optimize incorrectly:
;; var x = 10;
;; function sideEffect() {
(is (char= char-before a-parenthesis))))
(test-ps-js simple-slot-value
- (let* ((foo (create :a 1)))
+ (let ((foo (create :a 1)))
(alert (slot-value foo 'a)))
- "var foo = { a : 1 };
- alert(foo.a);")
+ "var foo1 = { a : 1 };
+ alert(foo1.a);")
(test-ps-js buggy-slot-value
- (let* ((foo (create :a 1))
- (slot-name "a"))
+ (let ((foo (create :a 1))
+ (slot-name "a"))
(alert (slot-value foo slot-name)))
- " var foo = { a : 1 };
- var slotName = 'a';
- alert(foo[slotName]);
+ " var foo1 = { a : 1 };
+ var slotName2 = 'a';
+ alert(foo1[slotName2]);
"); Last line was alert(foo.slotName) before bug-fix.
(test-ps-js buggy-slot-value-two
("u0080" . ,(code-char 128)) ;;Character over 127. Actually valid, parenscript escapes them to be sure.
("uABCD" . ,(code-char #xabcd)))));; Really above ascii.
(loop for (js-escape . lisp-char) in escapes
- for generated = (ps1* `(let* ((x ,(format nil "hello~ahi" lisp-char)))))
- for wanted = (format nil "var x = 'hello\\~ahi';" js-escape)
+ for generated = (ps-doc* `(let ((x ,(format nil "hello~ahi" lisp-char)))))
+ for wanted = (format nil "var x1 = 'hello\\~ahi';" js-escape)
do (is (string= (normalize-js-code generated) wanted)))))
-(test-ps-js complicated-symbol-name1
- grid-rows[foo].bar
- "gridRows[foo].bar")
-
-(test-ps-js complicated-symbol-name2
- *grid-rows*[foo].bar
- "GRIDROWS[foo].bar")
-
(test-ps-js slot-value-setf
(setf (slot-value x 'y) (+ (+ a 3) 4))
"x.y = (a + 3) + 4;")
(test-ps-js defsetf1
(progn (defsetf baz (x y) (newval) `(set-baz ,x ,y ,newval))
(setf (baz 1 2) 3))
- "var _js2 = 1; var _js3 = 2; var _js1 = 3; setBaz(_js2, _js3, _js1);")
+ "var _js2_4 = 1;
+var _js3_5 = 2;
+var _js1_6 = 3;
+setBaz(_js2_4, _js3_5, _js1_6);")
(test-ps-js defsetf-short
(progn (defsetf baz set-baz "docstring")
"function __setf_someThing(newVal, i1, i2) {
SOMETHING[i1][i2] = newVal;
};
-var _js2 = 1;
-var _js3 = 2;
-var _js1 = 'foo';
-__setf_someThing(_js1, _js2, _js3);")
+var _js2_4 = 1;
+var _js3_5 = 2;
+var _js1_6 = 'foo';
+__setf_someThing(_js1_6, _js2_4, _js3_5);")
(test-ps-js defun-optional1
(defun test-opt (&optional x) (return (if x "yes" "no")))
"[[1, 2], ['a', 'b']]")
(test-ps-js defun-rest1
- (defun foo (&rest bar) (alert bar[1]))
+ (defun foo (&rest bar) (alert (aref bar 1)))
"function foo() {
var bar = [];
for (var i1 = 0; i1 < arguments.length - 0; i1 += 1) {
(defun zoo (foo bar &key baz) (return (+ foo bar baz)))
"function zoo(foo, bar) {
var baz;
- var _js3 = arguments.length;
- for (var n1 = 2; n1 < _js3; n1 += 2) {
+ var _js2 = arguments.length;
+ for (var n1 = 2; n1 < _js2; n1 += 2) {
switch (arguments[n1]) {
case 'baz':
{
(defun zoo (&key baz) (return (* baz baz)))
"function zoo() {
var baz;
- var _js3 = arguments.length;
- for (var n1 = 0; n1 < _js3; n1 += 2) {
+ var _js2 = arguments.length;
+ for (var n1 = 0; n1 < _js2; n1 += 2) {
switch (arguments[n1]) {
case 'baz':
{
"function zoo() {
var baz;
var bar;
- var _js3 = arguments.length;
- for (var n1 = 0; n1 < _js3; n1 += 2) {
+ var _js2 = arguments.length;
+ for (var n1 = 0; n1 < _js2; n1 += 2) {
switch (arguments[n1]) {
case 'baz':
{
my-name)
"function helloWorld() {
var myName;
- var _js3 = arguments.length;
- for (var n1 = 0; n1 < _js3; n1 += 2) {
+ var _js2 = arguments.length;
+ for (var n1 = 0; n1 < _js2; n1 += 2) {
switch (arguments[n1]) {
case 'my-name-key':
{
}")
(test-ps-js funcall-if-expression
- (document.write
+ ((@ document write)
(if (= *linkornot* 1)
(ps-html ((:a :href "#"
:onclick (ps-inline (transport)))
(test-ps-js let-decl-in-expression
(defun f (x) (return (if x 1 (let* ((foo x)) foo))))
"function f(x) {
- var foo;
- return x ? 1 : (foo = x, foo);
+ var foo1;
+ return x ? 1 : (foo1 = x, foo1);
}")
(test-ps-js special-var1
(progn (defvar *foo*) (let* ((*foo* 2)) (* *foo* 2)))
"var FOO;
-var tempstackvar1;
+var FOO1;
try {
- tempstackvar1 = FOO;
+ FOO1 = FOO;
FOO = 2;
FOO * 2;
} finally {
- FOO = tempstackvar1;
- delete tempstackvar1;
+ FOO = FOO1;
};")
(test-ps-js special-var2
(progn (defvar *foo*) (let* ((*baz* 3) (*foo* 2)) (* *foo* 2 *baz*)))
"var FOO;
-var BAZ = 3;
-var tempstackvar1;
+var BAZ1 = 3;
+var FOO2;
try {
- tempstackvar1 = FOO;
+ FOO2 = FOO;
FOO = 2;
- FOO * 2 * BAZ;
+ FOO * 2 * BAZ1;
} finally {
- FOO = tempstackvar1;
- delete tempstackvar1;
-};
-")
+ FOO = FOO2;
+};")
(test-ps-js literal1
(setf x undefined)
(test-ps-js setf-operator-priority
(return (or (slot-value cache id)
- (setf (slot-value cache id) (document.get-element-by-id id))))
+ (setf (slot-value cache id) ((@ document get-element-by-id) id))))
"return cache[id] || (cache[id] = document.getElementById(id))")
(test-ps-js aref-operator-priority
(test-ps-js ps-js-target-version-keyword-test1
(defun foo (x y &key bar baz))
"function foo(x, y) {
- var x1 = Array.prototype.indexOf.call(arguments, 'bar', 2);
- var bar = -1 == x1 ? null : arguments[x1 + 1];
- var x2 = Array.prototype.indexOf.call(arguments, 'baz', 2);
- var baz = -1 == x2 ? null : arguments[x2 + 1];
+ var x1_3 = Array.prototype.indexOf.call(arguments, 'bar', 2);
+ 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-expressions2
(return (if x y (if z a b)))
"return x ? y : (z ? a : b)")
+
+(test-ps-js let1
+ (let (x)
+ (+ x x))
+ "var x1 = null;
+x1 + x1;")
+
+(test-ps-js let2
+ (let ((x 1))
+ (+ x x))
+ "var x1 = 1;
+x1 + x1;")
+
+(test-ps-js let3
+ (let ((x 1)
+ (y 2))
+ (+ x x))
+ "var x1 = 1;
+var y2 = 2;
+x1 + x1;")
+
+(test-ps-js let4
+ (let ((x 1)
+ (y (1+ x)))
+ (+ x y))
+ "var x1 = 1;
+var y2 = x + 1;
+x1 + y2;")
+
+(test-ps-js let5
+ (let ((x 1))
+ (+ x 1)
+ (let ((x (+ x 5)))
+ (+ x 1))
+ (+ x 1))
+ "var x1 = 1;
+x1 + 1;
+var x2 = x1 + 5;
+x2 + 1;
+x1 + 1;")
+
+(test-ps-js let6
+ (let ((x 2))
+ (let ((x 1)
+ (y (1+ x)))
+ (+ x y)))
+ "var x1 = 2;
+var x2 = 1;
+var y3 = x1 + 1;
+x2 + y3;")
+
+(test-ps-js let-exp1
+ (lambda ()
+ (return (let (x) (+ x x))))
+ "function () {
+ var x1;
+ return (x1 = null, x1 + x1);
+}")
+
+(test-ps-js let*1
+ (let* ((x 1)) (+ x x))
+"var x1 = 1;
+x1 + x1;")
+
+(test-ps-js let*2
+ (let* ((x 1)
+ (y (+ x 2)))
+ (+ x y))
+ "var x1 = 1;
+var y2 = x1 + 2;
+x1 + y2;")
+
+(test-ps-js let*3
+ (let ((x 3))
+ (let* ((x 1)
+ (y (+ x 2)))
+ (+ x y)))
+ "var x1 = 3;
+var x2 = 1;
+var y3 = x2 + 2;
+x2 + y3;")
+
+(test-ps-js let*4
+ (let ((x 3))
+ (let* ((y (+ x 2))
+ (x 1))
+ (+ x y)))
+ "var x1 = 3;
+var y2 = x1 + 2;
+var x3 = 1;
+x3 + y2;")
*array
"Array")
-(test-ps-js symbol-conversion-6
+(test-ps-js symbol-conversion-4
*global-array*
"GLOBALARRAY")
-(test-ps-js symbol-conversion-7
- *global-array*.length
- "GLOBALARRAY.length")
-
(test-ps-js number-literals-1
1
"1")
"anObject.foo")
(test-ps-js object-literals-4
- an-object.foo
- "anObject.foo")
+ (@ an-object foo bar)
+ "anObject.foo.bar")
(test-ps-js object-literals-5
(with-slots (a b c) this
*math
"Math")
-(test-ps-js variables-4
- *math.floor
- "Math.floor")
-
(test-ps-js function-calls-and-method-calls-1
(blorg 1 2)
"blorg(1, 2)")
((slot-value (aref foobar 1) 'blorg) NIL T)
"foobar[1].blorg(null, true)")
-(test-ps-js function-calls-and-method-calls-6
- (this.blorg 1 2)
- "this.blorg(1, 2)")
-
(test-ps-js operator-expressions-1
(* 1 2)
"1 * 2")
"a = 1 - a;")
(test-ps-js assignment-5
- (let* ((a 1) (b 2))
+ (let ((a 1) (b 2))
(psetf a b b a))
- "var a = 1;
-var b = 2;
-var _js1 = b;
-var _js2 = a;
-a = _js1;
-b = _js2;")
+ "var a1 = 1;
+var b2 = 2;
+var _js3_5 = b2;
+var _js4_6 = a1;
+a1 = _js3_5;
+b2 = _js4_6;")
(test-ps-js assignment-6
(setq a 1)
(test-ps-js assignment-9
(setf (color some-div) (+ 23 "em"))
- "var _js2 = someDiv;
-var _js1 = 23 + 'em';
-__setf_color(_js1, _js2);")
+ "var _js2_3 = someDiv;
+var _js1_4 = 23 + 'em';
+__setf_color(_js1_4, _js2_3);")
(test-ps-js assignment-10
(defsetf left (el) (offset)
(test-ps-js assignment-11
(setf (left some-div) (+ 123 "px"))
- "var _js2 = someDiv;
-var _js1 = 123 + 'px';
-_js2.style.left = _js1;")
+ "var _js2_3 = someDiv;
+var _js1_4 = 123 + 'px';
+_js2_3.style.left = _js1_4;")
(test-ps-js assignment-12
(progn (defmacro left (el)
}")
(test-ps-js conditional-statements-1
- (if (blorg.is-correct)
+ (if ((@ blorg is-correct))
(progn (carry-on) (return i))
(alert "blorg is not correct!"))
"if (blorg.isCorrect()) {
}")
(test-ps-js conditional-statements-2
- (+ i (if (blorg.add-one) 1 2))
+ (+ i (if ((@ blorg add-one)) 1 2))
"i + (blorg.addOne() ? 1 : 2)")
(test-ps-js conditional-statements-3
- (when (blorg.is-correct)
+ (when ((@ blorg is-correct))
(carry-on)
(return i))
"if (blorg.isCorrect()) {
}")
(test-ps-js conditional-statements-4
- (unless (blorg.is-correct)
+ (unless ((@ blorg is-correct))
(alert "blorg is not correct!"))
"if (!blorg.isCorrect()) {
alert('blorg is not correct!');
"var A = [ 1, 2, 3 ]")
(test-ps-js variable-declaration-2
- (simple-let* ((a 0) (b 1))
- (alert (+ a b)))
- "var a = 0;
-var b = 1;
-alert(a + b);")
-
-(test-ps-js variable-declaration-3
- (simple-let* ((a "World") (b "Hello"))
- (simple-let ((a b) (b a))
- (alert (+ a b))))
- "var a = 'World';
-var b = 'Hello';
-var _js_a1 = b;
-var _js_b2 = a;
-var a = _js_a1;
-var b = _js_b2;
-delete _js_a1;
-delete _js_b2;
-alert(a + b);")
-
-(test-ps-js variable-declaration-4
- (simple-let* ((a 0) (b 1))
- (lexical-let* ((a 9) (b 8))
- (alert (+ a b)))
- (alert (+ a b)))
- "var a = 0;
-var b = 1;
-(function () {
- var a = 9;
- var b = 8;
- alert(a + b);
-})();
-alert(a + b);")
-
-(test-ps-js variable-declaration-5
- (simple-let* ((a "World") (b "Hello"))
- (lexical-let ((a b) (b a))
- (alert (+ a b)))
- (alert (+ a b)))
- "var a = 'World';
-var b = 'Hello';
-(function (a, b) {
- alert(a + b);
-})(b, a);
-alert(a + b);")
+ (progn
+ (defvar *a* 4)
+ (let ((x 1)
+ (*a* 2))
+ (let* ((y (+ x 1))
+ (x (+ x y)))
+ (+ *a* x y))))
+ "var A = 4;
+var x1 = 1;
+var A2;
+try {
+ A2 = A;
+ A = 2;
+ var y3 = x1 + 1;
+ var x4 = x1 + y3;
+ A + x4 + y3;
+} finally {
+ A = A2;
+};")
(test-ps-js iteration-constructs-1
(do* ((a) b (c (array "a" "b" "c" "d" "e"))
(d 0 (1+ d))
(e (aref c d) (aref c d)))
- ((or (= d c.length) (eql e "x")))
+ ((or (= d (@ c length)) (eql e "x")))
(setf a d b e)
- (document.write (+ "a: " a " b: " b "<br/>")))
+ ((@ document write) (+ "a: " a " b: " b "<br/>")))
"for (var a = null, b = null, c = ['a', 'b', 'c', 'd', 'e'], d = 0, e = c[d]; !(d == c.length || e == 'x'); d += 1, e = c[d]) {
a = d;
b = e;
(do ((i 0 (1+ i))
(s 0 (+ s i (1+ i))))
((> i 10))
- (document.write (+ "i: " i " s: " s "<br/>")))
- "var _js_i1 = 0;
-var _js_s2 = 0;
-var i = _js_i1;
-var s = _js_s2;
-delete _js_i1;
-delete _js_s2;
-for (; i <= 10; ) {
- document.write('i: ' + i + ' s: ' + s + '<br/>');
- var _js3 = i + 1;
- var _js4 = s + i + (i + 1);
- i = _js3;
- s = _js4;
+ ((@ document write) (+ "i: " i " s: " s "<br/>")))
+ "var i1 = 0;
+var s2 = 0;
+for (; i1 <= 10; ) {
+ document.write('i: ' + i1 + ' s: ' + s2 + '<br/>');
+ var _js3_5 = i1 + 1;
+ var _js4_6 = s2 + i1 + (i1 + 1);
+ i1 = _js3_5;
+ s2 = _js4_6;
};")
(test-ps-js iteration-constructs-3
(do* ((i 0 (1+ i))
(s 0 (+ s i (1- i))))
((> i 10))
- (document.write (+ "i: " i " s: " s "<br/>")))
+ ((@ document write) (+ "i: " i " s: " s "<br/>")))
"for (var i = 0, s = 0; i <= 10; i += 1, s += i + (i - 1)) {
document.write('i: ' + i + ' s: ' + s + '<br/>');
};")
(test-ps-js iteration-constructs-4
- (let* ((arr (array "a" "b" "c" "d" "e")))
- (dotimes (i arr.length)
- (document.write (+ "i: " i " arr[i]: " (aref arr i) "<br/>"))))
- "var arr = ['a', 'b', 'c', 'd', 'e'];
-for (var i = 0; i < arr.length; i += 1) {
- document.write('i: ' + i + ' arr[i]: ' + arr[i] + '<br/>');
+ (let ((arr (array "a" "b" "c" "d" "e")))
+ (dotimes (i (@ arr length))
+ ((@ document write) (+ "i: " i " arr[i]: " (aref arr i) "<br/>"))))
+ "var arr1 = ['a', 'b', 'c', 'd', 'e'];
+for (var i = 0; i < arr1.length; i += 1) {
+ document.write('i: ' + i + ' arr[i]: ' + arr1[i] + '<br/>');
};")
(test-ps-js iteration-constructs-5
- (let* ((res 0))
+ (let ((res 0))
(alert (+ "Summation to 10 is "
(dotimes (i 10 res)
(incf res (1+ i))))))
- "var res = 0;
+ "var res1 = 0;
alert('Summation to 10 is ' + (function () {
for (var i = 0; i < 10; i += 1) {
- res += i + 1;
+ res1 += i + 1;
};
- return res;
+ return res1;
})());")
(test-ps-js iteration-constructs-6
- (let* ((l (list 1 2 4 8 16 32)))
+ (let ((l (list 1 2 4 8 16 32)))
(dolist (c l)
- (document.write (+ "c: " c "<br/>"))))
- "var l = [1, 2, 4, 8, 16, 32];
-for (var c = null, _js_arrvar2 = l, _js_idx1 = 0; _js_idx1 < _js_arrvar2.length; _js_idx1 += 1) {
- c = _js_arrvar2[_js_idx1];
+ ((@ document write) (+ "c: " c "<br/>"))))
+ "var l1 = [1, 2, 4, 8, 16, 32];
+for (var c = null, _js_arrvar3 = l1, _js_idx2 = 0; _js_idx2 < _js_arrvar3.length; _js_idx2 += 1) {
+ c = _js_arrvar3[_js_idx2];
document.write('c: ' + c + '<br/>');
};")
(test-ps-js iteration-constructs-7
- (let* ((l (list 1 2 4 8 16 32))
- (s 0))
+ (let ((l '(1 2 4 8 16 32))
+ (s 0))
(alert (+ "Sum of " l " is: "
(dolist (c l s)
(incf s c)))))
- "var l = [1, 2, 4, 8, 16, 32];
-var s = 0;
-alert('Sum of ' + l + ' is: ' + (function () {
- for (var c = null, _js_arrvar2 = l, _js_idx1 = 0; _js_idx1 < _js_arrvar2.length; _js_idx1 += 1) {
- c = _js_arrvar2[_js_idx1];
- s += c;
+ "var l1 = [1, 2, 4, 8, 16, 32];
+var s2 = 0;
+alert('Sum of ' + l1 + ' is: ' + (function () {
+ for (var c = null, _js_arrvar4 = l1, _js_idx3 = 0; _js_idx3 < _js_arrvar4.length; _js_idx3 += 1) {
+ c = _js_arrvar4[_js_idx3];
+ s2 += c;
};
- return s;
+ return s2;
})());")
(test-ps-js iteration-constructs-8
- (let* ((obj (create :a 1 :b 2 :c 3)))
+ (let ((obj (create :a 1 :b 2 :c 3)))
(for-in (i obj)
- (document.write (+ i ": " (aref obj i) "<br/>"))))
- "var obj = { a : 1, b : 2, c : 3 };
-for (var i in obj) {
- document.write(i + ': ' + obj[i] + '<br/>');
+ ((@ document write) (+ i ": " (aref obj i) "<br/>"))))
+ "var obj1 = { a : 1, b : 2, c : 3 };
+for (var i in obj1) {
+ document.write(i + ': ' + obj1[i] + '<br/>');
};")
(test-ps-js iteration-constructs-9
- (while (film.is-not-finished)
- (this.eat (new *popcorn)))
+ (while ((@ film is-not-finished))
+ ((@ this eat) (new *popcorn)))
"while (film.isNotFinished()) {
this.eat(new Popcorn);
}")
"'<A HREF=\"' + generateALink() + '\">blorg</A>'")
(test-ps-js the-html-generator-3
- (document.write
+ ((@ document write)
(ps-html ((:a :href "#"
:onclick (ps-inline (transport))) "link")))
"document.write('<A HREF=\"#\" ONCLICK=\"' + ('javascript:' + 'transport' + '(' + ')') + '\">link</A>')")
(test-ps-js the-html-generator-4
- (let* ((disabled nil)
+ (let ((disabled nil)
(authorized t))
- (setf element.inner-h-t-m-l
+ (setf (@ element inner-h-t-m-l)
(ps-html ((:textarea (or disabled (not authorized)) :disabled "disabled")
"Edit me"))))
- "var disabled = null;
-var authorized = true;
+ "var disabled1 = null;
+var authorized2 = true;
element.innerHTML =
'<TEXTAREA'
-+ (disabled || !authorized ? ' DISABLED=\"' + 'disabled' + '\"' : '')
++ (disabled1 || !authorized2 ? ' DISABLED=\"' + 'disabled' + '\"' : '')
+ '>Edit me</TEXTAREA>';")
HCoop / clinton / parenscript.git / commitdiff