[xyzzy:04095] fluid-let

[Yutaka OIWA <oiwa@xxxxxxxxxxxxxxxxxxxxx>]

おおいわです。

ちょっとマクロをひねって、こんなものを書いてみました。
もし需要があれば御自由にお使い下さい。

# 実は下の方の解説コメントの ex.1 のためだけに作った (^^;


(provide "fluid-let")

(defmacro fluid-let (let-form &rest formals)
  (labels ((mv-setq-helper (vars n l)
			   (if (null vars)
			       nil
			     (cons `(setq ,(car vars) (nth ,n ,l))
				   (mv-setq-helper (cdr vars) (1+ n) l)))))
    (let* ((sym (gentemp))
	   (sym2 (gentemp))
	   (vars (mapcar 'car let-form))
	   (sets (mv-setq-helper vars 0 sym2))
	   (restores (mv-setq-helper vars 0 sym)))
      `(let ((,sym (list ,@vars))
	     (,sym2 (list ,@(mapcar #'(lambda (x) (cadr x)) let-form))))
	 (unwind-protect
	     (progn
	       ,@sets
	       nil ;; if formals are missing, result is nil
	       ,@formals)
	   ,@restores)))))

(defmacro fluid-let* (let-form &rest formals)
  (labels ((mv-setq-helper (vars n l)
			   (if (null vars)
			       nil
			     (cons `(setq ,(car vars) (nth ,n ,l))
				   (mv-setq-helper (cdr vars) (1+ n) l)))))
    (let* ((sym (gentemp))
	   (vars (mapcar 'car let-form))
	   (setqs (mapcar #'(lambda (x) `(setq ,(car x) ,(cadr x))) let-form))
	   (restores (mv-setq-helper vars 0 sym)))
      `(let ((,sym (list ,@vars)))
	 (unwind-protect
	     (progn
	       ,@setqs
	       nil ;; if formals are missing, result is nil
	       ,@formals)
	   ,@restores)))))

;; ex.1
;; (fluid-let ((buffer-read-only nil)) (insert "abc"))

;; ex.2
;; (setq a 1 b 2)                     ==> 2
;; (defun test () (list a b))         ==> test
;; (let ((a 3) (b 4)) (test))         ==> (1 2)
;; (fluid-let ((a 3) (b a)) (test))   ==> (3 1)
;; (fluid-let* ((a 3) (b a)) (test))  ==> (3 3)
;; (test)                             ==> (1 2)
;; (fluid-let ((a 3) (b a)))          ==> nil

;; (insert (format nil "~a" (macroexpand '(fluid-let* ((a 3) (b a)) (test)))))

-- 
大岩 寛   Yutaka Oiwa        
       東京大学大学院 理学系研究科情報科学専攻 修士課程 米澤研究室
      <oiwa@xxxxxxxxxxxxxxxxxxxxx>, <yutaka@xxxxxxxxxxxxxxxxxxxxx>
PGP fingerprint = C9 8D 5C B8 86 ED D8 07  EA 59 34 D8 F4 65 53 61