Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
parenscript
parenscript
Commits
b2af98bf
Verified
Commit
b2af98bf
authored
Oct 27, 2018
by
Vladimir Sedach
Browse files
Simplified *JS-TARGET-VERSION* checks
parent
7d17a98c
Changes
3
Hide whitespace changes
Inline
Side-by-side
docs/reference.html
View file @
b2af98bf
...
...
@@ -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-2
4
</p>
<p
style=
"font-size:xx-small;float:right;"
>
Last updated: 2018-10-2
7
</p>
</body>
</html>
src/non-cl.lisp
View file @
b2af98bf
...
...
@@ -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
))
...
...
src/utils.lisp
View file @
b2af98bf
...
...
@@ -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
)))
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment