On the Common Lisp HyperSpec page for unread-char - see
here - it says both of the following things:
"unread-char is intended to be an efficient mechanism for allowing the Lisp reader and other
parsers to perform one-character lookahead in input-stream."
"It is an error to invoke unread-char twice consecutively on the same stream without an
intervening call to read-char (or some other input operation which implicitly reads characters)
on that stream."
I'm investigating how to add support for multiple-character lookahead for CL streams for a
parser I'm planning to write, and just to confirm the above, I ran the following code:
(defun unread-char-test (data)
(with-input-from-string (stream data)
(let ((stack nil))
(loop
for c = (read-char stream nil)
while c
do (push c stack))
(loop
for c = (pop stack)
while c
do (unread-char c stream)))
(coerce
(loop
for c = (read-char stream nil)
while c
collect c)
'string)))
(unread-char-test "hello")
==> "hello"
It doesn't throw an error (on SBCL or CCL, I haven't tested it on other implementations yet) but I don't see how there can possibly be any read
operations (implicit or explicit) taking place on the stream between the consecutive calls
to unread-char.
This behaviour is good news for multiple-character lookahead, as long as it is consistent, but why
isn't an error being thrown?
In response to user jkiiski's comment I did some more digging. I defined a function similar to the above but that takes the stream as an argument (for easier reuse):
(defun unread-char-test (stream)
(let ((stack nil))
(loop
for c = (read-char stream nil)
while c
do (push c stack))
(loop
for c = (pop stack)
while c
do (unread-char c stream)))
(coerce
(loop
for c = (read-char stream nil)
while c
collect c)
'string))
I then ran the following in a second REPL:
(defun create-server (port)
(usocket:with-socket-listener (listener "127.0.0.1" port)
(usocket:with-server-socket (connection (usocket:socket-accept listener))
(let ((stream (usocket:socket-stream connection)))
(print "hello" stream)))))
(create-server 4000)
And the following in the first REPL:
(defun create-client (port)
(usocket:with-client-socket (connection stream "127.0.0.1" port)
(unread-char-test stream)))
(create-client 4000)
And it did throw the error I expected:
Two UNREAD-CHARs without intervening READ-CHAR on #<BASIC-TCP-STREAM ISO-8859-1 (SOCKET/4) #x302001813E2D>
[Condition of type SIMPLE-ERROR]
This suggests that jkiiski's assumption is correct. The original behaviour was also observed when the input was read from a text file, like so:
(with-open-file (stream "test.txt" :direction :output)
(princ "hello" stream))
(with-open-file (stream "test.txt")
(unread-char-test stream)))
==> "hello"
I imagine that, when dealing with local file I/O, the implementation reads large chunks of a file into memory, and then read-char reads from the buffer. If correct, this also supports the assumption that the error described in the specification is not thrown by typical implementations when unreading from a stream whose contents are in-memory.
Related
I am trying to build a common lisp implementation of the channel construct of Golang for a personal project (also to learn lisp). So far I've implemented the channels as objects of a class, containing a queue, a lock and a condition variable to signal listening functions that a new message has been added to the queue. I'm using bordeaux threads to create threads, locks, condition variables and join the executions (from the lisp cookbook).
This is the channel class and the recive function:
(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 should be the equivalent of go routine() for go (without the light threading). To test the setup I've built a printer function over a channel
(defvar printch (channel))
(defun printover (ch)
(let ((x (recive ch)))
(format t "Recived variable x: ~d~%" x)))
but when I run
(gorun printover printch)
The interpreter (using sbcl, but with clisp the same happens) gives back an error:
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]
I'm confused, since the method to run over the channel printch should be the one I've defined.
Trying to call a class method inside of a new thread, but got no applicable method
A macros is supposed to return code to run in place of the original call. Your macro is creating the thread at expansion time.
If you're not using backtick in a macro definition, there's usually something wrong with it. You should figure out what the code would look like without the macro, then define a macro that returns code with that same structure in a backticked list, replacing the places that need to vary with the parameters, using comma to expand them.
(defmacro gorun (f &rest args)
`(bt:make-thread (function ,f)
:initial-bindings (list ,#args)
:name "gorun worker"))
In the above, you need to substitute the function name into a (function ...) expression, and the args list as the :initial-bindings argument.
In multi-threaded environments it is often the case that special variables are thread-local. The global binding is visible from all threads, but if you bind one locally its value will not automatically be transferred to a thread created in that context. It has to be done explicitly, and I wrote a pair of macros recently just for that.
The first one captures bindings into lexically-scoped variables; the other bind the original variables back to the values captured in a different context.
I am using an intermediate data structure in the code to store bindings:
(defstruct bindings data)
The first macro is 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)))))
The capture variable holds a list of bindings to initialize the lexically-scoped variables. The rebind variables is a list of bindings to set back special variables to their values in another thread.
I inject with subst an instance of the bindings struct in the code. It helps to have a dedicated data structure, but the crude search-and-replace approach means the symbols name will not be usable as a function, local macro, etc. in body. I don't think it is too much of a problem.
Also, I define aliases like :stdio and :path for commonly used variables.
The second macro is with-bindings:
(defmacro with-bindings (bindings &body body)
(check-type bindings bindings)
`(let ,(bindings-data bindings)
,#body))
This replaces the intermediate struct with the proper code. The final code does not have this struct anymore and can be processed as usual.
For example:
(defvar *my-var* "hello")
(with-captured-bindings (:stdio :path *my-var*) :as <bindings>
(sb-thread:make-thread
(lambda ()
(with-bindings <bindings>
(print *var*)))))
A first application of macroexpand gives:
(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*)))))
Notice that there is #S(BINDINGS ...) object in the tree.
The full expansion is:
(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*)))))
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.
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.
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))))
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.
I am struggling to understand how to read a file line by line with racket, while passing each line to a recursive function.
According to the manual, the idiomatic way of doing this is something like the following example:
(with-input-from-file "manylines.txt"
(lambda ()
(for ([l (in-lines)])
(op l))))
What if my function op is a recursive function that needs to do some complicated operations depending on the line just read from file and also on the history of the recursion?
For example, I could have a function like this:
(define (op l s)
;; l is a string, s is a list
(cond ((predicate? l)
(op (next-line-from-file) (cons (function-yes l) s)))
(else
(op (next-line-from-file) (append (function-no l) s)))))
I am not sure how to use this function within the framework described by the manual.
Here next-line-from-file is a construct I made up to make it clear that I would like to keep reading the file.
I think I could do what I want by introducing side effects, for example:
(with-input-from-file "manylines.txt"
(lambda ()
(let ((s '()))
(for ([l (in-lines)])
(if (predicate? l)
(let ((prefix (function-yes l)))
(set-cdr! s s)
(set-car! s prefix))
(let ((prefix (function-no l)))
(set-cdr! prefix s)
(set-car! s prefix)))))))
I actually did not try to run this code, so I'm not sure it would work.
Anyway I would bet that this common task can be solved without introducing side effects, but how?
Two approaches that Racket supports rather well are to turn the port into something which is essentially a generator of lines, or into a stream. You can then pass these things around as arguments to whatever function you are using in order to successively read lines from the file.
The underlying thing in both of these is that ports are sequences, (in-lines p) returns another sequence which consists of the lines from p, and then you can turn these into generators or streams.
Here's a function which will cat a file (just read its lines in other words) using a generator:
(define (cat/generator f)
(call-with-input-file f
(λ (p)
(let-values ([(more? next) (sequence-generate (in-lines p))])
(let loop ([carry-on? (more?)])
(when carry-on?
(displayln (next))
(loop (more?))))))))
Here call-with-input-file deals with opening the file and calling its second argument with a suitable port. in-lines makes a sequence of lines from the port, and sequence-generate then takes any sequence and returns two thunks: one tells you if the sequence is exhausted, and one returns the next thing in it if it isn't. The remainder of the function just uses these functions to print the lines of the file.
Here's an equivalent function which does it using a stream:
(define (cat/stream f)
(call-with-input-file f
(λ (p)
(let loop ([s (sequence->stream (in-lines p))])
(unless (stream-empty? s)
(displayln (stream-first s))
(loop (stream-rest s)))))))
Here the trick is that sequence->stream returns a stream corresponding to a sequence, and then stream-empty? will tell you if you're at the end of the stream, and if it's not empty, then stream-first returns the first element (conceptually the car) while stream-rest returns a stream of all the other elements.
The second one of these is nicer I think.
One nice thing is that lists are streams so you can write functions which use the stream-* functions, test them on lists, and then use them on any other kind of stream, which means any other kind of sequence, and the functions will never know.
I recently implement something similar, except in my case the predicate depended on the following line, not the preceding one. In any case, I found it simplest to discard in-lines and use read-line recursively. Since the predicate depended on unread input, I used peek-string to look ahead in the input stream.
If you really want to use in-lines, you might like to experiment with sequence-fold:
(sequence-fold your-procedure '() (in-lines))
Notice this uses an accumulator, which you could use to check the previous results from your procedure. However, if you're building a list, you generally want to build it backwards using cons, so the most recent element is at the head of the list and can be accessed in constant time. Once you're done, reverse the list.
My program currently writes bytes using write-byte throughout the program.
When there is an error in the program, the program stops there but I've realized that this still leaves the previously written bytes (before encountering the error).
I was wondering if it is possible to hold on to all the bytes that I want to output until the successful ending of the program so that if the program encounters an error before the end of the program, it outputs nothing, and if no error is encountered, then I can output all the bytes that I wanted to write.
You can wrap your program in with-output-to-bytes to produce a bytestring value instead of writing directly to stdout:
(with-output-to-bytes
(λ ()
(write-bytes #"a")
(write-bytes #"b")))
Internally, this is just a super simple wrapper around open-output-bytes and a parameterization of current-output-port, so if you want more fine-grained control, you can use those directly. For example, if you have a simple script and don’t want to wrap the whole program, you can mutate the current-output-port parameter globally:
(define stdout (current-output-port))
(define output (open-output-bytes))
(current-output-port output)
(void
(begin
(write-bytes #"a")
(write-bytes #"b")))
(write-bytes (get-output-bytes output) stdout)
However, be careful: mutating current-output-port like that will affect everything that prints, including the output from expressions evaluated at a module level, which is why it is necessary to wrap the write-bytes invocations with void above.
One can add bytes to a list and print them together later:
(define lst '())
(set! lst (cons #"a" lst))
(set! lst (cons #"b" lst))
(println lst)
(for ((item (reverse lst)))
(write-bytes item))
Output:
'(#"b" #"a")
ab
List has to be reversed since 'cons' adds item to the head of the list.
I've written a small Scheme interpreter in C#, and realised that the way I had implemented it, it was very easy to add support for proper continuations.
So I added them... but want to "prove" that they way that I've added them is correct.
My Scheme interpreter however has no support for "mutating" state - everything is immutable.
So it was pretty easy to write a unit test to expose "upwards" continuations:
AssertEqual(Eval("(call/cc (lambda (k) (+ 56 (k 3))))"), 3);
However, I also want to write a unit test that demonstrates that if the continuation "escapes" then that still works too:
AssertEqual(Eval("(call/cc (lambda (k) k))", <some continuation>);
But of course, the above would just test that "I got a continuation"... not that it's actually a valid continuation.
All of the examples I can find, however, always end up using "set!" to demonstrate the escaped continuation.
What's the simplest Scheme example that demonstrates proper support for backwards continuations without relying on mutation?
Are backwards continuations any use without mutation? I am beginning to suspect that they are not, because you could only use it to execute the exact same calculation again... which is meaningless if there are no side-effects. Is this why Haskell does not have continuations?
I don't know if this is the simplest, but here's an example of using backwards continuations without any call to set! or similar:
(apply
(lambda (k i) (if (> i 5) i (k (list k (* 2 i)))))
(call/cc (lambda (k) (list k 1))))
This should evaluate to 8.
Slightly more interesting is:
(apply
(lambda (k i n) (if (= i 0) n (k (list k (- i 1) (* i n)))))
(call/cc (lambda (k) (list k 6 1))))
which computes 6! (that is, it should evaluate to 720).
You can even do the same thing with let*:
(let* ((ka (call/cc (lambda (k) `(,k 1)))) (k (car ka)) (a (cadr ka)))
(if (< a 5) (k `(,k ,(* 2 a))) a))
(Man, stackoverflow's syntax highlighting fails massively on scheme.)
I think you're right -- without mutation, backwards continuations do nothing that forward continuations can't.
Here's the best I've come up with:
AssertEqual(Eval("((call/cc (lambda (k) k)) (lambda (x) 5))", 5);
Not amazing, but it is a backwards continuation which I then "call" with the actual function I wish to invoke, a function that returns the number 5.
Ah and I've also come up with this as a good unit test case:
AssertEqual(Eval("((call/cc call/cc) (lambda (x) 5))", 5);
I agree with Jacob B - I don't think it's that useful without mutable state... but would be still be interested in a counter-example.
Functional Threads:
You can use a recursive loop to update state without mutation. including the state of the next continuation to be called. Now this is more complicated than the other examples given, but all you really need is the thread-1 and main loop. The other thread and "update" function are there to show that continuations can be used for more than a trivial example. Additionally, for this example to work you need an implementation with the named let. This can be translated into an equivalent form made with define statements.
Example:
(let* ((update (lambda (data) data)) ;is identity to keep simple for example
(thread-1
(lambda (cc) ;cc is the calling continuation
(let loop ((cc cc)(state 0))
(printf "--doing stuff state:~A~N" state)
(loop (call/cc cc)(+ state 1))))) ;this is where the exit hapens
(thread-2
(lambda (data) ;returns the procedure to be used as
(lambda (cc) ;thread with data bound
(let loop ((cc cc)(data data)(state 0))
(printf "--doing other stuff state:~A~N" state)
(loop (call/cc cc)(update data)(+ state 1)))))))
(let main ((cur thread-1)(idle (thread-2 '()))(state 0))
(printf "doing main stuff state:~A~N" state)
(if (< state 6)
(main (call/cc idle) cur (+ state 1)))))
Which outputs
doing main stuff state:0
--doing other stuff state:0
doing main stuff state:1
--doing stuff state:0
doing main stuff state:2
--doing other stuff state:1
doing main stuff state:3
--doing stuff state:1
doing main stuff state:4
--doing other stuff state:2
doing main stuff state:5
--doing stuff state:2
doing main stuff state:6