lysp: rework and/or, add prelude functions

This commit is contained in:
2026-06-04 12:47:21 +03:00
parent 1261c037f8
commit f5d3809f37
21 changed files with 383 additions and 130 deletions
+9 -8
View File
@@ -1,12 +1,13 @@
(setq xs '(1 2 3 4 5))
(setq ys '((1 2) (3 4) (5 6)))
(print "XS:")
(print xs)
(print (length xs))
(print (find (lambda (x) (> x 3)) xs))
(assert (= (length xs) 5))
(assert (= '(5 4 3 2 1) (reverse xs)))
(assert (= 15 (apply + xs) (fold + 0 xs)))
(assert (= 120 (apply * xs) (fold * 1 xs)))
(print "YS:")
(print ys)
(print (length ys))
(print (find (lambda (x) (> (car x) 2)) ys))
(assert (= (length ys) 3))
(assert (= '((5 6) (3 4) (1 2)) (reverse ys)))
(assert (= '((2 1) (4 3) (6 5)) (map reverse ys)))
(assert (= '(2 2 2) (map length ys)))
(assert (= '(1 2 3 4 5 6) (flatmap identity ys)))
+23
View File
@@ -46,4 +46,27 @@
;;;; Logic
(assert (and #t #t 1))
(assert (not (and #t #f 1)))
(assert (not (or nil 0 #f)))
; (and ...) and (or ...) must short-circuit
; (and ...) and (or ...) must not double-evaluate
(setq no-double-eval-and 0)
(setq no-double-eval-or 0)
(and
#t
(progn
(setq no-double-eval-and (+ no-double-eval-and 1))
#t
)
#f
(error "(and ...) must short-circuit after #F"))
(or
#f
(progn
(setq no-double-eval-or (+ no-double-eval-or 1))
#t
)
#t
(error "(or ...) must short-circuit after #T"))
(assert (= no-double-eval-and 1))
(assert (= no-double-eval-or 1))
+4
View File
@@ -50,3 +50,7 @@
;; Quoting
`(ok ,glob-value)
;; Evaluation rules
; (progn ...) must evaluate to the last expression
(assert (= (progn 1 2 3) 3))
+12 -3
View File
@@ -2,7 +2,10 @@ use crate::compile::{
block::{Compile, CompileContext, CompileValue},
error::CompileError,
instruction::Emitted,
syntax::{CondExpression, IfExpression, LoopExpression, PrognExpression, WhileExpression},
syntax::{
CondExpression, IfExpression, LoopExpression, PrognExpression, ReturnExpression,
WhileExpression,
},
};
impl Compile for WhileExpression {
@@ -103,8 +106,14 @@ impl Compile for CondExpression {
impl Compile for PrognExpression {
fn compile(&self, cx: &mut CompileContext) -> Result<CompileValue, CompileError> {
let value = self.body.compile(cx)?;
cx.discard(value);
self.body.compile(cx)
}
}
impl Compile for ReturnExpression {
fn compile(&self, cx: &mut CompileContext) -> Result<CompileValue, CompileError> {
let value = self.expression.compile(cx)?;
cx.compile_return_value(value)?;
Ok(CompileValue::Nil)
}
}
@@ -24,8 +24,6 @@ fn builtin_identifier_callee(identifier: &str) -> Option<Instruction> {
">=" | "" => Some(Instruction::Ge),
"<=" | "" => Some(Instruction::Le),
"not" => Some(Instruction::Not),
"and" | "&&" => Some(Instruction::And),
"or" | "||" => Some(Instruction::Or),
_ => None,
}
}
@@ -14,6 +14,7 @@ impl Compile for Expression {
Self::Nil => Ok(CompileValue::Nil),
Self::Break => flow::compile_break(cx),
Self::Continue => flow::compile_continue(cx),
Self::Return(return_) => return_.compile(cx),
Self::Call(call) => call.compile(cx),
Self::If(if_) => if_.compile(cx),
Self::Cond(cond) => cond.compile(cx),
@@ -32,6 +32,11 @@ pub struct DefunExpression {
pub body: FunctionBody,
}
#[derive(Debug, PartialEq)]
pub struct ReturnExpression {
pub expression: Rc<Expression>,
}
#[derive(Debug, PartialEq)]
pub struct PrognExpression {
pub body: FunctionBody,
@@ -262,6 +267,36 @@ impl DefunExpression {
}
}
impl ReturnExpression {
pub(super) fn parse(value: &Value, input: &Value) -> Result<Self, ParseError> {
match value {
Value::Cons(cons) => {
let ConsCell(car, cdr) = cons.as_ref();
if !cdr.is_nil() {
return Err(ParseError {
input: input.clone(),
error: ParseErrorKind::extraneous(cdr),
});
}
let expression = Expression::parse_inner(car);
Ok(Self { expression })
}
Value::Nil => Ok(Self {
expression: Rc::new(Expression::Nil),
}),
_ => Err(ParseError {
input: input.clone(),
error: ParseErrorKind::Expected(
ExpectedWhat::Expression,
ExpectedWhere::AfterKeyword(Keyword::Return),
),
}),
}
}
}
impl CollectErrors<ParseError> for FunctionBody {
fn collect_errors(&self, errors: &mut Vec<ParseError>) -> bool {
let mut r = false;
@@ -291,6 +326,12 @@ impl CollectErrors<ParseError> for PrognExpression {
}
}
impl CollectErrors<ParseError> for ReturnExpression {
fn collect_errors(&self, errors: &mut Vec<ParseError>) -> bool {
self.expression.collect_errors(errors)
}
}
#[cfg(test)]
mod tests {
use std::rc::Rc;
@@ -41,6 +41,7 @@ pub enum Expression {
Loop(LoopExpression),
Progn(PrognExpression),
Vector(Rc<Vector>),
Return(ReturnExpression),
Break,
Continue,
}
@@ -119,6 +120,9 @@ impl Expression {
}
Value::Keyword(Keyword::Break) => Rc::new(Self::Break),
Value::Keyword(Keyword::Continue) => Rc::new(Self::Continue),
Value::Keyword(Keyword::Return) => {
Self::map_or(ReturnExpression::parse(cdr, value), Expression::Return)
}
_ => Self::map_or(CallExpression::parse(cons, value), Expression::Call),
}
}
@@ -149,6 +153,7 @@ impl CollectErrors<ParseError> for Expression {
Self::While(cloop) => cloop.collect_errors(errors),
Self::Loop(cloop) => cloop.collect_errors(errors),
Self::Progn(progn) => progn.collect_errors(errors),
Self::Return(return_) => return_.collect_errors(errors),
Self::Nil
| Self::Vector(_)
| Self::Break
+5 -1
View File
@@ -1,7 +1,7 @@
use std::{error::Error as StdError, fmt, io, rc::Rc};
use crate::{
compile::CompileError,
compile::{CompileError, syntax::ParseError},
vm::{
Value,
instruction::{Instruction, InstructionDecodeError},
@@ -33,6 +33,8 @@ pub struct ValueConversionError {
pub enum ReadError {
#[error("{0}")]
Lexical(nom::Err<nom::error::Error<String>, nom::error::Error<String>>),
#[error("{0:?}")]
Parse(Vec<ParseError>),
#[error("{0}")]
Io(io::Error),
}
@@ -90,6 +92,8 @@ pub enum MachineError {
LoadError(StringValue, Box<MachineErrorAt>),
#[error("{0}")]
Custom(Box<dyn StdError>),
#[error("code-raised error: {0}")]
Raised(String),
#[error("value conversion error: {0}")]
ValueConversion(#[from] ValueConversionError),
+87 -2
View File
@@ -9,6 +9,88 @@
`(if (not ,condition) (progn ,body-head ,@body))
)
(defmacro when-let (bindings &rest body)
"If expression evaluates to a trueish value, evaluates (let (binding expression) body...)"
(let (output nil binding-names nil)
(while bindings
(setq binding-names (cons (car bindings) binding-names))
(setq output (append output (list (car bindings) (cadr bindings))))
(setq bindings (cddr bindings))
)
(unless binding-names
(error "No bindings provided in the (when-let ...) form"))
`(let ,output
(if (and ,@binding-names)
,@body
)
)
)
)
; List functions
; TODO most of those could be ported to Rust for performance
; TODO tail recursion
(defun filter (f xs)
(cond
((nil? xs) nil)
((f (car xs)) (cons (car xs) (filter f (cdr xs))))
(&otherwise (filter f (cdr xs)))
)
)
(defun map (f xs)
(if (cons? xs)
(cons (f (car xs)) (map f (cdr xs)))
nil
)
)
(defun flatmap (f xs)
(let (ys nil)
(while (cons? xs)
(setq ys (append ys (f (car xs))))
(setq xs (cdr xs)))
ys))
(defun fold (f acc xs)
(while (cons? xs)
(setq acc (f acc (car xs)))
(setq xs (cdr xs)))
acc)
(defun reverse (xs)
(let (ys nil)
(while (cons? xs)
(setq ys (cons (car xs) ys))
(setq xs (cdr xs)))
ys))
(defun unzip (xs)
(flatmap identity xs))
; Logic functions
(defun or_ (forms)
(cond
((nil? forms) #F)
((nil? (cdr forms)) (car forms))
(&otherwise
(let (tmp (gensym))
`(let (,tmp ,(car forms))
(if ,tmp ,tmp ,(or_ (cdr forms)))
)
)
)
))
(defmacro or (&rest forms)
;; (or x y z) -> (cond (x x) (y y) (z z) (&otherwise #t))
(or_ forms))
(defun and_ (forms)
(cond
((nil? forms) #T)
((nil? (cdr forms)) (car forms))
(&otherwise `(if ,(car forms) ,(and_ (cdr forms))))
))
(defmacro and (&rest forms)
;; (and x y z) -> (if x (if y (if z z)))
(and_ forms)
)
; Result handling functions
(defun result/ok? (x)
"Returns #t if x is an ok"
@@ -52,19 +134,22 @@
(defmacro compile-debug (expression)
"Prints the input expression during macro expansion/compile time and evaluates the expression in runtime"
(print expression)
(eprint expression)
expression
)
(defmacro runtime-debug (expression)
"Prints the input expression and evaluates it in runtime"
`(progn
(print (quote ,expression))
(eprint (quote ,expression))
,expression
)
)
; Convenience list functions
(defun caar (x) "Alias for (car (car x))" (car (car x)))
(defun cadr (x) "Alias for (car (cdr x))" (car (cdr x)))
(defun cdar (x) "Alias for (cdr (car x))" (cdr (car x)))
(defun cddr (x) "Alias for (cdr (cdr x))" (cdr (cdr 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))))
-6
View File
@@ -44,9 +44,6 @@ primitive_enum! {
Le = 29,
Ne = 30,
Not = 31,
Negate = 32,
And = 33,
Or = 34,
// Branching
Branch = 40,
Jump = 41,
@@ -258,9 +255,6 @@ impl fmt::Display for Instruction {
Self::Le => "LE",
Self::Ne => "NE",
Self::Not => "NOT",
Self::Negate => "NEGATE",
Self::And => "AND",
Self::Or => "OR",
Self::Branch => "BRANCH",
Self::Jump => "JUMP",
Self::Call => "CALL",
+6 -30
View File
@@ -12,6 +12,7 @@ use crate::{
ValueConversionError,
},
read::{self, FileReader, ModuleReader},
util::Either,
vm::{
Value,
env::Environment,
@@ -134,31 +135,6 @@ impl Machine {
.ok_or(MachineError::UndefinedLocalReference)
}
// fn upvalue_slot(&mut self, id: LocalId) -> Result<&mut Value, MachineError> {
// let frame = self
// .call_stack
// .head()
// .ok_or(MachineError::CallStackUnderflow)?;
// let upvalue_arena_index = frame
// .closure
// .upvalues
// .get(usize::from(id))
// .copied()
// .ok_or(MachineError::UndefinedUpvalueReference)?;
// let upvalue_value = self
// .upvalue_arena
// .get_mut(upvalue_arena_index)
// .ok_or(MachineError::UndefinedUpvalueReference)?;
// match upvalue_value {
// UpvalueValue::Open(sp) => self
// .data_stack
// .get_mut(*sp)
// .ok_or(MachineError::UndefinedUpvalueReference),
// UpvalueValue::Closed(boxed) => Ok(boxed.as_mut()),
// }
// }
fn execute_get_local(&mut self, id: LocalId) -> Result<(), MachineError> {
let value = self.local_slot(id)?.clone();
self.push(value)
@@ -584,10 +560,7 @@ impl Machine {
| Instruction::Mul
| Instruction::Div
| Instruction::Mod
| Instruction::Not
| Instruction::And
| Instruction::Or
| Instruction::Negate => {
| Instruction::Not => {
let argument_count = usize::from(ArgumentCount::read_encoded(self)?);
let mut arguments = (0..argument_count)
.map(|_| self.pop())
@@ -772,7 +745,10 @@ impl Machine {
let module_reader = ModuleReader::new(reader, path, self.trace_macros);
let function = match module_reader.compile(Some(name.into()), &compile_options, env) {
Ok(function) => function,
Err(error) => todo!("Handle error: {error:?}"),
Err(Either::Left(error)) => return Err(error),
Err(Either::Right(syntax)) => {
return Err(MachineError::Read(ReadError::Parse(syntax)).at_unknown());
}
};
let closure = ClosureValue {
function,
@@ -243,6 +243,33 @@ pub fn load(env: &Rc<Environment>) {
Ok(value)
},
);
env.defun_native(
"hash/update!",
"Applies a v -> v' function to the value referencing the key",
|vm, env, args| {
let [function, table, key] = args else {
return Err(MachineError::InvalidArgumentCount);
};
let table: Rc<HashTable> = TryFromValue::try_from_value(table)?;
let function = AnyFunction::try_from_value(function)?;
let value = {
let mut borrow = table.borrow_mut();
match borrow.get_mut(key) {
Some(old_value) => {
let new_value = function.invoke(vm, env, slice::from_ref(old_value))?;
*old_value = new_value.clone();
new_value
}
None => {
let new_value = function.invoke(vm, env, &[Value::Nil])?;
borrow.insert(key.clone(), new_value.clone())?;
new_value
}
}
};
Ok(value)
},
);
env.defun_native(
"hash/remove!",
"Removes an association from the hashtable",
@@ -333,4 +360,15 @@ pub fn load(env: &Rc<Environment>) {
Ok(value)
},
);
env.defun_native(
"hash/has?",
"Returns #t if the hashtable contains the key",
|_, _, args| {
let [table, key] = args else {
return Err(MachineError::InvalidArgumentCount);
};
let table: Rc<HashTable> = TryFromValue::try_from_value(table)?;
Ok(table.borrow().contains_key(key).into())
},
);
}
+14
View File
@@ -173,4 +173,18 @@ pub fn load(env: &Rc<Environment>) {
Ok(Value::Nil)
},
);
env.defun_native("error", "Raises an error condition", |_, _, args| {
let mut message = String::new();
for (i, arg) in args.iter().enumerate() {
if i != 0 {
message.push(' ');
}
if let Value::String(string) = arg {
message.push_str(&format!("{}", *string));
} else {
message.push_str(&format!("{arg}"));
}
}
Err(MachineError::Raised(message))
});
}
@@ -9,29 +9,6 @@ use crate::{
};
pub fn load(env: &Rc<Environment>) {
// env.defun_native("map", |vm, env, args| {
// let [f, xs] = args else {
// return Err(vm.error_at_ip(MachineErrorKind::InvalidArgument));
// };
// let f = AnyFunction::try_from_value(f).map_err(|e| vm.error_at_ip(e))?;
// let xs = xs.proper_iter(vm.error_at_ip(MachineErrorKind::InvalidArgument));
// let out = Value::try_list_or_nil(xs.map(|v| f.invoke(vm, env, slice::from_ref(v?))))?;
// Ok(out)
// });
// env.defun_native("filter", |vm, env, args| {
// let [f, xs] = args else {
// return Err(vm.error_at_ip(MachineErrorKind::InvalidArgument));
// };
// let f = AnyFunction::try_from_value(f).map_err(|e| vm.error_at_ip(e))?;
// let xs = xs
// .proper_iter(vm.error_at_ip(MachineErrorKind::InvalidArgument))
// .map(|x| x.cloned());
// let out = Value::try_list_or_nil(xs.try_filter(|v| {
// let result = f.invoke(vm, env, slice::from_ref(v))?;
// Ok(bool::try_from_value(&result).unwrap_or_default())
// }))?;
// Ok(out)
// });
env.defun_native(
"apply",
"Applies the function to a given argument list",
+1 -49
View File
@@ -1,8 +1,4 @@
use std::{
cmp::Ordering,
ops::{BitAnd, BitOr, Mul},
rc::Rc,
};
use std::{cmp::Ordering, ops::Mul, rc::Rc};
use crate::{
error::MachineError,
@@ -31,8 +27,6 @@ pub(crate) fn dispatch_arithmetic(
Instruction::Eq => builtin_cmp_eq,
Instruction::Ne => builtin_cmp_ne,
Instruction::Not => builtin_not,
Instruction::And => builtin_and,
Instruction::Or => builtin_or,
_ => unreachable!(),
}
}
@@ -84,19 +78,6 @@ pub(super) fn load(env: &Rc<Environment>) {
);
env.set_global_value("", ne); // alias for /=
let and = env.defun_native(
"and",
"Returns #t if all of the arguments are trueish",
builtin_and,
);
env.set_global_value("&&", and);
let or = env.defun_native(
"or",
"Returns #t if any of the arguments is trueish",
builtin_or,
);
env.set_global_value("||", or);
// env.defun_native("&", builtin_bitwise_and);
// env.defun_native("|", builtin_bitwise_or);
// env.defun_native("^", builtin_bitwise_xor);
@@ -156,21 +137,6 @@ where
Ok(accumulator.into())
}
fn builtin_fold_trueish<F>(
fold: F,
mut accumulator: bool,
args: &[Value],
) -> Result<Value, MachineError>
where
F: Fn(bool, bool) -> bool,
{
for arg in args {
let arg = arg.is_trueish();
accumulator = fold(accumulator, arg);
}
Ok(accumulator.into())
}
pub(crate) fn builtin_add(
_vm: &mut Machine,
_env: &Rc<Environment>,
@@ -240,20 +206,6 @@ pub(crate) fn builtin_div(
}
}
pub(crate) fn builtin_and(
_vm: &mut Machine,
_env: &Rc<Environment>,
args: &[Value],
) -> Result<Value, MachineError> {
builtin_fold_trueish(BitAnd::bitand, true, args)
}
pub(crate) fn builtin_or(
_vm: &mut Machine,
_env: &Rc<Environment>,
args: &[Value],
) -> Result<Value, MachineError> {
builtin_fold_trueish(BitOr::bitor, false, args)
}
// pub(crate) fn builtin_and(
// vm: &mut Machine,
// _env: &Rc<Environment>,
+94 -1
View File
@@ -9,9 +9,70 @@ use crate::{
},
};
fn classify<F: Fn(char) -> bool>(args: &[Value], predicate: F) -> Result<Value, MachineError> {
let [string] = args else {
return Err(MachineError::InvalidArgumentCount);
};
let string = StringValue::try_from_value(string)?;
Ok(string.chars().all(predicate).into())
}
pub fn load(env: &Rc<Environment>) {
env.defun_native(
"split",
"string/trim",
"Trims leading and trailing whitespace from a string",
|_, _, args| {
let [string] = args else {
return Err(MachineError::InvalidArgumentCount);
};
let string = StringValue::try_from_value(string)?;
Ok(StringValue::from(string.trim()).into())
},
);
env.defun_native(
"string/pop",
"Removes the last character from the string",
|_, _, args| {
let [string] = args else {
return Err(MachineError::InvalidArgumentCount);
};
let mut string = (*StringValue::try_from_value(string)?).to_owned();
string.pop();
Ok(StringValue::from(string).into())
},
);
env.defun_native(
"string/strip-prefix",
"Removes the prefix from a string. Returns NIL if string does not start with the prefix",
|_, _, args| {
let [string, prefix] = args else {
return Err(MachineError::InvalidArgumentCount);
};
let string = StringValue::try_from_value(string)?;
let prefix = StringValue::try_from_value(prefix)?;
match string.strip_prefix(&*prefix) {
Some(string) => Ok(StringValue::from(string).into()),
None => Ok(Value::Nil),
}
},
);
env.defun_native(
"string/strip-suffix",
"Removes the suffix from a string. Returns NIL if string does not end with the suffix",
|_, _, args| {
let [string, suffix] = args else {
return Err(MachineError::InvalidArgumentCount);
};
let string = StringValue::try_from_value(string)?;
let suffix = StringValue::try_from_value(suffix)?;
match string.strip_suffix(&*suffix) {
Some(string) => Ok(StringValue::from(string).into()),
None => Ok(Value::Nil),
}
},
);
env.defun_native(
"string/split",
"Splits a string by given separator",
|_, _, args| {
let (separator, string) = match args {
@@ -27,4 +88,36 @@ pub fn load(env: &Rc<Environment>) {
Ok(items)
},
);
env.defun_native(
"string/length",
"Returns the length of the string",
|_, _, args| {
let [string] = args else {
return Err(MachineError::InvalidArgumentCount);
};
let string = StringValue::try_from_value(string)?;
Ok(string.len().into())
},
);
env.defun_native(
"string/alpha?",
"Returns #t if all the characters in the string are alphabetic",
|_, _, args| classify(args, char::is_alphabetic),
);
env.defun_native(
"string/digit?",
"Returns #t if all the characters in the string are digits (0-9)",
|_, _, args| classify(args, |ch| ch.is_ascii_digit()),
);
env.defun_native(
"string/ascii-graphic?",
"Returns #t if all the characters in the string are ASCII graphic (non-control)",
|_, _, args| classify(args, |ch| ch.is_ascii_graphic()),
);
env.defun_native(
"string/ascii?",
"Returns #t if all the characters in the string are ASCII",
|_, _, args| classify(args, |ch| ch.is_ascii()),
);
}
+21 -1
View File
@@ -1,4 +1,4 @@
use std::rc::Rc;
use std::{fmt, rc::Rc};
use crate::{
error::{MachineError, ValueConversionError},
@@ -215,6 +215,26 @@ impl AnyFunction {
}
}
impl From<AnyFunction> for Value {
fn from(value: AnyFunction) -> Self {
match value {
AnyFunction::Function(value) => Value::Function(value),
AnyFunction::Native(value) => Value::NativeFunction(value),
AnyFunction::Closure(value) => Value::Closure(value),
}
}
}
impl fmt::Display for AnyFunction {
fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
match self {
Self::Native(value) => fmt::Display::fmt(value, f),
Self::Closure(value) => fmt::Display::fmt(value, f),
Self::Function(value) => fmt::Display::fmt(value, f),
}
}
}
impl_integer!(
i8: 8,
i16: 16,
+1 -4
View File
@@ -173,10 +173,7 @@ impl BytecodeFunction {
| Instruction::Mul
| Instruction::Div
| Instruction::Mod
| Instruction::Negate
| Instruction::Not
| Instruction::And
| Instruction::Or => TraceArgument::Byte,
| Instruction::Not => TraceArgument::Byte,
// Function
Instruction::Call => TraceArgument::Byte,
Instruction::Return => TraceArgument::None,
@@ -111,6 +111,16 @@ impl HashTableData {
Ok(())
}
pub fn contains_key(&self, key: &Value) -> bool {
let Some(hash) = key.hash() else { return false };
let bucket_index = (hash % self.buckets.len() as u64) as usize;
self.buckets[bucket_index]
.iter()
.find(|(k, _)| k == key)
.is_some()
}
pub fn get(&self, key: &Value) -> Option<&Value> {
let hash = key.hash()?;
let bucket_index = (hash % self.buckets.len() as u64) as usize;
@@ -121,6 +131,16 @@ impl HashTableData {
.map(|(_, v)| v)
}
pub fn get_mut(&mut self, key: &Value) -> Option<&mut Value> {
let hash = key.hash()?;
let bucket_index = (hash % self.buckets.len() as u64) as usize;
self.buckets[bucket_index]
.iter_mut()
.find(|(k, _)| k == key)
.map(|(_, v)| v)
}
pub fn remove(&mut self, key: &Value) -> Option<Value> {
let hash = key.hash()?;
let bucket_index = (hash % self.buckets.len() as u64) as usize;
@@ -53,6 +53,7 @@ impl_keyword! {
Continue => "continue",
Declare => "declare",
Error => "&error",
Return => "return",
// Cons => "cons",
}
}