sim_lib_lang_scheme/
forms.rs

1use std::sync::Arc;
2
3use sim_kernel::{
4    Claim, ClaimPattern, Cx, Expr, LibId, Ref, Result, Shape, Symbol, card::card_kind_predicate,
5};
6use sim_shape::{AnyShape, CaptureShape, ExactExprShape, ListShape};
7
8use crate::{scheme_base_export_kind_symbol, symbols::scheme_symbol};
9
10/// Whether a Scheme surface form is supported by this profile.
11#[derive(Clone)]
12pub enum SchemeFormStatus {
13    /// The form lowers to runtime behavior.
14    Supported,
15    /// The form is recognized but deferred; the string explains why.
16    Unsupported(&'static str),
17}
18
19/// Specification of one R7RS-small surface form: its symbol, doc, match shape,
20/// and support status.
21#[derive(Clone)]
22pub struct SchemeFormSpec {
23    /// Surface symbol naming the form.
24    pub symbol: Symbol,
25    /// One-line description of the form.
26    pub doc: &'static str,
27    /// `Shape` matching the form's head and tail.
28    pub shape: Arc<dyn Shape>,
29    /// Whether the form is supported or deferred.
30    pub status: SchemeFormStatus,
31}
32
33/// A Scheme base-library export: a surface symbol and its description.
34#[derive(Clone, Debug, PartialEq, Eq)]
35pub struct SchemeBaseExport {
36    /// `scheme`-qualified symbol of the export.
37    pub symbol: Symbol,
38    /// One-line description of the export.
39    pub doc: &'static str,
40}
41
42/// Returns the R7RS-small surface form specifications and their support status.
43pub fn r7rs_small_form_specs() -> Vec<SchemeFormSpec> {
44    [
45        ("quote", "datum quotation", SchemeFormStatus::Supported),
46        ("if", "conditional expression", SchemeFormStatus::Supported),
47        ("lambda", "procedure literal", SchemeFormStatus::Supported),
48        ("define", "definition form", SchemeFormStatus::Supported),
49        ("begin", "sequence expression", SchemeFormStatus::Supported),
50        (
51            "let",
52            "lexical binding via the binding organ",
53            SchemeFormStatus::Supported,
54        ),
55        (
56            "let*",
57            "sequential binding via the binding organ",
58            SchemeFormStatus::Supported,
59        ),
60        (
61            "letrec",
62            "recursive binding via the binding organ",
63            SchemeFormStatus::Supported,
64        ),
65        (
66            "set!",
67            "mutation marker reported as restricted",
68            SchemeFormStatus::Unsupported("mutation is deferred"),
69        ),
70        (
71            "call/cc",
72            "continuation capture beyond one-shot control",
73            SchemeFormStatus::Unsupported("full multishot continuations are deferred"),
74        ),
75        (
76            "dynamic-wind",
77            "dynamic wind control hooks",
78            SchemeFormStatus::Unsupported("dynamic-wind is deferred"),
79        ),
80        (
81            "eval",
82            "read-eval",
83            SchemeFormStatus::Unsupported("read-eval is capability gated"),
84        ),
85    ]
86    .into_iter()
87    .map(|(name, doc, status)| {
88        let symbol = Symbol::new(name);
89        SchemeFormSpec {
90            symbol: symbol.clone(),
91            doc,
92            shape: Arc::new(ListShape::with_rest(
93                vec![Arc::new(ExactExprShape::new(Expr::Symbol(symbol)))],
94                Arc::new(CaptureShape::new(
95                    Symbol::new("form-tail"),
96                    Arc::new(AnyShape),
97                )),
98            )),
99            status,
100        }
101    })
102    .collect()
103}
104
105/// Returns the supported R7RS-small forms as base-library exports.
106pub fn r7rs_small_base_exports() -> Vec<SchemeBaseExport> {
107    r7rs_small_form_specs()
108        .into_iter()
109        .filter(|form| matches!(form.status, SchemeFormStatus::Supported))
110        .map(|form| SchemeBaseExport {
111            symbol: scheme_symbol(&form.symbol.to_string()),
112            doc: form.doc,
113        })
114        .collect()
115}
116
117/// Publishes idempotent base-export card claims for the supported forms.
118pub fn publish_scheme_base_claims(cx: &mut Cx) -> Result<()> {
119    publish_scheme_base_claims_with_owner(cx, None)
120}
121
122/// Publishes base-export card claims as part of a loaded lib receipt.
123pub fn publish_scheme_base_claims_for_lib(cx: &mut Cx, lib_id: LibId) -> Result<()> {
124    publish_scheme_base_claims_with_owner(cx, Some(lib_id))
125}
126
127fn publish_scheme_base_claims_with_owner(cx: &mut Cx, owner: Option<LibId>) -> Result<()> {
128    for export in r7rs_small_base_exports() {
129        insert_once(
130            cx,
131            owner,
132            Ref::Symbol(export.symbol),
133            card_kind_predicate(),
134            Ref::Symbol(scheme_base_export_kind_symbol()),
135        )?;
136    }
137    Ok(())
138}
139
140fn insert_once(
141    cx: &mut Cx,
142    owner: Option<LibId>,
143    subject: Ref,
144    predicate: Symbol,
145    object: Ref,
146) -> Result<()> {
147    let exists = !cx
148        .query_facts(ClaimPattern::exact(
149            subject.clone(),
150            predicate.clone(),
151            object.clone(),
152        ))?
153        .is_empty();
154    if !exists {
155        let claim = Claim::public(subject, predicate, object);
156        match owner {
157            Some(lib_id) => {
158                cx.insert_fact_for_lib(lib_id, claim)?;
159            }
160            None => {
161                cx.insert_fact(claim)?;
162            }
163        }
164    }
165    Ok(())
166}
sim_lib_lang_scheme/forms.rs

sim_lib_lang_scheme/
forms.rs
