Common Lisp 实时抓取标准输出
Common Lisp grab stdout in real time
我正在尝试从我调用的函数中读取标准输出，但似乎无法让它实时工作。
(defun foo ()
(loop :for i :from 1 :to 3 :do
(format T "~A~%" i)
(sleep 1)))
(let* ((s (make-string-output-stream))
(*standard-output* s))
(foo)
...)
将捕获输出并在函数完成后使其可用。在那之前我怎样才能得到输出？我查看了 swank 的源代码，他们似乎设置了某种事件，但我无法弄清楚他们是如何连接到 stdout 的。
很明显，不可能让代码与标准定义的 CL 语言中的其他代码同时运行，因为这样做本质上需要多个控制线程（意味着要监听任何函数在执行过程中生成的标准输出？）。
如果您想要的是在输出到特定流时同步运行的用户代码，该流很容易使用灰色或类似灰色的流。
并发处理输出
这需要线程（当然，这可能不会为您提供真正的并发性，但在大多数实现中都可以）。以下是您在一种实现中的实现方式：LispWorks。其他实现将具有类似的实用程序，并且可能有可移植性垫片。请注意，这同时使用多处理和用户定义 ('almost Gray') 流来定义将内容发送到邮箱的流。
(defpackage :foo
(:use :cl :stream :mp))
(in-package :foo)
(defclass mailbox-output-stream (fundamental-character-output-stream
buffered-stream)
;; A character output stream which writes into a mailbox
((mailbox :initform (make-mailbox)
:initarg :mailbox
:reader mos-mailbox)
(mailbox-limit :initform nil
:reader mos-limit))
(:default-initargs
:direction ':output))
(defmethod stream-write-buffer ((stream mailbox-output-stream)
buffer start end)
;; Write the buffer into the mailbox
(let ((limit (mos-limit stream)))
(if limit
(mailbox-send-limited (mos-mailbox stream)
(subseq buffer start end)
limit)
(mailbox-send (mos-mailbox stream)
(subseq buffer start end)))))
(defun call/supervising-output-stream (supervised supervisor)
;; Call SUPERVISED with an output stream whose mailbox SUPERVISOR is
;; watching. Everything written into the mailbox will be a string,
;; until SUPERVISED returns, when T (normal return) or NIL (abnormal
;; return) will be written. SUPERVISED runs in its own thread,
;; SUPERVISOR in this thread. Return value is whatever SUPERVISOR
;; returns. This pretty obviously should be wrapped in a macro.
(let ((mbox (make-mailbox)))
(funcall-async (lambda ()
(let ((okp nil))
(unwind-protect
(with-open-stream (o (make-instance 'mailbox-output-stream
:mailbox mbox))
(funcall supervised o)
(setf okp t))
(mailbox-send mbox okp)))))
(funcall supervisor mbox)))
(defun trivial-printing-supervisor (mbox)
;; Just print everything we get from the mbox
(do ((in (mailbox-read mbox) (mailbox-read mbox)))
((not (stringp in)) in)
(print in)))
(defun collecting-supervisor (mbox)
;; Collect output from the mbox
(loop for in = (mailbox-read mbox)
while (stringp in)
collect in into results
finally (return (values results in))))
然后，例如：
> (call/supervising-output-stream
(lambda (o)
(let ((*standard-output* o))
(compile-file "/tmp/foo.lisp")))
#'collecting-supervisor)
(";;; Compiling file /tmp/foo.lisp ...
;;; Safety = 3, Speed = 1, Space = 1, Float = 1, Interruptible = 1
;;; Compilation speed = 1, Debug = 2, Fixnum safety = 3
;;; Source level debugging is on
;;; Source file recording is on
;;; Cross referencing is on
; (lispworks:top-level-form 0)
; (defpackage \"FOO\")
; (lispworks:top-level-form 2)
; (defclass mailbox-output-stream)
; (method stream-write-buffer (mailbox-output-stream t t t))
; call/supervising-output-stream
; trivial-printing-supervisor
; collecting-supervisor
;; Processing Cross Reference Information")
t
输出的同步处理
这需要灰色流，或几乎灰色的流或其他一些可扩展的流API。这不是 CL 标准的一部分，但我怀疑所有实现都有它们。
再次在 LispWorks 中，您可以按照以下方式进行操作。首先定义一个流class，它在缓冲区写入时调用一堆处理程序：
(defpackage :bar
(:use :cl :stream))
(in-package :bar)
(defclass handling-output-stream (fundamental-character-output-stream
buffered-stream)
;; A character output stream where buffer writes are handled by user
;; handlers.
((handlers :initform '()
:initarg :handlers
:accessor hos-handlers))
(:default-initargs
:direction ':output))
(defmethod stream-write-buffer ((stream handling-output-stream)
buffer start end)
;; Call the handlers
(dolist (handler (hos-handlers stream))
(funcall handler stream buffer start end)))
现在，举个例子，这是一个处理程序，它将把写入的缓冲区收集到一个秘密列表中，您可以访问该列表，还有另一个使用该处理程序的函数。
(defun make-stream-hos-collector ()
;; Return a handler and a function which will return the list of
;; strings it is collecting
(let ((collected '())
(ct nil))
(values (lambda (stream buffer start end)
(declare (ignore stream))
(let ((it (subseq buffer start end)))
(if (not ct)
(setf collected (list it)
ct collected)
(setf (cdr ct) (list it)
ct (cdr ct)))))
(lambda ()
collected))))
(defun example ()
(multiple-value-bind (handler returner) (make-stream-hos-collector)
(with-open-stream (*standard-output* (make-instance 'handling-output-stream
:handlers (list handler)))
(dotimes (i 10)
(print i)
(when (evenp i) (force-output))))
(funcall returner))))
调用 example 将 return 像这样：
> (example)
("
0 "
"
1
2 "
"
3
4 "
"
5
6 "
"
7
8 "
"
9 ")
完全有可能捕获每个字符，但捕获缓冲区写入通常要快得多。
我正在尝试从我调用的函数中读取标准输出，但似乎无法让它实时工作。
(defun foo ()
(loop :for i :from 1 :to 3 :do
(format T "~A~%" i)
(sleep 1)))
(let* ((s (make-string-output-stream))
(*standard-output* s))
(foo)
...)
将捕获输出并在函数完成后使其可用。在那之前我怎样才能得到输出？我查看了 swank 的源代码，他们似乎设置了某种事件，但我无法弄清楚他们是如何连接到 stdout 的。
很明显，不可能让代码与标准定义的 CL 语言中的其他代码同时运行，因为这样做本质上需要多个控制线程（意味着要监听任何函数在执行过程中生成的标准输出？）。
如果您想要的是在输出到特定流时同步运行的用户代码，该流很容易使用灰色或类似灰色的流。
并发处理输出
这需要线程（当然，这可能不会为您提供真正的并发性，但在大多数实现中都可以）。以下是您在一种实现中的实现方式：LispWorks。其他实现将具有类似的实用程序，并且可能有可移植性垫片。请注意，这同时使用多处理和用户定义 ('almost Gray') 流来定义将内容发送到邮箱的流。
(defpackage :foo
(:use :cl :stream :mp))
(in-package :foo)
(defclass mailbox-output-stream (fundamental-character-output-stream
buffered-stream)
;; A character output stream which writes into a mailbox
((mailbox :initform (make-mailbox)
:initarg :mailbox
:reader mos-mailbox)
(mailbox-limit :initform nil
:reader mos-limit))
(:default-initargs
:direction ':output))
(defmethod stream-write-buffer ((stream mailbox-output-stream)
buffer start end)
;; Write the buffer into the mailbox
(let ((limit (mos-limit stream)))
(if limit
(mailbox-send-limited (mos-mailbox stream)
(subseq buffer start end)
limit)
(mailbox-send (mos-mailbox stream)
(subseq buffer start end)))))
(defun call/supervising-output-stream (supervised supervisor)
;; Call SUPERVISED with an output stream whose mailbox SUPERVISOR is
;; watching. Everything written into the mailbox will be a string,
;; until SUPERVISED returns, when T (normal return) or NIL (abnormal
;; return) will be written. SUPERVISED runs in its own thread,
;; SUPERVISOR in this thread. Return value is whatever SUPERVISOR
;; returns. This pretty obviously should be wrapped in a macro.
(let ((mbox (make-mailbox)))
(funcall-async (lambda ()
(let ((okp nil))
(unwind-protect
(with-open-stream (o (make-instance 'mailbox-output-stream
:mailbox mbox))
(funcall supervised o)
(setf okp t))
(mailbox-send mbox okp)))))
(funcall supervisor mbox)))
(defun trivial-printing-supervisor (mbox)
;; Just print everything we get from the mbox
(do ((in (mailbox-read mbox) (mailbox-read mbox)))
((not (stringp in)) in)
(print in)))
(defun collecting-supervisor (mbox)
;; Collect output from the mbox
(loop for in = (mailbox-read mbox)
while (stringp in)
collect in into results
finally (return (values results in))))
然后，例如：
> (call/supervising-output-stream
(lambda (o)
(let ((*standard-output* o))
(compile-file "/tmp/foo.lisp")))
#'collecting-supervisor)
(";;; Compiling file /tmp/foo.lisp ...
;;; Safety = 3, Speed = 1, Space = 1, Float = 1, Interruptible = 1
;;; Compilation speed = 1, Debug = 2, Fixnum safety = 3
;;; Source level debugging is on
;;; Source file recording is on
;;; Cross referencing is on
; (lispworks:top-level-form 0)
; (defpackage \"FOO\")
; (lispworks:top-level-form 2)
; (defclass mailbox-output-stream)
; (method stream-write-buffer (mailbox-output-stream t t t))
; call/supervising-output-stream
; trivial-printing-supervisor
; collecting-supervisor
;; Processing Cross Reference Information")
t
输出的同步处理
这需要灰色流，或几乎灰色的流或其他一些可扩展的流API。这不是 CL 标准的一部分，但我怀疑所有实现都有它们。
再次在 LispWorks 中，您可以按照以下方式进行操作。首先定义一个流class，它在缓冲区写入时调用一堆处理程序：
(defpackage :bar
(:use :cl :stream))
(in-package :bar)
(defclass handling-output-stream (fundamental-character-output-stream
buffered-stream)
;; A character output stream where buffer writes are handled by user
;; handlers.
((handlers :initform '()
:initarg :handlers
:accessor hos-handlers))
(:default-initargs
:direction ':output))
(defmethod stream-write-buffer ((stream handling-output-stream)
buffer start end)
;; Call the handlers
(dolist (handler (hos-handlers stream))
(funcall handler stream buffer start end)))
现在，举个例子，这是一个处理程序，它将把写入的缓冲区收集到一个秘密列表中，您可以访问该列表，还有另一个使用该处理程序的函数。
(defun make-stream-hos-collector ()
;; Return a handler and a function which will return the list of
;; strings it is collecting
(let ((collected '())
(ct nil))
(values (lambda (stream buffer start end)
(declare (ignore stream))
(let ((it (subseq buffer start end)))
(if (not ct)
(setf collected (list it)
ct collected)
(setf (cdr ct) (list it)
ct (cdr ct)))))
(lambda ()
collected))))
(defun example ()
(multiple-value-bind (handler returner) (make-stream-hos-collector)
(with-open-stream (*standard-output* (make-instance 'handling-output-stream
:handlers (list handler)))
(dotimes (i 10)
(print i)
(when (evenp i) (force-output))))
(funcall returner))))
调用 example 将 return 像这样：
> (example)
("
0 "
"
1
2 "
"
3
4 "
"
5
6 "
"
7
8 "
"
9 ")
完全有可能捕获每个字符，但捕获缓冲区写入通常要快得多。