From 3cefd9ac4e4edbf013cee9e498c525d2645a73d9 Mon Sep 17 00:00:00 2001 From: Mark Poliakov Date: Fri, 22 May 2026 13:57:35 +0300 Subject: [PATCH] Fix temporaries breaking (let ...) blocks, (gensym) --- examples/debug.lysp | 1 - examples/macros.lysp | 22 ++++++++--- src/compile/block.rs | 23 +++++++++++ src/compile/codegen/function.rs | 9 +++++ src/compile/syntax/mod.rs | 2 +- src/prelude.lysp | 70 +++++++++++++++++++++++++++++++-- src/vm/env.rs | 17 +++++++- src/vm/prelude/debug.rs | 3 ++ src/vm/value/convert.rs | 10 ++++- src/vm/value/keyword.rs | 1 + 10 files changed, 143 insertions(+), 15 deletions(-) delete mode 100644 examples/debug.lysp diff --git a/examples/debug.lysp b/examples/debug.lysp deleted file mode 100644 index de46ed4..0000000 --- a/examples/debug.lysp +++ /dev/null @@ -1 +0,0 @@ -(print (explain explain)) diff --git a/examples/macros.lysp b/examples/macros.lysp index 2419730..c3d2993 100644 --- a/examples/macros.lysp +++ b/examples/macros.lysp @@ -19,14 +19,16 @@ (assert (= '(2 3 4 2 3 4) `(,@glob1 ,@glob1))) (assert (= '((((2 3 4)))) `(((,glob1))))) -(defmacro debug (expression) - (print "DEBUG:" expression) - expression - ) - ; those are prelude, but defined in lysp itself: -(debug +(print "The previously printed expression is AFTER this one in the code") +(compile-debug + (when #t + (print "a") + (print "b") + ) + ) +(runtime-debug (when #t (print "a") (print "b") @@ -43,3 +45,11 @@ ) +; catch macro +(print "Failing in a catch block...") +(catch + (print a) + e (print "Caught an error:" e) + ) + +(print "... doesn't fail the execution") diff --git a/src/compile/block.rs b/src/compile/block.rs index 4761aef..0712e3e 100644 --- a/src/compile/block.rs +++ b/src/compile/block.rs @@ -267,6 +267,29 @@ impl CompileContext { } } + pub fn guard_argument(&mut self) { + let depth = self.scope_depth as isize; + self.locals.push(Local { + name: "".into(), + depth, + is_captured: false, + }); + } + + pub fn unguard_argument(&mut self) { + let guard = self + .locals + .pop() + .expect("unguard_argument() called with an empty locals stack"); + let stack_index = self.locals.len(); + if guard.name.as_ref() != "" { + panic!( + "unguard_argument(): the local is not a guard: {:?} at stack index {}", + guard.name, stack_index, + ); + } + } + pub fn push_scope(&mut self) { self.scope_depth += 1; if self.options.trace_compile { diff --git a/src/compile/codegen/function.rs b/src/compile/codegen/function.rs index 4f99093..b4fe152 100644 --- a/src/compile/codegen/function.rs +++ b/src/compile/codegen/function.rs @@ -53,13 +53,22 @@ impl Compile for CallExpression { if instruction == Instruction::Call { let callee = self.callee.compile(cx)?; cx.push(callee)?; + cx.guard_argument(); } for expression in self.arguments.iter() { let value = expression.compile(cx)?; cx.push(value)?; + cx.guard_argument(); } cx.emit(instruction); cx.emit(argument_count); + let mut unguard_count = usize::from(argument_count); + if instruction == Instruction::Call { + unguard_count += 1; + } + for _ in 0..unguard_count { + cx.unguard_argument(); + } Ok(CompileValue::Stack) } } diff --git a/src/compile/syntax/mod.rs b/src/compile/syntax/mod.rs index c3ef28f..d569a7c 100644 --- a/src/compile/syntax/mod.rs +++ b/src/compile/syntax/mod.rs @@ -121,7 +121,7 @@ impl Expression { _ => Self::map_or(CallExpression::parse(cons, value), Expression::Call), } } - Value::Keyword(_) => todo!("Error here"), + Value::Keyword(keyword) => todo!("Error here: keyword {keyword}"), Value::Closure(_) => todo!("Error here"), Value::Function(_) => todo!("Error here"), Value::NativeFunction(_) => todo!("Error here"), diff --git a/src/prelude.lysp b/src/prelude.lysp index 7ac8488..d664a29 100644 --- a/src/prelude.lysp +++ b/src/prelude.lysp @@ -1,8 +1,70 @@ -(defmacro when (condition &rest body) - `(if ,condition (progn ,@body)) +; Convenience flow control macros +(defmacro when (condition body-head &rest body) + "If condition is true, evaluates the expressions in body, otherwise returns nil" + `(if ,condition (progn ,body-head ,@body)) ) -(defmacro unless (condition &rest body) - `(if (not ,condition) (progn ,@body)) +(defmacro unless (condition body-head &rest body) + "If condition is false, evaluates the expressions in body, otherwise returns nil" + `(if (not ,condition) (progn ,body-head ,@body)) ) +; Result handling functions +(defun result/ok? (x) + "Returns #t if x is an ok" + (= 'ok (car x)) + ) +(defun result/err? (x) + "Returns #t if x is an error" + (= 'err (car x)) + ) +(defun result/map (f x) + "If x is an ok, applies f to its value, otherwise does nothing" + (if (result/ok? x) + `(ok ,(f (cadr x))) + x + ) + ) +(defun result/map-err (f x) + "If x is an error, applies f to its value, otherwise does nothing" + (if (result/err? x) + `(err ,(f (cadr x))) + x + ) + ) + +; Convenience error handling macros +(defmacro catch (expression error-symbol handler) + "Evaluates expression, running the handler if evaluation fails, introducing error-symbol as error" + (let (eval-result-symbol (gensym)) + `(let (,eval-result-symbol (eval (quote ,expression))) + (cond + ((result/ok? ,eval-result-symbol) (cadr ,eval-result-symbol)) + (&otherwise + (let (,error-symbol (cadr ,eval-result-symbol)) + ,handler + ) + ) + ) + ) + ) + ) + +(defmacro compile-debug (expression) + "Prints the input expression during macro expansion/compile time and evaluates the expression in runtime" + (print expression) + expression + ) +(defmacro runtime-debug (expression) + "Prints the input expression and evaluates it in runtime" + `(progn + (print (quote ,expression)) + ,expression + ) + ) + +; Convenience list functions +(defun cadr (x) "Alias for (car (cdr x))" (car (cdr x))) +(defun cdar (x) "Alias for (cdr (car x))" (cdr (car x))) +(defun caddr (x) "Alias for (car (cdr (cdr x)))" (car (cdr (cdr x)))) +(defun cadar (x) "Alias for (car (cdr (car x)))" (car (cdr (car x)))) diff --git a/src/vm/env.rs b/src/vm/env.rs index ed20746..c237d95 100644 --- a/src/vm/env.rs +++ b/src/vm/env.rs @@ -1,4 +1,12 @@ -use std::{borrow::Borrow, cell::RefCell, collections::HashMap, fmt, hash::Hash, rc::Rc}; +use std::{ + borrow::Borrow, + cell::RefCell, + collections::HashMap, + fmt, + hash::Hash, + rc::Rc, + sync::atomic::{AtomicU32, Ordering}, +}; use crate::{ error::MachineError, @@ -22,6 +30,7 @@ pub struct Environment { globals: RefCell>, macros: RefCell>, parent: Option>, + gensym_index: AtomicU32, } impl Environment { @@ -32,6 +41,12 @@ impl Environment { } } + pub fn gensym(&self) -> IdentifierValue { + // TODO do this in a root environment? + let index = self.gensym_index.fetch_add(1, Ordering::SeqCst); + format!("___gensym{index}").into() + } + pub fn defun_native(&self, identifier: S, docstring: D, function: F) -> Value where S: Into, diff --git a/src/vm/prelude/debug.rs b/src/vm/prelude/debug.rs index 250e4ae..34b4149 100644 --- a/src/vm/prelude/debug.rs +++ b/src/vm/prelude/debug.rs @@ -6,6 +6,9 @@ use crate::{ }; pub fn load(env: &Rc) { + env.defun_native("gensym", "Provides an unique symbol name", |_, env, _| { + Ok(env.gensym().into()) + }); env.defun_native( "explain", "Provides an explanation for a given value", diff --git a/src/vm/value/convert.rs b/src/vm/value/convert.rs index 6e98f4a..0db0f53 100644 --- a/src/vm/value/convert.rs +++ b/src/vm/value/convert.rs @@ -7,8 +7,8 @@ use crate::{ env::Environment, machine::Machine, value::{ - BooleanValue, BytecodeFunction, ClosureValue, ConsCell, NativeFunction, NativeValue, - NumberValue, StringValue, Vector, + BooleanValue, BytecodeFunction, ClosureValue, ConsCell, IdentifierValue, + NativeFunction, NativeValue, NumberValue, StringValue, Vector, }, }, }; @@ -126,6 +126,12 @@ impl From> for Value { } } +impl From for Value { + fn from(value: IdentifierValue) -> Self { + Value::Identifier(value) + } +} + impl TryFromValue<'_> for AnyFunction { fn try_from_value(value: &'_ Value) -> Result { match value { diff --git a/src/vm/value/keyword.rs b/src/vm/value/keyword.rs index 6e4cc55..415b3b8 100644 --- a/src/vm/value/keyword.rs +++ b/src/vm/value/keyword.rs @@ -52,6 +52,7 @@ impl_keyword! { Break => "break", Continue => "continue", Declare => "declare", + Error => "&error", // Cons => "cons", } }