Reorganize builtins

schemius/src/core/builtins/base.rs

@@ -0,0 +1,73 @@
+use super::{
+    eval,
+    s_procedure::{ProcedureArgs, ProcedureEnv, ProcedureOutput},
+    Accessor, SExpr, SchemeEnvironment, SchemeList,
+};
+
+pub fn r_apply(args: ProcedureArgs, env: ProcedureEnv) -> ProcedureOutput {
+    if args.len() != 2 {
+        return Err(format!("Exception in apply: expected 2 arguments, found {}", args.len()));
+    }
+
+    let symbol = &args[0];
+    let arg_list = &args[1];
+
+    match eval(arg_list, env.clone()) {
+        Ok(list) => match list {
+            SExpr::List(args) => {
+                let iterator = [symbol.clone()];
+                let mut args = args.borrow().clone();
+                args.splice(0..0, iterator);
+
+                Ok(SExpr::List(SchemeList::new(args.clone())))
+            }
+            _ => Err(String::from("Exception in apply: must provide a quoted list of arguments")),
+        },
+        Err(e) => Err(e),
+    }
+}
+
+pub fn r_eval(args: ProcedureArgs, env: ProcedureEnv) -> ProcedureOutput {
+    if args.len() != 1 {
+        return Err(format!("Exception in eval: expected 1 argument, found {}", args.len()));
+    }
+
+    eval(&args[0], env.clone())
+}
+
+pub fn r_display(args: ProcedureArgs, env: ProcedureEnv) -> ProcedureOutput {
+    if args.len() != 1 {
+        return Err(format!("Exception in display: expected 1 argument, found {}", args.len()));
+    }
+
+    match eval(&args[0], env.clone()) {
+        Ok(val) => match val {
+            SExpr::String(string) => Ok(SExpr::Symbol(string.borrow().to_string())), // Avoids double quotes
+            expr => Ok(SExpr::Symbol(format!("{}", expr))),
+        },
+        Err(e) => Err(e),
+    }
+}
+
+pub fn r_exit(_: ProcedureArgs, _: ProcedureEnv) -> ProcedureOutput {
+    std::process::exit(0)
+}
+
+pub fn r_environment_bindings(args: ProcedureArgs, env: ProcedureEnv) -> ProcedureOutput {
+    if !args.is_empty() {
+        return Err(format!(
+            "Exception in environment-bindings: expected 0 arguments, found {}",
+            args.len()
+        ));
+    }
+
+    let env_guard = env.borrow();
+    let mut bindings = env_guard.get_bindings().clone();
+    bindings.sort_by(|a, b| a.0.cmp(b.0));
+
+    let mut output: String = "".to_owned();
+    bindings.iter().for_each(|b| output.push_str(format!("({}, {})\n", b.0, b.1).as_str()));
+    output.remove(output.len() - 1);
+
+    Ok(SExpr::Symbol(output))
+}

schemius/src/core/builtins/booleans.rs

@@ -0,0 +1,34 @@
+use super::{
+    s_procedure::{ProcedureArgs, ProcedureEnv, ProcedureOutput},
+    SExpr,
+};
+
+macro_rules! fn_is {
+    ($($fn:ident, $source_fn:ident, $name:literal)*) => {
+        $(
+            pub fn $fn(args: ProcedureArgs, _: ProcedureEnv) -> ProcedureOutput {
+                if args.len() != 1 {
+                    return Err(format!("Exception in {}: expected 1 argument, found {}", $name, args.len()));
+                }
+
+                match args[0].$source_fn() {
+                    Ok(res) => Ok(SExpr::Boolean(res)),
+                    Err(e) => Err(e)
+                }
+            }
+        )*}
+}
+
+fn_is! {
+    r_is_char, is_char, "char?"
+    r_is_string, is_string, "string?"
+    r_is_boolean, is_boolean, "boolean?"
+    r_is_number, is_number, "number?"
+    r_is_exact, is_exact, "exact?"
+    r_is_list, is_list, "list?"
+    r_is_pair, is_pair, "pair?"
+    r_is_vector, is_vector, "vector?"
+    r_is_procedure, is_procedure, "procedure?"
+    r_is_symbol, is_symbol, "symbol?"
+    r_is_null, is_null, "null?"
+}

schemius/src/core/builtins/lists.rs

