Common Lisp での Perl の $_ の適当実装

progn-$_.lisp

;;; 毎回 setf する　（lambda と相性悪い）
(defmacro progn-$_ (&body forms)
  `(let ($_)
     ,@(mapcar
	(lambda (form)
	  `(setf $_ ,form))
	forms)))

#|
CL-USER> (progn-$_ 1 2 3)
3
CL-USER> (macroexpand +)
(LET ($_) (SETF $_ 1) (SETF $_ 2) (SETF $_ 3))
T
CL-USER> (progn-$_ 1 (+ $_ 2) (+ $_ 3))
6
CL-USER> (macroexpand +)
(LET ($_) (SETF $_ 1) (SETF $_ (+ $_ 2)) (SETF $_ (+ $_ 3)))
T
|#

;;; let の nest に展開
(defmacro progn-$_ (&body forms)
  (if (> (length forms) 1)
      `(let (($_ ,(first forms)))
	 (progn-$_ ,@(rest forms)))
      (first forms)))

#|
CL-USER> (progn-$_ 1 2 3)
3
CL-USER> (progn-$_ 1 (+ $_ 2) (+ $_ 3))
6
|#

;;; 素直にlet*に展開
(defmacro progn-$_ (&body forms)
  `(let* ,(loop for form in (butlast forms)
	     collect `($_ ,form))
     ,@(last forms)))

#|
CL-USER> (progn-$_ 1 2 3)
3
CL-USER> (macroexpand +)
(LET* (($_ 1) ($_ 2)) 3)
T
CL-USER> (progn-$_ 1 (+ $_ 2) (+ $_ 3))
6
CL-USER> (macroexpand +)
(LET* (($_ 1) ($_ (+ $_ 2))) (+ $_ 3))
T
|#

;;; ここまでで (15 min)

;;; その場の package の $_ を使う（必要なら他でも可）
(defmacro progn-$_ ((&optional ($_ (intern "$_" *package*))) &body forms)
  `(let* ,(loop for form in (butlast forms)
	     collect `(,$_ ,form))
     ,@(last forms)))

#|
CL-USER> (progn-$_ () 1 2 3)
3
CL-USER> (macroexpand +)
(LET* (($_ 1) ($_ 2)) 3)
T
CL-USER> (progn-$_ () 1 (+ $_ 2) (+ $_ 3))
6
CL-USER> (macroexpand +)
(LET* (($_ 1) ($_ (+ $_ 2))) (+ $_ 3))
T
CL-USER> (progn-$_ (*) 1 (+ * 2) (+ * 3))
6
CL-USER> (macroexpand +)
(LET* ((* 1) (* (+ * 2))) (+ * 3))
T
|#