在 Common Lisp 中不使用 eval 可以做到这一点吗？

Question

在我的小项目中，我有两个数组，我们称它们为 A 和 B。它们的值是 #(1 2 3) 和 #(5 6 7)。我还有两个相同长度的符号列表，我们称它们为 C 和 D。它们看起来像这样：(num1 num2 num3) 和 (num2 num3 num4)。

您可以说列表 C 和 D 中的符号是数组 A 和 B 中值的文本标签。因此 A 中的 num1 为 1。A 中的 num2 为 2。B 中的 num2 为 5。没有 num1在B中，但有一个num3，即6。

我的目标是生成一个带有两个参数的函数，如下所示：

(defun row-join-function-factory (C D)
...body...)

我希望它返回一个有两个参数的函数：

(lambda (A B) ...body...)

这样使用参数 A 和 B 调用的结果函数会产生一种返回新数组的“连接”：#(1 5 6 7)

在后面的函数中发生的过程从两个数组 A 和 B 中获取值，从而生成一个新数组，其成员可以由(union C D) 表示。注意：我实际上并没有运行(union C D)，因为我实际上并不关心其中包含的符号的顺序，但假设它返回(num1 num2 num3 num4)。重要的是(num1 num2 num3 num4) 作为文本标签对应于新数组#(1 5 6 7)。如果 num2 或任何符号同时存在于 C 和 D 中，并且随后表示来自 A 和 B 的值，则与该符号对应的来自 B 的值将保留在结果数组中，而不是来自 A 的值。

我希望在这里得到机械动作的要点。从理论上讲，我希望 row-join-function-factory 能够使用任何长度/内容的数组和符号列表来做到这一点，但编写这样的函数并不是我无法做到的，也不是问题。

问题是，我希望返回的函数非常高效，这意味着我不愿意让函数在列表中跟踪指针，或者在运行时查找哈希表。在这个例子中，我需要返回的函数几乎是字面意思：

      (lambda (A B) 
(make-array 4 
    :initial-contents (list (aref A 0) (aref B 0) (aref B 1) (aref B 2))))

我不希望在运行时计算数组索引，也不希望它们引用哪个数组。我想要一个编译的函数，它尽可能快地完成这个和这个，它做的工作尽可能少。我不关心制作这样一个功能所需的运行时工作，只关心应用它所需的运行时工作。

我已决定在 row-join-function-factory 中使用 (eval ) 来处理表示上述 lisp 代码的符号以生成此函数。但是，我想知道，考虑到人们对使用 eval 的普遍谨慎态度，是否有一些更简单的方法来实现我没有想到的这个技巧......

根据我的推理，我不能单独使用宏，因为它们无法知道所有值和维度 A、B、C、D 在编译时可以采用什么，而我可以编写一个返回 lambda 的函数，该函数会机械地返回做我想做的事，我相信我的版本总是会做一些额外的运行时工作/关闭变量/等等...与上面假设的 lambda 函数相比

欢迎提出想法、答案、建议等。我的结论是否正确，这是一种罕见的合法 eval 用途？对于我无法用英语雄辩地表达这个问题提前道歉......

（或者，如果有人可以解释我的推理在哪里出错，或者如何动态生成最有效的函数......）

Answer 1

据我了解，您需要预先计算矢量大小和 aref 参数。

