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

Simplified *JS-TARGET-VERSION* checks

parent 7d17a98c
......@@ -193,7 +193,7 @@
is not strictly necessary, as the values can be inserted inline
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
targets. For newer versions of JS, some Parenscript special
forms may compile to more concise and/or efficient expressions
......@@ -1568,6 +1568,6 @@ someDiv.offsetLeft;</samp></pre>
function argument lists to the Emacs minibuffer, like SLIME
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>
</html>
......@@ -82,42 +82,43 @@
;;; objects
(define-expression-operator create (&rest arrows)
`(ps-js:object
,@(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))))))
collecting
(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))
key)
((and (consp key)
(eq 'quote (first key))
(symbolp (second key))
(null (third key)))
(symbol-to-js-string (second key)))
(t
(error "Slot key ~s is not one of ~
~{~a~#[~;, or ~:;, ~]~}."
key
`("symbol" "string" "number"
,@(when allow-accessors
'("accessor spec"))))))
(compile-expression val-expr))))))
(let ((allow-accessors (js-target-at-least "1.8.5")))
(cons
'ps-js:object
(loop 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))))))
collecting
(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))
key)
((and (consp key)
(eq 'quote (first key))
(symbolp (second key))
(null (third key)))
(symbol-to-js-string (second key)))
(t
(error "Slot key ~s is not one of ~
~{~a~#[~;, or ~:;, ~]~}."
key
(list* "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))
......
......@@ -126,31 +126,14 @@ Use GETPROP, @, or CHAIN instead."
(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)))
(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)))
(defun parse-semver (semver-string)
(let ((semver-list (cl-ppcre:split "\\." semver-string))
(semver-scaled 0))
(dotimes (i 3)
(incf semver-scaled
(* (expt 1000 (- 2 i))
(parse-integer (or (nth i semver-list) "0")))))
semver-scaled))
(defun js-target-at-least (version)
(>= (parse-semver *js-target-version*) (parse-semver version)))
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