updates
ober
dd5345598122c571af1ee860beed97183e632a7d
--- a/Makefile +++ b/Makefile @@ -1839,7 +1839,7 @@ browser-repl-artifact: browser-repl-test '{' \ ' "schema_version": 1,' \ ' "abi_version": 1,' \ - ' "subset_revision": "browser-subset-120",' \ + ' "subset_revision": "browser-subset-137",' \ " \"jerboa_version\": \"$$version\"," \ " \"jerboa_commit\": \"$$commit\"," \ ' "rust_toolchain": "1.94.1",' \ --- a/browser-repl/src/lib.rs +++ b/browser-repl/src/lib.rs @@ -16,11 +16,189 @@ const MAX_TOP_LEVEL_EVALS: u32 = 256; const MAX_USER_BINDINGS: usize = 2_048; const MAX_STRING_BYTES: usize = 65_536; const MAX_LIST_TRAVERSAL: usize = 16_384; +const MAX_IN_NATURALS: usize = 1_024; const UNICODE_SCALAR_COUNT: i64 = 0x110000 - 0x800; const WASM_MEMORY_MAX_BYTES: usize = 33_554_432; -const SUBSET_REVISION: &str = "browser-subset-120"; +const SUBSET_REVISION: &str = "browser-subset-137"; const ENGINE_VERSION: &str = env!("CARGO_PKG_VERSION"); const BROWSER_RANDOM_SEED: u64 = 0x5eed_5eed_c0de_cafe; +const BROWSER_CORE_PRELUDE: &str = r#" +(def (constantly v) + (lambda args v)) + +(def (partial f . fixed) + (lambda rest + (apply f (append fixed rest)))) + +(def (curry f . fixed) + (lambda rest + (apply f (append fixed rest)))) + +(def (flip f) + (lambda (a b . rest) + (apply f b a rest))) + +(def (complement pred) + (lambda args + (not (apply pred args)))) + +(def negate complement) + +(def (compose . fs) + (lambda args + (if (null? fs) + (apply identity args) + (let ((rev (reverse fs))) + (let loop ((value (apply (car rev) args)) + (rest (cdr rev))) + (if (null? rest) + value + (loop ((car rest) value) (cdr rest)))))))) + +(def compose1 compose) +(def comp compose) + +(def (juxt . fs) + (lambda args + (let loop ((fs fs) (out '())) + (if (null? fs) + (reverse out) + (loop (cdr fs) (cons (apply (car fs) args) out)))))) + +(def (conjoin . preds) + (lambda args + (let loop ((preds preds)) + (if (null? preds) + #t + (if (apply (car preds) args) + (loop (cdr preds)) + #f))))) + +(def every-pred conjoin) + +(def (disjoin . preds) + (lambda args + (let loop ((preds preds)) + (if (null? preds) + #f + (let ((result (apply (car preds) args))) + (if result + result + (loop (cdr preds)))))))) + +(def some-fn disjoin) + +(def (fnil f . defaults) + (lambda args + (let loop ((xs args) (ds defaults) (out '())) + (cond + ((null? xs) (apply f (reverse out))) + ((null? ds) (apply f (append (reverse out) xs))) + (else + (loop (cdr xs) + (cdr ds) + (cons (if (car xs) (car xs) (car ds)) out))))))) + +(defstruct result-ok (value)) +(defstruct result-err (value)) + +(def (ok v) (make-result-ok v)) +(def (err e) (make-result-err e)) +(def (ok? r) (result-ok? r)) +(def (err? r) (result-err? r)) +(def (result? r) (or (ok? r) (err? r))) + +(def (unwrap r) + (if (ok? r) + (result-ok-value r) + (error 'unwrap "called unwrap on err" (result-err-value r)))) + +(def (unwrap-err r) + (if (err? r) + (result-err-value r) + (error 'unwrap-err "called unwrap-err on ok" (result-ok-value r)))) + +(def (unwrap-or r default) + (if (ok? r) (result-ok-value r) default)) + +(def (unwrap-or-else r thunk) + (if (ok? r) (result-ok-value r) (thunk))) + +(def (map-ok f r) + (if (ok? r) + (ok (f (result-ok-value r))) + r)) + +(def (map-err f r) + (if (err? r) + (err (f (result-err-value r))) + r)) + +(def (and-then r f) + (if (ok? r) + (f (result-ok-value r)) + r)) + +(def (or-else r f) + (if (err? r) + (f (result-err-value r)) + r)) + +(def (flatten-result r) + (if (and (ok? r) (result? (result-ok-value r))) + (result-ok-value r) + r)) + +(def (result->values r) + (if (ok? r) + (values (result-ok-value r) #f) + (values #f (result-err-value r)))) + +(def (result->option r) + (if (ok? r) (result-ok-value r) #f)) + +(def (results-partition results) + (let loop ((rest results) (oks '()) (errs '())) + (if (null? rest) + (cons (reverse oks) (reverse errs)) + (let ((r (car rest))) + (if (ok? r) + (loop (cdr rest) (cons (result-ok-value r) oks) errs) + (loop (cdr rest) oks (cons (result-err-value r) errs))))))) + +(def (map-results f lst) + (map f lst)) + +(def (filter-ok results) + (let loop ((rest results) (acc '())) + (if (null? rest) + (reverse acc) + (if (ok? (car rest)) + (loop (cdr rest) (cons (result-ok-value (car rest)) acc)) + (loop (cdr rest) acc))))) + +(def (filter-err results) + (let loop ((rest results) (acc '())) + (if (null? rest) + (reverse acc) + (if (err? (car rest)) + (loop (cdr rest) (cons (result-err-value (car rest)) acc)) + (loop (cdr rest) acc))))) + +(def (sequence-results results) + (let loop ((rest results) (acc '())) + (cond + ((null? rest) (ok (reverse acc))) + ((ok? (car rest)) + (loop (cdr rest) (cons (result-ok-value (car rest)) acc))) + (else (car rest))))) + +(def (ok->list r) + (if (ok? r) (list (result-ok-value r)) '())) + +(def (err->list r) + (if (err? r) (list (result-err-value r)) '())) +"#; thread_local! { static STATE: RefCell<State> = RefCell::new(State::new()); @@ -193,6 +371,9 @@ enum Value { StructPredicate(Rc<StructType>), StructAccessor(Rc<StructType>, usize), StructMutator(Rc<StructType>, usize), + RecordAlist(Rc<StructType>), + EnumPredicate(Rc<Vec<String>>), + EnumNameConverter(Rc<Vec<String>>), BoundMethod(Rc<BoundMethod>), InterfaceDescriptor(Rc<InterfaceDescriptor>), InterfaceInstance(Rc<InterfaceInstance>), @@ -212,6 +393,9 @@ enum Value { StdoutPort, ErrorObject(Rc<ErrorObject>), Parameter(Rc<Parameter>), + DateTime(DateTimeValue), + Duration(DurationValue), + Meta(Rc<MetaValue>), Values(Vec<Value>), Prim(fn(&[Value], &mut EvalContext) -> Result<Value, Error>), Closure(Rc<Closure>), @@ -241,6 +425,29 @@ struct TableObject { } #[derive(Clone, Copy, PartialEq, Eq)] +struct DateTimeValue { + year: i64, + month: i64, + day: i64, + hour: i64, + minute: i64, + second: i64, + nanosecond: i64, + offset: i64, +} + +#[derive(Clone, Copy, PartialEq, Eq)] +struct DurationValue { + seconds: i64, + nanoseconds: i64, +} + +struct MetaValue { + value: Value, + metadata: Value, +} + +#[derive(Clone, Copy, PartialEq, Eq)] enum HVectorKind { S8, U16, @@ -464,12 +671,15 @@ impl Session { fn new() -> Self { let prim = Frame::new(None, false); install_primitives(&prim); + let thread_locals = Rc::new(RefCell::new(Vec::new())); + let gensym_counter = Rc::new(Cell::new(0)); + install_browser_core_prelude(&prim, thread_locals.clone(), gensym_counter.clone()); prim.read_only_set(); Self { env: Frame::with_limit(Some(prim), false, Some(MAX_USER_BINDINGS)), top_level_evals: 0, - thread_locals: Rc::new(RefCell::new(Vec::new())), - gensym_counter: Rc::new(Cell::new(0)), + thread_locals, + gensym_counter, } } @@ -537,6 +747,32 @@ impl Session { } } +fn install_browser_core_prelude( + env: &Env, + thread_locals: Rc<RefCell<Vec<(Value, Value)>>>, + gensym_counter: Rc<Cell<u64>>, +) { + let forms = Reader::new(BROWSER_CORE_PRELUDE) + .read_all() + .expect("browser core prelude must parse"); + let mut cx = EvalContext { + steps_left: HARD_MAX_STEPS, + steps_used: 0, + depth: 0, + events: Vec::new(), + stdout: String::new(), + current_input: None, + current_output: None, + thread_locals, + gensym_counter, + }; + for form in forms { + if let Err(err) = eval(&form, env.clone(), &mut cx) { + panic!("browser core prelude failed: {}: {}", err.kind, err.message); + } + } +} + impl Frame { fn read_only_set(self: &Rc<Self>) { self.read_only.set(true); @@ -774,6 +1010,8 @@ fn eval_list(items: &[Expr], env: Env, cx: &mut EvalContext) -> Result<Value, Er "def*" => eval_def_star(items, env), "defstruct" => eval_defstruct(items, env), "defclass" => eval_defclass(items, env), + "defrecord" => eval_defrecord(items, env), + "define-enum" => eval_define_enum(items, env), "defmethod" => eval_defmethod(items, env, cx), "interface" => eval_interface(items, env), "set!" => { @@ -799,7 +1037,26 @@ fn eval_list(items: &[Expr], env: Env, cx: &mut EvalContext) -> Result<Value, Er "do-while" => eval_do_while(items, env, cx), "while" => eval_loop(&items[1..], env, cx, false), "until" => eval_loop(&items[1..], env, cx, true), + "dotimes" => eval_dotimes(items, env, cx), + "alist" => eval_alist(items, env, cx), + "let-alist" => eval_let_alist(items, env, cx), + "for" => eval_for(items, env, cx, ForMode::Each), + "for/collect" => eval_for(items, env, cx, ForMode::Collect), + "for/or" => eval_for(items, env, cx, ForMode::Or), + "for/and" => eval_for(items, env, cx, ForMode::And), + "for/fold" => eval_for_fold(items, env, cx), "try" => eval_try(&items[1..], env, cx), + "try-result" => eval_try_result(&items[1..], env, cx, false), + "try-result*" => eval_try_result(&items[1..], env, cx, true), + "->" => eval_threading(&items[1..], env, cx, ThreadingMode::First), + "->>" => eval_threading(&items[1..], env, cx, ThreadingMode::Last), + "some->" => eval_threading(&items[1..], env, cx, ThreadingMode::SomeFirst), + "some->>" => eval_threading(&items[1..], env, cx, ThreadingMode::SomeLast), + "cond->" => eval_cond_threading(&items[1..], env, cx, false), + "cond->>" => eval_cond_threading(&items[1..], env, cx, true), + "as->" => eval_as_threading(&items[1..], env, cx), + "->?" => eval_result_threading(&items[1..], env, cx, false), + "->>?" => eval_result_threading(&items[1..], env, cx, true), "unwind-protect" => eval_unwind_protect(&items[1..], env, cx), "parameterize" => eval_parameterize(items, env, cx), "match" => eval_match(items, env, cx), @@ -846,6 +1103,11 @@ fn eval_list(items: &[Expr], env: Env, cx: &mut EvalContext) -> Result<Value, Er Ok(Value::Void) } } + "when-let" => eval_when_let(items, env, cx), + "if-let" => eval_if_let(items, env, cx), + "awhen" => eval_awhen(items, env, cx), + "aif" => eval_aif(items, env, cx), + "when/list" => eval_when_list(items, env, cx), "import" => { if is_browser_subset_import(items) { Ok(Value::Void) @@ -986,6 +1248,389 @@ fn eval_sequence(body: &[Expr], env: Env, cx: &mut EvalContext) -> Result<Value, Ok(value) } +fn eval_when_let(items: &[Expr], env: Env, cx: &mut EvalContext) -> Result<Value, Error> { + if items.len() < 3 { + return Err(Error::eval("when-let needs binding and body")); + } + let (name, value_expr) = parse_conditional_binding(&items[1], "when-let")?; + let value = eval(value_expr, env.clone(), cx)?; + if truthy(&value) { + let child = Frame::new(Some(env), false); + child.define(name.to_owned(), value)?; + eval_sequence(&items[2..], child, cx) + } else { + Ok(Value::Void) + } +} + +fn eval_if_let(items: &[Expr], env: Env, cx: &mut EvalContext) -> Result<Value, Error> { + if items.len() != 4 { + return Err(Error::eval("if-let needs binding, then, and else")); + } + let (name, value_expr) = parse_conditional_binding(&items[1], "if-let")?; + let value = eval(value_expr, env.clone(), cx)?; + if truthy(&value) { + let child = Frame::new(Some(env), false); + child.define(name.to_owned(), value)?; + eval(&items[2], child, cx) + } else { + eval(&items[3], env, cx) + } +} + +fn eval_awhen(items: &[Expr], env: Env, cx: &mut EvalContext) -> Result<Value, Error> { + if items.len() < 3 { + return Err(Error::eval("awhen needs test and body")); + } + let value = eval(&items[1], env.clone(), cx)?; + if truthy(&value) { + let child = Frame::new(Some(env), false); + child.define("it".to_owned(), value)?; + eval_sequence(&items[2..], child, cx) + } else { + Ok(Value::Void) + } +} + +fn eval_aif(items: &[Expr], env: Env, cx: &mut EvalContext) -> Result<Value, Error> { + if items.len() != 4 { + return Err(Error::eval("aif needs test, then, and else")); + } + let value = eval(&items[1], env.clone(), cx)?; + if truthy(&value) { + let child = Frame::new(Some(env), false); + child.define("it".to_owned(), value)?; + eval(&items[2], child, cx) + } else { + eval(&items[3], env, cx) + } +} + +fn eval_when_list(items: &[Expr], env: Env, cx: &mut EvalContext) -> Result<Value, Error> { + if items.len() < 3 { + return Err(Error::eval("when/list needs test and body")); + } + if !truthy(&eval(&items[1], env.clone(), cx)?) { + return Ok(Value::Nil); + } + let mut values = Vec::with_capacity(items.len() - 2); + for expr in &items[2..] { + values.push(eval(expr, env.clone(), cx)?); + } + Ok(vec_to_list(&values)) +} + +fn parse_conditional_binding<'a>(expr: &'a Expr, name: &str) -> Result<(&'a str, &'a Expr), Error> { + match expr { + Expr::List(parts) | Expr::BracketList(parts) if parts.len() == 2 => { + Ok((expect_symbol(&parts[0], name)?, &parts[1])) + } + _ => Err(Error::eval(format!("{name} binding must be (name expr)"))), + } +} + +#[derive(Clone, Copy)] +enum ForMode { + Each, + Collect, + Or, + And, +} + +struct ForBinding { + name: String, + values: Vec<Value>, +} + +fn eval_for(items: &[Expr], env: Env, cx: &mut EvalContext, mode: ForMode) -> Result<Value, Error> { + if items.len() < 3 { + return Err(Error::eval("for form needs bindings and body")); + } + let bindings = parse_for_bindings(&items[1], env.clone(), cx)?; + let limit = bindings + .iter() + .map(|binding| binding.values.len()) + .min() + .unwrap_or(0); + let mut collected = Vec::new(); + let mut last_and = Value::Bool(true); + for idx in 0..limit { + cx.step()?; + let child = Frame::new(Some(env.clone()), false); + for binding in &bindings { + child.define(binding.name.clone(), binding.values[idx].clone())?; + } + let value = eval_sequence(&items[2..], child, cx)?; + match mode { + ForMode::Each => {} + ForMode::Collect => collected.push(value), + ForMode::Or => { + if truthy(&value) { + return Ok(value); + } + } + ForMode::And => { + if !truthy(&value) { + return Ok(Value::Bool(false)); + } + last_and = value; + } + } + } + match mode { + ForMode::Each => Ok(Value::Void), + ForMode::Collect => Ok(vec_to_list(&collected)), + ForMode::Or => Ok(Value::Bool(false)), + ForMode::And => Ok(last_and), + } +} + +fn eval_for_fold(items: &[Expr], env: Env, cx: &mut EvalContext) -> Result<Value, Error> { + if items.len() < 4 { + return Err(Error::eval( + "for/fold needs accumulators, bindings, and body", + )); + } + let accum_specs = parse_for_accumulators(&items[1])?; + let mut accum_names = Vec::with_capacity(accum_specs.len()); + let mut accum_values = Vec::with_capacity(accum_specs.len()); + for (name, expr) in accum_specs { + accum_names.push(name.to_owned()); + accum_values.push(eval(expr, env.clone(), cx)?); + } + let bindings = parse_for_bindings(&items[2], env.clone(), cx)?; + let limit = bindings + .iter() + .map(|binding| binding.values.len()) + .min() + .unwrap_or(0); + for idx in 0..limit { + cx.step()?; + let child = Frame::new(Some(env.clone()), false); + for (name, value) in accum_names.iter().zip(accum_values.iter()) { + child.define(name.clone(), value.clone())?; + } + for binding in &bindings { + child.define(binding.name.clone(), binding.values[idx].clone())?; + } + let next = eval_sequence(&items[3..], child, cx)?; + accum_values = match (accum_names.len(), next) { + (1, value) => vec![value], + (expected, Value::Values(values)) if values.len() == expected => values, + (expected, _) => { + return Err(Error::eval(format!( + "for/fold body returned wrong accumulator count: expected {expected}" + ))) + } + }; + } + if accum_values.len() == 1 { + Ok(accum_values.remove(0)) + } else { + Ok(Value::Values(accum_values)) + } +} + +fn parse_for_bindings( + expr: &Expr, + env: Env, + cx: &mut EvalContext, +) -> Result<Vec<ForBinding>, Error> { + let bindings = match expr { + Expr::List(bindings) | Expr::BracketList(bindings) => bindings, + _ => return Err(Error::eval("for bindings must be a list")), + }; + let mut out = Vec::with_capacity(bindings.len()); + let mut seen = BTreeSet::new(); + for binding in bindings { + let parts = match binding { + Expr::List(parts) | Expr::BracketList(parts) if parts.len() == 2 => parts, + _ => return Err(Error::eval("for binding must be (name iterable)")), + }; + let name = expect_symbol(&parts[0], "for binding")?.to_owned(); + if !seen.insert(name.clone()) { + return Err(Error::eval("duplicate for binding")); + } + let value = eval(&parts[1], env.clone(), cx)?; + out.push(ForBinding { + name, + values: iterable_to_vec(&value, "for binding")?, + }); + } + Ok(out) +} + +fn parse_for_accumulators(expr: &Expr) -> Result<Vec<(&str, &Expr)>, Error> { + let specs = match expr { + Expr::List(specs) | Expr::BracketList(specs) => specs, + _ => return Err(Error::eval("for/fold accumulators must be a list")), + }; + let mut out = Vec::with_capacity(specs.len()); + let mut seen = BTreeSet::new(); + for spec in specs { + let parts = match spec { + Expr::List(parts) | Expr::BracketList(parts) if parts.len() == 2 => parts, + _ => return Err(Error::eval("for/fold accumulator must be (name init)")), + }; + let name = expect_symbol(&parts[0], "for/fold accumulator")?; + if !seen.insert(name.to_owned()) { + return Err(Error::eval("duplicate for/fold accumulator")); + } + out.push((name, &parts[1])); + } + Ok(out) +} + +#[derive(Clone, Copy)] +enum ThreadingMode { + First, + Last, + SomeFirst, + SomeLast, +} + +impl ThreadingMode { + fn insert_last(self) -> bool { + matches!(self, ThreadingMode::Last | ThreadingMode::SomeLast) + } + + fn short_circuit_false(self) -> bool { + matches!(self, ThreadingMode::SomeFirst | ThreadingMode::SomeLast) + } +} + +fn eval_threading( + items: &[Expr], + env: Env, + cx: &mut EvalContext, + mode: ThreadingMode, +) -> Result<Value, Error> { + if items.is_empty() { + return Err(Error::eval("threading form needs an initial expression")); + } + let mut value = eval(&items[0], env.clone(), cx)?; + for step in &items[1..] { + if mode.short_circuit_false() && matches!(value, Value::Bool(false)) { + return Ok(Value::Bool(false)); + } + value = apply_thread_step(value, step, env.clone(), cx, mode.insert_last())?; + } + Ok(value) +} + +fn eval_cond_threading( + items: &[Expr], + env: Env, + cx: &mut EvalContext, + insert_last: bool, +) -> Result<Value, Error> { + if items.is_empty() { + return Err(Error::eval( + "cond threading form needs an initial expression", + )); + } + if items[1..].len() % 2 != 0 { + return Err(Error::eval("cond threading form needs test/step pairs")); + } + let mut value = eval(&items[0], env.clone(), cx)?; + for pair in items[1..].chunks(2) { + if truthy(&eval(&pair[0], env.clone(), cx)?) { + value = apply_thread_step(value, &pair[1], env.clone(), cx, insert_last)?; + } + } + Ok(value) +} + +fn eval_as_threading(items: &[Expr], env: Env, cx: &mut EvalContext) -> Result<Value, Error> { + if items.len() < 2 { + return Err(Error::eval("as-> needs an expression and binding name")); + } + let name = expect_symbol(&items[1], "as-> binding")?.to_owned(); + let mut value = eval(&items[0], env.clone(), cx)?; + for step in &items[2..] { + let child = Frame::new(Some(env.clone()), false); + child.define(name.clone(), value)?; + value = eval(step, child, cx)?; + } + Ok(value) +} + +fn eval_result_threading( + items: &[Expr], + env: Env, + cx: &mut EvalContext, + insert_last: bool, +) -> Result<Value, Error> { + if items.is_empty() { + return Err(Error::eval( + "result threading form needs an initial expression", + )); + } + let mut result = eval(&items[0], env.clone(), cx)?; + for step in &items[1..] { + match result_value(&result) { + Some((true, inner)) => { + let value = apply_thread_step(inner, step, env.clone(), cx, insert_last)?; + result = make_result("ok", value, env.clone(), cx)?; + } + Some((false, _)) => return Ok(result), + None => return Err(Error::eval("result threading form needs a result value")), + } + } + Ok(result) +} + +fn apply_thread_step( + value: Value, + step: &Expr, + env: Env, + cx: &mut EvalContext, + insert_last: bool, +) -> Result<Value, Error> { + match step { + Expr::Symbol(_) => { + let proc = eval(step, env, cx)?; + apply(&proc, &[value], cx) + } + Expr::List(parts) | Expr::BracketList(parts) => { + if parts.is_empty() { + return Err(Error::eval("threading step cannot be empty")); + } + let proc = eval(&parts[0], env.clone(), cx)?; + let mut args = parts[1..] + .iter() + .map(|expr| eval(expr, env.clone(), cx)) + .collect::<Result<Vec<_>, _>>()?; + if insert_last { + args.push(value); + } else { + args.insert(0, value); + } + apply(&proc, &args, cx) + } + _ => { + let proc = eval(step, env, cx)?; + apply(&proc, &[value], cx) + } + } +} + +fn result_value(value: &Value) -> Option<(bool, Value)> { + let Value::StructInstance(instance) = value else { + return None; + }; + let ok = instance.typ.name == "result-ok"; + if !ok && instance.typ.name != "result-err" { + return None; + } + instance + .fields + .borrow() + .first() + .cloned() + .map(|value| (ok, value)) +} + fn eval_define(items: &[Expr], env: Env, cx: &mut EvalContext) -> Result<Value, Error> { if items.len() < 3 { return Err(Error::eval("def needs name and value or function body")); @@ -1185,12 +1830,49 @@ fn eval_defclass(items: &[Expr], env: Env) -> Result<Value, Error> { eval_define_struct_type(items, env, true, "defclass") } +fn eval_defrecord(items: &[Expr], env: Env) -> Result<Value, Error> { + let typ = define_struct_type(items, env.clone(), false, "defrecord")?; + env.define(format!("{}->alist", typ.name), Value::RecordAlist(typ))?; + Ok(Value::Void) +} + +fn eval_define_enum(items: &[Expr], env: Env) -> Result<Value, Error> { + if items.len() != 3 { + return Err(Error::eval("define-enum needs name and variants")); + } + let name = expect_symbol(&items[1], "define-enum")?.to_owned(); + let variants = match &items[2] { + Expr::List(variants) | Expr::BracketList(variants) => variants + .iter() + .map(|variant| expect_symbol(variant, "define-enum variant").map(str::to_owned)) + .collect::<Result<Vec<_>, _>>()?, + _ => return Err(Error::eval("define-enum variants must be a list")), + }; + reject_duplicate_names(&variants, "define-enum variant")?; + let variants = Rc::new(variants); + for (idx, variant) in variants.iter().enumerate() { + env.define(format!("{name}-{variant}"), Value::Int(idx as i64))?; + } + env.define(format!("{name}?"), Value::EnumPredicate(variants.clone()))?; + env.define(format!("{name}->name"), Value::EnumNameConverter(variants))?; + Ok(Value::Void) +} + fn eval_define_struct_type( items: &[Expr], env: Env, keyword_constructor: bool, form: &str, ) -> Result<Value, Error> { + define_struct_type(items, env, keyword_constructor, form).map(|_| Value::Void) +} + +fn define_struct_type( + items: &[Expr], + env: Env, + keyword_constructor: bool, + form: &str, +) -> Result<Rc<StructType>, Error> { if items.len() < 3 { return Err(Error::eval(format!("{form} needs name and field list"))); } @@ -1229,7 +1911,7 @@ fn eval_define_struct_type( Value::StructMutator(typ.clone(), idx), )?; } - Ok(Value::Void) + Ok(typ) } fn eval_defmethod(items: &[Expr], env: Env, cx: &mut EvalContext) -> Result<Value, Error> { @@ -2210,6 +2892,64 @@ fn eval_loop(items: &[Expr], env: Env, cx: &mut EvalContext, until: bool) -> Res } } +fn eval_dotimes(items: &[Expr], env: Env, cx: &mut EvalContext) -> Result<Value, Error> { + if items.len() < 3 { + return Err(Error::eval("dotimes needs binding and body")); + } + let binding = match &items[1] { + Expr::List(parts) | Expr::BracketList(parts) if parts.len() == 2 => parts, + _ => return Err(Error::eval("dotimes binding must be (name count)")), + }; + let name = expect_symbol(&binding[0], "dotimes binding")?.to_owned(); + let count = expect_int(&eval(&binding[1], env.clone(), cx)?, "dotimes")?; + if count <= 0 { + return Ok(Value::Void); + } + if count as usize > MAX_LIST_TRAVERSAL { + return Err(Error::limit("dotimes exceeds browser traversal limit")); + } + for idx in 0..count { + cx.step()?; + let child = Frame::new(Some(env.clone()), false); + child.define(name.clone(), Value::Int(idx))?; + eval_sequence(&items[2..], child, cx)?; + } + Ok(Value::Void) +} + +fn eval_alist(items: &[Expr], env: Env, cx: &mut EvalContext) -> Result<Value, Error> { + let mut pairs = Vec::with_capacity(items.len().saturating_sub(1)); + for entry in &items[1..] { + let parts = match entry { + Expr::List(parts) | Expr::BracketList(parts) if parts.len() == 2 => parts, + _ => return Err(Error::eval("alist entry must be (key value)")), + }; + let key = Value::Symbol(expect_symbol(&parts[0], "alist key")?.to_owned()); + let value = eval(&parts[1], env.clone(), cx)?; + pairs.push(make_pair(key, value)); + } + Ok(vec_to_list(&pairs)) +} + +fn eval_let_alist(items: &[Expr], env: Env, cx: &mut EvalContext) -> Result<Value, Error> { + if items.len() < 4 { + return Err(Error::eval("let-alist needs alist, names, and body")); + } + let alist = eval(&items[1], env.clone(), cx)?; + let names = match &items[2] { + Expr::List(names) | Expr::BracketList(names) => names, + _ => return Err(Error::eval("let-alist names must be a list")), + }; + let child = Frame::new(Some(env), false); + for name_expr in names { + let name = expect_symbol(name_expr, "let-alist name")?; + let key = Value::Symbol(name.to_owned()); + let value = alist_get(&key, &alist, value_eq, Value::Bool(false))?; + child.define(name.to_owned(), value)?; + } + eval_sequence(&items[3..], child, cx) +} + fn eval_try(items: &[Expr], env: Env, cx: &mut EvalContext) -> Result<Value, Error> { if items.is_empty() { return Err(Error::eval("try needs body")); @@ -2249,13 +2989,42 @@ fn eval_try(items: &[Expr], env: Env, cx: &mut EvalContext) -> Result<Value, Err eval_finally(result, finally, env, cx) } -fn is_try_clause(expr: &Expr) -> bool { - matches!( - expr, - Expr::List(parts) | Expr::BracketList(parts) - if matches!(parts.first(), Some(Expr::Symbol(head)) if head == "catch" || head == "finally") - ) -} +fn eval_try_result( + items: &[Expr], + env: Env, + cx: &mut EvalContext, + message_only: bool, +) -> Result<Value, Error> { + if items.len() != 1 { + return Err(Error::eval("try-result needs exactly one body expression")); + } + match eval(&items[0], env.clone(), cx) { + Ok(value) => make_result("ok", value, env, cx), + Err(error) => { + let payload = if message_only { + make_string(error.message) + } else { + error_to_value(error, Vec::new()) + }; + make_result("err", payload, env, cx) + } + } +} + +fn make_result(kind: &str, value: Value, env: Env, cx: &mut EvalContext) -> Result<Value, Error> { + let ctor = env + .get(kind) + .ok_or_else(|| Error::eval(format!("result constructor `{kind}` is not installed")))?; + apply(&ctor, &[value], cx) +} + +fn is_try_clause(expr: &Expr) -> bool { + matches!( + expr, + Expr::List(parts) | Expr::BracketList(parts) + if matches!(parts.first(), Some(Expr::Symbol(head)) if head == "catch" || head == "finally") + ) +} struct CatchClause { predicate: Option<Expr>, @@ -2428,6 +3197,39 @@ fn apply(op: &Value, args: &[Value], cx: &mut EvalContext) -> Result<Value, Erro instance.fields.borrow_mut()[*idx] = args[1].clone(); Ok(Value::Void) } + Value::RecordAlist(typ) => { + if args.len() != 1 { + return Err(Error::eval("record->alist helper needs 1 arg")); + } + let instance = expect_struct_instance(&args[0], typ, "record->alist helper")?; + let fields = instance.fields.borrow(); + let entries = typ + .fields + .iter() + .zip(fields.iter()) + .map(|(field, value)| (Value::Symbol(field.clone()), value.clone())) + .collect::<Vec<_>>(); + Ok(entries_to_alist(entries)) + } + Value::EnumPredicate(variants) => { + if args.len() != 1 { + return Err(Error::eval("enum predicate needs 1 arg")); + } + match &args[0] { + Value::Int(idx) => Ok(Value::Bool(*idx >= 0 && (*idx as usize) < variants.len())), + _ => Ok(Value::Bool(false)), + } + } + Value::EnumNameConverter(variants) => { + if args.len() != 1 { + return Err(Error::eval("enum name converter needs 1 arg")); + } + let idx = expect_int(&args[0], "enum name converter")?; + let Some(name) = usize::try_from(idx).ok().and_then(|idx| variants.get(idx)) else { + return Err(Error::eval("enum value out of range")); + }; + Ok(Value::Symbol(name.clone())) + } Value::BoundMethod(method) => { let mut method_args = Vec::with_capacity(args.len() + 1); method_args.push(method.object.clone()); @@ -3420,14 +4222,75 @@ fn install_primitives(env: &Env) { prim!("take-right", prim_take_right); prim!("drop-right", prim_drop_right); prim!("drop-right!", prim_drop_right); + prim!("take-last", prim_take_last); + prim!("drop-last", prim_drop_last); prim!("split-at", prim_split_at); + prim!("append1", prim_append1); + prim!("snoc", prim_append1); prim!("xcons", prim_xcons); prim!("iota", prim_iota); + prim!("in-range", prim_in_range); + prim!("in-list", prim_in_list); + prim!("in-vector", prim_in_vector); + prim!("in-string", prim_in_string); + prim!("in-bytes", prim_in_bytes); + prim!("in-chars", prim_in_chars); + prim!("in-lines", prim_in_lines); + prim!("in-port", prim_in_port); + prim!("in-producer", prim_in_producer); + prim!("in-naturals", prim_in_naturals); + prim!("in-indexed", prim_in_indexed); + prim!("in-hash-keys", prim_in_hash_keys); + prim!("in-hash-values", prim_in_hash_values); + prim!("in-hash-pairs", prim_in_hash_pairs); prim!("map", prim_map); prim!("for-each", prim_for_each); prim!("filter", prim_filter); prim!("filter!", prim_filter); prim!("filter-map", prim_filter_map); + prim!("append-map", prim_append_map); + prim!("mapcat", prim_append_map); + prim!("keep", prim_keep); + prim!("take-while", prim_take_while); + prim!("drop-while", prim_drop_while); + prim!("take-until", prim_take_until); + prim!("drop-until", prim_drop_until); + prim!("butlast", prim_butlast); + prim!("flatten", prim_flatten); + prim!("flatten1", prim_flatten1); + prim!("distinct", prim_delete_duplicates); + prim!("unique", prim_delete_duplicates); + prim!("duplicates", prim_duplicates); + prim!("interpose", prim_interpose);