可以在不使用 Common Lisp 中的 eval 的情况下做到这一点



在我的小项目中,我有两个数组,我们称它们为 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。 B 中没有 num1,但有一个 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 中的值。

我希望这能在这里了解机械动作的要点。 从理论上讲,我希望行连接函数工厂能够使用任何长度/内容的数组和符号列表来做到这一点,但编写这样的函数并不超出我的范围,也不是问题。

问题是,我希望返回的函数非常高效,这意味着我不愿意让函数追逐列表指针,或在运行时查找哈希表。 在此示例中,我需要返回的函数几乎是字面意思:

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

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

我已经决定在行连接函数工厂中使用(eval )来处理表示上述 lisp 代码的符号来生成此函数。 然而,我想知道,如果没有一些更简单的方法来实现我没有想到的这个技巧,因为人们对使用 eval 的普遍谨慎......

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

欢迎提出想法、答案、建议等。 我的结论是否正确,这是那些罕见的合法评估用途之一?提前为我无法用英语雄辩地表达问题而道歉......

(或者,

如果有人可以解释我的推理在哪里,或者如何动态地产生最有效的函数......

据我了解,您需要预先计算向量大小和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)))))

请注意,我使用了一个数字来知道是否应该使用AB,而不是捕获CD,以允许它们被垃圾回收。


编辑:我建议您针对生成的函数进行分析,并观察运行时闭包的开销是否高于例如 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 之间的运行时差异真的很小,请保留闭包,以便:

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

我认为正确的方法是拥有一个在编译时计算索引的宏:

(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)

取决于您何时知道数据。如果所有数据在编译时都是已知的,则可以使用宏(根据 sds 的答案)。

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

顺便问一下,你能更详细地描述一下你的项目吗?听起来很有趣。:-)

给定CD,您可以创建一个闭包,例如

(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)))))

其中nuse-Ause-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 秒)。

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

; 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%。

相关内容

最新更新