1use std::sync::Arc;
10
11use tatara_lisp::{
12 Atom, MacroDef, MacroParams, Span, Spanned, SpannedExpander, SpannedForm,
13};
14
15use crate::code::{spanned_to_value, value_to_spanned};
16use crate::env::Env;
17use crate::error::{EvalError, Result};
18use crate::ffi::{
19 Arity, Caller, FnEntry, FnImpl, FnRegistry, FromValue, HigherOrderCallable, IntoValue,
20 NativeCallable,
21};
22use crate::module::{Loader, Module, ModuleError, ModuleRegistry, NoLoader};
23use crate::special::SpecialForm;
24use crate::value::{Closure, ErrorObj, NativeFn, Value};
25
26pub const DEFAULT_MACRO_EXPANSION_LIMIT: usize = 256;
36
37pub struct Interpreter<H> {
38 pub(crate) registry: FnRegistry<H>,
39 pub(crate) globals: Env,
40 pub(crate) expander: SpannedExpander,
45 pub(crate) modules: ModuleRegistry,
49 pub(crate) loader: Arc<dyn Loader>,
52 pub(crate) macro_expansion_limit: usize,
59 pub(crate) current_module: Option<Arc<str>>,
64}
65
66impl<H: 'static> Interpreter<H> {
67 pub fn new() -> Self {
68 Self {
69 registry: FnRegistry::new(),
70 globals: Env::new(),
71 expander: SpannedExpander::new(),
72 modules: ModuleRegistry::new(),
73 loader: Arc::new(NoLoader),
74 macro_expansion_limit: DEFAULT_MACRO_EXPANSION_LIMIT,
75 current_module: None,
76 }
77 }
78
79 pub fn set_loader(&mut self, loader: Arc<dyn Loader>) {
82 self.loader = loader;
83 }
84
85 pub fn modules(&self) -> &ModuleRegistry {
87 &self.modules
88 }
89
90 pub fn register_fn<F>(&mut self, name: impl Into<Arc<str>>, arity: Arity, callable: F)
94 where
95 F: NativeCallable<H>,
96 {
97 let name = name.into();
98 self.registry.insert(FnEntry {
99 name: name.clone(),
100 arity,
101 callable: FnImpl::Native(Arc::new(callable)),
102 });
103 self.globals.define(
104 name.clone(),
105 Value::NativeFn(Arc::new(NativeFn { name, arity })),
106 );
107 }
108
109 pub fn register_higher_order_fn<F>(
114 &mut self,
115 name: impl Into<Arc<str>>,
116 arity: Arity,
117 callable: F,
118 ) where
119 F: HigherOrderCallable<H>,
120 {
121 let name = name.into();
122 self.registry.insert(FnEntry {
123 name: name.clone(),
124 arity,
125 callable: FnImpl::Higher(Arc::new(callable)),
126 });
127 self.globals.define(
128 name.clone(),
129 Value::NativeFn(Arc::new(NativeFn { name, arity })),
130 );
131 }
132
133 pub fn register_awaitable_fn<R, C>(
183 &mut self,
184 name: impl Into<Arc<str>>,
185 arity: Arity,
186 ready: R,
187 call: C,
188 ) where
189 R: Fn(&[Value], &H) -> bool + Send + Sync + 'static,
190 C: Fn(&[Value], &mut H, Span) -> Result<Value> + Send + Sync + 'static,
191 {
192 let name = name.into();
193 self.registry.insert(FnEntry {
194 name: name.clone(),
195 arity,
196 callable: FnImpl::Awaitable(Arc::new(crate::ffi::Awaitable { ready, call })),
197 });
198 self.globals.define(
199 name.clone(),
200 Value::NativeFn(Arc::new(NativeFn { name, arity })),
201 );
202 }
203
204 pub fn set_macro_expansion_limit(&mut self, limit: usize) {
209 self.macro_expansion_limit = limit;
210 }
211
212 pub fn eval_spanned(&mut self, form: &Spanned, host: &mut H) -> Result<Value> {
217 let expanded = self.fully_expand(form, host)?;
218 eval_in(
219 &mut self.globals,
220 &self.registry,
221 &self.expander,
222 &expanded,
223 host,
224 )
225 }
226
227 pub fn eval_program(&mut self, forms: &[Spanned], host: &mut H) -> Result<Value> {
239 let mut last = Value::Nil;
240 for form in forms {
241 last = self.eval_top_form(form, host)?;
242 }
243 Ok(last)
244 }
245
246 pub fn eval_top_form(&mut self, form: &Spanned, host: &mut H) -> Result<Value> {
252 if self.expander.try_register_macro(form)? {
253 return Ok(Value::Nil);
254 }
255 if let Some(head) = head_symbol(form) {
259 match head {
260 "provide" => return self.eval_provide(form, host),
261 "require" => return self.eval_require(form, host),
262 _ => {}
263 }
264 }
265 let expanded = self.fully_expand(form, host)?;
266 eval_in(
267 &mut self.globals,
268 &self.registry,
269 &self.expander,
270 &expanded,
271 host,
272 )
273 }
274
275 fn eval_provide(&mut self, form: &Spanned, _host: &mut H) -> Result<Value> {
279 let items = form.as_list().unwrap_or(&[]);
280 let span = form.span;
281 let Some(current) = self.current_module.clone() else {
282 return Err(EvalError::bad_form(
283 "provide",
284 "`provide` only valid at module top level — embedder evaluating top-level code has no current module",
285 span,
286 ));
287 };
288 let mut names: Vec<Arc<str>> = Vec::with_capacity(items.len().saturating_sub(1));
290 for item in &items[1..] {
291 let name = item.as_symbol().ok_or_else(|| {
292 EvalError::bad_form(
293 "provide",
294 "expected symbol — every arg must name a binding to export",
295 item.span,
296 )
297 })?;
298 names.push(Arc::<str>::from(name));
299 }
300 {
305 let mut g = self.modules.inner_lock();
306 g.exports_staging
310 .entry(current.to_string())
311 .or_default()
312 .extend(names.iter().cloned());
313 }
314 Ok(Value::Nil)
315 }
316
317 fn eval_require(&mut self, form: &Spanned, host: &mut H) -> Result<Value> {
326 let items = form.as_list().unwrap_or(&[]);
327 let span = form.span;
328 if items.len() < 2 {
329 return Err(EvalError::bad_form(
330 "require",
331 "expected (require \"path\" [:as alias] [:refer (...)])",
332 span,
333 ));
334 }
335 let path: Arc<str> = match items[1].as_string() {
336 Some(s) => Arc::from(s),
337 None => {
338 return Err(EvalError::bad_form(
339 "require",
340 "first arg must be a string path",
341 items[1].span,
342 ))
343 }
344 };
345
346 let mut alias: Option<Arc<str>> = None;
348 let mut refer: Option<Vec<Arc<str>>> = None;
349 let mut i = 2usize;
350 while i < items.len() {
351 let kw = items[i].as_keyword().ok_or_else(|| {
352 EvalError::bad_form(
353 "require",
354 "expected keyword (:as / :refer) after path",
355 items[i].span,
356 )
357 })?;
358 let val = items.get(i + 1).ok_or_else(|| {
359 EvalError::bad_form("require", "keyword without value", items[i].span)
360 })?;
361 match kw {
362 "as" => {
363 alias = Some(Arc::from(val.as_symbol().ok_or_else(|| {
364 EvalError::bad_form("require", ":as needs a symbol alias", val.span)
365 })?));
366 }
367 "refer" => {
368 let names_list = val.as_list().ok_or_else(|| {
369 EvalError::bad_form(
370 "require",
371 ":refer needs a parenthesized list of symbols",
372 val.span,
373 )
374 })?;
375 let mut names = Vec::with_capacity(names_list.len());
376 for n in names_list {
377 names.push(Arc::<str>::from(n.as_symbol().ok_or_else(|| {
378 EvalError::bad_form(
379 "require",
380 ":refer list must contain symbols only",
381 n.span,
382 )
383 })?));
384 }
385 refer = Some(names);
386 }
387 other => {
388 return Err(EvalError::bad_form(
389 "require",
390 format!("unknown require option :{other}"),
391 items[i].span,
392 ));
393 }
394 }
395 i += 2;
396 }
397
398 if !self.modules.has(&path) {
400 self.load_module(&path, span, host)?;
401 }
402 let module = self
403 .modules
404 .get(&path)
405 .ok_or_else(|| EvalError::native_fn("require", "module disappeared after load", span))?;
406
407 let chosen_alias = alias.unwrap_or_else(|| path.clone());
409 for name in &module.exports {
410 let value = module
411 .bindings
412 .get(name)
413 .cloned()
414 .unwrap_or(Value::Nil);
415 let qualified: Arc<str> = Arc::from(format!("{chosen_alias}/{name}"));
416 self.globals.define(qualified, value);
417 }
418 if let Some(names) = refer {
419 for name in names {
420 if let Some(value) = module.bindings.get(&name) {
421 if module.exports.contains(&name) {
422 self.globals.define(name.clone(), value.clone());
423 } else {
424 return Err(EvalError::User {
425 value: error_value("not-exported", &format!(
426 "{path} does not export {name}"
427 )),
428 at: span,
429 });
430 }
431 } else {
432 return Err(EvalError::User {
433 value: error_value("not-defined", &format!(
434 "{path} does not define {name}"
435 )),
436 at: span,
437 });
438 }
439 }
440 }
441 Ok(Value::Nil)
442 }
443
444 fn load_module(&mut self, path: &str, span: Span, host: &mut H) -> Result<()> {
450 self.modules
452 .begin_load(path)
453 .map_err(|e| module_error_to_eval(e, span))?;
454
455 let source = match self.loader.load(path) {
457 Ok(s) => s,
458 Err(e) => {
459 self.modules.abort_load(path);
460 return Err(module_error_to_eval(e, span));
461 }
462 };
463
464 let forms = match tatara_lisp::read_spanned(&source) {
466 Ok(f) => f,
467 Err(e) => {
468 self.modules.abort_load(path);
469 return Err(EvalError::Reader(e));
470 }
471 };
472
473 let saved_globals = std::mem::replace(&mut self.globals, Env::new());
477 for (name, value) in saved_globals.iter_top_level() {
481 if matches!(value, Value::NativeFn(_) | Value::Closure(_)) {
485 self.globals.define(name.clone(), value.clone());
486 }
487 }
488 let saved_current = self.current_module.replace(Arc::from(path));
489
490 let mut eval_err: Option<EvalError> = None;
492 for f in &forms {
493 if let Err(e) = self.eval_top_form(f, host) {
497 eval_err = Some(e);
498 break;
499 }
500 }
501
502 let module_globals = std::mem::replace(&mut self.globals, saved_globals);
504 self.current_module = saved_current;
505
506 if let Some(e) = eval_err {
507 self.modules.abort_load(path);
508 return Err(e);
509 }
510
511 let mut module = Module::new(path);
514 for (name, value) in module_globals.iter_top_level() {
515 if !matches!(value, Value::NativeFn(_)) {
518 module.define(name.clone(), value.clone());
519 }
520 }
521 let staged = {
523 let mut g = self.modules.inner_lock();
524 g.exports_staging
525 .remove(path)
526 .unwrap_or_default()
527 };
528 for n in staged {
529 module.add_export(n);
530 }
531 self.modules.finish_load(module);
532 Ok(())
533 }
534
535 pub fn fully_expand(&mut self, form: &Spanned, host: &mut H) -> Result<Spanned> {
546 if self.expander.is_empty() {
548 return Ok(form.clone());
549 }
550 self.expand_recursive(form, host)
551 }
552
553 fn expand_recursive(&mut self, form: &Spanned, host: &mut H) -> Result<Spanned> {
554 self.expand_at_depth(form, host, 0)
555 }
556
557 fn expand_at_depth(&mut self, form: &Spanned, host: &mut H, depth: usize) -> Result<Spanned> {
574 match &form.form {
575 SpannedForm::List(items) if !items.is_empty() => {
576 if let Some(head) = items[0].as_symbol() {
577 if self.expander.has(head) {
578 if depth >= self.macro_expansion_limit {
579 return Err(EvalError::MacroExpansionLimit {
584 macro_name: head.into(),
585 limit: self.macro_expansion_limit,
586 at: form.span,
587 });
588 }
589 let expanded =
593 self.expand_macro_call(head, &items[1..], form.span, host)?;
594 return self.expand_at_depth(&expanded, host, depth + 1);
595 }
596 }
597 let mut out = Vec::with_capacity(items.len());
601 for child in items {
602 out.push(self.expand_at_depth(child, host, depth)?);
603 }
604 Ok(Spanned::new(form.span, SpannedForm::List(out)))
605 }
606 SpannedForm::Quote(_) => {
607 Ok(form.clone())
609 }
610 SpannedForm::Quasiquote(inner) => {
611 Ok(Spanned::new(
613 form.span,
614 SpannedForm::Quasiquote(Box::new(self.expand_inside_quasiquote(inner, host)?)),
615 ))
616 }
617 _ => Ok(form.clone()),
619 }
620 }
621
622 fn expand_inside_quasiquote(&mut self, form: &Spanned, host: &mut H) -> Result<Spanned> {
623 match &form.form {
624 SpannedForm::Unquote(inner) => Ok(Spanned::new(
625 form.span,
626 SpannedForm::Unquote(Box::new(self.expand_recursive(inner, host)?)),
627 )),
628 SpannedForm::UnquoteSplice(inner) => Ok(Spanned::new(
629 form.span,
630 SpannedForm::UnquoteSplice(Box::new(self.expand_recursive(inner, host)?)),
631 )),
632 SpannedForm::List(items) => {
633 let mut out = Vec::with_capacity(items.len());
634 for item in items {
635 out.push(self.expand_inside_quasiquote(item, host)?);
636 }
637 Ok(Spanned::new(form.span, SpannedForm::List(out)))
638 }
639 _ => Ok(form.clone()),
640 }
641 }
642
643 fn expand_macro_call(
647 &mut self,
648 macro_name: &str,
649 args: &[Spanned],
650 call_span: Span,
651 host: &mut H,
652 ) -> Result<Spanned> {
653 let def: MacroDef = self
656 .expander
657 .get_macro(macro_name)
658 .cloned()
659 .ok_or_else(|| {
660 EvalError::native_fn(
661 Arc::<str>::from(macro_name),
662 "macro disappeared during expansion",
663 call_span,
664 )
665 })?;
666
667 let body_spanned = Spanned::from_sexp_at(&def.body, call_span);
672
673 let body_expanded = self.fully_expand(&body_spanned, host)?;
679
680 let mut macro_env = self.globals.sealed_below_top();
688 bind_macro_args(&mut macro_env, &def.name, &def.params, args, call_span)?;
689
690 let result = eval_in(
693 &mut macro_env,
694 &self.registry,
695 &self.expander,
696 &body_expanded,
697 host,
698 )?;
699
700 value_to_spanned(&result, call_span).map_err(|reason| {
704 EvalError::native_fn(
705 Arc::<str>::from(format!("macro {macro_name}")),
706 reason,
707 call_span,
708 )
709 })
710 }
711
712 pub fn expander(&self) -> &SpannedExpander {
715 &self.expander
716 }
717
718 pub fn expander_mut(&mut self) -> &mut SpannedExpander {
722 &mut self.expander
723 }
724
725 pub fn lookup_global(&self, name: &str) -> Option<Value> {
727 self.globals.lookup(name)
728 }
729
730 pub fn define_global(&mut self, name: impl Into<Arc<str>>, value: Value) {
732 self.globals.define(name, value);
733 }
734
735 pub fn globals_snapshot(&self) -> &Env {
738 &self.globals
739 }
740
741 pub fn apply_external_value(
745 &mut self,
746 callee: &Value,
747 args: Vec<Value>,
748 host: &mut H,
749 call_span: Span,
750 ) -> Result<Value> {
751 apply_external(callee, args, call_span, &self.registry, &self.expander, host)
752 }
753
754 pub fn eval_program_vm(&mut self, forms: &[Spanned], host: &mut H) -> Result<Value> {
761 let mut expanded: Vec<Spanned> = Vec::with_capacity(forms.len());
762 for form in forms {
763 if self.expander.try_register_macro(form)? {
764 continue;
765 }
766 expanded.push(self.fully_expand(form, host)?);
767 }
768 let chunk = crate::vm::compile_program(&expanded).map_err(|e| match e {
769 crate::vm::CompileError::Bad { at, message } => {
770 EvalError::bad_form(Arc::<str>::from("vm:compile"), message, at)
771 }
772 })?;
773 let mut vm = crate::vm::Vm::new();
774 vm.run(&chunk, self, host).map_err(|e| match e {
775 crate::vm::VmError::Eval(inner) => inner,
776 other => EvalError::native_fn(Arc::<str>::from("vm"), format!("{other}"), Span::synthetic()),
777 })
778 }
779
780 pub fn register_typed0<R, F>(&mut self, name: impl Into<Arc<str>>, f: F)
784 where
785 R: IntoValue + 'static,
786 F: Fn(&mut H) -> Result<R> + Send + Sync + 'static,
787 {
788 self.register_fn(
789 name,
790 Arity::Exact(0),
791 move |_args: &[Value], host: &mut H, _sp| f(host).map(IntoValue::into_value),
792 );
793 }
794
795 pub fn register_typed1<A, R, F>(&mut self, name: impl Into<Arc<str>>, f: F)
797 where
798 A: FromValue + 'static,
799 R: IntoValue + 'static,
800 F: Fn(&mut H, A) -> Result<R> + Send + Sync + 'static,
801 {
802 self.register_fn(
803 name,
804 Arity::Exact(1),
805 move |args: &[Value], host: &mut H, sp| {
806 let a = A::from_value(&args[0], sp)?;
807 f(host, a).map(IntoValue::into_value)
808 },
809 );
810 }
811
812 pub fn register_typed2<A, B, R, F>(&mut self, name: impl Into<Arc<str>>, f: F)
814 where
815 A: FromValue + 'static,
816 B: FromValue + 'static,
817 R: IntoValue + 'static,
818 F: Fn(&mut H, A, B) -> Result<R> + Send + Sync + 'static,
819 {
820 self.register_fn(
821 name,
822 Arity::Exact(2),
823 move |args: &[Value], host: &mut H, sp| {
824 let a = A::from_value(&args[0], sp)?;
825 let b = B::from_value(&args[1], sp)?;
826 f(host, a, b).map(IntoValue::into_value)
827 },
828 );
829 }
830
831 pub fn register_typed3<A, B, C, R, F>(&mut self, name: impl Into<Arc<str>>, f: F)
833 where
834 A: FromValue + 'static,
835 B: FromValue + 'static,
836 C: FromValue + 'static,
837 R: IntoValue + 'static,
838 F: Fn(&mut H, A, B, C) -> Result<R> + Send + Sync + 'static,
839 {
840 self.register_fn(
841 name,
842 Arity::Exact(3),
843 move |args: &[Value], host: &mut H, sp| {
844 let a = A::from_value(&args[0], sp)?;
845 let b = B::from_value(&args[1], sp)?;
846 let c = C::from_value(&args[2], sp)?;
847 f(host, a, b, c).map(IntoValue::into_value)
848 },
849 );
850 }
851
852 pub fn register_typed4<A, B, C, D, R, F>(&mut self, name: impl Into<Arc<str>>, f: F)
854 where
855 A: FromValue + 'static,
856 B: FromValue + 'static,
857 C: FromValue + 'static,
858 D: FromValue + 'static,
859 R: IntoValue + 'static,
860 F: Fn(&mut H, A, B, C, D) -> Result<R> + Send + Sync + 'static,
861 {
862 self.register_fn(
863 name,
864 Arity::Exact(4),
865 move |args: &[Value], host: &mut H, sp| {
866 let a = A::from_value(&args[0], sp)?;
867 let b = B::from_value(&args[1], sp)?;
868 let c = C::from_value(&args[2], sp)?;
869 let d = D::from_value(&args[3], sp)?;
870 f(host, a, b, c, d).map(IntoValue::into_value)
871 },
872 );
873 }
874}
875
876impl<H: 'static> Default for Interpreter<H> {
877 fn default() -> Self {
878 Self::new()
879 }
880}
881
882pub(crate) fn eval_in<H: 'static>(
887 env: &mut Env,
888 registry: &FnRegistry<H>,
889 expander: &SpannedExpander,
890 form: &Spanned,
891 host: &mut H,
892) -> Result<Value> {
893 match &form.form {
894 SpannedForm::Nil => Ok(Value::Nil),
895 SpannedForm::Atom(a) => eval_atom(a, form.span, env),
896 SpannedForm::Quote(inner) => Ok(quoted_value(inner)),
897 SpannedForm::Quasiquote(inner) => quasiquote_eval(inner, env, registry, expander, host),
898 SpannedForm::Unquote(_) | SpannedForm::UnquoteSplice(_) => Err(EvalError::bad_form(
899 "unquote",
900 "unquote outside of quasiquote",
901 form.span,
902 )),
903 SpannedForm::List(items) => {
904 if items.is_empty() {
905 return Ok(Value::Nil);
906 }
907 if let Some(head_sym) = items[0].as_symbol() {
911 if let Some(sf) = SpecialForm::from_symbol(head_sym) {
912 return eval_special(sf, items, form.span, env, registry, expander, host);
913 }
914 }
915 eval_application(items, form.span, env, registry, expander, host)
916 }
917 }
918}
919
920fn eval_atom(a: &Atom, span: Span, env: &Env) -> Result<Value> {
921 match a {
922 Atom::Symbol(name) => env
923 .lookup(name)
924 .ok_or_else(|| EvalError::unbound(name.as_str(), span)),
925 Atom::Keyword(s) => Ok(Value::Keyword(crate::interner::intern(s.as_str()))),
926 Atom::Str(s) => Ok(Value::Str(Arc::from(s.as_str()))),
927 Atom::Int(n) => Ok(Value::Int(*n)),
928 Atom::Float(n) => Ok(Value::Float(*n)),
929 Atom::Bool(b) => Ok(Value::Bool(*b)),
930 }
931}
932
933fn quoted_value(inner: &Spanned) -> Value {
937 crate::code::spanned_to_value(inner)
938}
939
940fn quasiquote_eval<H: 'static>(
946 form: &Spanned,
947 env: &mut Env,
948 registry: &FnRegistry<H>,
949 expander: &SpannedExpander,
950 host: &mut H,
951) -> Result<Value> {
952 match &form.form {
953 SpannedForm::Unquote(inner) => eval_in(env, registry, expander, inner, host),
954 SpannedForm::UnquoteSplice(_) => Err(EvalError::bad_form(
955 "unquote-splice",
956 "`,@` only valid directly inside a list",
957 form.span,
958 )),
959 SpannedForm::List(items) => {
960 let mut out: Vec<Value> = Vec::with_capacity(items.len());
961 for item in items {
962 if let SpannedForm::UnquoteSplice(inner) = &item.form {
963 let v = eval_in(env, registry, expander, inner, host)?;
964 match v {
965 Value::List(xs) => out.extend(xs.iter().cloned()),
966 Value::Nil => {}
967 other => {
968 return Err(EvalError::type_mismatch(
969 "list",
970 other.type_name(),
971 item.span,
972 ))
973 }
974 }
975 } else {
976 out.push(quasiquote_eval(item, env, registry, expander, host)?);
977 }
978 }
979 if out.is_empty() {
980 Ok(Value::Nil)
981 } else {
982 Ok(Value::list(out))
983 }
984 }
985 SpannedForm::Nil => Ok(Value::Nil),
986 SpannedForm::Atom(a) => Ok(match a {
987 Atom::Symbol(s) => Value::Symbol(crate::interner::intern(s.as_str())),
988 Atom::Keyword(s) => Value::Keyword(crate::interner::intern(s.as_str())),
989 Atom::Str(s) => Value::Str(Arc::from(s.as_str())),
990 Atom::Int(n) => Value::Int(*n),
991 Atom::Float(n) => Value::Float(*n),
992 Atom::Bool(b) => Value::Bool(*b),
993 }),
994 SpannedForm::Quote(_) | SpannedForm::Quasiquote(_) => {
998 Ok(Value::Sexp(form.to_sexp(), form.span))
999 }
1000 }
1001}
1002
1003fn eval_application<H: 'static>(
1006 items: &[Spanned],
1007 call_span: Span,
1008 env: &mut Env,
1009 registry: &FnRegistry<H>,
1010 expander: &SpannedExpander,
1011 host: &mut H,
1012) -> Result<Value> {
1013 let head_val = eval_in(env, registry, expander, &items[0], host)?;
1014 let mut args: Vec<Value> = Vec::with_capacity(items.len().saturating_sub(1));
1015 for arg_form in &items[1..] {
1016 args.push(eval_in(env, registry, expander, arg_form, host)?);
1017 }
1018 apply(&head_val, args, call_span, registry, expander, host)
1019}
1020
1021fn apply<H: 'static>(
1022 callee: &Value,
1023 args: Vec<Value>,
1024 call_span: Span,
1025 registry: &FnRegistry<H>,
1026 expander: &SpannedExpander,
1027 host: &mut H,
1028) -> Result<Value> {
1029 match callee {
1030 Value::NativeFn(nfn) => {
1031 if nfn.arity.check(args.len()).is_err() {
1032 return Err(EvalError::ArityMismatch {
1033 fn_name: nfn.name.clone(),
1034 expected: nfn.arity,
1035 got: args.len(),
1036 at: call_span,
1037 });
1038 }
1039 let entry = registry.lookup(&nfn.name).ok_or_else(|| {
1040 EvalError::native_fn(
1041 nfn.name.clone(),
1042 format!("native fn {} is not registered", nfn.name),
1043 call_span,
1044 )
1045 })?;
1046 match &entry.callable {
1047 FnImpl::Native(f) => f.call(&args, host, call_span),
1048 FnImpl::Higher(f) => {
1049 let caller = Caller { registry, expander };
1050 f.call(&args, host, &caller, call_span)
1051 }
1052 FnImpl::Awaitable(f) => {
1057 if f.ready(&args, host) {
1058 f.call(&args, host, call_span)
1059 } else {
1060 Ok(crate::vm::Vm::park())
1061 }
1062 }
1063 }
1064 }
1065 Value::Closure(c) => call_closure(c.clone(), args, call_span, registry, expander, host),
1066 Value::Foreign(any) => {
1071 if let Some(cc) = any
1072 .clone()
1073 .downcast::<crate::vm::run::CompiledClosure>()
1074 .ok()
1075 {
1076 let lifted = cc.lift_to_closure();
1077 return call_closure(lifted, args, call_span, registry, expander, host);
1078 }
1079 Err(EvalError::NotCallable {
1080 value_kind: callee.type_name(),
1081 at: call_span,
1082 })
1083 }
1084 other => Err(EvalError::NotCallable {
1085 value_kind: other.type_name(),
1086 at: call_span,
1087 }),
1088 }
1089}
1090
1091enum TailResult {
1114 Done(Value),
1116 Resume(Arc<Closure>, Vec<Value>, Span),
1121}
1122
1123fn eval_in_tail<H: 'static>(
1127 env: &mut Env,
1128 registry: &FnRegistry<H>,
1129 expander: &SpannedExpander,
1130 form: &Spanned,
1131 host: &mut H,
1132) -> Result<TailResult> {
1133 match &form.form {
1134 SpannedForm::List(items) if !items.is_empty() => {
1135 if let Some(head_sym) = items[0].as_symbol() {
1137 if let Some(sf) = SpecialForm::from_symbol(head_sym) {
1138 return eval_special_tail(sf, items, form.span, env, registry, expander, host);
1139 }
1140 }
1141 let head_val = eval_in(env, registry, expander, &items[0], host)?;
1144 let mut args: Vec<Value> = Vec::with_capacity(items.len().saturating_sub(1));
1145 for arg_form in &items[1..] {
1146 args.push(eval_in(env, registry, expander, arg_form, host)?);
1147 }
1148 match head_val {
1149 Value::Closure(c) => Ok(TailResult::Resume(c, args, form.span)),
1150 _ => apply(&head_val, args, form.span, registry, expander, host)
1151 .map(TailResult::Done),
1152 }
1153 }
1154 _ => eval_in(env, registry, expander, form, host).map(TailResult::Done),
1156 }
1157}
1158
1159fn eval_special_tail<H: 'static>(
1160 sf: SpecialForm,
1161 items: &[Spanned],
1162 call_span: Span,
1163 env: &mut Env,
1164 registry: &FnRegistry<H>,
1165 expander: &SpannedExpander,
1166 host: &mut H,
1167) -> Result<TailResult> {
1168 match sf {
1169 SpecialForm::If => {
1170 if items.len() < 3 || items.len() > 4 {
1171 return eval_special(sf, items, call_span, env, registry, expander, host)
1172 .map(TailResult::Done);
1173 }
1174 let c = eval_in(env, registry, expander, &items[1], host)?;
1175 if c.is_truthy() {
1176 eval_in_tail(env, registry, expander, &items[2], host)
1177 } else if items.len() == 4 {
1178 eval_in_tail(env, registry, expander, &items[3], host)
1179 } else {
1180 Ok(TailResult::Done(Value::Nil))
1181 }
1182 }
1183 SpecialForm::Begin => {
1184 let body = &items[1..];
1185 if body.is_empty() {
1186 return Ok(TailResult::Done(Value::Nil));
1187 }
1188 for form in &body[..body.len() - 1] {
1189 eval_in(env, registry, expander, form, host)?;
1190 }
1191 eval_in_tail(env, registry, expander, body.last().unwrap(), host)
1192 }
1193 SpecialForm::When | SpecialForm::Unless => {
1194 if items.len() < 2 {
1195 return eval_special(sf, items, call_span, env, registry, expander, host)
1196 .map(TailResult::Done);
1197 }
1198 let invert = matches!(sf, SpecialForm::Unless);
1199 let cond = eval_in(env, registry, expander, &items[1], host)?;
1200 let run = cond.is_truthy() ^ invert;
1201 if !run {
1202 return Ok(TailResult::Done(Value::Nil));
1203 }
1204 let body = &items[2..];
1205 if body.is_empty() {
1206 return Ok(TailResult::Done(Value::Nil));
1207 }
1208 for form in &body[..body.len() - 1] {
1209 eval_in(env, registry, expander, form, host)?;
1210 }
1211 eval_in_tail(env, registry, expander, body.last().unwrap(), host)
1212 }
1213 SpecialForm::Cond => {
1214 for clause in &items[1..] {
1215 let Some(clause_list) = clause.as_list() else {
1216 return eval_special(sf, items, call_span, env, registry, expander, host)
1217 .map(TailResult::Done);
1218 };
1219 if clause_list.is_empty() {
1220 return eval_special(sf, items, call_span, env, registry, expander, host)
1221 .map(TailResult::Done);
1222 }
1223 let is_else = clause_list[0].as_symbol() == Some("else");
1224 let cond_matches = if is_else {
1225 true
1226 } else {
1227 eval_in(env, registry, expander, &clause_list[0], host)?.is_truthy()
1228 };
1229 if cond_matches {
1230 let body = &clause_list[1..];
1231 if body.is_empty() {
1232 return Ok(TailResult::Done(Value::Nil));
1233 }
1234 for form in &body[..body.len() - 1] {
1235 eval_in(env, registry, expander, form, host)?;
1236 }
1237 return eval_in_tail(env, registry, expander, body.last().unwrap(), host);
1238 }
1239 }
1240 Ok(TailResult::Done(Value::Nil))
1241 }
1242 SpecialForm::Let | SpecialForm::LetStar | SpecialForm::LetRec => {
1243 eval_let_family_tail(sf, items, call_span, env, registry, expander, host)
1244 }
1245 SpecialForm::And => {
1246 let exprs = &items[1..];
1247 if exprs.is_empty() {
1248 return Ok(TailResult::Done(Value::Bool(true)));
1249 }
1250 for e in &exprs[..exprs.len() - 1] {
1252 let v = eval_in(env, registry, expander, e, host)?;
1253 if !v.is_truthy() {
1254 return Ok(TailResult::Done(v));
1255 }
1256 }
1257 eval_in_tail(env, registry, expander, exprs.last().unwrap(), host)
1259 }
1260 SpecialForm::Or => {
1261 let exprs = &items[1..];
1262 if exprs.is_empty() {
1263 return Ok(TailResult::Done(Value::Bool(false)));
1264 }
1265 for e in &exprs[..exprs.len() - 1] {
1266 let v = eval_in(env, registry, expander, e, host)?;
1267 if v.is_truthy() {
1268 return Ok(TailResult::Done(v));
1269 }
1270 }
1271 eval_in_tail(env, registry, expander, exprs.last().unwrap(), host)
1272 }
1273 SpecialForm::Try => {
1274 sf_try(items, call_span, env, registry, expander, host).map(TailResult::Done)
1280 }
1281 SpecialForm::MacroexpandOne => {
1282 sf_macroexpand(items, call_span, env, registry, expander, host, false)
1283 .map(TailResult::Done)
1284 }
1285 SpecialForm::MacroexpandAll => {
1286 sf_macroexpand(items, call_span, env, registry, expander, host, true)
1287 .map(TailResult::Done)
1288 }
1289 SpecialForm::Delay => sf_delay(items, call_span, env).map(TailResult::Done),
1290 SpecialForm::Eval => {
1291 sf_eval(items, call_span, env, registry, expander, host).map(TailResult::Done)
1292 }
1293 _ => {
1295 eval_special(sf, items, call_span, env, registry, expander, host).map(TailResult::Done)
1296 }
1297 }
1298}
1299
1300fn eval_let_family_tail<H: 'static>(
1304 sf: SpecialForm,
1305 items: &[Spanned],
1306 call_span: Span,
1307 env: &mut Env,
1308 registry: &FnRegistry<H>,
1309 expander: &SpannedExpander,
1310 host: &mut H,
1311) -> Result<TailResult> {
1312 if items.len() < 3 {
1313 return Err(EvalError::bad_form(
1314 match sf {
1315 SpecialForm::Let => "let",
1316 SpecialForm::LetStar => "let*",
1317 SpecialForm::LetRec => "letrec",
1318 _ => "let-family",
1319 },
1320 "expected ((name expr)...) body...",
1321 call_span,
1322 ));
1323 }
1324 let bindings = parse_binding_list(
1325 &items[1],
1326 match sf {
1327 SpecialForm::Let => "let",
1328 SpecialForm::LetStar => "let*",
1329 SpecialForm::LetRec => "letrec",
1330 _ => "let-family",
1331 },
1332 )?;
1333
1334 match sf {
1335 SpecialForm::Let => {
1336 let mut values = Vec::with_capacity(bindings.len());
1337 for (_, expr) in &bindings {
1338 values.push(eval_in(env, registry, expander, expr, host)?);
1339 }
1340 env.push();
1341 for ((name, _), val) in bindings.into_iter().zip(values) {
1342 env.define(name, val);
1343 }
1344 }
1345 SpecialForm::LetStar => {
1346 env.push();
1347 for (name, expr) in bindings {
1348 let v = eval_in(env, registry, expander, expr, host)?;
1349 env.define(name, v);
1350 }
1351 }
1352 SpecialForm::LetRec => {
1353 env.push();
1354 for (name, _) in &bindings {
1355 env.define(name.clone(), Value::Nil);
1356 }
1357 for (name, expr) in &bindings {
1358 let v = eval_in(env, registry, expander, expr, host)?;
1359 env.define(name.clone(), v);
1360 }
1361 }
1362 _ => unreachable!(),
1363 }
1364
1365 let body = &items[2..];
1366 let result = if body.is_empty() {
1367 Ok(TailResult::Done(Value::Nil))
1368 } else {
1369 for form in &body[..body.len() - 1] {
1370 if let Err(e) = eval_in(env, registry, expander, form, host) {
1371 env.pop();
1372 return Err(e);
1373 }
1374 }
1375 eval_in_tail(env, registry, expander, body.last().unwrap(), host)
1376 };
1377 env.pop();
1378 result
1379}
1380
1381pub(crate) fn apply_external<H: 'static>(
1387 callee: &Value,
1388 args: Vec<Value>,
1389 call_span: Span,
1390 registry: &FnRegistry<H>,
1391 expander: &SpannedExpander,
1392 host: &mut H,
1393) -> Result<Value> {
1394 apply(callee, args, call_span, registry, expander, host)
1395}
1396
1397fn bind_macro_args(
1406 env: &mut Env,
1407 macro_name: &str,
1408 params: &MacroParams,
1409 args: &[Spanned],
1410 call_span: Span,
1411) -> Result<()> {
1412 let bound = params
1413 .bind_carrier(macro_name, args, call_span)
1414 .map_err(|e| {
1415 EvalError::native_fn(
1416 Arc::<str>::from(format!("macro {macro_name}")),
1417 e.to_string(),
1418 call_span,
1419 )
1420 })?;
1421 for (name, value) in params.names().into_iter().zip(bound.iter()) {
1422 env.define(Arc::<str>::from(name), spanned_to_value(value));
1423 }
1424 Ok(())
1425}
1426
1427fn call_closure<H: 'static>(
1432 closure: Arc<Closure>,
1433 args: Vec<Value>,
1434 call_span: Span,
1435 registry: &FnRegistry<H>,
1436 expander: &SpannedExpander,
1437 host: &mut H,
1438) -> Result<Value> {
1439 let mut current = closure;
1440 let mut current_args = args;
1441 let mut current_span = call_span;
1442 loop {
1443 let required = current.params.len();
1445 let has_rest = current.rest.is_some();
1446 if !has_rest && current_args.len() != required {
1447 return Err(EvalError::ArityMismatch {
1448 fn_name: Arc::from("<closure>"),
1449 expected: Arity::Exact(required),
1450 got: current_args.len(),
1451 at: current_span,
1452 });
1453 }
1454 if has_rest && current_args.len() < required {
1455 return Err(EvalError::ArityMismatch {
1456 fn_name: Arc::from("<closure>"),
1457 expected: Arity::AtLeast(required),
1458 got: current_args.len(),
1459 at: current_span,
1460 });
1461 }
1462
1463 let mut env = current.captured_env.clone();
1466 env.push();
1467 for (param, arg) in current.params.iter().zip(current_args.iter()) {
1468 env.define(param.clone(), arg.clone());
1469 }
1470 if let Some(rest_name) = ¤t.rest {
1471 let rest_args: Vec<Value> = current_args.iter().skip(required).cloned().collect();
1472 env.define(rest_name.clone(), Value::list(rest_args));
1473 }
1474
1475 let body = ¤t.body;
1478 if body.is_empty() {
1479 return Ok(Value::Nil);
1480 }
1481 for body_form in &body[..body.len() - 1] {
1482 eval_in(&mut env, registry, expander, body_form, host)?;
1483 }
1484 match eval_in_tail(&mut env, registry, expander, body.last().unwrap(), host)? {
1485 TailResult::Done(v) => return Ok(v),
1486 TailResult::Resume(next, next_args, next_span) => {
1487 current = next;
1490 current_args = next_args;
1491 current_span = next_span;
1492 }
1493 }
1494 }
1495}
1496
1497fn eval_special<H: 'static>(
1500 sf: SpecialForm,
1501 items: &[Spanned],
1502 call_span: Span,
1503 env: &mut Env,
1504 registry: &FnRegistry<H>,
1505 expander: &SpannedExpander,
1506 host: &mut H,
1507) -> Result<Value> {
1508 match sf {
1509 SpecialForm::Quote => sf_quote(items, call_span),
1510 SpecialForm::Quasiquote => {
1511 if items.len() != 2 {
1512 return Err(EvalError::bad_form(
1513 "quasiquote",
1514 format!("expected 1 arg, got {}", items.len() - 1),
1515 call_span,
1516 ));
1517 }
1518 quasiquote_eval(&items[1], env, registry, expander, host)
1519 }
1520 SpecialForm::If => sf_if(items, call_span, env, registry, expander, host),
1521 SpecialForm::Cond => sf_cond(items, call_span, env, registry, expander, host),
1522 SpecialForm::When => sf_when_unless(items, call_span, env, registry, expander, host, false),
1523 SpecialForm::Unless => {
1524 sf_when_unless(items, call_span, env, registry, expander, host, true)
1525 }
1526 SpecialForm::Let => sf_let(items, call_span, env, registry, expander, host),
1527 SpecialForm::LetStar => sf_let_star(items, call_span, env, registry, expander, host),
1528 SpecialForm::LetRec => sf_letrec(items, call_span, env, registry, expander, host),
1529 SpecialForm::Lambda => sf_lambda(items, call_span, env),
1530 SpecialForm::Define => sf_define(items, call_span, env, registry, expander, host),
1531 SpecialForm::Set => sf_set(items, call_span, env, registry, expander, host),
1532 SpecialForm::Begin => sf_begin(&items[1..], env, registry, expander, host),
1533 SpecialForm::And => sf_and(&items[1..], env, registry, expander, host),
1534 SpecialForm::Or => sf_or(&items[1..], env, registry, expander, host),
1535 SpecialForm::Not => sf_not(items, call_span, env, registry, expander, host),
1536 SpecialForm::Try => sf_try(items, call_span, env, registry, expander, host),
1537 SpecialForm::MacroexpandOne => {
1538 sf_macroexpand(items, call_span, env, registry, expander, host, false)
1539 }
1540 SpecialForm::MacroexpandAll => {
1541 sf_macroexpand(items, call_span, env, registry, expander, host, true)
1542 }
1543 SpecialForm::Delay => sf_delay(items, call_span, env),
1544 SpecialForm::Eval => sf_eval(items, call_span, env, registry, expander, host),
1545 SpecialForm::Provide | SpecialForm::Require => Err(EvalError::bad_form(
1546 if matches!(sf, SpecialForm::Provide) { "provide" } else { "require" },
1547 "module-system forms are only valid at top level — wrap your call in (eval (quote ...)) if you really need it dynamic",
1548 call_span,
1549 )),
1550 }
1551}
1552
1553fn head_symbol(form: &Spanned) -> Option<&str> {
1557 let SpannedForm::List(items) = &form.form else {
1558 return None;
1559 };
1560 items.first().and_then(Spanned::as_symbol)
1561}
1562
1563fn error_value(tag: &str, message: &str) -> Value {
1565 Value::Error(Arc::new(ErrorObj {
1566 tag: Arc::from(tag),
1567 message: Arc::from(message),
1568 data: Vec::new(),
1569 }))
1570}
1571
1572fn module_error_to_eval(e: ModuleError, span: Span) -> EvalError {
1576 let (tag, message) = match &e {
1577 ModuleError::NotFound(_) => ("module-not-found", e.to_string()),
1578 ModuleError::Circular { .. } => ("circular-require", e.to_string()),
1579 ModuleError::NotExported(_, _) => ("not-exported", e.to_string()),
1580 };
1581 EvalError::User {
1582 value: error_value(tag, &message),
1583 at: span,
1584 }
1585}
1586
1587fn sf_quote(items: &[Spanned], span: Span) -> Result<Value> {
1588 if items.len() != 2 {
1589 return Err(EvalError::bad_form(
1590 "quote",
1591 format!("expected 1 arg, got {}", items.len() - 1),
1592 span,
1593 ));
1594 }
1595 Ok(crate::code::spanned_to_value(&items[1]))
1601}
1602
1603fn sf_if<H: 'static>(
1604 items: &[Spanned],
1605 span: Span,
1606 env: &mut Env,
1607 registry: &FnRegistry<H>,
1608 expander: &SpannedExpander,
1609 host: &mut H,
1610) -> Result<Value> {
1611 if items.len() < 3 || items.len() > 4 {
1612 return Err(EvalError::bad_form(
1613 "if",
1614 format!("expected (if c t [e]), got {} subforms", items.len()),
1615 span,
1616 ));
1617 }
1618 let c = eval_in(env, registry, expander, &items[1], host)?;
1619 if c.is_truthy() {
1620 eval_in(env, registry, expander, &items[2], host)
1621 } else if items.len() == 4 {
1622 eval_in(env, registry, expander, &items[3], host)
1623 } else {
1624 Ok(Value::Nil)
1625 }
1626}
1627
1628fn sf_cond<H: 'static>(
1629 items: &[Spanned],
1630 span: Span,
1631 env: &mut Env,
1632 registry: &FnRegistry<H>,
1633 expander: &SpannedExpander,
1634 host: &mut H,
1635) -> Result<Value> {
1636 for clause in &items[1..] {
1637 let Some(clause_list) = clause.as_list() else {
1638 return Err(EvalError::bad_form(
1639 "cond",
1640 "clause must be a list",
1641 clause.span,
1642 ));
1643 };
1644 if clause_list.is_empty() {
1645 return Err(EvalError::bad_form("cond", "empty clause", clause.span));
1646 }
1647 let is_else = clause_list[0].as_symbol() == Some("else");
1648 let cond_matches = if is_else {
1649 true
1650 } else {
1651 let v = eval_in(env, registry, expander, &clause_list[0], host)?;
1652 v.is_truthy()
1653 };
1654 if cond_matches {
1655 let mut last = Value::Nil;
1656 for expr in &clause_list[1..] {
1657 last = eval_in(env, registry, expander, expr, host)?;
1658 }
1659 return Ok(last);
1660 }
1661 }
1662 let _ = span;
1664 Ok(Value::Nil)
1665}
1666
1667fn sf_when_unless<H: 'static>(
1668 items: &[Spanned],
1669 span: Span,
1670 env: &mut Env,
1671 registry: &FnRegistry<H>,
1672 expander: &SpannedExpander,
1673 host: &mut H,
1674 invert: bool,
1675) -> Result<Value> {
1676 if items.len() < 2 {
1677 return Err(EvalError::bad_form(
1678 if invert { "unless" } else { "when" },
1679 "need a test",
1680 span,
1681 ));
1682 }
1683 let cond = eval_in(env, registry, expander, &items[1], host)?;
1684 let run = cond.is_truthy() ^ invert;
1685 if run {
1686 let mut last = Value::Nil;
1687 for expr in &items[2..] {
1688 last = eval_in(env, registry, expander, expr, host)?;
1689 }
1690 Ok(last)
1691 } else {
1692 Ok(Value::Nil)
1693 }
1694}
1695
1696fn parse_binding_list<'a>(
1698 list: &'a Spanned,
1699 form_name: &'static str,
1700) -> Result<Vec<(Arc<str>, &'a Spanned)>> {
1701 let bindings = list
1702 .as_list()
1703 .ok_or_else(|| EvalError::bad_form(form_name, "bindings must be a list", list.span))?;
1704 let mut out = Vec::with_capacity(bindings.len());
1705 for binding in bindings {
1706 let pair = binding.as_list().ok_or_else(|| {
1707 EvalError::bad_form(form_name, "each binding must be (name expr)", binding.span)
1708 })?;
1709 if pair.len() != 2 {
1710 return Err(EvalError::bad_form(
1711 form_name,
1712 "binding must be exactly (name expr)",
1713 binding.span,
1714 ));
1715 }
1716 let name = pair[0].as_symbol().ok_or_else(|| {
1717 EvalError::bad_form(form_name, "binding name must be a symbol", pair[0].span)
1718 })?;
1719 out.push((Arc::<str>::from(name), &pair[1]));
1720 }
1721 Ok(out)
1722}
1723
1724fn sf_let<H: 'static>(
1725 items: &[Spanned],
1726 span: Span,
1727 env: &mut Env,
1728 registry: &FnRegistry<H>,
1729 expander: &SpannedExpander,
1730 host: &mut H,
1731) -> Result<Value> {
1732 if items.len() < 3 {
1733 return Err(EvalError::bad_form(
1734 "let",
1735 "expected (let ((name expr)...) body...)",
1736 span,
1737 ));
1738 }
1739 let bindings = parse_binding_list(&items[1], "let")?;
1740 let mut values = Vec::with_capacity(bindings.len());
1743 for (_, expr) in &bindings {
1744 values.push(eval_in(env, registry, expander, expr, host)?);
1745 }
1746 env.push();
1747 for ((name, _), val) in bindings.into_iter().zip(values) {
1748 env.define(name, val);
1749 }
1750 let result = eval_body(&items[2..], env, registry, expander, host);
1751 env.pop();
1752 result
1753}
1754
1755fn sf_let_star<H: 'static>(
1756 items: &[Spanned],
1757 span: Span,
1758 env: &mut Env,
1759 registry: &FnRegistry<H>,
1760 expander: &SpannedExpander,
1761 host: &mut H,
1762) -> Result<Value> {
1763 if items.len() < 3 {
1764 return Err(EvalError::bad_form(
1765 "let*",
1766 "expected (let* ((name expr)...) body...)",
1767 span,
1768 ));
1769 }
1770 let bindings = parse_binding_list(&items[1], "let*")?;
1771 env.push();
1772 for (name, expr) in bindings {
1773 let v = eval_in(env, registry, expander, expr, host)?;
1774 env.define(name, v);
1775 }
1776 let result = eval_body(&items[2..], env, registry, expander, host);
1777 env.pop();
1778 result
1779}
1780
1781fn sf_letrec<H: 'static>(
1782 items: &[Spanned],
1783 span: Span,
1784 env: &mut Env,
1785 registry: &FnRegistry<H>,
1786 expander: &SpannedExpander,
1787 host: &mut H,
1788) -> Result<Value> {
1789 if items.len() < 3 {
1790 return Err(EvalError::bad_form(
1791 "letrec",
1792 "expected (letrec ((name expr)...) body...)",
1793 span,
1794 ));
1795 }
1796 let bindings = parse_binding_list(&items[1], "letrec")?;
1797 env.push();
1798 for (name, _) in &bindings {
1801 env.define(name.clone(), Value::Nil);
1802 }
1803 for (name, expr) in &bindings {
1804 let v = eval_in(env, registry, expander, expr, host)?;
1805 env.define(name.clone(), v);
1806 }
1807 let result = eval_body(&items[2..], env, registry, expander, host);
1808 env.pop();
1809 result
1810}
1811
1812fn eval_body<H: 'static>(
1813 body: &[Spanned],
1814 env: &mut Env,
1815 registry: &FnRegistry<H>,
1816 expander: &SpannedExpander,
1817 host: &mut H,
1818) -> Result<Value> {
1819 let mut last = Value::Nil;
1820 for form in body {
1821 last = eval_in(env, registry, expander, form, host)?;
1822 }
1823 Ok(last)
1824}
1825
1826fn sf_lambda(items: &[Spanned], span: Span, env: &Env) -> Result<Value> {
1827 if items.len() < 3 {
1828 return Err(EvalError::bad_form(
1829 "lambda",
1830 "expected (lambda (params...) body...)",
1831 span,
1832 ));
1833 }
1834 let param_list: &[Spanned] = match &items[1].form {
1837 SpannedForm::Nil => &[],
1838 SpannedForm::List(xs) => xs.as_slice(),
1839 _ => {
1840 return Err(EvalError::bad_form(
1841 "lambda",
1842 "params must be a list",
1843 items[1].span,
1844 ))
1845 }
1846 };
1847 let (params, rest) = parse_lambda_params(param_list, items[1].span)?;
1848 let body = items[2..].to_vec();
1849 Ok(Value::Closure(Arc::new(Closure {
1850 params,
1851 rest,
1852 body,
1853 captured_env: env.clone(),
1854 source: span,
1855 })))
1856}
1857
1858fn parse_lambda_params(list: &[Spanned], span: Span) -> Result<(Vec<Arc<str>>, Option<Arc<str>>)> {
1859 let mut params = Vec::new();
1860 let mut rest = None;
1861 let mut i = 0;
1862 while i < list.len() {
1863 let s = list[i]
1864 .as_symbol()
1865 .ok_or_else(|| EvalError::bad_form("lambda", "param must be a symbol", list[i].span))?;
1866 if s == "&rest" {
1867 let name = list
1868 .get(i + 1)
1869 .and_then(Spanned::as_symbol)
1870 .ok_or_else(|| EvalError::bad_form("lambda", "&rest needs a name", span))?;
1871 rest = Some(Arc::<str>::from(name));
1872 if i + 2 != list.len() {
1873 return Err(EvalError::bad_form(
1874 "lambda",
1875 "&rest must be the last param",
1876 span,
1877 ));
1878 }
1879 break;
1880 }
1881 params.push(Arc::<str>::from(s));
1882 i += 1;
1883 }
1884 Ok((params, rest))
1885}
1886
1887fn sf_define<H: 'static>(
1889 items: &[Spanned],
1890 span: Span,
1891 env: &mut Env,
1892 registry: &FnRegistry<H>,
1893 expander: &SpannedExpander,
1894 host: &mut H,
1895) -> Result<Value> {
1896 if items.len() < 3 {
1897 return Err(EvalError::bad_form(
1898 "define",
1899 "expected (define name expr) or (define (name args) body)",
1900 span,
1901 ));
1902 }
1903 match &items[1].form {
1904 SpannedForm::Atom(Atom::Symbol(name)) => {
1905 let v = eval_in(env, registry, expander, &items[2], host)?;
1906 env.define(Arc::<str>::from(name.as_str()), v);
1907 Ok(Value::Nil)
1908 }
1909 SpannedForm::List(head_list) => {
1910 if head_list.is_empty() {
1911 return Err(EvalError::bad_form(
1912 "define",
1913 "empty (name args) list",
1914 items[1].span,
1915 ));
1916 }
1917 let name = head_list[0].as_symbol().ok_or_else(|| {
1918 EvalError::bad_form(
1919 "define",
1920 "first item in (name args) must be a symbol",
1921 head_list[0].span,
1922 )
1923 })?;
1924 let (params, rest) = parse_lambda_params(&head_list[1..], items[1].span)?;
1925 let body = items[2..].to_vec();
1926 let closure = Arc::new(Closure {
1927 params,
1928 rest,
1929 body,
1930 captured_env: env.clone(),
1931 source: span,
1932 });
1933 env.define(Arc::<str>::from(name), Value::Closure(closure));
1934 Ok(Value::Nil)
1935 }
1936 _ => Err(EvalError::bad_form(
1937 "define",
1938 "second form must be a symbol or (name args) list",
1939 items[1].span,
1940 )),
1941 }
1942}
1943
1944fn sf_set<H: 'static>(
1945 items: &[Spanned],
1946 span: Span,
1947 env: &mut Env,
1948 registry: &FnRegistry<H>,
1949 expander: &SpannedExpander,
1950 host: &mut H,
1951) -> Result<Value> {
1952 if items.len() != 3 {
1953 return Err(EvalError::bad_form(
1954 "set!",
1955 "expected (set! name expr)",
1956 span,
1957 ));
1958 }
1959 let name = items[1]
1960 .as_symbol()
1961 .ok_or_else(|| EvalError::bad_form("set!", "first arg must be a symbol", items[1].span))?;
1962 let v = eval_in(env, registry, expander, &items[2], host)?;
1963 if env.set(name, v) {
1964 Ok(Value::Nil)
1965 } else if env.is_sealed_binding(name) {
1966 Err(EvalError::bad_form(
1969 "set!",
1970 format!(
1971 "cannot `set!` {name:?} from a macro body — it is bound outside \
1972 the expansion and sealed. Macro expansion must be deterministic, \
1973 so compile-time state cannot outlive the expansion. Use a local \
1974 binding, or return the value in the expansion."
1975 ),
1976 items[1].span,
1977 ))
1978 } else {
1979 Err(EvalError::unbound(name, items[1].span))
1980 }
1981}
1982
1983fn sf_begin<H: 'static>(
1984 body: &[Spanned],
1985 env: &mut Env,
1986 registry: &FnRegistry<H>,
1987 expander: &SpannedExpander,
1988 host: &mut H,
1989) -> Result<Value> {
1990 eval_body(body, env, registry, expander, host)
1991}
1992
1993fn sf_and<H: 'static>(
1994 exprs: &[Spanned],
1995 env: &mut Env,
1996 registry: &FnRegistry<H>,
1997 expander: &SpannedExpander,
1998 host: &mut H,
1999) -> Result<Value> {
2000 let mut last = Value::Bool(true);
2001 for e in exprs {
2002 last = eval_in(env, registry, expander, e, host)?;
2003 if !last.is_truthy() {
2004 return Ok(last);
2005 }
2006 }
2007 Ok(last)
2008}
2009
2010fn sf_or<H: 'static>(
2011 exprs: &[Spanned],
2012 env: &mut Env,
2013 registry: &FnRegistry<H>,
2014 expander: &SpannedExpander,
2015 host: &mut H,
2016) -> Result<Value> {
2017 let mut last = Value::Bool(false);
2018 for e in exprs {
2019 last = eval_in(env, registry, expander, e, host)?;
2020 if last.is_truthy() {
2021 return Ok(last);
2022 }
2023 }
2024 Ok(last)
2025}
2026
2027fn sf_not<H: 'static>(
2028 items: &[Spanned],
2029 span: Span,
2030 env: &mut Env,
2031 registry: &FnRegistry<H>,
2032 expander: &SpannedExpander,
2033 host: &mut H,
2034) -> Result<Value> {
2035 if items.len() != 2 {
2036 return Err(EvalError::bad_form("not", "expected (not x)", span));
2037 }
2038 let v = eval_in(env, registry, expander, &items[1], host)?;
2039 Ok(Value::Bool(!v.is_truthy()))
2040}
2041
2042fn sf_try<H: 'static>(
2061 items: &[Spanned],
2062 span: Span,
2063 env: &mut Env,
2064 registry: &FnRegistry<H>,
2065 expander: &SpannedExpander,
2066 host: &mut H,
2067) -> Result<Value> {
2068 if items.len() < 3 {
2069 return Err(EvalError::bad_form(
2070 "try",
2071 "expected (try body... (catch (e) handler...))",
2072 span,
2073 ));
2074 }
2075 let catch_form = items.last().unwrap();
2077 let catch_list = catch_form.as_list().ok_or_else(|| {
2078 EvalError::bad_form(
2079 "try",
2080 "last form must be (catch (binding) handler...)",
2081 catch_form.span,
2082 )
2083 })?;
2084 if catch_list.is_empty() || catch_list[0].as_symbol() != Some("catch") {
2085 return Err(EvalError::bad_form(
2086 "try",
2087 "last form must be a (catch ...) clause",
2088 catch_form.span,
2089 ));
2090 }
2091 if catch_list.len() < 3 {
2092 return Err(EvalError::bad_form(
2093 "catch",
2094 "expected (catch (binding) handler...)",
2095 catch_form.span,
2096 ));
2097 }
2098 let binding_list = catch_list[1].as_list().ok_or_else(|| {
2099 EvalError::bad_form(
2100 "catch",
2101 "binding must be a 1-element list (e)",
2102 catch_list[1].span,
2103 )
2104 })?;
2105 if binding_list.len() != 1 {
2106 return Err(EvalError::bad_form(
2107 "catch",
2108 "binding must bind exactly one symbol",
2109 catch_list[1].span,
2110 ));
2111 }
2112 let binding_name = binding_list[0].as_symbol().ok_or_else(|| {
2113 EvalError::bad_form("catch", "binding must be a symbol", binding_list[0].span)
2114 })?;
2115
2116 let body = &items[1..items.len() - 1];
2117 let mut last = Value::Nil;
2118 for form in body {
2119 match eval_in(env, registry, expander, form, host) {
2120 Ok(v) => {
2121 last = v;
2122 }
2123 Err(EvalError::User { value, .. }) => {
2124 return run_catch_handler(
2125 binding_name,
2126 value,
2127 &catch_list[2..],
2128 env,
2129 registry,
2130 expander,
2131 host,
2132 );
2133 }
2134 Err(other) => {
2135 let value = rust_err_to_value_error(&other);
2139 return run_catch_handler(
2140 binding_name,
2141 value,
2142 &catch_list[2..],
2143 env,
2144 registry,
2145 expander,
2146 host,
2147 );
2148 }
2149 }
2150 }
2151 Ok(last)
2152}
2153
2154fn run_catch_handler<H: 'static>(
2155 binding_name: &str,
2156 error_value: Value,
2157 handler_body: &[Spanned],
2158 env: &mut Env,
2159 registry: &FnRegistry<H>,
2160 expander: &SpannedExpander,
2161 host: &mut H,
2162) -> Result<Value> {
2163 env.push();
2164 env.define(Arc::<str>::from(binding_name), error_value);
2165 let mut last = Value::Nil;
2166 for form in handler_body {
2167 match eval_in(env, registry, expander, form, host) {
2168 Ok(v) => last = v,
2169 Err(e) => {
2170 env.pop();
2171 return Err(e);
2172 }
2173 }
2174 }
2175 env.pop();
2176 Ok(last)
2177}
2178
2179fn sf_eval<H: 'static>(
2188 items: &[Spanned],
2189 call_span: Span,
2190 env: &mut Env,
2191 registry: &FnRegistry<H>,
2192 expander: &SpannedExpander,
2193 host: &mut H,
2194) -> Result<Value> {
2195 if items.len() != 2 {
2196 return Err(EvalError::bad_form(
2197 "eval",
2198 "expected (eval form)",
2199 call_span,
2200 ));
2201 }
2202 let form_value = eval_in(env, registry, expander, &items[1], host)?;
2203 let form_spanned = crate::code::value_to_spanned(&form_value, call_span)
2204 .map_err(|reason| EvalError::native_fn(Arc::<str>::from("eval"), reason, call_span))?;
2205 let expanded = fully_expand_with(&form_spanned, registry, expander, env, host)?;
2206 eval_in(env, registry, expander, &expanded, host)
2207}
2208
2209fn sf_delay(items: &[Spanned], call_span: Span, env: &Env) -> Result<Value> {
2214 if items.len() != 2 {
2215 return Err(EvalError::bad_form(
2216 "delay",
2217 "expected (delay expr)",
2218 call_span,
2219 ));
2220 }
2221 let body = vec![items[1].clone()];
2222 let thunk = Arc::new(Closure {
2223 params: Vec::new(),
2224 rest: None,
2225 body,
2226 captured_env: env.clone(),
2227 source: call_span,
2228 });
2229 Ok(Value::Promise(Arc::new(std::sync::Mutex::new(
2230 crate::value::PromiseState::Pending(thunk),
2231 ))))
2232}
2233
2234fn sf_macroexpand<H: 'static>(
2243 items: &[Spanned],
2244 call_span: Span,
2245 env: &mut Env,
2246 registry: &FnRegistry<H>,
2247 expander: &SpannedExpander,
2248 host: &mut H,
2249 fully: bool,
2250) -> Result<Value> {
2251 if items.len() != 2 {
2252 return Err(EvalError::bad_form(
2253 if fully {
2254 "macroexpand"
2255 } else {
2256 "macroexpand-1"
2257 },
2258 "expected (macroexpand[-1] form)",
2259 call_span,
2260 ));
2261 }
2262 let form_value = eval_in(env, registry, expander, &items[1], host)?;
2264 let form_spanned = crate::code::value_to_spanned(&form_value, call_span).map_err(|reason| {
2266 EvalError::native_fn(
2267 Arc::<str>::from(if fully {
2268 "macroexpand"
2269 } else {
2270 "macroexpand-1"
2271 }),
2272 reason,
2273 call_span,
2274 )
2275 })?;
2276
2277 let expanded = if fully {
2283 fully_expand_with(&form_spanned, registry, expander, env, host)?
2284 } else {
2285 macroexpand_one(&form_spanned, registry, expander, env, host)?
2286 };
2287
2288 Ok(crate::code::spanned_to_value(&expanded))
2289}
2290
2291fn expand_one_macro_call<H: 'static>(
2295 macro_name: &str,
2296 args: &[Spanned],
2297 call_span: Span,
2298 registry: &FnRegistry<H>,
2299 expander: &SpannedExpander,
2300 parent_env: &Env,
2301 host: &mut H,
2302) -> Result<Spanned> {
2303 let def: MacroDef = expander.get_macro(macro_name).cloned().ok_or_else(|| {
2304 EvalError::native_fn(
2305 Arc::<str>::from(macro_name),
2306 "macro disappeared during expansion",
2307 call_span,
2308 )
2309 })?;
2310 let body_spanned = Spanned::from_sexp_at(&def.body, call_span);
2311 let body_expanded = fully_expand_with(&body_spanned, registry, expander, parent_env, host)?;
2313
2314 let mut macro_env = parent_env.clone();
2315 macro_env.push();
2316 bind_macro_args(&mut macro_env, &def.name, &def.params, args, call_span)?;
2317 let result = eval_in(&mut macro_env, registry, expander, &body_expanded, host)?;
2318
2319 crate::code::value_to_spanned(&result, call_span).map_err(|reason| {
2320 EvalError::native_fn(
2321 Arc::<str>::from(format!("macro {macro_name}")),
2322 reason,
2323 call_span,
2324 )
2325 })
2326}
2327
2328fn fully_expand_with<H: 'static>(
2332 form: &Spanned,
2333 registry: &FnRegistry<H>,
2334 expander: &SpannedExpander,
2335 parent_env: &Env,
2336 host: &mut H,
2337) -> Result<Spanned> {
2338 if expander.is_empty() {
2339 return Ok(form.clone());
2340 }
2341 expand_recursive_with(form, registry, expander, parent_env, host)
2342}
2343
2344fn expand_recursive_with<H: 'static>(
2345 form: &Spanned,
2346 registry: &FnRegistry<H>,
2347 expander: &SpannedExpander,
2348 parent_env: &Env,
2349 host: &mut H,
2350) -> Result<Spanned> {
2351 match &form.form {
2352 SpannedForm::List(items) if !items.is_empty() => {
2353 if let Some(head) = items[0].as_symbol() {
2354 if expander.has(head) {
2355 let expanded = expand_one_macro_call(
2356 head,
2357 &items[1..],
2358 form.span,
2359 registry,
2360 expander,
2361 parent_env,
2362 host,
2363 )?;
2364 return expand_recursive_with(&expanded, registry, expander, parent_env, host);
2365 }
2366 }
2367 let mut out = Vec::with_capacity(items.len());
2368 for child in items {
2369 out.push(expand_recursive_with(
2370 child, registry, expander, parent_env, host,
2371 )?);
2372 }
2373 Ok(Spanned::new(form.span, SpannedForm::List(out)))
2374 }
2375 SpannedForm::Quote(_) => Ok(form.clone()),
2376 SpannedForm::Quasiquote(inner) => Ok(Spanned::new(
2377 form.span,
2378 SpannedForm::Quasiquote(Box::new(expand_inside_quasiquote_with(
2379 inner, registry, expander, parent_env, host,
2380 )?)),
2381 )),
2382 _ => Ok(form.clone()),
2383 }
2384}
2385
2386fn expand_inside_quasiquote_with<H: 'static>(
2387 form: &Spanned,
2388 registry: &FnRegistry<H>,
2389 expander: &SpannedExpander,
2390 parent_env: &Env,
2391 host: &mut H,
2392) -> Result<Spanned> {
2393 match &form.form {
2394 SpannedForm::Unquote(inner) => Ok(Spanned::new(
2395 form.span,
2396 SpannedForm::Unquote(Box::new(expand_recursive_with(
2397 inner, registry, expander, parent_env, host,
2398 )?)),
2399 )),
2400 SpannedForm::UnquoteSplice(inner) => Ok(Spanned::new(
2401 form.span,
2402 SpannedForm::UnquoteSplice(Box::new(expand_recursive_with(
2403 inner, registry, expander, parent_env, host,
2404 )?)),
2405 )),
2406 SpannedForm::List(items) => {
2407 let mut out = Vec::with_capacity(items.len());
2408 for item in items {
2409 out.push(expand_inside_quasiquote_with(
2410 item, registry, expander, parent_env, host,
2411 )?);
2412 }
2413 Ok(Spanned::new(form.span, SpannedForm::List(out)))
2414 }
2415 _ => Ok(form.clone()),
2416 }
2417}
2418
2419fn macroexpand_one<H: 'static>(
2422 form: &Spanned,
2423 registry: &FnRegistry<H>,
2424 expander: &SpannedExpander,
2425 parent_env: &Env,
2426 host: &mut H,
2427) -> Result<Spanned> {
2428 if let SpannedForm::List(items) = &form.form {
2429 if let Some(head) = items.first().and_then(Spanned::as_symbol) {
2430 if expander.has(head) {
2431 return expand_one_macro_call(
2432 head,
2433 &items[1..],
2434 form.span,
2435 registry,
2436 expander,
2437 parent_env,
2438 host,
2439 );
2440 }
2441 }
2442 }
2443 Ok(form.clone())
2444}
2445
2446fn rust_err_to_value_error(err: &EvalError) -> Value {
2449 use crate::value::ErrorObj;
2450 let tag: Arc<str> = match err {
2451 EvalError::UnboundSymbol { .. } => Arc::from("unbound-symbol"),
2452 EvalError::ArityMismatch { .. } => Arc::from("arity-mismatch"),
2453 EvalError::TypeMismatch { .. } => Arc::from("type-mismatch"),
2454 EvalError::DivisionByZero { .. } => Arc::from("division-by-zero"),
2455 EvalError::MacroExpansionLimit { .. } => Arc::from("macro-expansion-limit"),
2456 EvalError::NotCallable { .. } => Arc::from("not-callable"),
2457 EvalError::BadSpecialForm { .. } => Arc::from("bad-special-form"),
2458 EvalError::NativeFn { .. } => Arc::from("native-fn"),
2459 EvalError::Reader(_) => Arc::from("reader"),
2460 EvalError::Halted => Arc::from("halted"),
2461 EvalError::NotImplemented(_) => Arc::from("not-implemented"),
2462 EvalError::User { .. } => Arc::from("user"),
2463 };
2464 let message: Arc<str> = Arc::from(err.short_message());
2465 Value::Error(Arc::new(ErrorObj {
2466 tag,
2467 message,
2468 data: Vec::new(),
2469 }))
2470}
2471
2472#[cfg(test)]
2473mod tests {
2474 use super::*;
2475 use crate::primitive::install_primitives;
2476 use tatara_lisp::read_spanned;
2477
2478 struct NoHost;
2479
2480 fn eval_ok(src: &str) -> Value {
2481 let forms = read_spanned(src).unwrap();
2482 let mut i: Interpreter<NoHost> = Interpreter::new();
2483 install_primitives(&mut i);
2484 let mut host = NoHost;
2485 i.eval_program(&forms, &mut host).unwrap()
2486 }
2487
2488 fn eval_err(src: &str) -> EvalError {
2489 let forms = read_spanned(src).unwrap();
2490 let mut i: Interpreter<NoHost> = Interpreter::new();
2491 install_primitives(&mut i);
2492 let mut host = NoHost;
2493 i.eval_program(&forms, &mut host).unwrap_err()
2494 }
2495
2496 #[test]
2499 fn literal_int() {
2500 assert!(matches!(eval_ok("42"), Value::Int(42)));
2501 }
2502
2503 #[test]
2504 fn unbound_symbol_errors() {
2505 let e = eval_err("no-such-var");
2506 assert!(matches!(e, EvalError::UnboundSymbol { .. }));
2507 }
2508
2509 #[test]
2510 fn quote_returns_runtime_list_of_symbols() {
2511 let v = eval_ok("'(a b c)");
2514 match v {
2515 Value::List(xs) => {
2516 assert_eq!(xs.len(), 3);
2517 assert!(matches!(&xs[0], Value::Symbol(s) if s.as_ref() == "a"));
2518 assert!(matches!(&xs[1], Value::Symbol(s) if s.as_ref() == "b"));
2519 assert!(matches!(&xs[2], Value::Symbol(s) if s.as_ref() == "c"));
2520 }
2521 other => panic!("{other:?}"),
2522 }
2523 }
2524
2525 #[test]
2528 fn add_ints() {
2529 assert!(matches!(eval_ok("(+ 1 2 3)"), Value::Int(6)));
2530 }
2531
2532 #[test]
2533 fn sub_divides_float() {
2534 match eval_ok("(- 10 3)") {
2535 Value::Int(7) => {}
2536 other => panic!("{other:?}"),
2537 }
2538 }
2539
2540 #[test]
2541 fn division_by_zero_errors() {
2542 assert!(matches!(
2543 eval_err("(/ 1 0)"),
2544 EvalError::DivisionByZero { .. }
2545 ));
2546 }
2547
2548 #[test]
2551 fn if_truthy_branch() {
2552 assert!(matches!(eval_ok("(if #t 1 2)"), Value::Int(1)));
2553 }
2554
2555 #[test]
2556 fn if_falsy_branch() {
2557 assert!(matches!(eval_ok("(if #f 1 2)"), Value::Int(2)));
2558 }
2559
2560 #[test]
2561 fn if_no_else_returns_nil() {
2562 assert!(matches!(eval_ok("(if #f 1)"), Value::Nil));
2563 }
2564
2565 #[test]
2566 fn cond_picks_first_match() {
2567 assert!(matches!(
2568 eval_ok("(cond (#f 1) (#t 2) (else 3))"),
2569 Value::Int(2)
2570 ));
2571 }
2572
2573 #[test]
2574 fn cond_falls_through_to_else() {
2575 assert!(matches!(
2576 eval_ok("(cond (#f 1) (#f 2) (else 3))"),
2577 Value::Int(3)
2578 ));
2579 }
2580
2581 #[test]
2582 fn when_runs_body_if_true() {
2583 assert!(matches!(eval_ok("(when #t 99)"), Value::Int(99)));
2584 assert!(matches!(eval_ok("(when #f 99)"), Value::Nil));
2585 }
2586
2587 #[test]
2590 fn let_binds_and_evaluates_body() {
2591 assert!(matches!(
2592 eval_ok("(let ((x 10) (y 20)) (+ x y))"),
2593 Value::Int(30)
2594 ));
2595 }
2596
2597 #[test]
2598 fn let_star_sequential_bindings() {
2599 assert!(matches!(
2600 eval_ok("(let* ((x 5) (y (+ x 1))) (+ x y))"),
2601 Value::Int(11)
2602 ));
2603 }
2604
2605 #[test]
2606 fn letrec_mutual_recursion() {
2607 let v = eval_ok(
2608 "(letrec ((even? (lambda (n) (if (= n 0) #t (odd? (- n 1)))))
2609 (odd? (lambda (n) (if (= n 0) #f (even? (- n 1))))))
2610 (even? 10))",
2611 );
2612 assert!(matches!(v, Value::Bool(true)));
2613 }
2614
2615 #[test]
2618 fn lambda_applies() {
2619 assert!(matches!(
2620 eval_ok("((lambda (x y) (+ x y)) 3 4)"),
2621 Value::Int(7)
2622 ));
2623 }
2624
2625 #[test]
2626 fn lambda_closes_over_env() {
2627 assert!(matches!(
2628 eval_ok("(let ((n 10)) ((lambda (x) (+ x n)) 5))"),
2629 Value::Int(15)
2630 ));
2631 }
2632
2633 #[test]
2634 fn closure_captures_by_value_at_creation() {
2635 let v = eval_ok(
2638 "(define make-adder (lambda (n) (lambda (x) (+ x n))))
2639 (define add5 (make-adder 5))
2640 (add5 10)",
2641 );
2642 assert!(matches!(v, Value::Int(15)));
2643 }
2644
2645 #[test]
2646 fn rest_args_collect_into_list() {
2647 let v = eval_ok("((lambda (x &rest rs) (length rs)) 1 2 3 4 5)");
2648 assert!(matches!(v, Value::Int(4)));
2649 }
2650
2651 #[test]
2652 fn closure_arity_mismatch() {
2653 let e = eval_err("((lambda (x y) (+ x y)) 1)");
2654 assert!(matches!(e, EvalError::ArityMismatch { .. }));
2655 }
2656
2657 #[test]
2660 fn define_then_use() {
2661 assert!(matches!(eval_ok("(define x 42) x"), Value::Int(42)));
2662 }
2663
2664 #[test]
2665 fn define_function_shorthand() {
2666 assert!(matches!(
2667 eval_ok("(define (sq x) (* x x)) (sq 6)"),
2668 Value::Int(36)
2669 ));
2670 }
2671
2672 #[test]
2673 fn set_mutates_existing() {
2674 assert!(matches!(
2675 eval_ok("(define x 1) (set! x 99) x"),
2676 Value::Int(99)
2677 ));
2678 }
2679
2680 #[test]
2681 fn set_unbound_errors() {
2682 let e = eval_err("(set! nope 1)");
2683 assert!(matches!(e, EvalError::UnboundSymbol { .. }));
2684 }
2685
2686 #[test]
2689 fn begin_returns_last() {
2690 assert!(matches!(eval_ok("(begin 1 2 3)"), Value::Int(3)));
2691 }
2692
2693 #[test]
2694 fn and_short_circuits() {
2695 assert!(matches!(eval_ok("(and 1 #f 2)"), Value::Bool(false)));
2696 assert!(matches!(eval_ok("(and 1 2 3)"), Value::Int(3)));
2697 assert!(matches!(eval_ok("(and)"), Value::Bool(true)));
2698 }
2699
2700 #[test]
2701 fn or_short_circuits() {
2702 assert!(matches!(eval_ok("(or #f #f 7)"), Value::Int(7)));
2703 assert!(matches!(eval_ok("(or #f #f)"), Value::Bool(false)));
2704 assert!(matches!(eval_ok("(or)"), Value::Bool(false)));
2705 }
2706
2707 #[test]
2708 fn not_inverts() {
2709 assert!(matches!(eval_ok("(not #t)"), Value::Bool(false)));
2710 assert!(matches!(eval_ok("(not #f)"), Value::Bool(true)));
2711 assert!(matches!(eval_ok("(not 42)"), Value::Bool(false)));
2712 }
2713
2714 #[test]
2717 fn recursive_factorial() {
2718 let v = eval_ok(
2719 "(define (fact n)
2720 (if (= n 0) 1 (* n (fact (- n 1)))))
2721 (fact 6)",
2722 );
2723 assert!(matches!(v, Value::Int(720)));
2724 }
2725
2726 #[test]
2727 fn recursive_length() {
2728 let v = eval_ok(
2729 "(define (len xs)
2730 (if (null? xs) 0 (+ 1 (len (cdr xs)))))
2731 (len (list 1 2 3 4 5))",
2732 );
2733 assert!(matches!(v, Value::Int(5)));
2734 }
2735
2736 #[test]
2741 fn quasiquote_plain_list_is_runtime_list() {
2742 let v = eval_ok("`(a b c)");
2743 match v {
2744 Value::List(xs) => {
2745 assert_eq!(xs.len(), 3);
2746 assert!(matches!(&xs[0], Value::Symbol(s) if s.as_ref() == "a"));
2747 assert!(matches!(&xs[1], Value::Symbol(s) if s.as_ref() == "b"));
2748 assert!(matches!(&xs[2], Value::Symbol(s) if s.as_ref() == "c"));
2749 }
2750 other => panic!("{other:?}"),
2751 }
2752 }
2753
2754 #[test]
2755 fn quasiquote_unquote_substitutes_evaluated_value() {
2756 let v = eval_ok("(let ((x 42)) `(a ,x c))");
2757 match v {
2758 Value::List(xs) => {
2759 assert_eq!(xs.len(), 3);
2760 assert!(matches!(&xs[1], Value::Int(42)));
2761 }
2762 other => panic!("{other:?}"),
2763 }
2764 }
2765
2766 #[test]
2767 fn quasiquote_unquote_arbitrary_expr() {
2768 let v = eval_ok("`(x ,(+ 1 2 3) y)");
2769 match v {
2770 Value::List(xs) => {
2771 assert!(matches!(&xs[1], Value::Int(6)));
2772 }
2773 other => panic!("{other:?}"),
2774 }
2775 }
2776
2777 #[test]
2778 fn quasiquote_splice_inlines_list() {
2779 let v = eval_ok("`(a ,@(list 1 2 3) b)");
2780 match v {
2781 Value::List(xs) => {
2782 assert_eq!(xs.len(), 5);
2783 assert!(matches!(&xs[0], Value::Symbol(s) if s.as_ref() == "a"));
2784 assert!(matches!(&xs[1], Value::Int(1)));
2785 assert!(matches!(&xs[2], Value::Int(2)));
2786 assert!(matches!(&xs[3], Value::Int(3)));
2787 assert!(matches!(&xs[4], Value::Symbol(s) if s.as_ref() == "b"));
2788 }
2789 other => panic!("{other:?}"),
2790 }
2791 }
2792
2793 #[test]
2794 fn quasiquote_splice_empty_list_splices_nothing() {
2795 let v = eval_ok("`(a ,@(list) b)");
2796 match v {
2797 Value::List(xs) => {
2798 assert_eq!(xs.len(), 2);
2799 assert!(matches!(&xs[0], Value::Symbol(s) if s.as_ref() == "a"));
2800 assert!(matches!(&xs[1], Value::Symbol(s) if s.as_ref() == "b"));
2801 }
2802 other => panic!("{other:?}"),
2803 }
2804 }
2805
2806 #[test]
2807 fn quasiquote_splice_non_list_errors() {
2808 let e = eval_err("`(a ,@42)");
2809 assert!(matches!(e, EvalError::TypeMismatch { .. }));
2810 }
2811
2812 #[test]
2813 fn quasiquote_atom_yields_atom_value() {
2814 assert!(matches!(eval_ok("`foo"), Value::Symbol(s) if s.as_ref() == "foo"));
2815 assert!(matches!(eval_ok("`42"), Value::Int(42)));
2816 }
2817
2818 #[test]
2819 fn quasiquote_with_nested_list_and_unquote() {
2820 let v = eval_ok("(let ((x 99)) `(foo (bar ,x) baz))");
2822 match v {
2823 Value::List(xs) => {
2824 assert_eq!(xs.len(), 3);
2825 match &xs[1] {
2826 Value::List(inner) => {
2827 assert!(matches!(&inner[1], Value::Int(99)));
2828 }
2829 other => panic!("{other:?}"),
2830 }
2831 }
2832 other => panic!("{other:?}"),
2833 }
2834 }
2835
2836 #[test]
2837 fn quasiquote_symbol_keyword_distinction_preserved() {
2838 let v = eval_ok("`(:key val)");
2839 match v {
2840 Value::List(xs) => {
2841 assert!(matches!(&xs[0], Value::Keyword(s) if s.as_ref() == "key"));
2842 assert!(matches!(&xs[1], Value::Symbol(s) if s.as_ref() == "val"));
2843 }
2844 other => panic!("{other:?}"),
2845 }
2846 }
2847
2848 #[test]
2849 fn bare_unquote_outside_quasiquote_errors() {
2850 let e = eval_err(",x");
2851 assert!(matches!(e, EvalError::BadSpecialForm { .. }));
2852 }
2853
2854 #[test]
2857 fn native_fn_reads_host_state() {
2858 struct Counter {
2859 n: i64,
2860 }
2861 let forms = read_spanned("(bump) (bump) (bump) (cur)").unwrap();
2862 let mut i: Interpreter<Counter> = Interpreter::new();
2863 install_primitives(&mut i);
2864 i.register_fn(
2865 "bump",
2866 Arity::Exact(0),
2867 |_args: &[Value], host: &mut Counter, _span| {
2868 host.n += 1;
2869 Ok(Value::Int(host.n))
2870 },
2871 );
2872 i.register_fn(
2873 "cur",
2874 Arity::Exact(0),
2875 |_args: &[Value], host: &mut Counter, _span| Ok(Value::Int(host.n)),
2876 );
2877 let mut host = Counter { n: 0 };
2878 let v = i.eval_program(&forms, &mut host).unwrap();
2879 assert!(matches!(v, Value::Int(3)));
2880 }
2881
2882 struct Ctx {
2885 records: Vec<(String, i64)>,
2886 }
2887
2888 #[test]
2889 fn register_typed1_marshals_string_arg() {
2890 let mut i: Interpreter<Ctx> = Interpreter::new();
2891 install_primitives(&mut i);
2892 i.register_typed1("greet", |_h: &mut Ctx, name: String| -> Result<String> {
2893 Ok(format!("hello {name}"))
2894 });
2895 let forms = read_spanned(r#"(greet "luis")"#).unwrap();
2896 let mut h = Ctx { records: vec![] };
2897 let v = i.eval_program(&forms, &mut h).unwrap();
2898 match v {
2899 Value::Str(s) => assert_eq!(&*s, "hello luis"),
2900 other => panic!("{other:?}"),
2901 }
2902 }
2903
2904 #[test]
2905 fn register_typed2_marshals_host_state_mutation() {
2906 let mut i: Interpreter<Ctx> = Interpreter::new();
2907 install_primitives(&mut i);
2908 i.register_typed2(
2909 "record",
2910 |h: &mut Ctx, name: String, n: i64| -> Result<()> {
2911 h.records.push((name, n));
2912 Ok(())
2913 },
2914 );
2915 let forms = read_spanned(r#"(record "a" 1) (record "b" 2)"#).unwrap();
2916 let mut h = Ctx { records: vec![] };
2917 let _ = i.eval_program(&forms, &mut h).unwrap();
2918 assert_eq!(h.records.len(), 2);
2919 assert_eq!(h.records[0], ("a".to_string(), 1));
2920 assert_eq!(h.records[1], ("b".to_string(), 2));
2921 }
2922
2923 #[test]
2924 fn register_typed_arg_type_mismatch_surfaces_at_call_site() {
2925 let mut i: Interpreter<Ctx> = Interpreter::new();
2926 install_primitives(&mut i);
2927 i.register_typed1("needs-int", |_h: &mut Ctx, n: i64| -> Result<i64> {
2928 Ok(n + 1)
2929 });
2930 let forms = read_spanned(r#"(needs-int "not-a-number")"#).unwrap();
2931 let mut h = Ctx { records: vec![] };
2932 let err = i.eval_program(&forms, &mut h).unwrap_err();
2933 assert!(matches!(
2934 err,
2935 EvalError::TypeMismatch {
2936 expected: "integer",
2937 ..
2938 }
2939 ));
2940 }
2941
2942 #[test]
2943 fn register_typed3_three_args() {
2944 let mut i: Interpreter<Ctx> = Interpreter::new();
2945 install_primitives(&mut i);
2946 i.register_typed3(
2947 "triple-sum",
2948 |_h: &mut Ctx, a: i64, b: i64, c: i64| -> Result<i64> { Ok(a + b + c) },
2949 );
2950 let forms = read_spanned("(triple-sum 10 20 30)").unwrap();
2951 let mut h = Ctx { records: vec![] };
2952 let v = i.eval_program(&forms, &mut h).unwrap();
2953 assert!(matches!(v, Value::Int(60)));
2954 }
2955
2956 #[test]
2972 fn a_runaway_macro_is_a_typed_error_that_names_the_macro() {
2973 let err = eval_err("(defmacro forever (x) `(forever ,x))\n(forever 1)");
2974 match err {
2975 EvalError::MacroExpansionLimit {
2976 ref macro_name,
2977 limit,
2978 ..
2979 } => {
2980 assert_eq!(&**macro_name, "forever", "the error must name the culprit");
2981 assert_eq!(limit, DEFAULT_MACRO_EXPANSION_LIMIT);
2982 }
2983 other => panic!("expected MacroExpansionLimit, got {other:?}"),
2984 }
2985 }
2986
2987 #[test]
2991 fn a_mutually_recursive_macro_pair_is_caught_too() {
2992 let err = eval_err(
2993 "(defmacro ping (x) `(pong ,x))\n(defmacro pong (x) `(ping ,x))\n(ping 1)",
2994 );
2995 assert!(
2996 matches!(err, EvalError::MacroExpansionLimit { .. }),
2997 "a two-macro cycle must be bounded as well: {err:?}"
2998 );
2999 }
3000
3001 #[test]
3009 fn deep_but_finite_nesting_is_not_charged_to_the_expansion_budget() {
3010 let mut src = String::from("(defmacro id1 (x) x)\n");
3011 src.push_str(&"(+ 1 ".repeat(400));
3012 src.push_str("(id1 7)");
3013 src.push_str(&")".repeat(400));
3014 let v = eval_ok(&src);
3015 assert!(matches!(v, Value::Int(407)), "got {v:?}");
3016 }
3017
3018 #[test]
3021 fn a_terminating_chain_under_the_ceiling_still_expands() {
3022 let v = eval_ok(
3024 "(defmacro step (x) `(step2 ,x))\n(defmacro step2 (x) `(* ,x 3))\n(step 5)",
3025 );
3026 assert!(matches!(v, Value::Int(15)), "got {v:?}");
3027 }
3028
3029 #[test]
3032 fn the_expansion_ceiling_is_configurable() {
3033 let forms = read_spanned("(defmacro forever (x) `(forever ,x))\n(forever 1)").unwrap();
3034 let mut i: Interpreter<NoHost> = Interpreter::new();
3035 install_primitives(&mut i);
3036 i.set_macro_expansion_limit(4);
3037 match i.eval_program(&forms, &mut NoHost).unwrap_err() {
3038 EvalError::MacroExpansionLimit { limit, .. } => assert_eq!(limit, 4),
3039 other => panic!("expected MacroExpansionLimit, got {other:?}"),
3040 }
3041 }
3042
3043 #[test]
3044 fn user_macro_expands_and_evaluates() {
3045 let v = eval_ok(
3046 "(defmacro twice (x) `(* ,x 2))
3047 (twice 21)",
3048 );
3049 assert!(matches!(v, Value::Int(42)));
3050 }
3051
3052 #[test]
3053 fn user_macro_definition_returns_nil() {
3054 let v = eval_ok("(defmacro inc (x) `(+ ,x 1))");
3055 assert!(matches!(v, Value::Nil));
3056 }
3057
3058 #[test]
3059 fn user_macro_inside_define_body_expands() {
3060 let v = eval_ok(
3063 "(defmacro inc (x) `(+ ,x 1))
3064 (define (f n) (inc n))
3065 (f 41)",
3066 );
3067 assert!(matches!(v, Value::Int(42)));
3068 }
3069
3070 #[test]
3071 fn user_macro_with_rest_args_splices() {
3072 let v = eval_ok(
3073 "(defmacro sum-all (&rest xs) `(+ ,@xs))
3074 (sum-all 1 2 3 4 5)",
3075 );
3076 assert!(matches!(v, Value::Int(15)));
3077 }
3078
3079 #[test]
3080 fn nested_user_macros_compose() {
3081 let v = eval_ok(
3082 "(defmacro twice (x) `(* ,x 2))
3083 (defmacro quad (x) `(twice (twice ,x)))
3084 (quad 5)",
3085 );
3086 assert!(matches!(v, Value::Int(20)));
3087 }
3088
3089 #[test]
3090 fn user_macro_can_expand_to_special_form() {
3091 let v = eval_ok(
3094 "(defmacro guard (test then) `(if ,test ,then 0))
3095 (guard #t 99)",
3096 );
3097 assert!(matches!(v, Value::Int(99)));
3098 }
3099
3100 #[test]
3101 fn user_macro_redefined_replaces_prior_template() {
3102 let v = eval_ok(
3103 "(defmacro k () `1)
3104 (defmacro k () `2)
3105 (k)",
3106 );
3107 assert!(matches!(v, Value::Int(2)));
3108 }
3109
3110 #[test]
3111 fn user_macro_unbound_template_var_errors() {
3112 let mut i: Interpreter<NoHost> = Interpreter::new();
3118 install_primitives(&mut i);
3119 let forms = read_spanned("(defmacro bad (x) `(list ,y)) (bad 1)").unwrap();
3120 let err = i.eval_program(&forms, &mut NoHost).unwrap_err();
3121 match err {
3122 EvalError::UnboundSymbol { name, .. } => assert_eq!(&*name, "y"),
3123 other => panic!("expected UnboundSymbol, got {other:?}"),
3124 }
3125 }
3126
3127 #[test]
3128 fn defpoint_template_keyword_registers_as_macro() {
3129 let v = eval_ok(
3132 "(defpoint-template double (x) `(* ,x 2))
3133 (double 7)",
3134 );
3135 assert!(matches!(v, Value::Int(14)));
3136 }
3137
3138 #[test]
3139 fn defcheck_keyword_registers_as_macro() {
3140 let v = eval_ok(
3141 "(defcheck always-7 () `7)
3142 (always-7)",
3143 );
3144 assert!(matches!(v, Value::Int(7)));
3145 }
3146
3147 #[test]
3148 fn macro_call_evaluated_with_runtime_arg() {
3149 let v = eval_ok(
3153 "(defmacro double (x) `(+ ,x ,x))
3154 (define n 13)
3155 (double n)",
3156 );
3157 assert!(matches!(v, Value::Int(26)));
3158 }
3159
3160 #[test]
3161 fn macro_persists_across_eval_program_calls() {
3162 let mut i: Interpreter<NoHost> = Interpreter::new();
3165 install_primitives(&mut i);
3166 let mut host = NoHost;
3167 let defs = read_spanned("(defmacro inc (x) `(+ ,x 1))").unwrap();
3168 i.eval_program(&defs, &mut host).unwrap();
3169 assert_eq!(i.expander().len(), 1);
3170
3171 let call = read_spanned("(inc 41)").unwrap();
3172 let v = i.eval_program(&call, &mut host).unwrap();
3173 assert!(matches!(v, Value::Int(42)));
3174 }
3175
3176 #[test]
3177 fn macro_expansion_inside_lambda_body() {
3178 let v = eval_ok(
3179 "(defmacro sq (x) `(* ,x ,x))
3180 ((lambda (n) (sq n)) 9)",
3181 );
3182 assert!(matches!(v, Value::Int(81)));
3183 }
3184
3185 #[test]
3186 fn no_macros_registered_keeps_eval_program_a_passthrough() {
3187 let v = eval_ok("(+ 1 2 3)");
3193 assert!(matches!(v, Value::Int(6)));
3194 }
3195
3196 #[test]
3197 fn eval_top_form_drives_one_form_at_a_time() {
3198 let mut i: Interpreter<NoHost> = Interpreter::new();
3199 install_primitives(&mut i);
3200 let mut host = NoHost;
3201 let forms = read_spanned("(defmacro id (x) `,x) (id 42)").unwrap();
3202
3203 let r0 = i.eval_top_form(&forms[0], &mut host).unwrap();
3205 assert!(matches!(r0, Value::Nil));
3206
3207 let r1 = i.eval_top_form(&forms[1], &mut host).unwrap();
3209 assert!(matches!(r1, Value::Int(42)));
3210 }
3211
3212 use crate::install_full_stdlib_with;
3219
3220 fn run_full(src: &str) -> Value {
3221 let mut i: Interpreter<NoHost> = Interpreter::new();
3222 install_full_stdlib_with(&mut i, &mut NoHost);
3223 let forms = read_spanned(src).unwrap();
3224 i.eval_program(&forms, &mut NoHost).unwrap()
3225 }
3226
3227 #[test]
3228 fn macro_can_use_map_at_expansion_time() {
3229 let v = run_full(
3233 "(defmacro double-each (&rest xs)
3234 `(list ,@(map (lambda (x) (* x 2)) xs)))
3235 (double-each 1 2 3 4 5)",
3236 );
3237 assert_eq!(format!("{v}"), "(2 4 6 8 10)");
3238 }
3239
3240 #[test]
3241 fn macro_can_use_foldl_at_expansion_time() {
3242 let v = run_full(
3246 "(defmacro static-sum (&rest xs)
3247 (foldl + 0 xs))
3248 (static-sum 1 2 3 4 5)",
3249 );
3250 assert!(matches!(v, Value::Int(15)));
3251 }
3252
3253 #[test]
3254 fn macro_can_use_filter_at_expansion_time() {
3255 let v = run_full(
3259 "(defmacro sum-positives (&rest xs)
3260 `(+ ,@(filter positive? xs)))
3261 (sum-positives 1 -2 3 -4 5)",
3262 );
3263 assert!(matches!(v, Value::Int(9)));
3265 }
3266
3267 #[test]
3268 fn macro_can_recursively_emit_let_chain() {
3269 let v = run_full(
3272 "(defmacro chain-let (binding &rest more)
3273 (if (null? more)
3274 `(let (,binding) #t)
3275 `(let (,binding) (chain-let ,@more))))
3276 (chain-let (a 1) (b 2) (c 3))",
3277 );
3278 assert!(matches!(v, Value::Bool(true)));
3279 }
3280
3281 #[test]
3282 fn macro_can_use_gensym_for_hygiene() {
3283 let v = run_full(
3286 "(defmacro swap-bind (init body)
3287 (let ((tmp (gensym \"tmp\")))
3288 `(let ((,tmp ,init))
3289 (+ ,tmp ,tmp))))
3290 (swap-bind 21 #t)",
3291 );
3292 assert!(matches!(v, Value::Int(42)));
3293 }
3294
3295 #[test]
3296 fn macro_can_inspect_arg_shape() {
3297 let v = run_full(
3299 "(defmacro shape-aware (x)
3300 (if (list? x)
3301 `(+ ,@x) ;; sum the children
3302 `,x)) ;; pass through scalars
3303 (+ (shape-aware (1 2 3)) (shape-aware 100))",
3304 );
3305 assert!(matches!(v, Value::Int(106)));
3307 }
3308
3309 #[test]
3310 fn macro_can_call_user_helper_fn() {
3311 let v = run_full(
3313 "(define (square x) (* x x))
3314 (defmacro static-square (n) (square n))
3315 (static-square 7)",
3316 );
3317 assert!(matches!(v, Value::Int(49)));
3318 }
3319
3320 #[test]
3321 fn macro_emitting_quoted_form_round_trips() {
3322 let v = run_full(
3325 "(defmacro literal-list (&rest xs)
3326 `(quote ,xs))
3327 (literal-list a b c)",
3328 );
3329 let s = format!("{v}");
3330 assert!(s.contains('a') && s.contains('b') && s.contains('c'));
3331 }
3332
3333 #[test]
3334 fn quasiquote_inside_quasiquote_in_macro_output_is_preserved() {
3335 let v = run_full(
3338 "(defmacro emit-qq (x) `(quasiquote (a (unquote ,x) c)))
3339 (let ((q (emit-qq 99))) q)",
3340 );
3341 assert_eq!(format!("{v}"), "(a 99 c)");
3343 }
3344
3345 #[test]
3346 fn macro_body_can_define_locals_and_dispatch() {
3347 let v = run_full(
3349 "(defmacro classify-args (&rest xs)
3350 (let ((evens (filter even? xs))
3351 (odds (filter odd? xs)))
3352 `(list (list :evens ,@evens)
3353 (list :odds ,@odds))))
3354 (classify-args 1 2 3 4 5 6)",
3355 );
3356 let s = format!("{v}");
3357 assert!(s.contains(":evens 2 4 6"));
3358 assert!(s.contains(":odds 1 3 5"));
3359 }
3360
3361 #[test]
3370 fn tco_self_recursion_via_if() {
3371 let v = run_full(
3375 "(define (sum n acc)
3376 (if (= n 0)
3377 acc
3378 (sum (- n 1) (+ acc n))))
3379 (sum 100000 0)",
3380 );
3381 assert!(matches!(v, Value::Int(5_000_050_000)));
3383 }
3384
3385 #[test]
3386 fn tco_mutual_recursion() {
3387 let v = run_full(
3390 "(define (even-r? n) (if (= n 0) #t (odd-r? (- n 1))))
3391 (define (odd-r? n) (if (= n 0) #f (even-r? (- n 1))))
3392 (even-r? 50000)",
3393 );
3394 assert!(matches!(v, Value::Bool(true)));
3395 }
3396
3397 #[test]
3398 fn tco_via_cond_branch() {
3399 let v = run_full(
3400 "(define (countdown n)
3401 (cond
3402 ((<= n 0) :done)
3403 (else (countdown (- n 1)))))
3404 (countdown 50000)",
3405 );
3406 assert!(matches!(v, Value::Keyword(s) if &*s == "done"));
3407 }
3408
3409 #[test]
3410 fn tco_via_let_body() {
3411 let v = run_full(
3414 "(define (loop-let n)
3415 (let ((m (- n 1)))
3416 (if (<= n 0) :done (loop-let m))))
3417 (loop-let 50000)",
3418 );
3419 assert!(matches!(v, Value::Keyword(s) if &*s == "done"));
3420 }
3421
3422 #[test]
3423 fn tco_via_begin_last_form() {
3424 let v = run_full(
3425 "(define (counter n)
3426 (begin
3427 (+ 1 1)
3428 (+ 2 2)
3429 (if (<= n 0) :done (counter (- n 1)))))
3430 (counter 50000)",
3431 );
3432 assert!(matches!(v, Value::Keyword(s) if &*s == "done"));
3433 }
3434
3435 #[test]
3436 fn tco_via_when_unless() {
3437 let v = run_full(
3438 "(define (drain n)
3439 (when (> n 0)
3440 (drain (- n 1))))
3441 (drain 50000)",
3442 );
3443 assert!(matches!(v, Value::Nil));
3445 }
3446
3447 #[test]
3448 fn tco_through_and_or_short_circuit_last() {
3449 let v = run_full(
3452 "(define (loop-and n)
3453 (and #t #t (if (<= n 0) :done (loop-and (- n 1)))))
3454 (loop-and 30000)",
3455 );
3456 assert!(matches!(v, Value::Keyword(s) if &*s == "done"));
3457 }
3458
3459 #[test]
3460 fn non_tail_recursion_still_works_for_small_n() {
3461 let v = run_full(
3465 "(define (fact n)
3466 (if (= n 0) 1 (* n (fact (- n 1)))))
3467 (fact 12)",
3468 );
3469 assert!(matches!(v, Value::Int(479_001_600)));
3471 }
3472
3473 #[test]
3476 fn error_constructor_returns_error_value() {
3477 let v = run_full("(error :validation \"bad input\")");
3478 match v {
3479 Value::Error(e) => {
3480 assert_eq!(&*e.tag, "validation");
3481 assert_eq!(&*e.message, "bad input");
3482 assert!(e.data.is_empty());
3483 }
3484 other => panic!("{other:?}"),
3485 }
3486 }
3487
3488 #[test]
3489 fn ex_info_uses_default_tag() {
3490 let v = run_full("(ex-info \"validation failed\" (list :field \"email\" :code 42))");
3491 match v {
3492 Value::Error(e) => {
3493 assert_eq!(&*e.tag, "ex-info");
3494 assert_eq!(&*e.message, "validation failed");
3495 assert_eq!(e.data.len(), 2);
3496 }
3497 other => panic!("{other:?}"),
3498 }
3499 }
3500
3501 #[test]
3502 fn error_predicate() {
3503 let v = run_full("(error? (error :x \"y\"))");
3504 assert!(matches!(v, Value::Bool(true)));
3505 let v = run_full("(error? 42)");
3506 assert!(matches!(v, Value::Bool(false)));
3507 }
3508
3509 #[test]
3510 fn error_accessors() {
3511 let v = run_full(
3512 "(let ((e (ex-info \"oops\" (list :user-id 42))))
3513 (list (error-tag e) (error-message e) (error-data-get e :user-id)))",
3514 );
3515 assert_eq!(format!("{v}"), "(:ex-info \"oops\" 42)");
3516 }
3517
3518 #[test]
3519 fn try_catches_thrown_error() {
3520 let v = run_full(
3521 "(try
3522 (throw (ex-info \"boom\" (list :code 500)))
3523 (catch (e)
3524 (error-message e)))",
3525 );
3526 assert_eq!(format!("{v}"), "\"boom\"");
3527 }
3528
3529 #[test]
3530 fn try_returns_body_value_when_no_throw() {
3531 let v = run_full(
3532 "(try
3533 (+ 1 2 3)
3534 (catch (e) :unreachable))",
3535 );
3536 assert!(matches!(v, Value::Int(6)));
3537 }
3538
3539 #[test]
3540 fn try_catches_runtime_errors_too() {
3541 let v = run_full(
3545 "(try
3546 (/ 1 0)
3547 (catch (e) (error-tag e)))",
3548 );
3549 assert!(matches!(v, Value::Keyword(s) if &*s == "division-by-zero"));
3550 }
3551
3552 #[test]
3553 fn try_catches_unbound_symbol_error() {
3554 let v = run_full(
3555 "(try
3556 undefined-var
3557 (catch (e) (error-tag e)))",
3558 );
3559 assert!(matches!(v, Value::Keyword(s) if &*s == "unbound-symbol"));
3560 }
3561
3562 #[test]
3563 fn try_catches_arity_mismatch() {
3564 let v = run_full(
3565 "(try
3566 ((lambda (x y) (+ x y)) 1)
3567 (catch (e) (error-tag e)))",
3568 );
3569 assert!(matches!(v, Value::Keyword(s) if &*s == "arity-mismatch"));
3570 }
3571
3572 #[test]
3573 fn nested_try_inner_handler_takes_precedence() {
3574 let v = run_full(
3575 "(try
3576 (try
3577 (throw (ex-info \"inner\" ()))
3578 (catch (e) :inner-caught))
3579 (catch (e) :outer-caught))",
3580 );
3581 assert!(matches!(v, Value::Keyword(s) if &*s == "inner-caught"));
3582 }
3583
3584 #[test]
3585 fn outer_try_catches_when_handler_rethrows() {
3586 let v = run_full(
3587 "(try
3588 (try
3589 (throw (ex-info \"first\" ()))
3590 (catch (e) (throw (ex-info \"rethrown\" ()))))
3591 (catch (e) (error-message e)))",
3592 );
3593 assert_eq!(format!("{v}"), "\"rethrown\"");
3594 }
3595
3596 #[test]
3597 fn throw_propagates_when_no_try() {
3598 let mut i: Interpreter<NoHost> = Interpreter::new();
3600 install_full_stdlib_with(&mut i, &mut NoHost);
3601 let forms = read_spanned("(throw (ex-info \"unhandled\" (list :code 99)))").unwrap();
3602 let err = i.eval_program(&forms, &mut NoHost).unwrap_err();
3603 match err {
3604 EvalError::User { value, .. } => match value {
3605 Value::Error(e) => {
3606 assert_eq!(&*e.message, "unhandled");
3607 }
3608 other => panic!("{other:?}"),
3609 },
3610 other => panic!("{other:?}"),
3611 }
3612 }
3613
3614 #[test]
3617 fn macroexpand_one_step() {
3618 let v = run_full(
3619 "(defmacro twice (x) `(* ,x 2))
3620 (macroexpand-1 '(twice 7))",
3621 );
3622 assert_eq!(format!("{v}"), "(* 7 2)");
3624 }
3625
3626 #[test]
3627 fn macroexpand_full_until_fixed_point() {
3628 let v = run_full(
3629 "(defmacro twice (x) `(* ,x 2))
3630 (defmacro quad (x) `(twice (twice ,x)))
3631 (macroexpand '(quad 5))",
3632 );
3633 assert_eq!(format!("{v}"), "(* (* 5 2) 2)");
3635 }
3636
3637 #[test]
3638 fn macroexpand_returns_unchanged_for_non_macro() {
3639 let v = run_full("(macroexpand-1 '(+ 1 2 3))");
3640 assert_eq!(format!("{v}"), "(+ 1 2 3)");
3642 }
3643
3644 #[test]
3645 fn macroexpand_one_does_not_recurse_into_children() {
3646 let v = run_full(
3648 "(defmacro twice (x) `(* ,x 2))
3649 (defmacro outer (x) `(list ,x))
3650 (macroexpand-1 '(outer (twice 3)))",
3651 );
3652 assert_eq!(format!("{v}"), "(list (twice 3))");
3654 }
3655
3656 #[test]
3657 fn macroexpand_recurses_into_children() {
3658 let v = run_full(
3659 "(defmacro twice (x) `(* ,x 2))
3660 (defmacro outer (x) `(list ,x))
3661 (macroexpand '(outer (twice 3)))",
3662 );
3663 assert_eq!(format!("{v}"), "(list (* 3 2))");
3665 }
3666
3667 fn run_with_modules(modules: &[(&str, &str)], src: &str) -> Value {
3670 use crate::module::MapLoader;
3671 let mut i: Interpreter<NoHost> = Interpreter::new();
3672 install_full_stdlib_with(&mut i, &mut NoHost);
3673 let mut loader = MapLoader::new();
3674 for (path, source) in modules {
3675 loader.insert(*path, *source);
3676 }
3677 i.set_loader(Arc::new(loader));
3678 let forms = read_spanned(src).unwrap();
3679 i.eval_program(&forms, &mut NoHost).unwrap()
3680 }
3681
3682 fn run_with_modules_err(modules: &[(&str, &str)], src: &str) -> EvalError {
3683 use crate::module::MapLoader;
3684 let mut i: Interpreter<NoHost> = Interpreter::new();
3685 install_full_stdlib_with(&mut i, &mut NoHost);
3686 let mut loader = MapLoader::new();
3687 for (path, source) in modules {
3688 loader.insert(*path, *source);
3689 }
3690 i.set_loader(Arc::new(loader));
3691 let forms = read_spanned(src).unwrap();
3692 i.eval_program(&forms, &mut NoHost).unwrap_err()
3693 }
3694
3695 #[test]
3696 fn require_with_explicit_alias_imports_qualified_names() {
3697 let v = run_with_modules(
3698 &[(
3699 "lib/math",
3700 "(define square (lambda (x) (* x x)))
3701 (define cube (lambda (x) (* x x x)))
3702 (provide square cube)",
3703 )],
3704 "(require \"lib/math\" :as math)
3705 (math/square 7)",
3706 );
3707 assert!(matches!(v, Value::Int(49)));
3708 }
3709
3710 #[test]
3711 fn require_uses_path_as_default_alias() {
3712 let v = run_with_modules(
3713 &[("lib/math", "(define double (lambda (x) (* x 2))) (provide double)")],
3714 "(require \"lib/math\")
3715 (lib/math/double 21)",
3716 );
3717 assert!(matches!(v, Value::Int(42)));
3720 }
3721
3722 #[test]
3723 fn require_refer_imports_unqualified_names() {
3724 let v = run_with_modules(
3725 &[(
3726 "lib/math",
3727 "(define square (lambda (x) (* x x)))
3728 (define cube (lambda (x) (* x x x)))
3729 (provide square cube)",
3730 )],
3731 "(require \"lib/math\" :refer (square))
3732 (square 6)",
3733 );
3734 assert!(matches!(v, Value::Int(36)));
3735 }
3736
3737 #[test]
3738 fn require_does_not_import_non_provided() {
3739 let err = run_with_modules_err(
3742 &[(
3743 "lib/secret",
3744 "(define public 1)
3745 (define private 2)
3746 (provide public)",
3747 )],
3748 "(require \"lib/secret\" :as s)
3749 s/private",
3750 );
3751 match err {
3752 EvalError::UnboundSymbol { name, .. } => assert_eq!(&*name, "s/private"),
3753 other => panic!("{other:?}"),
3754 }
3755 }
3756
3757 #[test]
3758 fn require_chain_a_imports_b() {
3759 let v = run_with_modules(
3760 &[
3761 (
3762 "lib/util",
3763 "(define inc1 (lambda (n) (+ n 1)))
3764 (provide inc1)",
3765 ),
3766 (
3767 "lib/wrapper",
3768 "(require \"lib/util\" :as u)
3769 (define inc2 (lambda (n) (u/inc1 (u/inc1 n))))
3770 (provide inc2)",
3771 ),
3772 ],
3773 "(require \"lib/wrapper\" :as w)
3774 (w/inc2 10)",
3775 );
3776 assert!(matches!(v, Value::Int(12)));
3777 }
3778
3779 #[test]
3780 fn require_module_not_found() {
3781 let err = run_with_modules_err(&[], "(require \"missing/module\")");
3782 match err {
3784 EvalError::User { value, .. } => match value {
3785 Value::Error(e) => {
3786 assert_eq!(&*e.tag, "module-not-found");
3787 assert!(e.message.contains("missing/module"));
3788 }
3789 other => panic!("{other:?}"),
3790 },
3791 other => panic!("{other:?}"),
3792 }
3793 }
3794
3795 #[test]
3796 fn circular_require_detected() {
3797 let err = run_with_modules_err(
3798 &[
3799 ("a", "(require \"b\") (provide x) (define x 1)"),
3800 ("b", "(require \"a\") (provide y) (define y 2)"),
3801 ],
3802 "(require \"a\")",
3803 );
3804 match err {
3805 EvalError::User { value, .. } => match value {
3806 Value::Error(e) => assert_eq!(&*e.tag, "circular-require"),
3807 other => panic!("{other:?}"),
3808 },
3809 other => panic!("{other:?}"),
3810 }
3811 }
3812
3813 #[test]
3814 fn provide_at_top_level_errors() {
3815 let mut i: Interpreter<NoHost> = Interpreter::new();
3817 install_full_stdlib_with(&mut i, &mut NoHost);
3818 let forms = read_spanned("(provide x)").unwrap();
3819 let err = i.eval_program(&forms, &mut NoHost).unwrap_err();
3820 assert!(matches!(err, EvalError::BadSpecialForm { form, .. } if &*form == "provide"));
3821 }
3822
3823 #[test]
3824 fn require_refer_unknown_name_errors() {
3825 let err = run_with_modules_err(
3826 &[(
3827 "lib/math",
3828 "(define square (lambda (x) (* x x))) (provide square)",
3829 )],
3830 "(require \"lib/math\" :refer (square cube))",
3831 );
3832 match err {
3833 EvalError::User { value, .. } => match value {
3834 Value::Error(e) => {
3835 assert!(matches!(&*e.tag, "not-defined" | "not-exported"));
3836 }
3837 other => panic!("{other:?}"),
3838 },
3839 other => panic!("{other:?}"),
3840 }
3841 }
3842
3843 #[test]
3844 fn require_caches_module_load_once() {
3845 let v = run_with_modules(
3846 &[(
3847 "lib/foo",
3848 "(define x 42) (provide x)",
3849 )],
3850 "(require \"lib/foo\" :as a)
3851 (require \"lib/foo\" :as b)
3852 (+ a/x b/x)",
3853 );
3854 assert!(matches!(v, Value::Int(84)));
3856 }
3857
3858 #[test]
3867 fn macro_body_cannot_set_a_global() {
3868 let mut interp = Interpreter::new();
3869 install_primitives(&mut interp);
3870 let src = "(define *g* 0) (defmacro leak () (set! *g* 99)) (leak)";
3871 let forms = tatara_lisp::read_spanned(src).expect("parse");
3872 let err = interp
3873 .eval_program(&forms, &mut ())
3874 .expect_err("a macro must not be able to set! a global");
3875 let msg = format!("{err}");
3876 assert!(
3877 msg.contains("sealed") || msg.contains("cannot `set!`"),
3878 "expected a sealed-write diagnostic, got: {msg}"
3879 );
3880 }
3881
3882 #[test]
3883 fn the_global_is_actually_unchanged_after_a_refused_macro_set() {
3884 let mut interp = Interpreter::new();
3885 install_primitives(&mut interp);
3886 let forms = tatara_lisp::read_spanned(
3887 "(define *g* 0) (defmacro leak () (set! *g* 99))",
3888 )
3889 .expect("parse");
3890 interp.eval_program(&forms, &mut ()).expect("setup");
3891 let call = tatara_lisp::read_spanned("(leak)").expect("parse");
3893 let _ = interp.eval_program(&call, &mut ());
3894 let read = tatara_lisp::read_spanned("*g*").expect("parse");
3895 let v = interp.eval_program(&read, &mut ()).expect("read *g*");
3896 assert!(
3897 matches!(v, Value::Int(0)),
3898 "global was mutated by a macro body despite the seal: {v:?}"
3899 );
3900 }
3901
3902 #[test]
3905 fn ordinary_set_still_works_at_runtime() {
3906 let mut interp = Interpreter::new();
3907 install_primitives(&mut interp);
3908 let forms =
3909 tatara_lisp::read_spanned("(define x 1) (set! x 42) x").expect("parse");
3910 let v = interp.eval_program(&forms, &mut ()).expect("runtime set!");
3911 assert!(matches!(v, Value::Int(42)), "got {v:?}");
3912 }
3913
3914 #[test]
3917 fn macro_body_can_mutate_its_own_locals() {
3918 let mut interp = Interpreter::new();
3919 install_primitives(&mut interp);
3920 let src = "(defmacro m () (begin (define n 1) (set! n 2) n)) (m)";
3921 let forms = tatara_lisp::read_spanned(src).expect("parse");
3922 let v = interp
3923 .eval_program(&forms, &mut ())
3924 .expect("a macro must be able to mutate its own locals");
3925 assert!(matches!(v, Value::Int(2)), "got {v:?}");
3926 }
3927
3928}