@@ -0,0 +1,127 @@
+use super::{
+    eval,
+    s_procedure::{ProcedureArgs, ProcedureEnv, ProcedureOutput},
+    Accessor, SExpr, SchemeList, SchemePair,
+};
+
+pub fn r_set_car(args: ProcedureArgs, env: ProcedureEnv) -> ProcedureOutput {
+    if args.len() != 2 {
+        return Err(format!("Exception in set-car!: expected 2 arguments, found {}", args.len()));
+    }
+
+    match &args[0] {
+        SExpr::Symbol(_) => match eval(&args[0], env.clone()) {
+            Ok(res) => match res {
+                SExpr::List(list) => {
+                    list.borrow_mut()[0] = args[1].clone();
+
+                    Ok(SExpr::List(list.clone()))
+                }
+                SExpr::Pair(pair) => {
+                    let old_cdr = pair.borrow().1.clone();
+                    pair.replace((Box::new(args[1].clone()), old_cdr));
+
+                    Ok(SExpr::Pair(pair.clone()))
+                }
+                other => {
+                    Err(format!("Exception in set-car: {} is neither a list nor a pair", other))
+                }
+            },
+            Err(e) => Err(e),
+        },
+        _ => {
+            Err(String::from("Exception in set-car!: must provide a symbol as the first argument"))
+        }
+    }
+}
+
+pub fn r_cons(args: ProcedureArgs, env: ProcedureEnv) -> ProcedureOutput {
+    if args.len() != 2 {
+        return Err(format!("Exception in cons: expected 2 arguments, found {}", args.len()));
+    }
+
+    let car = eval(&args[0], env.clone());
+    if let Err(e) = car {
+        return Err(e);
+    }
+
+    match eval(&args[1], env.clone()) {
+        Ok(expr) => match expr {
+            SExpr::List(list) => {
+                let mut new_list = vec![];
+                new_list.push(car.unwrap());
+                list.borrow().iter().for_each(|x| new_list.push(x.clone()));
+
+                Ok(SExpr::List(SchemeList::new(new_list)))
+            }
+            cdr => {
+                let pair = SchemePair::new((Box::new(car.unwrap()), Box::new(cdr)));
+
+                Ok(SExpr::Pair(pair))
+            }
+        },
+        Err(e) => Err(e),
+    }
+}
+
+pub fn r_list(args: ProcedureArgs, _: ProcedureEnv) -> ProcedureOutput {
+    let mut list: Vec<SExpr> = vec![];
+
+    for arg in args {
+        list.push(arg.clone());
+    }
+
+    Ok(SExpr::List(SchemeList::new(list)))
+}
+
+pub fn r_flatten(args: ProcedureArgs, _: ProcedureEnv) -> ProcedureOutput {
+    if args.len() != 1 {
+        return Err(format!("Exception in flatten: expected 1 argument, found {}", args.len()));
+    }
+
+    args[0].flatten()
+}
+
+pub fn r_unflatten(args: ProcedureArgs, _: ProcedureEnv) -> ProcedureOutput {
+    if args.len() != 1 {
+        return Err(format!("Exception in unflatten: expected 1 argument, found {}", args.len()));
+    }
+
+    args[0].unflatten()
+}
+
+pub fn r_car(args: ProcedureArgs, env: ProcedureEnv) -> ProcedureOutput {
+    if args.len() != 1 {
+        return Err(format!("Exception in car: expected 1 argument, found {}", args.len()));
+    }
+
+    match eval(&args[0], env.clone())? {
+        SExpr::List(vec) => {
+            if vec.borrow().len() > 0 {
+                Ok(vec.borrow()[0].clone())
+            } else {
+                Err(String::from("Exception: #<procedure car> cannot take a quoted empty list"))
+            }
+        }
+        _ => Err(String::from("Exception: #<procedure car> cannot be applied to quoted symbol")),
+    }
+}
+
+pub fn r_cdr(args: ProcedureArgs, env: ProcedureEnv) -> ProcedureOutput {
+    if args.len() != 1 {
+        return Err(String::from("Exception: #<special-form cdr> can take one only argument"));
+    }
+
+    match eval(&args[0], env.clone())? {
+        SExpr::List(vec) => match vec.borrow().len() {
+            1.. => {
+                let mut cdr = vec.borrow().clone();
+                cdr.remove(0);
+
+                Ok(SExpr::List(SchemeList::new(cdr)))
+            }
+            _ => Err(String::from("Exception: #<procedure cdr> cannot take a quoted empty list")),
+        },
+        _ => Err(String::from("Exception: #<procedure cdr> cannot be applied to quoted symbol")),
+    }
+}

