use logicaffeine_kernel::elaborate::is_meta;
use logicaffeine_kernel::prelude::StandardLibrary;
use logicaffeine_kernel::{
elaborate, elaborate_app, infer_type, instantiate, normalize, unify, Context, MetaCtx,
ParamKind, Term, Universe,
};
fn g(n: &str) -> Term {
Term::Global(n.to_string())
}
fn var(n: &str) -> Term {
Term::Var(n.to_string())
}
fn ty0() -> Term {
Term::Sort(Universe::Type(0))
}
fn app(f: Term, x: Term) -> Term {
Term::App(Box::new(f), Box::new(x))
}
fn lam(p: &str, t: Term, b: Term) -> Term {
Term::Lambda { param: p.to_string(), param_type: Box::new(t), body: Box::new(b) }
}
fn pi(p: &str, t: Term, b: Term) -> Term {
Term::Pi { param: p.to_string(), param_type: Box::new(t), body_type: Box::new(b) }
}
fn arrow(a: Term, b: Term) -> Term {
pi("_", a, b)
}
fn std_ctx() -> Context {
let mut ctx = Context::new();
StandardLibrary::register(&mut ctx);
ctx
}
fn has_meta(t: &Term) -> bool {
match t {
Term::Var(n) => is_meta(n),
Term::App(f, a) => has_meta(f) || has_meta(a),
Term::Pi { param_type, body_type, .. } => has_meta(param_type) || has_meta(body_type),
Term::Lambda { param_type, body, .. } => has_meta(param_type) || has_meta(body),
Term::Match { discriminant, motive, cases } => {
has_meta(discriminant) || has_meta(motive) || cases.iter().any(has_meta)
}
Term::Fix { body, .. } => has_meta(body),
_ => false,
}
}
fn register_id(ctx: &mut Context) -> Term {
let id_ty = pi("A", ty0(), arrow(var("A"), var("A")));
let id_body = lam("A", ty0(), lam("a", var("A"), var("a")));
ctx.add_definition("id".to_string(), id_ty.clone(), id_body);
id_ty
}
#[test]
fn metavariable_unifies_with_a_concrete_term() {
let ctx = std_ctx();
let mut m = MetaCtx::new();
let mv = m.fresh();
assert!(unify(&ctx, &mut m, &mv, &g("Nat")), "?0 =?= Nat");
assert_eq!(instantiate(&mv, &m), g("Nat"));
}
#[test]
fn unification_is_symmetric() {
let ctx = std_ctx();
let mut m = MetaCtx::new();
let mv = m.fresh();
assert!(unify(&ctx, &mut m, &g("Nat"), &mv), "Nat =?= ?0 solves the metavariable");
assert_eq!(instantiate(&mv, &m), g("Nat"));
}
#[test]
fn equal_concretes_unify_and_distinct_ones_do_not() {
let ctx = std_ctx();
let mut m = MetaCtx::new();
assert!(unify(&ctx, &mut m, &g("Nat"), &g("Nat")), "Nat =?= Nat");
assert!(!unify(&ctx, &mut m, &g("Nat"), &g("Bool")), "Nat ≠ Bool");
}
#[test]
fn unification_descends_through_application() {
let ctx = std_ctx();
let mut m = MetaCtx::new();
let mv = m.fresh();
let lhs = app(g("Succ"), mv.clone());
let rhs = app(g("Succ"), g("Zero"));
assert!(unify(&ctx, &mut m, &lhs, &rhs));
assert_eq!(instantiate(&mv, &m), g("Zero"));
}
#[test]
fn unification_descends_through_pi() {
let ctx = std_ctx();
let mut m = MetaCtx::new();
let mv = m.fresh();
let lhs = arrow(mv.clone(), mv.clone());
let rhs = arrow(g("Nat"), g("Nat"));
assert!(unify(&ctx, &mut m, &lhs, &rhs));
assert_eq!(instantiate(&mv, &m), g("Nat"));
}
#[test]
fn occurs_check_rejects_a_cyclic_solution() {
let ctx = std_ctx();
let mut m = MetaCtx::new();
let mv = m.fresh();
let cyclic = app(g("Succ"), mv.clone());
assert!(!unify(&ctx, &mut m, &mv, &cyclic), "the occurs-check must reject ?0 := Succ ?0");
}
#[test]
fn metavariables_chain_transitively() {
let ctx = std_ctx();
let mut m = MetaCtx::new();
let a = m.fresh();
let b = m.fresh();
assert!(unify(&ctx, &mut m, &a, &b));
assert!(unify(&ctx, &mut m, &b, &g("Nat")));
assert_eq!(instantiate(&a, &m), g("Nat"), "?0 follows ?1 to Nat");
}
#[test]
fn a_solved_metavariable_stays_consistent() {
let ctx = std_ctx();
let mut m = MetaCtx::new();
let mv = m.fresh();
assert!(unify(&ctx, &mut m, &mv, &g("Nat")));
assert!(!unify(&ctx, &mut m, &mv, &g("Bool")), "a solved metavariable cannot be re-bound");
assert!(unify(&ctx, &mut m, &mv, &g("Nat")), "but re-confirming the same solution is fine");
}
#[test]
fn sorts_unify_by_universe_equivalence() {
let ctx = std_ctx();
let mut m = MetaCtx::new();
assert!(unify(&ctx, &mut m, &ty0(), &ty0()), "Type 0 =?= Type 0");
assert!(!unify(&ctx, &mut m, &ty0(), &Term::Sort(Universe::Type(1))), "Type 0 ≠ Type 1");
}
#[test]
fn implicit_type_argument_is_inferred_from_the_value() {
let mut ctx = std_ctx();
let id_ty = register_id(&mut ctx);
let mut m = MetaCtx::new();
let (term, ty) =
elaborate_app(&ctx, &mut m, &g("id"), &id_ty, &[ParamKind::Implicit, ParamKind::Explicit], &[g("Zero")]).expect("elab");
assert_eq!(term, app(app(g("id"), g("Nat")), g("Zero")), "must reconstruct `id Nat Zero`");
assert_eq!(ty, g("Nat"), "its type is Nat");
assert!(!has_meta(&term), "the elaborated term has no leftover metavariables");
assert!(infer_type(&ctx, &term).is_ok(), "and the KERNEL certifies it");
}
#[test]
fn the_same_function_infers_a_different_implicit_per_use() {
let mut ctx = std_ctx();
let id_ty = register_id(&mut ctx);
let mut m = MetaCtx::new();
let (term, ty) =
elaborate_app(&ctx, &mut m, &g("id"), &id_ty, &[ParamKind::Implicit, ParamKind::Explicit], &[g("true")]).expect("elab");
assert_eq!(term, app(app(g("id"), g("Bool")), g("true")));
assert_eq!(ty, g("Bool"));
assert!(infer_type(&ctx, &term).is_ok());
}
#[test]
fn the_elaborated_application_computes() {
let mut ctx = std_ctx();
let id_ty = register_id(&mut ctx);
let mut m = MetaCtx::new();
let (term, _) =
elaborate_app(&ctx, &mut m, &g("id"), &id_ty, &[ParamKind::Implicit, ParamKind::Explicit], &[g("Zero")]).expect("elab");
assert_eq!(normalize(&ctx, &term), g("Zero"), "id Nat Zero ⇝ Zero");
}
#[test]
fn an_explicit_argument_of_the_wrong_type_is_rejected() {
let mut ctx = std_ctx();
let pair_ty = pi("A", ty0(), arrow(var("A"), arrow(var("A"), var("A"))));
ctx.add_declaration("pair", pair_ty.clone());
let mut m = MetaCtx::new();
let result = elaborate_app(
&ctx,
&mut m,
&g("pair"),
&pair_ty,
&[ParamKind::Implicit, ParamKind::Explicit, ParamKind::Explicit],
&[g("Zero"), g("true")],
);
assert!(result.is_err(), "Bool cannot unify with the already-inferred A = Nat");
}
#[test]
fn a_homogeneous_pair_with_matching_arguments_elaborates() {
let mut ctx = std_ctx();
let pair_ty = pi("A", ty0(), arrow(var("A"), arrow(var("A"), var("A"))));
ctx.add_declaration("pair", pair_ty.clone());
let mut m = MetaCtx::new();
let (term, ty) = elaborate_app(
&ctx,
&mut m,
&g("pair"),
&pair_ty,
&[ParamKind::Implicit, ParamKind::Explicit, ParamKind::Explicit],
&[g("Zero"), g("Zero")],
)
.expect("elab");
assert_eq!(term, app(app(app(g("pair"), g("Nat")), g("Zero")), g("Zero")));
assert_eq!(ty, g("Nat"));
assert!(infer_type(&ctx, &term).is_ok());
}
#[test]
fn an_explicit_hole_is_filled_by_elaboration() {
let mut ctx = std_ctx();
register_id(&mut ctx);
let mut m = MetaCtx::new();
let surface = app(app(g("id"), Term::Hole), g("Zero"));
let (term, ty) = elaborate(&ctx, &mut m, &surface, None).expect("elab");
let term = instantiate(&term, &m);
assert_eq!(term, app(app(g("id"), g("Nat")), g("Zero")), "the hole becomes Nat");
assert_eq!(instantiate(&ty, &m), g("Nat"));
assert!(!has_meta(&term));
assert!(infer_type(&ctx, &term).is_ok());
}
fn setup_inhabited(ctx: &mut Context) -> (Term, Term, Term) {
ctx.add_inductive("Inhabited", pi("A", ty0(), ty0()));
ctx.add_constructor(
"mk",
"Inhabited",
pi("A", ty0(), arrow(var("A"), app(g("Inhabited"), var("A")))),
);
let nat_inst = app(app(g("mk"), g("Nat")), g("Zero")); let bool_inst = app(app(g("mk"), g("Bool")), g("true")); ctx.add_instance(app(g("Inhabited"), g("Nat")), nat_inst.clone());
ctx.add_instance(app(g("Inhabited"), g("Bool")), bool_inst.clone());
let default_ty = pi("A", ty0(), arrow(app(g("Inhabited"), var("A")), var("A")));
let default_body = lam(
"A",
ty0(),
lam(
"i",
app(g("Inhabited"), var("A")),
Term::Match {
discriminant: Box::new(var("i")),
motive: Box::new(lam("_", app(g("Inhabited"), var("A")), var("A"))),
cases: vec![lam("a", var("A"), var("a"))],
},
),
);
ctx.add_definition("default_of".to_string(), default_ty.clone(), default_body);
(default_ty, nat_inst, bool_inst)
}
#[test]
fn instance_is_resolved_from_the_database_and_the_result_computes() {
let mut ctx = std_ctx();
let (default_ty, nat_inst, _) = setup_inhabited(&mut ctx);
let mut m = MetaCtx::new();
let (term, ty) = elaborate_app(
&ctx,
&mut m,
&g("default_of"),
&default_ty,
&[ParamKind::Explicit, ParamKind::Instance],
&[g("Nat")],
)
.expect("elaboration resolves the instance");
assert_eq!(
term,
app(app(g("default_of"), g("Nat")), nat_inst),
"the Inhabited-Nat instance must be selected"
);
assert_eq!(ty, g("Nat"));
assert!(!has_meta(&term));
assert!(infer_type(&ctx, &term).is_ok(), "the kernel certifies the resolved term");
assert_eq!(normalize(&ctx, &term), g("Zero"), "default_of Nat ⇝ Zero");
}
#[test]
fn resolution_selects_the_instance_matching_the_type() {
let mut ctx = std_ctx();
let (default_ty, _, bool_inst) = setup_inhabited(&mut ctx);
let mut m = MetaCtx::new();
let (term, ty) = elaborate_app(
&ctx,
&mut m,
&g("default_of"),
&default_ty,
&[ParamKind::Explicit, ParamKind::Instance],
&[g("Bool")],
)
.expect("elab");
assert_eq!(term, app(app(g("default_of"), g("Bool")), bool_inst));
assert_eq!(ty, g("Bool"));
assert_eq!(normalize(&ctx, &term), g("true"), "default_of Bool ⇝ true");
}
#[test]
fn instance_resolution_is_deferred_until_the_type_variable_is_solved() {
let mut ctx = std_ctx();
let (_default_ty, nat_inst, _) = setup_inhabited(&mut ctx);
let pick_ty =
pi("A", ty0(), arrow(app(g("Inhabited"), var("A")), arrow(var("A"), var("A"))));
let pick_body =
lam("A", ty0(), lam("i", app(g("Inhabited"), var("A")), lam("a", var("A"), var("a"))));
ctx.add_definition("pick".to_string(), pick_ty.clone(), pick_body);
let mut m = MetaCtx::new();
let (term, ty) = elaborate_app(
&ctx,
&mut m,
&g("pick"),
&pick_ty,
&[ParamKind::Implicit, ParamKind::Instance, ParamKind::Explicit],
&[g("Zero")],
)
.expect("deferred resolution succeeds");
assert_eq!(
term,
app(app(app(g("pick"), g("Nat")), nat_inst), g("Zero")),
"A inferred Nat from the value, THEN the Inhabited Nat instance resolved"
);
assert_eq!(ty, g("Nat"));
assert!(!has_meta(&term));
assert!(infer_type(&ctx, &term).is_ok());
}
#[test]
fn an_unresolvable_instance_is_an_error() {
let mut ctx = std_ctx();
let (default_ty, _, _) = setup_inhabited(&mut ctx);
let mut m = MetaCtx::new();
let result = elaborate_app(
&ctx,
&mut m,
&g("default_of"),
&default_ty,
&[ParamKind::Explicit, ParamKind::Instance],
&[g("Entity")],
);
assert!(result.is_err(), "no Inhabited Entity instance ⇒ resolution must fail");
}
fn add_list_instance(ctx: &mut Context) {
let list_ty = pi(
"A",
ty0(),
arrow(app(g("Inhabited"), var("A")), app(g("Inhabited"), app(g("TList"), var("A")))),
);
let list_body = lam(
"A",
ty0(),
lam(
"ia",
app(g("Inhabited"), var("A")),
app(
app(g("mk"), app(g("TList"), var("A"))),
app(
app(
app(g("TCons"), var("A")),
app(app(g("default_of"), var("A")), var("ia")),
),
app(g("TNil"), var("A")),
),
),
),
);
ctx.add_definition("list_inst".to_string(), list_ty.clone(), list_body);
ctx.add_instance(list_ty, g("list_inst"));
}
#[test]
fn a_polymorphic_instance_resolves_its_premise_recursively() {
let mut ctx = std_ctx();
let (default_ty, nat_inst, _) = setup_inhabited(&mut ctx);
add_list_instance(&mut ctx);
let tlist_nat = app(g("TList"), g("Nat"));
let mut m = MetaCtx::new();
let (term, ty) = elaborate_app(
&ctx,
&mut m,
&g("default_of"),
&default_ty,
&[ParamKind::Explicit, ParamKind::Instance],
&[tlist_nat.clone()],
)
.expect("recursive resolution succeeds");
assert_eq!(
term,
app(app(g("default_of"), tlist_nat.clone()), app(app(g("list_inst"), g("Nat")), nat_inst)),
"list_inst applied to Nat and the recursively-resolved Inhabited-Nat instance"
);
assert_eq!(ty, tlist_nat);
assert!(!has_meta(&term));
assert!(infer_type(&ctx, &term).is_ok(), "the kernel certifies the recursively-resolved term");
let singleton = app(app(app(g("TCons"), g("Nat")), g("Zero")), app(g("TNil"), g("Nat")));
assert_eq!(normalize(&ctx, &term), singleton, "default_of (TList Nat) ⇝ [Zero]");
}
#[test]
fn instance_resolution_recurses_through_two_levels() {
let mut ctx = std_ctx();
let (default_ty, nat_inst, _) = setup_inhabited(&mut ctx);
add_list_instance(&mut ctx);
let tlist_nat = app(g("TList"), g("Nat"));
let tlist_tlist_nat = app(g("TList"), tlist_nat.clone());
let mut m = MetaCtx::new();
let (term, ty) = elaborate_app(
&ctx,
&mut m,
&g("default_of"),
&default_ty,
&[ParamKind::Explicit, ParamKind::Instance],
&[tlist_tlist_nat.clone()],
)
.expect("two-level resolution succeeds");
let inner = app(app(g("list_inst"), g("Nat")), nat_inst); let outer = app(app(g("list_inst"), tlist_nat), inner); assert_eq!(term, app(app(g("default_of"), tlist_tlist_nat.clone()), outer));
assert_eq!(ty, tlist_tlist_nat);
assert!(!has_meta(&term));
assert!(infer_type(&ctx, &term).is_ok());
}
#[test]
fn a_polymorphic_instance_does_not_fire_without_its_premise() {
let mut ctx = std_ctx();
let (default_ty, _, _) = setup_inhabited(&mut ctx);
add_list_instance(&mut ctx);
let mut m = MetaCtx::new();
let result = elaborate_app(
&ctx,
&mut m,
&g("default_of"),
&default_ty,
&[ParamKind::Explicit, ParamKind::Instance],
&[app(g("TList"), g("Entity"))],
);
assert!(result.is_err(), "no Inhabited Entity ⇒ the List premise cannot be discharged");
}
#[test]
fn an_eliminator_motive_is_inferred_by_pattern_unification() {
let mut ctx = std_ctx();
ctx.add_inductive("Vec", pi("_", g("Nat"), ty0()));
let elim_ty = pi(
"P",
pi("_", g("Nat"), ty0()), arrow(
pi("n", g("Nat"), app(var("P"), var("n"))), app(var("P"), g("Zero")), ),
);
ctx.add_declaration("elim", elim_ty.clone());
ctx.add_declaration("f", pi("n", g("Nat"), app(g("Vec"), var("n"))));
let mut m = MetaCtx::new();
let (term, ty) = elaborate_app(
&ctx,
&mut m,
&g("elim"),
&elim_ty,
&[ParamKind::Implicit, ParamKind::Explicit],
&[g("f")],
)
.expect("the motive is inferred");
assert_eq!(
normalize(&ctx, &ty),
app(g("Vec"), g("Zero")),
"motive P := λn. Vec n inferred ⇒ result type P Zero ⇝ Vec Zero"
);
assert!(!has_meta(&term), "no leftover metavariables");
assert!(infer_type(&ctx, &term).is_ok(), "the kernel certifies the motive-inferred term");
}
#[test]
fn a_motive_is_inferred_under_a_lambda_binder() {
let mut ctx = std_ctx();
ctx.add_inductive("Vec", pi("_", g("Nat"), ty0()));
ctx.add_declaration("g_vec", pi("n", g("Nat"), app(g("Vec"), var("n"))));
let mut m = MetaCtx::new();
let pmeta = m.fresh(); let expected = pi("mm", g("Nat"), app(pmeta.clone(), var("mm"))); let lam_term = lam("n", g("Nat"), app(g("g_vec"), var("n")));
let (term, _ty) =
elaborate(&ctx, &mut m, &lam_term, Some(&expected)).expect("elaborate under the binder");
let p_zero = normalize(&ctx, &instantiate(&app(pmeta, g("Zero")), &m));
assert_eq!(p_zero, app(g("Vec"), g("Zero")), "?P Zero ⇝ Vec Zero (motive inferred)");
assert!(infer_type(&ctx, &term).is_ok());
}