Replace internal eval_basic with Copy-on-Write eval_cow method (#75)

Also improve correctness of `sort` lisp function.
shsms · Mar 31, 2024 · b20ad23 · b20ad23
2 parents 92ab753 + 90ec17e
commit b20ad23
Show file tree

Hide file tree

Showing 8 changed files with 96 additions and 146 deletions.
diff --git a/src/builtin/functions/conditionals.rs b/src/builtin/functions/conditionals.rs
@@ -1,6 +1,6 @@
 use crate::{
     builtin::functions::common::eval_2_arg_special_form,
-    eval::{eval_and_then, eval_basic},
+    eval::eval_cow,
     list,
     lists::{last, length},
     Error, ErrorKind, TulispContext, TulispObject, TulispValue,
@@ -11,7 +11,7 @@ use tulisp_proc_macros::{crate_fn, crate_fn_no_eval};
 pub(crate) fn add(ctx: &mut TulispContext) {
     fn impl_if(ctx: &mut TulispContext, args: &TulispObject) -> Result<TulispObject, Error> {
         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()))? {
+            if eval_cow(ctx, cond)?.is_truthy() {
                 ctx.eval(then)
             } else {
                 ctx.eval_progn(else_body)
@@ -39,7 +39,7 @@ pub(crate) fn add(ctx: &mut TulispContext) {
 
     fn cond(ctx: &mut TulispContext, args: &TulispObject) -> Result<TulispObject, Error> {
         for item in args.base_iter() {
-            if item.car_and_then(|x| eval_and_then(ctx, x, |x| Ok(x.is_truthy())))? {
+            if item.car_and_then(|x| Ok(eval_cow(ctx, x)?.is_truthy()))? {
                 return item.cdr_and_then(|x| ctx.eval_progn(x));
             }
         }
@@ -57,34 +57,21 @@ pub(crate) fn add(ctx: &mut TulispContext) {
     fn and(ctx: &mut TulispContext, rest: TulispObject) -> Result<TulispObject, Error> {
         let mut ret = TulispObject::nil();
         for item in rest.base_iter() {
-            let mut result = None;
-            eval_basic(ctx, &item, &mut result)?;
-            if let Some(result) = result {
-                if result.null() {
-                    return Ok(result);
-                }
-                ret = result;
-            } else {
-                if item.null() {
-                    return Ok(item);
-                }
-                ret = item;
+            let result = eval_cow(ctx, &item)?;
+            if result.null() {
+                return Ok(result.into_owned());
             }
+            ret = result.into_owned();
         }
         Ok(ret)
     }
 
     #[crate_fn_no_eval(add_func = "ctx")]
     fn or(ctx: &mut TulispContext, rest: TulispObject) -> Result<TulispObject, Error> {
         for item in rest.base_iter() {
-            let mut result = None;
-            eval_basic(ctx, &item, &mut result)?;
-            if let Some(result) = result {
-                if !result.null() {
-                    return Ok(result);
-                }
-            } else if !item.null() {
-                return Ok(item);
+            let result = eval_cow(ctx, &item)?;
+            if !result.null() {
+                return Ok(result.into_owned());
             }
         }
         Ok(TulispObject::nil())

diff --git a/src/builtin/functions/functions.rs b/src/builtin/functions/functions.rs
@@ -3,9 +3,7 @@ use crate::context::Scope;
 use crate::context::TulispContext;
 use crate::error::Error;
 use crate::error::ErrorKind;
-use crate::eval::eval;
-use crate::eval::eval_and_then;
-use crate::eval::eval_check_null;
+use crate::eval::{eval, eval_cow};
 use crate::eval::DummyEval;
 use crate::eval::Eval;
 use crate::lists;
@@ -231,7 +229,7 @@ pub(crate) fn add(ctx: &mut TulispContext) {
         rest: TulispObject,
     ) -> Result<TulispObject, Error> {
         let mut result = TulispObject::nil();
-        while !eval_check_null(ctx, &condition)? {
+        while !eval_cow(ctx, &condition)?.null() {
             result = ctx.eval_progn(&rest)?;
         }
         Ok(result)
@@ -278,7 +276,7 @@ pub(crate) fn add(ctx: &mut TulispContext) {
                 args.car_and_then(|arg| ctx.eval(arg))
             })
         })?;
-        args.car_and_then(|name_sym| ctx.eval_and_then(name_sym, |name| name.set(value.clone())))?;
+        args.car_and_then(|name_sym| eval_cow(ctx, name_sym)?.set(value.clone()))?;
         Ok(value)
     }
     intern_set_func!(ctx, set);
@@ -671,7 +669,7 @@ pub(crate) fn add(ctx: &mut TulispContext) {
                     }
                     Ok(true) => {}
                 }
-                args.car_and_then(|arg| eval_and_then(ctx, &arg, |x| Ok(x.$name().into())))
+                args.car_and_then(|arg| Ok(eval_cow(ctx, &arg)?.$name().into()))
             }
             intern_set_func!(ctx, $name);
         };

diff --git a/src/builtin/functions/numbers/rounding_operations.rs b/src/builtin/functions/numbers/rounding_operations.rs
@@ -1,39 +1,37 @@
 use std::rc::Rc;
 
 use crate::{
-    builtin::functions::common::eval_1_arg_special_form, eval::eval_and_then, Error, ErrorKind,
+    builtin::functions::common::eval_1_arg_special_form, eval::eval_cow, Error, ErrorKind,
     TulispContext, TulispObject, TulispValue,
 };
 
 pub(crate) fn add(ctx: &mut TulispContext) {
     fn fround(ctx: &mut TulispContext, args: &TulispObject) -> Result<TulispObject, Error> {
         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::new(
-                        ErrorKind::TypeMismatch,
-                        format!("Expected float for fround. Got: {}", x),
-                    ))
-                }
-            })
+            let val = eval_cow(ctx, arg1)?;
+            if val.floatp() {
+                Ok(f64::round(val.as_float().unwrap()).into())
+            } else {
+                Err(Error::new(
+                    ErrorKind::TypeMismatch,
+                    format!("Expected float for fround. Got: {}", val),
+                ))
+            }
         })
     }
     intern_set_func!(ctx, fround);
 
     fn ftruncate(ctx: &mut TulispContext, args: &TulispObject) -> Result<TulispObject, Error> {
         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::new(
-                        ErrorKind::TypeMismatch,
-                        format!("Expected float for ftruncate. Got: {}", x),
-                    ))
-                }
-            })
+            let val = eval_cow(ctx, arg1)?;
+            if val.floatp() {
+                Ok(f64::trunc(val.as_float().unwrap()).into())
+            } else {
+                Err(Error::new(
+                    ErrorKind::TypeMismatch,
+                    format!("Expected float for ftruncate. Got: {}", val),
+                ))
+            }
         })
     }
     intern_set_func!(ctx, ftruncate);

