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)) (defmacro with-defer (&body body) (alexandria:with-gensyms (b thunks) `(let (,thunks) (unwind-protect (macrolet ((defer (&body ,b) `(push (lambda () ,@,b) ,',thunks))) ,@body) (map nil #'funcall ,thunks))))) (defmacro returning% (symbols wrapper &body body) (alexandria:with-gensyms (results) `(let (,@symbols) (,wrapper (let ((,results (multiple-value-list (progn ,@body)))) ,@(loop :for symbol :in symbols :collect `(unless (null ,results) (setf ,symbol (pop ,results)))))) (values ,@symbols)))) (defmacro returning (symbols &body body) `(returning% ,symbols progn ,@body)) (defmacro defun+ (name-and-return arglist &body body) (multiple-value-bind (body declarations documentation) (alexandria:parse-body body :documentation t) (multiple-value-bind (name symbols has-named-return) (etypecase name-and-return (symbol (values name-and-return nil nil)) (cons (values (first name-and-return) (rest name-and-return) t))) `(defun ,name ,arglist ,@(when documentation (list documentation)) ,@declarations ,(if has-named-return `(returning% ,symbols with-defer ,@body) `(with-defer ,@body)))))) (defun+ foo () (print "foo") (defer (print 1)) (print "bar") (defer (print 2)) (print "baz") :result) (defun+ (bar r1 r2) (x) (defer (print "foo")) (defer (setf r2 :actually)) (defer (setf r2 :garbage)) (print "here we are!") (values (+ x 1) (+ x 2))) (defun+ (example r1 r2 r3 r4 r5) () (setf r2 :garbage) (defer (setf r5 'e)) (setf r4 'd) (values 'a 'b))