Commit da2f37c1 authored by Vladimir Sedach's avatar Vladimir Sedach
Browse files

Renamed SLOT-VALUE to GET-PROPERTY (and added the former to the

deprecated interface).
parent 16e527d4
......@@ -80,7 +80,7 @@ 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* 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
PUBLIC RANDOM REGEX RETURN SETF SHORT GET-PROPERTY STATIC SUPER SWITCH
SYMBOL-MACROLET SYNCHRONIZED T THIS THROW THROWS TRANSIENT TRY TYPEOF
UNDEFINED UNLESS VAR VOID VOLATILE WHEN WHILE WITH WITH-SLOTS
......@@ -164,11 +164,11 @@ UNDEFINED UNLESS VAR VOID VOLATILE WHEN WHILE WITH WITH-SLOTS
;;; that JavaScript knows of no such thing as an array. Subscripting
;;; an array is in fact reading a property from an object. So in a
;;; semantic sense, there is no real difference between `AREF' and
;;; `SLOT-VALUE'.
;;; `GET-PROPERTY'.
;;;## Object literals
;;;t \index{CREATE}
;;;t \index{SLOT-VALUE}
;;;t \index{GET-PROPERTY}
;;;t \index{@}
;;;t \index{WITH-SLOTS}
;;;t \index{object literal}
......@@ -177,7 +177,7 @@ UNDEFINED UNLESS VAR VOID VOLATILE WHEN WHILE WITH WITH-SLOTS
;;;t \index{property}
; (CREATE {name value}*)
; (SLOT-VALUE object slot-name)
; (GET-PROPERTY object slot-name)
; (WITH-SLOTS ({slot-name}*) object body)
;
; name ::= a Parenscript symbol or a Lisp keyword
......@@ -201,10 +201,10 @@ UNDEFINED UNLESS VAR VOID VOLATILE WHEN WHILE WITH WITH-SLOTS
blorg : [ 1, 2, 3 ],
anotherObject : { 'schtrunz' : 1 } };
;;; Object properties can be accessed using the `SLOT-VALUE' form,
;;; Object properties can be accessed using the `GET-PROPERTY' form,
;;; which takes an object and a slot-name.
(slot-value an-object 'foo) => anObject.foo;
(get-property an-object 'foo) => anObject.foo;
;;; The convenience macro `@' is provided to make multiple levels of
;;; indirection easy to express
......@@ -212,7 +212,7 @@ UNDEFINED UNLESS VAR VOID VOLATILE WHEN WHILE WITH WITH-SLOTS
(@ 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
;;; symbols to a macro that will expand into a `GET-PROPERTY' form at
;;; expansion time.
(with-slots (a b c) this
......@@ -322,11 +322,11 @@ a-variable => aVariable;
(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);
((get-property this 'blorg) 1 2) => this.blorg(1, 2);
((aref foo i) 1 2) => foo[i](1, 2);
((slot-value (aref foobar 1) 'blorg) NIL T) => foobar[1].blorg(null, true);
((get-property (aref foobar 1) 'blorg) NIL T) => foobar[1].blorg(null, true);
;;;# Operator Expressions
;;;t \index{operator}
......@@ -525,7 +525,7 @@ a-variable => aVariable;
;;; prefix:
(defun (setf color) (new-color el)
(setf (slot-value (slot-value el 'style) 'color) new-color))
(setf (get-property (get-property el 'style) 'color) new-color))
=> function __setf_color(newColor, el) {
return el.style.color = newColor;
};
......@@ -542,7 +542,7 @@ a-variable => aVariable;
;;; provide a uniform protocol for positioning elements in HTML pages:
(defsetf left (el) (offset)
`(setf (slot-value (slot-value ,el 'style) 'left) ,offset))
`(setf (get-property (get-property ,el 'style) 'left) ,offset))
=> null;
(setf (left some-div) (+ 123 "px"))
......@@ -551,7 +551,7 @@ a-variable => aVariable;
_js2.style.left = _js1;
(macrolet ((left (el)
`(slot-value ,el 'offset-left)))
`(get-property ,el 'offset-left)))
(left some-div))
=> someDiv.offsetLeft;
......@@ -1073,7 +1073,7 @@ a-variable => aVariable;
,@(when introduce-array-var?
(list (list arrvar array)))
(,idx 0 (1+ ,idx)))
((>= ,idx (slot-value ,arrvar 'length))
((>= ,idx (get-property ,arrvar 'length))
,@(when result? (list result)))
(setq ,var (aref ,arrvar ,idx))
,@body)))
......@@ -1112,7 +1112,7 @@ a-variable => aVariable;
(defpsmacro with-slots (slots object &rest body)
`(symbol-macrolet ,(mapcar #'(lambda (slot)
`(,slot '(slot-value ,object ',slot)))
`(,slot '(get-property ,object ',slot)))
slots)
,@body))
......
......@@ -209,7 +209,7 @@ the form cannot be compiled to a symbol."
;;; operators
(let ((precedence-table (make-hash-table :test 'eq)))
(loop for level in '((js:new js:slot-value js:aref)
(loop for level in '((js:new js:get-property js:aref)
(postfix++ postfix--)
(delete void typeof ++ -- unary+ unary- ~ !)
(* / %)
......
......@@ -64,3 +64,7 @@ is output to the OUTPUT-STREAM stream."
(defun-js symbol-to-js symbol-to-js-string (symbol)
(symbol-to-js-string symbol))
(defpsmacro slot-value (&rest args)
(warn-deprecated 'slot-value 'get-property)
`(get-property ,@args))
......@@ -76,9 +76,9 @@
`(not (undefined ,x)))
(defpsmacro @ (obj &rest props)
"Handy slot-value/aref composition macro."
"Handy get-property/aref composition macro."
(if props
`(@ (slot-value ,obj ,(if (symbolp (car props)) `',(car props) (car props))) ,@(cdr props))
`(@ (get-property ,obj ,(if (symbolp (car props)) `',(car props) (car props))) ,@(cdr props))
obj))
(defpsmacro chain (&rest method-calls)
......
......@@ -127,7 +127,7 @@
;; slot access
#:with-slots
#:slot-value
#:get-property
;; macros
#:macrolet
......@@ -264,6 +264,7 @@
#:js
#:js*
#:symbol-to-js
#:slot-value
))
(defparameter *javascript-exports*
......@@ -361,7 +362,7 @@
#:lambda
#:object
#:variable
#:slot-value
#:get-property
#:funcall
#:escape
))
......
......@@ -101,7 +101,7 @@ arguments, defines a printer for that form using the given body."
(defun expression-precedence (expr)
(if (consp expr)
(case (car expr)
((js:slot-value js:aref) (op-precedence (car expr)))
((js:get-property js:aref) (op-precedence (car expr)))
(js:= (op-precedence 'js:=))
(js:? (op-precedence 'js:?))
(js:unary-operator (op-precedence (second expr)))
......@@ -153,7 +153,7 @@ arguments, defines a printer for that form using the given body."
(unless prefix (format *psw-stream* "~(~a~)" op)))
(defprinter js:funcall (fun-designator &rest args)
(funcall (if (member (car fun-designator) '(js:variable js:aref js:slot-value js:funcall))
(funcall (if (member (car fun-designator) '(js:variable js:aref js:get-property js:funcall))
#'ps-print
#'parenthesize-print)
fun-designator)
......@@ -194,8 +194,8 @@ arguments, defines a printer for that form using the given body."
(when remaining (psw ", ")))
(psw " }"))
(defprinter js:slot-value (obj slot)
(if (or (> (expression-precedence obj) (op-precedence 'js:slot-value))
(defprinter js:get-property (obj slot)
(if (or (> (expression-precedence obj) (op-precedence 'js:get-property))
(numberp obj)
(and (listp obj) (member (car obj) '(js:lambda js:object))))
(parenthesize-print obj)
......
......@@ -3,7 +3,7 @@
(defmacro with-local-macro-environment ((var env) &body body)
`(let* ((,var (make-macro-dictionary))
(,env (cons ,var ,env)))
,@body))
,@body))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; literals
......@@ -73,24 +73,24 @@
(let ((value (ps-macroexpand value)))
(if (consp value)
(case (car value)
(return
(ps-compile value))
((switch case)
(ps-compile
`(js:switch ,(second value)
,@(loop for (cvalue . cbody) in (cddr value) collect
(let ((last-n (if (eq 'js:break (car (last cbody)))
2
1)))
`(,cvalue ,@(butlast cbody last-n)
(return ,(car (last cbody last-n)))))))))
((with progn let flet labels)
(ps-compile (append (butlast value)
`((return ,@(last value))))))
(try
(ps-compile `(try (return ,(second value))
,@(cddr value))))
(otherwise `(js:return ,(ps-compile-expression value))))
(return
(ps-compile value))
((switch case)
(ps-compile
`(js:switch ,(second value)
,@(loop for (cvalue . cbody) in (cddr value) collect
(let ((last-n (if (eq 'js:break (car (last cbody)))
2
1)))
`(,cvalue ,@(butlast cbody last-n)
(return ,(car (last cbody last-n)))))))))
((with progn let flet labels)
(ps-compile (append (butlast value)
`((return ,@(last value))))))
(try
(ps-compile `(try (return ,(second value))
,@(cddr value))))
(otherwise `(js:return ,(ps-compile-expression value))))
`(js:return ,(ps-compile-expression value)))))
(define-ps-special-form throw (value)
......@@ -345,10 +345,10 @@ the given lambda-list and body."
;; prepended to the body of the function. Defaults and supplied-p
;; are handled using the same mechanism as with optional vars.
(multiple-value-bind (requireds optionals rest? rest keys? keys allow? aux?
aux more? more-context more-count key-object)
aux more? more-context more-count key-object)
(parse-lambda-list lambda-list)
(declare (ignore allow? aux? aux more? more-context more-count key-object))
(let* (;; optionals are of form (var default-value)
(let* ( ;; optionals are of form (var default-value)
(effective-args
(remove-if #'null
(append requireds
......@@ -380,8 +380,8 @@ the given lambda-list and body."
(reverse keys))
`(,@decls
(loop for ,n from ,(length requireds)
below (length arguments) by 2 do
(case (aref arguments ,n) ,@assigns))
below (length arguments) by 2 do
(case (aref arguments ,n) ,@assigns))
,@defaults)))
(mapcar
(lambda (k)
......@@ -399,7 +399,7 @@ the given lambda-list and body."
(when rest?
(with-ps-gensyms (i)
`(progn (var ,rest (array))
(dotimes (,i (- (slot-value arguments 'length)
(dotimes (,i (- (get-property arguments 'length)
,(length effective-args)))
(setf (aref ,rest
,i)
......@@ -430,7 +430,7 @@ lambda-list::=
(multiple-value-bind (effective-args effective-body)
(parse-extended-function lambda-list body)
`(%js-defun ,name ,effective-args
,@effective-body)))
,@effective-body)))
(defpsmacro lambda (lambda-list &body body)
"An extended defun macro that allows cool things like keyword arguments.
......@@ -443,7 +443,7 @@ lambda-list::=
(multiple-value-bind (effective-args effective-body)
(parse-extended-function lambda-list body)
`(%js-lambda ,effective-args
,@effective-body)))
,@effective-body)))
(define-ps-special-form flet (fn-defs &rest body)
(let ((fn-renames (make-macro-dictionary)))
......@@ -484,16 +484,16 @@ lambda-list::=
(compile nil
(let ((var-bindings (ordered-set-difference lambda-list lambda-list-keywords)))
`(lambda (access-fn-args store-form)
(destructuring-bind ,lambda-list
access-fn-args
(let* ((,store-var (ps-gensym))
(gensymed-names (loop repeat ,(length var-bindings) collecting (ps-gensym)))
(gensymed-arg-bindings (mapcar #'list gensymed-names (list ,@var-bindings))))
(destructuring-bind ,var-bindings
gensymed-names
`(let* (,@gensymed-arg-bindings
(,,store-var ,store-form))
,,form))))))))
(destructuring-bind ,lambda-list
access-fn-args
(let* ((,store-var (ps-gensym))
(gensymed-names (loop repeat ,(length var-bindings) collecting (ps-gensym)))
(gensymed-arg-bindings (mapcar #'list gensymed-names (list ,@var-bindings))))
(destructuring-bind ,var-bindings
gensymed-names
`(let* (,@gensymed-arg-bindings
(,,store-var ,store-form))
,,form))))))))
nil)
(defpsmacro defsetf-short (access-fn update-fn &optional docstring)
......@@ -559,29 +559,29 @@ lambda-list::=
`(js:instanceof ,(ps-compile-expression value)
,(ps-compile-expression type)))
(define-ps-special-form %js-slot-value (obj slot)
(define-ps-special-form %js-get-property (obj slot)
(let ((slot (ps-macroexpand slot)))
`(js:slot-value ,(ps-compile-expression (ps-macroexpand obj))
,(let ((slot (if (and (listp slot) (eq 'quote (car slot)))
(second slot) ;; assume we're quoting a symbol
(ps-compile-expression slot))))
(if (and (symbolp slot)
(ps-reserved-symbol-p slot))
(symbol-name-to-js-string slot)
slot)))))
(defpsmacro slot-value (obj &rest slots)
`(js:get-property ,(ps-compile-expression (ps-macroexpand obj))
,(let ((slot (if (and (listp slot) (eq 'quote (car slot)))
(second slot) ;; assume we're quoting a symbol
(ps-compile-expression slot))))
(if (and (symbolp slot)
(ps-reserved-symbol-p slot))
(symbol-name-to-js-string slot)
slot)))))
(defpsmacro get-property (obj &rest slots)
(if (null (rest slots))
`(%js-slot-value ,obj ,(first slots))
`(slot-value (slot-value ,obj ,(first slots)) ,@(rest slots))))
`(%js-get-property ,obj ,(first slots))
`(get-property (get-property ,obj ,(first slots)) ,@(rest slots))))
(defpsmacro with-slots (slots object &rest body)
(flet ((slot-var (slot) (if (listp slot) (first slot) slot))
(slot-symbol (slot) (if (listp slot) (second slot) slot)))
`(symbol-macrolet ,(mapcar #'(lambda (slot)
`(,(slot-var slot) (slot-value ,object ',(slot-symbol slot))))
`(,(slot-var slot) (get-property ,object ',(slot-symbol slot))))
slots)
,@body)))
,@body)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; assignment and binding
......@@ -801,7 +801,7 @@ lambda-list::=
,@(when introduce-array-var?
(list (list arrvar array)))
(,idx 0 (1+ ,idx)))
((>= ,idx (slot-value ,arrvar 'length))
((>= ,idx (get-property ,arrvar 'length))
,@(when result? (list result)))
(setq ,var (aref ,arrvar ,idx))
,@body)))
......@@ -819,9 +819,9 @@ lambda-list::=
(assert (or catch finally) ()
"Try form should have either a catch or a finally clause or both.")
`(js:try ,(ps-compile-statement `(progn ,form))
:catch ,(when catch (list (ps-compile-symbol (caar catch))
(ps-compile-statement `(progn ,@(cdr catch)))))
:finally ,(when finally (ps-compile-statement `(progn ,@finally))))))
:catch ,(when catch (list (ps-compile-symbol (caar catch))
(ps-compile-statement `(progn ,@(cdr catch)))))
:finally ,(when finally (ps-compile-statement `(progn ,@finally))))))
(define-ps-special-form cc-if (test &rest body)
`(js:cc-if ,test ,@(mapcar #'ps-compile-statement body)))
......
......@@ -22,7 +22,7 @@
(test-ps-js uniform-symbol-handling1
(progn (create ps-test.my-library::foo 1)
(slot-value foo 'ps-test.my-library::foo))
(get-property foo 'ps-test.my-library::foo))
"{ my_library_foo : 1 };
foo.my_library_foo;")
......@@ -60,6 +60,6 @@ foo.my_library_foo;")
(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))))
(return (and (not foo) (+ (get-property foo 'bar) some-other-var))))
"var prefix_foo = { prefix_bar : 1, prefix_notAKeyword : prefix_something };
return !prefix_foo && prefix_foo.prefix_bar + prefix_someOtherVar;")
......@@ -89,23 +89,23 @@ x = 2 + sideEffect() + x + 5;")
(a-parenthesis #\)))
(is (char= char-before a-parenthesis))))
(test-ps-js simple-slot-value
(test-ps-js simple-get-property
(let ((foo (create a 1)))
(alert (slot-value foo 'a)))
(alert (get-property foo 'a)))
"var foo = { a : 1 };
alert(foo.a);")
(test-ps-js buggy-slot-value
(test-ps-js buggy-get-property
(let ((foo (create a 1))
(slot-name "a"))
(alert (slot-value foo slot-name)))
(alert (get-property foo slot-name)))
" var foo = { a : 1 };
var slotName = 'a';
alert(foo[slotName]);
"); Last line was alert(foo.slotName) before bug-fix.
(test-ps-js buggy-slot-value-two
(slot-value foo (get-slot-name))
(test-ps-js buggy-get-property-two
(get-property foo (get-slot-name))
"foo[getSlotName()];")
(test-ps-js old-case-is-now-switch
......@@ -185,16 +185,16 @@ x = 2 + sideEffect() + x + 5;")
for wanted = (format nil "var x = 'hello\\~ahi';" js-escape)
do (is (string= (normalize-js-code generated) wanted)))))
(test-ps-js slot-value-setf
(setf (slot-value x 'y) (+ (+ a 3) 4))
(test-ps-js get-property-setf
(setf (get-property x 'y) (+ (+ a 3) 4))
"x.y = (a + 3) + 4;")
(test-ps-js slot-value-conditional1
(slot-value (if zoo foo bar) 'x)
(test-ps-js get-property-conditional1
(get-property (if zoo foo bar) 'x)
"(zoo ? foo : bar).x;")
(test-ps-js slot-value-conditional2
(slot-value (if (not zoo) foo bar) 'x)
(test-ps-js get-property-conditional2
(get-property (if (not zoo) foo bar) 'x)
"(!zoo ? foo : bar).x;")
(test script-star-eval1
......@@ -319,16 +319,16 @@ __setf_someThing(_js1, _js2, _js3);")
(create "foo" 2)
"{ 'foo' : 2 };")
(test-ps-js slot-value-string
(slot-value foo "bar")
(test-ps-js get-property-string
(get-property foo "bar")
"foo['bar'];")
(test-ps-js slot-value-string1
(slot-value "bar" 'length)
(test-ps-js get-property-string1
(get-property "bar" 'length)
"'bar'.length;")
(test-ps-js slot-value-progn
(slot-value (progn (some-fun "abc") "123") "length")
(test-ps-js get-property-progn
(get-property (progn (some-fun "abc") "123") "length")
"(someFun('abc'), '123')['length'];")
(test-ps-js method-call-block
......@@ -665,8 +665,8 @@ try {
"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 (or (get-property cache id)
(setf (get-property cache id) ((@ document get-element-by-id) id))))
"return cache[id] || (cache[id] = document.getElementById(id));")
(test-ps-js aref-operator-priority
......@@ -677,8 +677,8 @@ try {
"(x && x.length > 0 ? x[0] : y)[z];")
(test-ps-js aref-operator-priority1
(aref (or (slot-value x 'y)
(slot-value a 'b))
(aref (or (get-property x 'y)
(get-property a 'b))
z)
"(x.y || a.b)[z];")
......@@ -726,12 +726,12 @@ try {
(aref (or a b c) 0)
"(a || b || c)[0];")
(test-ps-js slot-value-operator
(slot-value (or a b c) 'd)
(test-ps-js get-property-operator
(get-property (or a b c) 'd)
"(a || b || c).d;")
(test-ps-js slot-value-parens
(slot-value (slot-value foo 'bar) 'baz)
(test-ps-js get-property-parens
(get-property (get-property foo 'bar) 'baz)
"foo.bar.baz;")
(test-ps-js funcall-funcall
......@@ -750,12 +750,12 @@ try {
(((or (@ window eval) eval)) foo nil)
"(window.eval || eval)()(foo, null);")
(test-ps-js slot-value-object-literal
(slot-value (create a 1) 'a)
(test-ps-js get-property-object-literal
(get-property (create a 1) 'a)
"({ a : 1 }).a;")
(test-ps-js slot-value-lambda
(slot-value (lambda ()) 'prototype)
(test-ps-js get-property-lambda
(get-property (lambda ()) 'prototype)
"(function () { return null; }).prototype;")
(test-ps-js who-html1
......@@ -1145,8 +1145,8 @@ x1 - x1;
(create :default 1)
"{ 'default' : 1 };")
(test-ps-js slot-value-reserved-word
(slot-value foo :default)
(test-ps-js get-property-reserved-word
(get-property foo :default)
"foo['default'];")
(test-ps-js eval-when-ps-side
......@@ -1188,8 +1188,8 @@ x1 - x1;
(declare (ignore js-output))
(is (eql :cl-user *lisp-output*))))
(test-ps-js slot-value-keyword
(slot-value foo :bar)
(test-ps-js get-property-keyword
(get-property foo :bar)
"foo['bar'];")
(test-ps-js nary-comparison1
......@@ -1199,15 +1199,15 @@ x1 - x1;
return (_cmp1 = 2, 1 < _cmp1 && _cmp1 < 3);
};")
(test-ps-js chain-slot-value1
(test-ps-js chain-get-property1
(chain ($ "foo") (bar x z) frob (baz 5))
"$('foo').bar(x, z).frob.baz(5);")
(test-ps-js chain-slot-value2
(test-ps-js chain-get-property2
(chain ($ "foo") bar baz)
"$('foo').bar.baz;")
(test-ps-js chain-slot-value3
(test-ps-js chain-get-property3
(chain ($ "foo") bar (x y) baz)
"$('foo').bar.x(y).baz;")
......
......@@ -99,7 +99,7 @@
anotherObject : { 'schtrunz' : 1 } };")
(test-ps-js object-literals-3
(slot-value an-object 'foo)
(get-property an-object 'foo)
"anObject.foo;")
(test-ps-js object-literals-4
......@@ -164,7 +164,7 @@
"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)
((get-property this 'blorg) 1 2)
"this.blorg(1, 2);")
(test-ps-js function-calls-and-method-calls-4
......@@ -172,7 +172,7 @@
"foo[i](1, 2);")
(test-ps-js function-calls-and-method-calls-5
((slot-value (aref foobar 1) 'blorg) NIL T)
((get-property (aref foobar 1) 'blorg) NIL T)
"foobar[1].blorg(null, true);")
(test-ps-js operator-expressions-1
......@@ -264,7 +264,7 @@ b = _js2;")
(test-ps-js assignment-8
(defun (setf color) (new-color el)
(setf (slot-value (slot-value el 'style) 'color) new-color))
(setf (get-property (get-property el 'style) 'color) new-color))
"function __setf_color(newColor, el) {
return el.style.color = newColor;
};")
......@@ -277,7 +277,7 @@ __setf_color(_js1, _js2);")
(test-ps-js assignment-10
(defsetf left (el) (offset)
`(setf (slot-value (slot-value ,el 'style) 'left) ,offset))