Commit ba367b0d authored by Boris Smilga's avatar Boris Smilga
Browse files

Merge pull request #9 from agrostis/upstream

Added support for getters and setters in object literals (when *js-target-version* ≥ 1.8.5).
parents fbaa506d ca62a581
(in-package #:parenscript)
(defparameter *js-target-version* 1.3)
(defparameter *js-target-version* "1.3")
(defvar *parenscript-stream* nil)
......@@ -65,6 +65,7 @@
......@@ -45,21 +45,41 @@
(define-expression-operator create (&rest arrows)
,@(loop for (key val-expr) on arrows by #'cddr collecting
(cons (cond ((and (symbolp key) (reserved-symbol-p key))
(reserved-symbol-p key))
((or (stringp key) (numberp key) (symbolp key))
((and (consp key)
(eq 'quote (first key))
(symbolp (second key))
(null (third key)))
(symbol-to-js-string (second key)))
"Slot key ~s is not one of symbol, string or number."
(compile-expression val-expr)))))
,@(loop with allow-accessors = (vstring>= *js-target-version* "1.8.5")
for (key val-expr) on arrows by #'cddr
for (accessor . accessor-args) =
(when (and allow-accessors
(consp key)
(symbolp (first key))
(symbolp (second key)))
(case (first key)
(get (and (null (third key))
`((ps-js:get ,(second key)))))
(set (and (symbolp (third key)) (null (fourth key))
`((ps-js:set ,(second key)) ,(third key))))))
(if accessor
(list accessor accessor-args
(let ((*function-block-names* ()))
(compile-function-body (third accessor)
(list val-expr))))
(cons (cond ((and (symbolp key) (reserved-symbol-p key))
(reserved-symbol-p key))
((or (stringp key) (numberp key) (symbolp key))
((and (consp key)
(eq 'quote (first key))
(symbolp (second key))
(null (third key)))
(symbol-to-js-string (second key)))
(error "Slot key ~s is not one of ~
~{~a~#[~;, or ~:;, ~]~}."
`("symbol" "string" "number"
,@(when allow-accessors
'("accessor spec"))))))
(compile-expression val-expr))))))
(define-expression-operator %js-getprop (obj slot)
(let ((expanded-slot (ps-macroexpand slot))
......@@ -260,11 +260,13 @@ vice-versa.")
(print-fun-def name args body-block))
(defun print-fun-def (name args body)
(format *psw-stream* "function ~:[~;~A~](" name (symbol-to-js-string name))
(loop for (arg . remaining) on args do
(destructuring-bind (keyword name) (if (consp name) name `(function ,name))
(format *psw-stream* "~(~A~) ~:[~;~A~]("
keyword name (symbol-to-js-string name))
(loop for (arg . remaining) on args do
(psw (symbol-to-js-string arg)) (when remaining (psw ", ")))
(psw ") ")
(ps-print body))
(psw ") ")
(ps-print body)))
(defprinter ps-js:object (&rest slot-defs)
......@@ -273,10 +275,14 @@ vice-versa.")
(let ((indent? (< 2 (length slot-defs)))
(indent *column*))
(loop for ((slot-name . slot-value) . remaining) on slot-defs do
(ps-print slot-name) (psw " : ")
(if (and (consp slot-value) (eq 'ps-js:|,| (car slot-value)))
(parenthesize-print slot-value)
(ps-print slot-value))
(if (consp slot-name)
(apply #'print-fun-def slot-name slot-value)
(ps-print slot-name) (psw " : ")
(if (and (consp slot-value)
(eq 'ps-js:|,| (car slot-value)))
(parenthesize-print slot-value)
(ps-print slot-value))))
(when remaining
(psw ",")
(if indent?
......@@ -57,3 +57,32 @@ paren-script becomes parenScript, *some-global* becomes SOMEGLOBAL."
(or (tree-search A (car x))
(unless (listp (cdr x))
(equal A (cdr x))))))))
(labels ((compare (a b op equality)
(if (not (stringp a)) (setf a (format nil "~A" a)))
(if (not (stringp b)) (setf b (format nil "~A" b)))
(loop with i := 0 and j := 0 and m and n
while (or i j)
do (multiple-value-setq (m i)
(if (and i (< i (length a)))
(parse-integer a :start i :junk-allowed t)))
(multiple-value-setq (n j)
(if (and j (< j (length b)))
(parse-integer b :start j :junk-allowed t)))
if (not m) do (setf m -1) else do (incf i)
if (not n) do (setf n -1) else do (incf j)
do (let ((op-p (funcall op m n))
(rev-op-p (funcall op n m)))
((and op-p (not (and rev-op-p equality)))
(return t))
((and rev-op-p (not (and op-p equality)))
(return nil))
((and (not (or op-p rev-op-p)) equality)
(return nil))))
finally (return equality))))
(defun vstring< (a b) (compare a b #'< nil))
(defun vstring<= (a b) (compare a b #'<= t))
(defun vstring= (a b) (compare a b #'= t))
(defun vstring>= (a b) (compare a b #'>= t))
(defun vstring> (a b) (compare a b #'> nil)))
......@@ -152,6 +152,21 @@
(create 'test "bang" 'symbol-saved-my-life "parenscript")
"({ 'test' : 'bang', 'symbolSavedMyLife' : 'parenscript' });")
(test-ps-js object-literal-property-accessors
(defun foo ()
(let ((x 10))
(create (get x) x
(set x v) (setf x v))))
"function foo() {
var x = 10;
return { get x() {
return x;
}, set x(v) {
return x = v;
} };
:js-target-version "1.8.5")
(test-ps-js object-method-apply-1
(apply (@ an-object foo) nil)
", null);")
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment