Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
parenscript
parenscript
Commits
101b09ed
Commit
101b09ed
authored
Feb 10, 2015
by
Boris Smilga
Browse files
Merge pull request #16 from agrostis/upstream-quater
Fix for
https://github.com/vsedach/Parenscript/issues/15
parents
ba367b0d
9b18f5b6
Changes
1
Hide whitespace changes
Inline
Side-by-side
src/special-operators.lisp
View file @
101b09ed
...
...
@@ -393,84 +393,6 @@ Parenscript now implements implicit return, update your code! Things like (lambd
`
(
ps-js:block
(
ps-js:var
,
test-result
)
,
if-form
)
if-form
)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; macros
(
defmacro
with-local-macro-environment
((
var
env
)
&body
body
)
`
(
let*
((
,
var
(
make-macro-dictionary
))
(
,
env
(
cons
,
var
,
env
)))
,@
body
))
(
define-expression-operator
macrolet
(
macros
&body
body
)
(
with-local-macro-environment
(
local-macro-dict
*macro-env*
)
(
dolist
(
macro
macros
)
(
destructuring-bind
(
name
arglist
&body
body
)
macro
(
setf
(
gethash
name
local-macro-dict
)
(
eval
(
make-ps-macro-function
arglist
body
)))))
(
ps-compile
`
(
locally
,@
body
))))
(
define-expression-operator
symbol-macrolet
(
symbol-macros
&body
body
)
(
with-local-macro-environment
(
local-macro-dict
*symbol-macro-env*
)
(
with-declaration-effects
(
body
body
)
(
let
(
local-var-bindings
)
(
dolist
(
macro
symbol-macros
)
(
destructuring-bind
(
name
expansion
)
macro
(
setf
(
gethash
name
local-macro-dict
)
(
lambda
(
x
)
(
declare
(
ignore
x
))
expansion
))
(
push
name
local-var-bindings
)))
(
let
((
*enclosing-lexicals*
(
append
local-var-bindings
*enclosing-lexicals*
)))
(
ps-compile
`
(
progn
,@
body
)))))))
(
define-expression-operator
defmacro
(
name
args
&body
body
)
(
eval
`
(
defpsmacro
,
name
,
args
,@
body
))
nil
)
(
define-expression-operator
define-symbol-macro
(
name
expansion
)
(
eval
`
(
define-ps-symbol-macro
,
name
,
expansion
))
nil
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; assignment
(
defun
assignment-op
(
op
)
(
getf
'
(
ps-js:+
ps-js:+=
ps-js:~
ps-js:~=
ps-js:&
ps-js:&=
ps-js:-
ps-js:-=
ps-js:*
ps-js:*=
ps-js:%
ps-js:%=
ps-js:>>
ps-js:>>=
ps-js:^
ps-js:^=
ps-js:<<
ps-js:<<=
ps-js:>>>
ps-js:>>>=
ps-js:/
ps-js:/=
)
op
))
(
define-expression-operator
ps-assign
(
lhs
rhs
)
(
let
((
rhs
(
ps-macroexpand
rhs
)))
(
if
(
and
(
listp
rhs
)
(
eq
(
car
rhs
)
'progn
))
(
ps-compile
`
(
progn
,@
(
butlast
(
cdr
rhs
))
(
ps-assign
,
lhs
,
(
car
(
last
(
cdr
rhs
))))))
(
let
((
lhs
(
compile-expression
lhs
))
(
rhs
(
compile-expression
rhs
)))
(
aif
(
and
(
listp
rhs
)
(
=
3
(
length
rhs
))
(
equal
lhs
(
second
rhs
))
(
assignment-op
(
first
rhs
)))
(
list
it
lhs
(
if
(
fourth
rhs
)
(
cons
(
first
rhs
)
(
cddr
rhs
))
(
third
rhs
)))
(
list
'ps-js:=
lhs
rhs
))))))
(
define-statement-operator
defvar
(
name
&optional
(
value
(
values
)
value-provided?
)
documentation
)
;; this must be used as a top-level form, otherwise the resulting
;; behavior will be undefined.
(
declare
(
ignore
documentation
))
(
pushnew
name
*special-variables*
)
(
ps-compile
`
(
var
,
name
,@
(
when
value-provided?
(
list
value
)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; binding
...
...
@@ -578,6 +500,84 @@ Parenscript now implements implicit return, update your code! Things like (lambd
(
with-declaration-effects
(
body
body
)
(
ps-compile
`
(
progn
,@
body
))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; macros
(
defmacro
with-local-macro-environment
((
var
env
)
&body
body
)
`
(
let*
((
,
var
(
make-macro-dictionary
))
(
,
env
(
cons
,
var
,
env
)))
,@
body
))
(
define-expression-operator
macrolet
(
macros
&body
body
)
(
with-local-macro-environment
(
local-macro-dict
*macro-env*
)
(
dolist
(
macro
macros
)
(
destructuring-bind
(
name
arglist
&body
body
)
macro
(
setf
(
gethash
name
local-macro-dict
)
(
eval
(
make-ps-macro-function
arglist
body
)))))
(
ps-compile
`
(
locally
,@
body
))))
(
define-expression-operator
symbol-macrolet
(
symbol-macros
&body
body
)
(
with-local-macro-environment
(
local-macro-dict
*symbol-macro-env*
)
(
with-declaration-effects
(
body
body
)
(
let
(
local-var-bindings
)
(
dolist
(
macro
symbol-macros
)
(
destructuring-bind
(
name
expansion
)
macro
(
setf
(
gethash
name
local-macro-dict
)
(
lambda
(
x
)
(
declare
(
ignore
x
))
expansion
))
(
push
name
local-var-bindings
)))
(
let
((
*enclosing-lexicals*
(
append
local-var-bindings
*enclosing-lexicals*
)))
(
ps-compile
`
(
progn
,@
body
)))))))
(
define-expression-operator
defmacro
(
name
args
&body
body
)
(
eval
`
(
defpsmacro
,
name
,
args
,@
body
))
nil
)
(
define-expression-operator
define-symbol-macro
(
name
expansion
)
(
eval
`
(
define-ps-symbol-macro
,
name
,
expansion
))
nil
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; assignment
(
defun
assignment-op
(
op
)
(
getf
'
(
ps-js:+
ps-js:+=
ps-js:~
ps-js:~=
ps-js:&
ps-js:&=
ps-js:-
ps-js:-=
ps-js:*
ps-js:*=
ps-js:%
ps-js:%=
ps-js:>>
ps-js:>>=
ps-js:^
ps-js:^=
ps-js:<<
ps-js:<<=
ps-js:>>>
ps-js:>>>=
ps-js:/
ps-js:/=
)
op
))
(
define-expression-operator
ps-assign
(
lhs
rhs
)
(
let
((
rhs
(
ps-macroexpand
rhs
)))
(
if
(
and
(
listp
rhs
)
(
eq
(
car
rhs
)
'progn
))
(
ps-compile
`
(
progn
,@
(
butlast
(
cdr
rhs
))
(
ps-assign
,
lhs
,
(
car
(
last
(
cdr
rhs
))))))
(
let
((
lhs
(
compile-expression
lhs
))
(
rhs
(
compile-expression
rhs
)))
(
aif
(
and
(
listp
rhs
)
(
=
3
(
length
rhs
))
(
equal
lhs
(
second
rhs
))
(
assignment-op
(
first
rhs
)))
(
list
it
lhs
(
if
(
fourth
rhs
)
(
cons
(
first
rhs
)
(
cddr
rhs
))
(
third
rhs
)))
(
list
'ps-js:=
lhs
rhs
))))))
(
define-statement-operator
defvar
(
name
&optional
(
value
(
values
)
value-provided?
)
documentation
)
;; this must be used as a top-level form, otherwise the resulting
;; behavior will be undefined.
(
declare
(
ignore
documentation
))
(
pushnew
name
*special-variables*
)
(
ps-compile
`
(
var
,
name
,@
(
when
value-provided?
(
list
value
)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; iteration
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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