sfos/ecl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

cmp: fix evaluation order bugs in compiler macros

Browse source
This commit is contained in:
Marius Gerbershagen 2020-03-20 21:42:23 +01:00
parent dda466dd0e
commit 14d46da134
2 changed files with 8 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
src/cmp/cmpmap.lsp
View file

@ -54,8 +54,8 @@
do (let ((var (gensym)))
(setf iterators (cons var iterators)
for-statements (list* :for var in-or-on arg for-statements))))
`(loop ,@list-1-form
,@fun-with
`(loop ,@fun-with
,@list-1-form
,@for-statements
,do-or-collect (funcall ,function ,@iterators)
,@finally-form))))

10
src/cmp/cmpopt-sequence.lsp
View file

@ -210,10 +210,11 @@
(return-from expand-member
`(ffi:c-inline (,value ,list) (:object :object) :object
"ecl_member(#0,#1)" :one-liner t :side-effects nil)))))
(ext:with-unique-names (%value %sublist %elt)
(ext:with-unique-names (%value %list %sublist %elt)
`(let ((,%value ,value)
(,%list ,list)
,@init)
(do-in-list (,%elt ,%sublist ,list)
(do-in-list (,%elt ,%sublist ,%list)
(when ,(funcall test-function %value
(funcall key-function %elt))
(return ,%sublist)))))))
@ -251,10 +252,11 @@
`(ffi:c-inline (,value ,list) (:object :object) :object
"ecl_assqlp(#0,#1)" :one-liner t :side-effects nil)))))
(when test-function
(ext:with-unique-names (%value %sublist %elt %car)
(ext:with-unique-names (%value %list %sublist %elt %car)
`(let ((,%value ,value)
(,%list ,list)
,@init)
(do-in-list (,%elt ,%sublist ,list)
(do-in-list (,%elt ,%sublist ,%list)
(when ,%elt
(let ((,%car (cons-car (optional-type-check ,%elt cons))))
(when ,(funcall test-function %value