如何以 let 方式格式化嵌套的多值绑定?

How to format a nested multiple-value-bind the let way?

最近,我经常嵌套多个 return 多个值的函数。然而,与 let 不同的是,我允许将这些调用优雅地写成一个大语句,我总是以大量缩进结束。

我的问题是:有几个多值函数,例如

(defun return-1-and-2 ()
  (values 1 2))

(defun return-3-and-4 ()
  (values 3 4))

有没有可能达到和

一样的效果
(multiple-value-bind (one two)
    (return-1-and-2)
  (multiple-value-bind (three four)
      (return-3-and-4)
    (list one two three four)))

但用 let 的方式写得更简洁,例如

(multiple-let (((one two) (return-1-and-2))
               ((three four) (return-3-and-4)))
  (list one two three four))

?

图书馆中可能有类似的结构。

请注意,它更类似于 let*,而不是 let,因为范围是嵌套的。

可以写一个宏。例如:

(defmacro multiple-value-let* ((&rest bindings) &body body)

  "Sets the scope for several ((var-0 ... var-n) form)
  binding clauses, using the multiple return values of the form."

  (if (null bindings)
      `(progn ,@body)
    (destructuring-bind (((&rest vars) form) &rest rest-bindings)
        bindings
      `(multiple-value-bind ,vars
           ,form
         (multiple-value-let* ,rest-bindings
           ,@body)))))

示例:

CL-USER 33 > (walker:walk-form
              '(multiple-value-let* (((one two)    (return-1-and-2))
                                     ((three four) (return-3-and-4)))
                 (list one two three four)))
(MULTIPLE-VALUE-BIND (ONE TWO)
    (RETURN-1-AND-2)
  (MULTIPLE-VALUE-BIND (THREE FOUR)
      (RETURN-3-AND-4)
    (PROGN (LIST ONE TWO THREE FOUR))))

我有点喜欢库 let-plus,它提供了一个 let+ 具有此选项(以及其他选项)的宏:

(let+ (((&values one two) (return-1-and-2))
       ((&values three four) (return-3-and-4))
       (foo (bar))                  ; other examples
       (#(a b c) (some-vector)))    ;
  #| body… |#)

在 Serapeum 中,mvlet*

Expand a series of nested multiple-value-bind forms.

  (mvlet* ((minutes seconds (truncate seconds 60))
           (hours minutes (truncate minutes 60))
           (days hours (truncate hours 24)))
    (declare ((integer 0 *) days hours minutes seconds))
    (fmt "~d day~:p, ~d hour~:p, ~d minute~:p, ~d second~:p"
         days hours minutes seconds))

https://github.com/ruricolist/serapeum/blob/master/REFERENCE.md#mvlet-rest-bindings-body-body

我扩展了上面的内容,让 let 不仅可以处理 multiple-value-bind,还可以处理 labels。我的代码比 serapeum 的代码简单一点,因为它们处理的案例比我多。例如在 serapeum 的代码中,如果 let+ 没有特殊功能,它会扩展为普通的 let*。通过忽略那些很酷的功能,我只用了十几行就把它写完了:

(defun %let+ (body xs)
  (labels ((fun (x) (and (listp x) (> (length x) 2)))
           (mvb (x) (and (listp x) (listp (car x)))))
    (if (null xs)
      body
      (let ((x (pop xs)))
        (cond
          ((fun x) `(labels ((,(pop x) ,(pop x) ,@x))       ,(%let+ body xs)))
          ((mvb x) `(multiple-value-bind ,(pop x) ,(pop x) ,@(%let+ body xs)))
          (t       `(let (,x)                          ,(%let+ body xs))))))))

(defmacro let+ (spec &rest body) (%let+ body spec))

在这个 let+ 宏中...

  • (let+ (x (y 1))... 正常展开
  • (let+ ((fn1 (arg1 arg1b) body1))...fn1 包裹在 labels 中。
  • (let+ ((arg2a arg2b) body2))...body2 上执行 multiple-value-bind,将其结果绑定到 arg2a arg2b

示例:

(defun fn2 (x y ) (values x (+ x y)))

(defun test-let+(&optional (x 1))
  (let+ (z                          ; normal let stuff
         (y 1)                      ; normal let stuff
         (z 2)                      ; normal let stuff
         (fn1 (x y) (+ x y))        ; define a local function
         ((a b) (fn2 x (fn1 y z)))) ; call multiple-value-bind
      (format t "~&a ~a b ~a x ~a y ~a z ~a~%" a b x y z)))

扩展为:

(DEFUN TEST-LET+ (&OPTIONAL (X 1))
  (LET (Z)
    (LET ((Y 1))
      (LET ((Z 2))
        (LABELS ((FN1 (X Y)
                   (+ X Y)))
          (MULTIPLE-VALUE-BIND (A B)
              (FN2 X (FN1 Y Z))
            (FORMAT T "a ~a b ~a x ~a y ~a z ~a~%" A B X Y Z)))))))

然后这样跑....

> (test-let+) 

a 1 b 4 x 1 y 1 z 2