Plaster
New
List
Login
text
apl
aspx
asterisk
brainfuck
c
c++hdr
c++src
cassandra
ceylon
clojure
clojurescript
cmake
cobol
coffeescript
common-lisp
crystal
csharp
css
cypher-query
cython
d
dart
diff
django
dockerfile
dylan
ebnf
ecl
ecmascript
edn
eiffel
ejs
elm
erb
erlang
ez80
factor
fcl
feature
forth
fortran
fragment
gfm
go
gql
groovy
gss
haml
handlebars-template
haskell
haxe
hive
html
http
httpd-php
httpd-php-open
hxml
ini
java
javascript
json
jsp
jsx
julia
kotlin
latex
less
literate-haskell
lua
mariadb
markdown
mbox
mirc
mscgen
msgenny
mssql
mumps
mysql
n-triples
nesc
nginx-conf
nsis
objectivec
octave
oz
pascal
perl
pgp
pgp-keys
pgp-signature
pgsql
php
pig
plsql
properties
protobuf
puppet
python
q
rpm-changes
rpm-spec
rsrc
ruby
rustsrc
sas
sass
scala
scheme
scss
sieve
slim
smarty
solr
soy
sparql-query
spreadsheet
sql
squirrel
stex
styl
swift
systemverilog
tcl
textile
tiddlywiki
tiki
tlv
tornado
ttcn-asn
ttcn-cfg
turtle
twig
typescript
typescript-jsx
vb
vbscript
velocity
verilog
vertex
vhdl
vue
webidl
xml
xml-dtd
xquery
xu
yaml
z80
default
Visibility:
public
unlisted
private
(ql:quickload '(:alexandria :place-utils)) (eval-when (:compile-toplevel :load-toplevel :execute) (defun make-gensym-list (n &optional name) (loop :repeat n :collect (if name (gensym name) (gensym))))) (defmacro place-only (specs &body forms) (let ((gensyms (make-gensym-list (length specs) "ONCE-ONLY")) (specs (mapcar (lambda (spec) (etypecase spec (list (destructuring-bind (name form) spec (cons name form))) (symbol (cons spec spec)))) specs))) ;; bind in user-macro `(let ,(mapcar (lambda (g n) `(,g (gensym ,(string (car n))))) gensyms specs) ;; bind in final expansion `(place-utils:with-resolved-places (,,@(mapcar (lambda (g n) ``(,,g ,,(cdr n))) gensyms specs)) ;; bind in user-macro ,(let ,(mapcar (lambda (n g) `(,(car n) ,g)) specs gensyms) ,@forms))))) ;; Multiple evaluation of subforms -- both when getting and setting (defmacro some-macro-0 (place &body body) `(progn (setf ,place (1+ ,place)) (format t "a list: ~a~%" (list ,place ,place ,place)) ,@body)) ;; Multiple evaluation of subforms when setting (defmacro some-macro-10 (place &body body) (alexandria:once-only ((v place)) `(progn (setf ,place (1+ ,v)) (format t "a list: ~a~%" (list ,v ,v ,v)) ,@body))) ;; Everything fine, but has to be done manually by introducing a local place via ;; WITH-RESOLVED-PLACES (the equivalent of a LET with normal expressions) (defmacro some-macro-20 (place &body body) (let ((sym (gensym))) `(place-utils:with-resolved-places ((,sym ,place)) (progn (setf ,sym (1+ ,sym)) (format t "a list: ~a~%" (list ,sym ,sym ,sym)) ,@body)))) ;; Everything fine, the job is done manually by PLACE-ONLY (defmacro some-macro-30 (place &body body) (place-only (place) `(progn (setf ,place (1+ ,place)) (format t "a list: ~a~%" (list ,place ,place ,place)) ,@body))) (flet ((random-cons () (cons 1 2))) (some-macro-0 (car (random-cons)) (format t "yo~%")) (some-macro-10 (car (random-cons)) (format t "yo~%")) (some-macro-20 (car (random-cons)) (format t "yo~%")) (some-macro-30 (car (random-cons)) (format t "yo~%")))