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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; PLUSPLUS ;;; ;;; This macro has a multiple evaluation bug (of the place's subforms)! I is ;;; incremented twice and ends up (1) reading the second element but (2) writing ;;; to the third element. (defmacro plusplus (place &optional delta-form) "Destructively increment place value; However, return the original value." (let ((place-before (gensym))) `(let ((,place-before ,place)) (incf ,place ,delta-form) ,place-before))) (let ((list (list 1 2 3)) (i 0)) (let ((old (plusplus (nth (incf i) list) 3))) (values old i list))) ;; => 2, 2, (1 2 6) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; PLUSPLUS1 ;;; ;;; A version that uses DEFINE-MODIFY-MACRO and avoids the multiple evaluation ;;; bug, but returns the new value instead of the old value (DEFINE-MODIFY-MACRO ;;; therefore isn't suitable here). (defun plusplus1-fn (value delta) (+ value delta)) (define-modify-macro plusplus1 (delta) plusplus1-fn) (let ((list (list 1 2 3)) (i 0)) (let ((old (plusplus1 (nth (incf i) list) 3))) (values old i list))) ;; => 5, 1, (1 5 3) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; PLUSPLUS2 ;;; ;;; A correct version that manually uses GET-SETF-EXPANSION to access the place. (defmacro plusplus2 (place delta &environment env) (let ((old (gensym))) (multiple-value-bind (temps exprs stores set get) (get-setf-expansion place env) `(let* (,@(mapcar #'list temps exprs) (,old ,get) (,(first stores) (+ ,get ,delta))) ,set ,old)))) (let ((list (list 1 2 3)) (i 0)) (let ((old (plusplus2 (nth (incf i) list) 3))) (values old i list))) ;; => 2, 1, (1, 5, 3) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; PLUSPLUS3 ;;; ;;; More fun! A version that uses my PLACE-ONLY. (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))))) ;;; A version of ONCE-ONLY for places, building on the crazily fun PLACE-UTILS ;;; library. (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))))) ;;; The definition is now trivial and resembles the definition of a "normal" ;;; macro trying to avoid multiple evaluation! (defmacro plusplus3 (place delta) (place-only (place) `(prog1 ,place (incf ,place ,delta)))) (let ((list (list 1 2 3)) (i 0)) (let ((old (plusplus3 (nth (incf i) list) 3))) (values old i list))) ;; => 2, 1, (1, 5, 3)