(foobar (blorg 1 2) (blabla 3 4) (array 2 3 4))
=> foobar(blorg(1, 2), blabla(3, 4), [ 2, 3, 4 ])
+((slot-value this 'blorg) 1 2) => this.blorg(1, 2)
+
((aref foo i) 1 2) => foo[i](1, 2)
-;;; A method call is a function call where the function name is a
-;;; symbol and begins with a "." . In a method call, the name of the
-;;; function is append to its first argument, thus reflecting the
-;;; method call syntax of JavaScript. Please note that most method
-;;; calls can be abbreviated using the "." trick in symbol names (see
-;;; "Symbol Conversion" above).
+((slot-value (aref foobar 1) 'blorg) NIL T) => foobar[1].blorg(null, true)
-(.blorg this 1 2) => this.blorg(1, 2)
+;;; 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)
-(.blorg (aref foobar 1) NIL T)
-=> foobar[1].blorg(null, true)
-
;;;# Operator Expressions
;;;t \index{operator}
;;;t \index{operator expression}
(not (op-form-p form))
(not (ps-special-form-p form))))
-(defun method-call-p (form)
- (and (funcall-form-p form)
- (symbolp (first form))
- (eql (char (symbol-name (first form)) 0) #\.)))
-
;;; macro expansion
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun make-macro-env-dictionary ()
(error "Attempting to use Parenscript special form ~a as variable" symbol)))
(t (list 'js-variable symbol))))
-(defun compile-function-argument-forms (arg-forms)
- "Compiles a bunch of Parenscript forms from a funcall form to an effective set of
-Javascript arguments. The only extra processing this does is makes :keyword arguments
-into a single options argument via CREATE."
- (let ((compiled-args (mapcar (lambda (arg) (compile-parenscript-form arg :expecting :expression))
- arg-forms)))
- (do ((effective-expressions nil)
- (expressions-subl compiled-args))
- ((not expressions-subl) (reverse effective-expressions))
- (let ((arg-expr (first expressions-subl)))
- (if (keywordp arg-expr)
- (progn (when (oddp (length expressions-subl))
- (error "Odd number of keyword arguments: ~A." arg-forms))
- (push (list 'js-object (loop for (name val) on expressions-subl by #'cddr
- collect (list (list 'js-variable name) val)))
- effective-expressions)
- (setf expressions-subl nil))
- (progn (push arg-expr effective-expressions)
- (setf expressions-subl (rest expressions-subl))))))))
+(defun compile-function-argument-forms (args)
+ (let ((remaining-args args))
+ (loop while remaining-args collecting
+ (if (keywordp (first remaining-args))
+ (prog2 (when (oddp (length remaining-args))
+ (error "Odd number of keyword arguments: ~A." args))
+ (compile-parenscript-form (cons 'create remaining-args) :expecting :expression)
+ (setf remaining-args nil))
+ (prog1 (compile-parenscript-form (first remaining-args) :expecting :expression)
+ (setf remaining-args (cdr remaining-args)))))))
(defun ps-convert-op-name (op)
(case (ensure-ps-symbol op)
(list 'operator
(ps-convert-op-name (compile-parenscript-form (first form) :expecting :symbol))
(mapcar (lambda (form) (compile-parenscript-form form :expecting :expression)) (rest form))))
- ((method-call-p form)
- (list 'js-method-call
- (compile-parenscript-form name :expecting :symbol)
- (compile-parenscript-form (first args) :expecting :expression)
- (compile-function-argument-forms (rest args))))
((funcall-form-p form)
(list 'js-funcall
(compile-parenscript-form name :expecting :expression)
(defpackage "PS-JS-SYMBOLS"
(:export
- #:.to-fixed
+ #:to-fixed
#:encode-u-r-i-component
- #:.push
- #:.size
+ #:size
#:*array
- #:set-timeout
- #:set-interval
+ #:*date
+ #:get-time
+ #:arguments
+ #:join
+ #:prototype
+ #:slice
+ #:call
))
(defpackage "PS-DOM-SYMBOLS"
#:left
#:display
#:onmousemove
- #:.create-element
- #:.set-attribute
- #:.append-child
+ #:create-element
+ #:set-attribute
+ #:append-child
#:offset-height
#:offset-width
#:client-height
#:client-width
#:scroll-height
#:scroll-width
- #:.insert-row
- #:.insert-cell
+ #:insert-row
+ #:insert-cell
#:value
#:elements
- #:.get-elements-by-class-name
- #:.get-element-by-id
+ #:get-elements-by-class-name
+ #:get-element-by-id
#:onselectstart
+ #:set-timeout
+ #:set-interval
))
(defpackage "PS-PROTOTYPE-LIB-SYMBOLS"
(:export
#:*event
- #:.observe
+ #:observe
#:*ajax
- #:.*request
+ #:*request
+ #:console
))
(loop for idx in indices do
(psw #\[) (ps-print idx) (psw #\])))
-(defprinter object-literal (&rest slot-definitions)
- (psw #\{)
- (loop for ((key . value) . remaining) on slot-definitions do
- (psw (format nil "~A: " (js-translate-symbol key)))
- (ps-print value)
- (when remaining (psw ", ")))
- (psw " }"))
-
(defprinter js-variable (var)
(psw (js-translate-symbol var)))
(ps-print arg))
(unless prefix (psw (format nil "~(~a~)" op))))
-;;; function and method calls
(defprinter js-funcall (fun-designator args)
- (if (member (car fun-designator) '(js-variable js-aref js-slot-value js-funcall))
- (ps-print fun-designator)
- (progn (psw #\() (ps-print fun-designator) (psw #\))))
- (psw #\() (print-comma-delimited-list args) (psw #\)))
-
-(defprinter js-method-call (method object args)
- ;; TODO: this may not be the best way to add ()'s around lambdas
- ;; probably there is or should be a more general solution working
- ;; in other situations involving lambdas
- (if (or (numberp object) (and (consp object) (member (car object) '(js-lambda js-object operator js-expression-if))))
- (parenthesize-print object)
- (ps-print object))
- (psw (js-translate-symbol method))
+ (funcall (if (member (car fun-designator) '(js-variable js-aref js-slot-value js-funcall))
+ #'ps-print
+ #'parenthesize-print)
+ fun-designator)
(psw #\() (print-comma-delimited-list args) (psw #\)))
(defprinter js-block (block-type statements)
(psw ") ")
(ps-print body-block))
-;;; object literals
(defprinter js-object (slot-defs)
(psw "{ ")
- (loop for ((slot-name slot-value) . remaining) on slot-defs do
+ (loop for ((slot-name . slot-value) . remaining) on slot-defs do
(if (and (listp slot-name) (eql 'ps-quote (car slot-name)) (symbolp (second slot-name)))
(psw (js-translate-symbol (second slot-name)))
(ps-print slot-name))
(psw " }"))
(defprinter js-slot-value (obj slot)
- (if (> (expression-precedence obj) #.(op-precedence 'js-slot-value))
+ (if (or (> (expression-precedence obj) #.(op-precedence 'js-slot-value))
+ (numberp obj)
+ (and (listp obj) (member (car obj) '(js-lambda js-object))))
(parenthesize-print obj)
(ps-print obj))
(if (and (listp slot) (eql 'ps-quote (car slot)))
(compile-parenscript-form form :expecting :expression))
coords)))
-(add-ps-literal '{})
-(define-ps-special-form {} (expecting &rest arrows)
- (declare (ignore expecting))
- (cons 'object-literal (loop for (key value) on arrows by #'cddr
- collect (cons key (compile-parenscript-form value :expecting :expression)))))
-
(defpsmacro list (&rest values)
`(array ,@values))
-(defpsmacro make-array (&rest inits)
- `(new (*array ,@inits)))
+(defpsmacro make-array (&rest initial-values)
+ `(new (*array ,@initial-values)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; operators
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; objects
-(define-ps-special-form create (expecting &rest args)
+(add-ps-literal '{})
+(define-ps-symbol-macro {} (create))
+
+(define-ps-special-form create (expecting &rest arrows)
(declare (ignore expecting))
- (list 'js-object (loop for (name val) on args by #'cddr collecting
- (let ((name-expr (compile-parenscript-form name :expecting :expression)))
- (when (keywordp name-expr)
- (setf name-expr (list 'js-variable name-expr)))
- (assert (or (stringp name-expr)
- (numberp name-expr)
- (and (listp name-expr)
- (or (eql 'js-variable (car name-expr))
- (eql 'ps-quote (car name-expr)))))
+ (list 'js-object (loop for (key-expr val-expr) on arrows by #'cddr collecting
+ (let ((key (compile-parenscript-form key-expr :expecting :expression)))
+ (when (keywordp key)
+ (setf key (list 'js-variable key)))
+ (assert (or (stringp key)
+ (numberp key)
+ (and (listp key)
+ (or (eq 'js-variable (car key))
+ (eq 'ps-quote (car key)))))
()
- "Slot ~s is not one of js-variable, keyword, string or number." name-expr)
- (list name-expr (compile-parenscript-form val :expecting :expression))))))
+ "Slot key ~s is not one of js-variable, keyword, string or number." key)
+ (cons key (compile-parenscript-form val-expr :expecting :expression))))))
(define-ps-special-form %js-slot-value (expecting obj slot)
(declare (ignore expecting))
(in-suite ps-tests)
(test-ps-js plus-is-not-commutative
- (setf x (+ "before" x "after"))
- "x = 'before' + x + 'after';")
+ (setf x (+ "before" x "after"))
+ "x = 'before' + x + 'after';")
(test-ps-js plus-works-if-first
- (setf x (+ x "middle" "after"))
- "x += 'middle' + 'after';")
+ (setf x (+ x "middle" "after"))
+ "x += 'middle' + 'after';")
(test-ps-js setf-side-effects
(progn
return 3;
};
x = 2 + sideEffect() + x + 5;")
-;; Parenscript used to optimize too much:
+;; Parenscript used to optimize incorrectly:
;; var x = 10;
;; function sideEffect() {
;; x = 4;
;; Which is 20, not 14
-(test-ps-js dot-notation-bug
- (.match (+ "" x) "foo")
- "('' + x).match('foo')")
+(test-ps-js method-call-op-form
+ ((@ (+ "" x) to-string))
+ "('' + x).toString()")
+
+(test-ps-js method-call-op-form-args
+ ((@ (+ "" x) to-string) 1 2 :baz 3)
+ "('' + x).toString(1, 2, { baz : 3 })")
+
+(test-ps-js method-call-number
+ ((@ 10 to-string))
+ "( 10 ).toString()")
+
+(test-ps-js method-call-string
+ ((@ "hi" to-string))
+ "'hi'.toString()")
-(test-ps-js method-call-op-form (.to-string (+ "" x)) "('' + x).toString()")
-(test-ps-js method-call-number (.to-string 10) "( 10 ).toString()")
-(test-ps-js method-call-string (.to-string "hi") "'hi'.toString()")
(test-ps-js method-call-lit-object
- (.to-string (create :to-string (lambda ()
- (return "it works"))))
- "( { toString : function () { return 'it works'; } } ).toString()")
+ ((@ (create :to-string (lambda () (return "it works"))) to-string))
+ "( { toString : function () { return 'it works'; } } ).toString()")
+
+(test-ps-js method-call-conditional
+ ((if a x y) 1)
+ "(a ? x : y)(1)")
(test-ps-js method-call-variable
- (.to-string x)
- "x.toString()")
+ ((@ x to-string))
+ "x.toString()")
(test-ps-js method-call-array
- (.to-string (list 10 20))
- "[ 10, 20 ].toString()")
+ ((@ (list 10 20) to-string))
+ "[ 10, 20 ].toString()")
+
(test-ps-js method-call-fn-call
- (.to-string (foo))
- "foo().toString()")
+ ((@ (foo) to-string))
+ "foo().toString()")
+
(test-ps-js method-call-lambda-fn
- (.to-string (lambda () (alert 10)))
- "( function () { alert(10); } ).toString()")
+ ((@ (lambda () (alert 10)) to-string))
+ "( function () { alert(10); } ).toString()")
+
(test-ps-js method-call-lambda-call
- (.to-string ((lambda (x) (return x)) 10))
- "(function (x) { return x; })(10).toString()")
+ ((@ ((lambda (x) (return x)) 10) to-string))
+ "(function (x) { return x; })(10).toString()")
(test no-whitespace-before-dot
- (let* ((str (ps1* '(.to-string ((lambda (x) (return x)) 10))))
+ (let* ((str (ps1* '((@ ((lambda (x) (return x)) 10) to-string))))
(dot-pos (position #\. str :test #'char=))
(char-before (elt str (1- dot-pos)))
(a-parenthesis #\)))
(slot-value foo "bar")
"foo['bar']")
+(test-ps-js slot-value-string1
+ (slot-value "bar" 'length)
+ "'bar'.length")
+
(test-ps-js slot-value-progn
(slot-value (progn (some-fun "abc") "123") "length")
"(someFun('abc'), '123')['length']")
(test-ps-js method-call-block
- (.to-string (progn (some-fun "abc") "123"))
+ ((@ (progn (some-fun "abc") "123") to-string))
"(someFun('abc'), '123').toString()")
(test-ps-js create-blank
{}
"{ }")
-(test-ps-js object-literal-1
- ({})
- "{ }")
-
-(test-ps-js object-literal-2
- ({} a 1 b 2)
- "{a: 1, b: 2 }")
-
(test-ps-js array-literal1
[]
"[]")
(((or (@ window eval) eval)) foo nil)
"(window.eval || eval)()(foo, null)")
+(test-ps-js slot-value-object-literal
+ (slot-value (create :a 1) 'a)
+ "({ a : 1 }).a")
+
+(test-ps-js slot-value-lambda
+ (slot-value (lambda ()) 'prototype)
+ "(function () { }).prototype")
"foobar(blorg(1, 2), blabla(3, 4), [ 2, 3, 4 ])")
(test-ps-js function-calls-and-method-calls-3
- ((aref foo i) 1 2)
- "foo[i](1, 2)")
+ ((slot-value this 'blorg) 1 2)
+ "this.blorg(1, 2)")
(test-ps-js function-calls-and-method-calls-4
- (.blorg this 1 2)
- "this.blorg(1, 2)")
+ ((aref foo i) 1 2)
+ "foo[i](1, 2)")
(test-ps-js function-calls-and-method-calls-5
- (this.blorg 1 2)
- "this.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
- (.blorg (aref foobar 1) NIL T)
- "foobar[1].blorg(null, true)")
+ (this.blorg 1 2)
+ "this.blorg(1, 2)")
(test-ps-js operator-expressions-1
(* 1 2)
HCoop / clinton / parenscript.git / commitdiff