(defun row-join-function-factory (C D)
  (flet ((add-indices (l n)
           (loop for el in l and i from 0 collect (list el n i))))
    (let* ((C-indices (add-indices C 0))
           (D-indices (add-indices D 1))
           (all-indices (append D-indices
                                (set-difference C-indices
                                                D-indices
                                                :key #'first)))
           (ns (mapcar #'second all-indices))
           (is (mapcar #'third all-indices))
           (size (length all-indices)))
      #'(lambda (A B)
          (map-into (make-array size)
                    #'(lambda (n i)
                        (aref (if (zerop n) A B) i))
                    ns is)))))

请注意，我使用了一个数字来了解是否应该使用 A 或 B 而不是捕获 C 和 D，以便对它们进行垃圾收集。

---

编辑：我建议您针对生成的函数进行分析，并观察运行时闭包的开销是否高于例如5%，针对特殊用途的功能：

(defun row-join-function-factory (C D)
  (flet ((add-indices (l n)
           (loop for el in l and i from 0 collect (list el n i))))
    (let* ((C-indices (add-indices C 0))
           (D-indices (add-indices D 1))
           (all-indices (append D-indices
                                (set-difference C-indices
                                                D-indices
                                                :key #'first)))
           (ns (mapcar #'second all-indices))
           (is (mapcar #'third all-indices))
           (size (length all-indices))
           (j 0))
      (compile
       nil
       `(lambda (A B)
          (let ((result (make-array ,size)))
            ,@(mapcar #'(lambda (n i)
                          `(setf (aref result ,(1- (incf j)))
                                 (aref ,(if (zerop n) 'A 'B) ,i)))
                      ns is)
            result))))))

并验证编译开销是否确实在您的实现中得到了回报。

我认为如果闭包和编译后的 lambda 之间的运行时差异非常小，请保留闭包，因为：

• 更简洁的编码风格
• 根据实现，调试可能更容易
• 根据实现，生成的闭包将共享函数代码（例如闭包模板函数）
• 在某些商业实现中不需要包含编译器的运行时许可证

Answer 2

我认为正确的方法是使用一个宏来在编译时计算索引：

(defmacro my-array-generator (syms-a syms-b)
  (let ((table '((a 0) (b 0) (b 1) (b 2)))) ; compute this from syms-a and syms-b
    `(lambda (a b)
       (make-array ,(length table) :initial-contents
             (list ,@(mapcar (lambda (ai) (cons 'aref ai)) table))))))

它会产生你想要的：

(macroexpand '(my-array-generator ...))
==>
#'(LAMBDA (A B)
    (MAKE-ARRAY 4 :INITIAL-CONTENTS
                (LIST (AREF A 0) (AREF B 0) (AREF B 1) (AREF B 2))))

所以，剩下的就是写一个函数来生成

((a 0) (b 0) (b 1) (b 2))

给定

syms-a = (num1 num2 num3) 

和

syms-b = (num2 num3 num4)

Answer 3

取决于您何时知道数据。如果在编译时所有数据都是已知的，则可以使用宏（根据 sds 的回答）。

如果数据在运行时已知，您应该考虑将其从现有数组加载到二维数组中。这 - 使用适当优化的编译器 - 应该意味着查找是几个 muls、一个 add 和一个 dereference。

顺便说一下，您能更详细地描述一下您的项目吗？听起来很有趣。 :-)

Answer 4

给定C 和D，您可以创建类似的闭包

(lambda (A B)
   (do ((result (make-array n))
        (i 0 (1+ i)))
       ((>= i n) result)
     (setf (aref result i)
           (aref (if (aref use-A i) A B)
                 (aref use-index i)))))

其中n、use-A 和use-index 是在闭包中捕获的预计算值，例如

n         --> 4
use-A     --> #(T nil nil nil)
use-index --> #(0 0 1 2)

用 SBCL（速度 3）（安全 0）检查，执行时间与 make-array + initial-contents 版本基本相同，至少对于这个简单的情况。

当然，使用这些预先计算的数据表创建闭包甚至不需要宏。

您是否实际计算过使用展开的编译版本要节省多少（如果有的话）？

编辑

用SBCL做一个实验生成的闭包

(defun merger (clist1 clist2)
  (let ((use1 (list))
        (index (list))
        (i1 0)
        (i2 0))
    (dolist (s1 clist1)
      (if (find s1 clist2)
          (progn
            (push NIL use1)
            (push (position s1 clist2) index))
          (progn
            (push T use1)
            (push i1 index)))
      (incf i1))
    (dolist (s2 clist2)
      (unless (find s2 clist1)
        (push NIL use1)
        (push i2 index))
      (incf i2))
    (let* ((n (length index))
           (u1 (make-array n :initial-contents (nreverse use1)))
           (ix (make-array n :initial-contents (nreverse index))))
      (declare (type simple-vector ix)
               (type simple-vector u1)
               (type fixnum n))
      (print (list u1 ix n))
      (lambda (a b)
        (declare (type simple-vector a)
                 (type simple-vector b))
        (let ((result (make-array n)))
          (dotimes (i n)
            (setf (aref result i)
                  (aref (if (aref u1 i) a b)
                        (aref ix i))))
          result)))))

运行速度比提供相同类型声明的手写版本慢约 13%（(a b c d)(b d e f) 情况下 100,000,000 次调用的 2.878 秒而不是 2.529 秒，6 元素输出）。

基于数据的闭包版本的内部循环编译为

; 470: L2:   4D8B540801       MOV R10, [R8+RCX+1]   ; (aref u1 i)
; 475:       4C8BF7           MOV R14, RDI          ; b
; 478:       4C8BEE           MOV R13, RSI          ; source to use (a for now)
; 47B:       4981FA17001020   CMP R10, 537919511    ; (null R10)?
; 482:       4D0F44EE         CMOVEQ R13, R14       ; if true use b instead
; 486:       4D8B540901       MOV R10, [R9+RCX+1]   ; (aref ix i)
; 48B:       4B8B441501       MOV RAX, [R13+R10+1]  ; load (aref ?? i)
; 490:       4889440B01       MOV [RBX+RCX+1], RAX  ; store (aref result i)
; 495:       4883C108         ADD RCX, 8            ; (incf i)
; 499: L3:   4839D1           CMP RCX, RDX          ; done?
; 49C:       7CD2             JL L2                 ; no, loop back

条件不是编译为跳转，而是编译为条件赋值 (CMOVEQ)。

我看到了一点改进的空间（例如，直接使用 CMOVEQ R13, RDI，保存一条指令并释放一个寄存器），但我认为这不会减少 13%。