2

I want to do something that means the following:

(with-output-to-string (*standard-output*)
  (bt:join-thread
   (bt:make-thread
    (lambda ()
      (format *standard-output* "Hello World")))))
;=> "" (actual output)
;=> "Hello World" (expected output)

In my understanding, this does not work because the *standard-output* that gets dynamically rebound by with-output-to-string outside the thread does not take effect inside the thread. What are the possible and recommedable ways?

In essence, I want to capture the output that was written to *standard-output* by another thread.

digikar
  • 576
  • 5
  • 13
  • I suppose you want to do that without touching the code inside the thread? like rebind any thread? – coredump Feb 17 '23 at 07:12
  • 1
    Would that help? https://stackoverflow.com/a/75309012/124319 – coredump Feb 17 '23 at 07:16
  • Wouldn't you do this the opposite way, like `with-output-to-string` inside the thread lambda? – Manfred Feb 17 '23 at 16:12
  • @coredump I'm sorry, I didn't get what you mean by "rebind any thread". And thank you for the pointer! In my particular case, I do want the thread to respect the global value of `*standard-output*` so that if the user redirects it to point to a file, the output of the thread will go to the file instead. @Manfred This is also why I cannot use `with-output-to-string` inside the thread lambda – digikar Feb 18 '23 at 06:29

3 Answers3

3

One can rebind the special variable to be thread local:

