From a7a986326c6f75674f8092fce41a9135b19b1184 Mon Sep 17 00:00:00 2001 From: Linus Shoravi Date: Sun, 19 Jul 2026 13:20:44 +0200 Subject: [PATCH 01/10] refactor: pull DynState off ContBarrier onto a trampoline-owned ambient DynState (dyn_stack, cont_marks) is no longer a field of ContBarrier. It's now a plain local owned by whichever Application::eval/eval_sync call is the current true entry point (root eval, or a spawn site with a snapshot), published to a thread-local/task-local ambient as before. ContBarrier shrinks to { id, params }: just escape-procedure scoping and host params, both of which still need to travel as a parameter. Everything that touches dynamic state - with-exception-handler, dynamic-wind, call/cc's SavedDynamicState capture, current-input/ output-port, continuation marks - now reads/writes through DYN_STATE instead of through barrier.state. DynStateSlot is a unit struct wrapping the two storage mechanisms (CURRENT_DYN_STATE thread-local, TASK_DYN_STATE task-local) as private module statics reached only through its methods (is_published, with, enter_sync, enter_async). Callers never touch the raw locals or write the try-task-then-thread fallback themselves; that logic lives in DynStateSlot::with and ::is_published, once. The single static DYN_STATE is the only instance. Both locals are RefCell>, not raw pointers: no unsafe, no Send hacks. DynStateSlot::with is the only access point; it does a short borrow_mut(), runs the closure, drops the borrow. The trampoline's eval loop never holds a borrow across apply(), so nested re-entry's own borrow_mut never conflicts with an outer one still in scope. A double-borrow would panic instead of being UB. Nested re-entry (Procedure::call/call_sync) is just ContBarrier::new() plus whatever the ambient already has published; there's no separate root/nested constructor. Application::eval/eval_sync check DYN_STATE.is_published() themselves: false means a true entry point, so they create a fresh DynState and publish it (with_dyn_state/ with_dyn_state_sync, both thin wrappers over DynStateSlot::enter_sync/ enter_async) for the duration; true means a nested call or a spawn site that already published one, so they run without touching the ambient. Spawn sites (threads.rs, futures.rs) snapshot the ambient on the parent side and publish the snapshot into the child's ambient themselves before calling in; their call sites are unchanged, since with_dyn_state/with_dyn_state_sync keep the same signatures. Keeps the two correctness fixes from the earlier spike: the trampoline owns the continuation-mark balance (push baseline, truncate on every exit) and escape_procedure halts its own barrier's trampoline on a cross-barrier rejection instead of raising through the (now ambient-shared) exception-handler search. Function signatures that exist only to match a fixed calling convention (JIT-generated code, or ContinuationPtr/BridgePtr function pointers) keep their barrier parameter even where the body no longer uses it, to avoid touching every call site; those are renamed to `_barrier` and noted as vestigial. Renamed the pop_dyn_stack continuation function to pop_dyn_stack_cont to avoid colliding with the new free function of the same name. --- benches/fib.rs | 12 +- benches/integrate.rs | 10 +- benches/yin_yang.rs | 10 +- src/docs.md | 29 +-- src/exceptions.rs | 15 +- src/futures.rs | 14 +- src/hashtables.rs | 27 +-- src/ports.rs | 197 ++++++++---------- src/proc.rs | 476 ++++++++++++++++++++++++++++++++----------- src/runtime.rs | 29 ++- src/syntax/mod.rs | 5 +- src/threads.rs | 24 ++- 12 files changed, 528 insertions(+), 320 deletions(-) diff --git a/benches/fib.rs b/benches/fib.rs index 372e9510..7674e472 100644 --- a/benches/fib.rs +++ b/benches/fib.rs @@ -1,8 +1,4 @@ -use scheme_rs::{ - env::TopLevelEnvironment, - proc::{ContBarrier, Procedure}, - value::Expect1, -}; +use scheme_rs::{env::TopLevelEnvironment, proc::Procedure, value::Expect1}; use criterion::*; use scheme_rs_macros::{maybe_async, maybe_await}; @@ -26,9 +22,7 @@ fn fib_fn() -> Procedure { fn fib_benchmark(c: &mut Criterion) { let proc = fib_fn(); - c.bench_function("fib 10000", |b| { - b.iter(|| proc.call(&[], &mut ContBarrier::new())) - }); + c.bench_function("fib 10000", |b| b.iter(|| proc.call(&[]))); } #[cfg(feature = "async")] @@ -40,7 +34,7 @@ fn fib_benchmark(c: &mut Criterion) { c.bench_function("fib 10000", |b| { b.to_async(&runtime).iter(|| { let val = proc.clone(); - async move { val.call(&[], &mut ContBarrier::new()).await } + async move { val.call(&[]).await } }) }); } diff --git a/benches/integrate.rs b/benches/integrate.rs index de445098..da911a04 100644 --- a/benches/integrate.rs +++ b/benches/integrate.rs @@ -1,8 +1,4 @@ -use scheme_rs::{ - env::TopLevelEnvironment, - proc::{ContBarrier, Procedure}, - value::Expect1, -}; +use scheme_rs::{env::TopLevelEnvironment, proc::Procedure, value::Expect1}; use criterion::*; use scheme_rs_macros::{maybe_async, maybe_await}; @@ -21,7 +17,7 @@ fn integrate_benchmark(c: &mut Criterion) { let proc = integrate_fn(); c.bench_function("integrate", |b| { - b.iter(|| proc.call(&[], &mut ContBarrier::new())); + b.iter(|| proc.call(&[])); }); } @@ -34,7 +30,7 @@ fn integrate_benchmark(c: &mut Criterion) { c.bench_function("integrate", |b| { b.to_async(&runtime).iter(|| { let val = proc.clone(); - async move { val.call(&[], &mut ContBarrier::new()).await } + async move { val.call(&[]).await } }) }); } diff --git a/benches/yin_yang.rs b/benches/yin_yang.rs index cfb17c7d..69fb71e8 100644 --- a/benches/yin_yang.rs +++ b/benches/yin_yang.rs @@ -1,8 +1,4 @@ -use scheme_rs::{ - env::TopLevelEnvironment, - proc::{ContBarrier, Procedure}, - value::Expect1, -}; +use scheme_rs::{env::TopLevelEnvironment, proc::Procedure, value::Expect1}; use criterion::*; use scheme_rs_macros::{maybe_async, maybe_await}; @@ -28,7 +24,7 @@ fn yin_yang_benchmark(c: &mut Criterion) { let proc = yin_yang_fn(); c.bench_function("yin_yang", |b| { - b.iter(|| proc.call(&[], &mut ContBarrier::new())); + b.iter(|| proc.call(&[])); }); } @@ -41,7 +37,7 @@ fn yin_yang_benchmark(c: &mut Criterion) { c.bench_function("yin_yang", |b| { b.to_async(&runtime).iter(|| { let val = proc.clone(); - async move { val.call(&[], &mut ContBarrier::new()).await } + async move { val.call(&[]).await } }) }); } diff --git a/src/docs.md b/src/docs.md index c1e51b02..fa8cf54a 100644 --- a/src/docs.md +++ b/src/docs.md @@ -75,7 +75,7 @@ anywhere. ```rust # use scheme_rs::{ -# env::TopLevelEnvironment, value::Value, proc::{ContBarrier, Procedure}, +# env::TopLevelEnvironment, value::Value, proc::Procedure, # }; # let env = TopLevelEnvironment::new_repl(); # env.import("(library (rnrs))".parse().unwrap()); @@ -93,14 +93,7 @@ anywhere. # .try_into() # .unwrap(); # let factorial = factorial.cast::().unwrap(); -let [result] = factorial - .call( - &[Value::from(5)], - &mut ContBarrier::new(), - ) - .unwrap() - .try_into() - .unwrap(); +let [result] = factorial.call(&[Value::from(5)]).unwrap().try_into().unwrap(); let result: u64 = result.try_into().unwrap(); assert_eq!(result, 120); ``` @@ -273,16 +266,14 @@ pub fn call_with_var( _rest_args: &[Value], barrier: &mut ContBarrier, ) -> Result { - // Set up the new dynamic state and add the param - let result = { - let mut var = 0u32; - let mut new_barrier = ContBarrier::from(barrier.save()); - new_barrier.add_param("var", &mut var); - - // Call the thunk arg with the new dyn state: - let thunk: Procedure = args[0].clone().try_into()?; - thunk.call(&[], &mut new_barrier)? - }; + // Set up a barrier with the new param + let mut var = 0u32; + let mut new_barrier = ContBarrier::new(); + new_barrier.add_param("var", &mut var); + + // Call the thunk arg with the new barrier: + let thunk: Procedure = args[0].clone().try_into()?; + let result = thunk.call_with_barrier(&[], &mut new_barrier)?; // Return to the continuation: Ok(barrier.call_cont(result)) diff --git a/src/exceptions.rs b/src/exceptions.rs index f1d8e76b..c8d38f49 100644 --- a/src/exceptions.rs +++ b/src/exceptions.rs @@ -54,7 +54,10 @@ use crate::{ gc::Trace, lists::slice_to_list, ports::{IoDecodingError, IoEncodingError, IoError, IoReadError, IoWriteError}, - proc::{Application, ContBarrier, ContPtr, DynStackElem, FuncPtr, Procedure, pop_dyn_stack}, + proc::{ + Application, ContBarrier, ContPtr, DynStackElem, FuncPtr, Procedure, + current_exception_handler, pop_dyn_stack, pop_dyn_stack_cont, push_dyn_stack, + }, records::{Embeddable, Embedded, RecordTypeDescriptor, rtd}, registry::{bridge, cps_bridge}, runtime::Runtime, @@ -936,13 +939,13 @@ pub fn with_exception_handler( let handler: Procedure = handler.clone().try_into()?; let thunk: Procedure = thunk.clone().try_into()?; - barrier.push_dyn_stack(DynStackElem::ExceptionHandler(handler)); + push_dyn_stack(DynStackElem::ExceptionHandler(handler)); let (req_args, var) = barrier.cont_formals(); barrier.push_cont( Vec::new(), - ContPtr::Continuation(pop_dyn_stack), + ContPtr::Continuation(pop_dyn_stack_cont), req_args, var, ); @@ -1005,7 +1008,7 @@ unsafe extern "C" fn unwind_to_exception_handler( let barrier = barrier.as_mut().unwrap_unchecked(); loop { - let app = match barrier.pop_dyn_stack() { + let app = match pop_dyn_stack() { None => { // If the stack is empty, we should return the error Application::halt_err(raised) @@ -1062,13 +1065,13 @@ pub fn raise_continuable( _env: &[Value], args: &[Value], _rest_args: &[Value], - barrier: &mut ContBarrier, + _barrier: &mut ContBarrier, ) -> Result { let [condition] = args else { unreachable!(); }; - let Some(handler) = barrier.current_exception_handler() else { + let Some(handler) = current_exception_handler() else { return Ok(Application::halt_err(condition.clone())); }; diff --git a/src/futures.rs b/src/futures.rs index 078f13bf..24bdfa8e 100644 --- a/src/futures.rs +++ b/src/futures.rs @@ -15,7 +15,7 @@ use tokio::{ use crate::{ exceptions::Exception, ports::{BufferMode, Port}, - proc::{ContBarrier, Procedure}, + proc::{Procedure, dyn_state_snapshot, with_dyn_state}, records::{Embeddable, Embedded, RecordTypeDescriptor, rtd}, strings::WideString, value::Value, @@ -36,7 +36,11 @@ unsafe impl Embeddable for Future { #[bridge(name = "future", lib = "(async)")] pub async fn make_future(proc: Procedure) -> Result, Exception> { - let future: Future = async move { proc.call(&[], &mut ContBarrier::new()).await } + // Snapshot the current dynamic state now, at creation time: the + // future's body runs later, whenever it's awaited, possibly from an + // unrelated dynamic extent. + let snapshot = dyn_state_snapshot(); + let future: Future = with_dyn_state(snapshot, async move { proc.call(&[]).await }) .boxed() .shared(); let future = Value::from(future); @@ -46,7 +50,11 @@ pub async fn make_future(proc: Procedure) -> Result, Exception> { #[bridge(name = "spawn", lib = "(async)")] pub async fn spawn(task: &Value) -> Result, Exception> { let task: Procedure = task.clone().try_into()?; - let task = tokio::task::spawn(async move { task.call(&[], &mut ContBarrier::new()).await }); + let snapshot = dyn_state_snapshot(); + let task = tokio::task::spawn(with_dyn_state( + snapshot, + async move { task.call(&[]).await }, + )); let future: Future = async move { task.await.unwrap() }.boxed().shared(); let future = Value::from(future); Ok(vec![future]) diff --git a/src/hashtables.rs b/src/hashtables.rs index e889dd2e..095357d5 100644 --- a/src/hashtables.rs +++ b/src/hashtables.rs @@ -13,7 +13,7 @@ use std::{ use crate::{ exceptions::Exception, gc::Trace, - proc::{ContBarrier, Procedure}, + proc::Procedure, records::{Embeddable, Embedded, RecordTypeDescriptor}, registry::bridge, strings::WideString, @@ -67,28 +67,22 @@ impl HashTableInner { #[cfg(not(feature = "async"))] pub fn hash(&self, val: Value) -> Result { - self.hash.call(&[val], &mut ContBarrier::new())?.expect1() + self.hash.call(&[val])?.expect1() } #[cfg(feature = "async")] pub fn hash(&self, val: Value) -> Result { - self.hash - .call_sync(&[val], &mut ContBarrier::new())? - .expect1() + self.hash.call_sync(&[val])?.expect1() } #[cfg(not(feature = "async"))] pub fn eq(&self, lhs: Value, rhs: Value) -> Result { - self.eq - .call(&[lhs, rhs], &mut ContBarrier::new())? - .expect1() + self.eq.call(&[lhs, rhs])?.expect1() } #[cfg(feature = "async")] pub fn eq(&self, lhs: Value, rhs: Value) -> Result { - self.eq - .call_sync(&[lhs, rhs], &mut ContBarrier::new())? - .expect1() + self.eq.call_sync(&[lhs, rhs])?.expect1() } /// Equivalent to `hashtable-ref` @@ -177,13 +171,10 @@ impl HashTableInner { for entry in table.iter_hash_mut(hash) { if entry.hash == hash && self.eq(key.clone(), entry.key.clone())? { #[cfg(not(feature = "async"))] - let updated = - proc.call(slice::from_ref(&entry.val), &mut ContBarrier::new())?[0].clone(); + let updated = proc.call(slice::from_ref(&entry.val))?[0].clone(); #[cfg(feature = "async")] - let updated = proc - .call_sync(slice::from_ref(&entry.val), &mut ContBarrier::new())?[0] - .clone(); + let updated = proc.call_sync(slice::from_ref(&entry.val))?[0].clone(); entry.val = updated; return Ok(()); @@ -191,10 +182,10 @@ impl HashTableInner { } #[cfg(not(feature = "async"))] - let updated = proc.call(slice::from_ref(default), &mut ContBarrier::new())?[0].clone(); // + let updated = proc.call(slice::from_ref(default))?[0].clone(); #[cfg(feature = "async")] - let updated = proc.call_sync(slice::from_ref(default), &mut ContBarrier::new())?[0].clone(); + let updated = proc.call_sync(slice::from_ref(default))?[0].clone(); table.insert_unique( hash, diff --git a/src/ports.rs b/src/ports.rs index baacf8c6..bde3d6b4 100644 --- a/src/ports.rs +++ b/src/ports.rs @@ -25,7 +25,11 @@ use crate::{ enumerations::{EnumerationSet, EnumerationType}, exceptions::{Assertion, Error, Exception, raise}, gc::Trace, - proc::{Application, ContBarrier, ContPtr, DynStackElem, FuncPtr, Procedure, pop_dyn_stack}, + proc::{ + Application, ContBarrier, ContPtr, DynStackElem, FuncPtr, Procedure, + current_input_port as dyn_current_input_port, + current_output_port as dyn_current_output_port, pop_dyn_stack_cont, push_dyn_stack, + }, records::{Embeddable, Embedded, RecordTypeDescriptor}, strings::WideString, symbols::Symbol, @@ -686,14 +690,11 @@ mod __impl { pub(super) fn proc_to_read_fn(read: Procedure) -> ReadFn { Box::new(move |_, buff, start, count| { let [read] = read - .call( - &[ - Value::from(buff.clone()), - Value::from(start), - Value::from(count), - ], - &mut ContBarrier::new(), - ) + .call(&[ + Value::from(buff.clone()), + Value::from(start), + Value::from(count), + ]) .map_err(|err| err.add_condition(IoReadError::new()))? .try_into() .map_err(|_| { @@ -711,14 +712,11 @@ mod __impl { pub(super) fn proc_to_write_fn(write: Procedure) -> WriteFn { Box::new(move |_, buff, start, count| { let _ = write - .call( - &[ - Value::from(buff.clone()), - Value::from(start), - Value::from(count), - ], - &mut ContBarrier::new(), - ) + .call(&[ + Value::from(buff.clone()), + Value::from(start), + Value::from(count), + ]) .map_err(|err| err.add_condition(IoReadError::new()))?; Ok(()) }) @@ -727,7 +725,7 @@ mod __impl { pub(super) fn proc_to_get_pos_fn(get_pos: Procedure) -> GetPosFn { Box::new(move |_| { let [pos] = get_pos - .call(&[], &mut ContBarrier::new()) + .call(&[]) .map_err(|err| err.add_condition(IoError::new()))? .try_into() .map_err(|_| { @@ -743,7 +741,7 @@ mod __impl { pub(super) fn proc_to_set_pos_fn(set_pos: Procedure) -> SetPosFn { Box::new(move |_, pos| { let _ = set_pos - .call(&[Value::from(pos)], &mut ContBarrier::new()) + .call(&[Value::from(pos)]) .map_err(|err| err.add_condition(IoError::new()))?; Ok(()) }) @@ -752,7 +750,7 @@ mod __impl { pub(super) fn proc_to_close_fn(close: Procedure) -> CloseFn { Box::new(move |_| { let _ = close - .call(&[], &mut ContBarrier::new()) + .call(&[]) .map_err(|err| err.add_condition(IoError::new()))?; Ok(()) }) @@ -949,14 +947,11 @@ mod __impl { let read = read.clone(); Box::pin(async move { let [read] = read - .call( - &[ - Value::from(buff.clone()), - Value::from(start), - Value::from(count), - ], - &mut ContBarrier::new(), - ) + .call(&[ + Value::from(buff.clone()), + Value::from(start), + Value::from(count), + ]) .await .map_err(|err| err.add_condition(IoReadError::new()))? .try_into() @@ -980,14 +975,11 @@ mod __impl { let write = write.clone(); Box::pin(async move { let _ = write - .call( - &[ - Value::from(buff.clone()), - Value::from(start), - Value::from(count), - ], - &mut ContBarrier::new(), - ) + .call(&[ + Value::from(buff.clone()), + Value::from(start), + Value::from(count), + ]) .await .map_err(|err| err.add_condition(IoReadError::new()))?; Ok(()) @@ -1000,7 +992,7 @@ mod __impl { let get_pos = get_pos.clone(); Box::pin(async move { let [pos] = get_pos - .call(&[], &mut ContBarrier::new()) + .call(&[]) .await .map_err(|err| err.add_condition(IoError::new()))? .try_into() @@ -1022,7 +1014,7 @@ mod __impl { let set_pos = set_pos.clone(); Box::pin(async move { let _ = set_pos - .call(&[Value::from(pos)], &mut ContBarrier::new()) + .call(&[Value::from(pos)]) .await .map_err(|err| err.add_condition(IoError::new()))?; Ok(()) @@ -1035,7 +1027,7 @@ mod __impl { let close = close.clone(); Box::pin(async move { let _ = close - .call(&[], &mut ContBarrier::new()) + .call(&[]) .await .map_err(|err| err.add_condition(IoError::new()))?; Ok(()) @@ -1899,14 +1891,11 @@ impl CustomTextualPortData { && let len = self.output_buffer.len() && len != 0 { - maybe_await!(write.call( - &[ - Value::from(self.output_buffer.clone()), - Value::from(0usize), - Value::from(len) - ], - &mut ContBarrier::new() - ))?; + maybe_await!(write.call(&[ + Value::from(self.output_buffer.clone()), + Value::from(0usize), + Value::from(len) + ]))?; self.output_buffer.clear(); } @@ -1921,14 +1910,11 @@ impl CustomTextualPortData { (self.chars_read, self.input_buffer.len() - self.chars_read) } }; - let read: usize = maybe_await!(read.call( - &[ - Value::from(self.input_buffer.clone()), - Value::from(start), - Value::from(count) - ], - &mut ContBarrier::new() - ))? + let read: usize = maybe_await!(read.call(&[ + Value::from(self.input_buffer.clone()), + Value::from(start), + Value::from(count) + ]))? .expect1()?; if read == 0 { @@ -1983,11 +1969,11 @@ impl CustomTextualPortData { && let Some(set_pos) = port_info.set_pos.as_ref() && self.chars_read > 0 { - let curr_pos: u64 = maybe_await!(get_pos.call(&[], &mut ContBarrier::new()))? + let curr_pos: u64 = maybe_await!(get_pos.call(&[]))? .expect1() .map_err(|err: Exception| err.add_condition(IoWriteError::new()))?; let seek_to = curr_pos - (self.chars_read as u64 - self.input_pos as u64); - maybe_await!(set_pos.call(&[Value::from(seek_to)], &mut ContBarrier::new()))?; + maybe_await!(set_pos.call(&[Value::from(seek_to)]))?; self.chars_read = 0; self.input_pos = 0; } @@ -1998,14 +1984,11 @@ impl CustomTextualPortData { { self.output_buffer.0.chars.write()[0] = chr; } - maybe_await!(write.call( - &[ - Value::from(self.output_buffer.clone()), - Value::from(0usize), - Value::from(1usize) - ], - &mut ContBarrier::new() - ))?; + maybe_await!(write.call(&[ + Value::from(self.output_buffer.clone()), + Value::from(0usize), + Value::from(1usize) + ]))?; } } BufferMode::Line => { @@ -2022,14 +2005,11 @@ impl CustomTextualPortData { } } let len = self.output_buffer.len(); - maybe_await!(write.call( - &[ - Value::from(self.output_buffer.clone()), - Value::from(0usize), - Value::from(len) - ], - &mut ContBarrier::new() - ))?; + maybe_await!(write.call(&[ + Value::from(self.output_buffer.clone()), + Value::from(0usize), + Value::from(len) + ]))?; self.output_buffer.clear(); } } @@ -2037,14 +2017,11 @@ impl CustomTextualPortData { for chr in s.chars() { let len = self.output_buffer.len(); if len >= BUFFER_SIZE { - maybe_await!(write.call( - &[ - Value::from(self.output_buffer.clone()), - Value::from(0usize), - Value::from(len) - ], - &mut ContBarrier::new() - ))?; + maybe_await!(write.call(&[ + Value::from(self.output_buffer.clone()), + Value::from(0usize), + Value::from(len) + ]))?; self.output_buffer.clear(); } self.output_buffer.0.chars.write().push(chr); @@ -2065,14 +2042,11 @@ impl CustomTextualPortData { return Err(Exception::io_error("port is closed")); } - maybe_await!(write.call( - &[ - Value::from(self.output_buffer.clone()), - Value::from(0usize), - Value::from(self.output_buffer.len()), - ], - &mut ContBarrier::new() - ))?; + maybe_await!(write.call(&[ + Value::from(self.output_buffer.clone()), + Value::from(0usize), + Value::from(self.output_buffer.len()), + ]))?; self.output_buffer.clear(); Ok(()) @@ -2088,7 +2062,7 @@ impl CustomTextualPortData { return Err(Exception::io_error("port is closed")); } - maybe_await!(get_pos.call(&[], &mut ContBarrier::new()))?.expect1() + maybe_await!(get_pos.call(&[]))?.expect1() } #[maybe_async] @@ -2105,21 +2079,18 @@ impl CustomTextualPortData { // Reset the buffers if let Some(write) = port_info.write.as_ref() { - maybe_await!(write.call( - &[ - Value::from(self.output_buffer.clone()), - Value::from(0usize), - Value::from(self.output_buffer.len()), - ], - &mut ContBarrier::new() - ))?; + maybe_await!(write.call(&[ + Value::from(self.output_buffer.clone()), + Value::from(0usize), + Value::from(self.output_buffer.len()), + ]))?; self.output_buffer.clear(); } self.chars_read = 0; self.input_pos = 0; - maybe_await!(set_pos.call(&[Value::from(pos)], &mut ContBarrier::new()))?; + maybe_await!(set_pos.call(&[Value::from(pos)]))?; Ok(()) } @@ -2136,7 +2107,7 @@ impl CustomTextualPortData { maybe_await!(self.flush(port_info))?; if let Some(close) = port_info.close.as_ref() { - maybe_await!(close.call(&[], &mut ContBarrier::new()))?; + maybe_await!(close.call(&[]))?; } Ok(()) @@ -3802,7 +3773,7 @@ pub fn current_input_port( _rest_args: &[Value], barrier: &mut ContBarrier, ) -> Result { - let current_input_port = barrier.current_input_port(); + let current_input_port = dyn_current_input_port(); Ok(barrier.call_cont(vec![Value::from(current_input_port)])) } @@ -3813,7 +3784,7 @@ pub fn current_output_port( _rest_args: &[Value], barrier: &mut ContBarrier, ) -> Result { - let current_input_port = barrier.current_output_port(); + let current_input_port = dyn_current_output_port(); Ok(barrier.call_cont(vec![Value::from(current_input_port)])) } @@ -4580,14 +4551,14 @@ pub fn with_input_from_file( Some(Transcoder::native()), ); - barrier.push_dyn_stack(DynStackElem::CurrentInputPort(port.clone())); + push_dyn_stack(DynStackElem::CurrentInputPort(port.clone())); let (req_args, var) = barrier.cont_formals(); // Stack (bottom to top): the outer continuation, pop_dyn_stack (removes the // current-input-port entry), then close_port_and_call_k (closes the port). // The thunk returns to the top. - barrier.push_cont([], ContPtr::Continuation(pop_dyn_stack), req_args, var); + barrier.push_cont([], ContPtr::Continuation(pop_dyn_stack_cont), req_args, var); barrier.push_cont( [Value::from(port.clone())], @@ -4643,11 +4614,11 @@ pub fn with_output_to_file( Some(Transcoder::native()), ); - barrier.push_dyn_stack(DynStackElem::CurrentOutputPort(port.clone())); + push_dyn_stack(DynStackElem::CurrentOutputPort(port.clone())); let (req_args, var) = barrier.cont_formals(); - barrier.push_cont([], ContPtr::Continuation(pop_dyn_stack), req_args, var); + barrier.push_cont([], ContPtr::Continuation(pop_dyn_stack_cont), req_args, var); barrier.push_cont( [Value::from(port.clone())], @@ -4692,7 +4663,7 @@ pub fn read_char( barrier: &mut ContBarrier<'_>, ) -> Result { let input_port = match rest_args { - [] => barrier.current_input_port(), + [] => dyn_current_input_port(), [input_port] => input_port.clone().try_into()?, _ => { return Ok(raise( @@ -4723,7 +4694,7 @@ pub fn peek_char( barrier: &mut ContBarrier<'_>, ) -> Result { let input_port = match rest_args { - [] => barrier.current_input_port(), + [] => dyn_current_input_port(), [input_port] => input_port.clone().try_into()?, _ => { return Ok(raise( @@ -4754,7 +4725,7 @@ pub fn read( barrier: &mut ContBarrier<'_>, ) -> Result { let input_port = match rest_args { - [] => barrier.current_input_port(), + [] => dyn_current_input_port(), [input_port] => input_port.clone().try_into()?, _ => { return Ok(raise( @@ -4787,7 +4758,7 @@ pub fn write_char( let [chr] = args else { unreachable!() }; let chr: char = chr.clone().try_into()?; let output_port = match rest_args { - [] => barrier.current_output_port(), + [] => dyn_current_output_port(), [output_port] => output_port.clone().try_into()?, _ => { return Ok(raise( @@ -4814,7 +4785,7 @@ pub fn newline( barrier: &mut ContBarrier<'_>, ) -> Result { let output_port = match rest_args { - [] => barrier.current_output_port(), + [] => dyn_current_output_port(), [output_port] => output_port.clone().try_into()?, _ => { return Ok(raise( @@ -4843,7 +4814,7 @@ pub fn display( let [obj] = args else { unreachable!() }; let obj = format!("{obj}"); let output_port = match rest_args { - [] => barrier.current_output_port(), + [] => dyn_current_output_port(), [output_port] => output_port.clone().try_into()?, _ => { return Ok(raise( @@ -4872,7 +4843,7 @@ pub fn write( let [obj] = args else { unreachable!() }; let obj = format!("{obj:?}"); let output_port = match rest_args { - [] => barrier.current_output_port(), + [] => dyn_current_output_port(), [output_port] => output_port.clone().try_into()?, _ => { return Ok(raise( diff --git a/src/proc.rs b/src/proc.rs index 02939623..3c6f1bf3 100644 --- a/src/proc.rs +++ b/src/proc.rs @@ -92,6 +92,7 @@ use crate::{ ports::{BufferMode, Port, Transcoder}, records::{Embeddable, Embedded, RecordTypeDescriptor, rtd}, registry::BridgeFnDebugInfo, + runtime::Runtime, symbols::Symbol, syntax::Span, value::Value, @@ -99,8 +100,11 @@ use crate::{ }; use scheme_rs_macros::{cps_bridge, maybe_async, maybe_await}; use smallvec::SmallVec; +#[cfg(feature = "async")] +use std::future::Future; use std::{ any::Any, + cell::RefCell, collections::HashMap, fmt, mem::MaybeUninit, @@ -474,7 +478,17 @@ impl Procedure { /// Applies `args` to the procedure and returns the values it evaluates to. #[maybe_async] - pub fn call( + pub fn call(&self, args: &[Value]) -> Result, Exception> { + maybe_await!(self.call_with_barrier(args, &mut ContBarrier::new())) + } + + #[cfg(feature = "async")] + pub fn call_sync(&self, args: &[Value]) -> Result, Exception> { + self.call_sync_with_barrier(args, &mut ContBarrier::new()) + } + + #[maybe_async] + pub fn call_with_barrier( &self, args: &[Value], barrier: &mut ContBarrier<'_>, @@ -483,7 +497,7 @@ impl Procedure { } #[cfg(feature = "async")] - pub fn call_sync( + pub fn call_sync_with_barrier( &self, args: &[Value], barrier: &mut ContBarrier<'_>, @@ -600,10 +614,9 @@ impl Application { } } - /// Evaluate the application - and all subsequent application - until all that - /// remains are values. This is the main trampoline of the evaluation engine. + /// The main trampoline loop. #[maybe_async] - pub fn eval(mut self, barrier: &mut ContBarrier<'_>) -> Result, Exception> { + fn eval_inner(mut self, barrier: &mut ContBarrier<'_>) -> Result, Exception> { loop { let Application { op, args } = self; self = match op { @@ -617,9 +630,33 @@ impl Application { } } + /// Evaluate the application - and all subsequent application - until all that + /// remains are values. This is the main trampoline of the evaluation engine. + /// + /// Publishes the runtime's root dynamic state if none is already active; + /// reuses whatever's published otherwise. #[cfg(feature = "async")] - /// Just like [eval] but throws an error if we encounter an async function. - pub fn eval_sync(mut self, barrier: &mut ContBarrier) -> Result, Exception> { + pub async fn eval(self, barrier: &mut ContBarrier<'_>) -> Result, Exception> { + if !DYN_STATE.is_published() { + with_root_dyn_state(Runtime::handle(), self.eval_inner(barrier)).await + } else { + self.eval_inner(barrier).await + } + } + + /// Evaluate the application - and all subsequent application - until all that + /// remains are values. This is the main trampoline of the evaluation engine. + #[cfg(not(feature = "async"))] + pub fn eval(self, barrier: &mut ContBarrier<'_>) -> Result, Exception> { + if !DYN_STATE.is_published() { + with_root_dyn_state_sync(Runtime::handle(), move || self.eval_inner(barrier)) + } else { + self.eval_inner(barrier) + } + } + + #[cfg(feature = "async")] + fn eval_sync_inner(mut self, barrier: &mut ContBarrier) -> Result, Exception> { loop { let Application { op, args } = self; self = match op { @@ -632,6 +669,16 @@ impl Application { }; } } + + #[cfg(feature = "async")] + /// Just like [eval] but throws an error if we encounter an async function. + pub fn eval_sync(self, barrier: &mut ContBarrier) -> Result, Exception> { + if !DYN_STATE.is_published() { + with_root_dyn_state_sync(Runtime::handle(), move || self.eval_sync_inner(barrier)) + } else { + self.eval_sync_inner(barrier) + } + } } /// Debug information associated with a procedure, including its name, argument @@ -705,16 +752,268 @@ type Param<'a> = &'a mut (dyn Any + Send + Sync); #[cfg(not(feature = "async"))] type Param<'a> = &'a mut dyn Any; +/// The dynamic state of a running program, owned by the trampoline as a +/// local and published as the current dynamic state for an evaluation. +#[derive(Trace)] +pub struct DynState { + /// The active dynamic stack + dyn_stack: Vec, + /// Whether this is the state currently being evaluated. False for a + /// dormant/idle slot; [`DynStateSlot::is_published`] is just this flag. + published: bool, +} + +impl DynState { + fn new() -> Self { + Self { + dyn_stack: Vec::new(), + published: false, + } + } + + /// Current ports cross a spawn boundary; winders, handlers, and prompts + /// do not. + fn spawn_snapshot(&self) -> DynState { + DynState { + dyn_stack: self + .dyn_stack + .iter() + .filter(|elem| elem.crosses_spawn()) + .cloned() + .collect(), + published: false, + } + } +} + +impl Default for DynState { + fn default() -> Self { + Self::new() + } +} + +impl DynStackElem { + /// Only current ports survive a spawn. + fn crosses_spawn(&self) -> bool { + matches!( + self, + DynStackElem::CurrentInputPort(_) | DynStackElem::CurrentOutputPort(_) + ) + } +} + +std::thread_local! { + /// Sync-trampoline dynamic state. Always holds a `DynState`; dormant + /// (not currently evaluating) is `published == false`, not absence. + static CURRENT_DYN_STATE: RefCell = RefCell::new(DynState::new()); +} + +#[cfg(feature = "async")] +tokio::task_local! { + /// Async-trampoline dynamic state (survives work-stealing). + static TASK_DYN_STATE: RefCell; +} + +pub(crate) struct DynStateGuard(DynState); + +impl Drop for DynStateGuard { + fn drop(&mut self) { + CURRENT_DYN_STATE.with(|c| *c.borrow_mut() = std::mem::take(&mut self.0)); + } +} + +/// Unified access to the thread-local and task-local dynamic state. +struct DynStateSlot; + +static DYN_STATE: DynStateSlot = DynStateSlot; + +impl DynStateSlot { + fn is_published(&self) -> bool { + #[cfg(feature = "async")] + if let Ok(published) = TASK_DYN_STATE.try_with(|c| c.borrow().published) { + return published; + } + CURRENT_DYN_STATE.with(|c| c.borrow().published) + } + + /// Short borrow of the current dynamic state; never hold across + /// re-entry. + fn with(&self, f: impl FnOnce(&mut DynState) -> R) -> R { + #[cfg(feature = "async")] + { + let task_active = TASK_DYN_STATE.try_with(|_| ()).is_ok(); + if task_active { + return TASK_DYN_STATE.with(|c| f(&mut c.borrow_mut())); + } + } + CURRENT_DYN_STATE.with(|c| f(&mut c.borrow_mut())) + } + + /// Publish state for a synchronous evaluation. + fn enter_sync(&self, mut state: DynState) -> DynStateGuard { + state.published = true; + let prev = CURRENT_DYN_STATE.with(|c| std::mem::replace(&mut *c.borrow_mut(), state)); + DynStateGuard(prev) + } + + /// Publish state for an async evaluation. + #[cfg(feature = "async")] + async fn enter_async(&self, mut state: DynState, fut: F) -> F::Output { + state.published = true; + TASK_DYN_STATE.scope(RefCell::new(state), fut).await + } +} + +pub(crate) fn with_dyn_state_sync(state: DynState, f: impl FnOnce() -> R) -> R { + let _guard = DYN_STATE.enter_sync(state); + f() +} + +#[cfg(feature = "async")] +pub(crate) async fn with_dyn_state(state: DynState, fut: F) -> F::Output { + DYN_STATE.enter_async(state, fut).await +} + +/// On drop, takes whatever's published and checks it back into `runtime`, +/// marked no longer published. Runs before the enclosing [`DynStateGuard`] +/// (declared first, so dropped last) restores the previous (dormant) slot, +/// so it still observes the finished state. +struct RootDynStateCheckin(Runtime); + +impl Drop for RootDynStateCheckin { + fn drop(&mut self) { + let mut state = DYN_STATE.with(std::mem::take); + state.published = false; + self.0.restore_dyn_state(state); + } +} + +/// Checks out `runtime`'s root dynamic state and publishes it for the +/// duration of `f`, then checks the (possibly mutated) state back in so +/// later top-level entries into `runtime` observe the same parameter +/// roots, current ports, etc. +pub(crate) fn with_root_dyn_state_sync(runtime: Runtime, f: impl FnOnce() -> R) -> R { + let state = runtime.checkout_dyn_state(); + let _guard = DYN_STATE.enter_sync(state); + let _checkin = RootDynStateCheckin(runtime); + f() +} + +/// Async counterpart to [`with_root_dyn_state_sync`]. The checkin runs +/// inside the scoped future so it can still read the task-local dynamic +/// state once `fut` completes (or is dropped without completing). +/// +/// Boxed so this call's stack frame stays a fixed, small size regardless of +/// what `fut` contains: macro transformers re-enter `eval` (and thus this +/// function) once per level of macro nesting in the source being expanded, +/// so an unboxed frame here grows with source-level macro nesting depth and +/// can overflow the stack on deeply macro-heavy code. +#[cfg(feature = "async")] +pub(crate) async fn with_root_dyn_state(runtime: Runtime, fut: F) -> F::Output +where + F::Output: Send, +{ + let state = runtime.checkout_dyn_state(); + let boxed: std::pin::Pin + Send>> = Box::pin(async move { + let _checkin = RootDynStateCheckin(runtime); + fut.await + }); + DYN_STATE.enter_async(state, boxed).await +} + +// TODO: We should certainly try to optimize these functions. Linear +// searching isn't _great_, although in practice I can't imagine this stack +// will ever get very large. + +pub fn current_exception_handler() -> Option { + DYN_STATE.with(|s| { + s.dyn_stack.iter().rev().find_map(|elem| match elem { + DynStackElem::ExceptionHandler(proc) => Some(proc.clone()), + _ => None, + }) + }) +} + +pub fn current_input_port() -> Port { + DYN_STATE.with(|s| { + s.dyn_stack + .iter() + .rev() + .find_map(|elem| match elem { + DynStackElem::CurrentInputPort(port) => Some(port.clone()), + _ => None, + }) + .unwrap_or_else(|| { + Port::new( + "", + #[cfg(not(feature = "async"))] + std::io::stdin(), + #[cfg(feature = "tokio")] + tokio::io::stdin(), + BufferMode::Line, + Some(Transcoder::native()), + ) + }) + }) +} + +pub fn current_output_port() -> Port { + DYN_STATE.with(|s| { + s.dyn_stack + .iter() + .rev() + .find_map(|elem| match elem { + DynStackElem::CurrentOutputPort(port) => Some(port.clone()), + _ => None, + }) + .unwrap_or_else(|| { + Port::new( + "", + #[cfg(not(feature = "async"))] + std::io::stdout(), + #[cfg(feature = "tokio")] + tokio::io::stdout(), + // TODO: Probably should change this to line, but that + // doesn't play nicely with rustyline + BufferMode::None, + Some(Transcoder::native()), + ) + }) + }) +} + +pub(crate) fn push_dyn_stack(elem: DynStackElem) { + DYN_STATE.with(|s| s.dyn_stack.push(elem)); +} + +pub(crate) fn pop_dyn_stack() -> Option { + DYN_STATE.with(|s| s.dyn_stack.pop()) +} + +pub(crate) fn dyn_stack_last() -> Option { + DYN_STATE.with(|s| s.dyn_stack.last().cloned()) +} + +pub(crate) fn dyn_stack_len() -> usize { + DYN_STATE.with(|s| s.dyn_stack.len()) +} + +pub(crate) fn dyn_stack_is_empty() -> bool { + DYN_STATE.with(|s| s.dyn_stack.is_empty()) +} + +pub(crate) fn dyn_state_snapshot() -> DynState { + if !DYN_STATE.is_published() { + return DynState::new(); + } + DYN_STATE.with(|s| s.spawn_snapshot()) +} + /// A continuation barrier. Escape procedures created within a continuation /// barrier cannot be called within another barrier. -/// -/// This structure also contains the dynamic state of the running program -/// including winders, exception handlers, continuation marks, and parameters. pub struct ContBarrier<'a> { /// The id of the barrier. Checked when calling an escape procedure id: usize, - /// The active dynamic stack - dyn_stack: Vec, /// The current live continuations for the program. Effectively the call /// stack. Includes active [continuation marks](https://srfi.schemers.org/srfi-157/srfi-157.html). cont_stack: ContStack, @@ -728,7 +1027,6 @@ impl<'a> ContBarrier<'a> { let mut this = Self { id: NEXT_ID.fetch_add(1, Ordering::Relaxed), - dyn_stack: Vec::new(), cont_stack: ContStack::default(), params: HashMap::new(), }; @@ -739,12 +1037,14 @@ impl<'a> ContBarrier<'a> { this } + /// Captures the barrier id and a copy of the current dyn_stack/cont_stack, + /// for restoring later (call/cc, prompts). pub fn save(&self) -> SavedDynamicState { - SavedDynamicState { + DYN_STATE.with(|s| SavedDynamicState { id: self.id, - dyn_stack: self.dyn_stack.clone(), + dyn_stack: s.dyn_stack.clone(), cont_stack: self.cont_stack.clone(), - } + }) } pub fn add_param( @@ -775,6 +1075,8 @@ impl<'a> ContBarrier<'a> { /// Constructs a child barrier from the current barrier, extracting an array /// of parameters that are not automatically passed onto the child. + /// dyn_stack isn't copied here (it's ambient, already shared); cont_stack + /// is, via `save`/`From`. pub fn child_barrier<'b, 'c, const N: usize>( &'b mut self, params: [impl Into; N], @@ -821,81 +1123,6 @@ impl<'a> ContBarrier<'a> { .insert(tag, val); } - // TODO: We should certainly try to optimize these functions. Linear - // searching isn't _great_, although in practice I can't imagine this stack - // will ever get very large. - - pub fn current_exception_handler(&self) -> Option { - self.dyn_stack.iter().rev().find_map(|elem| match elem { - DynStackElem::ExceptionHandler(proc) => Some(proc.clone()), - _ => None, - }) - } - - pub fn current_input_port(&self) -> Port { - self.dyn_stack - .iter() - .rev() - .find_map(|elem| match elem { - DynStackElem::CurrentInputPort(port) => Some(port.clone()), - _ => None, - }) - .unwrap_or_else(|| { - Port::new( - "", - #[cfg(not(feature = "async"))] - std::io::stdin(), - #[cfg(feature = "tokio")] - tokio::io::stdin(), - BufferMode::Line, - Some(Transcoder::native()), - ) - }) - } - - pub fn current_output_port(&self) -> Port { - self.dyn_stack - .iter() - .rev() - .find_map(|elem| match elem { - DynStackElem::CurrentOutputPort(port) => Some(port.clone()), - _ => None, - }) - .unwrap_or_else(|| { - Port::new( - "", - #[cfg(not(feature = "async"))] - std::io::stdout(), - #[cfg(feature = "tokio")] - tokio::io::stdout(), - // TODO: Probably should change this to line, but that - // doesn't play nicely with rustyline - BufferMode::None, - Some(Transcoder::native()), - ) - }) - } - - pub(crate) fn push_dyn_stack(&mut self, elem: DynStackElem) { - self.dyn_stack.push(elem); - } - - pub(crate) fn pop_dyn_stack(&mut self) -> Option { - self.dyn_stack.pop() - } - - pub(crate) fn dyn_stack_last(&self) -> Option<&DynStackElem> { - self.dyn_stack.last() - } - - pub(crate) fn dyn_stack_len(&self) -> usize { - self.dyn_stack.len() - } - - pub(crate) fn dyn_stack_is_empty(&self) -> bool { - self.dyn_stack.is_empty() - } - /// Push a continuation onto the current call stack. #[allow(private_bounds)] pub fn push_cont( @@ -944,7 +1171,7 @@ impl<'a> ContBarrier<'a> { app.assume_init() }, ContPtr::PromptBarrier { .. } => { - self.pop_dyn_stack(); + pop_dyn_stack(); let mut values: Vec = args[..curr_frame.num_required_args].to_vec(); if curr_frame.variadic { list_to_vec(&args[curr_frame.num_required_args], &mut values); @@ -979,7 +1206,8 @@ where } } -/// A copy of [`ContBarrier`] without mutable parameters +/// Independent of the current dynamic state: a plain value, safe to embed +/// and pass around Scheme code. #[derive(Clone, Trace)] pub struct SavedDynamicState { id: usize, @@ -999,8 +1227,10 @@ impl SavedDynamicState { impl From for ContBarrier<'_> { fn from(value: SavedDynamicState) -> Self { + // dyn_stack isn't restored here: it's ambient (shared with whatever + // published it), not barrier-local, so a sibling/child barrier + // already observes it without copying. ContBarrier { - dyn_stack: value.dyn_stack, cont_stack: value.cont_stack, ..Default::default() } @@ -1022,7 +1252,8 @@ pub(crate) enum DynStackElem { CurrentOutputPort(Port), } -pub(crate) unsafe extern "C" fn pop_dyn_stack( +/// Named distinctly from the free function `pop_dyn_stack` to avoid a clash. +pub(crate) unsafe extern "C" fn pop_dyn_stack_cont( _env: *const Value, args: *const Value, barrier: *mut ContBarrier, @@ -1030,7 +1261,7 @@ pub(crate) unsafe extern "C" fn pop_dyn_stack( ) { unsafe { let barrier = barrier.as_mut().unwrap_unchecked(); - barrier.pop_dyn_stack(); + pop_dyn_stack(); let (num_required_args, variadic) = barrier.cont_formals(); let mut collected_args: Vec<_> = (0..num_required_args) @@ -1160,8 +1391,15 @@ fn escape_procedure( .cast::>() .unwrap(); + // Cross-barrier escape must halt this trampoline (halt_err) instead of + // raising through the exception-handler search. With shared dynamic state, + // raising would find a handler belonging to an ancestor evaluation (e.g. + // guard's), whose own escape continuation also crosses this barrier, + // causing a second rejection with no handler left to catch it. if saved_barrier.id != barrier.id { - return Err(Exception::error("attempt to cross continuation barrier")); + return Ok(Application::halt_err(Value::from(Exception::error( + "attempt to cross continuation barrier", + )))); } let args = args.iter().chain(rest_args).cloned().collect::>(); @@ -1196,12 +1434,11 @@ unsafe extern "C" fn unwind( let barrier = barrier.as_mut().unwrap_unchecked(); - while !barrier.dyn_stack_is_empty() - && (barrier.dyn_stack_len() > dest_stack_read.dyn_stack_len() - || barrier.dyn_stack_last() - != dest_stack_read.dyn_stack_get(barrier.dyn_stack_len() - 1)) + while !dyn_stack_is_empty() + && (dyn_stack_len() > dest_stack_read.dyn_stack_len() + || dyn_stack_last().as_ref() != dest_stack_read.dyn_stack_get(dyn_stack_len() - 1)) { - match barrier.pop_dyn_stack() { + match pop_dyn_stack() { None => { break; } @@ -1255,14 +1492,11 @@ unsafe extern "C" fn wind( let winder = env.add(2).as_ref().unwrap().clone(); if winder.is_true() { let winder = winder.try_to::>().unwrap(); - barrier.push_dyn_stack(DynStackElem::Winder(winder.as_ref().clone())); + push_dyn_stack(DynStackElem::Winder(winder.as_ref().clone())); } - while barrier.dyn_stack_len() < dest_stack_read.dyn_stack_len() { - match dest_stack_read - .dyn_stack_get(barrier.dyn_stack_len()) - .cloned() - { + while dyn_stack_len() < dest_stack_read.dyn_stack_len() { + match dest_stack_read.dyn_stack_get(dyn_stack_len()).cloned() { None => { break; } @@ -1279,7 +1513,7 @@ unsafe extern "C" fn wind( (*out).write(app); return; } - Some(elem) => barrier.push_dyn_stack(elem), + Some(elem) => push_dyn_stack(elem), } } @@ -1427,7 +1661,7 @@ pub(crate) unsafe extern "C" fn call_body_thunk( let barrier = barrier.as_mut().unwrap_unchecked(); - barrier.push_dyn_stack(DynStackElem::Winder(Winder { + push_dyn_stack(DynStackElem::Winder(Winder { in_thunk: in_thunk.clone().try_into().unwrap(), out_thunk: out_thunk.clone().try_into().unwrap(), })); @@ -1452,7 +1686,7 @@ pub(crate) unsafe extern "C" fn call_out_thunks( let body_thunk_res = args.as_ref().unwrap().clone(); let barrier = barrier.as_mut().unwrap_unchecked(); - barrier.pop_dyn_stack(); + pop_dyn_stack(); barrier.push_cont( vec![body_thunk_res], @@ -1512,7 +1746,7 @@ pub fn call_with_prompt( let barrier_id = BARRIER_ID.fetch_add(1, Ordering::Relaxed); - barrier.push_dyn_stack(DynStackElem::Prompt(Prompt { + push_dyn_stack(DynStackElem::Prompt(Prompt { tag, handler: handler.clone().try_into().unwrap(), barrier_id, @@ -1569,10 +1803,13 @@ unsafe extern "C" fn unwind_to_prompt( let barrier = barrier.as_mut().unwrap_unchecked(); loop { - let app = match barrier.pop_dyn_stack() { - None => Application::halt_err(Value::from(Exception::error(format!( - "no prompt tag {tag} found" - )))), + let app = match pop_dyn_stack() { + None => { + // If the stack is empty, we should return the error + Application::halt_err(Value::from(Exception::error(format!( + "no prompt tag {tag} found" + )))) + } Some(DynStackElem::Prompt(Prompt { tag: prompt_tag, barrier_id, @@ -1611,8 +1848,7 @@ unsafe extern "C" fn unwind_to_prompt( .unwrap(); let prompt_delimited_barrier = SavedDynamicState { id: saved_barrier.id, - dyn_stack: saved_barrier.as_ref().dyn_stack[barrier.dyn_stack_len() + 1..] - .to_vec(), + dyn_stack: saved_barrier.as_ref().dyn_stack[dyn_stack_len() + 1..].to_vec(), cont_stack: delimited_cont, }; @@ -1706,7 +1942,7 @@ unsafe extern "C" fn wind_delim( let winder = env.add(3).as_ref().unwrap().clone(); if winder.is_true() { let winder = winder.try_to::>().unwrap(); - barrier.push_dyn_stack(DynStackElem::Winder(winder.as_ref().clone())); + push_dyn_stack(DynStackElem::Winder(winder.as_ref().clone())); } while let Some(elem) = dest_stack.as_ref().dyn_stack_get(idx) { @@ -1727,7 +1963,7 @@ unsafe extern "C" fn wind_delim( (*out).write(Application::new(winder.in_thunk.clone(), Vec::new())); return; } - barrier.push_dyn_stack(elem.clone()); + push_dyn_stack(elem.clone()); } let args: Vector = args.try_into().unwrap(); diff --git a/src/runtime.rs b/src/runtime.rs index f33ee528..df61a0a8 100644 --- a/src/runtime.rs +++ b/src/runtime.rs @@ -15,8 +15,8 @@ use crate::{ num, ports::{BufferMode, Port, Transcoder}, proc::{ - Application, ContBarrier, ContPtr, ContinuationPtr, FuncPtr, ProcDebugInfo, Procedure, - ProcedureInner, UserPtr, + Application, ContBarrier, ContPtr, ContinuationPtr, DynState, FuncPtr, ProcDebugInfo, + Procedure, ProcedureInner, UserPtr, }, registry::Registry, symbols::Symbol, @@ -186,6 +186,19 @@ impl Runtime { pub fn source_cache(&self) -> MutexGuard<'_, SourceCache> { self.0.source_cache.lock() } + + /// Takes the runtime's persistent root dynamic state, leaving a fresh + /// one behind. Paired with [`Runtime::restore_dyn_state`] to publish the + /// root state for a top-level evaluation without holding the runtime + /// lock for the evaluation's duration. + pub(crate) fn checkout_dyn_state(&self) -> DynState { + std::mem::take(&mut self.0.dyn_state.lock()) + } + + /// Checks a dynamic state back in as the runtime's root state. + pub(crate) fn restore_dyn_state(&self, state: DynState) { + *self.0.dyn_state.lock() = state; + } } #[allow(unused)] @@ -220,6 +233,11 @@ pub(crate) struct RuntimeInner { pub(crate) globals_pool: Mutex>, pub(crate) debug_info: DebugInfo, pub(crate) source_cache: Mutex, + /// The root dynamic state, persistent for the runtime's lifetime. + /// Checked out for the duration of each top-level evaluation (see + /// [`Runtime::checkout_dyn_state`]) so parameter roots, current ports, + /// etc. outlive any single eval call. + dyn_state: Mutex, } impl Default for RuntimeInner { @@ -253,6 +271,7 @@ impl RuntimeInner { globals_pool: Mutex::new(HashSet::new()), debug_info: DebugInfo::default(), source_cache: Mutex::new(SourceCache::default()), + dyn_state: Mutex::new(DynState::default()), } } } @@ -505,10 +524,8 @@ unsafe extern "C" fn set_continuation_mark( unsafe { let tag = Value::from_raw_inc_rc(tag); let val = Value::from_raw_inc_rc(val); - barrier - .as_mut() - .unwrap() - .set_continuation_mark(tag.cast().unwrap(), val); + let barrier = barrier.as_mut().unwrap_unchecked(); + barrier.set_continuation_mark(tag.cast().unwrap(), val); } } diff --git a/src/syntax/mod.rs b/src/syntax/mod.rs index 2ac9ceee..d6e9ae9f 100644 --- a/src/syntax/mod.rs +++ b/src/syntax/mod.rs @@ -6,7 +6,7 @@ use crate::{ exceptions::{CompoundCondition, Exception, Message, SyntaxViolation, Who}, gc::Trace, ports::Port, - proc::{ContBarrier, Procedure}, + proc::Procedure, records::{Embeddable, Embedded, RecordTypeDescriptor, rtd}, registry::bridge, symbols::Symbol, @@ -286,8 +286,7 @@ impl Syntax { input.add_scope(intro_scope); // Call the transformer with the input: - let transformer_output = - maybe_await!(transformer.call(&[Value::from(input)], &mut ContBarrier::new()))?; + let transformer_output = maybe_await!(transformer.call(&[Value::from(input)]))?; let output: Value = transformer_output.expect1()?; let mut output = Syntax::wrap(output, self.span()); diff --git a/src/threads.rs b/src/threads.rs index 01599981..bd0fc535 100644 --- a/src/threads.rs +++ b/src/threads.rs @@ -13,7 +13,7 @@ use scheme_rs_macros::bridge; use crate::{ exceptions::Exception, gc::{Gc, Trace}, - proc::{ContBarrier, Procedure}, + proc::{Procedure, dyn_state_snapshot, with_dyn_state_sync}, records::{Embeddable, Embedded, RecordTypeDescriptor, rtd}, value::Value, }; @@ -41,18 +41,24 @@ unsafe impl Embeddable for JoinHandle { pub fn spawn(thunk: Procedure) -> Result, Exception> { let cell = Gc::new(Mutex::new(Ok(Vec::new()))); let cell_cloned = cell.clone(); + // Snapshot the current dynamic state now, on the spawning thread: the + // spawned thread starts a new dynamic extent and must not run the + // parent's winders or see its exception handlers. + let snapshot = dyn_state_snapshot(); let join_handle = thread::spawn(move || { let mut cell_write = cell_cloned.lock(); - #[cfg(not(feature = "async"))] - { - *cell_write = thunk.call(&[], &mut ContBarrier::new()); - } + with_dyn_state_sync(snapshot, || { + #[cfg(not(feature = "async"))] + { + *cell_write = thunk.call(&[]); + } - #[cfg(feature = "async")] - { - *cell_write = thunk.call_sync(&[], &mut ContBarrier::new()); - } + #[cfg(feature = "async")] + { + *cell_write = thunk.call_sync(&[]); + } + }); }); let id = join_handle.thread().id(); Ok(vec![Value::from(JoinHandle { id, result: cell })]) From 56b9330cd0864eabc3e3d97752304bb0734e04c4 Mon Sep 17 00:00:00 2001 From: Linus Shoravi Date: Sun, 19 Jul 2026 13:20:59 +0200 Subject: [PATCH 02/10] test: dynamic state inheritance across hashtable, call/cc, and spawn Ported from #319 (commit 57bb515). Three properties of the ambient design: a hashtable hash function observes the caller's exception handler; a custom hashtable callback still can't call/cc past the Rust re-entry frame it runs in; a spawned thread doesn't run the parent's winders. --- tests/dynamic_state_inheritance.rs | 3 ++ tests/dynamic_state_inheritance.scm | 43 +++++++++++++++++++++++++++++ 2 files changed, 46 insertions(+) create mode 100644 tests/dynamic_state_inheritance.rs create mode 100644 tests/dynamic_state_inheritance.scm diff --git a/tests/dynamic_state_inheritance.rs b/tests/dynamic_state_inheritance.rs new file mode 100644 index 00000000..e7543c85 --- /dev/null +++ b/tests/dynamic_state_inheritance.rs @@ -0,0 +1,3 @@ +mod common; + +common::run_test!(dynamic_state_inheritance); diff --git a/tests/dynamic_state_inheritance.scm b/tests/dynamic_state_inheritance.scm new file mode 100644 index 00000000..cbc813ec --- /dev/null +++ b/tests/dynamic_state_inheritance.scm @@ -0,0 +1,43 @@ +(import (rnrs) (test) (threads (1))) + +;; 1. A hashtable hash function must observe the exception handler installed +;; by its caller. Without re-entry sharing the caller's DynState, it would +;; get a fresh, empty one, so raise-continuable finds no handler and the +;; guard below would produce 'no-handler-seen. +(define ht + (make-hashtable + (lambda (k) (raise-continuable 'need-hash)) + eq?)) + +(define handler-result + (guard (e (#t 'no-handler-seen)) + (with-exception-handler + (lambda (c) 42) + (lambda () + (hashtable-set! ht 'a 1) + (hashtable-ref ht 'a #f))))) + +(assert-equal? handler-result 1) + +;; 2. Escape procedures still cannot cross the Rust re-entry frame: the +;; fresh barrier id at the callback boundary rejects the jump. +(assert-equal? + (call/cc + (lambda (k) + (let ((ht2 (make-hashtable (lambda (key) (k 'escaped)) eq?))) + (guard (e (#t 'blocked)) + (hashtable-set! ht2 'x 1) + 'not-blocked)))) + 'blocked) + +;; 3. A spawned thread must not run the parent's winders. Each parent +;; winder fires exactly once, from the parent. +(define order '()) +(dynamic-wind + (lambda () (set! order (cons 'in order))) + (lambda () + (join (spawn (lambda () + (guard (e (#t 'caught)) + (error 'child "boom")))))) + (lambda () (set! order (cons 'out order)))) +(assert-equal? order '(out in)) From 22ebf720f1c2d83495c6bc773cf0fef3dbd323c7 Mon Sep 17 00:00:00 2001 From: Linus Shoravi Date: Fri, 3 Jul 2026 16:39:05 +0200 Subject: [PATCH 03/10] Make join wait for the spawned thread and surface panics join read the result cell guarded only by a mutex the child locks as its first action; if join won that race it returned the initial empty result, which surfaced downstream as a wrong-arity error at the continuation. Hold the std::thread::JoinHandle and join it before reading. A panicking thunk previously left the cell at its empty default; the panic payload is now stored as an exception so every joiner sees it. --- src/threads.rs | 61 +++++++++++++++++++++++++++++++++++++++---- tests/thread_join.rs | 3 +++ tests/thread_join.scm | 5 ++++ 3 files changed, 64 insertions(+), 5 deletions(-) create mode 100644 tests/thread_join.rs create mode 100644 tests/thread_join.scm diff --git a/src/threads.rs b/src/threads.rs index bd0fc535..86b17960 100644 --- a/src/threads.rs +++ b/src/threads.rs @@ -22,6 +22,8 @@ use crate::{ pub struct JoinHandle { #[trace(skip)] id: ThreadId, + #[trace(skip)] + thread: Mutex>>, result: Gc, Exception>>>, } @@ -61,19 +63,39 @@ pub fn spawn(thunk: Procedure) -> Result, Exception> { }); }); let id = join_handle.thread().id(); - Ok(vec![Value::from(JoinHandle { id, result: cell })]) + Ok(vec![Value::from(JoinHandle { + id, + thread: Mutex::new(Some(join_handle)), + result: cell, + })]) } #[bridge(name = "join", lib = "(threads (1))")] pub fn join(handle: Embedded) -> Result, Exception> { + join_inner(&handle) +} + +fn join_inner(handle: &JoinHandle) -> Result, Exception> { let curr_id = thread::current().id(); if curr_id == handle.id { - Err(Exception::error(format!( + return Err(Exception::error(format!( "thread {curr_id:?} attempted to join itself" - ))) - } else { - handle.result.lock().clone() + ))); } + // The scrutinee's MutexGuard is held across join() (if-let temporary + // scope), which is what blocks concurrent joiners until the thread has + // finished; don't hoist the lock() into its own binding. + if let Some(thread) = handle.thread.lock().take() + && let Err(payload) = thread.join() + { + let msg = payload + .downcast_ref::<&str>() + .map(ToString::to_string) + .or_else(|| payload.downcast_ref::().cloned()) + .unwrap_or_else(|| "unknown panic".to_string()); + *handle.result.lock() = Err(Exception::error(format!("thread panicked: {msg}"))); + } + handle.result.lock().clone() } #[bridge(name = "sleep", lib = "(threads (1))")] @@ -86,3 +108,32 @@ pub fn sleep(ms: u64) -> Result, Exception> { pub fn join_handle_pred(obj: &Value) -> Result, Exception> { Ok(vec![Value::from(obj.is_a::>())]) } + +#[cfg(test)] +mod tests { + use super::*; + use crate::exceptions::{CompoundCondition, Message}; + + fn exception_message(err: &Exception) -> String { + let cond: Embedded = Option::from(&err.0).expect("compound condition"); + cond.0 + .iter() + .find_map(|c| Option::>::from(c).map(|m| m.message.clone())) + .expect("message condition") + } + + #[test] + fn join_surfaces_panics() { + let thread = thread::spawn(|| panic!("boom")); + let handle = JoinHandle { + id: thread.thread().id(), + thread: Mutex::new(Some(thread)), + result: Gc::new(Mutex::new(Ok(Vec::new()))), + }; + let err = join_inner(&handle).unwrap_err(); + assert!(exception_message(&err).contains("boom")); + // Subsequent joins see the persisted error, not the default cell. + let err = join_inner(&handle).unwrap_err(); + assert!(exception_message(&err).contains("boom")); + } +} diff --git a/tests/thread_join.rs b/tests/thread_join.rs new file mode 100644 index 00000000..85c1be09 --- /dev/null +++ b/tests/thread_join.rs @@ -0,0 +1,3 @@ +mod common; + +common::run_test!(thread_join); diff --git a/tests/thread_join.scm b/tests/thread_join.scm new file mode 100644 index 00000000..d00a3e0b --- /dev/null +++ b/tests/thread_join.scm @@ -0,0 +1,5 @@ +(import (rnrs) (threads) (test)) + +;; join must wait for the thread to finish even when it wins the race to +;; the result cell. +(assert-equal? (join (spawn (lambda () 42))) 42) From 8d885ab5a6408fbb35fc85a2cfb070f51fa116f7 Mon Sep 17 00:00:00 2001 From: Linus Shoravi Date: Thu, 16 Jul 2026 14:34:04 +0200 Subject: [PATCH 04/10] Run spawned thunks under block_on instead of call_sync Spawned OS thread thunks went through call_sync, whose apply_sync arm raises on any async bridge, so thunks could not use display, put-string or the (async) library. Block on the async call path instead: enter the runtime via Handle::try_current when one exists (timers and IO work), and fall back to futures::executor::block_on otherwise. call_sync keeps its raising behavior as a strict-sync API; nothing nests block_on on one thread. Tests: an async bridge (display) inside a spawn thunk, which raised "attempt to apply async function in a sync-only context" before, and a timer-based thunk driving a real Poll::Pending round-trip through Handle::block_on on a multi_thread runtime. --- src/threads.rs | 9 ++++++++- tests/blockon_pending.rs | 17 +++++++++++++++++ tests/blockon_pending.scm | 7 +++++++ tests/thread_async_bridge.rs | 3 +++ tests/thread_async_bridge.scm | 11 +++++++++++ 5 files changed, 46 insertions(+), 1 deletion(-) create mode 100644 tests/blockon_pending.rs create mode 100644 tests/blockon_pending.scm create mode 100644 tests/thread_async_bridge.rs create mode 100644 tests/thread_async_bridge.scm diff --git a/src/threads.rs b/src/threads.rs index 86b17960..7f9bd485 100644 --- a/src/threads.rs +++ b/src/threads.rs @@ -47,6 +47,10 @@ pub fn spawn(thunk: Procedure) -> Result, Exception> { // spawned thread starts a new dynamic extent and must not run the // parent's winders or see its exception handlers. let snapshot = dyn_state_snapshot(); + // Capture the runtime handle so the child thread can block on the thunk + // inside the reactor context, letting async bridges use timers and IO. + #[cfg(feature = "async")] + let handle = tokio::runtime::Handle::try_current().ok(); let join_handle = thread::spawn(move || { let mut cell_write = cell_cloned.lock(); @@ -58,7 +62,10 @@ pub fn spawn(thunk: Procedure) -> Result, Exception> { #[cfg(feature = "async")] { - *cell_write = thunk.call_sync(&[]); + *cell_write = match handle { + Some(handle) => handle.block_on(thunk.call(&[])), + None => futures::executor::block_on(thunk.call(&[])), + }; } }); }); diff --git a/tests/blockon_pending.rs b/tests/blockon_pending.rs new file mode 100644 index 00000000..8612e741 --- /dev/null +++ b/tests/blockon_pending.rs @@ -0,0 +1,17 @@ +#![cfg(all(feature = "async", feature = "tokio"))] + +#[allow(unused)] +mod common; + +// multi_thread is required: the main test thread blocks in join() while +// another worker must drive the timer that completes the spawned thunk. +#[tokio::test(flavor = "multi_thread")] +async fn blockon_pending() { + use scheme_rs::runtime::Runtime; + use std::path::Path; + + let rt = Runtime::handle(); + rt.run_program(Path::new("tests/blockon_pending.scm")) + .await + .expect("Test blockon_pending failed"); +} diff --git a/tests/blockon_pending.scm b/tests/blockon_pending.scm new file mode 100644 index 00000000..ef0345bb --- /dev/null +++ b/tests/blockon_pending.scm @@ -0,0 +1,7 @@ +(import (rnrs) (test) (only (threads) spawn join) (only (async) sleep)) + +;; sleep from (async) suspends on a tokio timer, forcing a real Poll::Pending +;; round-trip through the block_on in the spawned OS thread instead of +;; first-poll completion. +(let ((h (spawn (lambda () (sleep 5) 'woke)))) + (assert-equal? (join h) 'woke)) diff --git a/tests/thread_async_bridge.rs b/tests/thread_async_bridge.rs new file mode 100644 index 00000000..26a73f4e --- /dev/null +++ b/tests/thread_async_bridge.rs @@ -0,0 +1,3 @@ +mod common; + +common::run_test!(thread_async_bridge); diff --git a/tests/thread_async_bridge.scm b/tests/thread_async_bridge.scm new file mode 100644 index 00000000..18bdde52 --- /dev/null +++ b/tests/thread_async_bridge.scm @@ -0,0 +1,11 @@ +(import (rnrs) (threads) (test)) + +;; A spawned OS thread must be able to run async bridges: display compiles +;; to an AsyncBridge under the async feature. This used to raise "attempt +;; to apply async function in a sync-only context". +(define h + (spawn (lambda () + (display "") + 'done))) + +(assert-equal? (join h) 'done) From 8b86a96e29eaed4bc7f60421580c3eedef969aed Mon Sep 17 00:00:00 2001 From: Linus Shoravi Date: Fri, 3 Jul 2026 16:52:18 +0200 Subject: [PATCH 05/10] Run hashtable hash/eq callbacks async end-to-end HashTableInner::{hash,eq} called Scheme-defined procedures through call_sync, which raises on async bridges by design (a strict-sync call API), so Scheme hash/eq functions could not use async bridges at all. Run them through the async call path instead. Instead of swapping the table lock for tokio::sync::RwLock (viral: fmt::Debug for HashTable takes the lock inside a sync trait method, reachable from every Value print site), keep parking_lot and run the callbacks unlocked: compute the hash first, snapshot hash-matching entries under a short read lock, run eq on the clones, and re-acquire the write lock to mutate, re-finding the entry by eqv? identity. The cost is a check-then-act window under concurrent mutation (a lost update, or briefly two eq-equal-but-not-eqv? keys), documented on make-hashtable; R6RS makes no thread-safety promises for hashtables. The non-async build is untouched. Tests: a hash function hitting an async bridge (display) from hashtable operations, which raised before this change, and a hash function that awaits a tokio timer under a current_thread runtime. --- src/hashtables.rs | 281 ++++++++++++++++++++++++---- tests/hashtable_hash_fn_timer.rs | 5 + tests/hashtable_hash_fn_timer.scm | 16 ++ tests/hashtable_nested_block_on.rs | 3 + tests/hashtable_nested_block_on.scm | 18 ++ 5 files changed, 284 insertions(+), 39 deletions(-) create mode 100644 tests/hashtable_hash_fn_timer.rs create mode 100644 tests/hashtable_hash_fn_timer.scm create mode 100644 tests/hashtable_nested_block_on.rs create mode 100644 tests/hashtable_nested_block_on.scm diff --git a/src/hashtables.rs b/src/hashtables.rs index 095357d5..5ad8b860 100644 --- a/src/hashtables.rs +++ b/src/hashtables.rs @@ -2,7 +2,7 @@ use indexmap::IndexSet; use parking_lot::RwLock; -use scheme_rs_macros::rtd; +use scheme_rs_macros::{maybe_async, maybe_await, rtd}; use std::{ collections::HashSet, fmt, @@ -65,27 +65,18 @@ impl HashTableInner { self.table.read().len() } - #[cfg(not(feature = "async"))] - pub fn hash(&self, val: Value) -> Result { - self.hash.call(&[val])?.expect1() - } - - #[cfg(feature = "async")] + #[maybe_async] pub fn hash(&self, val: Value) -> Result { - self.hash.call_sync(&[val])?.expect1() - } - - #[cfg(not(feature = "async"))] - pub fn eq(&self, lhs: Value, rhs: Value) -> Result { - self.eq.call(&[lhs, rhs])?.expect1() + maybe_await!(self.hash.call(&[val]))?.expect1() } - #[cfg(feature = "async")] + #[maybe_async] pub fn eq(&self, lhs: Value, rhs: Value) -> Result { - self.eq.call_sync(&[lhs, rhs])?.expect1() + maybe_await!(self.eq.call(&[lhs, rhs]))?.expect1() } /// Equivalent to `hashtable-ref` + #[cfg(not(feature = "async"))] pub fn get(&self, key: &Value, default: &Value) -> Result { let table = self.table.read(); let hash = self.hash(key.clone())?; @@ -97,6 +88,29 @@ impl HashTableInner { Ok(default.clone()) } + /// Equivalent to `hashtable-ref`. `hash`/`eq` are arbitrary Scheme code + /// and must not run under the table lock (the guard can't cross .await), + /// so we snapshot hash-matching entries and run `eq` on the clones. + #[cfg(feature = "async")] + pub async fn get(&self, key: &Value, default: &Value) -> Result { + let hash = self.hash(key.clone()).await?; + let candidates: Vec<(Value, Value)> = self + .table + .read() + .iter_hash(hash) + .filter(|entry| entry.hash == hash) + .map(|entry| (entry.key.clone(), entry.val.clone())) + .collect(); + + for (candidate_key, candidate_val) in candidates { + if self.eq(key.clone(), candidate_key).await? { + return Ok(candidate_val); + } + } + Ok(default.clone()) + } + + #[cfg(not(feature = "async"))] pub fn set(&self, key: &Value, val: &Value) -> Result<(), Exception> { if !self.mutable { return Err(Exception::error("hashtable is immutable")); @@ -125,6 +139,57 @@ impl HashTableInner { Ok(()) } + /// `eq` runs unlocked, so there is a check-then-act window before the + /// write lock is re-acquired; see [`make_hashtable`] for the caveat. + /// The matched entry is re-found by `eqv?` identity, never by re-running + /// user code under the lock. + #[cfg(feature = "async")] + pub async fn set(&self, key: &Value, val: &Value) -> Result<(), Exception> { + if !self.mutable { + return Err(Exception::error("hashtable is immutable")); + } + + let hash = self.hash(key.clone()).await?; + let candidates: Vec = self + .table + .read() + .iter_hash(hash) + .filter(|entry| entry.hash == hash) + .map(|entry| entry.key.clone()) + .collect(); + + let mut matched_key = None; + for candidate in candidates { + if self.eq(key.clone(), candidate.clone()).await? { + matched_key = Some(candidate); + break; + } + } + + let mut table = self.table.write(); + if let Some(matched_key) = matched_key + && let Some(entry) = table + .iter_hash_mut(hash) + .find(|entry| entry.key.eqv(&matched_key)) + { + entry.val = val.clone(); + return Ok(()); + } + + table.insert_unique( + hash, + TableEntry { + key: key.clone(), + val: val.clone(), + hash, + }, + TableEntry::get_hash, + ); + + Ok(()) + } + + #[cfg(not(feature = "async"))] pub fn delete(&self, key: &Value) -> Result<(), Exception> { if !self.mutable { return Err(Exception::error("hashtable is immutable")); @@ -147,6 +212,48 @@ impl HashTableInner { Ok(()) } + /// See [`Self::set`] for the check-then-act window this introduces. + #[cfg(feature = "async")] + pub async fn delete(&self, key: &Value) -> Result<(), Exception> { + if !self.mutable { + return Err(Exception::error("hashtable is immutable")); + } + + let hash = self.hash(key.clone()).await?; + let candidates: Vec = self + .table + .read() + .iter_hash(hash) + .filter(|entry| entry.hash == hash) + .map(|entry| entry.key.clone()) + .collect(); + + let mut matched_key = None; + for candidate in candidates { + if self.eq(key.clone(), candidate.clone()).await? { + matched_key = Some(candidate); + break; + } + } + let Some(matched_key) = matched_key else { + return Ok(()); + }; + + let mut table = self.table.write(); + let buckets = table.iter_hash_buckets(hash).collect::>(); + for bucket in buckets { + if let Ok(entry) = table.get_bucket_entry(bucket) + && entry.get().key.eqv(&matched_key) + { + entry.remove(); + break; + } + } + + Ok(()) + } + + #[cfg(not(feature = "async"))] pub fn contains(&self, key: &Value) -> Result { let table = self.table.write(); let hash = self.hash(key.clone())?; @@ -159,6 +266,28 @@ impl HashTableInner { Ok(false) } + /// Same snapshot-then-`eq` scheme as [`Self::get`]. + #[cfg(feature = "async")] + pub async fn contains(&self, key: &Value) -> Result { + let hash = self.hash(key.clone()).await?; + let candidates: Vec = self + .table + .read() + .iter_hash(hash) + .filter(|entry| entry.hash == hash) + .map(|entry| entry.key.clone()) + .collect(); + + for candidate in candidates { + if self.eq(key.clone(), candidate).await? { + return Ok(true); + } + } + + Ok(false) + } + + #[cfg(not(feature = "async"))] pub fn update(&self, key: &Value, proc: &Procedure, default: &Value) -> Result<(), Exception> { use std::slice; @@ -170,22 +299,78 @@ impl HashTableInner { let hash = self.hash(key.clone())?; for entry in table.iter_hash_mut(hash) { if entry.hash == hash && self.eq(key.clone(), entry.key.clone())? { - #[cfg(not(feature = "async"))] let updated = proc.call(slice::from_ref(&entry.val))?[0].clone(); - - #[cfg(feature = "async")] - let updated = proc.call_sync(slice::from_ref(&entry.val))?[0].clone(); - entry.val = updated; return Ok(()); } } - #[cfg(not(feature = "async"))] let updated = proc.call(slice::from_ref(default))?[0].clone(); - #[cfg(feature = "async")] - let updated = proc.call_sync(slice::from_ref(default))?[0].clone(); + table.insert_unique( + hash, + TableEntry { + key: key.clone(), + val: updated, + hash, + }, + TableEntry::get_hash, + ); + + Ok(()) + } + + /// Same window as [`Self::set`]; `proc` is likewise called unlocked. + #[cfg(feature = "async")] + pub async fn update( + &self, + key: &Value, + proc: &Procedure, + default: &Value, + ) -> Result<(), Exception> { + use std::slice; + + if !self.mutable { + return Err(Exception::error("hashtable is immutable")); + } + + let hash = self.hash(key.clone()).await?; + let candidates: Vec<(Value, Value)> = self + .table + .read() + .iter_hash(hash) + .filter(|entry| entry.hash == hash) + .map(|entry| (entry.key.clone(), entry.val.clone())) + .collect(); + + let mut matched = None; + for (candidate_key, candidate_val) in candidates { + if self.eq(key.clone(), candidate_key.clone()).await? { + matched = Some((candidate_key, candidate_val)); + break; + } + } + + let (matched_key, updated) = match matched { + Some((matched_key, current_val)) => { + let updated = proc.call(slice::from_ref(¤t_val)).await?[0].clone(); + (Some(matched_key), updated) + } + None => { + let updated = proc.call(slice::from_ref(default)).await?[0].clone(); + (None, updated) + } + }; + + let mut table = self.table.write(); + if let Some(matched_key) = matched_key + && let Some(entry) = table + .iter_hash_mut(hash) + .find(|entry| entry.key.eqv(&matched_key)) + { + entry.val = updated; + return Ok(()); + } table.insert_unique( hash, @@ -276,24 +461,29 @@ impl HashTable { self.0.size() } + #[maybe_async] pub fn get(&self, key: &Value, default: &Value) -> Result { - self.0.get(key, default) + maybe_await!(self.0.get(key, default)) } + #[maybe_async] pub fn set(&self, key: &Value, val: &Value) -> Result<(), Exception> { - self.0.set(key, val) + maybe_await!(self.0.set(key, val)) } + #[maybe_async] pub fn delete(&self, key: &Value) -> Result<(), Exception> { - self.0.delete(key) + maybe_await!(self.0.delete(key)) } + #[maybe_async] pub fn contains(&self, key: &Value) -> Result { - self.0.contains(key) + maybe_await!(self.0.contains(key)) } + #[maybe_async] pub fn update(&self, key: &Value, proc: &Procedure, default: &Value) -> Result<(), Exception> { - self.0.update(key, proc, default) + maybe_await!(self.0.update(key, proc, default)) } pub fn copy(&self, mutable: bool) -> Self { @@ -392,6 +582,10 @@ impl TryFrom<&Value> for HashTable { } } +/// Under the async feature the hash and equivalence procedures run without +/// the table lock held, so concurrent mutation has a check-then-act window: +/// a racing update can be lost, or two `eq`-equal (but not `eqv?`) keys can +/// briefly coexist. R6RS makes no thread-safety promises for hashtables. #[bridge(name = "make-hashtable", lib = "(rnrs hashtables builtins (6))")] pub fn make_hashtable( hash_function: &Value, @@ -423,32 +617,41 @@ pub fn hashtable_size(hashtable: HashTable) -> usize { hashtable.size() } +#[maybe_async] #[bridge(name = "hashtable-ref", lib = "(rnrs hashtables builtins (6))")] pub fn hashtable_ref( hashtable: HashTable, key: &Value, default: &Value, -) -> Result { - hashtable.get(key, default) +) -> Result, Exception> { + Ok(vec![maybe_await!(hashtable.get(key, default))?]) } +#[maybe_async] #[bridge(name = "hashtable-set!", lib = "(rnrs hashtables builtins (6))")] -pub fn hashtable_set_bang(hashtable: HashTable, key: &Value, obj: &Value) -> Result<(), Exception> { - hashtable.set(key, obj)?; - Ok(()) +pub fn hashtable_set_bang( + hashtable: HashTable, + key: &Value, + obj: &Value, +) -> Result, Exception> { + maybe_await!(hashtable.set(key, obj))?; + Ok(Vec::new()) } +#[maybe_async] #[bridge(name = "hashtable-delete!", lib = "(rnrs hashtables builtins (6))")] -pub fn hashtable_delete_bang(hashtable: HashTable, key: &Value) -> Result<(), Exception> { - hashtable.delete(key)?; - Ok(()) +pub fn hashtable_delete_bang(hashtable: HashTable, key: &Value) -> Result, Exception> { + maybe_await!(hashtable.delete(key))?; + Ok(Vec::new()) } +#[maybe_async] #[bridge(name = "hashtable-contains?", lib = "(rnrs hashtables builtins (6))")] -pub fn hashtable_contains_pred(hashtable: HashTable, key: &Value) -> Result { - Ok(hashtable.contains(key)?) +pub fn hashtable_contains_pred(hashtable: HashTable, key: &Value) -> Result, Exception> { + Ok(vec![Value::from(maybe_await!(hashtable.contains(key))?)]) } +#[maybe_async] #[bridge(name = "hashtable-update!", lib = "(rnrs hashtables builtins (6))")] pub fn hashtable_update_bang( hashtable: HashTable, @@ -456,7 +659,7 @@ pub fn hashtable_update_bang( proc: Procedure, default: &Value, ) -> Result, Exception> { - hashtable.update(key, &proc, default)?; + maybe_await!(hashtable.update(key, &proc, default))?; Ok(Vec::new()) } diff --git a/tests/hashtable_hash_fn_timer.rs b/tests/hashtable_hash_fn_timer.rs new file mode 100644 index 00000000..a53025a2 --- /dev/null +++ b/tests/hashtable_hash_fn_timer.rs @@ -0,0 +1,5 @@ +#![cfg(feature = "tokio")] + +mod common; + +common::run_test!(hashtable_hash_fn_timer); diff --git a/tests/hashtable_hash_fn_timer.scm b/tests/hashtable_hash_fn_timer.scm new file mode 100644 index 00000000..1ea96e81 --- /dev/null +++ b/tests/hashtable_hash_fn_timer.scm @@ -0,0 +1,16 @@ +(import (rnrs) (async) (test)) + +;; A hash function that suspends on the tokio timer, run under the default +;; current_thread test flavor: one OS thread drives both the evaluator and +;; the reactor. Under the sync callback path this raised on the async +;; bridge; with hashtable callbacks async all the way, the timer just fires. +(define (sleepy-hash x) + (sleep 5) + x) + +(define ht (make-hashtable sleepy-hash =)) +(hashtable-set! ht 1 'one) +(hashtable-set! ht 2 'two) +(assert-equal? (hashtable-ref ht 1 'nope) 'one) +(assert-equal? (hashtable-ref ht 2 'nope) 'two) +(assert-equal? (hashtable-ref ht 3 'nope) 'nope) diff --git a/tests/hashtable_nested_block_on.rs b/tests/hashtable_nested_block_on.rs new file mode 100644 index 00000000..2ac0d9ec --- /dev/null +++ b/tests/hashtable_nested_block_on.rs @@ -0,0 +1,3 @@ +mod common; + +common::run_test!(hashtable_nested_block_on); diff --git a/tests/hashtable_nested_block_on.scm b/tests/hashtable_nested_block_on.scm new file mode 100644 index 00000000..27240db6 --- /dev/null +++ b/tests/hashtable_nested_block_on.scm @@ -0,0 +1,18 @@ +(import (rnrs) (test)) + +;; A Scheme-defined hash function that hits an async bridge (display). +;; Hashtable operations run it through the async callback path, so this +;; works from inside the async evaluator on a Tokio worker thread. It used +;; to raise "attempt to apply async function in a sync-only context". +(define (loud-hash x) + (display "") + x) + +(define ht (make-hashtable loud-hash =)) +(hashtable-set! ht 1 'one) +(hashtable-set! ht 2 'two) +(assert-equal? (hashtable-ref ht 1 'nope) 'one) +(assert-equal? (hashtable-ref ht 2 'nope) 'two) +(assert-equal? (hashtable-ref ht 3 'nope) 'nope) +(hashtable-update! ht 1 (lambda (v) (display "") 'uno) 'default) +(assert-equal? (hashtable-ref ht 1 'nope) 'uno) From a514636af2560e072ff1dfcf17cca2ebbba2d367 Mon Sep 17 00:00:00 2001 From: Linus Shoravi Date: Sat, 4 Jul 2026 23:51:46 +0200 Subject: [PATCH 06/10] Guard top-level binding lookups against library self-reference A library body referencing a binding the same library defines and exports crashed with a native stack overflow: the binding is already registered in the global table as Unexpanded(lib) where lib is the library currently being parsed, maybe_expand short-circuits (state is already Expanding), and the lookup retries the same stale entry forever. lookup_keyword_inner and lookup_var_inner now short-circuit when the unexpanded origin is the environment currently being parsed, and a reentrancy backstop converts any remaining cyclic lookup pattern into a catchable exception instead of a stack overflow. --- src/env.rs | 36 ++++++++++++++++++++++++++++++++++++ tests/lib-x.sls | 8 ++++++++ tests/self_reference.rs | 3 +++ tests/self_reference.scm | 5 +++++ 4 files changed, 52 insertions(+) create mode 100644 tests/lib-x.sls create mode 100644 tests/self_reference.rs create mode 100644 tests/self_reference.scm diff --git a/src/env.rs b/src/env.rs index c329bf71..ce020c4e 100644 --- a/src/env.rs +++ b/src/env.rs @@ -44,6 +44,10 @@ pub(crate) mod error { pub(crate) fn name_bound_multiple_times(name: Symbol) -> Exception { Exception::from(Message::new(format!("`{name}` bound multiple times"))) } + + pub(crate) fn circular_binding_lookup() -> Exception { + Exception::from(Message::new("circular binding lookup")) + } } #[derive(Clone)] @@ -63,6 +67,30 @@ impl TopLevelBinding { pub(crate) static TOP_LEVEL_BINDINGS: LazyLock>> = LazyLock::new(|| Mutex::new(HashMap::default())); +/// Tracks bindings currently being resolved through the `Unexpanded` retry +/// path in `lookup_var_inner`/`lookup_keyword_inner`. Backstops any cyclic +/// lookup pattern (beyond direct self-reference, handled separately) by +/// turning infinite recursion into a catchable `Exception`. +static IN_PROGRESS_LOOKUPS: LazyLock>> = + LazyLock::new(|| Mutex::new(HashSet::default())); + +struct LookupGuard(Binding); + +impl LookupGuard { + fn enter(binding: Binding) -> Result { + if !IN_PROGRESS_LOOKUPS.lock().insert(binding) { + return Err(error::circular_binding_lookup()); + } + Ok(Self(binding)) + } +} + +impl Drop for LookupGuard { + fn drop(&mut self) { + IN_PROGRESS_LOOKUPS.lock().remove(&self.0); + } +} + fn add_pending_top_level_binding(binding: Binding, origin: TopLevelEnvironment) { TOP_LEVEL_BINDINGS .lock() @@ -468,6 +496,10 @@ impl TopLevelEnvironment { pub fn lookup_var_inner(&self, binding: Binding) -> Result, Exception> { match TopLevelBinding::lookup(&binding) { Some(TopLevelBinding::Unexpanded(unexpanded)) => { + if *self == unexpanded { + return Ok(None); + } + let _guard = LookupGuard::enter(binding)?; maybe_await!(unexpanded.maybe_expand())?; maybe_await!(self.lookup_var(binding)) } @@ -508,6 +540,10 @@ impl TopLevelEnvironment { } else { match TopLevelBinding::lookup(&binding) { Some(TopLevelBinding::Unexpanded(unexpanded)) => { + if *self == unexpanded { + return Ok(None); + } + let _guard = LookupGuard::enter(binding)?; maybe_await!(unexpanded.maybe_expand())?; maybe_await!(self.lookup_keyword(binding)) } diff --git a/tests/lib-x.sls b/tests/lib-x.sls new file mode 100644 index 00000000..b643a1a6 --- /dev/null +++ b/tests/lib-x.sls @@ -0,0 +1,8 @@ +(library (tests lib-x) + (export val f loaded?) + (import (rnrs)) + (define val 10) + val + (define (f x) (+ x 1)) + (f 1) + (define loaded? #t)) diff --git a/tests/self_reference.rs b/tests/self_reference.rs new file mode 100644 index 00000000..765e37da --- /dev/null +++ b/tests/self_reference.rs @@ -0,0 +1,3 @@ +mod common; + +common::run_test!(self_reference); diff --git a/tests/self_reference.scm b/tests/self_reference.scm new file mode 100644 index 00000000..831688d6 --- /dev/null +++ b/tests/self_reference.scm @@ -0,0 +1,5 @@ +(import (rnrs) (test) (tests lib-x)) + +(assert-equal? loaded? #t) +(assert-equal? val 10) +(assert-equal? (f 2) 3) From 0928a353498de5ea81badb715cbf7ee01a1c8b0b Mon Sep 17 00:00:00 2001 From: Linus Shoravi Date: Thu, 16 Jul 2026 23:33:35 +0200 Subject: [PATCH 07/10] Add parameters as first-class applicable objects --- scheme/rnrs/parameters.sls | 22 +++ src/lib.rs | 1 + src/parameters.rs | 263 ++++++++++++++++++++++++++++++++ src/proc.rs | 200 +++++++++++++++++++++--- src/runtime.rs | 7 +- src/value.rs | 91 ++++++++++- tests/parameters.rs | 3 + tests/parameters.scm | 126 +++++++++++++++ tests/parameters_applicable.rs | 3 + tests/parameters_applicable.scm | 28 ++++ tests/parameters_basic.rs | 3 + tests/parameters_basic.scm | 22 +++ 12 files changed, 748 insertions(+), 21 deletions(-) create mode 100644 scheme/rnrs/parameters.sls create mode 100644 src/parameters.rs create mode 100644 tests/parameters.rs create mode 100644 tests/parameters.scm create mode 100644 tests/parameters_applicable.rs create mode 100644 tests/parameters_applicable.scm create mode 100644 tests/parameters_basic.rs create mode 100644 tests/parameters_basic.scm diff --git a/scheme/rnrs/parameters.sls b/scheme/rnrs/parameters.sls new file mode 100644 index 00000000..4f4a95b7 --- /dev/null +++ b/scheme/rnrs/parameters.sls @@ -0,0 +1,22 @@ +(library (rnrs parameters) + (export make-parameter parameter? parameterize) + (import (rnrs) (rnrs parameters bridge)) + + (define (make-parameter init . args) + (let* ((converter (if (null? args) #f (car args))) + (converted-init (if converter (converter init) init))) + (%make-parameter converted-init (or converter #f)))) + + ;; Duplicate parameters in one parameterize: the last binding wins (matches Chez). + (define-syntax parameterize + (syntax-rules () + ((_ () body ...) + (begin body ...)) + ((_ ((param val) ...) body ...) + (let* ((ps (list param ...)) + (vs (map (lambda (rp v) + (let ((c (%parameter-converter rp))) + (if c (c v) v))) + ps + (list val ...)))) + (%call-with-parameterization ps vs (lambda () body ...))))))) diff --git a/src/lib.rs b/src/lib.rs index a3e828c1..437e5b5e 100644 --- a/src/lib.rs +++ b/src/lib.rs @@ -18,6 +18,7 @@ pub mod lists; #[cfg(feature = "lsp")] pub mod lsp; pub mod num; +pub mod parameters; pub mod ports; pub mod proc; pub mod records; diff --git a/src/parameters.rs b/src/parameters.rs new file mode 100644 index 00000000..253684df --- /dev/null +++ b/src/parameters.rs @@ -0,0 +1,263 @@ +use std::collections::HashMap; +use std::mem::MaybeUninit; +use std::sync::atomic::{AtomicUsize, Ordering}; +use std::sync::{Arc, OnceLock}; + +use scheme_rs_macros::bridge; + +use crate::{ + exceptions::Exception, + gc::{OpaqueGcPtr, Trace}, + lists::list_to_vec, + proc::{ + Application, BridgePtr, ContBarrier, ContPtr, DynStackElem, Procedure, parameter_ref, + parameter_set, pop_dyn_stack_cont, push_dyn_stack, + }, + records::{Embeddable, Embedded, RecordTypeDescriptor, rtd}, + registry::cps_bridge, + value::{Cell, Value}, +}; + +#[derive(Clone)] +pub struct Parameter { + id: usize, + default: Value, + converter: Value, + companion: OnceLock, +} + +unsafe impl Trace for Parameter { + unsafe fn visit_children(&self, visitor: &mut dyn FnMut(OpaqueGcPtr)) { + unsafe { + self.default.visit_children(visitor); + self.converter.visit_children(visitor); + if let Some(proc) = self.companion.get() { + proc.visit_children(visitor); + } + } + } + + unsafe fn finalize(&mut self) { + unsafe { + self.default.finalize(); + self.converter.finalize(); + if let Some(proc) = self.companion.get_mut() { + proc.finalize(); + } + } + } +} + +impl std::fmt::Debug for Parameter { + fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + write!(f, "#") + } +} + +impl Parameter { + pub fn new(default: Value, converter: Value) -> Self { + static NEXT_ID: AtomicUsize = AtomicUsize::new(0); + Self { + id: NEXT_ID.fetch_add(1, Ordering::Relaxed), + default, + converter, + companion: OnceLock::new(), + } + } + + pub fn id(&self) -> usize { + self.id + } + + pub fn default_value(&self) -> Value { + self.default.clone() + } + + pub fn converter(&self) -> Value { + self.converter.clone() + } + + pub fn companion(&self) -> &Procedure { + self.companion + .get() + .expect("companion must be initialized before use") + } + + pub fn set_companion(&self, proc: Procedure) { + self.companion + .set(proc) + .unwrap_or_else(|_| panic!("companion already initialized")); + } +} + +unsafe impl Embeddable for Parameter { + fn rtd() -> Arc { + rtd!(ty: Parameter, name: "parameter", sealed: true, opaque: true) + } +} + +/// The companion procedure's body: dispatches 0-arg (ref) and 1-arg (set) +/// calls on a parameter. env[0] is the Embedded value. +#[cps_bridge] +fn parameter_companion( + env: &[Value], + args: &[Value], + rest_args: &[Value], + barrier: &mut ContBarrier, +) -> Result { + let param: Embedded = env[0].try_to()?; + let total_args = args.len() + rest_args.len(); + match total_args { + 0 => { + let val = parameter_ref(¶m); + Ok(barrier.call_cont(vec![val])) + } + 1 => { + let new_val = if !args.is_empty() { + args[0].clone() + } else { + rest_args[0].clone() + }; + if param.converter().is_true() { + let converter: Procedure = param.converter().try_into()?; + barrier.push_cont( + [Value::from(param.clone())], + ContPtr::Continuation(set_after_convert_k), + 1, + false, + ); + Ok(Application::new(converter, vec![new_val])) + } else { + parameter_set(¶m, new_val); + Ok(barrier.call_cont(Vec::new())) + } + } + _ => Err(Exception::error("parameter accepts zero or one arguments")), + } +} + +/// Continuation that receives the converter's result and performs the +/// actual parameter_set. env[0] is the parameter. +unsafe extern "C" fn set_after_convert_k( + env: *const Value, + args: *const Value, + barrier: *mut ContBarrier, + out: *mut MaybeUninit, +) { + unsafe { + let param: Embedded = env.as_ref().unwrap().try_to().unwrap(); + let converted_val = args.as_ref().unwrap().clone(); + let barrier = barrier.as_mut().unwrap_unchecked(); + parameter_set(¶m, converted_val); + (*out).write(barrier.call_cont(Vec::new())); + } +} + +#[cps_bridge( + def = "%make-parameter init converter", + lib = "(rnrs parameters bridge)" +)] +pub fn make_parameter_bridge( + _env: &[Value], + args: &[Value], + _rest_args: &[Value], + barrier: &mut ContBarrier, +) -> Result { + let [init, converter] = args else { + return Err(Exception::wrong_num_of_args(2, args.len())); + }; + let param = Parameter::new(init.clone(), converter.clone()); + let embedded = Embedded::new(param); + let param_val = Value::from(embedded.clone()); + let companion = Procedure::new( + vec![param_val.clone()], + parameter_companion as BridgePtr, + 0, + true, + ); + embedded.set_companion(companion); + Ok(barrier.call_cont(vec![param_val])) +} + +#[cps_bridge(def = "%parameter-ref param", lib = "(rnrs parameters bridge)")] +pub fn parameter_ref_bridge( + _env: &[Value], + args: &[Value], + _rest_args: &[Value], + barrier: &mut ContBarrier, +) -> Result { + let [param_val] = args else { + return Err(Exception::wrong_num_of_args(1, args.len())); + }; + let param: Embedded = param_val.try_into()?; + let val = parameter_ref(¶m); + Ok(barrier.call_cont(vec![val])) +} + +#[cps_bridge(def = "%parameter-set! param val", lib = "(rnrs parameters bridge)")] +pub fn parameter_set_bridge( + _env: &[Value], + args: &[Value], + _rest_args: &[Value], + barrier: &mut ContBarrier, +) -> Result { + let [param_val, new_val] = args else { + return Err(Exception::wrong_num_of_args(2, args.len())); + }; + let param: Embedded = param_val.try_into()?; + parameter_set(¶m, new_val.clone()); + Ok(barrier.call_cont(Vec::new())) +} + +/// Runs `thunk` with `params` rebound to `vals` for its dynamic extent: a +/// fresh cell per parameter is pushed as a `Parameterization` entry, popped +/// again (uncovering the outer bindings) once `thunk` returns. +#[cps_bridge( + def = "%call-with-parameterization params vals thunk", + lib = "(rnrs parameters bridge)" +)] +pub fn call_with_parameterization( + _env: &[Value], + args: &[Value], + _rest_args: &[Value], + barrier: &mut ContBarrier, +) -> Result { + let [params, vals, thunk] = args else { + return Err(Exception::wrong_num_of_args(3, args.len())); + }; + let mut params_vec = Vec::new(); + list_to_vec(params, &mut params_vec); + let mut vals_vec = Vec::new(); + list_to_vec(vals, &mut vals_vec); + if params_vec.len() != vals_vec.len() { + return Err(Exception::error( + "parameterize: parameter/value length mismatch", + )); + } + let cells = params_vec + .iter() + .zip(vals_vec) + .map(|(p, v)| { + let param: Embedded = p.try_into()?; + Ok((param.id(), Cell::new(v))) + }) + .collect::, Exception>>()?; + + push_dyn_stack(DynStackElem::Parameterization(cells)); + + let thunk: Procedure = thunk.clone().try_into()?; + let (req_args, var) = barrier.cont_formals(); + barrier.push_cont([], ContPtr::Continuation(pop_dyn_stack_cont), req_args, var); + Ok(Application::new(thunk, Vec::new())) +} + +#[bridge(name = "%parameter-converter", lib = "(rnrs parameters bridge)")] +pub fn parameter_converter_bridge(param_val: &Value) -> Result, Exception> { + let param: Embedded = param_val.try_into()?; + Ok(vec![param.converter()]) +} + +#[bridge(name = "parameter?", lib = "(rnrs parameters bridge)")] +pub fn is_parameter(val: &Value) -> Result, Exception> { + Ok(vec![Value::from(val.is_a::>())]) +} diff --git a/src/proc.rs b/src/proc.rs index 3c6f1bf3..f7a632f8 100644 --- a/src/proc.rs +++ b/src/proc.rs @@ -89,13 +89,14 @@ use crate::{ exceptions::{Exception, raise}, gc::{Gc, Trace}, lists::{Pair, list_to_vec}, + parameters::Parameter, ports::{BufferMode, Port, Transcoder}, records::{Embeddable, Embedded, RecordTypeDescriptor, rtd}, registry::BridgeFnDebugInfo, runtime::Runtime, symbols::Symbol, syntax::Span, - value::Value, + value::{Cell, Value}, vectors::Vector, }; use scheme_rs_macros::{cps_bridge, maybe_async, maybe_await}; @@ -761,6 +762,11 @@ pub struct DynState { /// Whether this is the state currently being evaluated. False for a /// dormant/idle slot; [`DynStateSlot::is_published`] is just this flag. published: bool, + /// Root values of parameter objects (param id → value) for this task. + /// A bare `(p v)` outside any parameterize writes here; spawn_snapshot + /// value-copies it, so mutations are task-local with inheritance at + /// spawn (the guile-fibers model). + param_roots: HashMap, } impl DynState { @@ -768,20 +774,31 @@ impl DynState { Self { dyn_stack: Vec::new(), published: false, + param_roots: HashMap::new(), } } - /// Current ports cross a spawn boundary; winders, handlers, and prompts - /// do not. - fn spawn_snapshot(&self) -> DynState { - DynState { + /// The dynamic state a newly spawned thread/task starts with: binding + /// entries (current ports) carry over as copies; control entries + /// (winders, prompts, exception handlers) belong to the spawning + /// thread's stack and do not cross. Which entries cross is decided + /// per-variant by [`DynStackElem::spawn_copy`]. Parameter roots are + /// inherited by value: the child gets its own cells seeded with the + /// parent's current values, so later mutations on either side stay + /// task-local. + fn spawn_snapshot(&self) -> Self { + Self { dyn_stack: self .dyn_stack .iter() - .filter(|elem| elem.crosses_spawn()) - .cloned() + .filter_map(DynStackElem::spawn_copy) .collect(), published: false, + param_roots: self + .param_roots + .iter() + .map(|(id, cell)| (*id, Cell::new(cell.get()))) + .collect(), } } } @@ -792,16 +809,6 @@ impl Default for DynState { } } -impl DynStackElem { - /// Only current ports survive a spawn. - fn crosses_spawn(&self) -> bool { - matches!( - self, - DynStackElem::CurrentInputPort(_) | DynStackElem::CurrentOutputPort(_) - ) - } -} - std::thread_local! { /// Sync-trampoline dynamic state. Always holds a `DynState`; dormant /// (not currently evaluating) is `published == false`, not absence. @@ -1193,6 +1200,46 @@ impl Default for ContBarrier<'_> { } } +/// The current value of a parameter object: the innermost enclosing +/// `parameterize` binding, else the task root, else the parameter's +/// default if the root was never written. +pub(crate) fn parameter_ref(param: &Embedded) -> Value { + DYN_STATE.with(|s| { + for elem in s.dyn_stack.iter().rev() { + if let DynStackElem::Parameterization(cells) = elem + && let Some(cell) = cells.get(¶m.id()) + { + return cell.get(); + } + } + match s.param_roots.get(¶m.id()) { + Some(cell) => cell.get(), + None => param.default_value(), + } + }) +} + +/// Writes a parameter object: the innermost enclosing `parameterize` +/// binding if one is active, else the task root (creating it if this +/// is the first write). +pub(crate) fn parameter_set(param: &Embedded, val: Value) { + DYN_STATE.with(|s| { + for elem in s.dyn_stack.iter().rev() { + if let DynStackElem::Parameterization(cells) = elem + && let Some(cell) = cells.get(¶m.id()) + { + cell.set(val); + return; + } + } + if let Some(cell) = s.param_roots.get(¶m.id()) { + cell.set(val); + } else { + s.param_roots.insert(param.id(), Cell::new(val)); + } + }) +} + impl<'a, 'b, 'c> From<&'b mut ContBarrier<'a>> for ContBarrier<'c> where 'b: 'c, @@ -1208,6 +1255,10 @@ where /// Independent of the current dynamic state: a plain value, safe to embed /// and pass around Scheme code. +/// +/// Deliberately omits `param_roots`: continuations capture parameterize +/// bindings (they ride in `dyn_stack`), not the task's mutable parameter +/// roots — reinstating a continuation must not undo bare assignments. #[derive(Clone, Trace)] pub struct SavedDynamicState { id: usize, @@ -1250,6 +1301,35 @@ pub(crate) enum DynStackElem { ExceptionHandler(Procedure), CurrentInputPort(Port), CurrentOutputPort(Port), + /// A parameterize extent: fresh cells for the bound parameters, + /// uncovered again when the entry is popped. + Parameterization(HashMap), +} + +impl DynStackElem { + /// The entry a spawned child thread/task starts with for this entry, if + /// any. Binding entries (current ports, parameterize extents) cross; + /// control entries (winders, prompts, exception handlers) belong to the + /// spawning stack and do not. Parameterizations cross by value: the + /// child gets fresh cells seeded with the parent's current bindings, so + /// later mutations on either side stay task-local (mirrors param_roots). + /// Exhaustive on purpose: adding a variant forces this decision. + fn spawn_copy(&self) -> Option { + match self { + DynStackElem::CurrentInputPort(_) | DynStackElem::CurrentOutputPort(_) => { + Some(self.clone()) + } + DynStackElem::Parameterization(cells) => Some(DynStackElem::Parameterization( + cells + .iter() + .map(|(id, cell)| (*id, Cell::new(cell.get()))) + .collect(), + )), + DynStackElem::Prompt(_) + | DynStackElem::Winder(_) + | DynStackElem::ExceptionHandler(_) => None, + } + } } /// Named distinctly from the free function `pop_dyn_stack` to avoid a clash. @@ -1971,3 +2051,89 @@ unsafe extern "C" fn wind_delim( (*out).write(barrier.call_cont(args)); } } + +#[cfg(test)] +mod tests { + use super::*; + + /// A stand-in exception handler `Procedure`. Never actually invoked; + /// spawn_snapshot only needs a valid `ExceptionHandler` value to filter. + fn dummy_handler( + _env: &[Value], + _args: &[Value], + _rest_args: &[Value], + barrier: &mut ContBarrier<'_>, + ) -> Application { + barrier.call_cont(Vec::new()) + } + + #[test] + fn spawn_snapshot_keeps_ports_drops_control() { + let out_port = Port::new( + "", + #[cfg(not(feature = "async"))] + std::io::stdout(), + #[cfg(feature = "tokio")] + tokio::io::stdout(), + BufferMode::None, + Some(Transcoder::native()), + ); + let in_port = Port::new( + "", + #[cfg(not(feature = "async"))] + std::io::stdin(), + #[cfg(feature = "tokio")] + tokio::io::stdin(), + BufferMode::Line, + Some(Transcoder::native()), + ); + let handler = Procedure::new(vec![], dummy_handler as BridgePtr, 0, false); + let mut param_roots = HashMap::new(); + param_roots.insert(0, Cell::new(Value::from(42))); + let mut parameterization = HashMap::new(); + parameterization.insert(1, Cell::new(Value::from(7))); + let state = DynState { + dyn_stack: vec![ + DynStackElem::ExceptionHandler(handler), + DynStackElem::CurrentOutputPort(out_port), + DynStackElem::CurrentInputPort(in_port), + DynStackElem::Parameterization(parameterization), + ], + published: false, + param_roots, + }; + + let snapshot = state.spawn_snapshot(); + + assert!(matches!( + snapshot.dyn_stack.as_slice(), + [ + DynStackElem::CurrentOutputPort(_), + DynStackElem::CurrentInputPort(_), + DynStackElem::Parameterization(_) + ] + )); + + // Parameter roots are inherited by value into a fresh cell: the + // snapshot starts out equal to the parent, but mutating the copy + // must not affect the original. + let snapshot_cell = snapshot.param_roots.get(&0).unwrap(); + assert_eq!(snapshot_cell.get(), Value::from(42)); + + // A Parameterization entry survives the snapshot the same way: a + // fresh cell per bound parameter, seeded with the parent's current + // value but independent afterward. + let DynStackElem::Parameterization(snapshot_cells) = &snapshot.dyn_stack[2] else { + panic!("expected a Parameterization entry in the snapshot"); + }; + let DynStackElem::Parameterization(original_cells) = &state.dyn_stack[3] else { + panic!("expected a Parameterization entry in the original"); + }; + let snapshot_param_cell = snapshot_cells.get(&1).unwrap(); + assert_eq!(snapshot_param_cell.get(), Value::from(7)); + snapshot_param_cell.set(Value::from(99)); + assert_eq!(original_cells.get(&1).unwrap().get(), Value::from(7)); + snapshot_cell.set(Value::from(99)); + assert_eq!(state.param_roots.get(&0).unwrap().get(), Value::from(42)); + } +} diff --git a/src/runtime.rs b/src/runtime.rs index df61a0a8..1e4f525b 100644 --- a/src/runtime.rs +++ b/src/runtime.rs @@ -13,6 +13,7 @@ use crate::{ hashtables::EqualHashSet, lists::{Pair, list_to_vec}, num, + parameters::Parameter, ports::{BufferMode, Port, Transcoder}, proc::{ Application, ContBarrier, ContPtr, ContinuationPtr, DynState, FuncPtr, ProcDebugInfo, @@ -464,8 +465,12 @@ unsafe extern "C" fn apply( out: *mut MaybeUninit, ) { unsafe { - let op = match Value::from_raw_inc_rc(op).unpack() { + let op_val = Value::from_raw_inc_rc(op); + let op = match op_val.unpack() { UnpackedValue::Procedure(op) => op, + UnpackedValue::Record(ref record) if record.cast::().is_some() => { + record.cast::().unwrap().companion().clone() + } x => { let raised = raise( Exception::invalid_operator(&x.type_name()).into(), diff --git a/src/value.rs b/src/value.rs index 1f5fcf80..affb2afe 100644 --- a/src/value.rs +++ b/src/value.rs @@ -599,7 +599,7 @@ unsafe impl Trace for Value { } /// A Cell is a value that is mutable, essentially a variable. -#[derive(Clone, Trace)] +#[derive(Clone, Debug, Trace)] pub struct Cell(pub(crate) Gc>); impl Cell { @@ -625,6 +625,15 @@ impl From<&Value> for Option { } } +// Identity, not value equality: used to compare dyn-stack entries by +// position/binding identity (e.g. in escape_procedure/unwind), not by the +// value currently stored in the cell. +impl PartialEq for Cell { + fn eq(&self, other: &Self) -> bool { + Gc::ptr_eq(&self.0, &other.0) + } +} + /// A reference to an [`UnpackedValue`]. Allows for unpacking a `Value` without /// cloning/modifying the reference count. pub struct UnpackedValueRef<'a> { @@ -1195,7 +1204,80 @@ impl From for Value { impl_try_from_value_for!(char, Character, "char"); impl_try_from_value_for!(Number, Number, "number"); impl_try_from_value_for!(Symbol, Symbol, "symbol"); -impl_try_from_value_for!(Procedure, Procedure, "procedure"); +// Manual impls for Procedure: parameters are applicable, so +// TryFrom extracts the companion procedure from Embedded. +impl From for UnpackedValue { + fn from(v: Procedure) -> Self { + Self::Procedure(v) + } +} + +impl From for Value { + fn from(v: Procedure) -> Self { + UnpackedValue::from(v).into_value() + } +} + +impl From for Option { + fn from(v: UnpackedValue) -> Self { + match v { + UnpackedValue::Procedure(v) => Some(v), + UnpackedValue::Record(ref record) => { + use crate::parameters::Parameter; + record.cast::().map(|p| p.companion().clone()) + } + _ => None, + } + } +} + +impl From for Option { + fn from(v: Value) -> Self { + v.unpack().into() + } +} + +impl From<&'_ Value> for Option { + fn from(v: &Value) -> Self { + v.clone().unpack().into() + } +} + +impl TryFrom for Procedure { + type Error = Exception; + + fn try_from(v: UnpackedValue) -> Result { + match v { + UnpackedValue::Procedure(v) => Ok(v), + UnpackedValue::Cell(cell) => cell.0.read().clone().try_into(), + UnpackedValue::Record(ref record) => { + use crate::parameters::Parameter; + if let Some(param) = record.cast::() { + Ok(param.companion().clone()) + } else { + Err(Exception::type_error("procedure", &v.type_name())) + } + } + e => Err(Exception::type_error("procedure", &e.type_name())), + } + } +} + +impl TryFrom for Procedure { + type Error = Exception; + + fn try_from(v: Value) -> Result { + v.unpack().try_into() + } +} + +impl TryFrom<&Value> for Procedure { + type Error = Exception; + + fn try_from(v: &Value) -> Result { + v.clone().unpack().try_into() + } +} impl_try_from_value_for!(Pair, Pair, "pair"); impl_try_from_value_for!(Record, Record, "record"); impl_try_from_value_for!(Arc, RecordTypeDescriptor, "rt"); @@ -1494,5 +1576,8 @@ pub fn pair_pred(arg: &Value) -> Result, Exception> { #[bridge(name = "procedure?", lib = "(rnrs base builtins (6))")] pub fn procedure_pred(arg: &Value) -> Result, Exception> { - Ok(vec![Value::from(arg.type_of() == ValueType::Procedure)]) + Ok(vec![Value::from( + arg.type_of() == ValueType::Procedure + || arg.is_a::>(), + )]) } diff --git a/tests/parameters.rs b/tests/parameters.rs new file mode 100644 index 00000000..1ba140e2 --- /dev/null +++ b/tests/parameters.rs @@ -0,0 +1,3 @@ +mod common; + +common::run_test!(parameters); diff --git a/tests/parameters.scm b/tests/parameters.scm new file mode 100644 index 00000000..0a842784 --- /dev/null +++ b/tests/parameters.scm @@ -0,0 +1,126 @@ +(import (rnrs) (rnrs parameters) (prompts) (test)) + +;; Basic parameter creation and access +(define p (make-parameter 42)) +(assert-equal? (p) 42) +(assert-equal? (parameter? p) #t) +(assert-equal? (parameter? 42) #f) +(assert-equal? (parameter? car) #f) + +;; Direct set (bare set returns unspecified; read before/after instead) +(assert-equal? (p) 42) +(p 99) +(assert-equal? (p) 99) +(p 42) ;; reset + +;; Converter applied to initial value +(define q (make-parameter 5 (lambda (x) (* x 2)))) +(assert-equal? (q) 10) + +;; Converter applied on direct set +(q 3) +(assert-equal? (q) 6) + +;; parameterize scoping (no converter on p) +(assert-equal? (parameterize ((p 100)) (p)) 100) +(assert-equal? (p) 42) + +;; parameterize applies converter +(assert-equal? (parameterize ((q 7)) (q)) 14) +;; rebinding: exit uncovers the outer cell; the converter runs at entry only +;; (R7RS/SRFI-226/Racket; Chez re-applies on restore) +(assert-equal? (q) 6) + +;; Nested parameterize (no converter) +(assert-equal? + (parameterize ((p 100)) + (parameterize ((p 200)) + (p))) + 200) +(assert-equal? (p) 42) + +;; Multiple parameters in one parameterize +(assert-equal? + (parameterize ((p 1) (q 2)) + (cons (p) (q))) + '(1 . 4)) +;; rebinding: exit uncovers the outer cell unchanged +(assert-equal? (q) 6) + +;; Mutation inside parameterize doesn't leak (no converter) +(parameterize ((p 50)) + (p 60)) +(assert-equal? (p) 42) + +;; parameterize + call/cc: mutations preserved because the binding is a +;; cell carried by the captured continuation +(define cc-param (make-parameter 'outside)) +(define saved-k #f) +(define call-count 0) + +(parameterize ((cc-param 'inside)) + (call-with-current-continuation + (lambda (k) (set! saved-k k))) + (assert-equal? (cc-param) 'inside) + (set! call-count (+ call-count 1))) + +(assert-equal? (cc-param) 'outside) + +(if (< call-count 2) + (saved-k)) +(assert-equal? (cc-param) 'outside) + +;; Mutation + re-entry: mutation preserved because the binding is a cell +;; carried by the captured continuation +(define mut-param (make-parameter 'default)) +(define mut-k #f) +(define mut-count 0) + +(parameterize ((mut-param 'bound)) + (call-with-current-continuation + (lambda (k) (set! mut-k k))) + (if (= mut-count 0) + (mut-param 'mutated)) + (assert-equal? (mut-param) 'mutated) + (set! mut-count (+ mut-count 1))) + +(if (< mut-count 2) + (begin + (assert-equal? (mut-param) 'default) + (mut-k))) +(assert-equal? (mut-param) 'default) + +;; parameterize + dynamic-wind +(define dw-param (make-parameter 'default)) +(define dw-log '()) + +(parameterize ((dw-param 'bound)) + (dynamic-wind + (lambda () (set! dw-log (cons (cons 'in (dw-param)) dw-log))) + (lambda () (set! dw-log (cons (cons 'body (dw-param)) dw-log))) + (lambda () (set! dw-log (cons (cons 'out (dw-param)) dw-log))))) + +(assert-equal? (reverse dw-log) '((in . bound) (body . bound) (out . bound))) + +;; parameterize + abort-to-prompt +(define prompt-param (make-parameter 'outside)) + +(assert-equal? + (call-with-prompt 'test-tag + (lambda () + (parameterize ((prompt-param 'inside)) + (abort-to-prompt 'test-tag 'result))) + (lambda (k val) + (cons val (prompt-param)))) + '(result . outside)) + +;; Empty parameterize +(assert-equal? (parameterize () 42) 42) + +;; Non-idempotent converter +(define ni-param (make-parameter 1 (lambda (x) (+ x 1)))) +(assert-equal? (ni-param) 2) +(assert-equal? (parameterize ((ni-param 4)) (ni-param)) 5) +;; rebinding: exit uncovers the outer cell; the converter runs at entry only +;; (R7RS/SRFI-226/Racket; Chez re-applies on restore) +(assert-equal? (ni-param) 2) diff --git a/tests/parameters_applicable.rs b/tests/parameters_applicable.rs new file mode 100644 index 00000000..32405c37 --- /dev/null +++ b/tests/parameters_applicable.rs @@ -0,0 +1,3 @@ +mod common; + +common::run_test!(parameters_applicable); diff --git a/tests/parameters_applicable.scm b/tests/parameters_applicable.scm new file mode 100644 index 00000000..7c9736a7 --- /dev/null +++ b/tests/parameters_applicable.scm @@ -0,0 +1,28 @@ +(import (rnrs) (rnrs parameters) (test)) + +;; parameter? recognizes an actual parameter +(define p (make-parameter 42)) +(assert-equal? (parameter? p) #t) + +;; parameter? rejects a closure that merely closes over a parameter +(assert-equal? (parameter? (lambda () (p))) #f) + +;; procedure? answers #t for a parameter +(assert-equal? (procedure? p) #t) + +;; apply works with parameters as operators +(assert-equal? (apply p '()) 42) +(p 10) +(assert-equal? (apply p '()) 10) + +;; a converter parameter works through direct application +(define q (make-parameter 5 (lambda (x) (* x 2)))) +(assert-equal? (q) 10) +(q 3) +(assert-equal? (q) 6) + +;; too many arguments raises an error that names the parameter type +(assert-equal? + (guard (e (#t (condition-message e))) + (p 1 2)) + "parameter accepts zero or one arguments") diff --git a/tests/parameters_basic.rs b/tests/parameters_basic.rs new file mode 100644 index 00000000..fc522174 --- /dev/null +++ b/tests/parameters_basic.rs @@ -0,0 +1,3 @@ +mod common; + +common::run_test!(parameters_basic); diff --git a/tests/parameters_basic.scm b/tests/parameters_basic.scm new file mode 100644 index 00000000..dacc5962 --- /dev/null +++ b/tests/parameters_basic.scm @@ -0,0 +1,22 @@ +(import (rnrs) (rnrs parameters) (test)) + +;; default value +(define p (make-parameter 10)) +(assert-equal? (p) 10) + +;; bare set mutates the task root; read sees it +(p 42) +(assert-equal? (p) 42) + +;; converter applied at creation and on set. The set returns zero +;; values (matching hashtable-set!/set-car!'s convention), not one +;; unspecified value -- (define x (p 3)) would error, so sequence via +;; begin, not via the return value. +(define c (make-parameter 5 (lambda (x) (* x 2)))) +(assert-equal? (c) 10) +(c 3) +(assert-equal? (c) 6) + +;; parameter? recognizes parameters and rejects plain procedures +(assert-equal? (parameter? p) #t) +(assert-equal? (parameter? car) #f) From 2823bc85a81b72d13bd44f3c9ae2f0597bbff9a3 Mon Sep 17 00:00:00 2001 From: Linus Shoravi Date: Thu, 16 Jul 2026 23:33:42 +0200 Subject: [PATCH 08/10] Pin parameter semantics: spawn snapshots and callback visibility --- tests/parameters_tasks.rs | 3 +++ tests/parameters_tasks.scm | 35 +++++++++++++++++++++++++++++++++ tests/parameters_visibility.rs | 3 +++ tests/parameters_visibility.scm | 33 +++++++++++++++++++++++++++++++ 4 files changed, 74 insertions(+) create mode 100644 tests/parameters_tasks.rs create mode 100644 tests/parameters_tasks.scm create mode 100644 tests/parameters_visibility.rs create mode 100644 tests/parameters_visibility.scm diff --git a/tests/parameters_tasks.rs b/tests/parameters_tasks.rs new file mode 100644 index 00000000..60966c84 --- /dev/null +++ b/tests/parameters_tasks.rs @@ -0,0 +1,3 @@ +mod common; + +common::run_test!(parameters_tasks); diff --git a/tests/parameters_tasks.scm b/tests/parameters_tasks.scm new file mode 100644 index 00000000..eca4a617 --- /dev/null +++ b/tests/parameters_tasks.scm @@ -0,0 +1,35 @@ +(import (rnrs) (rnrs parameters) (test) (threads (1))) + +;; Inheritance: value at spawn time is visible in the child. +(define p (make-parameter 'default)) +(p 'before-spawn) +(join (spawn (lambda () (assert-equal? (p) 'before-spawn)))) + +;; Isolation: a bare set in the child is child-local (guile-fibers). +(join (spawn (lambda () + (p 'child-value) + (assert-equal? (p) 'child-value)))) +(assert-equal? (p) 'before-spawn) + +;; Snapshot at spawn, not a live link: a parent mutation after the child +;; has been joined does not retroactively appear anywhere, and a child +;; that joined before the mutation saw the old value. +(define q (make-parameter 0)) +(q 1) +(join (spawn (lambda () (assert-equal? (q) 1)))) +(q 2) +(join (spawn (lambda () (assert-equal? (q) 2)))) +(assert-equal? (q) 2) + +;; parameterize binding visible in a task spawned inside the body +;; (R7RS: "threads created inside "). +(define r (make-parameter 'outer)) +(parameterize ((r 'inner)) + (join (spawn (lambda () (assert-equal? (r) 'inner))))) +(assert-equal? (r) 'outer) + +;; ...and the child's mutation of that binding is its own copy: +(define s (make-parameter 0)) +(parameterize ((s 10)) + (join (spawn (lambda () (s 99) (assert-equal? (s) 99)))) + (assert-equal? (s) 10)) diff --git a/tests/parameters_visibility.rs b/tests/parameters_visibility.rs new file mode 100644 index 00000000..de020d5a --- /dev/null +++ b/tests/parameters_visibility.rs @@ -0,0 +1,3 @@ +mod common; + +common::run_test!(parameters_visibility); diff --git a/tests/parameters_visibility.scm b/tests/parameters_visibility.scm new file mode 100644 index 00000000..d304e285 --- /dev/null +++ b/tests/parameters_visibility.scm @@ -0,0 +1,33 @@ +(import (rnrs) (rnrs parameters) (test)) + +;; A parameterize binding is visible inside a hashtable hash callback — +;; impossible under per-barrier storage; the point of the redesign. +(define p (make-parameter 1)) +(define seen '()) +(define ht + (make-hashtable + (lambda (k) (set! seen (cons (p) seen)) 7) + eq?)) +(parameterize ((p 99)) + (hashtable-set! ht 'a 1)) +(assert-equal? (car seen) 99) + +;; A continuation captured inside a parameterize re-enters its binding. +(define q (make-parameter 0)) +(define k* #f) +(define trail '()) +(parameterize ((q 5)) + (call/cc (lambda (k) (set! k* k))) + (set! trail (cons (q) trail))) +(when (< (length trail) 2) (k* #f)) +(assert-equal? trail '(5 5)) + +;; Non-idempotent converter drift regression: entering and leaving +;; parameterize must not change the outer value (Chez drifts here; +;; rebinding applies the converter at entry only). +(define ni (make-parameter 1 (lambda (x) (+ x 1)))) +(assert-equal? (ni) 2) +(parameterize ((ni 10)) #f) +(parameterize ((ni 10)) #f) +(parameterize ((ni 10)) #f) +(assert-equal? (ni) 2) From d68cbee64467072eb90e34cd3506ee5bb6920aed Mon Sep 17 00:00:00 2001 From: Linus Shoravi Date: Thu, 16 Jul 2026 23:33:50 +0200 Subject: [PATCH 09/10] Pin cross-library parameter persistence --- tests/lib-p.sls | 6 ++++++ tests/parameters_cross_library.rs | 3 +++ tests/parameters_cross_library.scm | 3 +++ 3 files changed, 12 insertions(+) create mode 100644 tests/lib-p.sls create mode 100644 tests/parameters_cross_library.rs create mode 100644 tests/parameters_cross_library.scm diff --git a/tests/lib-p.sls b/tests/lib-p.sls new file mode 100644 index 00000000..4c0ce6e9 --- /dev/null +++ b/tests/lib-p.sls @@ -0,0 +1,6 @@ +(library (tests lib-p) + (export p loaded?) + (import (rnrs) (rnrs parameters)) + (define p (make-parameter 10)) + (p 99) + (define loaded? #t)) diff --git a/tests/parameters_cross_library.rs b/tests/parameters_cross_library.rs new file mode 100644 index 00000000..4e6d8085 --- /dev/null +++ b/tests/parameters_cross_library.rs @@ -0,0 +1,3 @@ +mod common; + +common::run_test!(parameters_cross_library); diff --git a/tests/parameters_cross_library.scm b/tests/parameters_cross_library.scm new file mode 100644 index 00000000..31289221 --- /dev/null +++ b/tests/parameters_cross_library.scm @@ -0,0 +1,3 @@ +(import (rnrs) (test) (tests lib-p)) +(assert-equal? loaded? #t) +(assert-equal? (p) 99) From c34100e48bb72f005f2028881a8a190c9f0ca95e Mon Sep 17 00:00:00 2001 From: Linus Shoravi Date: Thu, 16 Jul 2026 23:33:55 +0200 Subject: [PATCH 10/10] Pin parameter inheritance through tokio spawn and future --- tests/parameters_async.rs | 5 +++++ tests/parameters_async.scm | 26 ++++++++++++++++++++++++++ 2 files changed, 31 insertions(+) create mode 100644 tests/parameters_async.rs create mode 100644 tests/parameters_async.scm diff --git a/tests/parameters_async.rs b/tests/parameters_async.rs new file mode 100644 index 00000000..64dcddf8 --- /dev/null +++ b/tests/parameters_async.rs @@ -0,0 +1,5 @@ +#![cfg(all(feature = "async", feature = "tokio"))] + +mod common; + +common::run_test!(parameters_async); diff --git a/tests/parameters_async.scm b/tests/parameters_async.scm new file mode 100644 index 00000000..65f05f54 --- /dev/null +++ b/tests/parameters_async.scm @@ -0,0 +1,26 @@ +(import (rnrs) (rnrs parameters) (test) (async)) + +;; Task inheritance and isolation through tokio spawn. +(define p (make-parameter 'root)) +(p 'before) +(await (spawn (lambda () (assert-equal? (p) 'before)))) +(await (spawn (lambda () (p 'task-local) (assert-equal? (p) 'task-local)))) +(assert-equal? (p) 'before) + +;; future: snapshot at CREATION, not first poll. let-bound so creation, +;; mutation, and await sequence within one body. (A top-level define RHS +;; would trip the pre-existing top-level ordering bug - see the +;; linuss/toplevel-order branch - so this deliberately uses let.) +(define q (make-parameter 0)) +(let () + (q 1) + (let ((f (future (lambda () (q))))) + (q 2) + (assert-equal? (await f) 1) + (assert-equal? (q) 2))) + +;; parameterize binding visible in a task spawned inside the body. +(define r (make-parameter 'outer)) +(parameterize ((r 'inner)) + (await (spawn (lambda () (assert-equal? (r) 'inner))))) +(assert-equal? (r) 'outer)