From 518d1e262d19000d15c709965015f9707fa95b81 Mon Sep 17 00:00:00 2001 From: Matthew Plant Date: Tue, 31 Dec 2024 11:41:34 -0500 Subject: [PATCH] Dynamic-wind (#52) * Implement dynamic wind, fix bug with environment cloning * Adjust readme * I think this is correct now --- README.md | 19 +- proc-macros/src/lib.rs | 4 +- src/ast/parse.rs | 2 +- src/continuation.rs | 437 ++++++++++++++++++++++++++++++++++++----- src/env.rs | 25 ++- src/error.rs | 7 +- src/gc/mod.rs | 20 ++ src/proc.rs | 3 +- src/stdlib.scm | 7 + src/value.rs | 8 +- tests/r6rs.scm | 53 +++++ 11 files changed, 504 insertions(+), 81 deletions(-) diff --git a/README.md b/README.md index 85a6446..2368bac 100644 --- a/README.md +++ b/README.md @@ -22,7 +22,6 @@ That is obviously a long way away. ## Features currently unsupported by scheme-rs: - Exceptions and error handling -- Dynamic winding - Ports and IO operations - Most API functions are not implemented - A large portion of lexical structures are missing; there's no way to specify recursive data structures @@ -39,17 +38,17 @@ in the repo's root directory (examples taken from wikipedia): ~/scheme-rs> cargo run Finished `dev` profile [unoptimized + debuginfo] target(s) in 0.03s Running `target/debug/scheme-rs` ->>> (let loop ((n 1)) -... (if (> n 10) -... '() -... (cons n -... (loop (+ n 1))))) +> (let loop ((n 1)) + (if (> n 10) + '() + (cons n + (loop (+ n 1))))) $1 = (1 2 3 4 5 6 7 8 9 10) >>> (let* ((yin -... ((lambda (cc) (display "@") cc) (call-with-current-continuation (lambda (c) c)))) -... (yang -... ((lambda (cc) (display "*") cc) (call-with-current-continuation (lambda (c) c))))) -... (yin yang)) + ((lambda (cc) (display "@") cc) (call-with-current-continuation (lambda (c) c)))) + (yang + ((lambda (cc) (display "*") cc) (call-with-current-continuation (lambda (c) c))))) + (yin yang)) @*@**@***@****@*****@******@*******@********@*********@**********@***********@**********...^C ``` diff --git a/proc-macros/src/lib.rs b/proc-macros/src/lib.rs index a757e80..b8478e4 100644 --- a/proc-macros/src/lib.rs +++ b/proc-macros/src/lib.rs @@ -291,14 +291,14 @@ fn derive_trace_enum(name: Ident, data_enum: DataEnum) -> proc_macro2::TokenStre unsafe impl ::scheme_rs::gc::Trace for #name { unsafe fn visit_children(&self, visitor: unsafe fn(::scheme_rs::gc::OpaqueGcPtr)) { match self { - #( #visit_match_clauses )*, + #( #visit_match_clauses, )* _ => (), } } unsafe fn finalize(&mut self) { match self { - #( #finalize_match_clauses )*, + #( #finalize_match_clauses, )* _ => (), } } diff --git a/src/ast/parse.rs b/src/ast/parse.rs index 9af88d4..2166e47 100644 --- a/src/ast/parse.rs +++ b/src/ast/parse.rs @@ -18,7 +18,7 @@ use std::{ sync::Arc, }; -#[derive(Debug, Clone)] +#[derive(Debug, Clone, Trace)] pub enum ParseAstError { BadForm(Span), UnexpectedEmptyList(Span), diff --git a/src/continuation.rs b/src/continuation.rs index 87d1565..9dd9d8d 100644 --- a/src/continuation.rs +++ b/src/continuation.rs @@ -12,10 +12,10 @@ use crate::{ util::{ArcSlice, RequireOne}, value::Value, }; -use std::sync::Arc; +use std::{collections::HashMap, sync::Arc}; #[async_trait] -pub trait Resumable: Trace + Send + Sync { +pub trait Resumable: Trace + Send + Sync + std::fmt::Debug { fn min_args(&self) -> usize { 1 } @@ -32,13 +32,35 @@ pub trait Resumable: Trace + Send + Sync { /// Clone the contents of the resumable; necessary to ensure the continuation /// is unique when we make a continuation first-class. - fn clone_stack(&self) -> Arc; + fn clone_stack(&self, cloned: &mut HashMap, Gc>) -> Arc; } -#[derive(Trace)] +#[derive(Clone, Trace, Debug)] +struct DiscardResumeArgs { + replacement: Result>, RuntimeError>, +} + +#[async_trait] +impl Resumable for DiscardResumeArgs { + async fn resume( + &self, + _args: Vec>, + _cont: &Option>, + ) -> Result>, RuntimeError> { + self.replacement.clone() + } + + fn clone_stack(&self, _cloned: &mut HashMap, Gc>) -> Arc { + Arc::new(self.clone()) + } +} + +#[derive(Trace, derive_more::Debug)] pub struct Continuation { resume_point: Arc, remaining: Option>, + #[debug(skip)] + dynamic_wind: Option, } impl Continuation { @@ -46,15 +68,42 @@ impl Continuation { Self { resume_point, remaining: remaining.clone(), + dynamic_wind: remaining + .as_ref() + .and_then(|cont| cont.dynamic_wind.clone()), + } + } + + pub fn with_dynamic_wind( + resume_point: Arc, + remaining: &Option>, + dynamic_wind: DynamicWind, + ) -> Self { + Self { + resume_point, + remaining: remaining.clone(), + dynamic_wind: Some(dynamic_wind), } } - fn clone_stack(&self) -> Arc { + fn clone_stack(&self, cloned: &mut HashMap, Gc>) -> Arc { Arc::new(Self { - resume_point: self.resume_point.clone_stack(), - remaining: self.remaining.as_ref().map(|cont| cont.clone_stack()), + resume_point: self.resume_point.clone_stack(cloned), + remaining: self.remaining.as_ref().map(|cont| cont.clone_stack(cloned)), + dynamic_wind: self.dynamic_wind.clone(), }) } + + pub async fn enter_extent( + self: &Arc, + args: Vec>, + ) -> Result>, RuntimeError> { + if let Some(ref dynamic_wind) = self.dynamic_wind { + dynamic_wind.in_thunks().call(self).await?; + } + + self.resume(args, &None).await + } } #[async_trait] @@ -66,15 +115,15 @@ impl Resumable for Continuation { ) -> Result>, RuntimeError> { if let Some(ref remaining) = self.remaining { let new_cont = Some(Arc::new(Continuation::new(remaining.clone(), cont))); - let resume_result = self.resume_point.resume(args, &new_cont).await?; - remaining.resume(resume_result, cont).await + let resume_result = self.resume_point.resume(args, &new_cont).await; + remaining.resume(resume_result?, cont).await } else { self.resume_point.resume(args, cont).await } } - fn clone_stack(&self) -> Arc { - self.clone_stack() + fn clone_stack(&self, cloned: &mut HashMap, Gc>) -> Arc { + self.clone_stack(cloned) } } @@ -99,12 +148,14 @@ impl Callable for Option> { ) -> Result { Err(RuntimeError::abandon_current_continuation( args, - self.clone(), + // Cloning the stack is _extremely_ slow. This needs to be fixed at some point. + self.as_ref() + .map(|cont| cont.clone_stack(&mut HashMap::default())), )) } } -#[derive(Trace)] +#[derive(Trace, Debug)] pub struct ResumableDefineVar { env: Gc, name: Identifier, @@ -128,18 +179,18 @@ impl Resumable for ResumableDefineVar { ) -> Result>, RuntimeError> { let arg = args.require_one()?; self.env.write().def_local_var(&self.name, arg); - Ok(vec![]) + Ok(Vec::new()) } - fn clone_stack(&self) -> Arc { + fn clone_stack(&self, cloned: &mut HashMap, Gc>) -> Arc { Arc::new(Self { - env: self.env.deep_clone(), + env: self.env.deep_clone(cloned), name: self.name.clone(), }) } } -#[derive(Trace)] +#[derive(Trace, Debug)] pub struct ResumableBody { env: Gc, remaining: ArcSlice, @@ -156,6 +207,14 @@ impl ResumableBody { #[async_trait] impl Resumable for ResumableBody { + fn min_args(&self) -> usize { + 0 + } + + fn max_args(&self) -> Option { + None + } + async fn resume( &self, args: Vec>, @@ -174,15 +233,15 @@ impl Resumable for ResumableBody { last.eval(&self.env, cont).await } - fn clone_stack(&self) -> Arc { + fn clone_stack(&self, cloned: &mut HashMap, Gc>) -> Arc { Arc::new(Self { - env: self.env.deep_clone(), + env: self.env.deep_clone(cloned), remaining: self.remaining.clone(), }) } } -#[derive(Trace)] +#[derive(Trace, Debug)] pub struct ResumableLet { scope: Gc, curr: Identifier, @@ -230,9 +289,9 @@ impl Resumable for ResumableLet { self.body.eval(&self.scope, cont).await } - fn clone_stack(&self) -> Arc { + fn clone_stack(&self, cloned: &mut HashMap, Gc>) -> Arc { Arc::new(Self { - scope: self.scope.deep_clone(), + scope: self.scope.deep_clone(cloned), curr: self.curr.clone(), remaining_bindings: self.remaining_bindings.clone(), body: self.body.clone(), @@ -240,7 +299,7 @@ impl Resumable for ResumableLet { } } -#[derive(Trace)] +#[derive(Trace, Debug)] pub struct ResumableIf { env: Gc, success: Arc, @@ -278,16 +337,16 @@ impl Resumable for ResumableIf { } } - fn clone_stack(&self) -> Arc { + fn clone_stack(&self, cloned: &mut HashMap, Gc>) -> Arc { Arc::new(Self { - env: self.env.deep_clone(), + env: self.env.deep_clone(cloned), success: self.success.clone(), failure: self.failure.clone(), }) } } -#[derive(Trace)] +#[derive(Trace, Debug)] pub struct ResumableAnd { env: Gc, args: ArcSlice, @@ -336,15 +395,15 @@ impl Resumable for ResumableAnd { last.eval(&self.env, cont).await } - fn clone_stack(&self) -> Arc { + fn clone_stack(&self, cloned: &mut HashMap, Gc>) -> Arc { Arc::new(Self { - env: self.env.deep_clone(), + env: self.env.deep_clone(cloned), args: self.args.clone(), }) } } -#[derive(Trace)] +#[derive(Trace, Debug)] pub struct ResumableOr { env: Gc, args: ArcSlice, @@ -393,15 +452,15 @@ impl Resumable for ResumableOr { last.eval(&self.env, cont).await } - fn clone_stack(&self) -> Arc { + fn clone_stack(&self, cloned: &mut HashMap, Gc>) -> Arc { Arc::new(Self { - env: self.env.deep_clone(), + env: self.env.deep_clone(cloned), args: self.args.clone(), }) } } -#[derive(Trace)] +#[derive(Trace, Debug)] pub struct ResumableSet { env: Gc, var: Ref, @@ -429,15 +488,15 @@ impl Resumable for ResumableSet { Ok(Vec::new()) } - fn clone_stack(&self) -> Arc { + fn clone_stack(&self, cloned: &mut HashMap, Gc>) -> Arc { Arc::new(Self { - env: self.env.deep_clone(), + env: self.env.deep_clone(cloned), var: self.var.clone(), }) } } -#[derive(Trace)] +#[derive(Trace, Debug)] pub struct ResumableSyntaxCase { env: Gc, transformer: Transformer, @@ -475,15 +534,15 @@ impl Resumable for ResumableSyntaxCase { .await } - fn clone_stack(&self) -> Arc { + fn clone_stack(&self, cloned: &mut HashMap, Gc>) -> Arc { Arc::new(Self { - env: self.env.deep_clone(), + env: self.env.deep_clone(cloned), transformer: self.transformer.clone(), }) } } -#[derive(Trace)] +#[derive(Trace, Debug)] pub struct ResumableCall { env: Gc, // TODO: Making this a SmallVec of around 10 would probably be a @@ -551,9 +610,9 @@ impl Resumable for ResumableCall { .await } - fn clone_stack(&self) -> Arc { + fn clone_stack(&self, cloned: &mut HashMap, Gc>) -> Arc { Arc::new(Self { - env: self.env.deep_clone(), + env: self.env.deep_clone(cloned), collected: self.collected.clone(), remaining: self.remaining.clone(), proc_name: self.proc_name.clone(), @@ -573,18 +632,13 @@ pub async fn call_cc( .ok_or_else(|| RuntimeError::invalid_type("procedure", proc.type_name()))? }; callable - .call( - vec![Gc::new(Value::Continuation( - cont.as_ref().map(|cont| cont.clone_stack()), - ))], - cont, - ) + .call(vec![Gc::new(Value::Continuation(cont.clone()))], cont) .await? .eval(cont) .await } -#[derive(Clone, Trace)] +#[derive(Clone, Trace, Debug)] pub struct CallWithValues { min_args: usize, max_args: Option, @@ -613,7 +667,7 @@ impl Resumable for CallWithValues { callable.call(args, cont).await?.eval(cont).await } - fn clone_stack(&self) -> Arc { + fn clone_stack(&self, _cloned: &mut HashMap, Gc>) -> Arc { Arc::new(self.clone()) } } @@ -640,7 +694,9 @@ pub async fn call_with_values( max_args: consumer_callable.max_args(), consumer: consumer.clone(), }), - &cont.as_ref().map(|cont| cont.clone_stack()), + &cont + .as_ref() + .map(|cont| cont.clone_stack(&mut HashMap::default())), )); let producer_result = producer_callable @@ -656,3 +712,286 @@ pub async fn call_with_values( .eval(cont) .await } + +#[derive(Trace, Clone, Debug)] +pub struct DynamicWind { + in_thunks: Vec>, + out_thunk: Arc, +} + +impl DynamicWind { + pub fn new( + cont: &Option>, + in_thunk: Arc, + out_thunk: Arc, + ) -> Self { + let mut in_thunks = cont + .as_ref() + .and_then(|cont| cont.dynamic_wind.as_ref()) + .map_or_else(Vec::new, |cont| cont.in_thunks.clone()); + in_thunks.push(in_thunk); + Self { + in_thunks, + out_thunk, + } + } + + pub fn in_thunks(&self) -> ResumableListOfThunks { + ResumableListOfThunks { + thunks: ArcSlice::from(self.in_thunks.clone()), + } + } +} + +#[derive(Debug, Clone, Trace)] +pub struct ResumableDynamicWind { + in_thunk: Arc, + body_thunk: Arc, + out_thunk: Arc, +} + +#[async_trait] +impl Resumable for ResumableDynamicWind { + fn min_args(&self) -> usize { + 0 + } + + fn max_args(&self) -> Option { + None + } + + async fn resume( + &self, + _args: Vec>, + cont: &Option>, + ) -> Result>, RuntimeError> { + let dynamic_wind = DynamicWind::new(cont, self.in_thunk.clone(), self.out_thunk.clone()); + + // Discard the arguments and call the body thunk + let body_cont = Some(Arc::new(Continuation::with_dynamic_wind( + Arc::new(ResumableDynamicWindBody { + out_thunk: self.out_thunk.clone(), + }), + cont, + dynamic_wind.clone(), + ))); + + let res = self + .body_thunk + .call(Vec::new(), &body_cont) + .await? + .eval(&body_cont) + .await?; + + let out_cont = Some(Arc::new(Continuation::new( + Arc::new(DiscardResumeArgs { + replacement: Ok(res.clone()), + }), + cont, + ))); + + let _ = self + .out_thunk + .call(Vec::new(), &out_cont) + .await? + .eval(&out_cont) + .await?; + + Ok(res) + } + + fn clone_stack(&self, _cloned: &mut HashMap, Gc>) -> Arc { + // Do I need to clone the closures of the dynamic wind? I don't think so, but maybe. + Arc::new(self.clone()) + } +} + +#[derive(Debug, Clone, Trace)] +pub struct ResumableDynamicWindBody { + out_thunk: Arc, +} + +#[async_trait] +impl Resumable for ResumableDynamicWindBody { + fn min_args(&self) -> usize { + 0 + } + + fn max_args(&self) -> Option { + None + } + + async fn resume( + &self, + args: Vec>, + cont: &Option>, + ) -> Result>, RuntimeError> { + let out_cont = Some(Arc::new(Continuation::new( + Arc::new(DiscardResumeArgs { + replacement: Ok(args.clone()), + }), + cont, + ))); + + self.out_thunk + .call(Vec::new(), &out_cont) + .await? + .eval(&out_cont) + .await?; + + Ok(args) + } + + fn clone_stack(&self, _cloned: &mut HashMap, Gc>) -> Arc { + // Do I need to clone the closures of the dynamic wind? I don't think so, but maybe. + Arc::new(self.clone()) + } +} + +#[derive(Trace, derive_more::Debug)] +pub struct ResumableListOfThunks { + thunks: ArcSlice>, +} + +impl ResumableListOfThunks { + pub fn new(thunks: ArcSlice>) -> Self { + Self { thunks } + } + + async fn call(&self, cont: &Arc) -> Result>, RuntimeError> { + let mut result = Vec::new(); + for (i, (thunk, tail)) in self.thunks.iter().enumerate() { + let in_thunks = self + .thunks + .iter() + .map(|(x, _)| x) + .take(i) + .cloned() + .collect::>(); + let dynamic_wind = DynamicWind { + in_thunks, + out_thunk: cont.dynamic_wind.as_ref().unwrap().out_thunk.clone(), + }; + let cont = Some(Arc::new(Continuation::with_dynamic_wind( + Arc::new(ResumableListOfThunks::new(tail)), + &Some(cont.clone()), + dynamic_wind, + ))); + result = thunk.call(Vec::new(), &cont).await?.eval(&cont).await?; + } + Ok(result) + } +} + +#[async_trait] +impl Resumable for ResumableListOfThunks { + fn min_args(&self) -> usize { + 0 + } + + fn max_args(&self) -> Option { + None + } + + async fn resume( + &self, + args: Vec>, + cont: &Option>, + ) -> Result>, RuntimeError> { + let Some(last) = self.thunks.last() else { + return Ok(args); + }; + for (thunk, tail) in self.thunks.skip_last() { + let cont = Some(Arc::new(Continuation::new( + Arc::new(ResumableListOfThunks::new(tail)), + cont, + ))); + thunk.call(Vec::new(), &cont).await?.eval(&cont).await?; + } + last.call(Vec::new(), cont).await?.eval(cont).await + } + + fn clone_stack(&self, _cloned: &mut HashMap, Gc>) -> Arc { + Arc::new(Self { + thunks: self.thunks.clone(), + }) + } +} + +#[builtin("dynamic-wind")] +pub async fn dynamic_wind( + cont: &Option>, + in_thunk: &Gc, + body_thunk: &Gc, + out_thunk: &Gc, +) -> Result>, RuntimeError> { + let in_thunk = { + let in_thunk = in_thunk.read(); + in_thunk + .as_callable() + .ok_or_else(|| RuntimeError::invalid_type("procedure", in_thunk.type_name()))? + .clone() + }; + + let body_thunk = { + let body_thunk = body_thunk.read(); + body_thunk + .as_callable() + .ok_or_else(|| RuntimeError::invalid_type("procedure", body_thunk.type_name()))? + .clone() + }; + + let out_thunk = { + let out_thunk = out_thunk.read(); + out_thunk + .as_callable() + .ok_or_else(|| RuntimeError::invalid_type("procedure", out_thunk.type_name()))? + .clone() + }; + + let dynamic_wind = DynamicWind::new(cont, in_thunk.clone(), out_thunk.clone()); + + let in_cont = Some(Arc::new(Continuation::new( + Arc::new(ResumableDynamicWind { + in_thunk: in_thunk.clone(), + body_thunk: body_thunk.clone(), + out_thunk: out_thunk.clone(), + }), + cont, + ))); + + let _ = in_thunk + .call(Vec::new(), &in_cont) + .await? + .eval(&in_cont) + .await?; + + let body_cont = Some(Arc::new(Continuation::with_dynamic_wind( + Arc::new(ResumableDynamicWindBody { + out_thunk: out_thunk.clone(), + }), + cont, + dynamic_wind.clone(), + ))); + + let res = body_thunk + .call(Vec::new(), &body_cont) + .await? + .eval(&body_cont) + .await?; + + let out_cont = Some(Arc::new(Continuation::new( + Arc::new(DiscardResumeArgs { + replacement: Ok(res.clone()), + }), + cont, + ))); + + let _ = out_thunk + .call(Vec::new(), &out_cont) + .await? + .eval(&out_cont) + .await?; + + Ok(res) +} diff --git a/src/env.rs b/src/env.rs index 36fee38..82524d6 100644 --- a/src/env.rs +++ b/src/env.rs @@ -6,7 +6,6 @@ use tokio::sync::OnceCell; use crate::{ ast::{parse::ParseAstError, AstNode}, builtin::Builtin, - continuation::Resumable, error::{RuntimeError, RuntimeErrorKind}, gc::{init_gc, Gc}, lex::{LexError, Token}, @@ -177,7 +176,7 @@ impl Gc { // TODO: Retain the backtrace for errors // let arg = args.pop().unwrap(); if let Some(new_cont) = new_cont { - inner = new_cont.resume(args, &None).await; + inner = new_cont.enter_extent(args).await; } else { return Ok(args); } @@ -193,14 +192,20 @@ impl Gc { } } - pub fn deep_clone(&self) -> Self { - let this = self.read(); - Gc::new(Env { - up: this.up.as_ref().map(|up| up.deep_clone()), - vars: this.vars.clone(), - var_names: this.var_names.clone(), - macros: this.macros.clone(), - }) + pub fn deep_clone(&self, cloned: &mut HashMap) -> Self { + if cloned.contains_key(self) { + cloned.get(self).unwrap().clone() + } else { + let this = self.read(); + let clone = Gc::new(Env { + up: this.up.as_ref().map(|up| up.deep_clone(cloned)), + vars: this.vars.clone(), + var_names: this.var_names.clone(), + macros: this.macros.clone(), + }); + cloned.insert(self.clone(), clone.clone()); + clone + } } } diff --git a/src/error.rs b/src/error.rs index f5ae0a7..10aa038 100644 --- a/src/error.rs +++ b/src/error.rs @@ -6,16 +6,17 @@ use crate::{ value::Value, }; use derivative::Derivative; +use proc_macros::Trace; use std::sync::Arc; // TODO: Rename this to condition to more accurately reflect its purpose -#[derive(Debug, Clone)] +#[derive(Debug, Clone, Trace)] pub struct RuntimeError { pub backtrace: Vec, pub kind: RuntimeErrorKind, } -#[derive(Derivative)] +#[derive(Derivative, Trace)] #[derivative(Debug, Clone)] pub enum RuntimeErrorKind { UndefinedVariable(Identifier), @@ -49,7 +50,7 @@ pub enum RuntimeErrorKind { }, } -#[derive(Debug, Clone)] +#[derive(Debug, Clone, Trace)] pub struct Frame { pub proc: String, pub span: Span, diff --git a/src/gc/mod.rs b/src/gc/mod.rs index cf77760..697d248 100644 --- a/src/gc/mod.rs +++ b/src/gc/mod.rs @@ -479,6 +479,26 @@ where } } +unsafe impl Trace for Result +where + V: GcOrTrace, + E: GcOrTrace, +{ + unsafe fn visit_children(&self, visitor: unsafe fn(OpaqueGcPtr)) { + match self { + Ok(inner) => inner.visit_or_recurse(visitor), + Err(inner) => inner.visit_or_recurse(visitor), + } + } + + unsafe fn finalize(&mut self) { + match self { + Ok(ref mut inner) => inner.finalize_or_skip(), + Err(ref mut inner) => inner.finalize_or_skip(), + } + } +} + unsafe impl Trace for Box where T: GcOrTrace, diff --git a/src/proc.rs b/src/proc.rs index f70bc78..11dc3ba 100644 --- a/src/proc.rs +++ b/src/proc.rs @@ -44,7 +44,7 @@ impl ValuesOrPreparedCall { } #[async_trait] -pub trait Callable: Send + Sync + 'static { +pub trait Callable: Send + Sync + 'static + std::fmt::Debug { fn min_args(&self) -> usize; fn max_args(&self) -> Option; @@ -62,7 +62,6 @@ pub struct Procedure { pub up: Gc, pub args: Vec, pub remaining: Option, - #[debug(skip)] pub body: Body, pub is_variable_transformer: bool, } diff --git a/src/stdlib.scm b/src/stdlib.scm index 8d9b78b..75acf30 100644 --- a/src/stdlib.scm +++ b/src/stdlib.scm @@ -325,3 +325,10 @@ '() (cons (apply function (map1 car lists)) (apply map function (map1 cdr lists)))))) + +(define (reverse ls) + (define (reverse ls acc) + (if (null? ls) + acc + (reverse (cdr ls) (cons (car ls) acc)))) + (reverse ls '())) diff --git a/src/value.rs b/src/value.rs index 4603698..2f5d629 100644 --- a/src/value.rs +++ b/src/value.rs @@ -52,13 +52,13 @@ impl Value { } } - pub fn as_callable(&self) -> Option> { + pub fn as_callable(&self) -> Option> { match self { // Having to clone and box these kind of sucks. Hopefully we can // fix this at some point - Self::Procedure(ref proc) => Some(Box::new(proc.clone())), - Self::ExternalFn(ref proc) => Some(Box::new(*proc)), - Self::Continuation(ref proc) => Some(Box::new(proc.clone())), + Self::Procedure(ref proc) => Some(Arc::new(proc.clone())), + Self::ExternalFn(ref proc) => Some(Arc::new(*proc)), + Self::Continuation(ref proc) => Some(Arc::new(proc.clone())), _ => None, } } diff --git a/tests/r6rs.scm b/tests/r6rs.scm index dc40de9..faef924 100644 --- a/tests/r6rs.scm +++ b/tests/r6rs.scm @@ -224,3 +224,56 @@ (set! ls (cons 'a ls)) (set! n (- n 1)))) '(a a a)) + +;; 11.15 Control features + +(assert-eq (let ((path '()) + (c #f)) + (let ((add (lambda (s) + (set! path (cons s path))))) + (dynamic-wind + (lambda () (add 'connect)) + (lambda () + (add (call-with-current-continuation + (lambda (c0) + (set! c c0) + 'talk1)))) + (lambda () (add 'disconnect))) + (if (< (length path) 4) + (c 'talk2) + (reverse path)))) + '(connect talk1 disconnect connect talk2 disconnect)) + +(assert-eq (let ((n 0)) + (call-with-current-continuation + (lambda (k) + (dynamic-wind + (lambda () + (set! n (+ n 1)) + (k)) + (lambda () + (set! n (+ n 2))) + (lambda () + (set! n (+ n 4)))))) + n) + 1) + +(define n 0) + +(dynamic-wind + (lambda () + (set! n (+ n 1)) + (call/cc (lambda (x) (set! h x)))) + (lambda () + (set! n (+ n 2)) + (dynamic-wind + (lambda () (set! n (+ n 3))) + (lambda () (call/cc (lambda (x) (set! g x)))) + (lambda () (set! n (+ n 5))))) + (lambda () (set! n (+ n 7)))) + +(g) +(h) + +(assert-eq n 49) ; 1 + 2 + 3 + 5 + 7 + (1 + 3 + 5 + 7) + (3 + 5 + 7) +