use serde::{Deserialize, Serialize};
use tatara_lisp::DeriveTataraDomain;
use crate::SpecError;
#[derive(Serialize, Deserialize, Debug, Clone, Copy, PartialEq, Eq)]
pub enum ForceStrategy {
Whnf,
Deep,
}
#[derive(Serialize, Deserialize, Debug, Clone, Copy, PartialEq, Eq)]
pub enum Sharing {
Referential,
PerSite,
}
#[derive(Serialize, Deserialize, Debug, Clone, Copy, PartialEq, Eq)]
pub enum StringContext {
Tracked,
Deferred,
}
#[derive(DeriveTataraDomain, Serialize, Deserialize, Debug, Clone)]
#[tatara(keyword = "deflaziness-model")]
pub struct LazinessModel {
pub name: String,
#[serde(rename = "forceStrategy")]
pub force_strategy: ForceStrategy,
pub sharing: Sharing,
#[serde(rename = "stringContext")]
pub string_context: StringContext,
#[serde(rename = "demandOrder")]
pub demand_order: String,
}
impl LazinessModel {
#[must_use]
pub fn is_parity_capable(&self) -> bool {
self.sharing == Sharing::Referential
&& self.string_context == StringContext::Tracked
}
}
#[derive(Serialize, Deserialize, Debug, Clone, Copy, PartialEq, Eq)]
pub enum Reentry {
Blackhole,
Promise,
}
#[derive(Serialize, Deserialize, Debug, Clone, Copy, PartialEq, Eq)]
pub enum RecursionKind {
Syntactic,
Fixpoint,
}
#[derive(DeriveTataraDomain, Serialize, Deserialize, Debug, Clone)]
#[tatara(keyword = "defthunk-discipline")]
pub struct ThunkDiscipline {
pub name: String,
pub recursive: bool,
pub reentry: Reentry,
#[serde(rename = "memoizeOnForce")]
pub memoize_on_force: bool,
#[serde(rename = "recursionKind")]
pub recursion_kind: RecursionKind,
}
impl ThunkDiscipline {
#[must_use]
pub fn is_correctly_classified(&self) -> bool {
match self.recursion_kind {
RecursionKind::Fixpoint => self.recursive && self.reentry == Reentry::Promise,
RecursionKind::Syntactic => true,
}
}
}
#[derive(Serialize, Deserialize, Debug, Clone, Copy, PartialEq, Eq)]
pub enum AttrKeyPosition {
Head,
Tail,
}
#[derive(Serialize, Deserialize, Debug, Clone, Copy, PartialEq, Eq)]
pub enum KeyForceSite {
Construction,
HeadDemand,
}
#[derive(DeriveTataraDomain, Serialize, Deserialize, Debug, Clone)]
#[tatara(keyword = "defattrkey-forcesite")]
pub struct AttrKeyForceSite {
pub name: String,
pub position: AttrKeyPosition,
#[serde(rename = "forceSite")]
pub force_site: KeyForceSite,
}
impl AttrKeyForceSite {
#[must_use]
pub fn is_parity_correct(&self) -> bool {
match self.position {
AttrKeyPosition::Head => self.force_site == KeyForceSite::Construction,
AttrKeyPosition::Tail => self.force_site == KeyForceSite::HeadDemand,
}
}
}
pub type ThunkId = u64;
#[derive(Debug, Clone, PartialEq, Eq)]
pub struct ValueRepr(pub String);
#[derive(Debug, Clone, PartialEq, Eq)]
pub enum ThunkState {
Unforced,
InProgress,
Forced(ValueRepr),
}
#[derive(Debug, Clone, PartialEq, Eq)]
pub enum ForceOutcome {
Computed(ValueRepr),
MemoHit(ValueRepr),
Recursed,
InfiniteRecursion,
}
pub trait ThunkEnvironment {
fn state(&self, id: ThunkId) -> ThunkState;
fn enter(&mut self, id: ThunkId);
fn memoize(&mut self, id: ThunkId, value: ValueRepr);
fn compute(&mut self, id: ThunkId) -> Result<ValueRepr, SpecError>;
}
pub fn force<E: ThunkEnvironment>(
model: &LazinessModel,
discipline: &ThunkDiscipline,
env: &mut E,
id: ThunkId,
) -> Result<ForceOutcome, SpecError> {
match env.state(id) {
ThunkState::Forced(v) => Ok(ForceOutcome::MemoHit(v)),
ThunkState::InProgress => Ok(match discipline.reentry {
Reentry::Promise if discipline.recursive => ForceOutcome::Recursed,
_ => ForceOutcome::InfiniteRecursion,
}),
ThunkState::Unforced => {
env.enter(id);
let v = env.compute(id)?;
if discipline.memoize_on_force && model.sharing == Sharing::Referential {
env.memoize(id, v.clone());
}
Ok(ForceOutcome::Computed(v))
}
}
}
pub const CANONICAL_LAZINESS_LISP: &str = include_str!("../specs/laziness.lisp");
pub fn load_canonical_models() -> Result<Vec<LazinessModel>, SpecError> {
crate::loader::load_all::<LazinessModel>(CANONICAL_LAZINESS_LISP)
}
pub fn load_canonical_disciplines() -> Result<Vec<ThunkDiscipline>, SpecError> {
crate::loader::load_all::<ThunkDiscipline>(CANONICAL_LAZINESS_LISP)
}
pub fn load_canonical_attrkey_forcesites() -> Result<Vec<AttrKeyForceSite>, SpecError> {
crate::loader::load_all::<AttrKeyForceSite>(CANONICAL_LAZINESS_LISP)
}
#[cfg(test)]
mod tests {
use super::*;
use std::collections::HashMap;
struct MockEnv {
states: HashMap<ThunkId, ThunkState>,
compute_returns: String,
compute_calls: u32,
}
impl ThunkEnvironment for MockEnv {
fn state(&self, id: ThunkId) -> ThunkState {
self.states.get(&id).cloned().unwrap_or(ThunkState::Unforced)
}
fn enter(&mut self, id: ThunkId) {
self.states.insert(id, ThunkState::InProgress);
}
fn memoize(&mut self, id: ThunkId, value: ValueRepr) {
self.states.insert(id, ThunkState::Forced(value));
}
fn compute(&mut self, _id: ThunkId) -> Result<ValueRepr, SpecError> {
self.compute_calls += 1;
Ok(ValueRepr(self.compute_returns.clone()))
}
}
fn cppnix_model() -> LazinessModel {
load_canonical_models()
.unwrap()
.into_iter()
.find(|m| m.name == "cppnix")
.expect("canonical cppnix model")
}
fn discipline(name: &str) -> ThunkDiscipline {
load_canonical_disciplines()
.unwrap()
.into_iter()
.find(|d| d.name == name)
.unwrap_or_else(|| panic!("canonical discipline {name}"))
}
#[test]
fn canonical_lisp_loads_model_and_disciplines() {
assert!(!load_canonical_models().unwrap().is_empty());
assert!(load_canonical_disciplines().unwrap().len() >= 2);
}
#[test]
fn canonical_attrkey_forcesites_load() {
let sites = load_canonical_attrkey_forcesites().unwrap();
assert!(sites.len() >= 2, "head-dynamic + tail-dynamic");
for s in &sites {
assert!(s.is_parity_correct(), "authored site {} diverges", s.name);
}
}
#[test]
fn tail_dynamic_key_eager_construction_is_the_module_system_bug() {
let buggy = AttrKeyForceSite {
name: "sui-pre-fix".into(),
position: AttrKeyPosition::Tail,
force_site: KeyForceSite::Construction,
};
assert!(!buggy.is_parity_correct());
let fixed = AttrKeyForceSite {
name: "sui-fixed".into(),
position: AttrKeyPosition::Tail,
force_site: KeyForceSite::HeadDemand,
};
assert!(fixed.is_parity_correct());
}
#[test]
fn cppnix_model_is_parity_capable() {
assert!(cppnix_model().is_parity_capable());
}
#[test]
fn perinit_persite_model_is_not_parity_capable() {
let bad = LazinessModel {
name: "sui-bug".into(),
force_strategy: ForceStrategy::Whnf,
sharing: Sharing::PerSite,
string_context: StringContext::Deferred,
demand_order: "nix".into(),
};
assert!(!bad.is_parity_capable());
}
#[test]
fn referential_sharing_memoises_then_reuses_no_recompute() {
let model = cppnix_model();
let disc = discipline("non-recursive");
let mut env = MockEnv {
states: HashMap::new(),
compute_returns: "az4wk589".into(),
compute_calls: 0,
};
let first = force(&model, &disc, &mut env, 1).unwrap();
assert_eq!(first, ForceOutcome::Computed(ValueRepr("az4wk589".into())));
let second = force(&model, &disc, &mut env, 1).unwrap();
assert_eq!(second, ForceOutcome::MemoHit(ValueRepr("az4wk589".into())));
assert_eq!(env.compute_calls, 1, "memoised thunk must not recompute");
}
#[test]
fn recursive_binding_reentry_is_a_promise_not_infinite_recursion() {
let model = cppnix_model();
let disc = discipline("recursive-binding");
let mut env = MockEnv {
states: HashMap::from([(7, ThunkState::InProgress)]),
compute_returns: String::new(),
compute_calls: 0,
};
assert_eq!(force(&model, &disc, &mut env, 7).unwrap(), ForceOutcome::Recursed);
}
#[test]
fn non_recursive_reentry_is_infinite_recursion() {
let model = cppnix_model();
let disc = discipline("non-recursive");
let mut env = MockEnv {
states: HashMap::from([(9, ThunkState::InProgress)]),
compute_returns: String::new(),
compute_calls: 0,
};
assert_eq!(
force(&model, &disc, &mut env, 9).unwrap(),
ForceOutcome::InfiniteRecursion
);
}
#[test]
fn every_authored_discipline_is_correctly_classified() {
for d in load_canonical_disciplines().unwrap() {
assert!(d.is_correctly_classified(), "discipline {} misclassified", d.name);
}
}
#[test]
fn overlay_fixpoint_forces_to_a_promise_not_infinite_recursion() {
let model = cppnix_model();
let disc = discipline("overlay-fixpoint");
assert_eq!(disc.recursion_kind, RecursionKind::Fixpoint);
let mut env = MockEnv {
states: HashMap::from([(42, ThunkState::InProgress)]),
compute_returns: String::new(),
compute_calls: 0,
};
assert_eq!(force(&model, &disc, &mut env, 42).unwrap(), ForceOutcome::Recursed);
}
#[test]
fn a_fixpoint_classified_as_non_recursive_is_the_bug() {
let bug = ThunkDiscipline {
name: "misclassified-overlay".into(),
recursive: false,
reentry: Reentry::Blackhole,
memoize_on_force: true,
recursion_kind: RecursionKind::Fixpoint,
};
assert!(!bug.is_correctly_classified());
}
}