-
Notifications
You must be signed in to change notification settings - Fork 0
/
reclet.lisp
41 lines (37 loc) · 1.38 KB
/
reclet.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
;;;; RECLET -- a recursive LET for Common Lisp
;;;; by David Sorokin <david.sorokin@gmail.com>, 2012
;;;;
;;;; Licensed under MIT. See LICENSE for details.
(defpackage :reclet
(:use :cl :trivial-lazy)
(:export #:reclet))
(in-package :reclet)
;;(defmacro reclet (((name value)) &body body)
;; (let ((x (gensym)))
;; `(let ((,x (cons nil nil)))
;; (symbol-macrolet ((,name (force (car ,x))))
;; (setf (car ,x) (delay ,value :thread-safe t))
;; ,@body))))
(defmacro reclet (decls &body body)
(labels
((make-infos (decls)
(loop for decl in decls collect
(destructuring-bind (name value) decl
(list :name name :value value :gen (gensym)))))
(gen-let (info)
`(,(getf info :gen) nil))
(gen-symbol-macrolet (info)
`(,(getf info :name) (force ,(getf info :gen))))
(gen-setf (info)
`(setf ,(getf info :gen) (delay ,(getf info :value))))
(gen-lets (infos)
(loop for info in infos collect (gen-let info)))
(gen-symbol-macrolets (infos)
(loop for info in infos collect (gen-symbol-macrolet info)))
(gen-setfs (infos)
(loop for info in infos collect (gen-setf info))))
(let ((infos (make-infos decls)))
`(let (,@(gen-lets infos))
(symbol-macrolet (,@(gen-symbol-macrolets infos))
,@(gen-setfs infos)
,@body)))))