diff --git a/src/builtin/functions/sequences.rs b/src/builtin/functions/sequences.rs
@@ -67,19 +67,26 @@ pub(crate) fn add(ctx: &mut TulispContext) {
     ) -> Result<TulispObject, Error> {
         let pred = eval(ctx, &pred)?;
         let mut vec: Vec<_> = seq.base_iter().collect();
+        let mut err = None;
         vec.sort_by(|v1, v2| {
             if funcall::<DummyEval>(ctx, &pred, &list!(v1.clone(), v2.clone()).unwrap())
                 .map(|v| v.null())
-                .unwrap_or(false)
+                .unwrap_or_else(|x| {
+                    err = Some(x);
+                    false
+                })
             {
-                Ordering::Equal
-            } else {
                 Ordering::Less
+            } else {
+                Ordering::Greater
             }
         });
+        if let Some(err) = err {
+            return Err(err);
+        }
         let ret = vec
             .iter()
-            .fold(list!(), |v1, v2| list!(,@v1 ,(*v2).clone()).unwrap());
+            .fold(TulispObject::nil(), |v1, v2| TulispObject::cons(v2.clone(), v1));
         Ok(ret)
     }
 }
diff --git a/src/cons.rs b/src/cons.rs
@@ -2,7 +2,7 @@ use std::marker::PhantomData;
 
 use crate::error::Error;
 use crate::error::ErrorKind;
-use crate::eval::eval_basic;
+use crate::eval::eval_cow;
 use crate::object::Span;
 use crate::TulispContext;
 use crate::TulispObject;
@@ -143,20 +143,12 @@ impl BaseIter {
     ) -> Option<Result<TulispObject, Error>> {
         if let Some(ref next) = self.next {
             let Cons { car, cdr } = next;
-            let new_car = {
-                let mut result = None;
-                if let Err(e) = eval_basic(ctx, car, &mut result) {
-                    return Some(Err(e));
-                };
-                if let Some(result) = result {
-                    Ok(result)
-                } else {
-                    Ok(next.car.clone())
-                }
+            let new_car = match eval_cow(ctx, car) {
+                Ok(vv) => vv.into_owned(),
+                Err(e) => return Some(Err(e)),
             };
-
             self.next = cdr.as_list_cons();
-            Some(new_car)
+            Some(Ok(new_car))
         } else {
             None
         }

diff --git a/src/context.rs b/src/context.rs
@@ -3,7 +3,7 @@ use std::{collections::HashMap, fs, rc::Rc};
 use crate::{
     builtin,
     error::Error,
-    eval::{eval, eval_and_then, eval_basic, funcall, DummyEval},
+    eval::{eval, eval_cow, funcall, DummyEval},
     list,
     parse::parse,
     TulispObject, TulispValue,
@@ -107,16 +107,6 @@ impl TulispContext {
         eval(self, value)
     }
 
-    /// Evaluates the given value, run the given function on the result of the
-    /// evaluation, and returns the result of the function.
-    pub fn eval_and_then<T>(
-        &mut self,
-        expr: &TulispObject,
-        f: impl FnOnce(&TulispObject) -> Result<T, Error>,
-    ) -> Result<T, Error> {
-        eval_and_then(self, expr, f)
-    }
-
     /// Calls the given function with the given arguments, and returns the
     /// result.
     pub fn funcall(
@@ -181,10 +171,8 @@ impl TulispContext {
     /// last one.
     pub fn eval_progn(&mut self, seq: &TulispObject) -> Result<TulispObject, Error> {
         let mut ret = None;
-        let mut result = None;
         for val in seq.base_iter() {
-            eval_basic(self, &val, &mut result)?;
-            ret = Some(result.take().unwrap_or(val))
+            ret = Some(eval_cow(self, &val)?.into_owned())
         }
         Ok(ret.unwrap_or_else(TulispObject::nil))
     }