diff --git a/src/builtin/functions/common.rs b/src/builtin/functions/common.rs deleted file mode 100644 index 8894219..0000000 --- a/src/builtin/functions/common.rs +++ /dev/null @@ -1,68 +0,0 @@ -use crate::{Error, TulispContext, TulispObject, TulispValue}; - -pub(crate) fn eval_1_arg_special_form( - ctx: &mut TulispContext, - name: &str, - args: &TulispObject, - has_rest: bool, - lambda: fn(&mut TulispContext, &TulispObject, &TulispObject) -> Result, -) -> Result { - if args.null() { - return Err(Error::missing_argument(if has_rest { - format!("{}: expected at least 1 argument.", name) - } else { - format!("{}: expected 1 argument.", name) - })); - } - args.car_and_then(|arg1| { - args.cdr_and_then(|rest| { - if !has_rest && !rest.null() { - return Err(Error::missing_argument(format!( - "{}: expected only 1 argument.", - name - ))); - } - lambda(ctx, arg1, rest) - }) - }) -} - -pub(crate) fn eval_2_arg_special_form( - ctx: &mut TulispContext, - name: &str, - args: &TulispObject, - has_rest: bool, - lambda: fn( - &mut TulispContext, - &TulispObject, - &TulispObject, - &TulispObject, - ) -> Result, -) -> Result { - let TulispValue::List { cons: args, .. } = &*args.inner_ref() else { - return Err(Error::missing_argument(if has_rest { - format!("{}: expected at least 2 arguments.", name) - } else { - format!("{}: expected 2 arguments.", name) - })); - }; - if args.cdr().null() { - return Err(Error::missing_argument(if has_rest { - format!("{}: expected at least 2 arguments.", name) - } else { - format!("{}: expected 2 arguments.", name) - })); - } - let arg1 = args.car(); - args.cdr().car_and_then(|arg2| { - args.cdr().cdr_and_then(|rest| { - if !has_rest && !rest.null() { - return Err(Error::missing_argument(format!( - "{}: expected only 2 arguments.", - name - ))); - } - lambda(ctx, arg1, arg2, rest) - }) - }) -} diff --git a/src/builtin/functions/conditionals.rs b/src/builtin/functions/conditionals.rs index 5801458..d2dc8ea 100644 --- a/src/builtin/functions/conditionals.rs +++ b/src/builtin/functions/conditionals.rs @@ -1,24 +1,19 @@ use crate::{ - Error, TulispContext, TulispObject, TulispValue, - builtin::functions::common::eval_2_arg_special_form, - destruct_bind, destruct_eval_bind, + Error, TulispContext, TulispObject, destruct_bind, destruct_eval_bind, eval::{eval_and_then, eval_basic}, list, lists::{last, length}, }; -use std::rc::Rc; pub(crate) fn add(ctx: &mut TulispContext) { - fn impl_if(ctx: &mut TulispContext, args: &TulispObject) -> Result { - eval_2_arg_special_form(ctx, "if", args, true, |ctx, cond, then, else_body| { - if eval_and_then(ctx, cond, |_, x| Ok(x.is_truthy()))? { - ctx.eval(then) - } else { - ctx.eval_progn(else_body) - } - }) - } - intern_set_func!(ctx, impl_if, "if"); + ctx.add_special_form("if", |ctx, args| { + destruct_bind!((cond then &rest body) = args); + if ctx.eval_and_then(&cond, |_, x| Ok(x.is_truthy()))? { + ctx.eval(&then) + } else { + ctx.eval_progn(&body) + } + }); fn when(ctx: &mut TulispContext, args: &TulispObject) -> Result { destruct_bind!((cond &rest body) = args); @@ -36,15 +31,14 @@ pub(crate) fn add(ctx: &mut TulispContext) { } ctx.add_macro("unless", unless); - fn cond(ctx: &mut TulispContext, args: &TulispObject) -> Result { + ctx.add_special_form("cond", |ctx, args| { for item in args.base_iter() { if item.car_and_then(|x| eval_and_then(ctx, x, |_, x| Ok(x.is_truthy())))? { return item.cdr_and_then(|x| ctx.eval_progn(x)); } } Ok(TulispObject::nil()) - } - intern_set_func!(ctx, cond, "cond"); + }); // Constructs for combining conditions fn not(ctx: &mut TulispContext, args: &TulispObject) -> Result { diff --git a/src/builtin/functions/functions.rs b/src/builtin/functions/functions.rs index 7406630..f24dc77 100644 --- a/src/builtin/functions/functions.rs +++ b/src/builtin/functions/functions.rs @@ -14,7 +14,6 @@ use crate::lists; use crate::value::DefunParams; use crate::{destruct_bind, list}; use std::convert::TryInto; -use std::rc::Rc; pub(super) fn reduce_with( ctx: &mut TulispContext, @@ -221,7 +220,7 @@ pub(crate) fn add(ctx: &mut TulispContext) { Ok(result) }); - fn setq(ctx: &mut TulispContext, args: &TulispObject) -> Result { + ctx.add_special_form("setq", |ctx, args| { let value = args.cdr_and_then(|args| { if args.null() { return Err(Error::type_mismatch( @@ -239,20 +238,19 @@ pub(crate) fn add(ctx: &mut TulispContext) { })?; args.car_and_then(|name| name.set(value.clone()))?; Ok(value) - } - intern_set_func!(ctx, setq); + }); - fn set(ctx: &mut TulispContext, args: &TulispObject) -> Result { + ctx.add_special_form("set", |ctx, args| { let value = args.cdr_and_then(|args| { if args.null() { return Err(Error::type_mismatch( - "setq requires exactly 2 arguments".to_string(), + "set requires exactly 2 arguments".to_string(), )); } args.cdr_and_then(|x| { if !x.null() { return Err(Error::type_mismatch( - "setq requires exactly 2 arguments".to_string(), + "set requires exactly 2 arguments".to_string(), )); } args.car_and_then(|arg| ctx.eval(arg)) @@ -262,8 +260,7 @@ pub(crate) fn add(ctx: &mut TulispContext) { ctx.eval_and_then(name_sym, |_, name| name.set(value.clone())) })?; Ok(value) - } - intern_set_func!(ctx, set); + }); fn impl_let(ctx: &mut TulispContext, args: &TulispObject) -> Result { destruct_bind!((varlist &rest rest) = args); @@ -492,7 +489,7 @@ pub(crate) fn add(ctx: &mut TulispContext) { // List functions - fn impl_cons(ctx: &mut TulispContext, args: &TulispObject) -> Result { + ctx.add_special_form("cons", |ctx, args| { let cdr = args.cdr_and_then(|args| { if args.null() { return Err(Error::type_mismatch( @@ -510,8 +507,7 @@ pub(crate) fn add(ctx: &mut TulispContext) { })?; let car = args.car_and_then(|arg| ctx.eval(arg))?; Ok(TulispObject::cons(car, cdr)) - } - intern_set_func!(ctx, impl_cons, "cons"); + }); ctx.add_special_form("append", |ctx, args| { destruct_eval_bind!(ctx, (first &rest rest) = args); @@ -521,7 +517,7 @@ pub(crate) fn add(ctx: &mut TulispContext) { Ok(first) }); - fn dolist(ctx: &mut TulispContext, args: &TulispObject) -> Result { + ctx.add_special_form("dolist", |ctx, args| { destruct_bind!((spec &rest body) = args); destruct_bind!((var list &optional result) = spec); let mut list = ctx.eval(&list)?; @@ -534,10 +530,9 @@ pub(crate) fn add(ctx: &mut TulispContext) { } var.unset()?; ctx.eval(&result) - } - intern_set_func!(ctx, dolist); + }); - fn dotimes(ctx: &mut TulispContext, args: &TulispObject) -> Result { + ctx.add_special_form("dotimes", |ctx, args| { destruct_bind!((spec &rest body) = args); destruct_bind!((var count &optional result) = spec); var.set_scope(TulispObject::from(0))?; @@ -548,10 +543,9 @@ pub(crate) fn add(ctx: &mut TulispContext) { } var.unset()?; ctx.eval(&result) - } - intern_set_func!(ctx, dotimes); + }); - fn list(ctx: &mut TulispContext, args: &TulispObject) -> Result { + ctx.add_special_form("list", |ctx, args| { let (ctxobj, span) = (args.ctxobj(), args.span()); let mut cons: Option = None; for ele in args.base_iter() { @@ -566,8 +560,7 @@ pub(crate) fn add(ctx: &mut TulispContext) { Some(cons) => Ok(TulispValue::List { cons, ctxobj }.into_ref(span)), None => Ok(TulispObject::nil()), } - } - intern_set_func!(ctx, list); + }); ctx.add_special_form("mapcar", |ctx, args| { destruct_eval_bind!(ctx, (func seq) = args); @@ -622,7 +615,7 @@ pub(crate) fn add(ctx: &mut TulispContext) { } args.car_and_then(|arg| eval_and_then(ctx, &arg, |_, x| Ok(x.$name().into()))) } - intern_set_func!(ctx, $name); + ctx.add_special_form(stringify!($name), $name); }; } predicate_function!(consp); diff --git a/src/builtin/functions/mod.rs b/src/builtin/functions/mod.rs index 3c57653..326346a 100644 --- a/src/builtin/functions/mod.rs +++ b/src/builtin/functions/mod.rs @@ -42,18 +42,6 @@ macro_rules! binary_ops { }}; } -macro_rules! intern_set_func { - ($ctx:ident, $func: ident, $name: expr) => { - $ctx.intern($name) - .set_global(TulispValue::Func(Rc::new($func)).into_ref(None)) - .unwrap(); - }; - ($ctx:ident, $func: ident) => { - intern_set_func!($ctx, $func, stringify!($func)); - }; -} - -pub(crate) mod common; mod comparison_of_strings; mod conditionals; mod equality_predicates; diff --git a/src/builtin/functions/numbers/arithmetic_operations.rs b/src/builtin/functions/numbers/arithmetic_operations.rs index 502b1ba..f420b4c 100644 --- a/src/builtin/functions/numbers/arithmetic_operations.rs +++ b/src/builtin/functions/numbers/arithmetic_operations.rs @@ -4,13 +4,11 @@ use crate::eval::eval; use crate::{Error, TulispContext, TulispObject, TulispValue}; -use std::rc::Rc; - pub(crate) fn add(ctx: &mut TulispContext) { fn add(ctx: &mut TulispContext, args: &TulispObject) -> Result { reduce_with(ctx, args, binary_ops!(std::ops::Add::add)) } - intern_set_func!(ctx, add, "+"); + ctx.add_special_form("+", add); fn sub(ctx: &mut TulispContext, args: &TulispObject) -> Result { if let Some(cons) = args.as_list_cons() { @@ -26,12 +24,12 @@ pub(crate) fn add(ctx: &mut TulispContext) { )) } } - intern_set_func!(ctx, sub, "-"); + ctx.add_special_form("-", sub); fn mul(ctx: &mut TulispContext, args: &TulispObject) -> Result { reduce_with(ctx, args, binary_ops!(std::ops::Mul::mul)) } - intern_set_func!(ctx, mul, "*"); + ctx.add_special_form("*", mul); fn div(ctx: &mut TulispContext, rest: &TulispObject) -> Result { let mut iter = rest.base_iter(); @@ -47,7 +45,7 @@ pub(crate) fn add(ctx: &mut TulispContext) { } reduce_with(ctx, rest, binary_ops!(std::ops::Div::div)) } - intern_set_func!(ctx, div, "/"); + ctx.add_special_form("/", div); ctx.add_special_form("1+", |ctx, args| { destruct_eval_bind!(ctx, (number) = args); diff --git a/src/builtin/functions/numbers/comparison_of_numbers.rs b/src/builtin/functions/numbers/comparison_of_numbers.rs index c2a27b5..a1fd8b9 100644 --- a/src/builtin/functions/numbers/comparison_of_numbers.rs +++ b/src/builtin/functions/numbers/comparison_of_numbers.rs @@ -1,8 +1,7 @@ use crate::{ - Error, TulispContext, TulispObject, TulispValue, builtin::functions::functions::reduce_with, + Error, TulispContext, TulispObject, builtin::functions::functions::reduce_with, destruct_eval_bind, }; -use std::rc::Rc; macro_rules! compare_ops { ($oper:expr) => {{ @@ -70,26 +69,26 @@ macro_rules! compare_impl { pub(crate) fn add(ctx: &mut TulispContext) { compare_impl!(gt, ">"); - intern_set_func!(ctx, gt, ">"); + ctx.add_special_form(">", gt); compare_impl!(ge, ">="); - intern_set_func!(ctx, ge, ">="); + ctx.add_special_form(">=", ge); compare_impl!(lt, "<"); - intern_set_func!(ctx, lt, "<"); + ctx.add_special_form("<", lt); compare_impl!(le, "<="); - intern_set_func!(ctx, le, "<="); + ctx.add_special_form("<=", le); fn max(ctx: &mut TulispContext, rest: &TulispObject) -> Result { reduce_with(ctx, rest, max_min_ops!(max)) } - intern_set_func!(ctx, max, "max"); + ctx.add_special_form("max", max); fn min(ctx: &mut TulispContext, rest: &TulispObject) -> Result { reduce_with(ctx, rest, max_min_ops!(min)) } - intern_set_func!(ctx, min, "min"); + ctx.add_special_form("min", min); ctx.add_special_form("abs", |ctx, args| { destruct_eval_bind!(ctx, (number) = args); diff --git a/src/builtin/functions/numbers/rounding_operations.rs b/src/builtin/functions/numbers/rounding_operations.rs index f252430..99b5c2c 100644 --- a/src/builtin/functions/numbers/rounding_operations.rs +++ b/src/builtin/functions/numbers/rounding_operations.rs @@ -1,40 +1,29 @@ -use std::rc::Rc; - -use crate::{ - Error, TulispContext, TulispObject, TulispValue, - builtin::functions::common::eval_1_arg_special_form, eval::eval_and_then, -}; +use crate::{Error, TulispContext, destruct_eval_bind}; pub(crate) fn add(ctx: &mut TulispContext) { - fn fround(ctx: &mut TulispContext, args: &TulispObject) -> Result { - eval_1_arg_special_form(ctx, "fround", args, false, |ctx, arg1, _| { - eval_and_then(ctx, arg1, |_, x| { - if x.floatp() { - Ok(f64::round(x.as_float().unwrap()).into()) - } else { - Err(Error::type_mismatch(format!( - "Expected float for fround. Got: {}", - x - ))) - } - }) - }) - } - intern_set_func!(ctx, fround); + ctx.add_special_form("fround", |ctx, args| { + destruct_eval_bind!(ctx, (x) = args); + + if x.floatp() { + Ok(f64::round(x.as_float().unwrap()).into()) + } else { + Err(Error::type_mismatch(format!( + "Expected float for fround. Got: {}", + x, + ))) + } + }); + + ctx.add_special_form("ftruncate", |ctx, args| { + destruct_eval_bind!(ctx, (x) = args); - fn ftruncate(ctx: &mut TulispContext, args: &TulispObject) -> Result { - eval_1_arg_special_form(ctx, "ftruncate", args, false, |ctx, arg1, _| { - eval_and_then(ctx, arg1, |_, x| { - if x.floatp() { - Ok(f64::trunc(x.as_float().unwrap()).into()) - } else { - Err(Error::type_mismatch(format!( - "Expected float for ftruncate. Got: {}", - x - ))) - } - }) - }) - } - intern_set_func!(ctx, ftruncate); + if x.floatp() { + Ok(f64::trunc(x.as_float().unwrap()).into()) + } else { + Err(Error::type_mismatch(format!( + "Expected float for ftruncate. Got: {}", + x, + ))) + } + }); } diff --git a/src/eval.rs b/src/eval.rs index 70426e1..eb4a68d 100644 --- a/src/eval.rs +++ b/src/eval.rs @@ -215,8 +215,8 @@ pub(crate) fn eval(ctx: &mut TulispContext, expr: &TulispObject) -> Result Result { - let mut result = None; - eval_basic(ctx, expr, &mut result)?; + let result = &mut None; + eval_basic(ctx, expr, result)?; if let Some(result) = result { Ok(result.null()) } else { @@ -230,10 +230,10 @@ pub(crate) fn eval_and_then( expr: &TulispObject, func: impl FnOnce(&mut TulispContext, &TulispObject) -> Result, ) -> Result { - let mut result = None; - eval_basic(ctx, expr, &mut result)?; + let result = &mut None; + eval_basic(ctx, expr, result)?; if let Some(result) = result { - func(ctx, &result) + func(ctx, result) } else { func(ctx, expr) } diff --git a/tests/tests.rs b/tests/tests.rs index f2d43e3..8a8c29b 100644 --- a/tests/tests.rs +++ b/tests/tests.rs @@ -778,13 +778,13 @@ fn test_rounding_operations() -> Result<(), Error> { tulisp_assert! { program: "(fround)", - error: r#"ERR MissingArgument: fround: expected 1 argument. + error: r#"ERR TypeMismatch: Too few arguments :1.1-1.8: at (fround) "#, } tulisp_assert! { program: "(fround 3.14 3.14)", - error: r#"ERR MissingArgument: fround: expected only 1 argument. + error: r#"ERR TypeMismatch: Too many arguments :1.1-1.18: at (fround 3.14 3.14) "#, }