Verified Commit b2af98bf authored by Vladimir Sedach's avatar Vladimir Sedach
Browse files

Simplified *JS-TARGET-VERSION* checks

parent 7d17a98c
...@@ -193,7 +193,7 @@ ...@@ -193,7 +193,7 @@
is not strictly necessary, as the values can be inserted inline is not strictly necessary, as the values can be inserted inline
into code).</p> into code).</p>
<p><var>*JS-TARGET-VERSION*</var> (<kbd>1.3</kbd> by default) <p><var>*JS-TARGET-VERSION*</var> (<kbd>"1.3"</kbd> by default)
controls which version of JavaScript that Parenscript controls which version of JavaScript that Parenscript
targets. For newer versions of JS, some Parenscript special targets. For newer versions of JS, some Parenscript special
forms may compile to more concise and/or efficient expressions forms may compile to more concise and/or efficient expressions
...@@ -1568,6 +1568,6 @@ someDiv.offsetLeft;</samp></pre> ...@@ -1568,6 +1568,6 @@ someDiv.offsetLeft;</samp></pre>
function argument lists to the Emacs minibuffer, like SLIME function argument lists to the Emacs minibuffer, like SLIME
already does for Common Lisp functions and macros.</p> already does for Common Lisp functions and macros.</p>
<p style="font-size:xx-small;float:right;">Last updated: 2018-10-24</p> <p style="font-size:xx-small;float:right;">Last updated: 2018-10-27</p>
</body> </body>
</html> </html>
...@@ -82,42 +82,43 @@ ...@@ -82,42 +82,43 @@
;;; objects ;;; objects
(define-expression-operator create (&rest arrows) (define-expression-operator create (&rest arrows)
`(ps-js:object (let ((allow-accessors (js-target-at-least "1.8.5")))
,@(loop with allow-accessors = (vstring>= *js-target-version* "1.8.5") (cons
for (key val-expr) on arrows by #'cddr 'ps-js:object
for (accessor . accessor-args) = (loop for (key val-expr) on arrows by #'cddr
(when (and allow-accessors for (accessor . accessor-args) =
(consp key) (when (and allow-accessors
(symbolp (first key)) (consp key)
(symbolp (second key))) (symbolp (first key))
(case (first key) (symbolp (second key)))
(get (and (null (third key)) (case (first key)
`((ps-js:get ,(second key))))) (get (and (null (third key))
(set (and (symbolp (third key)) (null (fourth key)) `((ps-js:get ,(second key)))))
`((ps-js:set ,(second key)) ,(third key)))))) (set (and (symbolp (third key)) (null (fourth key))
collecting `((ps-js:set ,(second key)) ,(third key))))))
(if accessor collecting
(list accessor accessor-args (if accessor
(let ((*function-block-names* ())) (list accessor accessor-args
(compile-function-body (third accessor) (let ((*function-block-names* ()))
(list val-expr)))) (compile-function-body (third accessor)
(cons (cond ((and (symbolp key) (reserved-symbol-p key)) (list val-expr))))
(reserved-symbol-p key)) (cons (cond ((and (symbolp key) (reserved-symbol-p key))
((or (stringp key) (numberp key) (symbolp key)) (reserved-symbol-p key))
key) ((or (stringp key) (numberp key) (symbolp key))
((and (consp key) key)
(eq 'quote (first key)) ((and (consp key)
(symbolp (second key)) (eq 'quote (first key))
(null (third key))) (symbolp (second key))
(symbol-to-js-string (second key))) (null (third key)))
(t (symbol-to-js-string (second key)))
(error "Slot key ~s is not one of ~ (t
~{~a~#[~;, or ~:;, ~]~}." (error "Slot key ~s is not one of ~
key ~{~a~#[~;, or ~:;, ~]~}."
`("symbol" "string" "number" key
,@(when allow-accessors (list* "symbol" "string" "number"
'("accessor spec")))))) (when allow-accessors
(compile-expression val-expr)))))) '("accessor spec"))))))
(compile-expression val-expr)))))))
(define-expression-operator %js-getprop (obj slot) (define-expression-operator %js-getprop (obj slot)
(let ((expanded-slot (ps-macroexpand slot)) (let ((expanded-slot (ps-macroexpand slot))
......
...@@ -126,31 +126,14 @@ Use GETPROP, @, or CHAIN instead." ...@@ -126,31 +126,14 @@ Use GETPROP, @, or CHAIN instead."
(unless (listp (cdr x)) (unless (listp (cdr x))
(equal A (cdr x)))))))) (equal A (cdr x))))))))
(labels ((compare (a b op equality) (defun parse-semver (semver-string)
(if (not (stringp a)) (setf a (format nil "~A" a))) (let ((semver-list (cl-ppcre:split "\\." semver-string))
(if (not (stringp b)) (setf b (format nil "~A" b))) (semver-scaled 0))
(loop with i := 0 and j := 0 and m and n (dotimes (i 3)
while (or i j) (incf semver-scaled
do (multiple-value-setq (m i) (* (expt 1000 (- 2 i))
(if (and i (< i (length a))) (parse-integer (or (nth i semver-list) "0")))))
(parse-integer a :start i :junk-allowed t))) semver-scaled))
(multiple-value-setq (n j)
(if (and j (< j (length b))) (defun js-target-at-least (version)
(parse-integer b :start j :junk-allowed t))) (>= (parse-semver *js-target-version*) (parse-semver version)))
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)))
(cond
((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)))
Markdown is supported
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