->とcut

l4u!の->演算子ってどんなだったかなと思い出しながら書いていたら、全く別物になってしまいました。

• >がブロックをつくり、直前の式の評価値が、次の式の最後に暗黙的に渡されます。

(-> (list 1 2 3)
    (princ)
    (mapcar #'(lambda (x) (+ x 10))))
;; (1 2 3)
;; => (11 12 13)

"_"で直前の値を埋め込む場所を明示出来ます。

(-> (consp '(a . b))
    (if _ 'cons 'not-cons))
;; => CONS

埋め込む場所を明示する場合、_1,_2,...で多値を受けることも出来ます。

(-> (values (list 1 2 3)
	    (list 4 5 6))
            (mapcar #'+ _1 _2))
;; => (5 7 9)

これを使うと、第二戻り値が簡単に受けられます。

(defvar ht (make-hash-table))
;; => HT
(setf (gethash 'a ht) 'hoge)
;; => HOGE
(-> (gethash 'a ht) _2)
;; => T
(-> (gethash 'b ht) _2)
;; => NIL

ついでに_1,_2の展開論理を使って、cutっぽいものも作れました。

(macroexpand '(cut + 1))
;; => #'(LAMBDA (_) (+ 1 _))
;;    T

(macroexpand '(cut list 1 _1 3 _2 5))
;; => #'(LAMBDA (|_1| |_2|) (LIST 1 |_1| 3 |_2| 5))
;;    T

(funcall (cut list 1 _1 3 _2 5) 2 4)
;; => (1 2 3 4 5) 

「listの全要素に10を足してから、全要素を20倍する」は->とcutを使うと、次のように書けます。

(-> (list 1 2 3)
    (mapcar (cut + 10))
    (mapcar (cut * 20)))
;; => (220 240 260)

ただし、今の実装だと、->の_と干渉してしまいます。

(-> (list 1 2 3)
    (mapcar (cut - _ 5)))
;; => エラー：mapcarへの引数不足
(-> (list 1 2 3)
    (mapcar (cut - _ 5) _))
;; => (-4 -3 -2)

やたらと長くなった実装↓

(defpackage :implicit-params
    (:use :cl)
  (:export :|->| :cut))

(in-package :implicit-params)

(defun flatten (list)
  (labels ((iter (l acc)
	     (cond ((null l)        acc)
		   ((consp (car l)) (iter (cdr l) (iter (car l) acc)))
		   (t               (iter (cdr l) (cons (car l) acc))))))
    (nreverse (iter list '()))))

(defun rest2 (list)
  (rest (rest list)))

(defmacro let1 (var val &body body)
  `(let ((,var ,val))
     ,@body))
     
(defun _symbol-p (sym)
  (and (symbolp sym)
       (eql (char (symbol-name sym) 0) #\_)
       (every #'digit-char-p (subseq (symbol-name sym) 1))))

(defun _symbol-num (sym)
  (if (not (_symbol-p sym)) 0
      (multiple-value-bind (val index) (parse-integer (subseq (symbol-name sym) 1) :junk-allowed t)
	(if (> index 0) val 0))))

(defun max-_symbol-num (exp)
  (if (null exp) 0
      (reduce #'(lambda (n m) (max n m)) (flatten exp) :key #'_symbol-num)))

(defun generate-_-var (exp)
  (let ((n (max-_symbol-num exp)))
    (if (= n 0) '(_)
	(loop for i from 1 to n collect (intern (format nil "_~a" i))))))

(defun maybe-insert (it exp)
  (cond ((null exp) (list it))
	((atom exp) (maybe-insert it `(progn ,exp)))
	(t (if (find-if #'_symbol-p (flatten exp))
	     exp
	     (nreverse (cons it (reverse exp)))))))

(defmacro -> (&body body)
  (cond ((endp (rest body)) (first body))
	(t (let1 m-v-b-var (generate-_-var (second body))
	     `(multiple-value-bind ,m-v-b-var ,(first body)
		(declare (ignorable ,@m-v-b-var))
		(-> ,(maybe-insert '_ (second body))
		    ,@(rest2 body)))))))

(defmacro cut (func &rest args)
  (let1 lambda-var (generate-_-var args)
    `(lambda ,lambda-var
       (,func ,@(maybe-insert '_ args)))))