schemius/src/core/builtins/mod.rs

@@ -0,0 +1,76 @@
+use super::{accessor::*, environment::*, evaluator::*, s_expression::*};
+
+mod base;
+mod booleans;
+mod lists;
+mod numbers;
+mod special_forms;
+mod strings;
+
+use base::*;
+use booleans::*;
+use lists::*;
+use numbers::*;
+use special_forms::*;
+use strings::*;
+
+pub struct Primitive;
+pub struct SpecialForm;
+
+impl Primitive {
+    pub const EXIT: ProcedureSignature = r_exit;
+    pub const SUM: ProcedureSignature = r_sum;
+    pub const DIFF: ProcedureSignature = r_diff;
+    pub const PROD: ProcedureSignature = r_prod;
+    pub const QUOT: ProcedureSignature = r_quot;
+    pub const EQUAL: ProcedureSignature = r_equal;
+    pub const GT: ProcedureSignature = r_gt;
+    pub const GE: ProcedureSignature = r_ge;
+    pub const LT: ProcedureSignature = r_lt;
+    pub const LE: ProcedureSignature = r_le;
+    pub const EVAL: ProcedureSignature = r_eval;
+    pub const APPLY: ProcedureSignature = r_apply;
+    pub const CAR: ProcedureSignature = r_car;
+    pub const CDR: ProcedureSignature = r_cdr;
+    pub const CONS: ProcedureSignature = r_cons;
+    pub const LIST: ProcedureSignature = r_list;
+    pub const SET_CAR: ProcedureSignature = r_set_car;
+    pub const DISPLAY: ProcedureSignature = r_display;
+    pub const IS_CHAR: ProcedureSignature = r_is_char;
+    pub const IS_STRING: ProcedureSignature = r_is_string;
+    pub const IS_BOOLEAN: ProcedureSignature = r_is_boolean;
+    pub const IS_NUMBER: ProcedureSignature = r_is_number;
+    pub const IS_EXACT: ProcedureSignature = r_is_exact;
+    pub const IS_PAIR: ProcedureSignature = r_is_pair;
+    pub const IS_SYMBOL: ProcedureSignature = r_is_symbol;
+    pub const IS_LIST: ProcedureSignature = r_is_list;
+    pub const IS_VECTOR: ProcedureSignature = r_is_vector;
+    pub const IS_PROCEDURE: ProcedureSignature = r_is_procedure;
+    pub const IS_NULL: ProcedureSignature = r_is_null;
+    pub const ENVIRONMENT_BINDINGS: ProcedureSignature = r_environment_bindings;
+    pub const MAKE_STRING: ProcedureSignature = r_make_string;
+    pub const STRING: ProcedureSignature = r_string;
+    pub const STRING_APPEND: ProcedureSignature = r_string_append;
+    pub const STRING_DOWNCASE: ProcedureSignature = r_string_downcase;
+    pub const STRING_LENGTH: ProcedureSignature = r_string_length;
+    pub const STRING_REF: ProcedureSignature = r_string_ref;
+    pub const STRING_SET: ProcedureSignature = r_string_set;
+    pub const STRING_UPCASE: ProcedureSignature = r_string_upcase;
+    pub const FLATTEN: ProcedureSignature = r_flatten;
+    pub const UNFLATTEN: ProcedureSignature = r_unflatten;
+}
+
+impl SpecialForm {
+    pub const BEGIN: SpecialFormSignature = r_begin;
+    pub const COND: SpecialFormSignature = r_cond;
+    pub const DEFINE: SpecialFormSignature = r_define;
+    pub const IF: SpecialFormSignature = r_if;
+    pub const LAMBDA: SpecialFormSignature = r_lambda;
+    pub const LET: SpecialFormSignature = r_let;
+    pub const LET_STAR: SpecialFormSignature = r_let_star;
+    pub const NOT: SpecialFormSignature = r_not;
+    pub const QUOTE: SpecialFormSignature = r_quote;
+    pub const QUASIQUOTE: SpecialFormSignature = r_quasiquote;
+    pub const SET: SpecialFormSignature = r_set;
+    pub const TIME: SpecialFormSignature = r_time;
+}