1use std::sync::Arc;
10
11use tatara_lisp::{Atom, MacroDef, MacroParams, Span, Spanned, SpannedExpander, SpannedForm};
12
13use crate::code::{spanned_to_value, value_to_spanned};
14use crate::env::{Env, Seal};
15use crate::error::{EvalError, Result};
16use crate::ffi::{
17 Arity, Caller, FnEntry, FnImpl, FnRegistry, FromValue, HigherOrderCallable, IntoValue,
18 NativeCallable,
19};
20use crate::module::{Loader, Module, ModuleError, ModuleRegistry, NoLoader};
21use crate::special::SpecialForm;
22use crate::value::{Closure, ErrorObj, NativeFn, Value};
23
24pub const DEFAULT_MACRO_EXPANSION_LIMIT: usize = 256;
34
35#[derive(Clone, Copy, Debug, PartialEq, Eq, PartialOrd, Ord)]
39pub enum HeadBinding {
40 SpecialForm,
43 Macro,
46 Value,
48}
49
50pub struct Interpreter<H> {
51 pub(crate) registry: FnRegistry<H>,
52 pub(crate) globals: Env,
53 pub(crate) expander: SpannedExpander,
58 pub(crate) modules: ModuleRegistry,
62 pub(crate) loader: Arc<dyn Loader>,
65 pub(crate) macro_expansion_limit: usize,
72 pub(crate) current_module: Option<Arc<str>>,
77}
78
79impl<H: 'static> Interpreter<H> {
80 pub fn new() -> Self {
81 Self {
82 registry: FnRegistry::new(),
83 globals: Env::new(),
84 expander: SpannedExpander::new(),
85 modules: ModuleRegistry::new(),
86 loader: Arc::new(NoLoader),
87 macro_expansion_limit: DEFAULT_MACRO_EXPANSION_LIMIT,
88 current_module: None,
89 }
90 }
91
92 pub fn fork(&self) -> Self {
131 Self {
132 registry: self.registry.clone(),
133 globals: self.globals.sealed_below_top(Seal::Fork),
134 expander: self.expander.clone(),
135 modules: self.modules.clone(),
136 loader: Arc::clone(&self.loader),
137 macro_expansion_limit: self.macro_expansion_limit,
138 current_module: self.current_module.clone(),
139 }
140 }
141
142 pub fn set_loader(&mut self, loader: Arc<dyn Loader>) {
145 self.loader = loader;
146 }
147
148 pub fn modules(&self) -> &ModuleRegistry {
150 &self.modules
151 }
152
153 pub fn register_fn<F>(&mut self, name: impl Into<Arc<str>>, arity: Arity, callable: F)
157 where
158 F: NativeCallable<H>,
159 {
160 let name = name.into();
161 self.registry.insert(FnEntry {
162 name: name.clone(),
163 arity,
164 callable: FnImpl::Native(Arc::new(callable)),
165 });
166 self.globals.define(
167 name.clone(),
168 Value::NativeFn(Arc::new(NativeFn { name, arity })),
169 );
170 }
171
172 pub fn register_higher_order_fn<F>(
177 &mut self,
178 name: impl Into<Arc<str>>,
179 arity: Arity,
180 callable: F,
181 ) where
182 F: HigherOrderCallable<H>,
183 {
184 let name = name.into();
185 self.registry.insert(FnEntry {
186 name: name.clone(),
187 arity,
188 callable: FnImpl::Higher(Arc::new(callable)),
189 });
190 self.globals.define(
191 name.clone(),
192 Value::NativeFn(Arc::new(NativeFn { name, arity })),
193 );
194 }
195
196 pub fn register_awaitable_fn<R, C>(
246 &mut self,
247 name: impl Into<Arc<str>>,
248 arity: Arity,
249 ready: R,
250 call: C,
251 ) where
252 R: Fn(&[Value], &H) -> bool + Send + Sync + 'static,
253 C: Fn(&[Value], &mut H, Span) -> Result<Value> + Send + Sync + 'static,
254 {
255 let name = name.into();
256 self.registry.insert(FnEntry {
257 name: name.clone(),
258 arity,
259 callable: FnImpl::Awaitable(Arc::new(crate::ffi::Awaitable { ready, call })),
260 });
261 self.globals.define(
262 name.clone(),
263 Value::NativeFn(Arc::new(NativeFn { name, arity })),
264 );
265 }
266
267 pub fn set_macro_expansion_limit(&mut self, limit: usize) {
272 self.macro_expansion_limit = limit;
273 }
274
275 pub fn eval_spanned(&mut self, form: &Spanned, host: &mut H) -> Result<Value> {
280 let expanded = self.fully_expand(form, host)?;
281 eval_in(
282 &mut self.globals,
283 &self.registry,
284 &self.expander,
285 &expanded,
286 host,
287 )
288 }
289
290 pub fn eval_program(&mut self, forms: &[Spanned], host: &mut H) -> Result<Value> {
302 let mut last = Value::Nil;
303 for form in forms {
304 last = self.eval_top_form(form, host)?;
305 }
306 Ok(last)
307 }
308
309 pub fn eval_top_form(&mut self, form: &Spanned, host: &mut H) -> Result<Value> {
315 if self.expander.try_register_macro(form)? {
316 return Ok(Value::Nil);
317 }
318 if let Some(head) = head_symbol(form) {
322 match head {
323 "provide" => return self.eval_provide(form, host),
324 "require" => return self.eval_require(form, host),
325 _ => {}
326 }
327 }
328 let expanded = self.fully_expand(form, host)?;
329 eval_in(
330 &mut self.globals,
331 &self.registry,
332 &self.expander,
333 &expanded,
334 host,
335 )
336 }
337
338 fn eval_provide(&mut self, form: &Spanned, _host: &mut H) -> Result<Value> {
342 let items = form.as_list().unwrap_or(&[]);
343 let span = form.span;
344 let Some(current) = self.current_module.clone() else {
345 return Err(EvalError::bad_form(
346 "provide",
347 "`provide` only valid at module top level — embedder evaluating top-level code has no current module",
348 span,
349 ));
350 };
351 let mut names: Vec<Arc<str>> = Vec::with_capacity(items.len().saturating_sub(1));
353 for item in &items[1..] {
354 let name = item.as_symbol().ok_or_else(|| {
355 EvalError::bad_form(
356 "provide",
357 "expected symbol — every arg must name a binding to export",
358 item.span,
359 )
360 })?;
361 names.push(Arc::<str>::from(name));
362 }
363 {
368 let mut g = self.modules.inner_lock();
369 g.exports_staging
373 .entry(current.to_string())
374 .or_default()
375 .extend(names.iter().cloned());
376 }
377 Ok(Value::Nil)
378 }
379
380 fn eval_require(&mut self, form: &Spanned, host: &mut H) -> Result<Value> {
389 let items = form.as_list().unwrap_or(&[]);
390 let span = form.span;
391 if items.len() < 2 {
392 return Err(EvalError::bad_form(
393 "require",
394 "expected (require \"path\" [:as alias] [:refer (...)])",
395 span,
396 ));
397 }
398 let path: Arc<str> = match items[1].as_string() {
399 Some(s) => Arc::from(s),
400 None => {
401 return Err(EvalError::bad_form(
402 "require",
403 "first arg must be a string path",
404 items[1].span,
405 ))
406 }
407 };
408
409 let mut alias: Option<Arc<str>> = None;
411 let mut refer: Option<Vec<Arc<str>>> = None;
412 let mut i = 2usize;
413 while i < items.len() {
414 let kw = items[i].as_keyword().ok_or_else(|| {
415 EvalError::bad_form(
416 "require",
417 "expected keyword (:as / :refer) after path",
418 items[i].span,
419 )
420 })?;
421 let val = items.get(i + 1).ok_or_else(|| {
422 EvalError::bad_form("require", "keyword without value", items[i].span)
423 })?;
424 match kw {
425 "as" => {
426 alias = Some(Arc::from(val.as_symbol().ok_or_else(|| {
427 EvalError::bad_form("require", ":as needs a symbol alias", val.span)
428 })?));
429 }
430 "refer" => {
431 let names_list = val.as_list().ok_or_else(|| {
432 EvalError::bad_form(
433 "require",
434 ":refer needs a parenthesized list of symbols",
435 val.span,
436 )
437 })?;
438 let mut names = Vec::with_capacity(names_list.len());
439 for n in names_list {
440 names.push(Arc::<str>::from(n.as_symbol().ok_or_else(|| {
441 EvalError::bad_form(
442 "require",
443 ":refer list must contain symbols only",
444 n.span,
445 )
446 })?));
447 }
448 refer = Some(names);
449 }
450 other => {
451 return Err(EvalError::bad_form(
452 "require",
453 format!("unknown require option :{other}"),
454 items[i].span,
455 ));
456 }
457 }
458 i += 2;
459 }
460
461 if !self.modules.has(&path) {
463 self.load_module(&path, span, host)?;
464 }
465 let module = self.modules.get(&path).ok_or_else(|| {
466 EvalError::native_fn("require", "module disappeared after load", span)
467 })?;
468
469 let chosen_alias = alias.unwrap_or_else(|| path.clone());
471 for name in &module.exports {
472 let value = module.bindings.get(name).cloned().unwrap_or(Value::Nil);
473 let qualified: Arc<str> = Arc::from(format!("{chosen_alias}/{name}"));
474 self.globals.define(qualified, value);
475 }
476 if let Some(names) = refer {
477 for name in names {
478 if let Some(value) = module.bindings.get(&name) {
479 if module.exports.contains(&name) {
480 self.globals.define(name.clone(), value.clone());
481 } else {
482 return Err(EvalError::User {
483 value: error_value(
484 "not-exported",
485 &format!("{path} does not export {name}"),
486 ),
487 at: span,
488 });
489 }
490 } else {
491 return Err(EvalError::User {
492 value: error_value(
493 "not-defined",
494 &format!("{path} does not define {name}"),
495 ),
496 at: span,
497 });
498 }
499 }
500 }
501 Ok(Value::Nil)
502 }
503
504 fn load_module(&mut self, path: &str, span: Span, host: &mut H) -> Result<()> {
510 self.modules
512 .begin_load(path)
513 .map_err(|e| module_error_to_eval(e, span))?;
514
515 let source = match self.loader.load(path) {
517 Ok(s) => s,
518 Err(e) => {
519 self.modules.abort_load(path);
520 return Err(module_error_to_eval(e, span));
521 }
522 };
523
524 let forms = match tatara_lisp::read_spanned(&source) {
526 Ok(f) => f,
527 Err(e) => {
528 self.modules.abort_load(path);
529 return Err(EvalError::Reader(e));
530 }
531 };
532
533 let saved_globals = std::mem::replace(&mut self.globals, Env::new());
537 for (name, value) in saved_globals.iter_top_level() {
541 if matches!(value, Value::NativeFn(_) | Value::Closure(_)) {
545 self.globals.define(name.clone(), value.clone());
546 }
547 }
548 let saved_current = self.current_module.replace(Arc::from(path));
549
550 let mut eval_err: Option<EvalError> = None;
552 for f in &forms {
553 if let Err(e) = self.eval_top_form(f, host) {
557 eval_err = Some(e);
558 break;
559 }
560 }
561
562 let module_globals = std::mem::replace(&mut self.globals, saved_globals);
564 self.current_module = saved_current;
565
566 if let Some(e) = eval_err {
567 self.modules.abort_load(path);
568 return Err(e);
569 }
570
571 let mut module = Module::new(path);
574 for (name, value) in module_globals.iter_top_level() {
575 if !matches!(value, Value::NativeFn(_)) {
578 module.define(name.clone(), value.clone());
579 }
580 }
581 let staged = {
583 let mut g = self.modules.inner_lock();
584 g.exports_staging.remove(path).unwrap_or_default()
585 };
586 for n in staged {
587 module.add_export(n);
588 }
589 self.modules.finish_load(module);
590 Ok(())
591 }
592
593 pub fn fully_expand(&mut self, form: &Spanned, host: &mut H) -> Result<Spanned> {
604 if self.expander.is_empty() {
606 return Ok(form.clone());
607 }
608 self.expand_recursive(form, host)
609 }
610
611 fn expand_recursive(&mut self, form: &Spanned, host: &mut H) -> Result<Spanned> {
612 self.expand_at_depth(form, host, 0)
613 }
614
615 fn expand_at_depth(&mut self, form: &Spanned, host: &mut H, depth: usize) -> Result<Spanned> {
632 match &form.form {
633 SpannedForm::List(items) if !items.is_empty() => {
634 if let Some(head) = items[0].as_symbol() {
635 if self.expander.has(head) {
636 if depth >= self.macro_expansion_limit {
637 return Err(EvalError::MacroExpansionLimit {
642 macro_name: head.into(),
643 limit: self.macro_expansion_limit,
644 at: form.span,
645 });
646 }
647 let expanded =
651 self.expand_macro_call(head, &items[1..], form.span, host)?;
652 return self.expand_at_depth(&expanded, host, depth + 1);
653 }
654 }
655 let mut out = Vec::with_capacity(items.len());
659 for child in items {
660 out.push(self.expand_at_depth(child, host, depth)?);
661 }
662 Ok(Spanned::new(form.span, SpannedForm::List(out)))
663 }
664 SpannedForm::Quote(_) => {
665 Ok(form.clone())
667 }
668 SpannedForm::Quasiquote(inner) => {
669 Ok(Spanned::new(
671 form.span,
672 SpannedForm::Quasiquote(Box::new(self.expand_inside_quasiquote(inner, host)?)),
673 ))
674 }
675 _ => Ok(form.clone()),
677 }
678 }
679
680 fn expand_inside_quasiquote(&mut self, form: &Spanned, host: &mut H) -> Result<Spanned> {
681 match &form.form {
682 SpannedForm::Unquote(inner) => Ok(Spanned::new(
683 form.span,
684 SpannedForm::Unquote(Box::new(self.expand_recursive(inner, host)?)),
685 )),
686 SpannedForm::UnquoteSplice(inner) => Ok(Spanned::new(
687 form.span,
688 SpannedForm::UnquoteSplice(Box::new(self.expand_recursive(inner, host)?)),
689 )),
690 SpannedForm::List(items) => {
691 let mut out = Vec::with_capacity(items.len());
692 for item in items {
693 out.push(self.expand_inside_quasiquote(item, host)?);
694 }
695 Ok(Spanned::new(form.span, SpannedForm::List(out)))
696 }
697 _ => Ok(form.clone()),
698 }
699 }
700
701 fn expand_macro_call(
705 &mut self,
706 macro_name: &str,
707 args: &[Spanned],
708 call_span: Span,
709 host: &mut H,
710 ) -> Result<Spanned> {
711 let def: MacroDef = self
714 .expander
715 .get_macro(macro_name)
716 .cloned()
717 .ok_or_else(|| {
718 EvalError::native_fn(
719 Arc::<str>::from(macro_name),
720 "macro disappeared during expansion",
721 call_span,
722 )
723 })?;
724
725 let body_spanned = Spanned::from_sexp_at(&def.body, call_span);
730
731 let body_expanded = self.fully_expand(&body_spanned, host)?;
737
738 let mut macro_env = self.globals.sealed_below_top(Seal::MacroExpansion);
746 bind_macro_args(&mut macro_env, &def.name, &def.params, args, call_span)?;
747
748 let result = eval_in(
751 &mut macro_env,
752 &self.registry,
753 &self.expander,
754 &body_expanded,
755 host,
756 )?;
757
758 value_to_spanned(&result, call_span).map_err(|reason| {
762 EvalError::native_fn(
763 Arc::<str>::from(format!("macro {macro_name}")),
764 reason,
765 call_span,
766 )
767 })
768 }
769
770 pub fn expander(&self) -> &SpannedExpander {
773 &self.expander
774 }
775
776 pub fn expander_mut(&mut self) -> &mut SpannedExpander {
780 &mut self.expander
781 }
782
783 pub fn lookup_global(&self, name: &str) -> Option<Value> {
785 self.globals.lookup(name)
786 }
787
788 pub fn define_global(&mut self, name: impl Into<Arc<str>>, value: Value) {
790 self.globals.define(name, value);
791 }
792
793 pub fn globals_snapshot(&self) -> &Env {
796 &self.globals
797 }
798
799 #[must_use]
821 pub fn resolve_head(&self, name: &str) -> Option<HeadBinding> {
822 if SpecialForm::from_symbol(name).is_some() {
823 Some(HeadBinding::SpecialForm)
824 } else if self.expander.has(name) {
825 Some(HeadBinding::Macro)
826 } else if self.globals.lookup(name).is_some() {
827 Some(HeadBinding::Value)
828 } else {
829 None
830 }
831 }
832
833 #[must_use]
840 pub fn reserved_head_names(&self) -> std::collections::BTreeSet<Arc<str>> {
841 let mut out: std::collections::BTreeSet<Arc<str>> = SpecialForm::ALL
842 .iter()
843 .map(|sf| Arc::from(sf.symbol()))
844 .collect();
845 out.extend(
846 self.expander
847 .macro_names()
848 .map(Arc::from)
849 .collect::<Vec<Arc<str>>>(),
850 );
851 out.extend(self.globals.iter_top_level().into_iter().map(|(n, _)| n));
852 out
853 }
854
855 pub fn apply_external_value(
859 &mut self,
860 callee: &Value,
861 args: Vec<Value>,
862 host: &mut H,
863 call_span: Span,
864 ) -> Result<Value> {
865 apply_external(
866 callee,
867 args,
868 call_span,
869 &self.registry,
870 &self.expander,
871 host,
872 )
873 }
874
875 pub fn eval_program_vm(&mut self, forms: &[Spanned], host: &mut H) -> Result<Value> {
882 let mut expanded: Vec<Spanned> = Vec::with_capacity(forms.len());
883 for form in forms {
884 if self.expander.try_register_macro(form)? {
885 continue;
886 }
887 expanded.push(self.fully_expand(form, host)?);
888 }
889 let chunk = crate::vm::compile_program(&expanded).map_err(|e| match e {
890 crate::vm::CompileError::Bad { at, message } => {
891 EvalError::bad_form(Arc::<str>::from("vm:compile"), message, at)
892 }
893 })?;
894 let mut vm = crate::vm::Vm::new();
895 vm.run(&chunk, self, host).map_err(|e| match e {
896 crate::vm::VmError::Eval(inner) => inner,
897 other => EvalError::native_fn(
898 Arc::<str>::from("vm"),
899 format!("{other}"),
900 Span::synthetic(),
901 ),
902 })
903 }
904
905 pub fn register_typed0<R, F>(&mut self, name: impl Into<Arc<str>>, f: F)
909 where
910 R: IntoValue + 'static,
911 F: Fn(&mut H) -> Result<R> + Send + Sync + 'static,
912 {
913 self.register_fn(
914 name,
915 Arity::Exact(0),
916 move |_args: &[Value], host: &mut H, _sp| f(host).map(IntoValue::into_value),
917 );
918 }
919
920 pub fn register_typed1<A, R, F>(&mut self, name: impl Into<Arc<str>>, f: F)
922 where
923 A: FromValue + 'static,
924 R: IntoValue + 'static,
925 F: Fn(&mut H, A) -> Result<R> + Send + Sync + 'static,
926 {
927 self.register_fn(
928 name,
929 Arity::Exact(1),
930 move |args: &[Value], host: &mut H, sp| {
931 let a = A::from_value(&args[0], sp)?;
932 f(host, a).map(IntoValue::into_value)
933 },
934 );
935 }
936
937 pub fn register_typed2<A, B, R, F>(&mut self, name: impl Into<Arc<str>>, f: F)
939 where
940 A: FromValue + 'static,
941 B: FromValue + 'static,
942 R: IntoValue + 'static,
943 F: Fn(&mut H, A, B) -> Result<R> + Send + Sync + 'static,
944 {
945 self.register_fn(
946 name,
947 Arity::Exact(2),
948 move |args: &[Value], host: &mut H, sp| {
949 let a = A::from_value(&args[0], sp)?;
950 let b = B::from_value(&args[1], sp)?;
951 f(host, a, b).map(IntoValue::into_value)
952 },
953 );
954 }
955
956 pub fn register_typed3<A, B, C, R, F>(&mut self, name: impl Into<Arc<str>>, f: F)
958 where
959 A: FromValue + 'static,
960 B: FromValue + 'static,
961 C: FromValue + 'static,
962 R: IntoValue + 'static,
963 F: Fn(&mut H, A, B, C) -> Result<R> + Send + Sync + 'static,
964 {
965 self.register_fn(
966 name,
967 Arity::Exact(3),
968 move |args: &[Value], host: &mut H, sp| {
969 let a = A::from_value(&args[0], sp)?;
970 let b = B::from_value(&args[1], sp)?;
971 let c = C::from_value(&args[2], sp)?;
972 f(host, a, b, c).map(IntoValue::into_value)
973 },
974 );
975 }
976
977 pub fn register_typed4<A, B, C, D, R, F>(&mut self, name: impl Into<Arc<str>>, f: F)
979 where
980 A: FromValue + 'static,
981 B: FromValue + 'static,
982 C: FromValue + 'static,
983 D: FromValue + 'static,
984 R: IntoValue + 'static,
985 F: Fn(&mut H, A, B, C, D) -> Result<R> + Send + Sync + 'static,
986 {
987 self.register_fn(
988 name,
989 Arity::Exact(4),
990 move |args: &[Value], host: &mut H, sp| {
991 let a = A::from_value(&args[0], sp)?;
992 let b = B::from_value(&args[1], sp)?;
993 let c = C::from_value(&args[2], sp)?;
994 let d = D::from_value(&args[3], sp)?;
995 f(host, a, b, c, d).map(IntoValue::into_value)
996 },
997 );
998 }
999}
1000
1001impl<H: 'static> Default for Interpreter<H> {
1002 fn default() -> Self {
1003 Self::new()
1004 }
1005}
1006
1007pub(crate) fn eval_in<H: 'static>(
1012 env: &mut Env,
1013 registry: &FnRegistry<H>,
1014 expander: &SpannedExpander,
1015 form: &Spanned,
1016 host: &mut H,
1017) -> Result<Value> {
1018 match &form.form {
1019 SpannedForm::Nil => Ok(Value::Nil),
1020 SpannedForm::Atom(a) => eval_atom(a, form.span, env),
1021 SpannedForm::Quote(inner) => Ok(quoted_value(inner)),
1022 SpannedForm::Quasiquote(inner) => quasiquote_eval(inner, env, registry, expander, host),
1023 SpannedForm::Unquote(_) | SpannedForm::UnquoteSplice(_) => Err(EvalError::bad_form(
1024 "unquote",
1025 "unquote outside of quasiquote",
1026 form.span,
1027 )),
1028 SpannedForm::List(items) => {
1029 if items.is_empty() {
1030 return Ok(Value::Nil);
1031 }
1032 if let Some(head_sym) = items[0].as_symbol() {
1036 if let Some(sf) = SpecialForm::from_symbol(head_sym) {
1037 return eval_special(sf, items, form.span, env, registry, expander, host);
1038 }
1039 }
1040 eval_application(items, form.span, env, registry, expander, host)
1041 }
1042 }
1043}
1044
1045fn eval_atom(a: &Atom, span: Span, env: &Env) -> Result<Value> {
1046 match a {
1047 Atom::Symbol(name) => env
1048 .lookup(name)
1049 .ok_or_else(|| EvalError::unbound(name.as_str(), span)),
1050 Atom::Keyword(s) => Ok(Value::Keyword(crate::interner::intern(s.as_str()))),
1051 Atom::Str(s) => Ok(Value::Str(Arc::from(s.as_str()))),
1052 Atom::Int(n) => Ok(Value::Int(*n)),
1053 Atom::Float(n) => Ok(Value::Float(*n)),
1054 Atom::Bool(b) => Ok(Value::Bool(*b)),
1055 }
1056}
1057
1058fn quoted_value(inner: &Spanned) -> Value {
1062 crate::code::spanned_to_value(inner)
1063}
1064
1065fn quasiquote_eval<H: 'static>(
1071 form: &Spanned,
1072 env: &mut Env,
1073 registry: &FnRegistry<H>,
1074 expander: &SpannedExpander,
1075 host: &mut H,
1076) -> Result<Value> {
1077 match &form.form {
1078 SpannedForm::Unquote(inner) => eval_in(env, registry, expander, inner, host),
1079 SpannedForm::UnquoteSplice(_) => Err(EvalError::bad_form(
1080 "unquote-splice",
1081 "`,@` only valid directly inside a list",
1082 form.span,
1083 )),
1084 SpannedForm::List(items) => {
1085 let mut out: Vec<Value> = Vec::with_capacity(items.len());
1086 for item in items {
1087 if let SpannedForm::UnquoteSplice(inner) = &item.form {
1088 let v = eval_in(env, registry, expander, inner, host)?;
1089 match v {
1090 Value::List(xs) => out.extend(xs.iter().cloned()),
1091 Value::Nil => {}
1092 other => {
1093 return Err(EvalError::type_mismatch(
1094 "list",
1095 other.type_name(),
1096 item.span,
1097 ))
1098 }
1099 }
1100 } else {
1101 out.push(quasiquote_eval(item, env, registry, expander, host)?);
1102 }
1103 }
1104 if out.is_empty() {
1105 Ok(Value::Nil)
1106 } else {
1107 Ok(Value::list(out))
1108 }
1109 }
1110 SpannedForm::Nil => Ok(Value::Nil),
1111 SpannedForm::Atom(a) => Ok(match a {
1112 Atom::Symbol(s) => Value::Symbol(crate::interner::intern(s.as_str())),
1113 Atom::Keyword(s) => Value::Keyword(crate::interner::intern(s.as_str())),
1114 Atom::Str(s) => Value::Str(Arc::from(s.as_str())),
1115 Atom::Int(n) => Value::Int(*n),
1116 Atom::Float(n) => Value::Float(*n),
1117 Atom::Bool(b) => Value::Bool(*b),
1118 }),
1119 SpannedForm::Quote(_) | SpannedForm::Quasiquote(_) => {
1123 Ok(Value::Sexp(form.to_sexp(), form.span))
1124 }
1125 }
1126}
1127
1128fn eval_application<H: 'static>(
1131 items: &[Spanned],
1132 call_span: Span,
1133 env: &mut Env,
1134 registry: &FnRegistry<H>,
1135 expander: &SpannedExpander,
1136 host: &mut H,
1137) -> Result<Value> {
1138 let head_val = eval_in(env, registry, expander, &items[0], host)?;
1139 let mut args: Vec<Value> = Vec::with_capacity(items.len().saturating_sub(1));
1140 for arg_form in &items[1..] {
1141 args.push(eval_in(env, registry, expander, arg_form, host)?);
1142 }
1143 apply(&head_val, args, call_span, registry, expander, host)
1144}
1145
1146fn apply<H: 'static>(
1147 callee: &Value,
1148 args: Vec<Value>,
1149 call_span: Span,
1150 registry: &FnRegistry<H>,
1151 expander: &SpannedExpander,
1152 host: &mut H,
1153) -> Result<Value> {
1154 match callee {
1155 Value::NativeFn(nfn) => {
1156 if nfn.arity.check(args.len()).is_err() {
1157 return Err(EvalError::ArityMismatch {
1158 fn_name: nfn.name.clone(),
1159 expected: nfn.arity,
1160 got: args.len(),
1161 at: call_span,
1162 });
1163 }
1164 let entry = registry.lookup(&nfn.name).ok_or_else(|| {
1165 EvalError::native_fn(
1166 nfn.name.clone(),
1167 format!("native fn {} is not registered", nfn.name),
1168 call_span,
1169 )
1170 })?;
1171 match &entry.callable {
1172 FnImpl::Native(f) => f.call(&args, host, call_span),
1173 FnImpl::Higher(f) => {
1174 let caller = Caller { registry, expander };
1175 f.call(&args, host, &caller, call_span)
1176 }
1177 FnImpl::Awaitable(f) => {
1182 if f.ready(&args, host) {
1183 f.call(&args, host, call_span)
1184 } else {
1185 Ok(crate::vm::Vm::park())
1186 }
1187 }
1188 }
1189 }
1190 Value::Closure(c) => call_closure(c.clone(), args, call_span, registry, expander, host),
1191 Value::Foreign(any) => {
1196 if let Some(cc) = any
1197 .clone()
1198 .downcast::<crate::vm::run::CompiledClosure>()
1199 .ok()
1200 {
1201 let lifted = cc.lift_to_closure();
1202 return call_closure(lifted, args, call_span, registry, expander, host);
1203 }
1204 Err(EvalError::NotCallable {
1205 value_kind: callee.type_name(),
1206 at: call_span,
1207 })
1208 }
1209 other => Err(EvalError::NotCallable {
1210 value_kind: other.type_name(),
1211 at: call_span,
1212 }),
1213 }
1214}
1215
1216enum TailResult {
1239 Done(Value),
1241 Resume(Arc<Closure>, Vec<Value>, Span),
1246}
1247
1248fn eval_in_tail<H: 'static>(
1252 env: &mut Env,
1253 registry: &FnRegistry<H>,
1254 expander: &SpannedExpander,
1255 form: &Spanned,
1256 host: &mut H,
1257) -> Result<TailResult> {
1258 match &form.form {
1259 SpannedForm::List(items) if !items.is_empty() => {
1260 if let Some(head_sym) = items[0].as_symbol() {
1262 if let Some(sf) = SpecialForm::from_symbol(head_sym) {
1263 return eval_special_tail(sf, items, form.span, env, registry, expander, host);
1264 }
1265 }
1266 let head_val = eval_in(env, registry, expander, &items[0], host)?;
1269 let mut args: Vec<Value> = Vec::with_capacity(items.len().saturating_sub(1));
1270 for arg_form in &items[1..] {
1271 args.push(eval_in(env, registry, expander, arg_form, host)?);
1272 }
1273 match head_val {
1274 Value::Closure(c) => Ok(TailResult::Resume(c, args, form.span)),
1275 _ => apply(&head_val, args, form.span, registry, expander, host)
1276 .map(TailResult::Done),
1277 }
1278 }
1279 _ => eval_in(env, registry, expander, form, host).map(TailResult::Done),
1281 }
1282}
1283
1284fn eval_special_tail<H: 'static>(
1285 sf: SpecialForm,
1286 items: &[Spanned],
1287 call_span: Span,
1288 env: &mut Env,
1289 registry: &FnRegistry<H>,
1290 expander: &SpannedExpander,
1291 host: &mut H,
1292) -> Result<TailResult> {
1293 match sf {
1294 SpecialForm::If => {
1295 if items.len() < 3 || items.len() > 4 {
1296 return eval_special(sf, items, call_span, env, registry, expander, host)
1297 .map(TailResult::Done);
1298 }
1299 let c = eval_in(env, registry, expander, &items[1], host)?;
1300 if c.is_truthy() {
1301 eval_in_tail(env, registry, expander, &items[2], host)
1302 } else if items.len() == 4 {
1303 eval_in_tail(env, registry, expander, &items[3], host)
1304 } else {
1305 Ok(TailResult::Done(Value::Nil))
1306 }
1307 }
1308 SpecialForm::Begin => {
1309 let body = &items[1..];
1310 if body.is_empty() {
1311 return Ok(TailResult::Done(Value::Nil));
1312 }
1313 for form in &body[..body.len() - 1] {
1314 eval_in(env, registry, expander, form, host)?;
1315 }
1316 eval_in_tail(env, registry, expander, body.last().unwrap(), host)
1317 }
1318 SpecialForm::When | SpecialForm::Unless => {
1319 if items.len() < 2 {
1320 return eval_special(sf, items, call_span, env, registry, expander, host)
1321 .map(TailResult::Done);
1322 }
1323 let invert = matches!(sf, SpecialForm::Unless);
1324 let cond = eval_in(env, registry, expander, &items[1], host)?;
1325 let run = cond.is_truthy() ^ invert;
1326 if !run {
1327 return Ok(TailResult::Done(Value::Nil));
1328 }
1329 let body = &items[2..];
1330 if body.is_empty() {
1331 return Ok(TailResult::Done(Value::Nil));
1332 }
1333 for form in &body[..body.len() - 1] {
1334 eval_in(env, registry, expander, form, host)?;
1335 }
1336 eval_in_tail(env, registry, expander, body.last().unwrap(), host)
1337 }
1338 SpecialForm::Cond => {
1339 for clause in &items[1..] {
1340 let Some(clause_list) = clause.as_list() else {
1341 return eval_special(sf, items, call_span, env, registry, expander, host)
1342 .map(TailResult::Done);
1343 };
1344 if clause_list.is_empty() {
1345 return eval_special(sf, items, call_span, env, registry, expander, host)
1346 .map(TailResult::Done);
1347 }
1348 let is_else = clause_list[0].as_symbol() == Some("else");
1349 let cond_matches = if is_else {
1350 true
1351 } else {
1352 eval_in(env, registry, expander, &clause_list[0], host)?.is_truthy()
1353 };
1354 if cond_matches {
1355 let body = &clause_list[1..];
1356 if body.is_empty() {
1357 return Ok(TailResult::Done(Value::Nil));
1358 }
1359 for form in &body[..body.len() - 1] {
1360 eval_in(env, registry, expander, form, host)?;
1361 }
1362 return eval_in_tail(env, registry, expander, body.last().unwrap(), host);
1363 }
1364 }
1365 Ok(TailResult::Done(Value::Nil))
1366 }
1367 SpecialForm::Let | SpecialForm::LetStar | SpecialForm::LetRec => {
1368 eval_let_family_tail(sf, items, call_span, env, registry, expander, host)
1369 }
1370 SpecialForm::And => {
1371 let exprs = &items[1..];
1372 if exprs.is_empty() {
1373 return Ok(TailResult::Done(Value::Bool(true)));
1374 }
1375 for e in &exprs[..exprs.len() - 1] {
1377 let v = eval_in(env, registry, expander, e, host)?;
1378 if !v.is_truthy() {
1379 return Ok(TailResult::Done(v));
1380 }
1381 }
1382 eval_in_tail(env, registry, expander, exprs.last().unwrap(), host)
1384 }
1385 SpecialForm::Or => {
1386 let exprs = &items[1..];
1387 if exprs.is_empty() {
1388 return Ok(TailResult::Done(Value::Bool(false)));
1389 }
1390 for e in &exprs[..exprs.len() - 1] {
1391 let v = eval_in(env, registry, expander, e, host)?;
1392 if v.is_truthy() {
1393 return Ok(TailResult::Done(v));
1394 }
1395 }
1396 eval_in_tail(env, registry, expander, exprs.last().unwrap(), host)
1397 }
1398 SpecialForm::Try => {
1399 sf_try(items, call_span, env, registry, expander, host).map(TailResult::Done)
1405 }
1406 SpecialForm::MacroexpandOne => {
1407 sf_macroexpand(items, call_span, env, registry, expander, host, false)
1408 .map(TailResult::Done)
1409 }
1410 SpecialForm::MacroexpandAll => {
1411 sf_macroexpand(items, call_span, env, registry, expander, host, true)
1412 .map(TailResult::Done)
1413 }
1414 SpecialForm::Delay => sf_delay(items, call_span, env).map(TailResult::Done),
1415 SpecialForm::Eval => {
1416 sf_eval(items, call_span, env, registry, expander, host).map(TailResult::Done)
1417 }
1418 _ => {
1420 eval_special(sf, items, call_span, env, registry, expander, host).map(TailResult::Done)
1421 }
1422 }
1423}
1424
1425fn eval_let_family_tail<H: 'static>(
1429 sf: SpecialForm,
1430 items: &[Spanned],
1431 call_span: Span,
1432 env: &mut Env,
1433 registry: &FnRegistry<H>,
1434 expander: &SpannedExpander,
1435 host: &mut H,
1436) -> Result<TailResult> {
1437 if items.len() < 3 {
1438 return Err(EvalError::bad_form(
1439 match sf {
1440 SpecialForm::Let => "let",
1441 SpecialForm::LetStar => "let*",
1442 SpecialForm::LetRec => "letrec",
1443 _ => "let-family",
1444 },
1445 "expected ((name expr)...) body...",
1446 call_span,
1447 ));
1448 }
1449 let bindings = parse_binding_list(
1450 &items[1],
1451 match sf {
1452 SpecialForm::Let => "let",
1453 SpecialForm::LetStar => "let*",
1454 SpecialForm::LetRec => "letrec",
1455 _ => "let-family",
1456 },
1457 )?;
1458
1459 match sf {
1460 SpecialForm::Let => {
1461 let mut values = Vec::with_capacity(bindings.len());
1462 for (_, expr) in &bindings {
1463 values.push(eval_in(env, registry, expander, expr, host)?);
1464 }
1465 env.push();
1466 for ((name, _), val) in bindings.into_iter().zip(values) {
1467 env.define(name, val);
1468 }
1469 }
1470 SpecialForm::LetStar => {
1471 env.push();
1472 for (name, expr) in bindings {
1473 let v = eval_in(env, registry, expander, expr, host)?;
1474 env.define(name, v);
1475 }
1476 }
1477 SpecialForm::LetRec => {
1478 env.push();
1479 for (name, _) in &bindings {
1480 env.define(name.clone(), Value::Nil);
1481 }
1482 for (name, expr) in &bindings {
1483 let v = eval_in(env, registry, expander, expr, host)?;
1484 env.define(name.clone(), v);
1485 }
1486 }
1487 _ => unreachable!(),
1488 }
1489
1490 let body = &items[2..];
1491 let result = if body.is_empty() {
1492 Ok(TailResult::Done(Value::Nil))
1493 } else {
1494 for form in &body[..body.len() - 1] {
1495 if let Err(e) = eval_in(env, registry, expander, form, host) {
1496 env.pop();
1497 return Err(e);
1498 }
1499 }
1500 eval_in_tail(env, registry, expander, body.last().unwrap(), host)
1501 };
1502 env.pop();
1503 result
1504}
1505
1506pub(crate) fn apply_external<H: 'static>(
1512 callee: &Value,
1513 args: Vec<Value>,
1514 call_span: Span,
1515 registry: &FnRegistry<H>,
1516 expander: &SpannedExpander,
1517 host: &mut H,
1518) -> Result<Value> {
1519 apply(callee, args, call_span, registry, expander, host)
1520}
1521
1522fn bind_macro_args(
1531 env: &mut Env,
1532 macro_name: &str,
1533 params: &MacroParams,
1534 args: &[Spanned],
1535 call_span: Span,
1536) -> Result<()> {
1537 let bound = params
1538 .bind_carrier(macro_name, args, call_span)
1539 .map_err(|e| {
1540 EvalError::native_fn(
1541 Arc::<str>::from(format!("macro {macro_name}")),
1542 e.to_string(),
1543 call_span,
1544 )
1545 })?;
1546 for (name, value) in params.names().into_iter().zip(bound.iter()) {
1547 env.define(Arc::<str>::from(name), spanned_to_value(value));
1548 }
1549 Ok(())
1550}
1551
1552fn call_closure<H: 'static>(
1557 closure: Arc<Closure>,
1558 args: Vec<Value>,
1559 call_span: Span,
1560 registry: &FnRegistry<H>,
1561 expander: &SpannedExpander,
1562 host: &mut H,
1563) -> Result<Value> {
1564 let mut current = closure;
1565 let mut current_args = args;
1566 let mut current_span = call_span;
1567 loop {
1568 let required = current.params.len();
1570 let has_rest = current.rest.is_some();
1571 if !has_rest && current_args.len() != required {
1572 return Err(EvalError::ArityMismatch {
1573 fn_name: Arc::from("<closure>"),
1574 expected: Arity::Exact(required),
1575 got: current_args.len(),
1576 at: current_span,
1577 });
1578 }
1579 if has_rest && current_args.len() < required {
1580 return Err(EvalError::ArityMismatch {
1581 fn_name: Arc::from("<closure>"),
1582 expected: Arity::AtLeast(required),
1583 got: current_args.len(),
1584 at: current_span,
1585 });
1586 }
1587
1588 let mut env = current.captured_env.clone();
1591 env.push();
1592 for (param, arg) in current.params.iter().zip(current_args.iter()) {
1593 env.define(param.clone(), arg.clone());
1594 }
1595 if let Some(rest_name) = ¤t.rest {
1596 let rest_args: Vec<Value> = current_args.iter().skip(required).cloned().collect();
1597 env.define(rest_name.clone(), Value::list(rest_args));
1598 }
1599
1600 let body = ¤t.body;
1603 if body.is_empty() {
1604 return Ok(Value::Nil);
1605 }
1606 for body_form in &body[..body.len() - 1] {
1607 eval_in(&mut env, registry, expander, body_form, host)?;
1608 }
1609 match eval_in_tail(&mut env, registry, expander, body.last().unwrap(), host)? {
1610 TailResult::Done(v) => return Ok(v),
1611 TailResult::Resume(next, next_args, next_span) => {
1612 current = next;
1615 current_args = next_args;
1616 current_span = next_span;
1617 }
1618 }
1619 }
1620}
1621
1622fn eval_special<H: 'static>(
1625 sf: SpecialForm,
1626 items: &[Spanned],
1627 call_span: Span,
1628 env: &mut Env,
1629 registry: &FnRegistry<H>,
1630 expander: &SpannedExpander,
1631 host: &mut H,
1632) -> Result<Value> {
1633 match sf {
1634 SpecialForm::Quote => sf_quote(items, call_span),
1635 SpecialForm::Quasiquote => {
1636 if items.len() != 2 {
1637 return Err(EvalError::bad_form(
1638 "quasiquote",
1639 format!("expected 1 arg, got {}", items.len() - 1),
1640 call_span,
1641 ));
1642 }
1643 quasiquote_eval(&items[1], env, registry, expander, host)
1644 }
1645 SpecialForm::If => sf_if(items, call_span, env, registry, expander, host),
1646 SpecialForm::Cond => sf_cond(items, call_span, env, registry, expander, host),
1647 SpecialForm::When => sf_when_unless(items, call_span, env, registry, expander, host, false),
1648 SpecialForm::Unless => {
1649 sf_when_unless(items, call_span, env, registry, expander, host, true)
1650 }
1651 SpecialForm::Let => sf_let(items, call_span, env, registry, expander, host),
1652 SpecialForm::LetStar => sf_let_star(items, call_span, env, registry, expander, host),
1653 SpecialForm::LetRec => sf_letrec(items, call_span, env, registry, expander, host),
1654 SpecialForm::Lambda => sf_lambda(items, call_span, env),
1655 SpecialForm::Define => sf_define(items, call_span, env, registry, expander, host),
1656 SpecialForm::Set => sf_set(items, call_span, env, registry, expander, host),
1657 SpecialForm::Begin => sf_begin(&items[1..], env, registry, expander, host),
1658 SpecialForm::And => sf_and(&items[1..], env, registry, expander, host),
1659 SpecialForm::Or => sf_or(&items[1..], env, registry, expander, host),
1660 SpecialForm::Not => sf_not(items, call_span, env, registry, expander, host),
1661 SpecialForm::Try => sf_try(items, call_span, env, registry, expander, host),
1662 SpecialForm::MacroexpandOne => {
1663 sf_macroexpand(items, call_span, env, registry, expander, host, false)
1664 }
1665 SpecialForm::MacroexpandAll => {
1666 sf_macroexpand(items, call_span, env, registry, expander, host, true)
1667 }
1668 SpecialForm::Delay => sf_delay(items, call_span, env),
1669 SpecialForm::Eval => sf_eval(items, call_span, env, registry, expander, host),
1670 SpecialForm::Provide | SpecialForm::Require => Err(EvalError::bad_form(
1671 if matches!(sf, SpecialForm::Provide) { "provide" } else { "require" },
1672 "module-system forms are only valid at top level — wrap your call in (eval (quote ...)) if you really need it dynamic",
1673 call_span,
1674 )),
1675 }
1676}
1677
1678fn head_symbol(form: &Spanned) -> Option<&str> {
1682 let SpannedForm::List(items) = &form.form else {
1683 return None;
1684 };
1685 items.first().and_then(Spanned::as_symbol)
1686}
1687
1688fn error_value(tag: &str, message: &str) -> Value {
1690 Value::Error(Arc::new(ErrorObj {
1691 tag: Arc::from(tag),
1692 message: Arc::from(message),
1693 data: Vec::new(),
1694 }))
1695}
1696
1697fn module_error_to_eval(e: ModuleError, span: Span) -> EvalError {
1701 let (tag, message) = match &e {
1702 ModuleError::NotFound(_) => ("module-not-found", e.to_string()),
1703 ModuleError::Circular { .. } => ("circular-require", e.to_string()),
1704 ModuleError::NotExported(_, _) => ("not-exported", e.to_string()),
1705 };
1706 EvalError::User {
1707 value: error_value(tag, &message),
1708 at: span,
1709 }
1710}
1711
1712fn sf_quote(items: &[Spanned], span: Span) -> Result<Value> {
1713 if items.len() != 2 {
1714 return Err(EvalError::bad_form(
1715 "quote",
1716 format!("expected 1 arg, got {}", items.len() - 1),
1717 span,
1718 ));
1719 }
1720 Ok(crate::code::spanned_to_value(&items[1]))
1726}
1727
1728fn sf_if<H: 'static>(
1729 items: &[Spanned],
1730 span: Span,
1731 env: &mut Env,
1732 registry: &FnRegistry<H>,
1733 expander: &SpannedExpander,
1734 host: &mut H,
1735) -> Result<Value> {
1736 if items.len() < 3 || items.len() > 4 {
1737 return Err(EvalError::bad_form(
1738 "if",
1739 format!("expected (if c t [e]), got {} subforms", items.len()),
1740 span,
1741 ));
1742 }
1743 let c = eval_in(env, registry, expander, &items[1], host)?;
1744 if c.is_truthy() {
1745 eval_in(env, registry, expander, &items[2], host)
1746 } else if items.len() == 4 {
1747 eval_in(env, registry, expander, &items[3], host)
1748 } else {
1749 Ok(Value::Nil)
1750 }
1751}
1752
1753fn sf_cond<H: 'static>(
1754 items: &[Spanned],
1755 span: Span,
1756 env: &mut Env,
1757 registry: &FnRegistry<H>,
1758 expander: &SpannedExpander,
1759 host: &mut H,
1760) -> Result<Value> {
1761 for clause in &items[1..] {
1762 let Some(clause_list) = clause.as_list() else {
1763 return Err(EvalError::bad_form(
1764 "cond",
1765 "clause must be a list",
1766 clause.span,
1767 ));
1768 };
1769 if clause_list.is_empty() {
1770 return Err(EvalError::bad_form("cond", "empty clause", clause.span));
1771 }
1772 let is_else = clause_list[0].as_symbol() == Some("else");
1773 let cond_matches = if is_else {
1774 true
1775 } else {
1776 let v = eval_in(env, registry, expander, &clause_list[0], host)?;
1777 v.is_truthy()
1778 };
1779 if cond_matches {
1780 let mut last = Value::Nil;
1781 for expr in &clause_list[1..] {
1782 last = eval_in(env, registry, expander, expr, host)?;
1783 }
1784 return Ok(last);
1785 }
1786 }
1787 let _ = span;
1789 Ok(Value::Nil)
1790}
1791
1792fn sf_when_unless<H: 'static>(
1793 items: &[Spanned],
1794 span: Span,
1795 env: &mut Env,
1796 registry: &FnRegistry<H>,
1797 expander: &SpannedExpander,
1798 host: &mut H,
1799 invert: bool,
1800) -> Result<Value> {
1801 if items.len() < 2 {
1802 return Err(EvalError::bad_form(
1803 if invert { "unless" } else { "when" },
1804 "need a test",
1805 span,
1806 ));
1807 }
1808 let cond = eval_in(env, registry, expander, &items[1], host)?;
1809 let run = cond.is_truthy() ^ invert;
1810 if run {
1811 let mut last = Value::Nil;
1812 for expr in &items[2..] {
1813 last = eval_in(env, registry, expander, expr, host)?;
1814 }
1815 Ok(last)
1816 } else {
1817 Ok(Value::Nil)
1818 }
1819}
1820
1821fn parse_binding_list<'a>(
1823 list: &'a Spanned,
1824 form_name: &'static str,
1825) -> Result<Vec<(Arc<str>, &'a Spanned)>> {
1826 let bindings = list
1827 .as_list()
1828 .ok_or_else(|| EvalError::bad_form(form_name, "bindings must be a list", list.span))?;
1829 let mut out = Vec::with_capacity(bindings.len());
1830 for binding in bindings {
1831 let pair = binding.as_list().ok_or_else(|| {
1832 EvalError::bad_form(form_name, "each binding must be (name expr)", binding.span)
1833 })?;
1834 if pair.len() != 2 {
1835 return Err(EvalError::bad_form(
1836 form_name,
1837 "binding must be exactly (name expr)",
1838 binding.span,
1839 ));
1840 }
1841 let name = pair[0].as_symbol().ok_or_else(|| {
1842 EvalError::bad_form(form_name, "binding name must be a symbol", pair[0].span)
1843 })?;
1844 out.push((Arc::<str>::from(name), &pair[1]));
1845 }
1846 Ok(out)
1847}
1848
1849fn sf_let<H: 'static>(
1850 items: &[Spanned],
1851 span: Span,
1852 env: &mut Env,
1853 registry: &FnRegistry<H>,
1854 expander: &SpannedExpander,
1855 host: &mut H,
1856) -> Result<Value> {
1857 if items.len() < 3 {
1858 return Err(EvalError::bad_form(
1859 "let",
1860 "expected (let ((name expr)...) body...)",
1861 span,
1862 ));
1863 }
1864 let bindings = parse_binding_list(&items[1], "let")?;
1865 let mut values = Vec::with_capacity(bindings.len());
1868 for (_, expr) in &bindings {
1869 values.push(eval_in(env, registry, expander, expr, host)?);
1870 }
1871 env.push();
1872 for ((name, _), val) in bindings.into_iter().zip(values) {
1873 env.define(name, val);
1874 }
1875 let result = eval_body(&items[2..], env, registry, expander, host);
1876 env.pop();
1877 result
1878}
1879
1880fn sf_let_star<H: 'static>(
1881 items: &[Spanned],
1882 span: Span,
1883 env: &mut Env,
1884 registry: &FnRegistry<H>,
1885 expander: &SpannedExpander,
1886 host: &mut H,
1887) -> Result<Value> {
1888 if items.len() < 3 {
1889 return Err(EvalError::bad_form(
1890 "let*",
1891 "expected (let* ((name expr)...) body...)",
1892 span,
1893 ));
1894 }
1895 let bindings = parse_binding_list(&items[1], "let*")?;
1896 env.push();
1897 for (name, expr) in bindings {
1898 let v = eval_in(env, registry, expander, expr, host)?;
1899 env.define(name, v);
1900 }
1901 let result = eval_body(&items[2..], env, registry, expander, host);
1902 env.pop();
1903 result
1904}
1905
1906fn sf_letrec<H: 'static>(
1907 items: &[Spanned],
1908 span: Span,
1909 env: &mut Env,
1910 registry: &FnRegistry<H>,
1911 expander: &SpannedExpander,
1912 host: &mut H,
1913) -> Result<Value> {
1914 if items.len() < 3 {
1915 return Err(EvalError::bad_form(
1916 "letrec",
1917 "expected (letrec ((name expr)...) body...)",
1918 span,
1919 ));
1920 }
1921 let bindings = parse_binding_list(&items[1], "letrec")?;
1922 env.push();
1923 for (name, _) in &bindings {
1926 env.define(name.clone(), Value::Nil);
1927 }
1928 for (name, expr) in &bindings {
1929 let v = eval_in(env, registry, expander, expr, host)?;
1930 env.define(name.clone(), v);
1931 }
1932 let result = eval_body(&items[2..], env, registry, expander, host);
1933 env.pop();
1934 result
1935}
1936
1937fn eval_body<H: 'static>(
1938 body: &[Spanned],
1939 env: &mut Env,
1940 registry: &FnRegistry<H>,
1941 expander: &SpannedExpander,
1942 host: &mut H,
1943) -> Result<Value> {
1944 let mut last = Value::Nil;
1945 for form in body {
1946 last = eval_in(env, registry, expander, form, host)?;
1947 }
1948 Ok(last)
1949}
1950
1951fn sf_lambda(items: &[Spanned], span: Span, env: &Env) -> Result<Value> {
1952 if items.len() < 3 {
1953 return Err(EvalError::bad_form(
1954 "lambda",
1955 "expected (lambda (params...) body...)",
1956 span,
1957 ));
1958 }
1959 let param_list: &[Spanned] = match &items[1].form {
1962 SpannedForm::Nil => &[],
1963 SpannedForm::List(xs) => xs.as_slice(),
1964 _ => {
1965 return Err(EvalError::bad_form(
1966 "lambda",
1967 "params must be a list",
1968 items[1].span,
1969 ))
1970 }
1971 };
1972 let (params, rest) = parse_lambda_params(param_list, items[1].span)?;
1973 let body = items[2..].to_vec();
1974 Ok(Value::Closure(Arc::new(Closure {
1975 params,
1976 rest,
1977 body,
1978 captured_env: env.clone(),
1979 source: span,
1980 })))
1981}
1982
1983fn parse_lambda_params(list: &[Spanned], span: Span) -> Result<(Vec<Arc<str>>, Option<Arc<str>>)> {
1984 let mut params = Vec::new();
1985 let mut rest = None;
1986 let mut i = 0;
1987 while i < list.len() {
1988 let s = list[i]
1989 .as_symbol()
1990 .ok_or_else(|| EvalError::bad_form("lambda", "param must be a symbol", list[i].span))?;
1991 if s == "&rest" {
1992 let name = list
1993 .get(i + 1)
1994 .and_then(Spanned::as_symbol)
1995 .ok_or_else(|| EvalError::bad_form("lambda", "&rest needs a name", span))?;
1996 rest = Some(Arc::<str>::from(name));
1997 if i + 2 != list.len() {
1998 return Err(EvalError::bad_form(
1999 "lambda",
2000 "&rest must be the last param",
2001 span,
2002 ));
2003 }
2004 break;
2005 }
2006 params.push(Arc::<str>::from(s));
2007 i += 1;
2008 }
2009 Ok((params, rest))
2010}
2011
2012fn sf_define<H: 'static>(
2014 items: &[Spanned],
2015 span: Span,
2016 env: &mut Env,
2017 registry: &FnRegistry<H>,
2018 expander: &SpannedExpander,
2019 host: &mut H,
2020) -> Result<Value> {
2021 if items.len() < 3 {
2022 return Err(EvalError::bad_form(
2023 "define",
2024 "expected (define name expr) or (define (name args) body)",
2025 span,
2026 ));
2027 }
2028 match &items[1].form {
2029 SpannedForm::Atom(Atom::Symbol(name)) => {
2030 let v = eval_in(env, registry, expander, &items[2], host)?;
2031 env.define(Arc::<str>::from(name.as_str()), v);
2032 Ok(Value::Nil)
2033 }
2034 SpannedForm::List(head_list) => {
2035 if head_list.is_empty() {
2036 return Err(EvalError::bad_form(
2037 "define",
2038 "empty (name args) list",
2039 items[1].span,
2040 ));
2041 }
2042 let name = head_list[0].as_symbol().ok_or_else(|| {
2043 EvalError::bad_form(
2044 "define",
2045 "first item in (name args) must be a symbol",
2046 head_list[0].span,
2047 )
2048 })?;
2049 let (params, rest) = parse_lambda_params(&head_list[1..], items[1].span)?;
2050 let body = items[2..].to_vec();
2051 let closure = Arc::new(Closure {
2052 params,
2053 rest,
2054 body,
2055 captured_env: env.clone(),
2056 source: span,
2057 });
2058 env.define(Arc::<str>::from(name), Value::Closure(closure));
2059 Ok(Value::Nil)
2060 }
2061 _ => Err(EvalError::bad_form(
2062 "define",
2063 "second form must be a symbol or (name args) list",
2064 items[1].span,
2065 )),
2066 }
2067}
2068
2069fn sf_set<H: 'static>(
2070 items: &[Spanned],
2071 span: Span,
2072 env: &mut Env,
2073 registry: &FnRegistry<H>,
2074 expander: &SpannedExpander,
2075 host: &mut H,
2076) -> Result<Value> {
2077 if items.len() != 3 {
2078 return Err(EvalError::bad_form(
2079 "set!",
2080 "expected (set! name expr)",
2081 span,
2082 ));
2083 }
2084 let name = items[1]
2085 .as_symbol()
2086 .ok_or_else(|| EvalError::bad_form("set!", "first arg must be a symbol", items[1].span))?;
2087 let v = eval_in(env, registry, expander, &items[2], host)?;
2088 if env.set(name, v) {
2089 Ok(Value::Nil)
2090 } else if let (true, Some(seal)) = (env.is_sealed_binding(name), env.seal()) {
2091 Err(EvalError::SetSealed {
2096 name: name.into(),
2097 seal,
2098 at: items[1].span,
2099 })
2100 } else {
2101 Err(EvalError::unbound(name, items[1].span))
2102 }
2103}
2104
2105fn sf_begin<H: 'static>(
2106 body: &[Spanned],
2107 env: &mut Env,
2108 registry: &FnRegistry<H>,
2109 expander: &SpannedExpander,
2110 host: &mut H,
2111) -> Result<Value> {
2112 eval_body(body, env, registry, expander, host)
2113}
2114
2115fn sf_and<H: 'static>(
2116 exprs: &[Spanned],
2117 env: &mut Env,
2118 registry: &FnRegistry<H>,
2119 expander: &SpannedExpander,
2120 host: &mut H,
2121) -> Result<Value> {
2122 let mut last = Value::Bool(true);
2123 for e in exprs {
2124 last = eval_in(env, registry, expander, e, host)?;
2125 if !last.is_truthy() {
2126 return Ok(last);
2127 }
2128 }
2129 Ok(last)
2130}
2131
2132fn sf_or<H: 'static>(
2133 exprs: &[Spanned],
2134 env: &mut Env,
2135 registry: &FnRegistry<H>,
2136 expander: &SpannedExpander,
2137 host: &mut H,
2138) -> Result<Value> {
2139 let mut last = Value::Bool(false);
2140 for e in exprs {
2141 last = eval_in(env, registry, expander, e, host)?;
2142 if last.is_truthy() {
2143 return Ok(last);
2144 }
2145 }
2146 Ok(last)
2147}
2148
2149fn sf_not<H: 'static>(
2150 items: &[Spanned],
2151 span: Span,
2152 env: &mut Env,
2153 registry: &FnRegistry<H>,
2154 expander: &SpannedExpander,
2155 host: &mut H,
2156) -> Result<Value> {
2157 if items.len() != 2 {
2158 return Err(EvalError::bad_form("not", "expected (not x)", span));
2159 }
2160 let v = eval_in(env, registry, expander, &items[1], host)?;
2161 Ok(Value::Bool(!v.is_truthy()))
2162}
2163
2164fn sf_try<H: 'static>(
2183 items: &[Spanned],
2184 span: Span,
2185 env: &mut Env,
2186 registry: &FnRegistry<H>,
2187 expander: &SpannedExpander,
2188 host: &mut H,
2189) -> Result<Value> {
2190 if items.len() < 3 {
2191 return Err(EvalError::bad_form(
2192 "try",
2193 "expected (try body... (catch (e) handler...))",
2194 span,
2195 ));
2196 }
2197 let catch_form = items.last().unwrap();
2199 let catch_list = catch_form.as_list().ok_or_else(|| {
2200 EvalError::bad_form(
2201 "try",
2202 "last form must be (catch (binding) handler...)",
2203 catch_form.span,
2204 )
2205 })?;
2206 if catch_list.is_empty() || catch_list[0].as_symbol() != Some("catch") {
2207 return Err(EvalError::bad_form(
2208 "try",
2209 "last form must be a (catch ...) clause",
2210 catch_form.span,
2211 ));
2212 }
2213 if catch_list.len() < 3 {
2214 return Err(EvalError::bad_form(
2215 "catch",
2216 "expected (catch (binding) handler...)",
2217 catch_form.span,
2218 ));
2219 }
2220 let binding_list = catch_list[1].as_list().ok_or_else(|| {
2221 EvalError::bad_form(
2222 "catch",
2223 "binding must be a 1-element list (e)",
2224 catch_list[1].span,
2225 )
2226 })?;
2227 if binding_list.len() != 1 {
2228 return Err(EvalError::bad_form(
2229 "catch",
2230 "binding must bind exactly one symbol",
2231 catch_list[1].span,
2232 ));
2233 }
2234 let binding_name = binding_list[0].as_symbol().ok_or_else(|| {
2235 EvalError::bad_form("catch", "binding must be a symbol", binding_list[0].span)
2236 })?;
2237
2238 let body = &items[1..items.len() - 1];
2239 let mut last = Value::Nil;
2240 for form in body {
2241 match eval_in(env, registry, expander, form, host) {
2242 Ok(v) => {
2243 last = v;
2244 }
2245 Err(EvalError::User { value, .. }) => {
2246 return run_catch_handler(
2247 binding_name,
2248 value,
2249 &catch_list[2..],
2250 env,
2251 registry,
2252 expander,
2253 host,
2254 );
2255 }
2256 Err(other) => {
2257 let value = rust_err_to_value_error(&other);
2261 return run_catch_handler(
2262 binding_name,
2263 value,
2264 &catch_list[2..],
2265 env,
2266 registry,
2267 expander,
2268 host,
2269 );
2270 }
2271 }
2272 }
2273 Ok(last)
2274}
2275
2276fn run_catch_handler<H: 'static>(
2277 binding_name: &str,
2278 error_value: Value,
2279 handler_body: &[Spanned],
2280 env: &mut Env,
2281 registry: &FnRegistry<H>,
2282 expander: &SpannedExpander,
2283 host: &mut H,
2284) -> Result<Value> {
2285 env.push();
2286 env.define(Arc::<str>::from(binding_name), error_value);
2287 let mut last = Value::Nil;
2288 for form in handler_body {
2289 match eval_in(env, registry, expander, form, host) {
2290 Ok(v) => last = v,
2291 Err(e) => {
2292 env.pop();
2293 return Err(e);
2294 }
2295 }
2296 }
2297 env.pop();
2298 Ok(last)
2299}
2300
2301fn sf_eval<H: 'static>(
2310 items: &[Spanned],
2311 call_span: Span,
2312 env: &mut Env,
2313 registry: &FnRegistry<H>,
2314 expander: &SpannedExpander,
2315 host: &mut H,
2316) -> Result<Value> {
2317 if items.len() != 2 {
2318 return Err(EvalError::bad_form(
2319 "eval",
2320 "expected (eval form)",
2321 call_span,
2322 ));
2323 }
2324 let form_value = eval_in(env, registry, expander, &items[1], host)?;
2325 let form_spanned = crate::code::value_to_spanned(&form_value, call_span)
2326 .map_err(|reason| EvalError::native_fn(Arc::<str>::from("eval"), reason, call_span))?;
2327 let expanded = fully_expand_with(&form_spanned, registry, expander, env, host)?;
2328 eval_in(env, registry, expander, &expanded, host)
2329}
2330
2331fn sf_delay(items: &[Spanned], call_span: Span, env: &Env) -> Result<Value> {
2336 if items.len() != 2 {
2337 return Err(EvalError::bad_form(
2338 "delay",
2339 "expected (delay expr)",
2340 call_span,
2341 ));
2342 }
2343 let body = vec![items[1].clone()];
2344 let thunk = Arc::new(Closure {
2345 params: Vec::new(),
2346 rest: None,
2347 body,
2348 captured_env: env.clone(),
2349 source: call_span,
2350 });
2351 Ok(Value::Promise(Arc::new(std::sync::Mutex::new(
2352 crate::value::PromiseState::Pending(thunk),
2353 ))))
2354}
2355
2356fn sf_macroexpand<H: 'static>(
2365 items: &[Spanned],
2366 call_span: Span,
2367 env: &mut Env,
2368 registry: &FnRegistry<H>,
2369 expander: &SpannedExpander,
2370 host: &mut H,
2371 fully: bool,
2372) -> Result<Value> {
2373 if items.len() != 2 {
2374 return Err(EvalError::bad_form(
2375 if fully {
2376 "macroexpand"
2377 } else {
2378 "macroexpand-1"
2379 },
2380 "expected (macroexpand[-1] form)",
2381 call_span,
2382 ));
2383 }
2384 let form_value = eval_in(env, registry, expander, &items[1], host)?;
2386 let form_spanned = crate::code::value_to_spanned(&form_value, call_span).map_err(|reason| {
2388 EvalError::native_fn(
2389 Arc::<str>::from(if fully {
2390 "macroexpand"
2391 } else {
2392 "macroexpand-1"
2393 }),
2394 reason,
2395 call_span,
2396 )
2397 })?;
2398
2399 let expanded = if fully {
2405 fully_expand_with(&form_spanned, registry, expander, env, host)?
2406 } else {
2407 macroexpand_one(&form_spanned, registry, expander, env, host)?
2408 };
2409
2410 Ok(crate::code::spanned_to_value(&expanded))
2411}
2412
2413fn expand_one_macro_call<H: 'static>(
2417 macro_name: &str,
2418 args: &[Spanned],
2419 call_span: Span,
2420 registry: &FnRegistry<H>,
2421 expander: &SpannedExpander,
2422 parent_env: &Env,
2423 host: &mut H,
2424) -> Result<Spanned> {
2425 let def: MacroDef = expander.get_macro(macro_name).cloned().ok_or_else(|| {
2426 EvalError::native_fn(
2427 Arc::<str>::from(macro_name),
2428 "macro disappeared during expansion",
2429 call_span,
2430 )
2431 })?;
2432 let body_spanned = Spanned::from_sexp_at(&def.body, call_span);
2433 let body_expanded = fully_expand_with(&body_spanned, registry, expander, parent_env, host)?;
2435
2436 let mut macro_env = parent_env.clone();
2437 macro_env.push();
2438 bind_macro_args(&mut macro_env, &def.name, &def.params, args, call_span)?;
2439 let result = eval_in(&mut macro_env, registry, expander, &body_expanded, host)?;
2440
2441 crate::code::value_to_spanned(&result, call_span).map_err(|reason| {
2442 EvalError::native_fn(
2443 Arc::<str>::from(format!("macro {macro_name}")),
2444 reason,
2445 call_span,
2446 )
2447 })
2448}
2449
2450fn fully_expand_with<H: 'static>(
2454 form: &Spanned,
2455 registry: &FnRegistry<H>,
2456 expander: &SpannedExpander,
2457 parent_env: &Env,
2458 host: &mut H,
2459) -> Result<Spanned> {
2460 if expander.is_empty() {
2461 return Ok(form.clone());
2462 }
2463 expand_recursive_with(form, registry, expander, parent_env, host)
2464}
2465
2466fn expand_recursive_with<H: 'static>(
2467 form: &Spanned,
2468 registry: &FnRegistry<H>,
2469 expander: &SpannedExpander,
2470 parent_env: &Env,
2471 host: &mut H,
2472) -> Result<Spanned> {
2473 match &form.form {
2474 SpannedForm::List(items) if !items.is_empty() => {
2475 if let Some(head) = items[0].as_symbol() {
2476 if expander.has(head) {
2477 let expanded = expand_one_macro_call(
2478 head,
2479 &items[1..],
2480 form.span,
2481 registry,
2482 expander,
2483 parent_env,
2484 host,
2485 )?;
2486 return expand_recursive_with(&expanded, registry, expander, parent_env, host);
2487 }
2488 }
2489 let mut out = Vec::with_capacity(items.len());
2490 for child in items {
2491 out.push(expand_recursive_with(
2492 child, registry, expander, parent_env, host,
2493 )?);
2494 }
2495 Ok(Spanned::new(form.span, SpannedForm::List(out)))
2496 }
2497 SpannedForm::Quote(_) => Ok(form.clone()),
2498 SpannedForm::Quasiquote(inner) => Ok(Spanned::new(
2499 form.span,
2500 SpannedForm::Quasiquote(Box::new(expand_inside_quasiquote_with(
2501 inner, registry, expander, parent_env, host,
2502 )?)),
2503 )),
2504 _ => Ok(form.clone()),
2505 }
2506}
2507
2508fn expand_inside_quasiquote_with<H: 'static>(
2509 form: &Spanned,
2510 registry: &FnRegistry<H>,
2511 expander: &SpannedExpander,
2512 parent_env: &Env,
2513 host: &mut H,
2514) -> Result<Spanned> {
2515 match &form.form {
2516 SpannedForm::Unquote(inner) => Ok(Spanned::new(
2517 form.span,
2518 SpannedForm::Unquote(Box::new(expand_recursive_with(
2519 inner, registry, expander, parent_env, host,
2520 )?)),
2521 )),
2522 SpannedForm::UnquoteSplice(inner) => Ok(Spanned::new(
2523 form.span,
2524 SpannedForm::UnquoteSplice(Box::new(expand_recursive_with(
2525 inner, registry, expander, parent_env, host,
2526 )?)),
2527 )),
2528 SpannedForm::List(items) => {
2529 let mut out = Vec::with_capacity(items.len());
2530 for item in items {
2531 out.push(expand_inside_quasiquote_with(
2532 item, registry, expander, parent_env, host,
2533 )?);
2534 }
2535 Ok(Spanned::new(form.span, SpannedForm::List(out)))
2536 }
2537 _ => Ok(form.clone()),
2538 }
2539}
2540
2541fn macroexpand_one<H: 'static>(
2544 form: &Spanned,
2545 registry: &FnRegistry<H>,
2546 expander: &SpannedExpander,
2547 parent_env: &Env,
2548 host: &mut H,
2549) -> Result<Spanned> {
2550 if let SpannedForm::List(items) = &form.form {
2551 if let Some(head) = items.first().and_then(Spanned::as_symbol) {
2552 if expander.has(head) {
2553 return expand_one_macro_call(
2554 head,
2555 &items[1..],
2556 form.span,
2557 registry,
2558 expander,
2559 parent_env,
2560 host,
2561 );
2562 }
2563 }
2564 }
2565 Ok(form.clone())
2566}
2567
2568fn rust_err_to_value_error(err: &EvalError) -> Value {
2571 use crate::value::ErrorObj;
2572 let tag: Arc<str> = Arc::from(err.tag());
2573 let message: Arc<str> = Arc::from(err.short_message());
2574 Value::Error(Arc::new(ErrorObj {
2575 tag,
2576 message,
2577 data: Vec::new(),
2578 }))
2579}
2580
2581#[cfg(test)]
2582mod tests {
2583 use super::*;
2584 use crate::primitive::install_primitives;
2585 use tatara_lisp::read_spanned;
2586
2587 struct NoHost;
2588
2589 fn eval_ok(src: &str) -> Value {
2590 let forms = read_spanned(src).unwrap();
2591 let mut i: Interpreter<NoHost> = Interpreter::new();
2592 install_primitives(&mut i);
2593 let mut host = NoHost;
2594 i.eval_program(&forms, &mut host).unwrap()
2595 }
2596
2597 fn eval_err(src: &str) -> EvalError {
2598 let forms = read_spanned(src).unwrap();
2599 let mut i: Interpreter<NoHost> = Interpreter::new();
2600 install_primitives(&mut i);
2601 let mut host = NoHost;
2602 i.eval_program(&forms, &mut host).unwrap_err()
2603 }
2604
2605 #[test]
2608 fn literal_int() {
2609 assert!(matches!(eval_ok("42"), Value::Int(42)));
2610 }
2611
2612 #[test]
2613 fn unbound_symbol_errors() {
2614 let e = eval_err("no-such-var");
2615 assert!(matches!(e, EvalError::UnboundSymbol { .. }));
2616 }
2617
2618 #[test]
2619 fn quote_returns_runtime_list_of_symbols() {
2620 let v = eval_ok("'(a b c)");
2623 match v {
2624 Value::List(xs) => {
2625 assert_eq!(xs.len(), 3);
2626 assert!(matches!(&xs[0], Value::Symbol(s) if s.as_ref() == "a"));
2627 assert!(matches!(&xs[1], Value::Symbol(s) if s.as_ref() == "b"));
2628 assert!(matches!(&xs[2], Value::Symbol(s) if s.as_ref() == "c"));
2629 }
2630 other => panic!("{other:?}"),
2631 }
2632 }
2633
2634 #[test]
2637 fn add_ints() {
2638 assert!(matches!(eval_ok("(+ 1 2 3)"), Value::Int(6)));
2639 }
2640
2641 #[test]
2642 fn sub_divides_float() {
2643 match eval_ok("(- 10 3)") {
2644 Value::Int(7) => {}
2645 other => panic!("{other:?}"),
2646 }
2647 }
2648
2649 #[test]
2650 fn division_by_zero_errors() {
2651 assert!(matches!(
2652 eval_err("(/ 1 0)"),
2653 EvalError::DivisionByZero { .. }
2654 ));
2655 }
2656
2657 #[test]
2660 fn if_truthy_branch() {
2661 assert!(matches!(eval_ok("(if #t 1 2)"), Value::Int(1)));
2662 }
2663
2664 #[test]
2665 fn if_falsy_branch() {
2666 assert!(matches!(eval_ok("(if #f 1 2)"), Value::Int(2)));
2667 }
2668
2669 #[test]
2670 fn if_no_else_returns_nil() {
2671 assert!(matches!(eval_ok("(if #f 1)"), Value::Nil));
2672 }
2673
2674 #[test]
2675 fn cond_picks_first_match() {
2676 assert!(matches!(
2677 eval_ok("(cond (#f 1) (#t 2) (else 3))"),
2678 Value::Int(2)
2679 ));
2680 }
2681
2682 #[test]
2683 fn cond_falls_through_to_else() {
2684 assert!(matches!(
2685 eval_ok("(cond (#f 1) (#f 2) (else 3))"),
2686 Value::Int(3)
2687 ));
2688 }
2689
2690 #[test]
2691 fn when_runs_body_if_true() {
2692 assert!(matches!(eval_ok("(when #t 99)"), Value::Int(99)));
2693 assert!(matches!(eval_ok("(when #f 99)"), Value::Nil));
2694 }
2695
2696 #[test]
2699 fn let_binds_and_evaluates_body() {
2700 assert!(matches!(
2701 eval_ok("(let ((x 10) (y 20)) (+ x y))"),
2702 Value::Int(30)
2703 ));
2704 }
2705
2706 #[test]
2707 fn let_star_sequential_bindings() {
2708 assert!(matches!(
2709 eval_ok("(let* ((x 5) (y (+ x 1))) (+ x y))"),
2710 Value::Int(11)
2711 ));
2712 }
2713
2714 #[test]
2715 fn letrec_mutual_recursion() {
2716 let v = eval_ok(
2717 "(letrec ((even? (lambda (n) (if (= n 0) #t (odd? (- n 1)))))
2718 (odd? (lambda (n) (if (= n 0) #f (even? (- n 1))))))
2719 (even? 10))",
2720 );
2721 assert!(matches!(v, Value::Bool(true)));
2722 }
2723
2724 #[test]
2727 fn lambda_applies() {
2728 assert!(matches!(
2729 eval_ok("((lambda (x y) (+ x y)) 3 4)"),
2730 Value::Int(7)
2731 ));
2732 }
2733
2734 #[test]
2735 fn lambda_closes_over_env() {
2736 assert!(matches!(
2737 eval_ok("(let ((n 10)) ((lambda (x) (+ x n)) 5))"),
2738 Value::Int(15)
2739 ));
2740 }
2741
2742 #[test]
2743 fn closure_captures_by_value_at_creation() {
2744 let v = eval_ok(
2747 "(define make-adder (lambda (n) (lambda (x) (+ x n))))
2748 (define add5 (make-adder 5))
2749 (add5 10)",
2750 );
2751 assert!(matches!(v, Value::Int(15)));
2752 }
2753
2754 #[test]
2755 fn rest_args_collect_into_list() {
2756 let v = eval_ok("((lambda (x &rest rs) (length rs)) 1 2 3 4 5)");
2757 assert!(matches!(v, Value::Int(4)));
2758 }
2759
2760 #[test]
2761 fn closure_arity_mismatch() {
2762 let e = eval_err("((lambda (x y) (+ x y)) 1)");
2763 assert!(matches!(e, EvalError::ArityMismatch { .. }));
2764 }
2765
2766 #[test]
2769 fn define_then_use() {
2770 assert!(matches!(eval_ok("(define x 42) x"), Value::Int(42)));
2771 }
2772
2773 #[test]
2774 fn define_function_shorthand() {
2775 assert!(matches!(
2776 eval_ok("(define (sq x) (* x x)) (sq 6)"),
2777 Value::Int(36)
2778 ));
2779 }
2780
2781 #[test]
2782 fn set_mutates_existing() {
2783 assert!(matches!(
2784 eval_ok("(define x 1) (set! x 99) x"),
2785 Value::Int(99)
2786 ));
2787 }
2788
2789 #[test]
2790 fn set_unbound_errors() {
2791 let e = eval_err("(set! nope 1)");
2792 assert!(matches!(e, EvalError::UnboundSymbol { .. }));
2793 }
2794
2795 #[test]
2798 fn begin_returns_last() {
2799 assert!(matches!(eval_ok("(begin 1 2 3)"), Value::Int(3)));
2800 }
2801
2802 #[test]
2803 fn and_short_circuits() {
2804 assert!(matches!(eval_ok("(and 1 #f 2)"), Value::Bool(false)));
2805 assert!(matches!(eval_ok("(and 1 2 3)"), Value::Int(3)));
2806 assert!(matches!(eval_ok("(and)"), Value::Bool(true)));
2807 }
2808
2809 #[test]
2810 fn or_short_circuits() {
2811 assert!(matches!(eval_ok("(or #f #f 7)"), Value::Int(7)));
2812 assert!(matches!(eval_ok("(or #f #f)"), Value::Bool(false)));
2813 assert!(matches!(eval_ok("(or)"), Value::Bool(false)));
2814 }
2815
2816 #[test]
2817 fn not_inverts() {
2818 assert!(matches!(eval_ok("(not #t)"), Value::Bool(false)));
2819 assert!(matches!(eval_ok("(not #f)"), Value::Bool(true)));
2820 assert!(matches!(eval_ok("(not 42)"), Value::Bool(false)));
2821 }
2822
2823 #[test]
2826 fn recursive_factorial() {
2827 let v = eval_ok(
2828 "(define (fact n)
2829 (if (= n 0) 1 (* n (fact (- n 1)))))
2830 (fact 6)",
2831 );
2832 assert!(matches!(v, Value::Int(720)));
2833 }
2834
2835 #[test]
2836 fn recursive_length() {
2837 let v = eval_ok(
2838 "(define (len xs)
2839 (if (null? xs) 0 (+ 1 (len (cdr xs)))))
2840 (len (list 1 2 3 4 5))",
2841 );
2842 assert!(matches!(v, Value::Int(5)));
2843 }
2844
2845 #[test]
2850 fn quasiquote_plain_list_is_runtime_list() {
2851 let v = eval_ok("`(a b c)");
2852 match v {
2853 Value::List(xs) => {
2854 assert_eq!(xs.len(), 3);
2855 assert!(matches!(&xs[0], Value::Symbol(s) if s.as_ref() == "a"));
2856 assert!(matches!(&xs[1], Value::Symbol(s) if s.as_ref() == "b"));
2857 assert!(matches!(&xs[2], Value::Symbol(s) if s.as_ref() == "c"));
2858 }
2859 other => panic!("{other:?}"),
2860 }
2861 }
2862
2863 #[test]
2864 fn quasiquote_unquote_substitutes_evaluated_value() {
2865 let v = eval_ok("(let ((x 42)) `(a ,x c))");
2866 match v {
2867 Value::List(xs) => {
2868 assert_eq!(xs.len(), 3);
2869 assert!(matches!(&xs[1], Value::Int(42)));
2870 }
2871 other => panic!("{other:?}"),
2872 }
2873 }
2874
2875 #[test]
2876 fn quasiquote_unquote_arbitrary_expr() {
2877 let v = eval_ok("`(x ,(+ 1 2 3) y)");
2878 match v {
2879 Value::List(xs) => {
2880 assert!(matches!(&xs[1], Value::Int(6)));
2881 }
2882 other => panic!("{other:?}"),
2883 }
2884 }
2885
2886 #[test]
2887 fn quasiquote_splice_inlines_list() {
2888 let v = eval_ok("`(a ,@(list 1 2 3) b)");
2889 match v {
2890 Value::List(xs) => {
2891 assert_eq!(xs.len(), 5);
2892 assert!(matches!(&xs[0], Value::Symbol(s) if s.as_ref() == "a"));
2893 assert!(matches!(&xs[1], Value::Int(1)));
2894 assert!(matches!(&xs[2], Value::Int(2)));
2895 assert!(matches!(&xs[3], Value::Int(3)));
2896 assert!(matches!(&xs[4], Value::Symbol(s) if s.as_ref() == "b"));
2897 }
2898 other => panic!("{other:?}"),
2899 }
2900 }
2901
2902 #[test]
2903 fn quasiquote_splice_empty_list_splices_nothing() {
2904 let v = eval_ok("`(a ,@(list) b)");
2905 match v {
2906 Value::List(xs) => {
2907 assert_eq!(xs.len(), 2);
2908 assert!(matches!(&xs[0], Value::Symbol(s) if s.as_ref() == "a"));
2909 assert!(matches!(&xs[1], Value::Symbol(s) if s.as_ref() == "b"));
2910 }
2911 other => panic!("{other:?}"),
2912 }
2913 }
2914
2915 #[test]
2916 fn quasiquote_splice_non_list_errors() {
2917 let e = eval_err("`(a ,@42)");
2918 assert!(matches!(e, EvalError::TypeMismatch { .. }));
2919 }
2920
2921 #[test]
2922 fn quasiquote_atom_yields_atom_value() {
2923 assert!(matches!(eval_ok("`foo"), Value::Symbol(s) if s.as_ref() == "foo"));
2924 assert!(matches!(eval_ok("`42"), Value::Int(42)));
2925 }
2926
2927 #[test]
2928 fn quasiquote_with_nested_list_and_unquote() {
2929 let v = eval_ok("(let ((x 99)) `(foo (bar ,x) baz))");
2931 match v {
2932 Value::List(xs) => {
2933 assert_eq!(xs.len(), 3);
2934 match &xs[1] {
2935 Value::List(inner) => {
2936 assert!(matches!(&inner[1], Value::Int(99)));
2937 }
2938 other => panic!("{other:?}"),
2939 }
2940 }
2941 other => panic!("{other:?}"),
2942 }
2943 }
2944
2945 #[test]
2946 fn quasiquote_symbol_keyword_distinction_preserved() {
2947 let v = eval_ok("`(:key val)");
2948 match v {
2949 Value::List(xs) => {
2950 assert!(matches!(&xs[0], Value::Keyword(s) if s.as_ref() == "key"));
2951 assert!(matches!(&xs[1], Value::Symbol(s) if s.as_ref() == "val"));
2952 }
2953 other => panic!("{other:?}"),
2954 }
2955 }
2956
2957 #[test]
2958 fn bare_unquote_outside_quasiquote_errors() {
2959 let e = eval_err(",x");
2960 assert!(matches!(e, EvalError::BadSpecialForm { .. }));
2961 }
2962
2963 #[test]
2966 fn native_fn_reads_host_state() {
2967 struct Counter {
2968 n: i64,
2969 }
2970 let forms = read_spanned("(bump) (bump) (bump) (cur)").unwrap();
2971 let mut i: Interpreter<Counter> = Interpreter::new();
2972 install_primitives(&mut i);
2973 i.register_fn(
2974 "bump",
2975 Arity::Exact(0),
2976 |_args: &[Value], host: &mut Counter, _span| {
2977 host.n += 1;
2978 Ok(Value::Int(host.n))
2979 },
2980 );
2981 i.register_fn(
2982 "cur",
2983 Arity::Exact(0),
2984 |_args: &[Value], host: &mut Counter, _span| Ok(Value::Int(host.n)),
2985 );
2986 let mut host = Counter { n: 0 };
2987 let v = i.eval_program(&forms, &mut host).unwrap();
2988 assert!(matches!(v, Value::Int(3)));
2989 }
2990
2991 struct Ctx {
2994 records: Vec<(String, i64)>,
2995 }
2996
2997 #[test]
2998 fn register_typed1_marshals_string_arg() {
2999 let mut i: Interpreter<Ctx> = Interpreter::new();
3000 install_primitives(&mut i);
3001 i.register_typed1("greet", |_h: &mut Ctx, name: String| -> Result<String> {
3002 Ok(format!("hello {name}"))
3003 });
3004 let forms = read_spanned(r#"(greet "luis")"#).unwrap();
3005 let mut h = Ctx { records: vec![] };
3006 let v = i.eval_program(&forms, &mut h).unwrap();
3007 match v {
3008 Value::Str(s) => assert_eq!(&*s, "hello luis"),
3009 other => panic!("{other:?}"),
3010 }
3011 }
3012
3013 #[test]
3014 fn register_typed2_marshals_host_state_mutation() {
3015 let mut i: Interpreter<Ctx> = Interpreter::new();
3016 install_primitives(&mut i);
3017 i.register_typed2(
3018 "record",
3019 |h: &mut Ctx, name: String, n: i64| -> Result<()> {
3020 h.records.push((name, n));
3021 Ok(())
3022 },
3023 );
3024 let forms = read_spanned(r#"(record "a" 1) (record "b" 2)"#).unwrap();
3025 let mut h = Ctx { records: vec![] };
3026 let _ = i.eval_program(&forms, &mut h).unwrap();
3027 assert_eq!(h.records.len(), 2);
3028 assert_eq!(h.records[0], ("a".to_string(), 1));
3029 assert_eq!(h.records[1], ("b".to_string(), 2));
3030 }
3031
3032 #[test]
3033 fn register_typed_arg_type_mismatch_surfaces_at_call_site() {
3034 let mut i: Interpreter<Ctx> = Interpreter::new();
3035 install_primitives(&mut i);
3036 i.register_typed1("needs-int", |_h: &mut Ctx, n: i64| -> Result<i64> {
3037 Ok(n + 1)
3038 });
3039 let forms = read_spanned(r#"(needs-int "not-a-number")"#).unwrap();
3040 let mut h = Ctx { records: vec![] };
3041 let err = i.eval_program(&forms, &mut h).unwrap_err();
3042 assert!(matches!(
3043 err,
3044 EvalError::TypeMismatch {
3045 expected: "integer",
3046 ..
3047 }
3048 ));
3049 }
3050
3051 #[test]
3052 fn register_typed3_three_args() {
3053 let mut i: Interpreter<Ctx> = Interpreter::new();
3054 install_primitives(&mut i);
3055 i.register_typed3(
3056 "triple-sum",
3057 |_h: &mut Ctx, a: i64, b: i64, c: i64| -> Result<i64> { Ok(a + b + c) },
3058 );
3059 let forms = read_spanned("(triple-sum 10 20 30)").unwrap();
3060 let mut h = Ctx { records: vec![] };
3061 let v = i.eval_program(&forms, &mut h).unwrap();
3062 assert!(matches!(v, Value::Int(60)));
3063 }
3064
3065 #[test]
3081 fn a_runaway_macro_is_a_typed_error_that_names_the_macro() {
3082 let err = eval_err("(defmacro forever (x) `(forever ,x))\n(forever 1)");
3083 match err {
3084 EvalError::MacroExpansionLimit {
3085 ref macro_name,
3086 limit,
3087 ..
3088 } => {
3089 assert_eq!(&**macro_name, "forever", "the error must name the culprit");
3090 assert_eq!(limit, DEFAULT_MACRO_EXPANSION_LIMIT);
3091 }
3092 other => panic!("expected MacroExpansionLimit, got {other:?}"),
3093 }
3094 }
3095
3096 #[test]
3100 fn a_mutually_recursive_macro_pair_is_caught_too() {
3101 let err =
3102 eval_err("(defmacro ping (x) `(pong ,x))\n(defmacro pong (x) `(ping ,x))\n(ping 1)");
3103 assert!(
3104 matches!(err, EvalError::MacroExpansionLimit { .. }),
3105 "a two-macro cycle must be bounded as well: {err:?}"
3106 );
3107 }
3108
3109 #[test]
3117 fn deep_but_finite_nesting_is_not_charged_to_the_expansion_budget() {
3118 let mut src = String::from("(defmacro id1 (x) x)\n");
3119 src.push_str(&"(+ 1 ".repeat(400));
3120 src.push_str("(id1 7)");
3121 src.push_str(&")".repeat(400));
3122 let v = eval_ok(&src);
3123 assert!(matches!(v, Value::Int(407)), "got {v:?}");
3124 }
3125
3126 #[test]
3129 fn a_terminating_chain_under_the_ceiling_still_expands() {
3130 let v =
3132 eval_ok("(defmacro step (x) `(step2 ,x))\n(defmacro step2 (x) `(* ,x 3))\n(step 5)");
3133 assert!(matches!(v, Value::Int(15)), "got {v:?}");
3134 }
3135
3136 #[test]
3139 fn the_expansion_ceiling_is_configurable() {
3140 let forms = read_spanned("(defmacro forever (x) `(forever ,x))\n(forever 1)").unwrap();
3141 let mut i: Interpreter<NoHost> = Interpreter::new();
3142 install_primitives(&mut i);
3143 i.set_macro_expansion_limit(4);
3144 match i.eval_program(&forms, &mut NoHost).unwrap_err() {
3145 EvalError::MacroExpansionLimit { limit, .. } => assert_eq!(limit, 4),
3146 other => panic!("expected MacroExpansionLimit, got {other:?}"),
3147 }
3148 }
3149
3150 #[test]
3151 fn user_macro_expands_and_evaluates() {
3152 let v = eval_ok(
3153 "(defmacro twice (x) `(* ,x 2))
3154 (twice 21)",
3155 );
3156 assert!(matches!(v, Value::Int(42)));
3157 }
3158
3159 #[test]
3160 fn user_macro_definition_returns_nil() {
3161 let v = eval_ok("(defmacro inc (x) `(+ ,x 1))");
3162 assert!(matches!(v, Value::Nil));
3163 }
3164
3165 #[test]
3166 fn user_macro_inside_define_body_expands() {
3167 let v = eval_ok(
3170 "(defmacro inc (x) `(+ ,x 1))
3171 (define (f n) (inc n))
3172 (f 41)",
3173 );
3174 assert!(matches!(v, Value::Int(42)));
3175 }
3176
3177 #[test]
3178 fn user_macro_with_rest_args_splices() {
3179 let v = eval_ok(
3180 "(defmacro sum-all (&rest xs) `(+ ,@xs))
3181 (sum-all 1 2 3 4 5)",
3182 );
3183 assert!(matches!(v, Value::Int(15)));
3184 }
3185
3186 #[test]
3187 fn nested_user_macros_compose() {
3188 let v = eval_ok(
3189 "(defmacro twice (x) `(* ,x 2))
3190 (defmacro quad (x) `(twice (twice ,x)))
3191 (quad 5)",
3192 );
3193 assert!(matches!(v, Value::Int(20)));
3194 }
3195
3196 #[test]
3197 fn user_macro_can_expand_to_special_form() {
3198 let v = eval_ok(
3201 "(defmacro guard (test then) `(if ,test ,then 0))
3202 (guard #t 99)",
3203 );
3204 assert!(matches!(v, Value::Int(99)));
3205 }
3206
3207 #[test]
3208 fn user_macro_redefined_replaces_prior_template() {
3209 let v = eval_ok(
3210 "(defmacro k () `1)
3211 (defmacro k () `2)
3212 (k)",
3213 );
3214 assert!(matches!(v, Value::Int(2)));
3215 }
3216
3217 #[test]
3218 fn user_macro_unbound_template_var_errors() {
3219 let mut i: Interpreter<NoHost> = Interpreter::new();
3225 install_primitives(&mut i);
3226 let forms = read_spanned("(defmacro bad (x) `(list ,y)) (bad 1)").unwrap();
3227 let err = i.eval_program(&forms, &mut NoHost).unwrap_err();
3228 match err {
3229 EvalError::UnboundSymbol { name, .. } => assert_eq!(&*name, "y"),
3230 other => panic!("expected UnboundSymbol, got {other:?}"),
3231 }
3232 }
3233
3234 #[test]
3235 fn defpoint_template_keyword_registers_as_macro() {
3236 let v = eval_ok(
3239 "(defpoint-template double (x) `(* ,x 2))
3240 (double 7)",
3241 );
3242 assert!(matches!(v, Value::Int(14)));
3243 }
3244
3245 #[test]
3246 fn defcheck_keyword_registers_as_macro() {
3247 let v = eval_ok(
3248 "(defcheck always-7 () `7)
3249 (always-7)",
3250 );
3251 assert!(matches!(v, Value::Int(7)));
3252 }
3253
3254 #[test]
3255 fn macro_call_evaluated_with_runtime_arg() {
3256 let v = eval_ok(
3260 "(defmacro double (x) `(+ ,x ,x))
3261 (define n 13)
3262 (double n)",
3263 );
3264 assert!(matches!(v, Value::Int(26)));
3265 }
3266
3267 #[test]
3268 fn macro_persists_across_eval_program_calls() {
3269 let mut i: Interpreter<NoHost> = Interpreter::new();
3272 install_primitives(&mut i);
3273 let mut host = NoHost;
3274 let defs = read_spanned("(defmacro inc (x) `(+ ,x 1))").unwrap();
3275 i.eval_program(&defs, &mut host).unwrap();
3276 assert_eq!(i.expander().len(), 1);
3277
3278 let call = read_spanned("(inc 41)").unwrap();
3279 let v = i.eval_program(&call, &mut host).unwrap();
3280 assert!(matches!(v, Value::Int(42)));
3281 }
3282
3283 #[test]
3284 fn macro_expansion_inside_lambda_body() {
3285 let v = eval_ok(
3286 "(defmacro sq (x) `(* ,x ,x))
3287 ((lambda (n) (sq n)) 9)",
3288 );
3289 assert!(matches!(v, Value::Int(81)));
3290 }
3291
3292 #[test]
3293 fn no_macros_registered_keeps_eval_program_a_passthrough() {
3294 let v = eval_ok("(+ 1 2 3)");
3300 assert!(matches!(v, Value::Int(6)));
3301 }
3302
3303 #[test]
3304 fn eval_top_form_drives_one_form_at_a_time() {
3305 let mut i: Interpreter<NoHost> = Interpreter::new();
3306 install_primitives(&mut i);
3307 let mut host = NoHost;
3308 let forms = read_spanned("(defmacro id (x) `,x) (id 42)").unwrap();
3309
3310 let r0 = i.eval_top_form(&forms[0], &mut host).unwrap();
3312 assert!(matches!(r0, Value::Nil));
3313
3314 let r1 = i.eval_top_form(&forms[1], &mut host).unwrap();
3316 assert!(matches!(r1, Value::Int(42)));
3317 }
3318
3319 use crate::install_full_stdlib_with;
3326
3327 fn run_full(src: &str) -> Value {
3328 let mut i: Interpreter<NoHost> = Interpreter::new();
3329 install_full_stdlib_with(&mut i, &mut NoHost);
3330 let forms = read_spanned(src).unwrap();
3331 i.eval_program(&forms, &mut NoHost).unwrap()
3332 }
3333
3334 #[test]
3335 fn macro_can_use_map_at_expansion_time() {
3336 let v = run_full(
3340 "(defmacro double-each (&rest xs)
3341 `(list ,@(map (lambda (x) (* x 2)) xs)))
3342 (double-each 1 2 3 4 5)",
3343 );
3344 assert_eq!(format!("{v}"), "(2 4 6 8 10)");
3345 }
3346
3347 #[test]
3348 fn macro_can_use_foldl_at_expansion_time() {
3349 let v = run_full(
3353 "(defmacro static-sum (&rest xs)
3354 (foldl + 0 xs))
3355 (static-sum 1 2 3 4 5)",
3356 );
3357 assert!(matches!(v, Value::Int(15)));
3358 }
3359
3360 #[test]
3361 fn macro_can_use_filter_at_expansion_time() {
3362 let v = run_full(
3366 "(defmacro sum-positives (&rest xs)
3367 `(+ ,@(filter positive? xs)))
3368 (sum-positives 1 -2 3 -4 5)",
3369 );
3370 assert!(matches!(v, Value::Int(9)));
3372 }
3373
3374 #[test]
3375 fn macro_can_recursively_emit_let_chain() {
3376 let v = run_full(
3379 "(defmacro chain-let (binding &rest more)
3380 (if (null? more)
3381 `(let (,binding) #t)
3382 `(let (,binding) (chain-let ,@more))))
3383 (chain-let (a 1) (b 2) (c 3))",
3384 );
3385 assert!(matches!(v, Value::Bool(true)));
3386 }
3387
3388 #[test]
3389 fn macro_can_use_gensym_for_hygiene() {
3390 let v = run_full(
3393 "(defmacro swap-bind (init body)
3394 (let ((tmp (gensym \"tmp\")))
3395 `(let ((,tmp ,init))
3396 (+ ,tmp ,tmp))))
3397 (swap-bind 21 #t)",
3398 );
3399 assert!(matches!(v, Value::Int(42)));
3400 }
3401
3402 #[test]
3403 fn macro_can_inspect_arg_shape() {
3404 let v = run_full(
3406 "(defmacro shape-aware (x)
3407 (if (list? x)
3408 `(+ ,@x) ;; sum the children
3409 `,x)) ;; pass through scalars
3410 (+ (shape-aware (1 2 3)) (shape-aware 100))",
3411 );
3412 assert!(matches!(v, Value::Int(106)));
3414 }
3415
3416 #[test]
3417 fn macro_can_call_user_helper_fn() {
3418 let v = run_full(
3420 "(define (square x) (* x x))
3421 (defmacro static-square (n) (square n))
3422 (static-square 7)",
3423 );
3424 assert!(matches!(v, Value::Int(49)));
3425 }
3426
3427 #[test]
3428 fn macro_emitting_quoted_form_round_trips() {
3429 let v = run_full(
3432 "(defmacro literal-list (&rest xs)
3433 `(quote ,xs))
3434 (literal-list a b c)",
3435 );
3436 let s = format!("{v}");
3437 assert!(s.contains('a') && s.contains('b') && s.contains('c'));
3438 }
3439
3440 #[test]
3441 fn quasiquote_inside_quasiquote_in_macro_output_is_preserved() {
3442 let v = run_full(
3445 "(defmacro emit-qq (x) `(quasiquote (a (unquote ,x) c)))
3446 (let ((q (emit-qq 99))) q)",
3447 );
3448 assert_eq!(format!("{v}"), "(a 99 c)");
3450 }
3451
3452 #[test]
3453 fn macro_body_can_define_locals_and_dispatch() {
3454 let v = run_full(
3456 "(defmacro classify-args (&rest xs)
3457 (let ((evens (filter even? xs))
3458 (odds (filter odd? xs)))
3459 `(list (list :evens ,@evens)
3460 (list :odds ,@odds))))
3461 (classify-args 1 2 3 4 5 6)",
3462 );
3463 let s = format!("{v}");
3464 assert!(s.contains(":evens 2 4 6"));
3465 assert!(s.contains(":odds 1 3 5"));
3466 }
3467
3468 #[test]
3477 fn tco_self_recursion_via_if() {
3478 let v = run_full(
3482 "(define (sum n acc)
3483 (if (= n 0)
3484 acc
3485 (sum (- n 1) (+ acc n))))
3486 (sum 100000 0)",
3487 );
3488 assert!(matches!(v, Value::Int(5_000_050_000)));
3490 }
3491
3492 #[test]
3493 fn tco_mutual_recursion() {
3494 let v = run_full(
3497 "(define (even-r? n) (if (= n 0) #t (odd-r? (- n 1))))
3498 (define (odd-r? n) (if (= n 0) #f (even-r? (- n 1))))
3499 (even-r? 50000)",
3500 );
3501 assert!(matches!(v, Value::Bool(true)));
3502 }
3503
3504 #[test]
3505 fn tco_via_cond_branch() {
3506 let v = run_full(
3507 "(define (countdown n)
3508 (cond
3509 ((<= n 0) :done)
3510 (else (countdown (- n 1)))))
3511 (countdown 50000)",
3512 );
3513 assert!(matches!(v, Value::Keyword(s) if &*s == "done"));
3514 }
3515
3516 #[test]
3517 fn tco_via_let_body() {
3518 let v = run_full(
3521 "(define (loop-let n)
3522 (let ((m (- n 1)))
3523 (if (<= n 0) :done (loop-let m))))
3524 (loop-let 50000)",
3525 );
3526 assert!(matches!(v, Value::Keyword(s) if &*s == "done"));
3527 }
3528
3529 #[test]
3530 fn tco_via_begin_last_form() {
3531 let v = run_full(
3532 "(define (counter n)
3533 (begin
3534 (+ 1 1)
3535 (+ 2 2)
3536 (if (<= n 0) :done (counter (- n 1)))))
3537 (counter 50000)",
3538 );
3539 assert!(matches!(v, Value::Keyword(s) if &*s == "done"));
3540 }
3541
3542 #[test]
3543 fn tco_via_when_unless() {
3544 let v = run_full(
3545 "(define (drain n)
3546 (when (> n 0)
3547 (drain (- n 1))))
3548 (drain 50000)",
3549 );
3550 assert!(matches!(v, Value::Nil));
3552 }
3553
3554 #[test]
3555 fn tco_through_and_or_short_circuit_last() {
3556 let v = run_full(
3559 "(define (loop-and n)
3560 (and #t #t (if (<= n 0) :done (loop-and (- n 1)))))
3561 (loop-and 30000)",
3562 );
3563 assert!(matches!(v, Value::Keyword(s) if &*s == "done"));
3564 }
3565
3566 #[test]
3567 fn non_tail_recursion_still_works_for_small_n() {
3568 let v = run_full(
3572 "(define (fact n)
3573 (if (= n 0) 1 (* n (fact (- n 1)))))
3574 (fact 12)",
3575 );
3576 assert!(matches!(v, Value::Int(479_001_600)));
3578 }
3579
3580 #[test]
3583 fn error_constructor_returns_error_value() {
3584 let v = run_full("(error :validation \"bad input\")");
3585 match v {
3586 Value::Error(e) => {
3587 assert_eq!(&*e.tag, "validation");
3588 assert_eq!(&*e.message, "bad input");
3589 assert!(e.data.is_empty());
3590 }
3591 other => panic!("{other:?}"),
3592 }
3593 }
3594
3595 #[test]
3596 fn ex_info_uses_default_tag() {
3597 let v = run_full("(ex-info \"validation failed\" (list :field \"email\" :code 42))");
3598 match v {
3599 Value::Error(e) => {
3600 assert_eq!(&*e.tag, "ex-info");
3601 assert_eq!(&*e.message, "validation failed");
3602 assert_eq!(e.data.len(), 2);
3603 }
3604 other => panic!("{other:?}"),
3605 }
3606 }
3607
3608 #[test]
3609 fn error_predicate() {
3610 let v = run_full("(error? (error :x \"y\"))");
3611 assert!(matches!(v, Value::Bool(true)));
3612 let v = run_full("(error? 42)");
3613 assert!(matches!(v, Value::Bool(false)));
3614 }
3615
3616 #[test]
3617 fn error_accessors() {
3618 let v = run_full(
3619 "(let ((e (ex-info \"oops\" (list :user-id 42))))
3620 (list (error-tag e) (error-message e) (error-data-get e :user-id)))",
3621 );
3622 assert_eq!(format!("{v}"), "(:ex-info \"oops\" 42)");
3623 }
3624
3625 #[test]
3626 fn try_catches_thrown_error() {
3627 let v = run_full(
3628 "(try
3629 (throw (ex-info \"boom\" (list :code 500)))
3630 (catch (e)
3631 (error-message e)))",
3632 );
3633 assert_eq!(format!("{v}"), "\"boom\"");
3634 }
3635
3636 #[test]
3637 fn try_returns_body_value_when_no_throw() {
3638 let v = run_full(
3639 "(try
3640 (+ 1 2 3)
3641 (catch (e) :unreachable))",
3642 );
3643 assert!(matches!(v, Value::Int(6)));
3644 }
3645
3646 #[test]
3647 fn try_catches_runtime_errors_too() {
3648 let v = run_full(
3652 "(try
3653 (/ 1 0)
3654 (catch (e) (error-tag e)))",
3655 );
3656 assert!(matches!(v, Value::Keyword(s) if &*s == "division-by-zero"));
3657 }
3658
3659 #[test]
3660 fn try_catches_unbound_symbol_error() {
3661 let v = run_full(
3662 "(try
3663 undefined-var
3664 (catch (e) (error-tag e)))",
3665 );
3666 assert!(matches!(v, Value::Keyword(s) if &*s == "unbound-symbol"));
3667 }
3668
3669 #[test]
3670 fn try_catches_arity_mismatch() {
3671 let v = run_full(
3672 "(try
3673 ((lambda (x y) (+ x y)) 1)
3674 (catch (e) (error-tag e)))",
3675 );
3676 assert!(matches!(v, Value::Keyword(s) if &*s == "arity-mismatch"));
3677 }
3678
3679 #[test]
3680 fn nested_try_inner_handler_takes_precedence() {
3681 let v = run_full(
3682 "(try
3683 (try
3684 (throw (ex-info \"inner\" ()))
3685 (catch (e) :inner-caught))
3686 (catch (e) :outer-caught))",
3687 );
3688 assert!(matches!(v, Value::Keyword(s) if &*s == "inner-caught"));
3689 }
3690
3691 #[test]
3692 fn outer_try_catches_when_handler_rethrows() {
3693 let v = run_full(
3694 "(try
3695 (try
3696 (throw (ex-info \"first\" ()))
3697 (catch (e) (throw (ex-info \"rethrown\" ()))))
3698 (catch (e) (error-message e)))",
3699 );
3700 assert_eq!(format!("{v}"), "\"rethrown\"");
3701 }
3702
3703 #[test]
3704 fn throw_propagates_when_no_try() {
3705 let mut i: Interpreter<NoHost> = Interpreter::new();
3707 install_full_stdlib_with(&mut i, &mut NoHost);
3708 let forms = read_spanned("(throw (ex-info \"unhandled\" (list :code 99)))").unwrap();
3709 let err = i.eval_program(&forms, &mut NoHost).unwrap_err();
3710 match err {
3711 EvalError::User { value, .. } => match value {
3712 Value::Error(e) => {
3713 assert_eq!(&*e.message, "unhandled");
3714 }
3715 other => panic!("{other:?}"),
3716 },
3717 other => panic!("{other:?}"),
3718 }
3719 }
3720
3721 #[test]
3724 fn macroexpand_one_step() {
3725 let v = run_full(
3726 "(defmacro twice (x) `(* ,x 2))
3727 (macroexpand-1 '(twice 7))",
3728 );
3729 assert_eq!(format!("{v}"), "(* 7 2)");
3731 }
3732
3733 #[test]
3734 fn macroexpand_full_until_fixed_point() {
3735 let v = run_full(
3736 "(defmacro twice (x) `(* ,x 2))
3737 (defmacro quad (x) `(twice (twice ,x)))
3738 (macroexpand '(quad 5))",
3739 );
3740 assert_eq!(format!("{v}"), "(* (* 5 2) 2)");
3742 }
3743
3744 #[test]
3745 fn macroexpand_returns_unchanged_for_non_macro() {
3746 let v = run_full("(macroexpand-1 '(+ 1 2 3))");
3747 assert_eq!(format!("{v}"), "(+ 1 2 3)");
3749 }
3750
3751 #[test]
3752 fn macroexpand_one_does_not_recurse_into_children() {
3753 let v = run_full(
3755 "(defmacro twice (x) `(* ,x 2))
3756 (defmacro outer (x) `(list ,x))
3757 (macroexpand-1 '(outer (twice 3)))",
3758 );
3759 assert_eq!(format!("{v}"), "(list (twice 3))");
3761 }
3762
3763 #[test]
3764 fn macroexpand_recurses_into_children() {
3765 let v = run_full(
3766 "(defmacro twice (x) `(* ,x 2))
3767 (defmacro outer (x) `(list ,x))
3768 (macroexpand '(outer (twice 3)))",
3769 );
3770 assert_eq!(format!("{v}"), "(list (* 3 2))");
3772 }
3773
3774 fn run_with_modules(modules: &[(&str, &str)], src: &str) -> Value {
3777 use crate::module::MapLoader;
3778 let mut i: Interpreter<NoHost> = Interpreter::new();
3779 install_full_stdlib_with(&mut i, &mut NoHost);
3780 let mut loader = MapLoader::new();
3781 for (path, source) in modules {
3782 loader.insert(*path, *source);
3783 }
3784 i.set_loader(Arc::new(loader));
3785 let forms = read_spanned(src).unwrap();
3786 i.eval_program(&forms, &mut NoHost).unwrap()
3787 }
3788
3789 fn run_with_modules_err(modules: &[(&str, &str)], src: &str) -> EvalError {
3790 use crate::module::MapLoader;
3791 let mut i: Interpreter<NoHost> = Interpreter::new();
3792 install_full_stdlib_with(&mut i, &mut NoHost);
3793 let mut loader = MapLoader::new();
3794 for (path, source) in modules {
3795 loader.insert(*path, *source);
3796 }
3797 i.set_loader(Arc::new(loader));
3798 let forms = read_spanned(src).unwrap();
3799 i.eval_program(&forms, &mut NoHost).unwrap_err()
3800 }
3801
3802 #[test]
3803 fn require_with_explicit_alias_imports_qualified_names() {
3804 let v = run_with_modules(
3805 &[(
3806 "lib/math",
3807 "(define square (lambda (x) (* x x)))
3808 (define cube (lambda (x) (* x x x)))
3809 (provide square cube)",
3810 )],
3811 "(require \"lib/math\" :as math)
3812 (math/square 7)",
3813 );
3814 assert!(matches!(v, Value::Int(49)));
3815 }
3816
3817 #[test]
3818 fn require_uses_path_as_default_alias() {
3819 let v = run_with_modules(
3820 &[(
3821 "lib/math",
3822 "(define double (lambda (x) (* x 2))) (provide double)",
3823 )],
3824 "(require \"lib/math\")
3825 (lib/math/double 21)",
3826 );
3827 assert!(matches!(v, Value::Int(42)));
3830 }
3831
3832 #[test]
3833 fn require_refer_imports_unqualified_names() {
3834 let v = run_with_modules(
3835 &[(
3836 "lib/math",
3837 "(define square (lambda (x) (* x x)))
3838 (define cube (lambda (x) (* x x x)))
3839 (provide square cube)",
3840 )],
3841 "(require \"lib/math\" :refer (square))
3842 (square 6)",
3843 );
3844 assert!(matches!(v, Value::Int(36)));
3845 }
3846
3847 #[test]
3848 fn require_does_not_import_non_provided() {
3849 let err = run_with_modules_err(
3852 &[(
3853 "lib/secret",
3854 "(define public 1)
3855 (define private 2)
3856 (provide public)",
3857 )],
3858 "(require \"lib/secret\" :as s)
3859 s/private",
3860 );
3861 match err {
3862 EvalError::UnboundSymbol { name, .. } => assert_eq!(&*name, "s/private"),
3863 other => panic!("{other:?}"),
3864 }
3865 }
3866
3867 #[test]
3868 fn require_chain_a_imports_b() {
3869 let v = run_with_modules(
3870 &[
3871 (
3872 "lib/util",
3873 "(define inc1 (lambda (n) (+ n 1)))
3874 (provide inc1)",
3875 ),
3876 (
3877 "lib/wrapper",
3878 "(require \"lib/util\" :as u)
3879 (define inc2 (lambda (n) (u/inc1 (u/inc1 n))))
3880 (provide inc2)",
3881 ),
3882 ],
3883 "(require \"lib/wrapper\" :as w)
3884 (w/inc2 10)",
3885 );
3886 assert!(matches!(v, Value::Int(12)));
3887 }
3888
3889 #[test]
3890 fn require_module_not_found() {
3891 let err = run_with_modules_err(&[], "(require \"missing/module\")");
3892 match err {
3894 EvalError::User { value, .. } => match value {
3895 Value::Error(e) => {
3896 assert_eq!(&*e.tag, "module-not-found");
3897 assert!(e.message.contains("missing/module"));
3898 }
3899 other => panic!("{other:?}"),
3900 },
3901 other => panic!("{other:?}"),
3902 }
3903 }
3904
3905 #[test]
3906 fn circular_require_detected() {
3907 let err = run_with_modules_err(
3908 &[
3909 ("a", "(require \"b\") (provide x) (define x 1)"),
3910 ("b", "(require \"a\") (provide y) (define y 2)"),
3911 ],
3912 "(require \"a\")",
3913 );
3914 match err {
3915 EvalError::User { value, .. } => match value {
3916 Value::Error(e) => assert_eq!(&*e.tag, "circular-require"),
3917 other => panic!("{other:?}"),
3918 },
3919 other => panic!("{other:?}"),
3920 }
3921 }
3922
3923 #[test]
3924 fn provide_at_top_level_errors() {
3925 let mut i: Interpreter<NoHost> = Interpreter::new();
3927 install_full_stdlib_with(&mut i, &mut NoHost);
3928 let forms = read_spanned("(provide x)").unwrap();
3929 let err = i.eval_program(&forms, &mut NoHost).unwrap_err();
3930 assert!(matches!(err, EvalError::BadSpecialForm { form, .. } if &*form == "provide"));
3931 }
3932
3933 #[test]
3934 fn require_refer_unknown_name_errors() {
3935 let err = run_with_modules_err(
3936 &[(
3937 "lib/math",
3938 "(define square (lambda (x) (* x x))) (provide square)",
3939 )],
3940 "(require \"lib/math\" :refer (square cube))",
3941 );
3942 match err {
3943 EvalError::User { value, .. } => match value {
3944 Value::Error(e) => {
3945 assert!(matches!(&*e.tag, "not-defined" | "not-exported"));
3946 }
3947 other => panic!("{other:?}"),
3948 },
3949 other => panic!("{other:?}"),
3950 }
3951 }
3952
3953 #[test]
3954 fn require_caches_module_load_once() {
3955 let v = run_with_modules(
3956 &[("lib/foo", "(define x 42) (provide x)")],
3957 "(require \"lib/foo\" :as a)
3958 (require \"lib/foo\" :as b)
3959 (+ a/x b/x)",
3960 );
3961 assert!(matches!(v, Value::Int(84)));
3963 }
3964
3965 #[test]
3974 fn macro_body_cannot_set_a_global() {
3975 let mut interp = Interpreter::new();
3976 install_primitives(&mut interp);
3977 let src = "(define *g* 0) (defmacro leak () (set! *g* 99)) (leak)";
3978 let forms = tatara_lisp::read_spanned(src).expect("parse");
3979 let err = interp
3980 .eval_program(&forms, &mut ())
3981 .expect_err("a macro must not be able to set! a global");
3982 let msg = format!("{err}");
3983 assert!(
3984 msg.contains("sealed") || msg.contains("cannot `set!`"),
3985 "expected a sealed-write diagnostic, got: {msg}"
3986 );
3987 }
3988
3989 #[test]
3990 fn the_global_is_actually_unchanged_after_a_refused_macro_set() {
3991 let mut interp = Interpreter::new();
3992 install_primitives(&mut interp);
3993 let forms = tatara_lisp::read_spanned("(define *g* 0) (defmacro leak () (set! *g* 99))")
3994 .expect("parse");
3995 interp.eval_program(&forms, &mut ()).expect("setup");
3996 let call = tatara_lisp::read_spanned("(leak)").expect("parse");
3998 let _ = interp.eval_program(&call, &mut ());
3999 let read = tatara_lisp::read_spanned("*g*").expect("parse");
4000 let v = interp.eval_program(&read, &mut ()).expect("read *g*");
4001 assert!(
4002 matches!(v, Value::Int(0)),
4003 "global was mutated by a macro body despite the seal: {v:?}"
4004 );
4005 }
4006
4007 #[test]
4010 fn ordinary_set_still_works_at_runtime() {
4011 let mut interp = Interpreter::new();
4012 install_primitives(&mut interp);
4013 let forms = tatara_lisp::read_spanned("(define x 1) (set! x 42) x").expect("parse");
4014 let v = interp.eval_program(&forms, &mut ()).expect("runtime set!");
4015 assert!(matches!(v, Value::Int(42)), "got {v:?}");
4016 }
4017
4018 #[test]
4021 fn macro_body_can_mutate_its_own_locals() {
4022 let mut interp = Interpreter::new();
4023 install_primitives(&mut interp);
4024 let src = "(defmacro m () (begin (define n 1) (set! n 2) n)) (m)";
4025 let forms = tatara_lisp::read_spanned(src).expect("parse");
4026 let v = interp
4027 .eval_program(&forms, &mut ())
4028 .expect("a macro must be able to mutate its own locals");
4029 assert!(matches!(v, Value::Int(2)), "got {v:?}");
4030 }
4031}