diff --git a/examples/fib-tail.lisp b/examples/fib-tail.lisp index 973f2fb5..33ec7196 100644 --- a/examples/fib-tail.lisp +++ b/examples/fib-tail.lisp @@ -6,4 +6,4 @@ "Tail recursive Fib" (fib-impl n 0 1)) -(princ (fib 30)) +(print (fib 30)) diff --git a/examples/fib.lisp b/examples/fib.lisp index 8d0b4485..3f9a02c2 100644 --- a/examples/fib.lisp +++ b/examples/fib.lisp @@ -4,5 +4,6 @@ (+ (fib (- n 1)) (fib (- n 2))))) -(let ((tgt 30)) - (print (format "\n (fib %d)\n %d\n" tgt (fib tgt)))) +(let* ((tgt 30) + (res (fib tgt))) + (print (format "\n (fib %d)\n %d\n" tgt res))) diff --git a/examples/tail-recursion.lisp b/examples/tail-recursion.lisp index 567f052f..0898c981 100644 --- a/examples/tail-recursion.lisp +++ b/examples/tail-recursion.lisp @@ -2,4 +2,5 @@ (if (equal counter 0) lis (build (- counter 1) (cons counter lis)))) -(princ (build 1000000 '())) +(print (build 1000000 '())) + diff --git a/src/bin/tulisp_vm.rs b/src/bin/tulisp_vm.rs new file mode 100644 index 00000000..33be7d24 --- /dev/null +++ b/src/bin/tulisp_vm.rs @@ -0,0 +1,15 @@ +use std::env; + +use tulisp::TulispContext; + +fn main() { + let mut ctx = TulispContext::new(); + let args: Vec = env::args().skip(1).collect(); + + for arg in args { + if let Err(e) = ctx.vm_eval_file(&arg) { + println!("{}", e.format(&ctx)); + std::process::exit(-1); + } + } +} diff --git a/src/builtin/functions/functions.rs b/src/builtin/functions/functions.rs index 25dd97fe..04ec38ab 100644 --- a/src/builtin/functions/functions.rs +++ b/src/builtin/functions/functions.rs @@ -3,6 +3,7 @@ use crate::TulispValue; use crate::cons::Cons; use crate::context::Scope; use crate::context::TulispContext; +use crate::destruct_bind; use crate::destruct_eval_bind; use crate::error::Error; use crate::error::ErrorKind; @@ -12,8 +13,8 @@ use crate::eval::eval; use crate::eval::eval_and_then; use crate::eval::eval_check_null; use crate::lists; +use crate::parse::mark_tail_calls; use crate::value::DefunParams; -use crate::{destruct_bind, list}; use std::convert::TryInto; use std::rc::Rc; @@ -33,63 +34,6 @@ pub(super) fn reduce_with( Ok(first) } -fn mark_tail_calls( - ctx: &mut TulispContext, - name: TulispObject, - body: TulispObject, -) -> Result { - if !body.consp() { - return Ok(body); - } - let ret = TulispObject::nil(); - let mut body_iter = body.base_iter(); - let mut tail = body_iter.next().unwrap(); - for next in body_iter { - ret.push(tail)?; - tail = next; - } - if !tail.consp() { - return Ok(body); - } - let span = tail.span(); - let ctxobj = tail.ctxobj(); - let tail_ident = tail.car()?; - let tail_name_str = tail_ident.as_symbol()?; - let new_tail = if tail_ident.eq(&name) { - let ret_tail = TulispObject::nil().append(tail.cdr()?)?.to_owned(); - list!(,ctx.intern("list") - ,TulispValue::Bounce.into_ref(None) - ,@ret_tail)? - } else if tail_name_str == "progn" || tail_name_str == "let" || tail_name_str == "let*" { - list!(,tail_ident ,@mark_tail_calls(ctx, name, tail.cdr()?)?)? - } else if tail_name_str == "if" { - destruct_bind!((_if condition then_body &rest else_body) = tail); - list!(,tail_ident - ,condition.clone() - ,mark_tail_calls( - ctx, - name.clone(), - list!(,then_body)? - )?.car()? - ,@mark_tail_calls(ctx, name, else_body)? - )? - } else if tail_name_str == "cond" { - destruct_bind!((_cond &rest conds) = tail); - let mut ret = list!(,tail_ident)?; - for cond in conds.base_iter() { - destruct_bind!((condition &rest body) = cond); - ret = list!(,@ret - ,list!(,condition.clone() - ,@mark_tail_calls(ctx, name.clone(), body)?)?)?; - } - ret - } else { - tail - }; - ret.push(new_tail.with_ctxobj(ctxobj).with_span(span))?; - Ok(ret) -} - pub(crate) fn add(ctx: &mut TulispContext) { ctx.add_special_form("load", |ctx, args| { destruct_eval_bind!(ctx, (filename) = args); @@ -309,7 +253,8 @@ pub(crate) fn add(ctx: &mut TulispContext) { "varitems inside a let-varlist should be a var or a binding: {}", varitem ), - )); + ) + .with_trace(varitem.clone())); }; } diff --git a/src/bytecode/bytecode.rs b/src/bytecode/bytecode.rs new file mode 100644 index 00000000..a7db3f5c --- /dev/null +++ b/src/bytecode/bytecode.rs @@ -0,0 +1,42 @@ +use std::{cell::RefCell, collections::HashMap, fmt, rc::Rc}; + +use super::Instruction; +use crate::{bytecode::compiler::VMDefunParams, TulispObject}; + +#[derive(Default, Clone)] +pub(crate) struct CompiledDefun { + pub(crate) name: TulispObject, + pub(crate) instructions: Rc>>, + pub(crate) params: VMDefunParams, +} + +#[derive(Default, Clone)] +pub(crate) struct Bytecode { + pub(crate) global: Rc>>, + pub(crate) functions: HashMap, // key: fn_name.addr_as_usize() +} + +impl fmt::Display for Bytecode { + fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { + for (i, instr) in self.global.borrow().iter().enumerate() { + write!(f, "\n{:<40} # {}", instr.to_string(), i)?; + } + for (name, func) in &self.functions { + write!(f, "\n\n{}:", name)?; + for (i, instr) in func.instructions.borrow().iter().enumerate() { + write!(f, "\n{:<40} # {}", instr.to_string(), i)?; + } + } + Ok(()) + } +} + +impl Bytecode { + pub(crate) fn new() -> Self { + Self::default() + } + + pub(crate) fn import_functions(&mut self, other: &Bytecode) { + self.functions.extend(other.functions.clone()); + } +} diff --git a/src/bytecode/compiler/compiler.rs b/src/bytecode/compiler/compiler.rs new file mode 100644 index 00000000..e855bbba --- /dev/null +++ b/src/bytecode/compiler/compiler.rs @@ -0,0 +1,292 @@ +use std::{cell::RefCell, collections::HashMap, rc::Rc}; + +use crate::{ + bytecode::{Bytecode, Instruction}, + Error, ErrorKind, TulispContext, TulispObject, TulispValue, +}; + +use super::forms::{compile_form, VMCompilers}; + +#[derive(Default, Clone)] +pub(crate) struct VMDefunParams { + pub required: Vec, + pub optional: Vec, + pub rest: Option, +} + +#[allow(dead_code)] +pub(crate) struct Compiler { + pub vm_compilers: VMCompilers, + pub defun_args: HashMap, // fn_name.addr_as_usize() -> arg symbol idx + pub bytecode: Bytecode, + pub keep_result: bool, + label_counter: usize, +} + +impl Compiler { + pub fn new(vm_compilers: VMCompilers) -> Self { + Compiler { + vm_compilers, + defun_args: HashMap::new(), + bytecode: Bytecode::new(), + keep_result: true, + label_counter: 0, + } + } + + pub fn new_label(&mut self) -> TulispObject { + self.label_counter += 1; + TulispObject::symbol(format!(":{}", self.label_counter), true) + } +} + +pub fn compile(ctx: &mut TulispContext, value: &TulispObject) -> Result { + let output = compile_progn(ctx, value)?; + let compiler = ctx.compiler.as_mut().unwrap(); + compiler.bytecode.global = Rc::new(RefCell::new(output)); + Ok(compiler.bytecode.clone()) +} + +pub fn compile_progn( + ctx: &mut TulispContext, + value: &TulispObject, +) -> Result, Error> { + let mut result = vec![]; + let mut prev = None; + let compiler = ctx.compiler.as_mut().unwrap(); + let keep_result = compiler.keep_result; + compiler.keep_result = false; + #[allow(dropping_references)] + drop(compiler); + for expr in value.base_iter() { + if let Some(prev) = prev { + result.append(&mut compile_expr(ctx, &prev)?); + } + prev = Some(expr); + } + let compiler = ctx.compiler.as_mut().unwrap(); + compiler.keep_result = keep_result; + #[allow(dropping_references)] + drop(compiler); + if let Some(prev) = prev { + result.append(&mut compile_expr(ctx, &prev)?); + } + Ok(result) +} + +pub(crate) fn compile_expr_keep_result( + ctx: &mut TulispContext, + expr: &TulispObject, +) -> Result, Error> { + let compiler = ctx.compiler.as_mut().unwrap(); + let keep_result = compiler.keep_result; + compiler.keep_result = true; + #[allow(dropping_references)] + drop(compiler); + let ret = compile_expr(ctx, expr); + ctx.compiler.as_mut().unwrap().keep_result = keep_result; + ret +} + +pub(crate) fn compile_progn_keep_result( + ctx: &mut TulispContext, + expr: &TulispObject, +) -> Result, Error> { + let compiler = ctx.compiler.as_mut().unwrap(); + let keep_result = compiler.keep_result; + compiler.keep_result = true; + #[allow(dropping_references)] + drop(compiler); + let ret = compile_progn(ctx, expr); + ctx.compiler.as_mut().unwrap().keep_result = keep_result; + ret +} + +fn compile_back_quote( + ctx: &mut TulispContext, + value: &TulispObject, +) -> Result, Error> { + let compiler = ctx.compiler.as_mut().unwrap(); + if !compiler.keep_result { + return Ok(vec![]); + } + match &*value.inner_ref() { + TulispValue::Quote { value } => { + return compile_back_quote(ctx, value).map(|mut v| { + v.push(Instruction::Quote); + v + }) + } + TulispValue::Unquote { value } => { + return compile_expr(ctx, value).map_err(|e| e.with_trace(value.clone())); + } + TulispValue::Splice { .. } => { + return Err(Error::new( + crate::ErrorKind::SyntaxError, + "Splice must be within a backquoted list.".to_string(), + )); + } + TulispValue::List { .. } => {} + _ => return Ok(vec![Instruction::Push(value.clone().into())]), + } + let mut result = vec![]; + + let mut value = value.clone(); + let mut items = 0; + let mut need_list = true; + let mut need_append = false; + loop { + value.car_and_then(|first| { + let first_inner = &*first.inner_ref(); + if let TulispValue::Unquote { value } = first_inner { + items += 1; + result.append( + &mut compile_expr(ctx, &value).map_err(|e| e.with_trace(first.clone()))?, + ); + } else if let TulispValue::Splice { value } = first_inner { + let mut splice_result = compile_expr(ctx, &value)?; + let list_inst = splice_result.pop().unwrap(); + if let Instruction::List(n) = list_inst { + result.append(&mut splice_result); + items += n; + } else if let Instruction::Load(idx) = list_inst { + result.append(&mut splice_result); + result.push(Instruction::List(items)); + if need_append { + result.push(Instruction::Append(2)); + } + result.append(&mut vec![Instruction::Load(idx), Instruction::Append(2)]); + need_append = true; + items = 0; + } else { + if !value.consp() { + return Err(Error::new( + ErrorKind::SyntaxError, + format!( + "Can only splice an inplace-list or a variable binding: {}", + value + ), + ) + .with_trace(first.clone())); + } + result.push(Instruction::List(items)); + if need_append { + result.push(Instruction::Append(2)); + } + result.append(&mut splice_result); + result.push(list_inst); + result.push(Instruction::Append(2)); + need_append = true; + items = 0; + } + } else { + items += 1; + result.append(&mut compile_back_quote(ctx, first)?); + } + Ok(()) + })?; + let rest = value.cdr()?; + if let TulispValue::Unquote { value } = &*rest.inner_ref() { + result.append(&mut compile_expr(ctx, &value)?); + result.push(Instruction::Cons); + need_list = false; + break; + } + if !rest.consp() { + if !rest.null() { + result.push(Instruction::Push(rest.clone().into())); + result.push(Instruction::Cons); + need_list = false; + } + break; + } + value = rest; + } + if need_list { + result.push(Instruction::List(items)); + } + if need_append { + result.push(Instruction::Append(2)); + } + Ok(result) +} + +pub(crate) fn compile_expr( + ctx: &mut TulispContext, + expr: &TulispObject, +) -> Result, Error> { + let expr_ref = expr.inner_ref(); + let compiler = ctx.compiler.as_mut().unwrap(); + match &*expr_ref { + TulispValue::Int { value } => { + if compiler.keep_result { + return Ok(vec![Instruction::Push(value.clone().into())]); + } else { + return Ok(vec![]); + } + } + TulispValue::Float { value } => { + if compiler.keep_result { + return Ok(vec![Instruction::Push(value.clone().into())]); + } else { + return Ok(vec![]); + } + } + TulispValue::Nil => { + if compiler.keep_result { + return Ok(vec![Instruction::Push(false.into())]); + } else { + return Ok(vec![]); + } + } + TulispValue::T => { + if compiler.keep_result { + return Ok(vec![Instruction::Push(true.into())]); + } else { + return Ok(vec![]); + } + } + TulispValue::String { .. } | TulispValue::Any(_) => { + if compiler.keep_result { + return Ok(vec![Instruction::Push(expr.clone().into())]); + } else { + return Ok(vec![]); + } + } + TulispValue::Lambda { .. } + | TulispValue::Func(_) + | TulispValue::CompiledDefun { .. } + | TulispValue::Macro(_) + | TulispValue::Defmacro { .. } + | TulispValue::Bounce { .. } => return Ok(vec![]), + + TulispValue::Backquote { value } => compile_back_quote(ctx, value), + TulispValue::Quote { value } | TulispValue::Sharpquote { value } => { + if compiler.keep_result { + return Ok(vec![Instruction::Push(value.clone().into())]); + } else { + return Ok(vec![]); + } + } + TulispValue::List { .. } => { + drop(expr_ref); + compile_form(ctx, expr).map_err(|e| e.with_trace(expr.clone())) + } + TulispValue::Symbol { .. } | TulispValue::LexicalBinding { .. } => { + if !compiler.keep_result { + return Ok(vec![]); + } + return Ok(vec![if expr.keywordp() { + Instruction::Push(expr.clone()) + } else { + Instruction::Load(expr.clone()) + }]); + } + TulispValue::Unquote { .. } | TulispValue::Splice { .. } => { + return Err(Error::new( + crate::ErrorKind::TypeMismatch, // TODO: ErrorKind::SyntaxError + "Unquote without backquote".to_string(), + )); + } + } +} diff --git a/src/bytecode/compiler/forms/arithmetic_operations.rs b/src/bytecode/compiler/forms/arithmetic_operations.rs new file mode 100644 index 00000000..04ade702 --- /dev/null +++ b/src/bytecode/compiler/forms/arithmetic_operations.rs @@ -0,0 +1,117 @@ +use crate::{ + bytecode::{compiler::compiler::compile_expr, instruction::BinaryOp, Instruction}, + Error, ErrorKind, TulispContext, TulispObject, +}; + +pub(super) fn compile_fn_plus( + ctx: &mut TulispContext, + _name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + let mut result = vec![]; + let args = args.base_iter().collect::>(); + if args.is_empty() { + return Err(Error::new( + ErrorKind::ArityMismatch, + "+ requires at least 1 argument.".to_string(), + )); + } + for arg in args.iter().rev() { + result.append(&mut compile_expr(ctx, arg)?); + } + let compiler = ctx.compiler.as_mut().unwrap(); + if compiler.keep_result { + for _ in 0..args.len() - 1 { + result.push(Instruction::BinaryOp(BinaryOp::Add)); + } + } + Ok(result) +} + +pub(super) fn compile_fn_minus( + ctx: &mut TulispContext, + _name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + let mut result = vec![]; + let args = args.base_iter().collect::>(); + if args.is_empty() { + return Err(Error::new( + ErrorKind::ArityMismatch, + "- requires at least 1 argument.".to_string(), + )); + } + for arg in args.iter().rev() { + result.append(&mut compile_expr(ctx, arg)?); + } + let compiler = ctx.compiler.as_mut().unwrap(); + if args.len() == 1 { + if compiler.keep_result { + result.push(Instruction::Push((-1).into())); + result.push(Instruction::BinaryOp(BinaryOp::Mul)); + } + return Ok(result); + } + if compiler.keep_result { + for _ in 0..args.len() - 1 { + result.push(Instruction::BinaryOp(BinaryOp::Sub)); + } + } + Ok(result) +} + +pub(super) fn compile_fn_mul( + ctx: &mut TulispContext, + _name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + let mut result = vec![]; + let args = args.base_iter().collect::>(); + if args.is_empty() { + return Err(Error::new( + ErrorKind::ArityMismatch, + "* requires at least 1 argument.".to_string(), + )); + } + for arg in args.iter().rev() { + result.append(&mut compile_expr(ctx, arg)?); + } + let compiler = ctx.compiler.as_mut().unwrap(); + if compiler.keep_result { + for _ in 0..args.len() - 1 { + result.push(Instruction::BinaryOp(BinaryOp::Mul)); + } + } + Ok(result) +} + +pub(super) fn compile_fn_div( + ctx: &mut TulispContext, + _name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + let compiler = ctx.compiler.as_mut().unwrap(); + if !compiler.keep_result { + return Ok(vec![]); + } + let mut result = vec![]; + let args = args.base_iter().collect::>(); + if args.is_empty() { + return Err(Error::new( + ErrorKind::ArityMismatch, + "/ requires at least 1 argument.".to_string(), + )); + } + for arg in args.iter().rev() { + result.append(&mut compile_expr(ctx, arg)?); + } + if args.len() == 1 { + result.push(Instruction::Push(1.into())); + result.push(Instruction::BinaryOp(BinaryOp::Div)); + return Ok(result); + } + for _ in 0..args.len() - 1 { + result.push(Instruction::BinaryOp(BinaryOp::Div)); + } + Ok(result) +} diff --git a/src/bytecode/compiler/forms/common.rs b/src/bytecode/compiler/forms/common.rs new file mode 100644 index 00000000..43db834b --- /dev/null +++ b/src/bytecode/compiler/forms/common.rs @@ -0,0 +1,83 @@ +use crate::{bytecode::Instruction, Error, ErrorKind, TulispContext, TulispObject, TulispValue}; + +impl TulispContext { + pub(crate) fn compile_1_arg_call( + &mut self, + name: &TulispObject, + args: &TulispObject, + has_rest: bool, + mut lambda: impl FnMut( + &mut TulispContext, + &TulispObject, + &TulispObject, + ) -> Result, Error>, + ) -> Result, Error> { + if args.null() { + return Err(Error::new( + ErrorKind::TypeMismatch, // TODO: change to ArityMismatch + if has_rest { + format!("{} requires at least 1 argument", name) + } else { + format!("{} requires exactly 1 argument", name) + }, + )); + } + args.car_and_then(|arg1| { + args.cdr_and_then(|rest| { + if !has_rest && !rest.null() { + return Err(Error::new( + ErrorKind::TypeMismatch, // TODO: change to ArityMismatch + format!("{} requires exactly 1 argument", name), + )); + } + lambda(self, arg1, rest) + }) + }) + } + + pub(crate) fn compile_2_arg_call( + &mut self, + name: &TulispObject, + args: &TulispObject, + has_rest: bool, + mut lambda: impl FnMut( + &mut TulispContext, + &TulispObject, + &TulispObject, + &TulispObject, + ) -> Result, Error>, + ) -> Result, Error> { + let TulispValue::List { cons: args, .. } = &*args.inner_ref() else { + return Err(Error::new( + ErrorKind::TypeMismatch, // TODO: change to ArityMismatch + if has_rest { + format!("{} requires at least 2 arguments", name) + } else { + format!("{} requires exactly 2 arguments", name) + }, + )); + }; + if args.cdr().null() { + return Err(Error::new( + ErrorKind::TypeMismatch, // TODO: change to ArityMismatch + if has_rest { + format!("{} requires at least 2 arguments", name) + } else { + format!("{} requires exactly 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::new( + ErrorKind::TypeMismatch, // TODO: change to ArityMismatch + format!("{} requires exactly 2 arguments", name), + )); + } + lambda(self, arg1, arg2, rest) + }) + }) + } +} diff --git a/src/bytecode/compiler/forms/comparison_of_numbers.rs b/src/bytecode/compiler/forms/comparison_of_numbers.rs new file mode 100644 index 00000000..bf742b9e --- /dev/null +++ b/src/bytecode/compiler/forms/comparison_of_numbers.rs @@ -0,0 +1,336 @@ +use crate::{ + bytecode::{compiler::compiler::compile_expr, Instruction, Pos}, + Error, TulispContext, TulispObject, +}; + +fn compile_fn_compare( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, + instruction: Instruction, +) -> Result, Error> { + let compiler = ctx.compiler.as_mut().unwrap(); + let label = compiler.new_label(); + let keep_result = compiler.keep_result; + #[allow(dropping_references)] + drop(compiler); + let mut result = vec![]; + let args = args.base_iter().collect::>(); + if args.len() < 2 { + return Err(Error::new( + crate::ErrorKind::OutOfRange, // TODO: change to ArityMismatch + format!("{} requires at least 2 arguments", name), + )); + } + for items in args.windows(2) { + result.append(&mut compile_expr(ctx, &items[1])?); + result.append(&mut compile_expr(ctx, &items[0])?); + if keep_result { + result.push(instruction.clone()); + result.push(Instruction::JumpIfNilElsePop(Pos::Label(label.clone()))); + } + } + if keep_result { + result.pop(); + if args.len() > 2 { + result.push(Instruction::Label(label)); + } + } + Ok(result) +} + +pub(super) fn compile_fn_lt( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + compile_fn_compare(ctx, name, args, Instruction::Lt) +} + +pub(super) fn compile_fn_le( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + compile_fn_compare(ctx, name, args, Instruction::LtEq) +} + +pub(super) fn compile_fn_gt( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + compile_fn_compare(ctx, name, args, Instruction::Gt) +} + +pub(super) fn compile_fn_ge( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + compile_fn_compare(ctx, name, args, Instruction::GtEq) +} + +pub(super) fn compile_fn_eq( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + ctx.compile_2_arg_call(name, args, false, |ctx, arg1, arg2, _| { + let mut result = compile_expr(ctx, arg2)?; + result.append(&mut compile_expr(ctx, arg1)?); + if ctx.compiler.as_ref().unwrap().keep_result { + result.push(Instruction::Eq); + } + Ok(result) + }) +} + +pub(super) fn compile_fn_equal( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + ctx.compile_2_arg_call(name, args, false, |ctx, arg1, arg2, _| { + let mut result = compile_expr(ctx, arg2)?; + result.append(&mut compile_expr(ctx, arg1)?); + if ctx.compiler.as_ref().unwrap().keep_result { + result.push(Instruction::Equal); + } + Ok(result) + }) +} + +#[cfg(test)] +mod tests { + use crate::TulispObject; + + #[test] + fn test_compare_two_variables() { + let ctx = &mut crate::TulispContext::new(); + + let program = "(> 15 10)"; + let bytecode = ctx.compile_string(program, false).unwrap(); + assert!(bytecode.global.borrow().is_empty()); + assert_eq!(bytecode.functions.len(), 0); + + let program = "(> 15 10)"; + let bytecode = ctx.compile_string(program, true).unwrap(); + assert_eq!( + bytecode.to_string(), + r#" + push 10 # 0 + push 15 # 1 + cgt # 2"# + ); + let output = ctx.run_bytecode(bytecode).unwrap(); + assert!(output.equal(&TulispObject::t())); + assert!(!output.equal(&TulispObject::nil())); + + let program = "(> 10 15)"; + + let bytecode = ctx.compile_string(program, true).unwrap(); + let output = ctx.run_bytecode(bytecode).unwrap(); + assert!(output.equal(&TulispObject::nil())); + assert!(!output.equal(&TulispObject::t())); + } + + #[test] + fn test_compare_multiple_variables() { + let ctx = &mut crate::TulispContext::new(); + + let program = "(< a b c 10)"; + let bytecode = ctx.compile_string(program, false).unwrap(); + assert!(bytecode.global.borrow().is_empty()); + assert_eq!(bytecode.functions.len(), 0); + + let bytecode = ctx.compile_string(program, true).unwrap(); + + assert_eq!( + bytecode.to_string(), + r#" + load b # 0 + load a # 1 + clt # 2 + jnil_else_pop :2 # 3 + load c # 4 + load b # 5 + clt # 6 + jnil_else_pop :2 # 7 + push 10 # 8 + load c # 9 + clt # 10 +:2 # 11"# + ); + } + + #[test] + fn test_compare_side_effects() { + let ctx = &mut crate::TulispContext::new(); + + let program = "(<= (setq a 5) 8 10)"; + let bytecode = ctx.compile_string(program, false).unwrap(); + assert_eq!( + bytecode.to_string(), + r#" + push 5 # 0 + store_pop a # 1"# + ); + + let bytecode = ctx.compile_string(program, true).unwrap(); + assert_eq!( + bytecode.to_string(), + r#" + push 8 # 0 + push 5 # 1 + store a # 2 + cle # 3 + jnil_else_pop :2 # 4 + push 10 # 5 + push 8 # 6 + cle # 7 +:2 # 8"# + ); + + let output = ctx.run_bytecode(bytecode).unwrap(); + assert!(output.equal(&TulispObject::t())); + + let program = "(<= (setq a 5) 8 5)"; + let bytecode = ctx.compile_string(program, true).unwrap(); + let output = ctx.run_bytecode(bytecode).unwrap(); + assert!(output.equal(&TulispObject::nil())); + } + + #[test] + fn test_compare_eq() { + let ctx = &mut crate::TulispContext::new(); + + let program = "(eq 'a 'a)"; + let bytecode = ctx.compile_string(program, true).unwrap(); + assert_eq!( + bytecode.to_string(), + r#" + push a # 0 + push a # 1 + ceq # 2"# + ); + let output = ctx.run_bytecode(bytecode).unwrap(); + assert!(output.equal(&TulispObject::t())); + + let program = "(eq 'a 'b)"; + let bytecode = ctx.compile_string(program, true).unwrap(); + assert_eq!( + bytecode.to_string(), + r#" + push b # 0 + push a # 1 + ceq # 2"# + ); + let output = ctx.run_bytecode(bytecode).unwrap(); + assert!(output.equal(&TulispObject::nil())); + + let program = "(eq 'a 'a)"; + let bytecode = ctx.compile_string(program, false).unwrap(); + assert!(bytecode.global.borrow().is_empty()); + assert_eq!(bytecode.functions.len(), 0); + } + + #[test] + fn test_compare_eq_side_effects() { + let ctx = &mut crate::TulispContext::new(); + + let program = "(eq (setq a 'w) 'w)"; + let bytecode = ctx.compile_string(program, false).unwrap(); + println!("{}", bytecode.to_string()); + assert_eq!( + bytecode.to_string(), + r#" + push w # 0 + store_pop a # 1"# + ); + + let bytecode = ctx.compile_string(program, true).unwrap(); + assert_eq!( + bytecode.to_string(), + r#" + push w # 0 + push w # 1 + store a # 2 + ceq # 3"# + ); + + let output = ctx.run_bytecode(bytecode).unwrap(); + assert!(output.equal(&TulispObject::t())); + + let program = "(eq (setq a 'w) 'x)"; + let bytecode = ctx.compile_string(program, true).unwrap(); + let output = ctx.run_bytecode(bytecode).unwrap(); + assert!(output.equal(&TulispObject::nil())); + } + + #[test] + fn test_compare_equal() { + let ctx = &mut crate::TulispContext::new(); + + let program = "(equal 5 5)"; + let bytecode = ctx.compile_string(program, true).unwrap(); + assert_eq!( + bytecode.to_string(), + r#" + push 5 # 0 + push 5 # 1 + equal # 2"# + ); + let output = ctx.run_bytecode(bytecode).unwrap(); + assert!(output.equal(&TulispObject::t())); + + let program = "(equal 5 6)"; + let bytecode = ctx.compile_string(program, true).unwrap(); + assert_eq!( + bytecode.to_string(), + r#" + push 6 # 0 + push 5 # 1 + equal # 2"# + ); + let output = ctx.run_bytecode(bytecode).unwrap(); + assert!(output.equal(&TulispObject::nil())); + + let program = "(equal 5 5)"; + let bytecode = ctx.compile_string(program, false).unwrap(); + assert!(bytecode.global.borrow().is_empty()); + assert_eq!(bytecode.functions.len(), 0); + } + + #[test] + fn test_compare_equal_side_effects() { + let ctx = &mut crate::TulispContext::new(); + + let program = "(equal (setq a 5) 5)"; + let bytecode = ctx.compile_string(program, false).unwrap(); + assert_eq!( + bytecode.to_string(), + r#" + push 5 # 0 + store_pop a # 1"# + ); + + let bytecode = ctx.compile_string(program, true).unwrap(); + assert_eq!( + bytecode.to_string(), + r#" + push 5 # 0 + push 5 # 1 + store a # 2 + equal # 3"# + ); + + let output = ctx.run_bytecode(bytecode).unwrap(); + assert!(output.equal(&TulispObject::t())); + + let program = "(equal (setq a 5) 6)"; + let bytecode = ctx.compile_string(program, true).unwrap(); + let output = ctx.run_bytecode(bytecode).unwrap(); + assert!(output.equal(&TulispObject::nil())); + } +} diff --git a/src/bytecode/compiler/forms/conditionals.rs b/src/bytecode/compiler/forms/conditionals.rs new file mode 100644 index 00000000..73df4f6f --- /dev/null +++ b/src/bytecode/compiler/forms/conditionals.rs @@ -0,0 +1,182 @@ +use crate::{ + bytecode::{ + compiler::compiler::{compile_expr, compile_expr_keep_result, compile_progn}, + Instruction, Pos, + }, + Error, TulispContext, TulispObject, +}; + +fn optimize_jump_if_nil(result: &mut Vec, tgt_pos: Pos) -> Instruction { + match result.last() { + Some(Instruction::Gt) => { + result.pop(); + Instruction::JumpIfLtEq(tgt_pos) + } + Some(Instruction::Lt) => { + result.pop(); + Instruction::JumpIfGtEq(tgt_pos) + } + Some(Instruction::GtEq) => { + result.pop(); + Instruction::JumpIfLt(tgt_pos) + } + Some(Instruction::LtEq) => { + result.pop(); + Instruction::JumpIfGt(tgt_pos) + } + Some(Instruction::Eq) => { + result.pop(); + Instruction::JumpIfNeq(tgt_pos) + } + _ => Instruction::JumpIfNil(tgt_pos), + } +} + +pub(super) fn compile_fn_if( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + ctx.compile_2_arg_call(name, args, true, |ctx, cond, then, else_| { + let mut result = compile_expr_keep_result(ctx, cond)?; + let mut then = compile_expr(ctx, then)?; + let mut else_ = compile_progn(ctx, else_)?; + + let res = optimize_jump_if_nil(&mut result, Pos::Rel(then.len() as isize + 1)); + result.push(res); + result.append(&mut then); + if else_.is_empty() && ctx.compiler.as_ref().unwrap().keep_result { + else_.push(Instruction::Push(TulispObject::nil())); + } + result.push(Instruction::Jump(Pos::Rel(else_.len() as isize))); + result.append(&mut else_); + Ok(result) + }) +} + +pub(super) fn compile_fn_cond( + ctx: &mut TulispContext, + _name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + let mut result = vec![]; + let cond_end = ctx.compiler.as_mut().unwrap().new_label(); + + for branch in args.base_iter() { + result.append( + &mut ctx + .compile_1_arg_call(&"cond-branch".into(), &branch, true, |ctx, cond, body| { + let mut result = compile_expr_keep_result(ctx, cond)?; + let mut body = compile_progn(ctx, body)?; + + let res = optimize_jump_if_nil(&mut result, Pos::Rel(body.len() as isize + 1)); + result.push(res); + result.append(&mut body); + Ok(result) + }) + .map_err(|err| err.with_trace(branch))?, + ); + result.push(Instruction::Jump(Pos::Label(cond_end.clone()))); + } + let compiler = ctx.compiler.as_mut().unwrap(); + if compiler.keep_result { + result.push(Instruction::Push(false.into())); + } + result.push(Instruction::Label(cond_end)); + Ok(result) +} + +pub(super) fn compile_fn_while( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + ctx.compile_1_arg_call(name, args, true, |ctx, cond, body| { + let mut result = compile_expr_keep_result(ctx, cond)?; + let mut body = compile_progn(ctx, body)?; + + let res = optimize_jump_if_nil(&mut result, Pos::Rel(body.len() as isize + 1)); + result.push(res); + result.append(&mut body); + result.push(Instruction::Jump(Pos::Rel(-(result.len() as isize + 1)))); + Ok(result) + }) +} + +pub(super) fn compile_fn_not( + ctx: &mut TulispContext, + _name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + ctx.compile_1_arg_call(_name, args, false, |ctx, arg, _| { + let mut result = compile_expr(ctx, arg)?; + if ctx.compiler.as_ref().unwrap().keep_result { + result.push(Instruction::Null); + } + Ok(result) + }) +} + +pub(super) fn compile_fn_and( + ctx: &mut TulispContext, + _name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + let mut result = vec![]; + let compiler = ctx.compiler.as_mut().unwrap(); + let label = compiler.new_label(); + let keep_result = compiler.keep_result; + #[allow(dropping_references)] + drop(compiler); + let mut need_label = false; + for item in args.base_iter() { + let expr_result = &mut compile_expr(ctx, &item)?; + if !expr_result.is_empty() { + result.append(expr_result); + if keep_result { + result.push(Instruction::JumpIfNilElsePop(Pos::Label(label.clone()))); + } else { + result.push(Instruction::JumpIfNil(Pos::Label(label.clone()))); + } + need_label = true; + } + } + if need_label { + if keep_result { + result.pop(); + } + result.push(Instruction::Label(label.into())); + } + Ok(result) +} + +pub(super) fn compile_fn_or( + ctx: &mut TulispContext, + _name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + let mut result = vec![]; + let compiler = ctx.compiler.as_mut().unwrap(); + let label = compiler.new_label(); + let keep_result = compiler.keep_result; + let mut need_label = false; + for item in args.base_iter() { + let expr_result = &mut compile_expr(ctx, &item)?; + if !expr_result.is_empty() { + result.append(expr_result); + if keep_result { + result.push(Instruction::JumpIfNotNilElsePop(Pos::Label(label.clone()))); + } else { + result.push(Instruction::JumpIfNotNil(Pos::Label(label.clone()))); + } + need_label = true; + } + } + if need_label { + if keep_result { + result.push(Instruction::Push(false.into())) + } + result.push(Instruction::Label(label.into())); + } + Ok(result) +} diff --git a/src/bytecode/compiler/forms/list_elements.rs b/src/bytecode/compiler/forms/list_elements.rs new file mode 100644 index 00000000..4bd9bba7 --- /dev/null +++ b/src/bytecode/compiler/forms/list_elements.rs @@ -0,0 +1,51 @@ +use crate::{ + bytecode::{compiler::compiler::compile_expr, instruction::Cxr, Instruction}, + Error, ErrorKind, TulispContext, TulispObject, +}; + +pub(super) fn compile_fn_cxr( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + let mut result = + ctx.compile_1_arg_call(name, args, false, |ctx, arg1, _| compile_expr(ctx, arg1))?; + let compiler = ctx.compiler.as_mut().unwrap(); + if compiler.keep_result { + let name = name.to_string(); + match name.as_str() { + "car" => result.push(Instruction::Cxr(Cxr::Car)), + "cdr" => result.push(Instruction::Cxr(Cxr::Cdr)), + "caar" => result.push(Instruction::Cxr(Cxr::Caar)), + "cadr" => result.push(Instruction::Cxr(Cxr::Cadr)), + "cdar" => result.push(Instruction::Cxr(Cxr::Cdar)), + "cddr" => result.push(Instruction::Cxr(Cxr::Cddr)), + "caaar" => result.push(Instruction::Cxr(Cxr::Caaar)), + "caadr" => result.push(Instruction::Cxr(Cxr::Caadr)), + "cadar" => result.push(Instruction::Cxr(Cxr::Cadar)), + "caddr" => result.push(Instruction::Cxr(Cxr::Caddr)), + "cdaar" => result.push(Instruction::Cxr(Cxr::Cdaar)), + "cdadr" => result.push(Instruction::Cxr(Cxr::Cdadr)), + "cddar" => result.push(Instruction::Cxr(Cxr::Cddar)), + "cdddr" => result.push(Instruction::Cxr(Cxr::Cdddr)), + "caaaar" => result.push(Instruction::Cxr(Cxr::Caaaar)), + "caaadr" => result.push(Instruction::Cxr(Cxr::Caaadr)), + "caadar" => result.push(Instruction::Cxr(Cxr::Caadar)), + "caaddr" => result.push(Instruction::Cxr(Cxr::Caaddr)), + "cadaar" => result.push(Instruction::Cxr(Cxr::Cadaar)), + "cadadr" => result.push(Instruction::Cxr(Cxr::Cadadr)), + "caddar" => result.push(Instruction::Cxr(Cxr::Caddar)), + "cadddr" => result.push(Instruction::Cxr(Cxr::Cadddr)), + "cdaaar" => result.push(Instruction::Cxr(Cxr::Cdaaar)), + "cdaadr" => result.push(Instruction::Cxr(Cxr::Cdaadr)), + "cdadar" => result.push(Instruction::Cxr(Cxr::Cdadar)), + "cdaddr" => result.push(Instruction::Cxr(Cxr::Cdaddr)), + "cddaar" => result.push(Instruction::Cxr(Cxr::Cddaar)), + "cddadr" => result.push(Instruction::Cxr(Cxr::Cddadr)), + "cdddar" => result.push(Instruction::Cxr(Cxr::Cdddar)), + "cddddr" => result.push(Instruction::Cxr(Cxr::Cddddr)), + _ => return Err(Error::new(ErrorKind::Undefined, "unknown cxr".to_string())), + } + } + Ok(result) +} diff --git a/src/bytecode/compiler/forms/mod.rs b/src/bytecode/compiler/forms/mod.rs new file mode 100644 index 00000000..db2f3478 --- /dev/null +++ b/src/bytecode/compiler/forms/mod.rs @@ -0,0 +1,154 @@ +use std::collections::HashMap; + +use crate::{ + bytecode::Instruction, eval::macroexpand, Error, TulispContext, TulispObject, TulispValue, +}; + +use super::compiler::compile_expr; + +mod arithmetic_operations; +mod common; +mod comparison_of_numbers; +mod conditionals; +mod list_elements; +mod other_functions; +mod plist; +mod setting; + +type FnCallCompiler = + fn(&mut TulispContext, &TulispObject, &TulispObject) -> Result, Error>; + +pub(crate) struct VMCompilers { + // TulispObject.addr() -> implementation + pub functions: HashMap, +} + +macro_rules! map_fn_call_compilers { + ($ctx:ident, $functions: ident, $(($name:literal, $compiler:path),)+) => { + $( + $functions.insert( + $ctx.intern($name).addr_as_usize(), + $compiler as FnCallCompiler, + ); + )+ + }; +} + +impl VMCompilers { + pub fn new(ctx: &mut TulispContext) -> Self { + let mut functions = HashMap::new(); + map_fn_call_compilers! { + ctx, functions, + ("<=", comparison_of_numbers::compile_fn_le), + ("<", comparison_of_numbers::compile_fn_lt), + (">=", comparison_of_numbers::compile_fn_ge), + (">", comparison_of_numbers::compile_fn_gt), + ("eq", comparison_of_numbers::compile_fn_eq), + ("equal", comparison_of_numbers::compile_fn_equal), + // arithmetic + ("+", arithmetic_operations::compile_fn_plus), + ("-", arithmetic_operations::compile_fn_minus), + ("*", arithmetic_operations::compile_fn_mul), + ("/", arithmetic_operations::compile_fn_div), + // other functions + ("load", other_functions::compile_fn_load_file), + ("print", other_functions::compile_fn_print), + ("quote", other_functions::compile_fn_quote), + ("defun", other_functions::compile_fn_defun), + ("progn", other_functions::compile_fn_progn), + // setting + ("let", setting::compile_fn_let_star), + ("let*", setting::compile_fn_let_star), + ("setq", setting::compile_fn_setq), + ("set", setting::compile_fn_set), + // lists + ("cons", other_functions::compile_fn_cons), + ("list", other_functions::compile_fn_list), + ("append", other_functions::compile_fn_append), + ("plist-get", plist::compile_fn_plist_get), + // cxr + ("car", list_elements::compile_fn_cxr), + ("cdr", list_elements::compile_fn_cxr), + ("caar", list_elements::compile_fn_cxr), + ("cadr", list_elements::compile_fn_cxr), + ("cdar", list_elements::compile_fn_cxr), + ("cddr", list_elements::compile_fn_cxr), + ("caaar", list_elements::compile_fn_cxr), + ("caadr", list_elements::compile_fn_cxr), + ("cadar", list_elements::compile_fn_cxr), + ("caddr", list_elements::compile_fn_cxr), + ("cdaar", list_elements::compile_fn_cxr), + ("cdadr", list_elements::compile_fn_cxr), + ("cddar", list_elements::compile_fn_cxr), + ("cdddr", list_elements::compile_fn_cxr), + ("caaaar", list_elements::compile_fn_cxr), + ("caaadr", list_elements::compile_fn_cxr), + ("caadar", list_elements::compile_fn_cxr), + ("caaddr", list_elements::compile_fn_cxr), + ("cadaar", list_elements::compile_fn_cxr), + ("cadadr", list_elements::compile_fn_cxr), + ("caddar", list_elements::compile_fn_cxr), + ("cadddr", list_elements::compile_fn_cxr), + ("cdaaar", list_elements::compile_fn_cxr), + ("cdaadr", list_elements::compile_fn_cxr), + ("cdadar", list_elements::compile_fn_cxr), + ("cdaddr", list_elements::compile_fn_cxr), + ("cddaar", list_elements::compile_fn_cxr), + ("cddadr", list_elements::compile_fn_cxr), + ("cdddar", list_elements::compile_fn_cxr), + ("cddddr", list_elements::compile_fn_cxr), + // conditionals + ("if", conditionals::compile_fn_if), + ("cond", conditionals::compile_fn_cond), + ("while", conditionals::compile_fn_while), + ("and", conditionals::compile_fn_and), + ("or", conditionals::compile_fn_or), + ("not", conditionals::compile_fn_not), + // noop + ("defmacro", other_functions::compile_fn_noop), + } + VMCompilers { functions } + } +} + +pub(super) fn compile_form( + ctx: &mut TulispContext, + form: &TulispObject, +) -> Result, Error> { + let name = form.car()?; + let args = form.cdr()?; + if let Some(compiler) = ctx + .compiler + .as_ref() + .unwrap() + .vm_compilers + .functions + .get(&name.addr_as_usize()) + { + return compiler(ctx, &name, &args); + } + if let Ok(func) = ctx.eval(&name) { + match &*func.inner_ref() { + TulispValue::Func(func) => { + let compiler = ctx.compiler.as_mut().unwrap(); + return Ok(vec![ + Instruction::Push(args.clone()), + Instruction::RustCall { + name: name.clone(), + func: func.clone(), + keep_result: compiler.keep_result, + }, + ]); + } + TulispValue::Defmacro { .. } | TulispValue::Macro(..) => { + // TODO: this should not be necessary, this should be + // handled in the parser instead. + let form = macroexpand(ctx, form.clone())?; + return compile_expr(ctx, &form); + } + _ => {} + } + } + + other_functions::compile_fn_defun_call(ctx, &name, &args) +} diff --git a/src/bytecode/compiler/forms/other_functions.rs b/src/bytecode/compiler/forms/other_functions.rs new file mode 100644 index 00000000..6fed3954 --- /dev/null +++ b/src/bytecode/compiler/forms/other_functions.rs @@ -0,0 +1,304 @@ +use std::{cell::RefCell, rc::Rc}; + +use crate::{ + bytecode::{ + bytecode::CompiledDefun, + compiler::{ + compiler::{ + compile_expr, compile_expr_keep_result, compile_progn, compile_progn_keep_result, + }, + VMDefunParams, + }, + Instruction, Pos, + }, + list, + parse::mark_tail_calls, + Error, ErrorKind, TulispContext, TulispObject, +}; + +pub(super) fn compile_fn_print( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + ctx.compile_1_arg_call(name, args, false, |ctx, arg, _| { + let mut result = compile_expr_keep_result(ctx, arg)?; + if ctx.compiler.as_ref().unwrap().keep_result { + result.push(Instruction::Print); + } else { + result.push(Instruction::PrintPop); + } + Ok(result) + }) +} + +pub(super) fn compile_fn_quote( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + ctx.compile_1_arg_call(name, args, false, |ctx, arg, _| { + let compiler = ctx.compiler.as_mut().unwrap(); + if compiler.keep_result { + return Ok(vec![Instruction::Push(arg.clone().into())]); + } else { + return Ok(vec![]); + } + }) +} + +pub(super) fn compile_fn_cons( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + ctx.compile_2_arg_call(name, args, false, |ctx, arg1, arg2, _| { + let mut result = compile_expr(ctx, arg1)?; + result.append(&mut compile_expr(ctx, arg2)?); + if ctx.compiler.as_ref().unwrap().keep_result { + result.push(Instruction::Cons); + } + Ok(result) + }) +} + +pub(super) fn compile_fn_list( + ctx: &mut TulispContext, + _name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + if let Some(name) = args.is_bounced() { + return compile_fn_defun_bounce_call(ctx, &name, args); + } + + let mut result = vec![]; + let mut len = 0; + for arg in args.base_iter() { + result.append(&mut compile_expr(ctx, &arg)?); + len += 1; + } + if ctx.compiler.as_ref().unwrap().keep_result { + result.push(Instruction::List(len)); + } + Ok(result) +} + +pub(super) fn compile_fn_append( + ctx: &mut TulispContext, + _name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + let mut result = vec![]; + let mut len = 0; + for arg in args.base_iter() { + result.append(&mut compile_expr(ctx, &arg)?); + len += 1; + } + if ctx.compiler.as_ref().unwrap().keep_result { + result.push(Instruction::Append(len)); + } + Ok(result) +} + +fn compile_fn_defun_bounce_call( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + let compiler = ctx.compiler.as_mut().unwrap(); + + let mut result = vec![]; + let params = compiler.defun_args[&name.addr_as_usize()].clone(); + let mut args_count = 0; + // cdr because the first element is `Bounce`. + for arg in args.cdr()?.base_iter() { + result.append(&mut compile_expr_keep_result(ctx, &arg)?); + args_count += 1; + } + let mut optional_count = 0; + let left_args = args_count - params.required.len(); + if left_args > params.optional.len() { + if params.rest.is_none() { + return Err(Error::new( + ErrorKind::ArityMismatch, + format!( + "defun bounce call: too many arguments. expected: {} got: {}", + params.required.len() + params.optional.len(), + args_count + ), + ) + .with_trace(args.clone())); + } + result.push(Instruction::List(left_args - params.optional.len())); + optional_count = params.optional.len(); + } else if params.rest.is_some() { + result.push(Instruction::Push(TulispObject::nil())); + } + if let Some(param) = ¶ms.rest { + result.push(Instruction::StorePop(param.clone())) + } + if left_args <= params.optional.len() && left_args > 0 { + optional_count = left_args; + } + + for (ii, param) in params.optional.iter().enumerate().rev() { + if ii >= optional_count { + result.push(Instruction::Push(TulispObject::nil())); + result.push(Instruction::StorePop(param.clone())) + } else { + result.push(Instruction::StorePop(param.clone())); + } + } + + for param in params.required.iter().rev() { + result.push(Instruction::StorePop(param.clone())) + } + result.push(Instruction::Jump(Pos::Abs(0))); + return Ok(result); +} + +pub(super) fn compile_fn_defun_call( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + let mut result = vec![]; + let mut args_count = 0; + if name.consp() && name.car_and_then(|name| Ok(name.eq(&ctx.keywords.lambda)))? { + compile_fn_defun(ctx, &name.car()?, &list!(name.clone() ,@name.cdr()?)?)?; + } + + for arg in args.base_iter() { + result.append(&mut compile_expr_keep_result(ctx, &arg)?); + args_count += 1; + } + result.push(Instruction::Call { + name: name.clone(), + args_count, + function: None, + optional_count: 0, + rest_count: 0, + }); + if !ctx.compiler.as_ref().unwrap().keep_result { + result.push(Instruction::Pop); + } + Ok(result) +} + +pub(super) fn compile_fn_defun( + ctx: &mut TulispContext, + defun_kw: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + let mut defun_params = VMDefunParams { + required: vec![], + optional: vec![], + rest: None, + }; + let mut fn_name = TulispObject::nil(); + let res = ctx.compile_2_arg_call(defun_kw, args, true, |ctx, defun_name, args, body| { + fn_name = defun_name.clone(); + let compiler = ctx.compiler.as_mut().unwrap(); + compiler + .vm_compilers + .functions + .insert(defun_name.addr_as_usize(), compile_fn_defun_call); + let args = args.base_iter().collect::>(); + let mut is_optional = false; + let mut is_rest = false; + for arg in args.iter() { + if arg.eq(&ctx.keywords.amp_optional) { + if is_rest { + return Err(Error::new( + ErrorKind::Undefined, + "optional after rest".to_string(), + ) + .with_trace(arg.clone())); + } + is_optional = true; + } else if arg.eq(&ctx.keywords.amp_rest) { + if is_rest { + return Err( + Error::new(ErrorKind::Undefined, "rest after rest".to_string()) + .with_trace(arg.clone()), + ); + } + is_optional = false; + is_rest = true; + } else if is_optional { + defun_params.optional.push(arg.clone()); + } else if is_rest { + if defun_params.rest.is_some() { + return Err(Error::new( + ErrorKind::Undefined, + "multiple rest arguments".to_string(), + ) + .with_trace(arg.clone())); + } + defun_params.rest = Some(arg.clone()); + } else { + defun_params.required.push(arg.clone()); + } + } + + // This is required at this point, before the body is compiled, in case + // of tail calls. + compiler + .defun_args + .insert(defun_name.addr_as_usize(), defun_params.clone()); + + // TODO: replace with `is_string` + let body = if body.car()?.as_string().is_ok() { + body.cdr()? + } else { + body.clone() + }; + let body = mark_tail_calls(ctx, defun_name.clone(), body).map_err(|e| { + println!("mark_tail_calls error: {:?}", e); + e + })?; + let mut result = compile_progn_keep_result(ctx, &body)?; + result.push(Instruction::Ret); + + Ok(result) + })?; + let function = CompiledDefun { + name: fn_name.clone(), + instructions: Rc::new(RefCell::new(res)), + params: defun_params, + }; + let compiler = ctx.compiler.as_mut().unwrap(); + compiler + .bytecode + .functions + .insert(fn_name.addr_as_usize(), function); + Ok(vec![]) +} + +pub(super) fn compile_fn_progn( + ctx: &mut TulispContext, + _name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + Ok(compile_progn(ctx, args)?) +} + +pub(super) fn compile_fn_load_file( + ctx: &mut TulispContext, + _name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + ctx.compile_1_arg_call(_name, args, true, |ctx, arg, _| { + let mut result = compile_expr_keep_result(ctx, &arg)?; + result.push(Instruction::LoadFile); + Ok(result) + }) +} + +pub(super) fn compile_fn_noop( + _ctx: &mut TulispContext, + _name: &TulispObject, + _args: &TulispObject, +) -> Result, Error> { + Ok(vec![]) +} diff --git a/src/bytecode/compiler/forms/plist.rs b/src/bytecode/compiler/forms/plist.rs new file mode 100644 index 00000000..2ae81fd4 --- /dev/null +++ b/src/bytecode/compiler/forms/plist.rs @@ -0,0 +1,19 @@ +use crate::{ + bytecode::{compiler::compiler::compile_expr, Instruction}, + Error, TulispContext, TulispObject, +}; + +pub(super) fn compile_fn_plist_get( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + ctx.compile_2_arg_call(name, args, false, |ctx, plist, property, _| { + let mut result = compile_expr(ctx, property)?; + result.append(&mut compile_expr(ctx, plist)?); + if ctx.compiler.as_ref().unwrap().keep_result { + result.push(Instruction::PlistGet); + } + Ok(result) + }) +} diff --git a/src/bytecode/compiler/forms/setting.rs b/src/bytecode/compiler/forms/setting.rs new file mode 100644 index 00000000..8fed4586 --- /dev/null +++ b/src/bytecode/compiler/forms/setting.rs @@ -0,0 +1,112 @@ +use crate::{ + bytecode::{ + compiler::compiler::{compile_expr_keep_result, compile_progn}, + Instruction, + }, + destruct_bind, Error, ErrorKind, TulispContext, TulispObject, +}; + +pub(super) fn compile_fn_setq( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + ctx.compile_2_arg_call(name, args, false, |ctx, arg1, arg2, _| { + let mut result = compile_expr_keep_result(ctx, arg2)?; + if ctx.compiler.as_ref().unwrap().keep_result { + result.push(Instruction::Store(arg1.clone())); + } else { + result.push(Instruction::StorePop(arg1.clone())); + } + Ok(result) + }) +} + +pub(super) fn compile_fn_set( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + ctx.compile_2_arg_call(name, args, false, |ctx, arg1, arg2, _| { + let mut result = compile_expr_keep_result(ctx, arg2)?; + result.append(&mut compile_expr_keep_result(ctx, arg1)?); + if ctx.compiler.as_ref().unwrap().keep_result { + result.push(Instruction::Set); + } else { + result.push(Instruction::SetPop); + } + Ok(result) + }) +} + +pub(super) fn compile_fn_let_star( + ctx: &mut TulispContext, + name: &TulispObject, + args: &TulispObject, +) -> Result, Error> { + ctx.compile_1_arg_call(name, args, true, |ctx, varlist, body| { + let mut result = vec![]; + let mut params = vec![]; + let mut symbols = vec![]; + for varitem in varlist.base_iter() { + if varitem.symbolp() { + let param = varitem.clone(); + params.push(param.clone()); + result.append(&mut vec![ + Instruction::Push(false.into()), + Instruction::BeginScope(param), + ]); + + symbols.push(varitem); + } else if varitem.consp() { + let varitem_clone = varitem.clone(); + destruct_bind!((&optional name value &rest rest) = varitem_clone); + if name.null() { + return Err(Error::new( + ErrorKind::Undefined, + "let varitem requires name".to_string(), + ) + .with_trace(varitem)); + } + if !name.symbolp() { + return Err(Error::new( + ErrorKind::TypeMismatch, + format!("Expected Symbol: Can't assign to {}", name), + ) + .with_trace(name)); + } + if !rest.null() { + return Err(Error::new( + ErrorKind::Undefined, + "let varitem has too many values".to_string(), + ) + .with_trace(varitem)); + } + let param = name.clone(); + params.push(param.clone()); + result.append( + &mut compile_expr_keep_result(ctx, &value).map_err(|e| e.with_trace(value))?, + ); + result.push(Instruction::BeginScope(param)); + } else { + return Err(Error::new( + ErrorKind::SyntaxError, + format!( + "varitems inside a let-varlist should be a var or a binding: {}", + varitem + ), + ) + .with_trace(varitem)); + } + } + let mut body = compile_progn(ctx, body)?; + if body.is_empty() { + return Ok(vec![]); + } + result.append(&mut body); + for param in params { + result.push(Instruction::EndScope(param)); + } + Ok(result) + }) +} diff --git a/src/bytecode/compiler/mod.rs b/src/bytecode/compiler/mod.rs new file mode 100644 index 00000000..3265d98a --- /dev/null +++ b/src/bytecode/compiler/mod.rs @@ -0,0 +1,5 @@ +mod compiler; +mod forms; +pub(crate) use compiler::{compile, Compiler, VMDefunParams}; + +pub(crate) use forms::VMCompilers; diff --git a/src/bytecode/instruction.rs b/src/bytecode/instruction.rs new file mode 100644 index 00000000..dfa9dd13 --- /dev/null +++ b/src/bytecode/instruction.rs @@ -0,0 +1,212 @@ +use std::rc::Rc; + +use crate::{value::TulispFn, TulispObject}; + +use super::bytecode::CompiledDefun; + +#[derive(Clone)] +pub(crate) enum Pos { + Abs(usize), + Rel(isize), + Label(TulispObject), +} + +impl std::fmt::Display for Pos { + fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + match self { + Pos::Abs(p) => write!(f, "{}", p), + Pos::Rel(p) => write!(f, ". {}", p), + Pos::Label(p) => write!(f, "{}", p), + } + } +} + +#[derive(Clone, Copy)] +pub(crate) enum Cxr { + Car, + Cdr, + Caar, + Cadr, + Cdar, + Cddr, + Caaar, + Caadr, + Cadar, + Caddr, + Cdaar, + Cdadr, + Cddar, + Cdddr, + Caaaar, + Caaadr, + Caadar, + Caaddr, + Cadaar, + Cadadr, + Caddar, + Cadddr, + Cdaaar, + Cdaadr, + Cdadar, + Cdaddr, + Cddaar, + Cddadr, + Cdddar, + Cddddr, +} + +#[derive(Clone, Copy)] +pub(crate) enum BinaryOp { + Add, + Sub, + Mul, + Div, +} + +/// A single instruction in the VM. +#[derive(Clone)] +pub(crate) enum Instruction { + // stack + Push(TulispObject), + Pop, + // variables + Set, + SetPop, + StorePop(TulispObject), + Store(TulispObject), + Load(TulispObject), + BeginScope(TulispObject), + EndScope(TulispObject), + // arithmetic + BinaryOp(BinaryOp), + // io + LoadFile, + PrintPop, + Print, + // comparison + Equal, + Eq, + Lt, + LtEq, + Gt, + GtEq, + // predicates + Null, + // control flow + JumpIfNil(Pos), + JumpIfNotNil(Pos), + JumpIfNilElsePop(Pos), + JumpIfNotNilElsePop(Pos), + JumpIfNeq(Pos), + JumpIfLt(Pos), + JumpIfLtEq(Pos), + JumpIfGt(Pos), + JumpIfGtEq(Pos), + Jump(Pos), + // functions + Label(TulispObject), + RustCall { + name: TulispObject, + func: Rc, + keep_result: bool, + }, + Call { + name: TulispObject, + args_count: usize, + function: Option, + optional_count: usize, + rest_count: usize, + }, + Ret, + // lists + Cons, + List(usize), + Append(usize), + Cxr(Cxr), + PlistGet, + // values + Quote, +} + +impl std::fmt::Display for Instruction { + fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + match self { + Instruction::Push(obj) => write!(f, " push {}", obj), + Instruction::Pop => write!(f, " pop"), + Instruction::Set => write!(f, " set"), + Instruction::SetPop => write!(f, " set_pop"), + Instruction::StorePop(obj) => write!(f, " store_pop {}", obj), + Instruction::Store(obj) => write!(f, " store {}", obj), + Instruction::Load(obj) => write!(f, " load {}", obj), + Instruction::BeginScope(obj) => write!(f, " begin_scope {}", obj), + Instruction::EndScope(obj) => write!(f, " end_scope {}", obj), + Instruction::BinaryOp(op) => match op { + BinaryOp::Add => write!(f, " add"), + BinaryOp::Sub => write!(f, " sub"), + BinaryOp::Mul => write!(f, " mul"), + BinaryOp::Div => write!(f, " div"), + }, + Instruction::LoadFile => write!(f, " load_file"), + Instruction::PrintPop => write!(f, " print_pop"), + Instruction::Print => write!(f, " print"), + Instruction::Null => write!(f, " null"), + Instruction::JumpIfNil(pos) => write!(f, " jnil {}", pos), + Instruction::JumpIfNotNil(pos) => write!(f, " jnnil {}", pos), + Instruction::JumpIfNilElsePop(pos) => write!(f, " jnil_else_pop {}", pos), + Instruction::JumpIfNotNilElsePop(pos) => write!(f, " jnnil_else_pop {}", pos), + Instruction::JumpIfNeq(pos) => write!(f, " jne {}", pos), + Instruction::JumpIfLt(pos) => write!(f, " jlt {}", pos), + Instruction::JumpIfLtEq(pos) => write!(f, " jle {}", pos), + Instruction::JumpIfGt(pos) => write!(f, " jgt {}", pos), + Instruction::JumpIfGtEq(pos) => write!(f, " jge {}", pos), + Instruction::Equal => write!(f, " equal"), + Instruction::Eq => write!(f, " ceq"), + Instruction::Lt => write!(f, " clt"), + Instruction::LtEq => write!(f, " cle"), + Instruction::Gt => write!(f, " cgt"), + Instruction::GtEq => write!(f, " cge"), + Instruction::Jump(pos) => write!(f, " jmp {}", pos), + Instruction::Call { name, .. } => write!(f, " call {}", name), + Instruction::Ret => write!(f, " ret"), + Instruction::RustCall { name, .. } => write!(f, " rustcall {}", name), + Instruction::Label(name) => write!(f, "{}", name), + Instruction::Cons => write!(f, " cons"), + Instruction::List(len) => write!(f, " list {}", len), + Instruction::Append(len) => write!(f, " append {}", len), + Instruction::Cxr(cxr) => match cxr { + Cxr::Car => write!(f, " car"), + Cxr::Cdr => write!(f, " cdr"), + Cxr::Caar => write!(f, " caar"), + Cxr::Cadr => write!(f, " cadr"), + Cxr::Cdar => write!(f, " cdar"), + Cxr::Cddr => write!(f, " cddr"), + Cxr::Caaar => write!(f, " caaar"), + Cxr::Caadr => write!(f, " caadr"), + Cxr::Cadar => write!(f, " cadar"), + Cxr::Caddr => write!(f, " caddr"), + Cxr::Cdaar => write!(f, " cdaar"), + Cxr::Cdadr => write!(f, " cdadr"), + Cxr::Cddar => write!(f, " cddar"), + Cxr::Cdddr => write!(f, " cdddr"), + Cxr::Caaaar => write!(f, " caaaar"), + Cxr::Caaadr => write!(f, " caaadr"), + Cxr::Caadar => write!(f, " caadar"), + Cxr::Caaddr => write!(f, " caaddr"), + Cxr::Cadaar => write!(f, " cadaar"), + Cxr::Cadadr => write!(f, " cadadr"), + Cxr::Caddar => write!(f, " caddar"), + Cxr::Cadddr => write!(f, " cadddr"), + Cxr::Cdaaar => write!(f, " cdaaar"), + Cxr::Cdaadr => write!(f, " cdaadr"), + Cxr::Cdadar => write!(f, " cdadar"), + Cxr::Cdaddr => write!(f, " cdaddr"), + Cxr::Cddaar => write!(f, " cddaar"), + Cxr::Cddadr => write!(f, " cddadr"), + Cxr::Cdddar => write!(f, " cdddar"), + Cxr::Cddddr => write!(f, " cddddr"), + }, + Instruction::PlistGet => write!(f, " plist_get"), + Instruction::Quote => write!(f, " quote"), + } + } +} diff --git a/src/bytecode/interpreter.rs b/src/bytecode/interpreter.rs new file mode 100644 index 00000000..fcca9833 --- /dev/null +++ b/src/bytecode/interpreter.rs @@ -0,0 +1,610 @@ +use super::{bytecode::Bytecode, compile, compiler::VMDefunParams, Instruction}; +use crate::{bytecode::Pos, lists, Error, TulispContext, TulispObject, TulispValue}; +use std::{cell::RefCell, collections::HashMap, rc::Rc}; + +macro_rules! binary_ops { + ($oper:expr) => {{ + |selfobj: &TulispObject, other: &TulispObject| -> Result { + if !selfobj.numberp() { + return Err(Error::new( + crate::ErrorKind::TypeMismatch, + format!("Expected number, found: {selfobj}"), + ) + .with_trace(selfobj.clone())); + } + if !other.numberp() { + return Err(Error::new( + crate::ErrorKind::TypeMismatch, + format!("Expected number, found: {other}"), + ) + .with_trace(other.clone())); + } + if selfobj.floatp() { + let s: f64 = selfobj.as_float().unwrap(); + let o: f64 = other.try_into()?; + Ok($oper(&s, &o).into()) + } else if other.floatp() { + let o: f64 = other.as_float().unwrap(); + let s: f64 = selfobj.try_into()?; + Ok($oper(&s, &o).into()) + } else { + let s: i64 = selfobj.try_into()?; + let o: i64 = other.try_into()?; + Ok($oper(&s, &o).into()) + } + } + }}; +} + +macro_rules! compare_ops { + ($oper:expr) => {{ + |selfobj: &TulispObject, other: &TulispObject| -> Result { + if !selfobj.numberp() { + return Err(Error::new( + crate::ErrorKind::TypeMismatch, + format!("Expected number, found: {selfobj}"), + ) + .with_trace(selfobj.clone())); + } + if !other.numberp() { + return Err(Error::new( + crate::ErrorKind::TypeMismatch, + format!("Expected number, found: {other}"), + ) + .with_trace(other.clone())); + } + if selfobj.floatp() { + let s: f64 = selfobj.as_float().unwrap(); + let o: f64 = other.try_into()?; + Ok($oper(&s, &o)) + } else if other.floatp() { + let o: f64 = other.as_float().unwrap(); + let s: f64 = selfobj.try_into()?; + Ok($oper(&s, &o)) + } else { + let s: i64 = selfobj.try_into()?; + let o: i64 = other.try_into()?; + Ok($oper(&s, &o)) + } + } + }}; +} + +struct SetParams(Vec); + +impl SetParams { + fn new() -> Self { + Self(Vec::new()) + } + + fn push(&mut self, obj: TulispObject) { + self.0.push(obj); + } +} + +impl Drop for SetParams { + fn drop(&mut self) { + for obj in self.0.iter() { + obj.unset().unwrap(); + } + } +} + +pub struct Machine { + stack: Vec, + bytecode: Bytecode, + labels: HashMap, // TulispObject.addr -> instruction index +} + +macro_rules! jump_to_pos { + ($self: ident, $pc:ident, $pos:ident) => { + $pc = { + match $pos { + Pos::Abs(p) => *p, + Pos::Rel(p) => { + let abs_pos = ($pc as isize + *p + 1) as usize; + *$pos = Pos::Abs(abs_pos); + abs_pos + } + Pos::Label(p) => { + let abs_pos = *$self.labels.get(&p.addr_as_usize()).unwrap(); + *$pos = Pos::Abs(abs_pos); // TODO: uncomment + abs_pos + } + } + } + }; +} + +impl Machine { + pub(crate) fn new() -> Self { + Machine { + stack: Vec::new(), + bytecode: Bytecode::new(), + labels: HashMap::new(), + } + } + + fn locate_labels(bytecode: &Bytecode) -> HashMap { + // TODO: intern-soft and make sure that the labels are unique + let mut labels = HashMap::new(); + for (i, instr) in bytecode.global.borrow().iter().enumerate() { + if let Instruction::Label(name) = instr { + labels.insert(name.addr_as_usize(), i + 1); + } + } + for (_, func) in &bytecode.functions { + for (i, instr) in func.instructions.borrow().iter().enumerate() { + if let Instruction::Label(name) = instr { + labels.insert(name.addr_as_usize(), i + 1); + } + } + } + labels + } + + #[allow(dead_code)] + fn print_stack(&self, func: Option, pc: usize, recursion_depth: u32) { + println!("Stack:"); + for obj in self.stack.iter() { + println!(" {}", obj); + } + println!( + "\nDepth: {}: PC: {}; Executing: {}", + recursion_depth, + pc, + if let Some(func) = func { + self.bytecode + .functions + .get(&func) + .unwrap() + .instructions + .borrow()[pc] + .clone() + } else { + self.bytecode.global.borrow()[pc].clone() + } + ); + } + + pub fn run( + &mut self, + ctx: &mut TulispContext, + bytecode: Bytecode, + ) -> Result { + let labels = Self::locate_labels(&bytecode); + self.labels.extend(labels); + self.bytecode.import_functions(&bytecode); + self.bytecode.global = bytecode.global; + self.run_impl(ctx, &self.bytecode.global.clone(), 0)?; + Ok(self.stack.pop().unwrap().into()) + } + + fn run_impl( + &mut self, + ctx: &mut TulispContext, + program: &Rc>>, + recursion_depth: u32, + ) -> Result<(), Error> { + let mut pc: usize = 0; + let program_size = program.borrow().len(); + let mut instr_ref = program.borrow_mut(); + while pc < program_size { + // drop(instr_ref); + // self.print_stack(func, pc, recursion_depth); + // instr_ref = program.borrow_mut(); + + let instr = &mut instr_ref[pc]; + match instr { + Instruction::Push(obj) => self.stack.push(obj.clone()), + Instruction::Pop => { + self.stack.pop(); + } + Instruction::BinaryOp(op) => { + let [ref b, ref a] = self.stack[(self.stack.len() - 2)..] else { + unreachable!() + }; + + let vv = { + use crate::bytecode::instruction::BinaryOp::*; + match op { + Add => binary_ops!(|a, b| a + b)(a, b)?, + Sub => binary_ops!(|a, b| a - b)(a, b)?, + Mul => binary_ops!(|a, b| a * b)(a, b)?, + Div => { + if b.integerp() && b.as_int().unwrap() == 0 { + return Err(Error::new( + crate::ErrorKind::Undefined, + "Division by zero".to_string(), + )); + } + binary_ops!(|a, b| a / b)(a, b)? + } + } + }; + self.stack.truncate(self.stack.len() - 2); + self.stack.push(vv); + } + Instruction::LoadFile => { + let filename = self.stack.pop().unwrap(); + let filename = filename + .as_string() + .map_err(|err| err.with_trace(filename))?; + let ast = ctx.parse_file(&filename)?; + let bytecode = compile(ctx, &ast)?; + // TODO: support global code in modules + if bytecode.global.borrow().len() > 0 { + return Err(Error::new( + crate::ErrorKind::Undefined, + "Cannot load a file with global code".to_string(), + )); + } + // println!("{}", bytecode); + self.labels.extend(Self::locate_labels(&bytecode)); + self.bytecode.import_functions(&bytecode); + } + Instruction::PrintPop => { + let a = self.stack.pop().unwrap(); + println!("{}", a.fmt_string()); + } + Instruction::Print => { + let a = self.stack.last().unwrap(); + println!("{}", a.fmt_string()); + } + Instruction::JumpIfNil(pos) => { + let a = self.stack.last().unwrap(); + let cmp = a.null(); + self.stack.truncate(self.stack.len() - 1); + if cmp { + jump_to_pos!(self, pc, pos); + continue; + } + } + Instruction::JumpIfNotNil(pos) => { + let a = self.stack.last().unwrap(); + let cmp = !a.null(); + self.stack.truncate(self.stack.len() - 1); + if cmp { + jump_to_pos!(self, pc, pos); + continue; + } + } + Instruction::JumpIfNilElsePop(pos) => { + let a = self.stack.last().unwrap(); + if a.null() { + jump_to_pos!(self, pc, pos); + continue; + } else { + self.stack.truncate(self.stack.len() - 1); + } + } + Instruction::JumpIfNotNilElsePop(pos) => { + let a = self.stack.last().unwrap(); + if !a.null() { + jump_to_pos!(self, pc, pos); + continue; + } else { + self.stack.truncate(self.stack.len() - 1); + } + } + Instruction::JumpIfNeq(pos) => { + let minus2 = self.stack.len() - 2; + let [ref b, ref a] = self.stack[minus2..] else { + unreachable!() + }; + let cmp = !a.eq(&b); + self.stack.truncate(minus2); + if cmp { + jump_to_pos!(self, pc, pos); + continue; + } + } + Instruction::JumpIfLt(pos) => { + let minus2 = self.stack.len() - 2; + let [ref b, ref a] = self.stack[minus2..] else { + unreachable!() + }; + let cmp = compare_ops!(|a, b| a < b)(a, b)?; + self.stack.truncate(minus2); + if cmp { + jump_to_pos!(self, pc, pos); + continue; + } + } + Instruction::JumpIfLtEq(pos) => { + let minus2 = self.stack.len() - 2; + let [ref b, ref a] = self.stack[minus2..] else { + unreachable!() + }; + let cmp = compare_ops!(|a, b| a <= b)(a, b)?; + self.stack.truncate(minus2); + if cmp { + jump_to_pos!(self, pc, pos); + continue; + } + } + Instruction::JumpIfGt(pos) => { + let minus2 = self.stack.len() - 2; + let [ref b, ref a] = self.stack[minus2..] else { + unreachable!() + }; + let cmp = compare_ops!(|a, b| a > b)(a, b)?; + self.stack.truncate(minus2); + if cmp { + jump_to_pos!(self, pc, pos); + continue; + } + } + Instruction::JumpIfGtEq(pos) => { + let minus2 = self.stack.len() - 2; + let [ref b, ref a] = self.stack[minus2..] else { + unreachable!() + }; + let cmp = compare_ops!(|a, b| a >= b)(a, b)?; + self.stack.truncate(minus2); + if cmp { + jump_to_pos!(self, pc, pos); + continue; + } + } + Instruction::Jump(pos) => { + jump_to_pos!(self, pc, pos); + continue; + } + Instruction::Equal => { + let a = self.stack.pop().unwrap(); + let b = self.stack.pop().unwrap(); + self.stack.push(a.equal(&b).into()); + } + Instruction::Eq => { + let a = self.stack.pop().unwrap(); + let b = self.stack.pop().unwrap(); + self.stack.push(a.eq(&b).into()); + } + Instruction::Lt => { + let a = self.stack.pop().unwrap(); + let b = self.stack.pop().unwrap(); + self.stack.push(compare_ops!(|a, b| a < b)(&a, &b)?.into()); + } + Instruction::LtEq => { + let a = self.stack.pop().unwrap(); + let b = self.stack.pop().unwrap(); + self.stack.push(compare_ops!(|a, b| a <= b)(&a, &b)?.into()); + } + Instruction::Gt => { + let a = self.stack.pop().unwrap(); + let b = self.stack.pop().unwrap(); + self.stack.push(compare_ops!(|a, b| a > b)(&a, &b)?.into()); + } + Instruction::GtEq => { + let a = self.stack.pop().unwrap(); + let b = self.stack.pop().unwrap(); + self.stack.push(compare_ops!(|a, b| a >= b)(&a, &b)?.into()); + } + Instruction::Set => { + let minus2 = self.stack.len() - 2; + let [ref value, ref variable] = self.stack[minus2..] else { + unreachable!() + }; + variable.set(value.clone()).unwrap(); + // remove just the variable from the stack, keep the value + self.stack.truncate(self.stack.len() - 1); + } + Instruction::SetPop => { + let minus2 = self.stack.len() - 2; + let [ref value, ref variable] = self.stack[minus2..] else { + unreachable!() + }; + variable.set(value.clone()).unwrap(); + // remove both variable and value from stack. + self.stack.truncate(minus2); + } + Instruction::StorePop(obj) => { + let a = self.stack.pop().unwrap(); + obj.set(a.into()).unwrap(); + } + Instruction::Store(obj) => { + let a = self.stack.last().unwrap(); + obj.set(a.clone().into()).unwrap(); + } + Instruction::Load(obj) => { + let a = obj.get()?; + self.stack.push(a.into()); + } + Instruction::BeginScope(obj) => { + let a = self.stack.last().unwrap(); + obj.set_scope(a.clone().into()).unwrap(); + self.stack.truncate(self.stack.len() - 1); + } + Instruction::EndScope(obj) => { + obj.unset().unwrap(); + } + Instruction::Call { + name, + function, + args_count, + optional_count, + rest_count, + } => { + if function.is_none() { + let addr = name.addr_as_usize(); + let Some(func) = self.bytecode.functions.get(&addr) else { + return Err(Error::new( + crate::ErrorKind::Undefined, + format!("undefined function: {}", name), + ) + .with_trace(name.clone())); + }; + let func = func.clone(); + + if *args_count < func.params.required.len() { + return Err(Error::new( + crate::ErrorKind::TypeMismatch, // TODO: change to ArityMismatch + "Too few arguments".to_string(), + )); + } + if func.params.rest.is_none() + && *args_count > func.params.required.len() + func.params.optional.len() + { + return Err(Error::new( + crate::ErrorKind::TypeMismatch, // TODO: change to ArityMismatch + "Too many arguments".to_string(), + )); + } + let left_args = *args_count - func.params.required.len(); + if left_args > func.params.optional.len() { + *rest_count = left_args - func.params.optional.len(); + *optional_count = func.params.optional.len(); + } else if left_args > 0 { + *optional_count = left_args + } + *function = Some(func); + } + + let instructions = function.as_ref().unwrap().instructions.clone(); + let Some(function) = function.as_ref() else { + unreachable!() + }; + + let params = self.init_defun_args(&function.params, optional_count, rest_count); + drop(instr_ref); + self.run_function(ctx, &instructions, recursion_depth + 1)?; + instr_ref = program.borrow_mut(); + drop(params); + } + Instruction::Ret => return Ok(()), + Instruction::RustCall { + func, keep_result, .. + } => { + let args = self.stack.pop().unwrap(); + let result = func(ctx, &args)?; + if *keep_result { + self.stack.push(result); + } + } + Instruction::Label(_) => {} + Instruction::Cons => { + let b = self.stack.pop().unwrap(); + let a = self.stack.pop().unwrap(); + self.stack + .push(TulispObject::cons(a.into(), b.into()).into()); + } + Instruction::List(len) => { + let mut list = TulispObject::nil(); + for _ in 0..*len { + let a = self.stack.pop().unwrap(); + list = TulispObject::cons(a.into(), list); + } + self.stack.push(list.into()); + } + Instruction::Append(len) => { + let list = TulispObject::nil(); + + for elt in self.stack.drain(self.stack.len() - *len..) { + list.append(elt.deep_copy().unwrap())?; + } + self.stack.push(list.into()); + } + Instruction::Cxr(cxr) => { + let a: TulispObject = self.stack.pop().unwrap().into(); + + self.stack.push({ + use crate::bytecode::instruction::Cxr::*; + match cxr { + Car => a.car().unwrap(), + Cdr => a.cdr().unwrap(), + Caar => a.caar().unwrap(), + Cadr => a.cadr().unwrap(), + Cdar => a.cdar().unwrap(), + Cddr => a.cddr().unwrap(), + Caaar => a.caaar().unwrap(), + Caadr => a.caadr().unwrap(), + Cadar => a.cadar().unwrap(), + Caddr => a.caddr().unwrap(), + Cdaar => a.cdaar().unwrap(), + Cdadr => a.cdadr().unwrap(), + Cddar => a.cddar().unwrap(), + Cdddr => a.cdddr().unwrap(), + Caaaar => a.caaaar().unwrap(), + Caaadr => a.caaadr().unwrap(), + Caadar => a.caadar().unwrap(), + Caaddr => a.caaddr().unwrap(), + Cadaar => a.cadaar().unwrap(), + Cadadr => a.cadadr().unwrap(), + Caddar => a.caddar().unwrap(), + Cadddr => a.cadddr().unwrap(), + Cdaaar => a.cdaaar().unwrap(), + Cdaadr => a.cdaadr().unwrap(), + Cdadar => a.cdadar().unwrap(), + Cdaddr => a.cdaddr().unwrap(), + Cddaar => a.cddaar().unwrap(), + Cddadr => a.cddadr().unwrap(), + Cdddar => a.cdddar().unwrap(), + Cddddr => a.cddddr().unwrap(), + } + }) + } + Instruction::PlistGet => { + let [ref key, ref plist] = self.stack[(self.stack.len() - 2)..] else { + unreachable!() + }; + let value = lists::plist_get(plist, key)?; + self.stack.truncate(self.stack.len() - 2); + self.stack.push(value); + } + // predicates + Instruction::Null => { + let a = self.stack.last().unwrap().null(); + *self.stack.last_mut().unwrap() = a.into(); + } + Instruction::Quote => { + let a = self.stack.pop().unwrap(); + self.stack + .push(TulispValue::Quote { value: a.clone() }.into_ref(None)); + } + } + pc += 1; + } + Ok(()) + } + + fn init_defun_args( + &mut self, + params: &VMDefunParams, + optional_count: &usize, + rest_count: &usize, + ) -> SetParams { + let mut set_params = SetParams::new(); + if let Some(rest) = ¶ms.rest { + let mut rest_value = TulispObject::nil(); + for _ in 0..*rest_count { + rest_value = TulispObject::cons(self.stack.pop().unwrap(), rest_value); + } + rest.set_scope(rest_value).unwrap(); + set_params.push(rest.clone()); + } + for (ii, arg) in params.optional.iter().enumerate().rev() { + if ii >= *optional_count { + arg.set_scope(TulispObject::nil()).unwrap(); + continue; + } + arg.set_scope(self.stack.pop().unwrap()).unwrap(); + set_params.push(arg.clone()); + } + for arg in params.required.iter().rev() { + arg.set_scope(self.stack.pop().unwrap()).unwrap(); + set_params.push(arg.clone()); + } + set_params + } + + fn run_function( + &mut self, + ctx: &mut TulispContext, + instructions: &Rc>>, + recursion_depth: u32, + ) -> Result<(), Error> { + self.run_impl(ctx, &instructions, recursion_depth)?; + Ok(()) + } +} diff --git a/src/bytecode/mod.rs b/src/bytecode/mod.rs new file mode 100644 index 00000000..9753eb79 --- /dev/null +++ b/src/bytecode/mod.rs @@ -0,0 +1,11 @@ +mod bytecode; +pub(crate) use bytecode::{Bytecode, CompiledDefun}; + +pub(crate) mod instruction; +pub(crate) use instruction::{Instruction, Pos}; + +mod interpreter; +pub(crate) use interpreter::Machine; + +mod compiler; +pub(crate) use compiler::{compile, Compiler, VMCompilers}; diff --git a/src/context.rs b/src/context.rs index d0c49acd..f3a4976b 100644 --- a/src/context.rs +++ b/src/context.rs @@ -3,10 +3,11 @@ mod add_function; mod rest; pub use rest::Rest; -use std::{collections::HashMap, fs, rc::Rc}; +use std::{cell::RefCell, collections::HashMap, fs, rc::Rc}; use crate::{ TulispObject, TulispValue, builtin, + bytecode::{self, Bytecode, Compiler, compile}, context::add_function::TulispCallable, error::Error, eval::{DummyEval, eval, eval_and_then, eval_basic, funcall}, @@ -14,6 +15,40 @@ use crate::{ parse::parse, }; +use crate::bytecode::VMCompilers; + +macro_rules! intern_from_obarray { + ($( #[$meta:meta] )* + $vis:vis struct $struct_name:ident { + $($name:ident : $symbol:literal),+ $(,)? + }) => { + $( #[$meta] )* + $vis struct $struct_name { + $(pub $name: $crate::TulispObject),+ + } + + impl $struct_name { + fn from_obarray(obarray: &mut std::collections::HashMap) -> Self { + $struct_name { + $($name: intern_from_obarray!(@intern obarray, $symbol)),+ + } + } + } + }; + + (@intern $obarray:ident, $name:literal) => { + if let Some(sym) = $obarray.get($name) { + sym.clone_without_span() + } else { + let name = $name.to_string(); + let constant = name.starts_with(':'); + let sym = TulispObject::symbol(name.clone(), constant); + $obarray.insert(name, sym.clone()); + sym + } + } +} + #[derive(Debug, Default, Clone)] pub(crate) struct Scope { pub scope: Vec, @@ -34,6 +69,15 @@ impl Scope { } } +intern_from_obarray! { + #[derive(Clone)] + pub(crate) struct Keywords { + amp_optional: "&optional", + amp_rest: "&rest", + lambda: "lambda", + } +} + /// Represents an instance of the _Tulisp_ interpreter. /// /// Owns the @@ -45,6 +89,9 @@ impl Scope { pub struct TulispContext { obarray: HashMap, pub(crate) filenames: Vec, + pub(crate) compiler: Option, + pub(crate) keywords: Keywords, + pub(crate) vm: Rc>, } impl Default for TulispContext { @@ -56,12 +103,19 @@ impl Default for TulispContext { impl TulispContext { /// Creates a TulispContext with an empty global scope. pub fn new() -> Self { + let mut obarray = HashMap::new(); + let keywords = Keywords::from_obarray(&mut obarray); let mut ctx = Self { - obarray: HashMap::new(), + obarray, filenames: vec!["".to_string()], + compiler: None, + keywords, + vm: Rc::new(RefCell::new(bytecode::Machine::new())), }; builtin::functions::add(&mut ctx); builtin::macros::add(&mut ctx); + let vm_compilers = VMCompilers::new(&mut ctx); + ctx.compiler = Some(Compiler::new(vm_compilers)); ctx } @@ -239,20 +293,74 @@ impl TulispContext { /// Parses and evaluates the contents of the given file and returns the /// value. pub fn eval_file(&mut self, filename: &str) -> Result { + let vv = self.parse_file(filename)?; + self.eval_progn(&vv) + } + + pub fn vm_eval_string(&mut self, string: &str) -> Result { + let vv = parse(self, 0, string)?; + let bytecode = compile(self, &vv)?; + let vm = self.vm.clone(); + let res = vm.borrow_mut().run(self, bytecode); + drop(vm); + res + } + + pub fn vm_eval_file(&mut self, filename: &str) -> Result { + let start = std::time::Instant::now(); + let vv = self.parse_file(filename)?; + println!("Parsing took: {:?}", start.elapsed()); + let start = std::time::Instant::now(); + let bytecode = compile(self, &vv)?; + println!("Compiling took: {:?}", start.elapsed()); + // println!("{}", bytecode); + let start = std::time::Instant::now(); + let vm = self.vm.clone(); + let res = vm.borrow_mut().run(self, bytecode); + drop(vm); + println!("Running took: {:?}", start.elapsed()); + res + } + + pub(crate) fn get_filename(&self, file_id: usize) -> String { + self.filenames[file_id].clone() + } + + pub(crate) fn parse_file(&mut self, filename: &str) -> Result { let contents = fs::read_to_string(filename).map_err(|e| { Error::new( crate::ErrorKind::Undefined, format!("Unable to read file: {filename}. Error: {e}"), ) })?; - self.filenames.push(filename.to_owned()); + let idx = if let Some(idx) = self.filenames.iter().position(|x| x == filename) { + idx + } else { + self.filenames.push(filename.to_owned()); + self.filenames.len() - 1 + }; let string: &str = &contents; - let vv = parse(self, self.filenames.len() - 1, string)?; - self.eval_progn(&vv) + parse(self, idx, string) } - pub(crate) fn get_filename(&self, file_id: usize) -> String { - self.filenames[file_id].clone() + #[allow(dead_code)] + pub(crate) fn compile_string( + &mut self, + string: &str, + keep_result: bool, + ) -> Result { + let vv = parse(self, 0, string)?; + let compiler = self.compiler.as_mut().unwrap(); + compiler.keep_result = keep_result; + compile(self, &vv) + } + + #[allow(dead_code)] + pub(crate) fn run_bytecode(&mut self, bytecode: Bytecode) -> Result { + let vm = self.vm.clone(); + let res = vm.borrow_mut().run(self, bytecode); + drop(vm); + res } } diff --git a/src/error.rs b/src/error.rs index 4e02a4c1..40b31b4a 100644 --- a/src/error.rs +++ b/src/error.rs @@ -11,6 +11,7 @@ pub enum ErrorKind { SyntaxError, Throw(TulispObject), TypeMismatch, + ArityMismatch, Undefined, Uninitialized, } @@ -27,6 +28,7 @@ impl std::fmt::Display for ErrorKind { ErrorKind::SyntaxError => f.write_str("SyntaxError"), ErrorKind::Throw(args) => write!(f, "Throw{}", args), ErrorKind::TypeMismatch => f.write_str("TypeMismatch"), + ErrorKind::ArityMismatch => f.write_str("ArityMismatch"), ErrorKind::Undefined => f.write_str("Undefined"), ErrorKind::Uninitialized => f.write_str("Uninitialized"), } diff --git a/src/eval.rs b/src/eval.rs index 5c7d91b6..7be96d93 100644 --- a/src/eval.rs +++ b/src/eval.rs @@ -100,7 +100,7 @@ fn eval_lambda( args: &TulispObject, ) -> Result { let mut result = eval_function::(ctx, params, body, args)?; - while result.is_bounced() { + while result.is_bounced().is_some() { result = eval_function::(ctx, params, body, &result.cdr()?)?; } Ok(result) @@ -277,8 +277,9 @@ pub(crate) fn eval_basic<'a>( | TulispValue::Func(_) | TulispValue::Macro(_) | TulispValue::Defmacro { .. } + | TulispValue::CompiledDefun { .. } | TulispValue::Any(_) - | TulispValue::Bounce + | TulispValue::Bounce { .. } | TulispValue::Nil | TulispValue::T => {} TulispValue::Quote { value, .. } => { diff --git a/src/lib.rs b/src/lib.rs index c5ce973e..a95a92b4 100644 --- a/src/lib.rs +++ b/src/lib.rs @@ -76,6 +76,7 @@ A list of currently available builtin functions can be found [here](builtin). for executing _Tulisp_ programs. */ +pub(crate) mod bytecode; mod eval; mod macros; mod parse; diff --git a/src/object.rs b/src/object.rs index 8d4609f9..6ac4223d 100644 --- a/src/object.rs +++ b/src/object.rs @@ -353,9 +353,6 @@ assert_eq!(ts.value, 25); predicate_fn!(pub, null, "Returns True if `self` is `nil`."); predicate_fn!(pub, is_truthy, "Returns True if `self` is not `nil`."); - - predicate_fn!(pub(crate), is_bounce, "Returns True if `self` is a tail-call trampoline bounce object."); - predicate_fn!(pub(crate), is_bounced, "Returns True if `self` is a tail-call trampoline bounced function call."); // predicates end } @@ -451,10 +448,19 @@ impl TulispObject { self.span.set(in_span); self.clone() } + pub(crate) fn take(&self) -> TulispValue { self.rc.borrow_mut().take() } + pub(crate) fn is_bounce(&self) -> Option { + self.rc.borrow().is_bounce() + } + + pub(crate) fn is_bounced(&self) -> Option { + self.rc.borrow().is_bounced() + } + #[doc(hidden)] #[inline(always)] pub fn span(&self) -> Option { diff --git a/src/parse.rs b/src/parse.rs index a01bb345..f370adc6 100644 --- a/src/parse.rs +++ b/src/parse.rs @@ -1,8 +1,9 @@ use std::{collections::HashMap, fmt::Write, iter::Peekable, str::Chars}; use crate::{ - Error, ErrorKind, TulispContext, TulispObject, TulispValue, + Error, ErrorKind, TulispContext, TulispObject, TulispValue, destruct_bind, eval::{eval, macroexpand}, + list, object::Span, }; @@ -461,7 +462,10 @@ impl Parser<'_, '_> { } }; Ok(Some( - TulispValue::Unquote { value: next }.into_ref(Some(span)), + TulispValue::Unquote { + value: macroexpand(self.ctx, next)?, + } + .into_ref(Some(span)), )) } Token::Splice { span } => { @@ -531,6 +535,63 @@ impl Parser<'_, '_> { } } +pub(crate) fn mark_tail_calls( + ctx: &mut TulispContext, + name: TulispObject, + body: TulispObject, +) -> Result { + if !body.consp() { + return Ok(body); + } + let ret = TulispObject::nil(); + let mut body_iter = body.base_iter(); + let mut tail = body_iter.next().unwrap(); + for next in body_iter { + ret.push(tail)?; + tail = next; + } + if !tail.consp() { + return Ok(body); + } + let span = tail.span(); + let ctxobj = tail.ctxobj(); + let tail_ident = tail.car()?; + let tail_name_str = tail_ident.as_symbol()?; + let new_tail = if tail_ident.eq(&name) { + let ret_tail = TulispObject::nil().append(tail.cdr()?)?.to_owned(); + list!(,ctx.intern("list") + ,TulispValue::Bounce{ value: name }.into_ref(None) + ,@ret_tail)? + } else if tail_name_str == "progn" || tail_name_str == "let" || tail_name_str == "let*" { + list!(,tail_ident ,@mark_tail_calls(ctx, name, tail.cdr()?)?)? + } else if tail_name_str == "if" { + destruct_bind!((_if condition then_body &rest else_body) = tail); + list!(,tail_ident + ,condition.clone() + ,mark_tail_calls( + ctx, + name.clone(), + list!(,then_body)? + )?.car()? + ,@mark_tail_calls(ctx, name, else_body)? + )? + } else if tail_name_str == "cond" { + destruct_bind!((_cond &rest conds) = tail); + let mut ret = list!(,tail_ident)?; + for cond in conds.base_iter() { + destruct_bind!((condition &rest body) = cond); + ret = list!(,@ret + ,list!(,condition.clone() + ,@mark_tail_calls(ctx, name.clone(), body)?)?)?; + } + ret + } else { + tail + }; + ret.push(new_tail.with_ctxobj(ctxobj).with_span(span))?; + Ok(ret) +} + pub fn parse( ctx: &mut TulispContext, file_id: usize, diff --git a/src/value.rs b/src/value.rs index 0b87923d..490ea87c 100644 --- a/src/value.rs +++ b/src/value.rs @@ -1,5 +1,6 @@ use crate::{ TulispContext, TulispObject, + bytecode::CompiledDefun, cons::{self, Cons}, context::Scope, error::{Error, ErrorKind}, @@ -100,7 +101,7 @@ impl DefunParams { } } -type TulispFn = dyn Fn(&mut TulispContext, &TulispObject) -> Result; +pub(crate) type TulispFn = dyn Fn(&mut TulispContext, &TulispObject) -> Result; #[derive(Default, Clone, Debug)] pub struct SymbolBindings { @@ -256,7 +257,12 @@ pub enum TulispValue { params: DefunParams, body: TulispObject, }, - Bounce, + CompiledDefun { + value: CompiledDefun, + }, + Bounce { + value: TulispObject, + }, } impl std::fmt::Debug for TulispValue { @@ -302,7 +308,8 @@ impl std::fmt::Debug for TulispValue { .field("params", params) .field("body", body) .finish(), - Self::Bounce => write!(f, "Bounce"), + Self::CompiledDefun { .. } => f.debug_struct("CompiledDefun").finish(), + Self::Bounce { value } => f.debug_struct("Bounce").field("value", value).finish(), } } } @@ -375,7 +382,7 @@ fn fmt_list(mut vv: TulispObject, f: &mut std::fmt::Formatter<'_>) -> Result<(), impl std::fmt::Display for TulispValue { fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { match self { - TulispValue::Bounce => f.write_str("Bounce"), + TulispValue::Bounce { value } => f.write_fmt(format_args!("{}::bounce", value)), TulispValue::Nil => f.write_str("nil"), TulispValue::Symbol { value } => f.write_str(&value.name), TulispValue::LexicalBinding { value, .. } => f.write_str(&value.name), @@ -397,6 +404,7 @@ impl std::fmt::Display for TulispValue { TulispValue::Macro(_) => f.write_str("Macro"), TulispValue::Defmacro { .. } => f.write_str("Defmacro"), TulispValue::Lambda { .. } => f.write_str("Defun"), + TulispValue::CompiledDefun { .. } => f.write_str("CompiledDefun"), } } } @@ -696,16 +704,19 @@ impl TulispValue { } #[inline(always)] - pub(crate) fn is_bounced(&self) -> bool { + pub(crate) fn is_bounced(&self) -> Option { match self { TulispValue::List { cons, .. } => cons.car().is_bounce(), - _ => false, + _ => None, } } #[inline(always)] - pub(crate) fn is_bounce(&self) -> bool { - matches!(self, TulispValue::Bounce) + pub fn is_bounce(&self) -> Option { + match self { + TulispValue::Bounce { value } => Some(value.clone()), + _ => None, + } } #[inline(always)] diff --git a/tests/good-load.lisp b/tests/good-load.lisp index 8ead51f7..b44ff4d8 100644 --- a/tests/good-load.lisp +++ b/tests/good-load.lisp @@ -1 +1 @@ -'(1 2 3) +(defun test () '(1 2 3)) diff --git a/tests/tests.rs b/tests/tests.rs index 4f21911d..facc8c7f 100644 --- a/tests/tests.rs +++ b/tests/tests.rs @@ -19,6 +19,23 @@ macro_rules! tulisp_assert { ); }; + (@impl_vm $ctx: expr, program:$input:expr, result:$result:expr $(,)?) => { + let output = $ctx.vm_eval_string($input).map_err(|err| { + panic!("{}:{}: execution failed: {}", file!(), line!(),err.format(&$ctx)); + + })?; + let expected = $ctx.vm_eval_string($result)?; + assert!( + output.equal(&expected), + "\n{}:{}: program: {}\n vm output: {},\n expected: {}\n", + file!(), + line!(), + $input, + output, + expected + ); + }; + (@impl $ctx: expr, program:$input:expr, result_str:$result:expr $(,)?) => { let output = $ctx.eval_string($input).map_err(|err| { println!("{}:{}: execution failed: {}", file!(), line!(),err.format(&$ctx)); @@ -35,19 +52,50 @@ macro_rules! tulisp_assert { ); }; + (@impl_vm $ctx: expr, program:$input:expr, result_str:$result:expr $(,)?) => { + let output = $ctx.vm_eval_string($input).map_err(|err| { + println!("{}:{}: execution failed: {}", file!(), line!(),err.format(&$ctx)); + err + })?; + let expected = $ctx.vm_eval_string($result)?; + assert_eq!(output.to_string(), expected.to_string(), + "\n{}:{}: program: {}\n vm output: {},\n expected: {}\n", + file!(), + line!(), + $input, + output, + expected + ); + }; + (@impl $ctx: expr, program:$input:expr, error:$desc:expr $(,)?) => { let output = $ctx.eval_string($input); assert!(output.is_err()); assert_eq!(output.unwrap_err().format(&$ctx), $desc); }; + (@impl_vm $ctx: expr, program:$input:expr, error:$desc:expr $(,)?) => { + let output = $ctx.vm_eval_string($input); + assert!(output.is_err()); + let output = output.unwrap_err().format(&$ctx); + assert!( + $desc.starts_with(&output), + " vm output: {},\n expected: {}\n", + &output, + $desc + ); + }; + (ctx: $ctx: expr, program: $($tail:tt)+) => { - tulisp_assert!(@impl $ctx, program: $($tail)+) + tulisp_assert!(@impl $ctx, program: $($tail)+); + tulisp_assert!(@impl_vm $ctx, program: $($tail)+); }; (program: $($tail:tt)+) => { let mut ctx = TulispContext::new(); - tulisp_assert!(ctx: ctx, program: $($tail)+) + tulisp_assert!(@impl ctx, program: $($tail)+); + let mut ctx = TulispContext::new(); + tulisp_assert!(@impl_vm ctx, program: $($tail)+); }; } @@ -474,10 +522,10 @@ fn test_eval() -> Result<(), Error> { "# } tulisp_assert! { - program: "(let ((j 10)) (+ j j))(+ j j)", + program: "(let ((j 10)) (+ j j))(+ j 1)", error: r#"ERR TypeMismatch: Variable definition is void: j :1.26-1.27: at j -:1.23-1.30: at (+ j j) +:1.23-1.30: at (+ j 1) "# } Ok(()) @@ -706,6 +754,14 @@ fn test_backquotes() -> Result<(), Error> { result: r#"t"#, } + tulisp_assert! { + program: r#" + (let ((a 10)) + (cdr `(a . ,a))) + "#, + result: r#"10"#, + } + tulisp_assert! { program: r#"`(1 2 '(+ 10 20) ',(+ 10 20) (quote ,(+ 20 20)))"#, result: r#"'(1 2 '(+ 10 20) '30 (quote 40))"#, @@ -824,6 +880,7 @@ fn test_let() -> Result<(), Error> { tulisp_assert! { program: "(let (18 (vv (+ 55 1)) (jj 20)) (+ vv jj 1))", error: r#"ERR SyntaxError: varitems inside a let-varlist should be a var or a binding: 18 +:1.7-1.9: at 18 :1.1-1.45: at (let (18 (vv (+ 55 1)) (jj 20)) (+ vv jj 1)) "# } @@ -1209,7 +1266,7 @@ fn test_load() -> Result<(), Error> { tulisp_assert! { ctx: ctx, - program: r#"(load "tests/good-load.lisp")"#, + program: r#"(load "tests/good-load.lisp") (test)"#, result: "'(1 2 3)", }