Common lisp：在单独的线程中调用 class 方法

Question

我正在尝试为个人项目（也学习 lisp）构建 Golang 通道构造的通用 lisp 实现。 到目前为止，我已经将通道实现为 class 的对象，其中包含一个队列、一个锁和一个条件变量，用于向监听函数发出新消息已添加到队列的信号。 我正在使用波尔多线程来创建线程、锁、条件变量并加入执行（来自lisp cookbook ）。

这是频道 class 和接收recive ：

(defclass channel ()
  ((messages :initform '()
             :accessor messages
             :documentation "Messages in the channel")
   (lock :initform (bt:make-lock)
         :accessor lock
         :documentation
         "Lock to push/pop messages in the channel")
   (cv :initarg :cv
       :initform (bt:make-condition-variable)
       :accessor cv
       :documentation
       "Condtional variable to notify the channel of a new message")))


(defmethod recive-loop ((self channel))
  (with-slots (lock cv messages) self
    (let ((to-ret nil))
    (loop
     (bt:with-lock-held (lock)
       (if (not (null messages))
           (setf to-ret (car (pop messages)))
           (bt:condition-wait cv lock))
       (if to-ret (return to-ret)))))))

(defmethod recive ((self channel))
  (with-slots (name thread) self
    (let ((thread
            (bt:make-thread #'(lambda() (recive-loop self))
                            :name name)))
      (bt:join-thread thread))))

(defmacro gorun (f &rest args)
  (flet ((fn () (apply f args)))
    (bt:make-thread #'fn
            :initial-bindings (list args)
            :name "gorun worker")))

gorun应该相当于go routine() for go（没有轻线程）。 为了测试设置，我在通道上构建了一台打印机 function

(defvar printch (channel))

(defun printover (ch)
  (let ((x (recive ch)))
    (format t "Recived variable x: ~d~%" x)))

但是当我跑的时候

(gorun printover printch)

解释器（使用sbcl ，但使用clisp会发生同样的情况）返回一个错误：

There is no applicable method for the generic function
  #<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::RECIVE (1)>
when called with arguments
  (PRINTCH).
   [Condition of type SB-PCL::NO-APPLICABLE-METHOD-ERROR]
See also:
  Common Lisp Hyperspec, 7.6.6 [:section]

Restarts:
 0: [RETRY] Retry calling the generic function.
 1: [ABORT] abort thread (#<THREAD "gorun worker" RUNNING {100293E9F3}>)

Backtrace:
  0: ((:METHOD NO-APPLICABLE-METHOD (T)) #<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::RECIVE (1)> PRINTCH) [fast-method]
      Locals:
        SB-PCL::ARGS = (PRINTCH)
        GENERIC-FUNCTION = #<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::RECIVE (1)>
  1: (SB-PCL::CALL-NO-APPLICABLE-METHOD #<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::RECIVE (1)> (PRINTCH))
      Locals:
        ARGS = (PRINTCH)
        GF = #<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::RECIVE (1)>
  2: (PRINTOVER PRINTCH)
      Locals:
        CH = PRINTCH
  3: ((LAMBDA NIL :IN BORDEAUX-THREADS::BINDING-DEFAULT-SPECIALS))
      [No Locals]

我很困惑，因为在通道printch上运行的方法应该是我定义的方法。

试图在新线程中调用 class 方法，但no applicable method

Answer 1

宏应该返回代码以代替原始调用运行。 您的宏在扩展时创建线程。

如果您没有在宏定义中使用反引号，那么它通常有问题。 您应该弄清楚没有宏的代码会是什么样子，然后定义一个宏，该宏在反引号列表中返回具有相同结构的代码，替换需要随参数变化的地方，使用逗号扩展它们。

(defmacro gorun (f &rest args)
  `(bt:make-thread (function ,f)
        :initial-bindings (list ,@args)
        :name "gorun worker"))

在上面，您需要将 function 名称替换为(function...)表达式，并将args列表替换为:initial-bindings参数。

Answer 2

在多线程环境中，特殊变量通常是线程局部的。 全局绑定对所有线程都是可见的，但是如果您在本地绑定一个线程，它的值将不会自动传输到在该上下文中创建的线程。 它必须明确地完成，我最近为此编写了一对宏。

第一个将绑定捕获到词法范围的变量中； 另一个将原始变量绑定回在不同上下文中捕获的值。

我在代码中使用中间数据结构来存储绑定：

(defstruct bindings data)

第一个宏是with-captured-bindings ：

(defmacro with-captured-bindings ((&rest symbols) as name &body body)
  (assert (eq as :as))
  (loop for s in (alexandria:flatten
                  (sublis
                   '((:stdio *standard-output* *error-output* *standard-input*)
                     (:path *default-pathname-defaults*))
                   symbols))
        for g = (gensym)
        collect (list g s) into capture
        collect (list s g) into rebind
        finally
           (return
             `(let ,capture
                ,@(subst (make-bindings :data rebind)
                         name
                         body)))))

capture变量包含一个绑定列表，用于初始化词法范围的变量。 rebind变量是一个绑定列表，用于将特殊变量设置回它们在另一个线程中的值。

我用subst在代码中注入bindings结构的一个实例。 它有助于拥有专用的数据结构，但粗略的搜索和替换方法意味着符号name将不能用作body中的 function、本地宏等。 我认为这不是什么大问题。

此外，我为常用变量定义了别名，如:stdio和:path 。

第二个宏是with-bindings ：

(defmacro with-bindings (bindings &body body)
  (check-type bindings bindings)
  `(let ,(bindings-data bindings)
     ,@body))

这用正确的代码替换了中间结构。 最终代码不再有这个结构体，可以照常处理。

例如：

(defvar *my-var* "hello")

(with-captured-bindings (:stdio :path *my-var*) :as <bindings>
  (sb-thread:make-thread 
   (lambda ()
     (with-bindings <bindings>
       (print *var*)))))

macroexpand 的第一个应用给出：

(LET ((#:G3882 *STANDARD-OUTPUT*)
      (#:G3883 *ERROR-OUTPUT*)
      (#:G3884 *STANDARD-INPUT*)
      (#:G3885 *DEFAULT-PATHNAME-DEFAULTS*)
      (#:G3886 *MY-VAR*))
  (SB-THREAD:MAKE-THREAD
   (LAMBDA ()
     (WITH-BINDINGS #S(BINDINGS
                       :DATA ((*STANDARD-OUTPUT* #:G3882)
                              (*ERROR-OUTPUT* #:G3883)
                              (*STANDARD-INPUT* #:G3884)
                              (*DEFAULT-PATHNAME-DEFAULTS* #:G3885)
                              (*MY-VAR* #:G3886)))
       (PRINT *MY-VAR*)))))

请注意，树中有#S(BINDINGS...) object。

完整的展开是：

(LET ((#:G3887 *STANDARD-OUTPUT*)
      (#:G3888 *ERROR-OUTPUT*)
      (#:G3889 *STANDARD-INPUT*)
      (#:G3890 *DEFAULT-PATHNAME-DEFAULTS*)
      (#:G3891 *MY-VAR*))
  (SB-THREAD:MAKE-THREAD
   (LAMBDA ()
     (LET ((*STANDARD-OUTPUT* #:G3887)
           (*ERROR-OUTPUT* #:G3888)
           (*STANDARD-INPUT* #:G3889)
           (*DEFAULT-PATHNAME-DEFAULTS* #:G3890)
           (*MY-VAR* #:G3891))
       (PRINT *MY-VAR*)))))