Oh, I hadn't noticed that behavior. Seems that s7_free triggers something.
But then, why is repl just.. broken, if having the (main) not commented out?
Anyway, I've come up with a better example. It seems s7_eval_c_string
behaves differently than both s7_load & s7_load_c_string.
See the attached cpp file
On Sun, 5 Dec 2021 at 22:37, <[email protected]> wrote:
>
> I think this is more a matter of where the repl
> loop happens. If (main) is not commented out,
> the next thing is the repl loop waiting for input;
> if you type Ctrl-D, you get the rest of the
> continuation stuff:
>
> ;; (main) commented out:
> /home/bil/test/callcc/ asdf
> hi from c
>
> > (main)
> ()
> > foo is response1
> foo is response1 bar is response2
> done!
> ^C
>
> ;; (main) in main.scm:
> /home/bil/test/callcc/ asdf
> hi from c
>
> > foo is response1
> < Ctrl-D typed here>
> foo is response1 bar is response2
> done!
> <exits>
>
#include <thread>
#include <s7.h>
#include <mutex>
#include <thread>
#include "stdio.h"
#include <cstring> // strlen
std::recursive_mutex mutex;
#define HELP_set_timeout "(set-timeout timeout thunk)"
s7_pointer scm_set_timeout(s7_scheme* sc, s7_pointer args) {
s7_pointer timeout = s7_car(args); args = s7_cdr(args);
s7_pointer thunk = s7_car(args); args = s7_cdr(args);
int i_timeout = s7_integer(timeout);
int gc = s7_gc_protect(sc, thunk);
std::thread t([=](){
// thread will call this c++ "thunk", which has captured used variables
std::this_thread::sleep_for(std::chrono::milliseconds(i_timeout));
// locking RAII style: gets unlocked when it goes out of scope
std::unique_lock<std::recursive_mutex> lock(mutex);
s7_call(sc, thunk, s7_nil(sc));
s7_gc_unprotect_at(sc, gc);
});
// letting the thread run in the background, while return s7_nil
t.detach();
return s7_nil(sc);
}
void bind_set_timeout(s7_scheme* sc, s7_pointer env) {
s7_define(sc, env, s7_make_symbol(sc, "set-timeout"),
s7_make_function(sc, "set-timeout",
scm_set_timeout,
2, 0, false, // req, opt, rest?
HELP_set_timeout)
);
}
// if evaled with s7_eval_c_string: works
// with s7_load_c_string: doesn't work
const char *program = R"scm(
(begin
(define (print . args)
(for-each
(lambda (x)
(format *stderr* "~A " x))
args)
(format *stderr* "\n"))
(define async-call
(let ((counter 0))
(lambda (cb)
(set-timeout 1000 (lambda () (cb (format #f "response~A" counter))))
(set! counter (+ 1 counter)))))
(define (main)
(call-with-exit
(lambda (return)
(define foo
(call/cc
(lambda (cc)
(define cb (lambda (res)
(cc res)))
(async-call cb)
cc)))
(when (continuation? foo)
(return))
(print "foo is" foo)
(define bar
(call/cc
(lambda (cc)
(define cb2 (lambda (res)
(cc res)))
(async-call cb2)
cc)))
(when (continuation? bar)
(return))
(print "foo is" foo "bar is" bar)
(print "done!"))))
(main)
)
)scm";
int main(int argc, char** argv) {
printf("hi from c\n");
s7_scheme* sc = s7_init();
bind_set_timeout(sc, s7_nil(sc));
std::unique_lock<std::recursive_mutex> lock(mutex, std::defer_lock);
// locking, just in case any (set-timeout ..) is called from main.scm
lock.lock();
// cases with calling (main) :
// s7_load: doesn't work
// s7_load(sc, "main.scm");
// eval_c_string (with everything wrapped around a (begin..)): works
s7_eval_c_string(sc, program);
// s7_load_c_string: doesn't work
// s7_load_c_string(sc, program, strlen(program));
lock.unlock();
char buffer[512];
bool running = true;
printf("\n> ");
while(running) {
if (fgets(buffer, 512, stdin) == NULL) {
running = false;
break;
}
std::unique_lock<std::recursive_mutex> lock(mutex);
s7_pointer res = s7_eval_c_string(sc, buffer);
// dummy repl
printf("%s\n> ", s7_string(s7_object_to_string(sc, res, false)));
}
s7_free(sc);
return 0;
}
_______________________________________________
Cmdist mailing list
[email protected]
https://cm-mail.stanford.edu/mailman/listinfo/cmdist
