[5/5] Add R7RS parameters with Guile semantics where unspecified

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 }
         })
     });
 }

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 }
         })
     });
 }

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 }
         })
     });
 }

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 ...)))))))

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::<Procedure>().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<Application, Exception> {
-    // 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))

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<Mutex<HashMap<Binding, TopLevelBinding>>> =
     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<Mutex<HashSet<Binding>>> =
+    LazyLock::new(|| Mutex::new(HashSet::default()));
+
+struct LookupGuard(Binding);
+
+impl LookupGuard {
+    fn enter(binding: Binding) -> Result<Self, Exception> {
+        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<Option<Global>, 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))
                 }

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<Application, Exception> {
     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()));
     };
 

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<Vec<Value>, 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<Vec<Value>, Exception> {
 #[bridge(name = "spawn", lib = "(async)")]
 pub async fn spawn(task: &Value) -> Result<Vec<Value>, 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])