(with-output-to-string (*standard-output*)
  (bt:join-thread
    (bt:make-thread
      (lambda ()
        (format *standard-output* "Hello World"))
      :initial-bindings `((*standard-output* . ,*standard-output*)))))

*initial-bindings* is an alist with (variable . value) elements.

Rainer Joswig
  • 136,269
  • 10
  • 221
  • 346
  • In which case one could move the `with-output-to-string` into the thread lambda? – Manfred Feb 18 '23 at 22:52
  • @manfred , in the case where the stream object does not need to be picked up from the outside... – Rainer Joswig Feb 18 '23 at 22:58
  • Thanks! I will mark this as accepted because the code I had posted assumed `make-thread` (as well as `join-thread`) being called inside the `with-output-to-string`, and this looks like the most appropriate solution for it. In general, `join-thread` and `make-thread` will be called outside the `with-output-to-string` form, but perhaps one can make do with some closures. – digikar Feb 19 '23 at 03:10
1

A previous idea was to mutate the original binding of *standard-output* itself. As @coredump suggested, this has the downside that the binding will be mutated in all the threads - other threads that are sending their output to *standard-output* would also send their output to the string-output-stream.

Another idea is to let the thread itself decide whether to send the output to *standard-output* or to some other stream:

(let ((in-with-output-to-string nil)
      (output-stream-string     nil))
  (unwind-protect
       (progn
         (setq output-stream-string (make-string-output-stream))
         (setq in-with-output-to-string t)
         (bt:join-thread
          (bt:make-thread
           (lambda ()
             (format (if in-with-output-to-string
                         output-stream-string
                         *standard-output*)
                     "Hello World"))))
         (get-output-stream-string output-stream-string))
    (setq in-with-output-to-string nil)))
;=> "Hello World"

A more involved example is illustrated in the following. The general situation I was interested in involved a thread reading some stream and sending the contents of that stream to *standard-output*. However, in certain cases, I was interested in capturing the output of that thread into a string.

Even before that, drawing inspiration from [1], we define a helper macro which captures the variable bindings that were present before executing the body and then restores them once the body has completed execution.

(deftype list-of (&rest types)
  (if types
      `(cons ,(first types) (list-of ,@(rest types)))
      'null))

(defmacro thread-global-let (bindings &body body)
  (let* ((bindings (mapcar (lambda (binding)
                             ;; Normalize the bindings
                             (etypecase binding
                               (symbol
                                (list binding nil))
                               ((list-of symbol)
                                (list (first binding) nil))
                               ((list-of symbol t)
                                binding)))
                           bindings))
         (variables (mapcar #'first bindings))
         (gensyms (alexandria:make-gensym-list (length variables))))
    `(let (,@(mapcar (lambda (var gensym)
                       `(,gensym ,var))
                     variables gensyms))
       (unwind-protect
            (progn
              ,@(mapcar (lambda (binding)
                          `(setq ,@binding))
                        bindings)
              ,@body)
         ,@(mapcar (lambda (var gensym)
                     `(setq ,var ,gensym))
                   variables gensyms)))))

The main example then is the following:

(defvar *input-wait-condition* (bt:make-condition-variable))
(defvar *input-wait-lock*      (bt:make-lock))
(defvar *stream-input-string*  nil)
(defvar *thread*)

(let ((in-with-thread-output nil)
      (stream-output-string  nil))

  (when (and (boundp '*thread*)
             (bt:threadp *thread*))
    (bt:destroy-thread *thread*))
  (setq *thread*
        (bt:make-thread
         (lambda ()
           (bt:with-lock-held (*input-wait-lock*)
             (loop :do (bt:condition-wait *input-wait-condition* *input-wait-lock*)
                       (loop :while (listen *stream-input-string*)
                             :do (write-char (read-char *stream-input-string*)
                                             (if in-with-thread-output
                                                 stream-output-string
                                                 *standard-output*))))))))

  (defun thread-output-thunk (thunk)
    (thread-global-let ((stream-output-string (make-string-output-stream))
                        (in-with-thread-output t))
      (funcall thunk)
      (get-output-stream-string stream-output-string))))

(defmacro with-thread-output (&body body)
  `(thread-output-thunk (lambda () ,@body)))

What it essentially achieves is the following:

CL-USER> (setq *stream-input-string* (make-string-input-stream "Hello World"))
#<SB-IMPL::STRING-INPUT-STREAM {100D0D47A3}>
CL-USER> (bt:condition-notify *input-wait-condition*)
NIL
Hello World
CL-USER> (with-thread-output
           (thread-global-let
               ((*stream-input-string*
                 (make-string-input-stream "Output from a thread")))
             (bt:condition-notify *input-wait-condition*)
             (loop :while (listen *stream-input-string*))))
"Output from a thread"
CL-USER> (with-thread-output
           (thread-global-let
               ((*stream-input-string*
                 (make-string-input-stream "Output from a thread")))
             (print (with-thread-output
                      (thread-global-let
                          ((*stream-input-string*
                            (make-string-input-stream "Output from a thread 2")))
                        (bt:with-lock-held (*input-wait-lock*)
                          (bt:condition-notify *input-wait-condition*))
                        (loop :while (listen *stream-input-string*)))))
             (bt:with-lock-held (*input-wait-lock*)
               (bt:condition-notify *input-wait-condition*))
             (loop :while (listen *stream-input-string*))))

"Output from a thread 2"
"Output from a thread"

The following code illustrates the previous idea of mutating the original binding of *standard-output*. This has the downside of the mutation affecting all the threads.

(let ((original-stdout *standard-output*))
  (with-output-to-string (stdout)
    (unwind-protect
         (progn
           (setq *standard-output* stdout)
           (bt:join-thread
            (bt:make-thread
             (lambda ()
               (format *standard-output* "Hello World")))))
      (setq *standard-output* original-stdout))))
digikar
  • 576
  • 5
  • 13
  • unfortunately it globally redirects all outputs, it would be better to rebind special variables when entering the thread. That can be done in another function that wraps the function you want to call, or by giving them as arguments to bt: make-thread (see doc) – coredump Feb 17 '23 at 10:36
  • @coredump If I understand correctly, rebinding the special variables as you suggested in [1] does not let the thread respect the global bindings of the variables. In my particular case I do want the thread to respect the global bindings. Another idea (answer editted) is to instead let the thread decide where to send its output. [1] : https://stackoverflow.com/a/75309012/124319 – digikar Feb 18 '23 at 06:43
1

This all seem a bit complex, and it looks like you are calling bt:join-thread to wait for the thread to finish. Unfortunately, this means that your main thread is blocked until the worker thread is finished, something that typically is a code smell in multi-threaded applications (if you block the main thread, you might as well call the function directly in the same thread).

In fact, when threads are involved, lexically scoped macros like with-X are usually either better done inside the thread, or not at all. I am going to use the lparallel library because it provides queues datastructures.

(defpackage :so (:use :cl))
(in-package :so)
(ql:quickload :lparallel)

Let's define a sample test function that uses standard input and output streams:

(defun test-function ()
  "A test function that acts on standard input/output streams"
  (format t "input is: ~s" (read-line)))

The following make-thread/redirect-io function takes a function to execute as well as its input as a string. It returns another function that will block until the thread terminates and return the accumulated output as a string. In practice you would also need to handle exceptions:

(defun make-thread/redirect-io (fn input-as-string)
  (let ((queue (lparallel.queue:make-queue)))
    (values (lambda () (lparallel.queue:pop-queue queue))
            (bt:make-thread 
             (lambda ()
               (lparallel.queue:push-queue 
                (with-output-to-string (*standard-output*)
                  (with-input-from-string (*standard-input* input-as-string)
                    (funcall fn)))
                queue))))))

This allows you to really run things in parallel, for example you can spawn two threads with different inputs:

(let ((join-a (make-thread/redirect-io #'test-function "Hello"))
      (join-b (make-thread/redirect-io #'test-function "World")))
  
  ;; do something else in parallel, do not join the thread otherwise
  ;; it would just be blocking as-if you called the function in the
  ;; same thread
  
  ;; then, get the results
  (list (funcall join-a)
        (funcall join-b)))

This returns the following list:

("input is: \"Hello\"" "input is: \"World\"")

In fact, I'd suggest using having a look at lparallel.org to see if you can use it directly, it can greatly simplify working with threads.

coredump
  • 37,664
  • 5
  • 43
  • 77
  • Erm, this is actually pretty much the only place where threads pop-up in this project [1]. While calling cpython through common lisp, I had created a separate thread that reads from python's output stream and writes the result to `*standard-output*`. Simply assigning `*standard-output*` to the python's output stream doesn't play nice with SLIME/SWANK. Parallelism essentially goes out of the window due to CPython's GIL. [1]: https://github.com/digikar99/py4cl2-cffi/blob/408e9e8fdd8394824980f83640d6fd192dc930a5/src/python-process.lisp#L58-L116 – digikar Feb 18 '23 at 13:21
  • 1
    That's interesting, what is a bit confusing to me is that the linked code already does `sys.stdout = open('/tmp/py4cl2-cffi-output', 'w')` on the Python side so I don't really understand why it is not sufficient to open a temporary file to grab all the output, but I'm probably missing some complexities. – coredump Feb 20 '23 at 14:13
  • 1
    Indeed, the thread that is reading the python's output and writing it to the lisp's `*standard-output*` is doing exactly this. But you do have a point, thanks! Instead of capturing the output from the original thread, a `with-python-output` could directly open the named pipe and read from it. Although, a separate thread is still necessary in the general case because we also want to print the python output regardless of whether the python call is complete. – digikar Feb 23 '23 at 07:22