diff --git a/TODO.md b/TODO.md index 5f593ffcd..bab856961 100644 --- a/TODO.md +++ b/TODO.md @@ -112,7 +112,7 @@ Implementation roadmap for a Rust-hosted Clojure dialect. Native file extension - [ ] `derive` / full `isa?` hierarchy - [x] `defrecord` — backed by `TypeInstance` (type_tag + MapValue fields); generates `->Name` and `map->Name` constructors; supports inline protocol impls - [x] `reify` — creates a unique-tagged `TypeInstance`; supports inline protocol impls -- [ ] `deftype` — blocked by `.` interop (field access via `(.field obj)` not yet implemented; Phase 9); mutable fields require `set!`-on-field semantic that needs interop dot special form; low priority until Phase 9 +- [x] `deftype` — positional `->Name` constructor, inline protocol impls with fields in scope, `.-field` access, and mutable fields (`^:unsynchronized-mutable` / `^:volatile-mutable`) written with `set!` (bare-symbol form inside a method and `(set! (.-field inst) v)` outside); no `map->Name` constructor, matching Clojure. Host-class method calls on an instance still await `.` interop (Phase 9) --- diff --git a/crates/cljrs-compiler/src/rt_abi.rs b/crates/cljrs-compiler/src/rt_abi.rs index 109bb87d7..fa2dc9a0a 100644 --- a/crates/cljrs-compiler/src/rt_abi.rs +++ b/crates/cljrs-compiler/src/rt_abi.rs @@ -1823,6 +1823,7 @@ pub unsafe extern "C" fn rt_assoc( Value::TypeInstance(alloc_inner_coll(TypeInstance { type_tag: ti.get().type_tag.clone(), fields, + mutable: ti.get().mutable.clone(), })), meta, )) diff --git a/crates/cljrs-ir/README.md b/crates/cljrs-ir/README.md index 3e72784c3..dd49d6158 100644 --- a/crates/cljrs-ir/README.md +++ b/crates/cljrs-ir/README.md @@ -159,6 +159,14 @@ form. Interpreter-only special forms with no IR equivalent (`defprotocol`, them as generic calls would resolve their clojure.core stub vars, which return nil and silently corrupt the promoted function. +`set!` lowers to `SetBang` only for a global var target. A `deftype` mutable +field write — `(set! (.-field inst) v)`, or the bare `(set! field v)` inside a +method body, where the field is bound as a `let*` local — is likewise +**rejected**, because the `LoadVar`/`SetBang` pair would target a global var +of that name rather than the instance's interior-mutable cell: the write would +be lost and a stray var defined. The method tree-walks instead, where +`eval_set_bang` updates the cell. + `Const`, `LoadLocal`, `LoadGlobal`, `LoadVar`, `AllocVector`, `AllocMap`, `AllocSet`, `AllocList`, `AllocCons`, `AllocClosure`, `CallKnown`, `Call`, `CallDirect`, `Deref`, `DefVar`, `SetBang`, `Throw`, `Phi`, `Recur`, diff --git a/crates/cljrs-ir/src/lower/anf.rs b/crates/cljrs-ir/src/lower/anf.rs index 5fec6cebc..44f9d49bf 100644 --- a/crates/cljrs-ir/src/lower/anf.rs +++ b/crates/cljrs-ir/src/lower/anf.rs @@ -2176,10 +2176,22 @@ fn lower_set_bang(ctx: &mut LowerCtx, args: &[Form]) -> R { )); } let FormKind::Symbol(sym_str) = &args[0].kind else { - return Err(LowerError::MalformedSpecialForm( - "set! target must be a symbol".into(), + // A non-symbol target, e.g. `(set! (.-field inst) v)` — a deftype + // mutable-field write. The IR var-store path cannot express it; decline + // to lower so the method tree-walks (eval_set_bang handles it). + return Err(LowerError::UnsupportedForm( + "set! on a non-symbol target (deftype mutable field)".into(), )); }; + // A set! whose target is a LOCAL binding is a deftype mutable-field write + // (the field is bound as a let* local in the synthesized method body). The + // var-store path would silently target a global var; decline to lower so + // the method tree-walks, where eval_set_bang updates the interior cell. + if ctx.lookup_local(sym_str).is_some() { + return Err(LowerError::UnsupportedForm( + "set! on a local binding (deftype mutable field)".into(), + )); + } let (var_ns, var_name) = split_sym(sym_str, ctx.ns()); let var_dst = ctx.fresh_var(); ctx.emit(Inst::LoadVar(var_dst, var_ns, var_name)); diff --git a/crates/cljrs-runtime/README.md b/crates/cljrs-runtime/README.md index e7fa16277..12ad98a45 100644 --- a/crates/cljrs-runtime/README.md +++ b/crates/cljrs-runtime/README.md @@ -116,6 +116,11 @@ tests/ declare_macro.rs, doc.rs, gas_meter.rs, into_seq_target.rs, map_entry.rs, defrecord_method_fields.rs — defrecord fields in scope in an inline protocol method body; params shadow them + deftype_types.rs — deftype: positional ctor, `.-field`, protocol + impls, and mutable fields written with `set!` + qualified_protocol_impl.rs — a qualified protocol name in an impl position + (defrecord/deftype/reify/extend-*) resolves + through its own namespace named_fn_identity.rs, ns_metadata.rs, partition_arities.rs, shared_atom.rs, symbolic_nan.rs, threading_macros.rs, auto_gensym.rs, auto_keyword_macro.rs, assoc_in_metadata.rs, empty_metadata.rs, into_metadata.rs, vec_metadata.rs, @@ -123,6 +128,10 @@ tests/ auto_resolution_properties.rs — tree-walker behavior gas_meter_ir.rs, versioned_ir.rs, partition_ir.rs, destructure_lowering.rs, osr_transfer.rs, region_phi_uaf.rs — tiered behavior + deftype_mutable_tiered.rs — deftype mutable-field writes under forced + eager IR lowering: the lowerer must decline + a `set!` on a local (own binary — it flips + the process-wide eager-lowering switch) ``` --- @@ -964,7 +973,7 @@ implement sentinel operations without hitting the stub errors registered in | `eval_eval(args, env)` | `eval` — convert a form value back to a `Form` and evaluate it at top level of the current namespace (vars visible, caller's locals not) | | `eval_with_bindings_star(args, env)` | `with-bindings*` — push binding frame, call f | | `eval_send_to_agent(args, env)` | `send` / `send-off` — dispatch action to agent | -| `dispatch_method(method, target, args)` | `(.method target args…)` — interop method dispatch on an evaluated target (strings, vectors, seqs) | +| `dispatch_method(method, target, args)` | `(.method target args…)` — interop method dispatch on an evaluated target (strings, vectors, seqs); on a `TypeInstance` only `.-field` reads are supported (mutable cell first, then the field map) | `make_lazy_seq_from_fn(f, globals, ns)` (already public) creates a `LazySeq` from a zero-arg callable; the above `make_delay_from_fn` is the analogous @@ -981,6 +990,20 @@ conditional in ANY slot of an `ns` require spec, namespace included, so `[#?(:clj clojure.core :cljs cljs.core) :as core]` reads — an option selecting no branch is dropped, a namespace selecting none is an error. +`deftype` and `defrecord` share `parse_field_specs` (field name + mutability, +metadata-transparent), `build_positional_ctor` (`->Name`, routed to the +`make-type-instance-mut` builtin when the type declares mutable fields) and +`intern_type_symbol` (so `(instance? Name x)` resolves); only `defrecord` also +gets `build_map_ctor`. `synth_field_scope` wraps a method body in a `let*` +binding each field a param does not shadow — a mutable field through +`(.-field this)` (the live cell) and an immutable one through `(:field this)` — +plus a hidden `__deftype_self__` handle when any field is mutable, which is how +`eval_set_bang` finds the instance whose cell a bare `(set! field v)` updates. +`resolve_protocol_sym` resolves a protocol named in an impl position +(`extend-type`, `extend-protocol`, `reify`/`defrecord`/`deftype`) through the +current ns's `:require :as` aliases and through its own namespace when +qualified — not as a literal intern of the current ns. + --- ## Module `tiered` diff --git a/crates/cljrs-runtime/src/builtins/builtins.rs b/crates/cljrs-runtime/src/builtins/builtins.rs index 3d34939bc..dfd08278f 100644 --- a/crates/cljrs-runtime/src/builtins/builtins.rs +++ b/crates/cljrs-runtime/src/builtins/builtins.rs @@ -1555,6 +1555,11 @@ pub fn register_all(globals: &Arc, ns: &str) { Arity::Fixed(2), builtin_make_type_instance, ), + ( + "make-type-instance-mut", + Arity::Fixed(3), + builtin_make_type_instance_mut, + ), ("record?", Arity::Fixed(1), builtin_record_q), ("instance?", Arity::Fixed(2), builtin_instance_q), // Native objects (Phase 9 interop) @@ -3642,6 +3647,7 @@ fn builtin_assoc(args: &[Value]) -> ValueResult { return Ok(apply_meta(Value::TypeInstance(GcPtr::new(TypeInstance { type_tag: ti.get().type_tag.clone(), fields, + mutable: ti.get().mutable.clone(), })))); } let mut result = match coll { @@ -5610,6 +5616,7 @@ fn assoc_in_impl(m: Value, keys: &[Value], val: Value) -> ValueResult { Value::TypeInstance(ti) => Value::TypeInstance(GcPtr::new(TypeInstance { type_tag: ti.get().type_tag.clone(), fields: ti.get().fields.assoc(k.clone(), updated), + mutable: ti.get().mutable.clone(), })), _ => Value::Map(MapValue::empty().assoc(k.clone(), updated)), }; @@ -8229,6 +8236,51 @@ fn builtin_make_type_instance(args: &[Value]) -> ValueResult { Ok(Value::TypeInstance(GcPtr::new(TypeInstance { type_tag, fields, + mutable: None, + }))) +} + +/// `(make-type-instance-mut type-tag immutable-map mutable-map)` — like +/// `make-type-instance`, but the keys in `mutable-map` become interior-mutable +/// slots (an `Atom` cell) that `set!` can update in place. Used by the `deftype` +/// positional constructor when the type declares `^:unsynchronized-mutable` or +/// `^:volatile-mutable` fields. +fn builtin_make_type_instance_mut(args: &[Value]) -> ValueResult { + let type_tag = match &args[0] { + Value::Str(s) => Arc::from(s.get().as_str()), + Value::Symbol(s) => Arc::from(s.get().name.as_ref()), + v => { + return Err(ValueError::WrongType { + expected: "string or symbol", + got: v.type_name().to_string(), + }); + } + }; + let fields = match &args[1] { + Value::Map(m) => m.clone(), + Value::Nil => MapValue::empty(), + v => { + return Err(ValueError::WrongType { + expected: "map", + got: v.type_name().to_string(), + }); + } + }; + let mut_map = match &args[2] { + Value::Map(m) => m.clone(), + Value::Nil => MapValue::empty(), + v => { + return Err(ValueError::WrongType { + expected: "map", + got: v.type_name().to_string(), + }); + } + }; + let cell = GcPtr::new(Atom::new(Value::Map(mut_map))); + Ok(Value::TypeInstance(GcPtr::new(TypeInstance { + type_tag, + fields, + mutable: Some(cell), }))) } diff --git a/crates/cljrs-runtime/src/interp/apply.rs b/crates/cljrs-runtime/src/interp/apply.rs index 8c14fe342..ac167388b 100644 --- a/crates/cljrs-runtime/src/interp/apply.rs +++ b/crates/cljrs-runtime/src/interp/apply.rs @@ -344,6 +344,29 @@ pub fn dispatch_method(method: &str, target: &Value, args: &[Value]) -> EvalResu Value::List(_) | Value::Cons(_) | Value::LazySeq(_) => { dispatch_seq_method(method, target, args) } + Value::TypeInstance(ti) => { + // `.-field` reads a deftype/defrecord field. There are no host + // methods to call on an interpreter instance, so a plain `.method` + // is unsupported (protocol methods are called as `(proto-fn inst)`). + if let Some(field) = method.strip_prefix('-') { + let key = Value::keyword(cljrs_value::Keyword::simple(field)); + let inst = ti.get(); + // A mutable field lives in the interior-mutable cell; an + // immutable one in the field map. + if let Some(atom) = &inst.mutable + && let Value::Map(m) = atom.get().deref() + && let Some(v) = m.get(&key) + { + return Ok(v); + } + Ok(inst.fields.get(&key).unwrap_or(Value::Nil)) + } else { + Err(EvalError::Runtime(format!( + ".{method} not supported on {} (only .-field access is)", + target.type_name() + ))) + } + } _ => Err(EvalError::Runtime(format!( ".{method} not supported on type {}", target.type_name() diff --git a/crates/cljrs-runtime/src/interp/special.rs b/crates/cljrs-runtime/src/interp/special.rs index 0f4201c13..198c7d6d2 100644 --- a/crates/cljrs-runtime/src/interp/special.rs +++ b/crates/cljrs-runtime/src/interp/special.rs @@ -879,25 +879,98 @@ fn eval_var(args: &[Form], env: &mut Env) -> EvalResult { // ── set! ────────────────────────────────────────────────────────────────────── fn eval_set_bang(args: &[Form], env: &mut Env) -> EvalResult { - let sym = match args.first().map(|f| &f.kind) { - Some(FormKind::Symbol(s)) => s.clone(), - _ => return Err(EvalError::Runtime("set! requires a symbol".into())), - }; + let target = args + .first() + .ok_or_else(|| EvalError::Runtime("set! requires a target".into()))?; let val = if args.len() > 1 { eval(&args[1], env)? } else { Value::Nil }; - let parsed = cljrs_value::Symbol::parse(&sym); - let ns = parsed.namespace.as_deref().unwrap_or(&env.current_ns); - let var = env - .globals - .lookup_var_in_ns(ns, &parsed.name) - .ok_or_else(|| EvalError::UnboundSymbol(sym))?; - // Prefer updating the thread-local binding if one exists. - if !crate::env::dynamics::set_thread_local(&var, val.clone()) { - var.get().bind(val.clone()); + match &target.kind { + FormKind::Symbol(sym) => { + // A bare unqualified name inside a deftype method may be one of its + // mutable fields; only if not does it fall through to var logic. + if !sym.contains('/') + && let Some(v) = try_set_mutable_field(env, sym, &val)? + { + return Ok(v); + } + let parsed = cljrs_value::Symbol::parse(sym); + let ns = parsed.namespace.as_deref().unwrap_or(&env.current_ns); + let var = env + .globals + .lookup_var_in_ns(ns, &parsed.name) + .ok_or_else(|| EvalError::UnboundSymbol(sym.clone()))?; + // Prefer updating the thread-local binding if one exists. + if !crate::env::dynamics::set_thread_local(&var, val.clone()) { + var.get().bind(val.clone()); + } + Ok(val) + } + // `(set! (.-field inst) v)` — a mutable field on an explicit instance. + FormKind::List(parts) + if parts.len() == 2 + && matches!(&parts[0].kind, FormKind::Symbol(op) if op.starts_with(".-")) => + { + let FormKind::Symbol(op) = &parts[0].kind else { + unreachable!() + }; + let field = &op[2..]; + let inst = eval(&parts[1], env)?; + set_type_instance_field(&inst, field, val) + } + _ => Err(EvalError::Runtime( + "set! requires a symbol or (.-field inst) target".into(), + )), } +} + +/// If `sym` names a mutable field of the `__deftype_self__` instance in scope, +/// update its cell AND refresh the in-scope local snapshot, returning the new +/// value. `None` when `sym` is not such a field, so `set!` falls through to var +/// logic. +fn try_set_mutable_field(env: &mut Env, sym: &str, val: &Value) -> EvalResult> { + let Some(Value::TypeInstance(ti)) = env.lookup_local_frames(DEFTYPE_SELF) else { + return Ok(None); + }; + let Some(atom) = ti.get().mutable.clone() else { + return Ok(None); + }; + let key = Value::keyword(cljrs_value::Keyword::simple(sym)); + let Value::Map(map) = atom.get().deref() else { + return Ok(None); + }; + if map.get(&key).is_none() { + return Ok(None); + } + atom.get().reset(Value::Map(map.assoc(key, val.clone()))); + // Keep the method's local snapshot consistent for later reads. + env.bind(Arc::from(sym), val.clone()); + Ok(Some(val.clone())) +} + +/// Set a mutable field on an explicit instance: `(set! (.-field inst) v)`. +fn set_type_instance_field(inst: &Value, field: &str, val: Value) -> EvalResult { + let Value::TypeInstance(ti) = inst else { + return Err(EvalError::Runtime(format!( + "set! (.-{field} …): target is not a type instance" + ))); + }; + let atom = ti.get().mutable.clone().ok_or_else(|| { + EvalError::Runtime(format!("set! (.-{field} …): type has no mutable fields")) + })?; + let key = Value::keyword(cljrs_value::Keyword::simple(field)); + let map = match atom.get().deref() { + Value::Map(m) => m, + _ => MapValue::empty(), + }; + if map.get(&key).is_none() { + return Err(EvalError::Runtime(format!( + "set!: {field} is not a mutable field" + ))); + } + atom.get().reset(Value::Map(map.assoc(key, val.clone()))); Ok(val) } @@ -1949,21 +2022,15 @@ fn eval_extend_type(args: &[Form], env: &mut Env) -> EvalResult { for form in &args[1..] { match &form.unmeta().kind { - FormKind::Symbol(s) => { - // Look up protocol in env. - let val = env.globals.lookup_in_ns(&env.current_ns, s); - match val { - Some(Value::Protocol(p)) => { - current_proto = Some(p); - } - _ => { - return Err(EvalError::Runtime(format!( - "extend-type: {} is not a protocol", - s - ))); - } + FormKind::Symbol(s) => match resolve_protocol_sym(env, s) { + Some(p) => current_proto = Some(p), + None => { + return Err(EvalError::Runtime(format!( + "extend-type: {} is not a protocol", + s + ))); } - } + }, FormKind::List(parts) => { // (method-name [params] body...) let proto = current_proto.as_ref().ok_or_else(|| { @@ -1976,7 +2043,7 @@ fn eval_extend_type(args: &[Form], env: &mut Env) -> EvalResult { Some(s) => Arc::from(s), None => continue, }; - let fn_val = build_impl_fn(parts, &[], env)?; + let fn_val = build_impl_fn(parts, &[], &[], env)?; let mut impls = proto.get().impls.lock().unwrap(); impls .entry(type_tag.clone()) @@ -2006,10 +2073,9 @@ fn eval_extend_protocol(args: &[Form], env: &mut Env) -> EvalResult { "extend-protocol: first arg must be a protocol symbol".into(), )); }; - let proto_val = env.globals.lookup_in_ns(&env.current_ns, proto_sym); - let proto_ptr = match proto_val { - Some(Value::Protocol(p)) => p, - _ => { + let proto_ptr = match resolve_protocol_sym(env, proto_sym) { + Some(p) => p, + None => { return Err(EvalError::Runtime(format!( "extend-protocol: {} is not a protocol", proto_sym @@ -2035,7 +2101,7 @@ fn eval_extend_protocol(args: &[Form], env: &mut Env) -> EvalResult { Some(s) => Arc::from(s), None => continue, }; - let fn_val = build_impl_fn(parts, &[], env)?; + let fn_val = build_impl_fn(parts, &[], &[], env)?; let mut impls = proto_ptr.get().impls.lock().unwrap(); impls .entry(type_tag.clone()) @@ -2068,7 +2134,12 @@ fn eval_extend_protocol(args: &[Form], env: &mut Env) -> EvalResult { /// field in Clojure, and binding it here would shadow the param instead. /// Returns None when there is nothing to bind, or when the first param is not /// a plain symbol (a destructured `this` has no name to read the fields from). -fn synth_field_scope(params_form: &Form, fields: &[Arc], body: &[Form]) -> Option> { +fn synth_field_scope( + params_form: &Form, + fields: &[Arc], + mutable_fields: &[Arc], + body: &[Form], +) -> Option> { let param_forms = match ¶ms_form.kind { FormKind::Vector(v) => v, _ => return None, @@ -2086,19 +2157,37 @@ fn synth_field_scope(params_form: &Form, fields: &[Arc], body: &[Form]) -> .collect(); let span = params_form.span.clone(); + let is_mut = |name: &str| mutable_fields.iter().any(|m| m.as_ref() == name); let mut bindings: Vec
= Vec::new(); for field in fields { if param_names.contains(&field.as_ref()) { continue; } bindings.push(Form::new(FormKind::Symbol(field.to_string()), span.clone())); - bindings.push(Form::new( + // A mutable field reads through `(.-field this)` — the live cell; an + // immutable one through `(:field this)` — the field map. Both snapshot + // at method entry; `set!` refreshes the local for later reads. + let accessor = if is_mut(field) { + FormKind::List(vec![ + Form::new(FormKind::Symbol(format!(".-{field}")), span.clone()), + Form::new(FormKind::Symbol(this_name.clone()), span.clone()), + ]) + } else { FormKind::List(vec![ Form::new(FormKind::Keyword(field.to_string()), span.clone()), Form::new(FormKind::Symbol(this_name.clone()), span.clone()), - ]), + ]) + }; + bindings.push(Form::new(accessor, span.clone())); + } + // With mutable fields present, bind a hidden handle to `this` so `set!` can + // find the instance whose cell to update. + if !mutable_fields.is_empty() { + bindings.push(Form::new( + FormKind::Symbol(DEFTYPE_SELF.to_string()), span.clone(), )); + bindings.push(Form::new(FormKind::Symbol(this_name.clone()), span.clone())); } if bindings.is_empty() { return None; @@ -2112,7 +2201,12 @@ fn synth_field_scope(params_form: &Form, fields: &[Arc], body: &[Form]) -> Some(vec![Form::new(FormKind::List(let_forms), span)]) } -fn build_impl_fn(parts: &[Form], fields: &[Arc], env: &mut Env) -> EvalResult { +fn build_impl_fn( + parts: &[Form], + fields: &[Arc], + mutable_fields: &[Arc], + env: &mut Env, +) -> EvalResult { if parts.len() < 2 { return Err(EvalError::Runtime( "protocol method impl requires params and body".into(), @@ -2125,7 +2219,7 @@ fn build_impl_fn(parts: &[Form], fields: &[Arc], env: &mut Env) -> EvalResu let body: &[Form] = if fields.is_empty() { body } else { - match synth_field_scope(params_form, fields, body) { + match synth_field_scope(params_form, fields, mutable_fields, body) { Some(v) => { scoped = v; &scoped @@ -2290,6 +2384,181 @@ fn eval_binding(args: &[Form], env: &mut Env) -> EvalResult { // _guard drops here → pop_frame() } +// ── deftype / defrecord shared construction ───────────────────────────────────── + +/// Hidden `let*` binding a `deftype` method body carries when the type has +/// mutable fields: a handle to `this`, so `set!` can locate the instance whose +/// interior-mutable cell to update. +const DEFTYPE_SELF: &str = "__deftype_self__"; + +/// Does a field's `^meta` mark it `^:unsynchronized-mutable` or +/// `^:volatile-mutable`? Instances are single-threaded here, so the two are +/// treated identically — only whether the field is mutable at all matters. +fn meta_form_is_mutable(meta: &Form) -> bool { + let is_mut_kw = |k: &str| k == "unsynchronized-mutable" || k == "volatile-mutable"; + match &meta.kind { + FormKind::Keyword(k) => is_mut_kw(k), + FormKind::Map(entries) => entries.chunks(2).any(|kv| { + matches!(&kv[0].kind, FormKind::Keyword(k) if is_mut_kw(k)) + && !matches!( + kv.get(1).map(|f| &f.kind), + None | Some(FormKind::Bool(false)) | Some(FormKind::Nil) + ) + }), + _ => false, + } +} + +/// A single field spec: its name and whether it is mutable. +fn field_spec_of(form: &Form) -> Option<(Arc, bool)> { + match &form.kind { + FormKind::Symbol(s) => Some((Arc::from(s.as_str()), false)), + FormKind::Meta(meta, inner) => { + let here = meta_form_is_mutable(meta); + field_spec_of(inner).map(|(name, inner_mut)| (name, inner_mut || here)) + } + _ => None, + } +} + +/// Parse a `deftype` `[field ...]` vector into `(name, mutable?)` specs. +fn parse_field_specs(form: &Form, ctx: &str) -> EvalResult, bool)>> { + // `as_vector` reports the shape under any `^meta`, so a marker on the + // vector itself — `(defrecord R ^:marker [x])` — stays transparent. + let Some(fields) = form.as_vector() else { + return Err(EvalError::Runtime(format!( + "{ctx} requires a field vector as second arg" + ))); + }; + fields + .iter() + .map(|f| { + field_spec_of(f) + .ok_or_else(|| EvalError::Runtime(format!("{ctx} field names must be symbols"))) + }) + .collect() +} + +/// Intern `->TypeName`, the positional constructor, in the current namespace. +/// For an all-immutable type the body is +/// `(make-type-instance "T" {:f1 f1 …})`; when `mutable_names` is non-empty the +/// mutable fields are split into a second map and the body becomes +/// `(make-type-instance-mut "T" {imm…} {mut…})`. Shared by `deftype` and +/// `defrecord` (which always passes an empty `mutable_names`). +fn build_positional_ctor( + type_name: &str, + type_tag: &Arc, + field_names: &[Arc], + mutable_names: &[Arc], + env: &mut Env, +) { + use cljrs_reader::form::FormKind as FK; + let ns = env.current_ns.clone(); + let globals = env.globals.clone(); + let dummy_span = + cljrs_types::span::Span::new(std::sync::Arc::new("".into()), 0, 0, 1, 1); + let make_form = |kind: FK| Form { + kind, + span: dummy_span.clone(), + }; + let is_mut = |name: &str| mutable_names.iter().any(|m| m.as_ref() == name); + let mut imm_kv: Vec = Vec::new(); + let mut mut_kv: Vec = Vec::new(); + for f in field_names { + let target = if is_mut(f) { &mut mut_kv } else { &mut imm_kv }; + target.push(make_form(FK::Keyword(f.as_ref().to_string()))); + target.push(make_form(FK::Symbol(f.as_ref().to_string()))); + } + let ctor_call = if mutable_names.is_empty() { + vec![ + make_form(FK::Symbol("make-type-instance".into())), + make_form(FK::Str(type_tag.as_ref().to_string())), + make_form(FK::Map(imm_kv)), + ] + } else { + vec![ + make_form(FK::Symbol("make-type-instance-mut".into())), + make_form(FK::Str(type_tag.as_ref().to_string())), + make_form(FK::Map(imm_kv)), + make_form(FK::Map(mut_kv)), + ] + }; + let body = vec![make_form(FK::List(ctor_call))]; + let arity = CljxFnArity { + params: field_names.to_vec(), + rest_param: None, + body, + destructure_params: vec![], + destructure_rest: None, + ir_arity_id: crate::interp::arity::fresh_arity_id(), + param_hints: vec![], + rest_hint: None, + }; + let fn_name: Arc = Arc::from(format!("->{}", type_name)); + let ctor = CljxFn::new( + Some(fn_name.clone()), + vec![arity], + vec![], + vec![], + false, + Arc::clone(&ns), + ); + globals.intern(&ns, fn_name, Value::Fn(GcPtr::new(ctor))); +} + +/// Intern `map->TypeName`, the map constructor — `defrecord` only, as `deftype` +/// has no map constructor in Clojure. +fn build_map_ctor(type_name: &str, type_tag: &Arc, env: &mut Env) { + use cljrs_reader::form::FormKind as FK; + let ns = env.current_ns.clone(); + let globals = env.globals.clone(); + let dummy_span = + cljrs_types::span::Span::new(std::sync::Arc::new("".into()), 0, 0, 1, 1); + let make_form = |kind: FK| Form { + kind, + span: dummy_span.clone(), + }; + let m_sym: Arc = Arc::from("m__"); + let body = vec![make_form(FK::List(vec![ + make_form(FK::Symbol("make-type-instance".into())), + make_form(FK::Str(type_tag.as_ref().to_string())), + make_form(FK::Symbol(m_sym.as_ref().to_string())), + ]))]; + let arity = CljxFnArity { + params: vec![m_sym], + rest_param: None, + body, + destructure_params: vec![], + destructure_rest: None, + ir_arity_id: crate::interp::arity::fresh_arity_id(), + param_hints: vec![], + rest_hint: None, + }; + let fn_name: Arc = Arc::from(format!("map->{}", type_name)); + let ctor = CljxFn::new( + Some(fn_name.clone()), + vec![arity], + vec![], + vec![], + false, + Arc::clone(&ns), + ); + globals.intern(&ns, fn_name, Value::Fn(GcPtr::new(ctor))); +} + +/// Intern the type NAME as a Symbol value so `(instance? TypeName x)` and other +/// name references resolve to the type tag. +fn intern_type_symbol(type_name: &str, env: &mut Env) { + let ns = env.current_ns.clone(); + let globals = env.globals.clone(); + let type_sym = cljrs_value::Symbol::simple(type_name.to_string()); + globals.intern( + &ns, + Arc::from(type_name), + Value::Symbol(GcPtr::new(type_sym)), + ); +} + // ── defrecord ───────────────────────────────────────────────────────────────── fn eval_defrecord(args: &[Form], env: &mut Env) -> EvalResult { @@ -2305,143 +2574,62 @@ fn eval_defrecord(args: &[Form], env: &mut Env) -> EvalResult { let (type_name, _) = require_sym_meta(args, 0, "defrecord", env)?; let type_tag: Arc = Arc::from(type_name.as_str()); - // Parse field names from the vector. - let Some(fields) = args[1].as_vector() else { - return Err(EvalError::Runtime( - "defrecord requires a field vector as second arg".into(), - )); - }; - let field_names: Vec> = fields - .iter() - .map(|f| { - f.as_symbol() - .map(Arc::from) - .ok_or_else(|| EvalError::Runtime("defrecord field names must be symbols".into())) - }) - .collect::>()?; + // Parse field names from the vector, peeling any per-field metadata. + // (A defrecord field is always immutable, so the mutability flag is dropped.) + let field_names: Vec> = parse_field_specs(&args[1], "defrecord")? + .into_iter() + .map(|(n, _)| n) + .collect(); // Register protocol implementations (same as extend-type inner logic). // The field names go with them: a defrecord method body may name its fields // directly, which reify has no equivalent of. - register_impls_for_tag(&type_tag, &args[2..], &field_names, env)?; + register_impls_for_tag(&type_tag, &args[2..], &field_names, &[], env)?; - // Generate constructors in clojure.core. - // ->TypeName: positional constructor - // map->TypeName: map constructor - let ns = env.current_ns.clone(); - let globals = env.globals.clone(); - let type_tag2 = type_tag.clone(); + // Generate constructors in the current namespace: the positional `->T` and + // the map `map->T`; then intern the type name so `(instance? T x)` resolves. + build_positional_ctor(&type_name, &type_tag, &field_names, &[], env); + build_map_ctor(&type_name, &type_tag, env); + intern_type_symbol(&type_name, env); + Ok(Value::Nil) +} - // Build `->TypeName` as a native-Clojure fn: (fn [f1 f2 ...] (make-type-instance "T" {:f1 f1 :f2 f2 ...})) - { - let params: Vec> = field_names.clone(); - let rest_param = None; - // Build body forms manually: (make-type-instance "TypeName" {:field1 field1 ...}) - use cljrs_reader::form::FormKind as FK; - let dummy_span = - cljrs_types::span::Span::new(std::sync::Arc::new("".into()), 0, 0, 1, 1); - let make_form = |kind: FK| Form { - kind, - span: dummy_span.clone(), - }; - let mut kv_forms: Vec = Vec::new(); - for f in &field_names { - kv_forms.push(make_form(FK::Keyword(f.as_ref().to_string()))); - kv_forms.push(make_form(FK::Symbol(f.as_ref().to_string()))); - } - let map_form = make_form(FK::Map(kv_forms)); - let body = vec![make_form(FK::List(vec![ - make_form(FK::Symbol("make-type-instance".into())), - make_form(FK::Str(type_tag.as_ref().to_string())), - map_form, - ]))]; - let arity = CljxFnArity { - params, - rest_param, - body, - destructure_params: vec![], - destructure_rest: None, - ir_arity_id: crate::interp::arity::fresh_arity_id(), - param_hints: vec![], - rest_hint: None, - }; - let fn_name: Arc = Arc::from(format!("->{}", type_name)); - let ctor = CljxFn::new( - Some(fn_name.clone()), - vec![arity], - vec![], - vec![], - false, - Arc::clone(&ns), - ); - globals.intern(&ns, fn_name, Value::Fn(GcPtr::new(ctor))); - } +// ── deftype ────────────────────────────────────────────────────────────────── - // Build `map->TypeName`: (fn [m] (make-type-instance "TypeName" m)) - { - use cljrs_reader::form::FormKind as FK; - let dummy_span = - cljrs_types::span::Span::new(std::sync::Arc::new("".into()), 0, 0, 1, 1); - let make_form = |kind: FK| Form { - kind, - span: dummy_span.clone(), - }; - let m_sym: Arc = Arc::from("m__"); - let body = vec![make_form(FK::List(vec![ - make_form(FK::Symbol("make-type-instance".into())), - make_form(FK::Str(type_tag2.as_ref().to_string())), - make_form(FK::Symbol(m_sym.as_ref().to_string())), - ]))]; - let arity = CljxFnArity { - params: vec![m_sym], - rest_param: None, - body, - destructure_params: vec![], - destructure_rest: None, - ir_arity_id: crate::interp::arity::fresh_arity_id(), - param_hints: vec![], - rest_hint: None, - }; - let fn_name: Arc = Arc::from(format!("map->{}", type_name)); - let ctor = CljxFn::new( - Some(fn_name.clone()), - vec![arity], - vec![], - vec![], - false, - Arc::clone(&ns), - ); - globals.intern(&ns, fn_name, Value::Fn(GcPtr::new(ctor))); +fn eval_deftype(args: &[Form], env: &mut Env) -> EvalResult { + // (deftype TypeName [field ...] Proto (method [this] body) ...) + if args.len() < 2 { + return Err(EvalError::Runtime( + "deftype requires a name and field vector".into(), + )); } + // Type metadata (e.g. ^:private) has no var to hold it; unwrapped so the + // name reads, and deliberately not applied anywhere it would not belong. + let (type_name, _) = require_sym_meta(args, 0, "deftype", env)?; + let type_tag: Arc = Arc::from(type_name.as_str()); - // Intern the type name as a Symbol value so `(instance? TypeName x)` works. - let type_sym = cljrs_value::Symbol::simple(type_name.clone()); - globals.intern( - &ns, - Arc::from(type_name), - Value::Symbol(GcPtr::new(type_sym)), - ); + let specs = parse_field_specs(&args[1], "deftype")?; + let field_names: Vec> = specs.iter().map(|(n, _)| n.clone()).collect(); + let mutable_names: Vec> = specs + .iter() + .filter(|(_, m)| *m) + .map(|(n, _)| n.clone()) + .collect(); + + // Register protocol/interface method impls, with the fields in scope in + // each body — same machinery as defrecord/reify. Mutable fields read + // through the live cell and are writable with `set!`. + register_impls_for_tag(&type_tag, &args[2..], &field_names, &mutable_names, env)?; + + // deftype gets a positional `->T` constructor and its type symbol, but no + // `map->T` (Clojure reserves that for defrecord). + build_positional_ctor(&type_name, &type_tag, &field_names, &mutable_names, env); + intern_type_symbol(&type_name, env); Ok(Value::Nil) } // ── reify ───────────────────────────────────────────────────────────────────── -fn eval_deftype(args: &[Form], _env: &mut Env) -> EvalResult { - // deftype is not implemented. It is a SPECIAL FORM (not a builtin) purely so - // this error fires at the deftype form itself, unevaluated, rather than the - // builtin path evaluating `(deftype T [x y])`'s args and reporting the far - // more confusing "Unable to resolve symbol: T". A real implementation needs - // mutable/volatile fields, set! over them, and array interop — see the - // hive kanban [CLJRS-DEFTYPE]. - let name = match args.first().map(|f| &f.kind) { - Some(FormKind::Symbol(s)) => s.as_str(), - _ => "", - }; - Err(EvalError::Runtime(format!( - "deftype is not implemented (defining {name}); use defrecord where a map-backed type suffices" - ))) -} - fn eval_reify(args: &[Form], env: &mut Env) -> EvalResult { // (reify Proto1 (method [this] body) ...) // Generate a unique type tag for this instance. @@ -2450,12 +2638,13 @@ fn eval_reify(args: &[Form], env: &mut Env) -> EvalResult { let type_tag: Arc = Arc::from(format!("reify__{}", n)); // Register protocol implementations. reify has no fields. - register_impls_for_tag(&type_tag, args, &[], env)?; + register_impls_for_tag(&type_tag, args, &[], &[], env)?; // Return an empty TypeInstance with the unique tag. Ok(Value::TypeInstance(GcPtr::new(TypeInstance { type_tag, fields: MapValue::empty(), + mutable: None, }))) } @@ -2471,7 +2660,6 @@ fn eval_reify(args: &[Form], env: &mut Env) -> EvalResult { /// the CURRENT ns, where it is neither interned nor referred. A qualified protocol /// symbol must resolve through its own namespace, exactly as `eval` resolves any /// other qualified symbol. -#[expect(dead_code)] // until next PR uses this fn resolve_protocol_sym(env: &Env, s: &str) -> Option> { let parsed = cljrs_value::Symbol::parse(s); let val = match parsed.namespace.as_deref() { @@ -2496,26 +2684,22 @@ fn register_impls_for_tag( type_tag: &Arc, forms: &[Form], fields: &[Arc], + mutable_fields: &[Arc], env: &mut Env, ) -> EvalResult<()> { let mut current_proto: Option> = None; for form in forms { match &form.unmeta().kind { - FormKind::Symbol(s) => { - let val = env.globals.lookup_in_ns(&env.current_ns, s); - match val { - Some(Value::Protocol(p)) => { - current_proto = Some(p); - } - _ => { - return Err(EvalError::Runtime(format!( - "reify/defrecord: {} is not a protocol", - s - ))); - } + FormKind::Symbol(s) => match resolve_protocol_sym(env, s) { + Some(p) => current_proto = Some(p), + None => { + return Err(EvalError::Runtime(format!( + "reify/defrecord: {} is not a protocol", + s + ))); } - } + }, FormKind::List(parts) => { let proto = current_proto.as_ref().ok_or_else(|| { EvalError::Runtime("reify/defrecord: method impl before protocol name".into()) @@ -2527,7 +2711,7 @@ fn register_impls_for_tag( Some(s) => Arc::from(s), None => continue, }; - let fn_val = build_impl_fn(parts, fields, env)?; + let fn_val = build_impl_fn(parts, fields, mutable_fields, env)?; let mut impls = proto.get().impls.lock().unwrap(); impls .entry(type_tag.clone()) diff --git a/crates/cljrs-runtime/tests/deftype_mutable_tiered.rs b/crates/cljrs-runtime/tests/deftype_mutable_tiered.rs new file mode 100644 index 000000000..48fe602fe --- /dev/null +++ b/crates/cljrs-runtime/tests/deftype_mutable_tiered.rs @@ -0,0 +1,112 @@ +//! PR #356's tiered-safety half: the IR lowerer must **decline** to lower a +//! `set!` whose target is a local binding. +//! +//! A `deftype` method body binds each field as a `let*` local, so a mutable +//! field write reads as `(set! n (inc n))` over a local. The IR var-store path +//! cannot express that — it would emit a store to the global var `n` and lose +//! the write — so `lower_set_bang` returns `UnsupportedForm` and the method +//! tree-walks, where `eval_set_bang` updates the instance's interior cell. +//! +//! Nothing pins that from a tree-walking test: with lowering off, the decline +//! is unreachable. This file lives on its own so it can flip the process-wide +//! eager-lowering switch without disturbing any other test binary, and drives +//! each method far past the warm threshold so the tier is genuinely entered. + +use std::sync::Arc; + +use cljrs_reader::Parser; +use cljrs_runtime::env::env::{Env, GlobalEnv}; +use cljrs_value::Value; + +fn make_env() -> (Arc, Env) { + // Process-wide, and the reason this test is its own binary. + cljrs_runtime::tiered::force_eager_lowering(); + let globals = cljrs_runtime::Runtime::builder() + .execution_mode(cljrs_runtime::ExecutionMode::TieredNoJit) + .build() + .expect("runtime") + .into_globals(); + let env = Env::new(globals.clone(), "user"); + (globals, env) +} + +fn eval_pr(src: &str) -> String { + let (_globals, mut env) = make_env(); + let mut parser = Parser::new(src.to_string(), "".to_string()); + let forms = parser.parse_all().expect("parse error"); + let mut result = Value::Nil; + for form in forms { + result = cljrs_runtime::interp::eval::eval(&form, &mut env).expect("eval error"); + } + match result { + Value::Str(s) => s.get().as_str().to_string(), + // The type name, not `{:?}`: a `Value` may be a `Uuid`, and CodeQL + // reads Debug-formatting one into a panic as logging it in cleartext. + // Which type came back instead of a string is what this assertion is + // actually about. + other => panic!("expected a string from pr-str, got a {}", other.type_name()), + } +} + +#[test] +fn a_hot_mutable_field_method_keeps_every_write() { + assert_eq!( + eval_pr( + "(defprotocol Counter (bump [this]) (peek-n [this])) + (deftype C [^:unsynchronized-mutable n] + Counter + (bump [_] (set! n (inc n))) + (peek-n [_] n)) + (let [c (->C 0)] + (dotimes [_ 1000] (bump c)) + (pr-str (peek-n c)))" + ), + "1000" + ); +} + +#[test] +fn a_hot_method_does_not_leak_the_write_to_a_global_var() { + // The failure mode the decline exists to prevent: lowering `(set! n ...)` + // as a var store would define/overwrite `user/n` and leave the instance + // untouched. `n` must still be unresolvable afterwards. + assert_eq!( + eval_pr( + "(defprotocol Counter (bump [this])) + (deftype C [^:unsynchronized-mutable n] Counter (bump [_] (set! n (inc n)))) + (let [c (->C 0)] (dotimes [_ 1000] (bump c))) + (pr-str (resolve 'n))" + ), + "nil" + ); +} + +#[test] +fn a_hot_read_after_write_within_one_method_is_consistent() { + assert_eq!( + eval_pr( + "(defprotocol Counter (bump-twice [this])) + (deftype C [^:unsynchronized-mutable n] + Counter + (bump-twice [_] (set! n (inc n)) (set! n (inc n)) n)) + (let [c (->C 0)] + (pr-str (last (map (fn [_] (bump-twice c)) (range 500)))))" + ), + "1000" + ); +} + +#[test] +fn a_hot_immutable_deftype_method_still_lowers_and_agrees() { + // The control: an immutable-field method has no `set!` to decline on, so + // it may lower freely and must produce the same answers. + assert_eq!( + eval_pr( + "(defprotocol P (scale [this k])) + (deftype T [a] P (scale [_ k] (* a k))) + (let [t (->T 3)] + (pr-str (reduce + (map (fn [i] (scale t i)) (range 100)))))" + ), + "14850" + ); +} diff --git a/crates/cljrs-runtime/tests/deftype_types.rs b/crates/cljrs-runtime/tests/deftype_types.rs new file mode 100644 index 000000000..d4a52b3d5 --- /dev/null +++ b/crates/cljrs-runtime/tests/deftype_types.rs @@ -0,0 +1,261 @@ +//! Regression tests pinning PR #356's intent: `deftype` is a real named type. +//! +//! `deftype` used to be a special form wired to a "not implemented" error. The +//! feature landed a positional `->T` constructor, protocol/interface method +//! bodies with the fields in scope, `.-field` access, and mutable fields +//! (`^:unsynchronized-mutable` / `^:volatile-mutable`) writable with `set!`. +//! +//! The implementation was then silently lost across a `main` merge: the +//! conflict resolution kept the old stub alongside a truncated copy of the new +//! `eval_deftype`, which is a compile error the moment anything builds the +//! crate. These tests exist so the *behaviour* — not just compilation — is +//! pinned the next time the branch takes a merge. + +use std::sync::Arc; + +use cljrs_reader::Parser; +use cljrs_runtime::env::env::{Env, GlobalEnv}; +use cljrs_value::Value; + +fn make_env() -> (Arc, Env) { + let globals = cljrs_runtime::Runtime::builder() + .execution_mode(cljrs_runtime::ExecutionMode::TreeWalk) + .build() + .expect("runtime") + .into_globals(); + let env = Env::new(globals.clone(), "user"); + (globals, env) +} + +/// Evaluate `src` and return the last value rendered with `pr-str`. +fn eval_pr(src: &str) -> String { + let (_globals, mut env) = make_env(); + let mut parser = Parser::new(src.to_string(), "".to_string()); + let forms = parser.parse_all().expect("parse error"); + let mut result = Value::Nil; + for form in forms { + result = cljrs_runtime::interp::eval::eval(&form, &mut env).expect("eval error"); + } + match result { + Value::Str(s) => s.get().as_str().to_string(), + // The type name, not `{:?}`: a `Value` may be a `Uuid`, and CodeQL + // reads Debug-formatting one into a panic as logging it in cleartext. + // Which type came back instead of a string is what this assertion is + // actually about. + other => panic!("expected a string from pr-str, got a {}", other.type_name()), + } +} + +/// Evaluate `src`, expecting it to fail, and return the error rendered. +fn eval_err(src: &str) -> String { + let (_globals, mut env) = make_env(); + let mut parser = Parser::new(src.to_string(), "".to_string()); + let forms = parser.parse_all().expect("parse error"); + let mut last = Ok(Value::Nil); + for form in forms { + last = cljrs_runtime::interp::eval::eval(&form, &mut env); + if last.is_err() { + break; + } + } + match last { + Err(e) => format!("{e:?}"), + Ok(v) => panic!("expected an error, got a {}", v.type_name()), + } +} + +// ── The type itself ────────────────────────────────────────────────────────── + +#[test] +fn deftype_is_implemented() { + // The old stub errored with "deftype is not implemented"; the whole point + // of the feature is that this evaluates. + assert_eq!(eval_pr("(deftype T [x y]) (pr-str (.-x (->T 1 2)))"), "1"); +} + +#[test] +fn positional_constructor_binds_fields_in_order() { + assert_eq!( + eval_pr("(deftype Point [x y]) (let [p (->Point 3 4)] (pr-str [(.-x p) (.-y p)]))"), + "[3 4]" + ); +} + +#[test] +fn type_name_is_interned_so_instance_resolves() { + assert_eq!( + eval_pr("(deftype T [x]) (pr-str (instance? T (->T 1)))"), + "true" + ); +} + +#[test] +fn deftype_has_no_map_constructor() { + // Clojure reserves `map->T` for defrecord; deftype must not generate one. + assert!( + eval_err("(deftype T [x]) (map->T {:x 1})").contains("map->T"), + "expected map->T to be unresolvable for a deftype" + ); +} + +#[test] +fn a_field_vector_may_carry_its_own_metadata() { + // `as_vector` reports the shape under any `^meta`, so a marker on the field + // vector is transparent — as it is for defrecord. + assert_eq!( + eval_pr("(deftype T ^:marker [x]) (pr-str (.-x (->T 7)))"), + "7" + ); +} + +// ── Protocol method bodies ─────────────────────────────────────────────────── + +#[test] +fn immutable_fields_are_in_scope_in_a_method_body() { + assert_eq!( + eval_pr( + "(defprotocol P (describe [this])) + (deftype T [a b] P (describe [_] [a b])) + (pr-str (describe (->T 1 2)))" + ), + "[1 2]" + ); +} + +#[test] +fn one_type_can_implement_several_protocols() { + assert_eq!( + eval_pr( + "(defprotocol P (p-of [this])) + (defprotocol Q (q-of [this])) + (deftype T [a] P (p-of [_] (* a 10)) Q (q-of [_] (* a 100))) + (let [t (->T 2)] (pr-str [(p-of t) (q-of t)]))" + ), + "[20 200]" + ); +} + +// ── Mutable fields ─────────────────────────────────────────────────────────── + +#[test] +fn set_bang_on_a_bare_field_name_inside_a_method() { + assert_eq!( + eval_pr( + "(defprotocol Counter (bump [this]) (peek-n [this])) + (deftype C [^:unsynchronized-mutable n] + Counter + (bump [_] (set! n (inc n))) + (peek-n [_] n)) + (let [c (->C 0)] (bump c) (bump c) (pr-str (peek-n c)))" + ), + "2" + ); +} + +#[test] +fn a_write_is_visible_to_a_later_read_in_the_same_method() { + assert_eq!( + eval_pr( + "(defprotocol Counter (bump-twice [this])) + (deftype C [^:unsynchronized-mutable n] + Counter + (bump-twice [_] (set! n (inc n)) (set! n (inc n)) n)) + (pr-str (bump-twice (->C 5)))" + ), + "7" + ); +} + +#[test] +fn volatile_mutable_behaves_like_unsynchronized_mutable() { + assert_eq!( + eval_pr( + "(defprotocol Counter (bump [this]) (peek-n [this])) + (deftype C [^:volatile-mutable n] + Counter + (bump [_] (set! n (inc n))) + (peek-n [_] n)) + (let [c (->C 41)] (bump c) (pr-str (peek-n c)))" + ), + "42" + ); +} + +#[test] +fn set_bang_on_an_explicit_field_target() { + assert_eq!( + eval_pr( + "(deftype Box [^:unsynchronized-mutable v]) + (let [b (->Box :old)] (set! (.-v b) :new) (pr-str (.-v b)))" + ), + ":new" + ); +} + +#[test] +fn mutating_one_instance_does_not_touch_another() { + assert_eq!( + eval_pr( + "(deftype Box [^:unsynchronized-mutable v]) + (let [a (->Box 1) b (->Box 1)] + (set! (.-v a) 99) + (pr-str [(.-v a) (.-v b)]))" + ), + "[99 1]" + ); +} + +#[test] +fn immutable_and_mutable_fields_coexist() { + assert_eq!( + eval_pr( + "(defprotocol P (report [this])) + (deftype T [label ^:unsynchronized-mutable n] + P + (report [_] (set! n (inc n)) [label n])) + (let [t (->T \"hits\" 0)] (report t) (pr-str (report t)))" + ), + "[\"hits\" 2]" + ); +} + +#[test] +fn a_hot_mutable_field_method_accumulates_every_write() { + // Tree-walk only — `deftype_mutable_tiered.rs` runs the same script with IR + // lowering forced on, which is where the `set!`-on-a-local decline matters. + assert_eq!( + eval_pr( + "(defprotocol Counter (bump [this]) (peek-n [this])) + (deftype C [^:unsynchronized-mutable n] + Counter + (bump [_] (set! n (inc n))) + (peek-n [_] n)) + (let [c (->C 0)] + (dotimes [_ 500] (bump c)) + (pr-str (peek-n c)))" + ), + "500" + ); +} + +#[test] +fn set_bang_rejects_a_field_the_type_did_not_declare_mutable() { + let err = eval_err("(deftype T [^:unsynchronized-mutable a b]) (set! (.-b (->T 1 2)) 3)"); + assert!( + err.contains("not a mutable field"), + "expected a mutable-field error, got {err}" + ); +} + +// ── set! still means what it meant ─────────────────────────────────────────── + +#[test] +fn set_bang_on_a_dynamic_var_is_unaffected() { + assert_eq!( + eval_pr( + "(def ^:dynamic *v* 1) + (binding [*v* 2] (set! *v* 3) (pr-str *v*))" + ), + "3" + ); +} diff --git a/crates/cljrs-runtime/tests/qualified_protocol_impl.rs b/crates/cljrs-runtime/tests/qualified_protocol_impl.rs new file mode 100644 index 000000000..05bbf9026 --- /dev/null +++ b/crates/cljrs-runtime/tests/qualified_protocol_impl.rs @@ -0,0 +1,149 @@ +//! Regression tests pinning PR #354: a protocol named in an **impl position** +//! may be qualified, and must resolve through its own namespace. +//! +//! `defrecord`/`deftype`/`reify`/`extend-type`/`extend-protocol` used to look +//! the protocol up with `lookup_in_ns(current_ns, "mp/IThing")` — passing the +//! whole symbol string. A qualified name is neither interned nor referred under +//! that string in the current ns, so a cross-namespace impl failed with +//! "mp/IThing is not a protocol" even though the protocol was loaded and +//! `(resolve 'mini.proto/IThing)` was truthy. That sinks every design where the +//! protocol and its implementations live in different namespaces — which is +//! most of them. +//! +//! `resolve_protocol_sym` fixed it, but its three call sites were lost across a +//! `main` merge, leaving the helper dead and the bug back. Nothing caught that, +//! because nothing tested it. These tests are that test. + +use std::sync::Arc; + +use cljrs_reader::Parser; +use cljrs_runtime::env::env::{Env, GlobalEnv}; +use cljrs_value::Value; + +fn make_env() -> (Arc, Env) { + let globals = cljrs_runtime::Runtime::builder() + .execution_mode(cljrs_runtime::ExecutionMode::TreeWalk) + .build() + .expect("runtime") + .into_globals(); + let env = Env::new(globals.clone(), "user"); + (globals, env) +} + +/// Evaluate `src` and return the last value rendered with `pr-str`. +fn eval_pr(src: &str) -> String { + let (_globals, mut env) = make_env(); + let mut parser = Parser::new(src.to_string(), "".to_string()); + let forms = parser.parse_all().expect("parse error"); + let mut result = Value::Nil; + for form in forms { + result = cljrs_runtime::interp::eval::eval(&form, &mut env).expect("eval error"); + } + match result { + Value::Str(s) => s.get().as_str().to_string(), + // The type name, not `{:?}`: a `Value` may be a `Uuid`, and CodeQL + // reads Debug-formatting one into a panic as logging it in cleartext. + // Which type came back instead of a string is what this assertion is + // actually about. + other => panic!("expected a string from pr-str, got a {}", other.type_name()), + } +} + +/// A protocol defined in `mini.proto`, with the caller back in `user` and +/// `mp` aliased to it — the shape every port/adapter design takes. +const PRELUDE: &str = "(ns mini.proto) + (defprotocol IThing (-describe [this])) + (ns user) + (alias 'mp 'mini.proto) + "; + +// ── The three impl sites ───────────────────────────────────────────────────── + +#[test] +fn defrecord_implements_a_protocol_from_another_namespace() { + assert_eq!( + eval_pr(&format!( + "{PRELUDE} + (defrecord R [n] mp/IThing (-describe [_] [:record n])) + (pr-str (mp/-describe (->R 1)))" + )), + "[:record 1]" + ); +} + +#[test] +fn deftype_implements_a_protocol_from_another_namespace() { + assert_eq!( + eval_pr(&format!( + "{PRELUDE} + (deftype T [n] mp/IThing (-describe [_] [:type n])) + (pr-str (mp/-describe (->T 2)))" + )), + "[:type 2]" + ); +} + +#[test] +fn reify_implements_a_protocol_from_another_namespace() { + assert_eq!( + eval_pr(&format!( + "{PRELUDE} + (pr-str (mp/-describe (reify mp/IThing (-describe [_] :reified))))" + )), + ":reified" + ); +} + +#[test] +fn extend_type_names_a_protocol_from_another_namespace() { + assert_eq!( + eval_pr(&format!( + "{PRELUDE} + (extend-type String mp/IThing (-describe [s] [:string s])) + (pr-str (mp/-describe \"hi\"))" + )), + "[:string \"hi\"]" + ); +} + +#[test] +fn extend_protocol_names_a_protocol_from_another_namespace() { + assert_eq!( + eval_pr(&format!( + "{PRELUDE} + (extend-protocol mp/IThing Long (-describe [n] [:long n])) + (pr-str (mp/-describe 7))" + )), + "[:long 7]" + ); +} + +// ── Fully qualified, no alias ──────────────────────────────────────────────── + +#[test] +fn a_fully_qualified_protocol_name_resolves_without_an_alias() { + assert_eq!( + eval_pr( + "(ns mini.proto) + (defprotocol IThing (-describe [this])) + (ns user) + (defrecord R [] mini.proto/IThing (-describe [_] :qualified)) + (pr-str (mini.proto/-describe (->R)))" + ), + ":qualified" + ); +} + +// ── The unqualified case still resolves in the current ns ──────────────────── + +#[test] +fn an_unqualified_protocol_name_still_resolves_in_the_current_ns() { + assert_eq!( + eval_pr( + "(defprotocol P (-describe [this])) + (defrecord R [] P (-describe [_] :same-ns)) + (pr-str (-describe (->R)))" + ), + ":same-ns" + ); +} diff --git a/crates/cljrs-value/README.md b/crates/cljrs-value/README.md index d246fa159..ee9cca00e 100644 --- a/crates/cljrs-value/README.md +++ b/crates/cljrs-value/README.md @@ -503,18 +503,30 @@ pub struct CljxCons { `cljrs-value` stays free of evaluator dependencies while `LazySeq` can still call back through the trait object. -### `TypeInstance` (Phase 6-ext — defrecord/reify) +### `TypeInstance` (Phase 6-ext — defrecord/deftype/reify) ```rust pub struct TypeInstance { - pub type_tag: Arc, // record name (defrecord) or gensym (reify) - pub fields: MapValue, // keyword → value + pub type_tag: Arc, // type name, or a gensym for reify + pub fields: MapValue, // keyword → value (immutable fields) + pub mutable: Option>, // keyword → value, deftype only } ``` -Used by `defrecord` (named type_tag, generates `->Name`/`map->Name` constructors) and -`reify` (gensym'd type_tag, no constructors). Supports keyword field access `(:field rec)`, -`get`, `assoc` (returns new TypeInstance), and `count`. +Used by `defrecord` (named type_tag, generates `->Name`/`map->Name` constructors), +`deftype` (named type_tag, `->Name` only), and `reify` (gensym'd type_tag, no +constructors). Supports keyword field access `(:field rec)`, `get`, `assoc` +(returns new TypeInstance), and `count`. + +`mutable` holds a `deftype`'s `^:unsynchronized-mutable` / `^:volatile-mutable` +fields in one interior-mutable cell — an `Atom` over a keyword→value map — so +`set!` updates them in place and every clone of the instance sees the write. +It is `None` for `defrecord`, `reify`, and an all-immutable `deftype`. +Instances are `!Send`, so one shared cell needs no stronger volatility than an +`Atom`, and the two mutability markers behave identically. `assoc`/`assoc-in` +and `with-meta` carry the cell through; `serialize` folds the slot *values* +into the field map and `deserialize` restores `mutable: None`, since mutability +itself is runtime state that does not cross a clone boundary. ### `Volatile` / `Delay` / `CljxPromise` / `CljxFuture` / `Agent` (Phase 7) diff --git a/crates/cljrs-value/src/clone.rs b/crates/cljrs-value/src/clone.rs index 10a3d2560..3c29af687 100644 --- a/crates/cljrs-value/src/clone.rs +++ b/crates/cljrs-value/src/clone.rs @@ -401,7 +401,19 @@ pub fn serialize(v: &Value) -> Result { // ── Records ── Value::TypeInstance(p) => { let ti = p.get(); - let fields = serialize_map_pairs(&ti.fields)?; + // Fold any mutable-field slots into the serialized field map: the + // snapshot preserves their VALUES. Mutability itself is runtime + // state and is not restored (deserialize sets `mutable: None`). + let fields = match ti.mutable.as_ref().map(|a| a.get().deref()) { + Some(Value::Map(mm)) => { + let mut merged = ti.fields.clone(); + for (k, v) in mm.iter() { + merged = merged.assoc(k.clone(), v.clone()); + } + serialize_map_pairs(&merged)? + } + _ => serialize_map_pairs(&ti.fields)?, + }; Ok(SerializedValue::TypeInstance { type_tag: ti.type_tag.clone(), fields, @@ -680,6 +692,7 @@ pub fn deserialize(sv: SerializedValue) -> Value { Value::TypeInstance(GcPtr::new(TypeInstance { type_tag, fields: MapValue::from_pairs(pairs), + mutable: None, })) } diff --git a/crates/cljrs-value/src/value.rs b/crates/cljrs-value/src/value.rs index 8b0011a6e..dc89030aa 100644 --- a/crates/cljrs-value/src/value.rs +++ b/crates/cljrs-value/src/value.rs @@ -1342,11 +1342,21 @@ impl cljrs_gc::Trace for MapValue { pub struct TypeInstance { pub type_tag: Arc, pub fields: MapValue, + /// Mutable `deftype` fields (`^:unsynchronized-mutable` / + /// `^:volatile-mutable`), held in an interior-mutable cell — an `Atom` over + /// a keyword→value map — so `set!` can update them in place. `None` for + /// `defrecord`, `reify`, and immutable `deftype`s. Instances are `!Send`, + /// so one shared cell needs no stronger volatility than an `Atom`. + pub mutable: Option>, } impl cljrs_gc::Trace for TypeInstance { fn trace(&self, visitor: &mut cljrs_gc::MarkVisitor) { + use cljrs_gc::GcVisitor as _; self.fields.trace(visitor); + if let Some(m) = &self.mutable { + visitor.visit(m); + } } } diff --git a/docs/book/src/language/differences.md b/docs/book/src/language/differences.md index 7e1002800..76d03687b 100644 --- a/docs/book/src/language/differences.md +++ b/docs/book/src/language/differences.md @@ -39,8 +39,18 @@ implemented. ## `deftype` -`deftype` is not implemented. Use `defrecord` (which is fully supported) or -`reify` for most cases. +`deftype` is implemented: a positional `->Name` constructor, inline +protocol/interface method bodies with the fields in scope, `.-field` access, +and mutable fields (`^:unsynchronized-mutable` / `^:volatile-mutable`) written +with `set!` — both `(set! field v)` inside a method and +`(set! (.-field inst) v)` from outside. + +Instances are single-threaded here, so `^:volatile-mutable` and +`^:unsynchronized-mutable` behave identically. Unlike `defrecord`, `deftype` +generates no `map->Name` constructor and no map behaviour on the instance — +that matches Clojure. Host-class method calls (`(.someMethod inst)`) on an +instance are not supported; protocol methods are called as +`(proto-fn inst)`. ## Metadata on collections