scheme_rs/
records.rs

1//! Records (also known as structs).
2//!
3//! [`Records`](Record) are the mechanism by which new types are introduced to
4//! scheme and the method by which custom Rust types are stored and accessible
5//! to scheme code.
6//!
7//! Each records is described by its [`RecordTypeDescriptor`], which includes
8//! the names of its name and fields among other properties.
9//!
10//! # Implementing [`SchemeCompatible`]
11//!
12//! Any type that implements [`Trace`] and [`Debug`](std::fmt::Debug) is
13//! eligible to implement `SchemeCompatible`. Once this criteria is fulfilled,
14//! we first need to use the [`rtd`] proc macro to fill in the type descriptor.
15//!
16//! For example, let's say that we have `Enemy` struct that we want to have two
17//! immutable fields and one mutable field:
18//!
19//! ```rust
20//! # use std::sync::Mutex;
21//! # use scheme_rs::gc::Trace;
22//! #[derive(Trace, Debug)]
23//! struct Enemy {
24//!   // pos_x and pos_y will be immutable
25//!   pos_x: f64,
26//!   pos_y: f64,
27//!   // health will be mutable (thus the mutex)
28//!   health: Mutex<f64>,
29//! }
30//! ```
31//!
32//! We can now fill in the `rtd` for the type:
33//!
34//! ```rust
35//! # use std::sync::{Arc, Mutex};
36//! # use scheme_rs::{gc::Trace, records::{rtd, SchemeCompatible, RecordTypeDescriptor},
37//! # exceptions::Exception };
38//! # #[derive(Debug, Trace)]
39//! # struct Enemy {
40//! #   pos_x: f64,
41//! #   pos_y: f64,
42//! #   health: Mutex<f64>,
43//! # }
44//! impl SchemeCompatible for Enemy {
45//!     fn rtd() -> Arc<RecordTypeDescriptor> {
46//!         rtd!(
47//!             name: "enemy",
48//!             fields: [ "pos-x", "pos-y", mutable("health") ],
49//!             constructor: |pos_x, pos_y, health| {
50//!                 Ok(Enemy {
51//!                     pos_x: pos_x.try_to_scheme_type()?,
52//!                     pos_y: pos_y.try_to_scheme_type()?,
53//!                     health: Mutex::new(health.try_to_scheme_type()?),
54//!                 })
55//!             }
56//!         )
57//!     }
58//! }
59//! ```
60//!
61//! It's important to note that you need to provide an argument in the
62//! constructor for every field specified in `fields` and every parent field;
63//! however, this does not preclude you from omitting fields that are present in
64//! your data type from the `fields` list.
65//!
66//! Technically, [`rtd`](SchemeCompatible::rtd) is the only required method to
67//! implement `SchemeCompatible`, but since we populated `fields` it will be
68//! possible for the [`get_field`](SchemeCompatible::get_field) and
69//! [`set_field`](SchemeCompatible::set_field) functions to be called, which by
70//! default panic.
71//!
72//! Thus, we need to provide getters and setters for each field. We only need to
73//! provide setters for the mutable fields. Fields are indexed by their position
74//! in the `fields` array passed to `rtd`:
75//!
76//! ```rust
77//! # use std::sync::{Arc, Mutex};
78//! # use scheme_rs::{gc::Trace, value::Value, records::{rtd, SchemeCompatible, RecordTypeDescriptor}, exceptions::Exception};
79//! # #[derive(Debug, Trace)]
80//! # struct Enemy {
81//! #   pos_x: f64,
82//! #   pos_y: f64,
83//! #   health: Mutex<f64>,
84//! # }
85//! impl SchemeCompatible for Enemy {
86//! #    fn rtd() -> Arc<RecordTypeDescriptor> {
87//! #        rtd!(name: "enemy", sealed: true)
88//! #    }
89//!     fn get_field(&self, k: usize) -> Result<Value, Exception> {
90//!         match k {
91//!             0 => Ok(Value::from(self.pos_x)),
92//!             1 => Ok(Value::from(self.pos_y)),
93//!             2 => Ok(Value::from(*self.health.lock().unwrap())),
94//!             _ => Err(Exception::invalid_record_index(k)),
95//!         }
96//!     }
97//!
98//!     fn set_field(&self, k: usize, new_health: Value) -> Result<(), Exception> {
99//!         if k != 2 { return Err(Exception::invalid_record_index(k)); }
100//!         let new_health = f64::try_from(new_health)?;
101//!         *self.health.lock().unwrap() = new_health;
102//!         Ok(())
103//!     }
104//! }
105//! ```
106//!
107//! ## Expressing subtyping relationships
108//!
109//! It is possible to express the classic child/parent relationship in structs
110//! by embedding the parent in the child and implementing the
111//! [`extract_embedded_record`](SchemeCompatible::extract_embedded_record)
112//! function with the [`into_scheme_compatible`] function:
113//!
114//! ```rust
115//! # use std::sync::Arc;
116//! # use scheme_rs::{gc::{Trace, Gc}, value::Value, records::{rtd, SchemeCompatible, RecordTypeDescriptor, into_scheme_compatible}, exceptions::Exception};
117//! # #[derive(Debug, Trace)]
118//! # struct Enemy {
119//! #   pos_x: f64,
120//! #   pos_y: f64,
121//! #   health: f64,
122//! # }
123//! # impl SchemeCompatible for Enemy {
124//! #    fn rtd() -> Arc<RecordTypeDescriptor> {
125//! #        rtd!(name: "enemy", sealed: true)
126//! #    }
127//! # }
128//! #[derive(Debug, Trace)]
129//! struct SpecialEnemy {
130//!     parent: Gc<Enemy>,
131//!     special: u64,
132//! }
133//!
134//! impl SchemeCompatible for SpecialEnemy {
135//!     fn rtd() -> Arc<RecordTypeDescriptor> {
136//!         rtd!(
137//!             name: "enemy",
138//!             parent: Enemy,
139//!             fields: ["special"],
140//!             // The constructor must take all of the arguments
141//!             // required by all of the parent objects, in order.
142//!             constructor: |pos_x, pos_y, health, special| {
143//!                 Ok(SpecialEnemy {
144//!                     parent: Gc::new(Enemy {
145//!                         pos_x: pos_x.try_to_scheme_type()?,
146//!                         pos_y: pos_y.try_to_scheme_type()?,
147//!                         health: health.try_to_scheme_type()?,
148//!                     }),
149//!                     special: special.try_to_scheme_type()?,
150//!                 })
151//!             }
152//!         )
153//!     }
154//!
155//!     fn get_field(&self, _k: usize) -> Result<Value, Exception> {
156//!         Ok(Value::from(self.special))
157//!     }
158//!
159//!     fn extract_embedded_record(
160//!         &self,
161//!         rtd: &Arc<RecordTypeDescriptor>
162//!     ) -> Option<Gc<dyn SchemeCompatible>> {
163//!         Enemy::rtd()
164//!             .is_subtype_of(rtd)
165//!             .then(|| into_scheme_compatible(self.parent.clone()))
166//!     }
167//! }
168//! ```
169//!
170//! ## Defining Rust types as Scheme records
171//!
172//! There is still a little bit more work to do in order to have our Rust type
173//! appear fully as a record in scheme. First, we can use the `lib` keyword in
174//! the `rtd!` macro to specify a location to put a procedure that returns our
175//! type's rtd:
176//!
177//! ```rust
178//! # use std::sync::Arc;
179//! # use scheme_rs::{gc::Trace, records::{rtd, SchemeCompatible, RecordTypeDescriptor},
180//! # exceptions::Exception };
181//! # #[derive(Debug, Trace)]
182//! # struct Enemy {}
183//! impl SchemeCompatible for Enemy {
184//!     fn rtd() -> Arc<RecordTypeDescriptor> {
185//!         rtd!(
186//!             lib: "(enemies (1))",
187//!             // ...
188//! #           name: "enemy",
189//! #           sealed: true, opaque: true,
190//!         )
191//!     }
192//! }
193//! ```
194//!
195//! This will register the procedure `enemy-rtd` in the `(enemies (1))` scheme
196//! library. We can expand that library using the `define-rust-type` macro
197//! provided by the `(rust (1))` library to define enemy fully as a scheme
198//! record:
199//!
200//! ```scheme
201//! (library (enemies (1))
202//!  (export enemy make-enemy enemy?)
203//!  (import (rust (1)))
204//!
205//!  (define-rust-type enemy (enemy-rtd) make-enemy enemy?))
206//! ```
207
208use std::{
209    any::Any,
210    collections::HashMap,
211    fmt,
212    mem::ManuallyDrop,
213    ptr::NonNull,
214    sync::{Arc, LazyLock, Mutex},
215};
216
217use by_address::ByAddress;
218use parking_lot::RwLock;
219
220use crate::{
221    exceptions::Exception,
222    gc::{Gc, GcInner, Trace},
223    proc::{Application, DynamicState, FuncPtr, Procedure},
224    registry::{bridge, cps_bridge},
225    runtime::{Runtime, RuntimeInner},
226    symbols::Symbol,
227    value::{UnpackedValue, Value, ValueType},
228    vectors::Vector,
229};
230
231pub use scheme_rs_macros::rtd;
232
233/// Type declaration for a record.
234#[derive(Trace, Clone)]
235#[repr(align(16))]
236pub struct RecordTypeDescriptor {
237    /// The name of the record.
238    pub name: Symbol,
239    /// Whether or not the record is "sealed". Sealed records cannot be made the
240    /// parent of other records.
241    pub sealed: bool,
242    /// Whether or not the record is "opaque". Opaque records are not considered
243    /// to be records proper and fail the `record?` predicate.
244    pub opaque: bool,
245    /// An optional universal identifier for the record. Prevents the record
246    /// from being "generative," i.e. unique upon each call to
247    /// `define-record-type`.
248    pub uid: Option<Symbol>,
249    /// Whether or not the type being described is a Rust type.
250    pub rust_type: bool,
251    /// The Rust parent of the record type, if it exists.
252    pub rust_parent_constructor: Option<RustParentConstructor>,
253    /// Parent is most recently inserted record type, if one exists.
254    pub inherits: indexmap::IndexSet<ByAddress<Arc<RecordTypeDescriptor>>>,
255    /// The index into `fields` where this record's fields proper begin. All of
256    /// the previous fields belong to a parent.
257    pub field_index_offset: usize,
258    /// The fields of the record, notincluding any of the ones inherited from
259    /// parents.
260    pub fields: Vec<Field>,
261}
262
263impl RecordTypeDescriptor {
264    pub fn is_base_record_type(&self) -> bool {
265        self.inherits.is_empty()
266    }
267
268    pub fn is_subtype_of(self: &Arc<Self>, rtd: &Arc<Self>) -> bool {
269        Arc::ptr_eq(self, rtd) || self.inherits.contains(&ByAddress(rtd.clone()))
270    }
271}
272
273impl fmt::Debug for RecordTypeDescriptor {
274    fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
275        write!(
276            f,
277            "#<rtd name: {} sealed: {} opaque: {} rust: {} ",
278            self.name, self.sealed, self.opaque, self.rust_type,
279        )?;
280        if !self.inherits.is_empty() {
281            let parent = self.inherits.last().unwrap();
282            write!(f, "parent: {} ", parent.name)?;
283        }
284        write!(f, "fields: (")?;
285        for (i, field) in self.fields.iter().enumerate() {
286            if i > 0 {
287                write!(f, " ")?;
288            }
289            field.fmt(f)?;
290        }
291        write!(f, ")>")?;
292        Ok(())
293    }
294}
295
296/// Description of a Record field.
297#[derive(Trace, Clone)]
298pub enum Field {
299    Immutable(Symbol),
300    Mutable(Symbol),
301}
302
303impl Field {
304    fn parse(field: &Value) -> Result<Self, Exception> {
305        let (mutability, field_name) = field.clone().try_into()?;
306        let mutability: Symbol = mutability.try_into()?;
307        let (field_name, _) = field_name.clone().try_into()?;
308        let field_name: Symbol = field_name.try_into()?;
309        match &*mutability.to_str() {
310            "mutable" => Ok(Field::Mutable(field_name)),
311            "immutable" => Ok(Field::Immutable(field_name)),
312            _ => Err(Exception::error(
313                "mutability specifier must be mutable or immutable".to_string(),
314            )),
315        }
316    }
317
318    fn parse_fields(fields: &Value) -> Result<Vec<Self>, Exception> {
319        let fields: Vector = fields.clone().try_into()?;
320        fields.0.vec.read().iter().map(Self::parse).collect()
321    }
322
323    fn name(&self) -> Symbol {
324        match self {
325            Self::Immutable(sym) | Self::Mutable(sym) => *sym,
326        }
327    }
328}
329
330impl fmt::Debug for Field {
331    fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
332        match self {
333            Self::Immutable(sym) => write!(f, "(immutable {sym})"),
334            Self::Mutable(sym) => write!(f, "(mutable {sym})"),
335        }
336    }
337}
338
339type NonGenerativeStore = LazyLock<Arc<Mutex<HashMap<Symbol, Arc<RecordTypeDescriptor>>>>>;
340
341static NONGENERATIVE: NonGenerativeStore = LazyLock::new(|| Arc::new(Mutex::new(HashMap::new())));
342
343#[bridge(
344    name = "make-record-type-descriptor",
345    lib = "(rnrs records procedural (6))"
346)]
347pub fn make_record_type_descriptor(
348    name: &Value,
349    parent: &Value,
350    uid: &Value,
351    sealed: &Value,
352    opaque: &Value,
353    fields: &Value,
354) -> Result<Vec<Value>, Exception> {
355    let uid: Option<Symbol> = if uid.is_true() {
356        Some(uid.clone().try_into()?)
357    } else {
358        None
359    };
360
361    // If the record is non-generative, check to see if it has already been
362    // instanciated.
363    if let Some(ref uid) = uid
364        && let Some(rtd) = NONGENERATIVE.lock().unwrap().get(uid)
365    {
366        return Ok(vec![Value::from(rtd.clone())]);
367    }
368
369    let name: Symbol = name.clone().try_into()?;
370    let parent: Option<Arc<RecordTypeDescriptor>> = parent
371        .is_true()
372        .then(|| parent.clone().try_into())
373        .transpose()?;
374    let inherits = if let Some(parent) = parent {
375        let mut inherits = parent.inherits.clone();
376        inherits.insert(ByAddress(parent));
377        inherits
378    } else {
379        indexmap::IndexSet::new()
380    };
381    let field_index_offset = inherits.last().map_or(0, |last_parent| {
382        last_parent.field_index_offset + last_parent.fields.len()
383    });
384    let sealed = sealed.is_true();
385    let opaque = opaque.is_true();
386    let fields = Field::parse_fields(fields)?;
387    let rtd = Arc::new(RecordTypeDescriptor {
388        name,
389        sealed,
390        opaque,
391        uid,
392        rust_type: false,
393        rust_parent_constructor: None,
394        inherits,
395        field_index_offset,
396        fields,
397    });
398
399    if let Some(uid) = uid {
400        NONGENERATIVE.lock().unwrap().insert(uid, rtd.clone());
401    }
402
403    Ok(vec![Value::from(rtd)])
404}
405
406#[bridge(
407    name = "record-type-descriptor?",
408    lib = "(rnrs records procedural (6))"
409)]
410pub fn record_type_descriptor_pred(obj: &Value) -> Result<Vec<Value>, Exception> {
411    Ok(vec![Value::from(
412        obj.type_of() == ValueType::RecordTypeDescriptor,
413    )])
414}
415
416/// A description of a record's constructor.
417#[derive(Trace, Clone)]
418pub struct RecordConstructorDescriptor {
419    parent: Option<Gc<RecordConstructorDescriptor>>,
420    rtd: Arc<RecordTypeDescriptor>,
421    protocol: Procedure,
422}
423
424impl SchemeCompatible for RecordConstructorDescriptor {
425    fn rtd() -> Arc<RecordTypeDescriptor> {
426        rtd!(name: "record-constructor-descriptor", sealed: true, opaque: true)
427    }
428}
429
430impl fmt::Debug for RecordConstructorDescriptor {
431    fn fmt(&self, _f: &mut fmt::Formatter<'_>) -> fmt::Result {
432        Ok(())
433    }
434}
435
436fn make_default_record_constructor_descriptor(
437    runtime: Runtime,
438    rtd: Arc<RecordTypeDescriptor>,
439) -> Gc<RecordConstructorDescriptor> {
440    let parent = rtd.inherits.last().map(|parent| {
441        make_default_record_constructor_descriptor(runtime.clone(), parent.0.clone())
442    });
443    let protocol = Procedure::new(
444        runtime,
445        vec![Value::from(rtd.clone())],
446        FuncPtr::Bridge(default_protocol),
447        1,
448        false,
449    );
450    Gc::new(RecordConstructorDescriptor {
451        parent,
452        rtd,
453        protocol,
454    })
455}
456
457#[cps_bridge(
458    def = "make-record-constructor-descriptor rtd parent-constructor-descriptor protocol",
459    lib = "(rnrs records procedural (6))"
460)]
461pub fn make_record_constructor_descriptor(
462    runtime: &Runtime,
463    _env: &[Value],
464    args: &[Value],
465    _rest_args: &[Value],
466    _dyn_state: &mut DynamicState,
467    k: Value,
468) -> Result<Application, Exception> {
469    let k: Procedure = k.try_into()?;
470    let [rtd, parent_rcd, protocol] = args else {
471        unreachable!();
472    };
473
474    let rtd: Arc<RecordTypeDescriptor> = rtd.clone().try_into()?;
475
476    if rtd.rust_type && rtd.rust_parent_constructor.is_none() {
477        return Err(Exception::error(format!(
478            "cannot create a record-constructor-descriptor for rust type without a constructor {}",
479            rtd.name
480        )));
481    }
482
483    let parent_rcd = if parent_rcd.is_true() {
484        let Some(parent_rtd) = rtd.inherits.last() else {
485            return Err(Exception::error("RTD is a base type".to_string()));
486        };
487        let parent_rcd = parent_rcd.try_to_rust_type::<RecordConstructorDescriptor>()?;
488        if !Arc::ptr_eq(&parent_rcd.rtd, parent_rtd) {
489            return Err(Exception::error(
490                "Parent RTD does not match parent RCD".to_string(),
491            ));
492        }
493        Some(parent_rcd)
494    } else if !rtd.is_base_record_type() {
495        Some(make_default_record_constructor_descriptor(
496            runtime.clone(),
497            rtd.inherits.last().unwrap().clone().0,
498        ))
499    } else {
500        None
501    };
502
503    let protocol = if protocol.is_true() {
504        protocol.clone().try_into()?
505    } else {
506        Procedure::new(
507            runtime.clone(),
508            vec![Value::from(rtd.clone())],
509            FuncPtr::Bridge(default_protocol),
510            1,
511            false,
512        )
513    };
514
515    let rcd = RecordConstructorDescriptor {
516        parent: parent_rcd,
517        rtd,
518        protocol,
519    };
520
521    Ok(Application::new(
522        k,
523        vec![Value::from(Record::from_rust_type(rcd))],
524    ))
525}
526
527#[cps_bridge(def = "record-constructor rcd", lib = "(rnrs records procedural (6))")]
528pub fn record_constructor(
529    runtime: &Runtime,
530    _env: &[Value],
531    args: &[Value],
532    _rest_args: &[Value],
533    dyn_state: &mut DynamicState,
534    k: Value,
535) -> Result<Application, Exception> {
536    let [rcd] = args else {
537        unreachable!();
538    };
539    let rcd = rcd.try_to_rust_type::<RecordConstructorDescriptor>()?;
540
541    let (protocols, rtds) = rcd_to_protocols_and_rtds(&rcd);
542
543    // See if there is a rust constructor available
544    let rust_constructor = rtds
545        .iter()
546        .rev()
547        .find(|rtd| rtd.rust_parent_constructor.is_some())
548        .map_or_else(|| Value::from(false), |rtd| Value::from(rtd.clone()));
549
550    let protocols = protocols.into_iter().map(Value::from).collect::<Vec<_>>();
551    let rtds = rtds.into_iter().map(Value::from).collect::<Vec<_>>();
552    let chain_protocols = Value::from(dyn_state.new_k(
553        runtime.clone(),
554        vec![Value::from(protocols), k],
555        chain_protocols,
556        1,
557        false,
558    ));
559
560    Ok(chain_constructors(
561        runtime,
562        &[Value::from(rtds), rust_constructor],
563        &[],
564        &[],
565        dyn_state,
566        chain_protocols,
567    ))
568}
569
570fn rcd_to_protocols_and_rtds(
571    rcd: &Gc<RecordConstructorDescriptor>,
572) -> (Vec<Procedure>, Vec<Arc<RecordTypeDescriptor>>) {
573    let (mut protocols, mut rtds) = if let Some(ref parent) = rcd.parent {
574        rcd_to_protocols_and_rtds(parent)
575    } else {
576        (Vec::new(), Vec::new())
577    };
578    protocols.push(rcd.protocol.clone());
579    rtds.push(rcd.rtd.clone());
580    (protocols, rtds)
581}
582
583pub(crate) unsafe extern "C" fn chain_protocols(
584    runtime: *mut GcInner<RwLock<RuntimeInner>>,
585    env: *const Value,
586    args: *const Value,
587    dyn_state: *mut DynamicState,
588) -> *mut Application {
589    unsafe {
590        // env[0] is a vector of protocols
591        let protocols: Vector = env.as_ref().unwrap().clone().try_into().unwrap();
592        // env[1] is k, the continuation
593        let k = env.add(1).as_ref().unwrap().clone();
594
595        let mut protocols = protocols.0.vec.read().clone();
596        let remaining_protocols = protocols.split_off(1);
597        let curr_protocol: Procedure = protocols[0].clone().try_into().unwrap();
598
599        // If there are no more remaining protocols after the current, call the
600        // protocol with arg[0] and the continuation.
601        if remaining_protocols.is_empty() {
602            return Box::into_raw(Box::new(Application::new(
603                curr_protocol,
604                vec![args.as_ref().unwrap().clone(), k.clone()],
605            )));
606        }
607
608        // Otherwise, turn the remaining chain into the continuation:
609        let new_k = dyn_state.as_mut().unwrap().new_k(
610            Runtime::from_raw_inc_rc(runtime),
611            vec![Value::from(remaining_protocols), k],
612            chain_protocols,
613            1,
614            false,
615        );
616
617        Box::into_raw(Box::new(Application::new(
618            curr_protocol,
619            vec![args.as_ref().unwrap().clone(), Value::from(new_k)],
620        )))
621    }
622}
623
624#[cps_bridge]
625fn chain_constructors(
626    runtime: &Runtime,
627    env: &[Value],
628    args: &[Value],
629    _rest_args: &[Value],
630    _dyn_state: &mut DynamicState,
631    k: Value,
632) -> Result<Application, Exception> {
633    let k: Procedure = k.try_into()?;
634    // env[0] is a vector of RTDs
635    let rtds: Vector = env[0].clone().try_into()?;
636    // env[1] is the possible rust constructor
637    let rust_constructor = env[1].clone();
638    let mut rtds = rtds.0.vec.read().clone();
639    let remaining_rtds = rtds.split_off(1);
640    let curr_rtd: Arc<RecordTypeDescriptor> = rtds[0].clone().try_into()?;
641    let rtds_remain = !remaining_rtds.is_empty();
642    let num_args = curr_rtd.fields.len();
643    let env = if rtds_remain {
644        vec![Value::from(remaining_rtds), rust_constructor]
645    } else {
646        vec![Value::from(curr_rtd), rust_constructor]
647    }
648    .into_iter()
649    // Chain the current environment:
650    .chain(env[2..].iter().cloned())
651    // Chain the arguments passed to this function:
652    .chain(args.iter().cloned())
653    .collect::<Vec<_>>();
654    let next_proc = Procedure::new(
655        runtime.clone(),
656        env,
657        if rtds_remain {
658            FuncPtr::Bridge(chain_constructors)
659        } else {
660            FuncPtr::Bridge(constructor)
661        },
662        num_args,
663        false,
664    );
665    Ok(Application::new(k, vec![Value::from(next_proc)]))
666}
667
668#[cps_bridge]
669fn constructor(
670    _runtime: &Runtime,
671    env: &[Value],
672    args: &[Value],
673    _rest_args: &[Value],
674    _dyn_state: &mut DynamicState,
675    k: Value,
676) -> Result<Application, Exception> {
677    let k: Procedure = k.try_into()?;
678    let rtd: Arc<RecordTypeDescriptor> = env[0].clone().try_into()?;
679    // The fields of the record are all of the env variables chained with
680    // the arguments to this function.
681    let mut fields = env[2..]
682        .iter()
683        .cloned()
684        .chain(args.iter().cloned())
685        .collect::<Vec<_>>();
686    // Check for a rust constructor
687    let rust_constructor = env[1].clone();
688    let (rust_parent, fields) = if rust_constructor.is_true() {
689        let rust_rtd: Arc<RecordTypeDescriptor> = rust_constructor.try_into()?;
690        let num_fields: usize = rust_rtd
691            .inherits
692            .iter()
693            .map(|parent| parent.fields.len())
694            .sum();
695        let remaining_fields = fields.split_off(num_fields + rust_rtd.fields.len());
696        (
697            Some((rust_rtd.rust_parent_constructor.unwrap().constructor)(
698                &fields,
699            )?),
700            remaining_fields,
701        )
702    } else {
703        (None, fields)
704    };
705    let record = Value::from(Record(Gc::new(RecordInner {
706        rust_parent,
707        rtd,
708        fields: fields.into_iter().map(RwLock::new).collect(),
709    })));
710    Ok(Application::new(k, vec![record]))
711}
712
713#[cps_bridge]
714fn default_protocol(
715    runtime: &Runtime,
716    env: &[Value],
717    args: &[Value],
718    _rest_args: &[Value],
719    _dyn_state: &mut DynamicState,
720    k: Value,
721) -> Result<Application, Exception> {
722    let k: Procedure = k.try_into()?;
723    let rtd: Arc<RecordTypeDescriptor> = env[0].clone().try_into()?;
724    let num_args = rtd.field_index_offset + rtd.fields.len();
725
726    let constructor = Procedure::new(
727        runtime.clone(),
728        vec![args[0].clone(), Value::from(rtd)],
729        FuncPtr::Bridge(default_protocol_constructor),
730        num_args,
731        false,
732    );
733
734    Ok(Application::new(k, vec![Value::from(constructor)]))
735}
736
737#[cps_bridge]
738fn default_protocol_constructor(
739    runtime: &Runtime,
740    env: &[Value],
741    args: &[Value],
742    _rest_args: &[Value],
743    dyn_state: &mut DynamicState,
744    k: Value,
745) -> Result<Application, Exception> {
746    let constructor: Procedure = env[0].clone().try_into()?;
747    let rtd: Arc<RecordTypeDescriptor> = env[1].clone().try_into()?;
748    let mut args = args.to_vec();
749
750    let k = if let Some(parent) = rtd.inherits.last() {
751        let remaining = args.split_off(parent.field_index_offset + parent.fields.len());
752        Value::from(dyn_state.new_k(
753            runtime.clone(),
754            vec![Value::from(remaining), k],
755            call_constructor_continuation,
756            1,
757            false,
758        ))
759    } else {
760        k
761    };
762
763    args.push(k);
764    Ok(Application::new(constructor, args))
765}
766
767pub(crate) unsafe extern "C" fn call_constructor_continuation(
768    _runtime: *mut GcInner<RwLock<RuntimeInner>>,
769    env: *const Value,
770    args: *const Value,
771    _dyn_state: *mut DynamicState,
772) -> *mut Application {
773    unsafe {
774        let constructor: Procedure = args.as_ref().unwrap().clone().try_into().unwrap();
775        let args: Vector = env.as_ref().unwrap().clone().try_into().unwrap();
776        let mut args = args.0.vec.read().clone();
777        let cont = env.add(1).as_ref().unwrap().clone();
778        args.push(cont);
779
780        // Call the constructor
781        Box::into_raw(Box::new(Application::new(constructor, args)))
782    }
783}
784
785/// A Scheme record type. Effectively a tuple of a fixed size array and some type
786/// information.
787#[derive(Trace, Clone)]
788pub struct Record(pub(crate) Gc<RecordInner>);
789
790impl Record {
791    pub fn rtd(&self) -> Arc<RecordTypeDescriptor> {
792        self.0.rtd.clone()
793    }
794
795    /// Convert any Rust type that implements [SchemeCompatible] into an opaque
796    /// record.
797    pub fn from_rust_type<T: SchemeCompatible>(t: T) -> Self {
798        let opaque_parent = Some(into_scheme_compatible(Gc::new(t)));
799        let rtd = T::rtd();
800        Self(Gc::new(RecordInner {
801            rust_parent: opaque_parent,
802            rtd,
803            fields: Vec::new(),
804        }))
805    }
806
807    /// Attempt to convert the record into a Rust type that implements
808    /// [SchemeCompatible].
809    pub fn cast<T: SchemeCompatible>(&self) -> Option<Gc<T>> {
810        let rust_parent = self.0.rust_parent.as_ref()?;
811
812        // Attempt to extract any embedded records
813        let rtd = T::rtd();
814        let mut t = rust_parent.clone();
815        while let Some(embedded) = { t.extract_embedded_record(&rtd) } {
816            t = embedded;
817        }
818
819        let t = ManuallyDrop::new(t);
820
821        // Second, convert the opaque_parent type into a Gc<dyn Any>
822        let any: NonNull<GcInner<dyn Any + Send + Sync>> = t.ptr;
823        let gc_any = Gc {
824            ptr: any,
825            marker: std::marker::PhantomData,
826        };
827
828        // Then, convert that back into the desired type
829        Gc::downcast::<T>(gc_any).ok()
830    }
831
832    /// Get the kth field of the Record
833    pub fn get_field(&self, k: usize) -> Result<Value, Exception> {
834        self.get_parent_field(&self.rtd(), k)
835    }
836
837    /// Get the kth field of a parent Record
838    pub fn get_parent_field(
839        &self,
840        rtd: &Arc<RecordTypeDescriptor>,
841        k: usize,
842    ) -> Result<Value, Exception> {
843        if !self.0.rtd.is_subtype_of(rtd) {
844            Err(Exception::error(format!("not a subtype of {rtd:?}")))
845        } else if let Some(mut t) = self.0.rust_parent.clone() {
846            while let Some(embedded) = { t.extract_embedded_record(rtd) } {
847                t = embedded;
848            }
849            t.get_field(rtd.field_index_offset + k)
850        } else {
851            Ok(self.0.fields[rtd.field_index_offset + k].read().clone())
852        }
853    }
854
855    /// Set the kth field of the Record
856    pub fn set_field(&self, k: usize, new_value: Value) -> Result<(), Exception> {
857        self.set_parent_field(&self.rtd(), k, new_value)
858    }
859
860    /// Set the kth field of a parent Record
861    pub fn set_parent_field(
862        &self,
863        rtd: &Arc<RecordTypeDescriptor>,
864        k: usize,
865        new_value: Value,
866    ) -> Result<(), Exception> {
867        if !self.0.rtd.is_subtype_of(rtd) {
868            Err(Exception::error(format!("not a subtype of {rtd:?}")))
869        } else if let Some(mut t) = self.0.rust_parent.clone() {
870            while let Some(embedded) = { t.extract_embedded_record(rtd) } {
871                t = embedded;
872            }
873            t.set_field(rtd.field_index_offset + k, new_value)
874        } else {
875            *self.0.fields[rtd.field_index_offset + k].write() = new_value;
876            Ok(())
877        }
878    }
879}
880
881impl fmt::Debug for Record {
882    fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
883        self.0.fmt(f)
884    }
885}
886
887#[derive(Trace)]
888#[repr(align(16))]
889pub(crate) struct RecordInner {
890    pub(crate) rust_parent: Option<Gc<dyn SchemeCompatible>>,
891    pub(crate) rtd: Arc<RecordTypeDescriptor>,
892    pub(crate) fields: Vec<RwLock<Value>>,
893}
894
895impl fmt::Debug for RecordInner {
896    fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
897        write!(f, "#<{}", self.rtd.name)?;
898        if let Some(parent) = &self.rust_parent {
899            write!(f, "{parent:?}")?;
900        }
901        let mut field_names = self
902            .rtd
903            .inherits
904            .iter()
905            .cloned()
906            .chain(Some(ByAddress(self.rtd.clone())))
907            .flat_map(|rtd| rtd.fields.clone());
908        for field in &self.fields {
909            let field = field.read();
910            let name = field_names.next().unwrap().name();
911            write!(f, " {name}: {field:?}")?;
912        }
913        write!(f, ">")
914    }
915}
916
917/// A Rust value that can present itself as a Scheme record.
918pub trait SchemeCompatible: fmt::Debug + Trace + Any + Send + Sync + 'static {
919    /// The Record Type Descriptor of the value. Can be constructed at runtime,
920    /// but cannot change.
921    fn rtd() -> Arc<RecordTypeDescriptor>
922    where
923        Self: Sized;
924
925    /// Extract the embedded record type with the matching record type
926    /// descriptor if it exists.
927    fn extract_embedded_record(
928        &self,
929        _rtd: &Arc<RecordTypeDescriptor>,
930    ) -> Option<Gc<dyn SchemeCompatible>> {
931        None
932    }
933
934    /// Fetch the kth field of the record.
935    fn get_field(&self, k: usize) -> Result<Value, Exception> {
936        Err(Exception::error(format!("invalid record field: {k}")))
937    }
938
939    /// Set the kth field of the record.
940    fn set_field(&self, k: usize, _val: Value) -> Result<(), Exception> {
941        Err(Exception::error(format!("invalid record field: {k}")))
942    }
943}
944
945/// Convenience function for converting a `Gc<T>` into a
946/// `Gc<dyn SchemeCompatible>`.
947///
948/// This isn't as simple as using the `as` keyword in Rust due to the
949/// instability of the `CoerceUnsized` trait.
950pub fn into_scheme_compatible(t: Gc<impl SchemeCompatible>) -> Gc<dyn SchemeCompatible> {
951    // Convert t into a Gc<dyn SchemeCompatible>. This has to be done
952    // manually since [CoerceUnsized] is unstable.
953    let t = ManuallyDrop::new(t);
954    let any: NonNull<GcInner<dyn SchemeCompatible>> = t.ptr;
955    Gc {
956        ptr: any,
957        marker: std::marker::PhantomData,
958    }
959}
960
961#[derive(Copy, Clone, Debug, Trace)]
962pub struct RustParentConstructor {
963    #[trace(skip)]
964    constructor: ParentConstructor,
965}
966
967impl RustParentConstructor {
968    pub fn new(constructor: ParentConstructor) -> Self {
969        Self { constructor }
970    }
971}
972
973type ParentConstructor = fn(&[Value]) -> Result<Gc<dyn SchemeCompatible>, Exception>;
974
975pub(crate) fn is_subtype_of(val: &Value, rt: Arc<RecordTypeDescriptor>) -> Result<bool, Exception> {
976    let UnpackedValue::Record(rec) = val.clone().unpack() else {
977        return Ok(false);
978    };
979    Ok(Arc::ptr_eq(&rec.0.rtd, &rt) || rec.0.rtd.inherits.contains(&ByAddress::from(rt)))
980}
981
982#[cps_bridge]
983fn record_predicate_fn(
984    _runtime: &Runtime,
985    env: &[Value],
986    args: &[Value],
987    _rest_args: &[Value],
988    _dyn_state: &mut DynamicState,
989    k: Value,
990) -> Result<Application, Exception> {
991    let k: Procedure = k.try_into()?;
992    let [val] = args else {
993        unreachable!();
994    };
995    // RTD is the first environment variable:
996    let rtd: Arc<RecordTypeDescriptor> = env[0].try_to_scheme_type()?;
997    Ok(Application::new(
998        k,
999        vec![Value::from(is_subtype_of(val, rtd)?)],
1000    ))
1001}
1002
1003#[cps_bridge(def = "record-predicate rtd", lib = "(rnrs records procedural (6))")]
1004pub fn record_predicate(
1005    runtime: &Runtime,
1006    _env: &[Value],
1007    args: &[Value],
1008    _rest_args: &[Value],
1009    _dyn_state: &mut DynamicState,
1010    k: Value,
1011) -> Result<Application, Exception> {
1012    let k: Procedure = k.try_into()?;
1013    let [rtd] = args else {
1014        unreachable!();
1015    };
1016    // TODO: Check if RTD is a record type.
1017    let pred_fn = Procedure::new(
1018        runtime.clone(),
1019        vec![rtd.clone()],
1020        FuncPtr::Bridge(record_predicate_fn),
1021        1,
1022        false,
1023    );
1024    Ok(Application::new(k, vec![Value::from(pred_fn)]))
1025}
1026
1027#[cps_bridge]
1028fn record_accessor_fn(
1029    _runtime: &Runtime,
1030    env: &[Value],
1031    args: &[Value],
1032    _rest_args: &[Value],
1033    _dyn_state: &mut DynamicState,
1034    k: Value,
1035) -> Result<Application, Exception> {
1036    let k: Procedure = k.try_into()?;
1037    let [val] = args else {
1038        unreachable!();
1039    };
1040    let record: Record = val.clone().try_into()?;
1041    // RTD is the first environment variable, field index is the second
1042    let rtd: Arc<RecordTypeDescriptor> = env[0].try_to_scheme_type()?;
1043    if !is_subtype_of(val, rtd.clone())? {
1044        return Err(Exception::error(
1045            "not a child of this record type".to_string(),
1046        ));
1047    }
1048    let idx: usize = env[1].clone().try_into()?;
1049    let val = if let Some(rust_parent) = &record.0.rust_parent
1050        && rtd.rust_type
1051    {
1052        let mut t = rust_parent.clone();
1053        while let Some(embedded) = { t.extract_embedded_record(&rtd) } {
1054            t = embedded;
1055        }
1056        t.get_field(idx)?
1057    } else {
1058        record.0.fields[idx].read().clone()
1059    };
1060    if val.is_undefined() {
1061        return Err(Exception::error(format!(
1062            "failed to get field!: {rtd:?}, {idx}"
1063        )));
1064    }
1065    Ok(Application::new(k, vec![val]))
1066}
1067
1068#[cps_bridge(def = "record-accessor rtd k", lib = "(rnrs records procedural (6))")]
1069pub fn record_accessor(
1070    runtime: &Runtime,
1071    _env: &[Value],
1072    args: &[Value],
1073    _rest_args: &[Value],
1074    _dyn_state: &mut DynamicState,
1075    k: Value,
1076) -> Result<Application, Exception> {
1077    let k: Procedure = k.try_into()?;
1078    let [rtd, idx] = args else {
1079        unreachable!();
1080    };
1081    let rtd: Arc<RecordTypeDescriptor> = rtd.clone().try_into()?;
1082    let idx: usize = idx.clone().try_into()?;
1083    if idx >= rtd.fields.len() {
1084        return Err(Exception::error(format!(
1085            "{idx} is out of range 0..{}",
1086            rtd.fields.len()
1087        )));
1088    }
1089    let idx = idx + rtd.field_index_offset;
1090    let accessor_fn = Procedure::new(
1091        runtime.clone(),
1092        vec![Value::from(rtd), Value::from(idx)],
1093        FuncPtr::Bridge(record_accessor_fn),
1094        1,
1095        false,
1096    );
1097    Ok(Application::new(k, vec![Value::from(accessor_fn)]))
1098}
1099
1100#[cps_bridge]
1101fn record_mutator_fn(
1102    _runtime: &Runtime,
1103    env: &[Value],
1104    args: &[Value],
1105    _rest_args: &[Value],
1106    _dyn_state: &mut DynamicState,
1107    k: Value,
1108) -> Result<Application, Exception> {
1109    let k: Procedure = k.try_into()?;
1110    let [rec, new_val] = args else {
1111        unreachable!();
1112    };
1113    let record: Record = rec.clone().try_into()?;
1114    // RTD is the first environment variable, field index is the second
1115    let rtd: Arc<RecordTypeDescriptor> = env[0].try_to_scheme_type()?;
1116    if !is_subtype_of(rec, rtd.clone())? {
1117        return Err(Exception::error(
1118            "not a child of this record type".to_string(),
1119        ));
1120    }
1121    let idx: usize = env[1].clone().try_into()?;
1122    if let Some(rust_parent) = &record.0.rust_parent
1123        && rtd.rust_type
1124    {
1125        let mut t = rust_parent.clone();
1126        while let Some(embedded) = { t.extract_embedded_record(&rtd) } {
1127            t = embedded;
1128        }
1129        t.set_field(idx, new_val.clone())?;
1130    } else {
1131        *record.0.fields[idx].write() = new_val.clone();
1132    }
1133    Ok(Application::new(k, vec![]))
1134}
1135
1136#[cps_bridge(def = "record-mutator rtd k", lib = "(rnrs records procedural (6))")]
1137pub fn record_mutator(
1138    runtime: &Runtime,
1139    _env: &[Value],
1140    args: &[Value],
1141    _rest_args: &[Value],
1142    _dyn_state: &mut DynamicState,
1143    k: Value,
1144) -> Result<Application, Exception> {
1145    let k: Procedure = k.try_into()?;
1146    let [rtd, idx] = args else {
1147        unreachable!();
1148    };
1149    let rtd: Arc<RecordTypeDescriptor> = rtd.clone().try_into()?;
1150    let idx: usize = idx.clone().try_into()?;
1151    if idx >= rtd.fields.len() {
1152        return Err(Exception::error(format!(
1153            "{idx} is out of range {}",
1154            rtd.fields.len()
1155        )));
1156    }
1157    if matches!(rtd.fields[idx], Field::Immutable(_)) {
1158        return Err(Exception::error(format!("{idx} is immutable")));
1159    }
1160    let idx = idx + rtd.field_index_offset;
1161    let mutator_fn = Procedure::new(
1162        runtime.clone(),
1163        vec![Value::from(rtd), Value::from(idx)],
1164        FuncPtr::Bridge(record_mutator_fn),
1165        2,
1166        false,
1167    );
1168    Ok(Application::new(k, vec![Value::from(mutator_fn)]))
1169}
1170
1171// Inspection library:
1172
1173#[bridge(name = "record?", lib = "(rnrs records inspection (6))")]
1174pub fn record_pred(obj: &Value) -> Result<Vec<Value>, Exception> {
1175    match &*obj.unpacked_ref() {
1176        UnpackedValue::Record(rec) => Ok(vec![Value::from(!rec.0.rtd.opaque)]),
1177        _ => Ok(vec![Value::from(false)]),
1178    }
1179}
1180
1181#[bridge(name = "record-rtd", lib = "(rnrs records inspection (6))")]
1182pub fn record_rtd(record: &Value) -> Result<Vec<Value>, Exception> {
1183    match &*record.unpacked_ref() {
1184        UnpackedValue::Record(rec) if !rec.0.rtd.opaque => Ok(vec![Value::from(rec.0.rtd.clone())]),
1185        _ => Err(Exception::error(
1186            "expected a non-opaque record type".to_string(),
1187        )),
1188    }
1189}
1190
1191#[bridge(name = "record-type-name", lib = "(rnrs records inspection (6))")]
1192pub fn record_type_name(rtd: &Value) -> Result<Vec<Value>, Exception> {
1193    let rtd: Arc<RecordTypeDescriptor> = rtd.clone().try_into()?;
1194    Ok(vec![Value::from(rtd.name)])
1195}
1196
1197#[bridge(name = "record-type-parent", lib = "(rnrs records inspection (6))")]
1198pub fn record_type_parent(rtd: &Value) -> Result<Vec<Value>, Exception> {
1199    let rtd: Arc<RecordTypeDescriptor> = rtd.clone().try_into()?;
1200    if let Some(parent) = rtd.inherits.last() {
1201        Ok(vec![Value::from(parent.0.clone())])
1202    } else {
1203        Ok(vec![Value::from(false)])
1204    }
1205}
1206
1207#[bridge(name = "record-type-uid", lib = "(rnrs records inspection (6))")]
1208pub fn record_type_uid(rtd: &Value) -> Result<Vec<Value>, Exception> {
1209    let rtd: Arc<RecordTypeDescriptor> = rtd.clone().try_into()?;
1210    if let Some(uid) = rtd.uid {
1211        Ok(vec![Value::from(uid)])
1212    } else {
1213        Ok(vec![Value::from(false)])
1214    }
1215}
1216
1217#[bridge(
1218    name = "record-type-generative?",
1219    lib = "(rnrs records inspection (6))"
1220)]
1221pub fn record_type_generative_pred(rtd: &Value) -> Result<Vec<Value>, Exception> {
1222    let rtd: Arc<RecordTypeDescriptor> = rtd.clone().try_into()?;
1223    Ok(vec![Value::from(rtd.uid.is_none())])
1224}
1225
1226#[bridge(name = "record-type-sealed?", lib = "(rnrs records inspection (6))")]
1227pub fn record_type_sealed_pred(rtd: &Value) -> Result<Vec<Value>, Exception> {
1228    let rtd: Arc<RecordTypeDescriptor> = rtd.clone().try_into()?;
1229    Ok(vec![Value::from(rtd.sealed)])
1230}
1231
1232#[bridge(name = "record-type-opaque?", lib = "(rnrs records inspection (6))")]
1233pub fn record_type_opaque_pred(rtd: &Value) -> Result<Vec<Value>, Exception> {
1234    let rtd: Arc<RecordTypeDescriptor> = rtd.clone().try_into()?;
1235    Ok(vec![Value::from(rtd.opaque)])
1236}
1237
1238#[bridge(
1239    name = "record-type-field-names",
1240    lib = "(rnrs records inspection (6))"
1241)]
1242pub fn record_type_field_names(rtd: &Value) -> Result<Vec<Value>, Exception> {
1243    let rtd: Arc<RecordTypeDescriptor> = rtd.clone().try_into()?;
1244    let fields = rtd
1245        .fields
1246        .iter()
1247        .map(Field::name)
1248        .map(Value::from)
1249        .collect::<Vec<_>>();
1250    Ok(vec![Value::from(fields)])
1251}
1252
1253#[bridge(name = "record-field-mutable?", lib = "(rnrs records inspection (6))")]
1254pub fn record_field_mutable_pred(rtd: &Value, k: &Value) -> Result<Vec<Value>, Exception> {
1255    let rtd: Arc<RecordTypeDescriptor> = rtd.clone().try_into()?;
1256    let k: usize = k.try_to_scheme_type()?;
1257
1258    if k >= rtd.fields.len() {
1259        return Err(Exception::invalid_index(k, rtd.fields.len()));
1260    }
1261
1262    Ok(vec![Value::from(matches!(
1263        rtd.fields[k],
1264        Field::Mutable(_)
1265    ))])
1266}
scheme_rs/records.rs

scheme_rs/
records.rs
