From 463d6643cde5f15fbb4d9590c735db6ac02cea12 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Wed, 29 Jul 2026 04:12:38 +0800 Subject: [PATCH 01/35] feat(logic): define resource algebra core and unit RA --- syntax/base.c | 137 ++++ syntax/base.h | 32 + theory/logic/ra.c | 1398 +++++++++++++++++++++++++++++++++++++ theory/logic/ra.h | 283 ++++++++ theory/logic/ra_builder.h | 110 +++ theory/logic/unit_ra.c | 197 ++++++ theory/logic/unit_ra.h | 55 ++ 7 files changed, 2212 insertions(+) create mode 100644 syntax/base.c create mode 100644 syntax/base.h create mode 100644 theory/logic/ra.c create mode 100644 theory/logic/ra.h create mode 100644 theory/logic/ra_builder.h create mode 100644 theory/logic/unit_ra.c create mode 100644 theory/logic/unit_ra.h diff --git a/syntax/base.c b/syntax/base.c new file mode 100644 index 0000000..43ddc68 --- /dev/null +++ b/syntax/base.c @@ -0,0 +1,137 @@ +#include "proof/syntax/base.h" + +PROOF static bool proof_base_syntax_installed = false; + +PROOF int proof_install_base_syntax(void) { + if (proof_base_syntax_installed) return 0; + + type A = mk_var_type("A"); + type B = mk_var_type("B"); + type bool_type = mk_bool_type(); + type int_type = mk_int_type(); + type real_type = mk_real_type(); + type list_A = mk_list_type(A); + type A_to_A = mk_fun_type(A, A); + type binary_A = mk_fun_type(A, A_to_A); + type bool_to_bool = mk_fun_type(bool_type, bool_type); + type binary_bool = mk_fun_type(bool_type, bool_to_bool); + + /* Fixities are declared explicitly so this module does not depend on the + * order or presence of an OCaml bootstrap file. */ + parse_as_infix("/", 22, "left"); + parse_as_infix("%", 22, "left"); + parse_as_infix("::", 25, "right"); + parse_as_infix("++", 16, "right"); + parse_as_infix("==", 10, "right"); + parse_as_infix("<=>", 2, "right"); + parse_as_infix("||", 6, "right"); + parse_as_infix("&&", 8, "right"); + + /* Arithmetic and list notation. */ + make_overloadable("/", binary_A); + type real_to_real = mk_fun_type(real_type, real_type); + type binary_real = mk_fun_type(real_type, real_to_real); + term real_div = mk_const("real_div", binary_real); + overload_interface("/", real_div); + type int_to_int = mk_fun_type(int_type, int_type); + type binary_int = mk_fun_type(int_type, int_to_int); + + /* Re-establish HOL Light's `prioritize_int()` policy using only public + * parser-interface operations. The former OCaml bootstrap performed this + * mutation globally; without it an unconstrained `&n`, `+`, or comparison + * can silently be invented at type `real`. */ + type int_predicate = mk_fun_type(int_type, bool_type); + type binary_int_predicate = mk_fun_type(int_type, int_predicate); + type num_type = mk_nat_type(); + type num_to_int = mk_fun_type(num_type, int_type); + type int_pow_type = mk_fun_type(int_type, num_to_int); + term int_add = mk_const("int_add", binary_int); + term int_sub = mk_const("int_sub", binary_int); + term int_mul = mk_const("int_mul", binary_int); + term int_lt = mk_const("int_lt", binary_int_predicate); + term int_le = mk_const("int_le", binary_int_predicate); + term int_gt = mk_const("int_gt", binary_int_predicate); + term int_ge = mk_const("int_ge", binary_int_predicate); + term int_neg = mk_const("int_neg", int_to_int); + term int_pow = mk_const("int_pow", int_pow_type); + term int_abs = mk_const("int_abs", int_to_int); + term int_max = mk_const("int_max", binary_int); + term int_min = mk_const("int_min", binary_int); + term int_of_num = mk_const("int_of_num", num_to_int); + overload_interface("+", int_add); + overload_interface("-", int_sub); + overload_interface("*", int_mul); + overload_interface("<", int_lt); + overload_interface("<=", int_le); + overload_interface(">", int_gt); + overload_interface(">=", int_ge); + overload_interface("--", int_neg); + overload_interface("pow", int_pow); + overload_interface("abs", int_abs); + overload_interface("max", int_max); + overload_interface("min", int_min); + overload_interface("&", int_of_num); + + term int_div = mk_const("div", binary_int); + overload_interface("/", int_div); + term int_rem = mk_const("rem", binary_int); + override_interface("%", int_rem); + type list_to_list = mk_fun_type(list_A, list_A); + type cons_type = mk_fun_type(A, list_to_list); + term cons = mk_const("CONS", cons_type); + override_interface("::", cons); + type append_type = mk_fun_type(list_A, list_to_list); + term append = mk_const("APPEND", append_type); + override_interface("++", append); + + /* `==` retains the standard congruence interpretation while adding plain + * equality as the preferred boolean-result instance. */ + type A_to_B = mk_fun_type(A, B); + type equality_skeleton = mk_fun_type(A, A_to_B); + make_overloadable("==", equality_skeleton); + type A_to_bool = mk_fun_type(A, bool_type); + type equality_type = mk_fun_type(A, A_to_bool); + type equality_predicate_to_bool = mk_fun_type(equality_type, bool_type); + type A_to_equality_predicate_to_bool = + mk_fun_type(A, equality_predicate_to_bool); + type congruence_type = mk_fun_type(A, A_to_equality_predicate_to_bool); + term congruence = mk_const("==", congruence_type); + overload_interface("==", congruence); + term equality = mk_const("=", equality_type); + overload_interface("==", equality); + term boolean_equality = mk_const("=", binary_bool); + override_interface("<=>", boolean_equality); + + /* Boolean spellings remain overloadable so a selected resource assertion + * model can add its own conjunction, disjunction, and existential heads. */ + make_overloadable("&&", binary_A); + term conjunction = mk_const("/\\", binary_bool); + overload_interface("&&", conjunction); + make_overloadable("||", binary_A); + term disjunction = mk_const("\\/", binary_bool); + overload_interface("||", disjunction); + + make_overloadable("true", A); + term truth = mk_const("T", bool_type); + overload_interface("true", truth); + make_overloadable("false", A); + term falsehood = mk_const("F", bool_type); + overload_interface("false", falsehood); + + type binder_skeleton = mk_fun_type(A_to_B, B); + type bool_binder = mk_fun_type(A_to_bool, bool_type); + make_overloadable("forall", binder_skeleton); + term universal = mk_const("!", bool_binder); + overload_interface("forall", universal); + make_overloadable("exists", binder_skeleton); + term existential = mk_const("?", bool_binder); + overload_interface("exists", existential); + + proof_base_syntax_installed = true; + return 0; +err: + ERR_FUN_PUTS("proof_install_base_syntax"); + return -1; +} + +PROOF static int _PROOF_BASE_SYNTAX_INSTALLED = proof_install_base_syntax(); diff --git a/syntax/base.h b/syntax/base.h new file mode 100644 index 0000000..ab9fd25 --- /dev/null +++ b/syntax/base.h @@ -0,0 +1,32 @@ +/** + * @file base.h + * @brief Model-independent C* proof syntax. + * + * This module installs only parser/interface declarations that are shared by + * ordinary HOL and every resource model. Separation-logic notation is + * selected separately after a concrete resource algebra has been chosen. + * The operation is idempotent against the standard HOL Light baseline and + * against repeated inclusion by proof files. + */ + +#pragma once + +#include "proof/proof_kernel.h" + +/** + * Install the neutral C* proof dialect. + * + * The dialect gives overloaded arithmetic the same integer priority as HOL + * `prioritize_int()` and includes the former OCaml bootstrap's conveniences + * (`/`, `%`, `::`, `++`). It also provides the C* spelling `==` for HOL + * equality and `<=>` for Boolean equivalence, and the overloadable Boolean + * spellings `&&`, `||`, `true`, `false`, `forall`, and `exists`. Return zero + * on success and `-1` after setting prover error state. Installation changes + * global parser/fixity metadata incrementally. A process-local completion flag + * makes repeated installation through one dependency graph a no-op; a fresh + * verification process reinstalls the metadata after the server restores its + * checkpoint. No logical constant is introduced merely to record runtime + * state. A failure may leave a partially installed dialect and is + * proof-initialization fail-stop for the current session. + */ +PROOF int proof_install_base_syntax(void); diff --git a/theory/logic/ra.c b/theory/logic/ra.c new file mode 100644 index 0000000..3a170f4 --- /dev/null +++ b/theory/logic/ra.c @@ -0,0 +1,1398 @@ +#include "proof/theory/logic/ra_builder.h" + +#include "proof/syntax/base.h" +#require "proof/syntax/base.c" +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" + +/* ------------------------------------------------------------------------- */ +/* Printing utility functions */ +/* ------------------------------------------------------------------------- */ + +PROOF static inline char *cst_string_of_term(const term tm) { + if (IS_NULL(tm)) return ""; + return cstr_term(tm); +} + +PROOF static inline char *cst_string_of_thm(const thm th) { + if (IS_NULL(th)) return ""; + return cstr_thm(th); +} + +PROOF static inline char *cst_string_of_type(const type ty) { + if (IS_NULL(ty)) return ""; + return cstr_type(ty); +} + +PROOF static inline char *cst_string_of_gnode(const gnode gn) { + if (gn == NULL) return ""; + return cstr_gnode(gn); +} + +PROOF static inline char *cst_string_of_gnode_list(const gnode_list gns) { + return cstr_gnode_list(gns); +} + + +PROOF static size_t RA_AXIOMS_BEFORE = vector_size(get_all_axioms()); + +/* + * Laws stored in the representation subset. + * + * `ra_laws e op valid` is intentionally a predicate on a raw descriptor, not + * a predicate on `(A)ra`: the type definition below admits exactly the + * descriptors satisfying these laws. + */ +PROOF thm ra_laws_def = new_fun_definition(` + ra_laws (e:A) (op:A->A->A) (valid:A->bool) <=> + (forall a b c. + op (op a b) c == op a (op b c)) && + (forall a b. op a b == op b a) && + (forall a. op e a == a) && + valid e && + (forall a b. valid (op a b) ==> valid a) +`); + +/* + * Every nonempty HOL type admits a commutative monoid. ARB is the unit. If + * the carrier has a non-unit element, Hilbert choice selects one as an + * absorbing result for products of two non-unit elements; in a singleton + * carrier the final branch is unreachable. + */ +PROOF static thm ra_witness_op_def = new_fun_definition(` + ra_witness_op (a:A) (b:A) = + if a == (ARB:A) then b + else if b == (ARB:A) then a + else (@z:A. ~(z == (ARB:A))) +`); + +PROOF static thm prove_ra_witness_absorb_nonunit(void) { + term goal_tm = ` + forall a:A. + ~(a == (ARB:A)) ==> + ~((@z:A. ~(z == (ARB:A))) == (ARB:A)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "a"); + body = DISCH_TAC(body, "Ha"); + + thm selected = specl_rule( + TERM_LIST( + `\z:A. ~(z == (ARB:A))`, + `a:A`), + get_theorem_by_name("SELECT_AX")); + selected = beta_rule(selected); + selected = mp_rule( + selected, + assume_rule(`~((a:A) == (ARB:A))`)); + ACCEPT_TAC(body, selected); + return gnode_prove(root); +} + +PROOF static thm RA_WITNESS_ABSORB_NONUNIT = + prove_ra_witness_absorb_nonunit(); + +PROOF static thm prove_ra_witness_assoc(void) { + term goal_tm = ` + forall a b c:A. + ra_witness_op (ra_witness_op a b) c == + ra_witness_op a (ra_witness_op b c) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list a_cases = + BOOL_CASES_TAC(body, `(a:A) == (ARB:A)`, "Ha"); + thm absorb_nonunit_from_a = mp_rule( + spec_rule(`a:A`, RA_WITNESS_ABSORB_NONUNIT), + assume_rule(`~((a:A) == (ARB:A))`)); + + for (size_t i = 0; i < vector_size(a_cases); ++i) { + gnode_list b_cases = + BOOL_CASES_TAC(a_cases[i], `(b:A) == (ARB:A)`, "Hb"); + for (size_t j = 0; j < vector_size(b_cases); ++j) { + gnode_list c_cases = + BOOL_CASES_TAC(b_cases[j], `(c:A) == (ARB:A)`, "Hc"); + for (size_t k = 0; k < vector_size(c_cases); ++k) { + if (i == 0) { + CONV_WITH_ASMP_TAC( + c_cases[k], + rewrite_conv, + THM_LIST(ra_witness_op_def)); + } else { + CONV_WITH_ASMP_TAC( + c_cases[k], + rewrite_conv, + THM_LIST( + ra_witness_op_def, + absorb_nonunit_from_a)); + } + } + } + } + return gnode_prove(root); +} + +PROOF static thm RA_WITNESS_ASSOC = prove_ra_witness_assoc(); + +PROOF static thm prove_ra_witness_comm(void) { + term goal_tm = ` + forall a b:A. + ra_witness_op a b == ra_witness_op b a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list a_cases = + BOOL_CASES_TAC(body, `(a:A) == (ARB:A)`, "Ha"); + + for (size_t i = 0; i < vector_size(a_cases); ++i) { + gnode_list b_cases = + BOOL_CASES_TAC(a_cases[i], `(b:A) == (ARB:A)`, "Hb"); + for (size_t j = 0; j < vector_size(b_cases); ++j) { + CONV_WITH_ASMP_TAC( + b_cases[j], + rewrite_conv, + THM_LIST( + ra_witness_op_def, + RA_WITNESS_ABSORB_NONUNIT)); + } + } + return gnode_prove(root); +} + +PROOF static thm RA_WITNESS_COMM = prove_ra_witness_comm(); + +PROOF static thm prove_ra_witness_unit(void) { + term goal_tm = ` + forall a:A. ra_witness_op (ARB:A) a == a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + CONV_TAC(body, rewrite_conv(THM_LIST(ra_witness_op_def))); + return gnode_prove(root); +} + +PROOF static thm RA_WITNESS_UNIT = prove_ra_witness_unit(); + +PROOF static thm prove_ra_witness_laws(void) { + term goal_tm = ` + ra_laws (ARB:A) (ra_witness_op:A->A->A) (\x:A. T) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + ra_laws_def, + RA_WITNESS_ASSOC, + RA_WITNESS_COMM, + RA_WITNESS_UNIT))); + return gnode_prove(root); +} + +PROOF static thm RA_WITNESS_LAWS = prove_ra_witness_laws(); + +PROOF static thm prove_ra_rep_exists(void) { + term descriptor = ` + ((ARB:A), + ((ra_witness_op:A->A->A),(\x:A. T))) + `; + term body = ` + ra_laws + (FST (d:A#((A->A->A)#(A->bool)))) + (FST (SND d)) + (SND (SND d)) + `; + term existence = mk_exists(`d:A#((A->A->A)#(A->bool))`, body); + + term witness_body = subst( + (term_pair_list)TERM_PAIR_LIST( + ((term_pair){descriptor, `d:A#((A->A->A)#(A->bool))`})), + body); + thm projected = apply_conversion( + rewrite_conv(THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND"))), + witness_body); + thm witness_laws = eq_mp_rule(sym_rule(projected), RA_WITNESS_LAWS); + return exists_rule(existence, descriptor, witness_laws); +} + +PROOF static thm RA_REP_EXISTS = prove_ra_rep_exists(); + +/* + * This call creates the genuine unary type constructor `(A)ra`. + * + * The representation predicate is exactly: + * ra_laws (FST d) (FST (SND d)) (SND (SND d)). + */ +PROOF thm RA_TYPE_BIJECTION = new_type_bijection_definition( + "ra", "ra_abs", "ra_rep", RA_REP_EXISTS); + +/* Public projections from the abstract descriptor. */ +PROOF thm ra_unit_def = new_fun_definition(` + ra_unit (R:(A)ra) : A = FST (ra_rep R) +`); + +PROOF thm ra_op_def = new_fun_definition(` + ra_op (R:(A)ra) : A->A->A = FST (SND (ra_rep R)) +`); + +PROOF thm ra_valid_def = new_fun_definition(` + ra_valid (R:(A)ra) : A->bool = SND (SND (ra_rep R)) +`); + +/* + * Generic extension and frame-preserving update relations. + * + * The nondeterministic update returns any element selected by `result`. + * The deterministic relation is stated directly rather than through a + * singleton predicate so that its common proof rules reduce to first-order + * implications without existential elimination. + */ +PROOF thm ra_included_def = new_fun_definition(` + ra_included (R:(A)ra) (a:A) (b:A) <=> + exists frame:A. b == ra_op R a frame +`); + +PROOF thm ra_update_nd_def = new_fun_definition(` + ra_update_nd (R:(A)ra) (a:A) (result:A->bool) <=> + forall frame:A. + ra_valid R (ra_op R a frame) ==> + exists b:A. + result b && ra_valid R (ra_op R b frame) +`); + +PROOF thm ra_update_def = new_fun_definition(` + ra_update (R:(A)ra) (a:A) (b:A) <=> + forall frame:A. + ra_valid R (ra_op R a frame) ==> + ra_valid R (ra_op R b frame) +`); + +/* + * Optional left cancellativity. Validity is required only for the left-hand + * composition, matching the standard RA/PCM cancellation property. This is a + * property of a particular bundled RA, not an intrinsic law of the `ra` type. + */ +PROOF thm ra_cancellative_def = new_fun_definition(` + ra_cancellative (R:(A)ra) <=> + forall (frame:A) (a:A) (b:A). + ra_valid R (ra_op R frame a) ==> + ra_op R frame a == ra_op R frame b ==> + a == b +`); + +/* + * The representation selected for any abstract RA satisfies the subtype + * predicate. This is the central consequence of new_type_definition. + */ +PROOF static thm prove_ra_rep_laws(void) { + term goal_tm = ` + forall R:(A)ra. + ra_laws + (FST (ra_rep R)) + (FST (SND (ra_rep R))) + (SND (SND (ra_rep R))) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + CONV_TAC(body, rewrite_conv(THM_LIST(RA_TYPE_BIJECTION))); + return gnode_prove(root); +} + +PROOF thm RA_REP_LAWS = prove_ra_rep_laws(); + +PROOF static thm prove_ra_laws(void) { + term goal_tm = ` + forall R:(A)ra. + ra_laws (ra_unit R) (ra_op R) (ra_valid R) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + CONV_TAC(body, rewrite_conv(THM_LIST( + ra_unit_def, ra_op_def, ra_valid_def, RA_REP_LAWS))); + return gnode_prove(root); +} + +PROOF thm RA_LAWS = prove_ra_laws(); + +/* + * Stable projections of the intrinsic laws. Downstream RA constructors use + * these facts instead of unfolding the representation predicate. + */ +PROOF static thm expanded_ra_laws(const term R) { + return rewrite_rule( + THM_LIST(ra_laws_def), + spec_rule(R, RA_LAWS)); +} + +PROOF static thm prove_ra_assoc(void) { + term R = `R:(A)ra`; + return gen_rule(R, conjunct1_rule(expanded_ra_laws(R))); +} + +PROOF thm RA_ASSOC = prove_ra_assoc(); + +PROOF static thm prove_ra_comm(void) { + term R = `R:(A)ra`; + thm law_tail = conjunct2_rule(expanded_ra_laws(R)); + return gen_rule(R, conjunct1_rule(law_tail)); +} + +PROOF thm RA_COMM = prove_ra_comm(); + +PROOF static thm prove_ra_unit_l(void) { + term R = `R:(A)ra`; + thm law_tail = conjunct2_rule(expanded_ra_laws(R)); + law_tail = conjunct2_rule(law_tail); + return gen_rule(R, conjunct1_rule(law_tail)); +} + +PROOF thm RA_UNIT_L = prove_ra_unit_l(); + +PROOF static thm prove_ra_unit_r(void) { + term R = `R:(A)ra`; + term a = `a:A`; + thm commuted = ispecl_rule( + TERM_LIST(R, a, `ra_unit (R:(A)ra)`), + RA_COMM); + thm reduced = ispecl_rule( + TERM_LIST(R, a), + RA_UNIT_L); + thm result = trans_rule(commuted, reduced); + result = gen_rule(a, result); + return gen_rule(R, result); +} + +PROOF thm RA_UNIT_R = + prove_ra_unit_r(); + +PROOF static thm prove_ra_valid_unit(void) { + term R = `R:(A)ra`; + thm law_tail = conjunct2_rule(expanded_ra_laws(R)); + law_tail = conjunct2_rule(law_tail); + law_tail = conjunct2_rule(law_tail); + return gen_rule(R, conjunct1_rule(law_tail)); +} + +PROOF thm RA_VALID_UNIT = prove_ra_valid_unit(); + +PROOF static thm prove_ra_valid_op_l(void) { + term R = `R:(A)ra`; + thm law_tail = conjunct2_rule(expanded_ra_laws(R)); + law_tail = conjunct2_rule(law_tail); + law_tail = conjunct2_rule(law_tail); + return gen_rule(R, conjunct2_rule(law_tail)); +} + +PROOF thm RA_VALID_OP_L = prove_ra_valid_op_l(); + +PROOF static thm prove_ra_valid_op_r(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_valid R (ra_op R a b) ==> + ra_valid R b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm commuted_valid = pure_once_rewrite_rule( + THM_LIST(ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `b:A`), + RA_COMM)), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (a:A) (b:A)) + `)); + thm right_valid = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `b:A`, + `a:A`), + RA_VALID_OP_L), + commuted_valid); + ACCEPT_TAC(body, right_valid); + return gnode_prove(root); +} + +PROOF thm RA_VALID_OP_R = + prove_ra_valid_op_r(); + +/* + * Apply the optional cancellativity property without exposing its quantified + * definition to client proofs. The proof specializes each operand and + * discharges both premises explicitly. + */ +PROOF static thm prove_ra_cancellative_apply(void) { + term goal_tm = ` + forall (R:(A)ra) (frame:A) (a:A) (b:A). + ra_cancellative R ==> + ra_valid R (ra_op R frame a) ==> + ra_op R frame a == ra_op R frame b ==> + a == b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + thm cancellative = rewrite_rule( + THM_LIST(ra_cancellative_def), + assume_rule(`ra_cancellative (R:(A)ra)`)); + cancellative = specl_rule( + TERM_LIST(`frame:A`, `a:A`, `b:A`), + cancellative); + cancellative = mp_rule( + cancellative, + assume_rule(` + ra_valid (R:(A)ra) (ra_op R (frame:A) (a:A)) + `)); + cancellative = mp_rule( + cancellative, + assume_rule(` + ra_op (R:(A)ra) (frame:A) (a:A) == + ra_op R frame (b:A) + `)); + ACCEPT_TAC(body, cancellative); + return gnode_prove(root); +} + +PROOF thm RA_CANCELLATIVE_APPLY = + prove_ra_cancellative_apply(); + +/* + * Inclusion is reflexive: choose the unit as the missing frame. + */ +PROOF static thm prove_ra_included_refl(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A). + ra_included R a a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_included_def))); + body = AUTO_INTROS_TAC(body); + body = EXISTS_TAC(body, `ra_unit (R:(A)ra)`); + ACCEPT_TAC( + body, + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + RA_UNIT_R))); + return gnode_prove(root); +} + +PROOF thm RA_INCLUDED_REFL = + prove_ra_included_refl(); + +/* + * The unit is included in every element: the element itself is the frame. + */ +PROOF static thm prove_ra_included_unit(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A). + ra_included R (ra_unit R) a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_included_def))); + body = AUTO_INTROS_TAC(body); + body = EXISTS_TAC(body, `a:A`); + ACCEPT_TAC( + body, + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + RA_UNIT_L))); + return gnode_prove(root); +} + +PROOF thm RA_INCLUDED_UNIT = + prove_ra_included_unit(); + +PROOF static thm prove_ra_included_op_l(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_included R a (ra_op R a b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_included_def))); + body = AUTO_INTROS_TAC(body); + body = EXISTS_TAC(body, `b:A`); + CONV_TAC(body, rewrite_conv(THM_LIST())); + return gnode_prove(root); +} + +PROOF thm RA_INCLUDED_OP_L = + prove_ra_included_op_l(); + +/* + * The right operand is also included in a composition. Choose the left + * operand as its frame and commute the composition. + */ +PROOF static thm prove_ra_included_op_r(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_included R b (ra_op R a b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_included_def))); + body = AUTO_INTROS_TAC(body); + body = EXISTS_TAC(body, `a:A`); + ACCEPT_TAC( + body, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `b:A`), + RA_COMM)); + return gnode_prove(root); +} + +PROOF thm RA_INCLUDED_OP_R = + prove_ra_included_op_r(); + +PROOF static thm prove_ra_included_trans(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A) (c:A). + ra_included R a b ==> + ra_included R b c ==> + ra_included R a c + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(ra_included_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "b"); + body = GEN_TAC(body, "c"); + body = DISCH_TAC(body, "Hab"); + body = DISCH_TAC(body, "Hbc"); + body = ASMP_EXISTS_TAC(body, "Hab", "frame_ab"); + body = ASMP_EXISTS_TAC(body, "Hbc", "frame_bc"); + body = EXISTS_TAC( + body, + `ra_op (R:(A)ra) (frame_ab:A) (frame_bc:A)`); + + gnode c_substituted = CONV_TAC( + body, + subs_conv(THM_LIST( + assume_rule(` + (c:A) == + ra_op (R:(A)ra) (b:A) (frame_bc:A) + `)))); + gnode b_substituted = CONV_TAC( + c_substituted, + subs_conv(THM_LIST( + assume_rule(` + (b:A) == + ra_op (R:(A)ra) (a:A) (frame_ab:A) + `)))); + thm assoc = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `frame_ab:A`, + `frame_bc:A`), + RA_ASSOC); + CONV_TAC( + b_substituted, + rewrite_conv(THM_LIST(assoc))); + return gnode_prove(root); +} + +PROOF thm RA_INCLUDED_TRANS = + prove_ra_included_trans(); + +PROOF static thm prove_ra_included_valid(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_included R a b ==> + ra_valid R b ==> + ra_valid R a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_included_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "b"); + body = DISCH_TAC(body, "Hab"); + body = ASMP_EXISTS_TAC(body, "Hab", "frame"); + body = DISCH_TAC(body, "Hvalid_b"); + + thm valid_extension = rewrite_rule( + THM_LIST(assume_rule(` + (b:A) == + ra_op (R:(A)ra) (a:A) (frame:A) + `)), + assume_rule(`ra_valid (R:(A)ra) (b:A)`)); + thm valid_left = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `frame:A`), + RA_VALID_OP_L), + valid_extension); + ACCEPT_TAC(body, valid_left); + return gnode_prove(root); +} + +PROOF thm RA_INCLUDED_VALID = + prove_ra_included_valid(); + +/* + * A predicate-valued update to a singleton is equivalent to the deterministic + * update relation. Both directions are kept explicit so this bridge remains + * independent of simplifier search. + */ +PROOF static thm prove_ra_update_nd_singleton(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_update_nd R a (\x:A. x == b) <=> ra_update R a b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode unfolded = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + ra_update_nd_def, + ra_update_def))); + gnode beta_normal = CONV_TAC( + unfolded, + depth_conv(get_conversion_by_name("BETA_CONV"))); + gnode equivalence = AUTO_INTROS_TAC(beta_normal); + gnode_list directions = EQ_TAC(equivalence); + + gnode left = AUTO_INTROS_TAC(directions[0]); + thm candidates = mp_rule( + spec_rule( + `frame:A`, + assume_rule(` + forall frame:A. + ra_valid (R:(A)ra) (ra_op R (a:A) frame) ==> + exists candidate:A. + candidate == (b:A) && + ra_valid R (ra_op R candidate frame) + `)), + assume_rule(` + ra_valid (R:(A)ra) (ra_op R (a:A) (frame:A)) + `)); + left = ASSUME_TAC(left, candidates, "Hcandidate"); + left = ASMP_EXISTS_TAC(left, "Hcandidate", "candidate"); + left = ASMP_CONJ_TAC( + left, "Hcandidate", "Hcandidate_eq", "Hcandidate_valid"); + thm selected_valid = rewrite_rule( + THM_LIST(assume_rule(`candidate:A == (b:A)`)), + assume_rule(` + ra_valid (R:(A)ra) (ra_op R (candidate:A) (frame:A)) + `)); + ACCEPT_TAC(left, selected_valid); + + gnode right = AUTO_INTROS_TAC(directions[1]); + right = EXISTS_TAC(right, `b:A`); + gnode_list result_parts = CONJ_TAC(right); + CONV_TAC(result_parts[0], rewrite_conv(THM_LIST())); + thm updated_valid = mp_rule( + spec_rule( + `frame:A`, + assume_rule(` + forall frame:A. + ra_valid (R:(A)ra) (ra_op R (a:A) frame) ==> + ra_valid R (ra_op R (b:A) frame) + `)), + assume_rule(` + ra_valid (R:(A)ra) (ra_op R (a:A) (frame:A)) + `)); + ACCEPT_TAC(result_parts[1], updated_valid); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_ND_SINGLETON = prove_ra_update_nd_singleton(); + +/* + * Nondeterministic update is reflexive. Select the source itself and retain + * the assumed frame-validity fact. + */ +PROOF static thm prove_ra_update_nd_refl(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A). + ra_update_nd R a (\x:A. x == a) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = AUTO_INTROS_TAC(body); + body = EXISTS_TAC(body, `a:A`); + gnode_list result_parts = CONJ_TAC(body); + CONV_TAC(result_parts[0], rewrite_conv(THM_LIST())); + ACCEPT_TAC( + result_parts[1], + assume_rule(` + ra_valid (R:(A)ra) (ra_op R (a:A) (frame:A)) + `)); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_ND_REFL = + prove_ra_update_nd_refl(); + +/* + * Predicate-valued updates compose by selecting the intermediate result and + * then applying the second update to that result. + */ +PROOF static thm prove_ra_update_nd_trans(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (P:A->bool) (Q:A->bool). + ra_update_nd R a P ==> + (forall b:A. P b ==> ra_update_nd R b Q) ==> + ra_update_nd R a Q + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = AUTO_INTROS_TAC(body); + + thm intermediate = mp_rule( + spec_rule( + `frame:A`, + assume_rule(` + forall frame:A. + ra_valid (R:(A)ra) (ra_op R (a:A) frame) ==> + exists b:A. + (P:A->bool) b && + ra_valid R (ra_op R b frame) + `)), + assume_rule(` + ra_valid (R:(A)ra) (ra_op R (a:A) (frame:A)) + `)); + body = ASSUME_TAC(body, intermediate, "Hintermediate"); + body = ASMP_EXISTS_TAC(body, "Hintermediate", "middle"); + body = ASMP_CONJ_TAC( + body, "Hintermediate", "HP_middle", "Hmiddle_valid"); + + thm middle_update = mp_rule( + spec_rule( + `middle:A`, + assume_rule(` + forall b:A. + (P:A->bool) b ==> + forall frame:A. + ra_valid (R:(A)ra) (ra_op R b frame) ==> + exists result:A. + (Q:A->bool) result && + ra_valid R (ra_op R result frame) + `)), + assume_rule(`(P:A->bool) (middle:A)`)); + thm result = mp_rule( + spec_rule(`frame:A`, middle_update), + assume_rule(` + ra_valid (R:(A)ra) (ra_op R (middle:A) (frame:A)) + `)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_ND_TRANS = prove_ra_update_nd_trans(); + +/* + * Enlarging the allowed result set preserves a nondeterministic update. + */ +PROOF static thm prove_ra_update_nd_mono(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (P:A->bool) (Q:A->bool). + ra_update_nd R a P ==> + (forall b:A. P b ==> Q b) ==> + ra_update_nd R a Q + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = AUTO_INTROS_TAC(body); + + thm selected = mp_rule( + spec_rule( + `frame:A`, + assume_rule(` + forall frame:A. + ra_valid (R:(A)ra) (ra_op R (a:A) frame) ==> + exists b:A. + (P:A->bool) b && + ra_valid R (ra_op R b frame) + `)), + assume_rule(` + ra_valid (R:(A)ra) (ra_op R (a:A) (frame:A)) + `)); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "selected"); + body = ASMP_CONJ_TAC( + body, "Hselected", "HP_selected", "Hselected_valid"); + body = EXISTS_TAC(body, `selected:A`); + gnode_list result_parts = CONJ_TAC(body); + + thm selected_in_Q = mp_rule( + spec_rule( + `selected:A`, + assume_rule(` + forall b:A. (P:A->bool) b ==> (Q:A->bool) b + `)), + assume_rule(`(P:A->bool) (selected:A)`)); + ACCEPT_TAC(result_parts[0], selected_in_Q); + ACCEPT_TAC( + result_parts[1], + assume_rule(` + ra_valid (R:(A)ra) (ra_op R (selected:A) (frame:A)) + `)); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_ND_MONO = + prove_ra_update_nd_mono(); + +/* + * Applying an ND update to a valid source yields at least one valid selected + * result. Instantiate the update with the unit frame and eliminate that + * frame using the right-unit law. + */ +PROOF static thm prove_ra_update_nd_valid(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (P:A->bool). + ra_update_nd R a P ==> + ra_valid R a ==> + exists b:A. P b && ra_valid R b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = AUTO_INTROS_TAC(body); + + thm source_unit_eq = gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + RA_UNIT_R)); + thm source_valid_eq = ap_term_rule( + `ra_valid (R:(A)ra)`, + source_unit_eq); + thm source_with_unit = eq_mp_rule( + source_valid_eq, + assume_rule(`ra_valid (R:(A)ra) (a:A)`)); + thm selected = mp_rule( + spec_rule( + `ra_unit (R:(A)ra)`, + assume_rule(` + forall frame:A. + ra_valid (R:(A)ra) (ra_op R (a:A) frame) ==> + exists b:A. + (P:A->bool) b && + ra_valid R (ra_op R b frame) + `)), + source_with_unit); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "selected"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "HP_selected", + "Hselected_valid"); + body = EXISTS_TAC(body, `selected:A`); + gnode_list result_parts = CONJ_TAC(body); + ACCEPT_TAC( + result_parts[0], + assume_rule(`(P:A->bool) (selected:A)`)); + + thm selected_unit_eq = ispecl_rule( + TERM_LIST(`R:(A)ra`, `selected:A`), + RA_UNIT_R); + thm selected_valid_eq = ap_term_rule( + `ra_valid (R:(A)ra)`, + selected_unit_eq); + thm selected_valid = eq_mp_rule( + selected_valid_eq, + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (selected:A) (ra_unit R)) + `)); + ACCEPT_TAC(result_parts[1], selected_valid); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_ND_VALID = + prove_ra_update_nd_valid(); + +PROOF static thm prove_ra_update_refl(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A). ra_update R a a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_update_def))); + body = AUTO_INTROS_TAC(body); + ACCEPT_TAC( + body, + assume_rule(` + ra_valid (R:(A)ra) (ra_op R (a:A) (frame:A)) + `)); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_REFL = prove_ra_update_refl(); + +PROOF static thm prove_ra_update_trans(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A) (c:A). + ra_update R a b ==> + ra_update R b c ==> + ra_update R a c + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(ra_update_def))); + body = AUTO_INTROS_TAC(body); + + thm b_valid = mp_rule( + spec_rule( + `frame:A`, + assume_rule(` + forall frame:A. + ra_valid (R:(A)ra) (ra_op R (a:A) frame) ==> + ra_valid R (ra_op R (b:A) frame) + `)), + assume_rule(` + ra_valid (R:(A)ra) (ra_op R (a:A) (frame:A)) + `)); + thm c_valid = mp_rule( + spec_rule( + `frame:A`, + assume_rule(` + forall frame:A. + ra_valid (R:(A)ra) (ra_op R (b:A) frame) ==> + ra_valid R (ra_op R (c:A) frame) + `)), + b_valid); + ACCEPT_TAC(body, c_valid); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_TRANS = prove_ra_update_trans(); + +/* + * A deterministic update maps a valid source to a valid result. As for the + * ND rule above, the unit is the frame witnessing ordinary validity. + */ +PROOF static thm prove_ra_update_valid(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_update R a b ==> + ra_valid R a ==> + ra_valid R b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_update_def))); + body = AUTO_INTROS_TAC(body); + + thm source_unit_eq = gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + RA_UNIT_R)); + thm source_valid_eq = ap_term_rule( + `ra_valid (R:(A)ra)`, + source_unit_eq); + thm source_with_unit = eq_mp_rule( + source_valid_eq, + assume_rule(`ra_valid (R:(A)ra) (a:A)`)); + thm result_with_unit = mp_rule( + spec_rule( + `ra_unit (R:(A)ra)`, + assume_rule(` + forall frame:A. + ra_valid (R:(A)ra) (ra_op R (a:A) frame) ==> + ra_valid R (ra_op R (b:A) frame) + `)), + source_with_unit); + thm result_unit_eq = ispecl_rule( + TERM_LIST(`R:(A)ra`, `b:A`), + RA_UNIT_R); + thm result_valid_eq = ap_term_rule( + `ra_valid (R:(A)ra)`, + result_unit_eq); + thm result_valid = eq_mp_rule( + result_valid_eq, + result_with_unit); + ACCEPT_TAC(body, result_valid); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_VALID = + prove_ra_update_valid(); + +/* + * A deterministic update remains valid after appending the same resource to + * both sides. The only algebraic fact used here is associativity. + */ +PROOF static thm prove_ra_update_frame(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_update R a b ==> + forall extra:A. + ra_update R (ra_op R a extra) (ra_op R b extra) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(ra_update_def))); + body = AUTO_INTROS_TAC(body); + + thm source_assoc = specl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `extra:A`, + `frame:A`), + RA_ASSOC); + thm normalized_source = rewrite_rule( + THM_LIST(source_assoc), + assume_rule(` + ra_valid (R:(A)ra) + (ra_op R (ra_op R (a:A) (extra:A)) (frame:A)) + `)); + + thm normalized_result = mp_rule( + spec_rule( + `ra_op (R:(A)ra) (extra:A) (frame:A)`, + assume_rule(` + forall frame:A. + ra_valid (R:(A)ra) (ra_op R (a:A) frame) ==> + ra_valid R (ra_op R (b:A) frame) + `)), + normalized_source); + + thm result_assoc = specl_rule( + TERM_LIST( + `R:(A)ra`, + `b:A`, + `extra:A`, + `frame:A`), + RA_ASSOC); + thm framed_result = rewrite_rule( + THM_LIST(gsym_rule(result_assoc)), + normalized_result); + ACCEPT_TAC(body, framed_result); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_FRAME = prove_ra_update_frame(); + +PROOF static thm prove_ra_update_nd_frame(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (P:A->bool). + ra_update_nd R a P ==> + forall extra:A. + ra_update_nd + R + (ra_op R a extra) + (\x:A. + exists b:A. + P b && x == ra_op R b extra) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = AUTO_INTROS_TAC(body); + + thm source_assoc = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `extra:A`, + `frame:A`), + RA_ASSOC); + thm normalized_source = rewrite_rule( + THM_LIST(source_assoc), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R + (ra_op R (a:A) (extra:A)) + (frame:A)) + `)); + thm selected = mp_rule( + spec_rule( + `ra_op (R:(A)ra) (extra:A) (frame:A)`, + assume_rule(` + forall frame:A. + ra_valid (R:(A)ra) + (ra_op R (a:A) frame) ==> + exists b:A. + (P:A->bool) b && + ra_valid R (ra_op R b frame) + `)), + normalized_source); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "b"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "HP_b", + "Hb_valid"); + body = EXISTS_TAC( + body, + `ra_op (R:(A)ra) (b:A) (extra:A)`); + gnode_list result_parts = CONJ_TAC(body); + + term predicate_existence = ` + exists candidate:A. + (P:A->bool) candidate && + ra_op (R:(A)ra) (b:A) (extra:A) == + ra_op R candidate extra + `; + thm predicate_body = conj_rule( + assume_rule(`(P:A->bool) (b:A)`), + refl_rule(`ra_op (R:(A)ra) (b:A) (extra:A)`)); + thm predicate_witness = exists_rule( + predicate_existence, + `b:A`, + predicate_body); + ACCEPT_TAC(result_parts[0], predicate_witness); + + thm result_assoc = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `b:A`, + `extra:A`, + `frame:A`), + RA_ASSOC); + thm framed_valid = rewrite_rule( + THM_LIST(gsym_rule(result_assoc)), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R + (b:A) + (ra_op R (extra:A) (frame:A))) + `)); + ACCEPT_TAC(result_parts[1], framed_valid); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_ND_FRAME = + prove_ra_update_nd_frame(); + +/* + * Abstraction computes to the supplied descriptor only when that descriptor + * satisfies the laws. For an ill-formed raw descriptor `ra_abs` still + * returns an inhabitant of `(A)ra`, but the subtype bijection deliberately + * gives no representation equation for it. + */ +PROOF static thm prove_ra_abs_rep(void) { + term e = `e:A`; + term op = `op:A->A->A`; + term valid = `valid:A->bool`; + term descriptor = `(e:A,(op:A->A->A,valid:A->bool))`; + term laws = `ra_laws (e:A) (op:A->A->A) (valid:A->bool)`; + + thm inverse = spec_rule( + descriptor, + conjunct2_rule(RA_TYPE_BIJECTION)); + inverse = rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + inverse); + + thm abstracted = eq_mp_rule(inverse, assume_rule(laws)); + abstracted = disch_rule(laws, abstracted); + abstracted = gen_rule(valid, abstracted); + abstracted = gen_rule(op, abstracted); + return gen_rule(e, abstracted); +} + +PROOF thm RA_ABS_REP = prove_ra_abs_rep(); + +PROOF static thm prove_ra_unit_abs(void) { + term goal_tm = ` + forall (e:A) (op:A->A->A) (valid:A->bool). + ra_laws e op valid ==> + ra_unit (ra_abs (e,(op,valid))) == e + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm abstracted = mp_rule( + specl_rule( + TERM_LIST(`e:A`, `op:A->A->A`, `valid:A->bool`), + RA_ABS_REP), + assume_rule(`ra_laws (e:A) (op:A->A->A) (valid:A->bool)`)); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + ra_unit_def, + abstracted, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + return gnode_prove(root); +} + +PROOF thm RA_UNIT_ABS = prove_ra_unit_abs(); + +PROOF static thm prove_ra_op_abs(void) { + term goal_tm = ` + forall (e:A) (op:A->A->A) (valid:A->bool). + ra_laws e op valid ==> + ra_op (ra_abs (e,(op,valid))) == op + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm abstracted = mp_rule( + specl_rule( + TERM_LIST(`e:A`, `op:A->A->A`, `valid:A->bool`), + RA_ABS_REP), + assume_rule(`ra_laws (e:A) (op:A->A->A) (valid:A->bool)`)); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + ra_op_def, + abstracted, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + return gnode_prove(root); +} + +PROOF thm RA_OP_ABS = prove_ra_op_abs(); + +PROOF static thm prove_ra_valid_abs(void) { + term goal_tm = ` + forall (e:A) (op:A->A->A) (valid:A->bool). + ra_laws e op valid ==> + ra_valid (ra_abs (e,(op,valid))) == valid + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm abstracted = mp_rule( + specl_rule( + TERM_LIST(`e:A`, `op:A->A->A`, `valid:A->bool`), + RA_ABS_REP), + assume_rule(`ra_laws (e:A) (op:A->A->A) (valid:A->bool)`)); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + ra_valid_def, + abstracted, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + return gnode_prove(root); +} + +PROOF thm RA_VALID_ABS = prove_ra_valid_abs(); + +PROOF static thm prove_ra_abs_eta(void) { + term goal_tm = ` + forall R:(A)ra. + ra_abs (ra_unit R,(ra_op R,ra_valid R)) == R + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + RA_TYPE_BIJECTION, + ra_unit_def, + ra_op_def, + ra_valid_def, + get_theorem_by_name("PAIR")))); + return gnode_prove(root); +} + +PROOF thm RA_ABS_ETA = prove_ra_abs_eta(); + +PROOF static int audit_ra_core(void) { + thm_list public_definitions = THM_LIST( + ra_unit_def, + ra_op_def, + ra_valid_def, + ra_included_def, + ra_update_nd_def, + ra_update_def, + ra_cancellative_def); + thm_list public_rules = THM_LIST( + RA_LAWS, + RA_ASSOC, + RA_COMM, + RA_UNIT_L, + RA_UNIT_R, + RA_VALID_UNIT, + RA_VALID_OP_L, + RA_VALID_OP_R, + RA_CANCELLATIVE_APPLY, + RA_INCLUDED_REFL, + RA_INCLUDED_UNIT, + RA_INCLUDED_OP_L, + RA_INCLUDED_OP_R, + RA_INCLUDED_TRANS, + RA_INCLUDED_VALID, + RA_UPDATE_ND_SINGLETON, + RA_UPDATE_ND_REFL, + RA_UPDATE_ND_TRANS, + RA_UPDATE_ND_MONO, + RA_UPDATE_ND_VALID, + RA_UPDATE_ND_FRAME, + RA_UPDATE_REFL, + RA_UPDATE_TRANS, + RA_UPDATE_VALID, + RA_UPDATE_FRAME); + thm_list builder_theorems = THM_LIST( + ra_laws_def, + RA_TYPE_BIJECTION, + RA_REP_LAWS, + RA_ABS_REP, + RA_UNIT_ABS, + RA_OP_ABS, + RA_VALID_ABS, + RA_ABS_ETA); + + for (size_t i = 0; i < vector_size(public_definitions); ++i) { + ENSURE_COND(!IS_NULL(public_definitions[i]), + "RA public definition %zu is empty", i); + ENSURE_COND(vector_size(hyp(public_definitions[i])) == 0, + "RA public definition %zu has hypotheses", i); + } + for (size_t i = 0; i < vector_size(public_rules); ++i) { + ENSURE_COND(!IS_NULL(public_rules[i]), + "RA public rule %zu is empty", i); + ENSURE_COND(vector_size(hyp(public_rules[i])) == 0, + "RA public rule %zu has hypotheses", i); + } + for (size_t i = 0; i < vector_size(builder_theorems); ++i) { + ENSURE_COND(!IS_NULL(builder_theorems[i]), + "RA builder theorem %zu is empty", i); + ENSURE_COND(vector_size(hyp(builder_theorems[i])) == 0, + "RA builder theorem %zu has hypotheses", i); + } + ENSURE_COND(vector_size(get_all_axioms()) == RA_AXIOMS_BEFORE, + "RA core introduced an axiom"); + ENSURE_COND(get_tyconst_arity("ra") == 1, + "ra is not a unary HOL type constructor"); + return 0; +err: + ERR_FUN_PUTS("audit_ra_core"); + return -1; +} + +PROOF static int _RA_CORE_AUDIT = audit_ra_core(); diff --git a/theory/logic/ra.h b/theory/logic/ra.h new file mode 100644 index 0000000..5aae70a --- /dev/null +++ b/theory/logic/ra.h @@ -0,0 +1,283 @@ +#pragma once + +/* + * Generic discrete unital resource algebras: public client API. + * + * `(A)ra` is a genuine unary HOL type constructor. A value `R:(A)ra` + * bundles a unit, a commutative associative operation, and a validity + * predicate. The type contains only lawful descriptors, so every theorem + * below is unconditional in `R`: clients never carry a separate + * well-formedness premise. + * + * We write `R=(|R|, ε_R, ·_R, valid_R)`, with `R:(A)ra` and `|R|=A`, + * and use + * + * a ≼ b iff exists c. b == ra_op R a c, + * a ↝ B iff ra_update_nd R a B. + * + * Thus the first relation is `ra_included`; the second is the + * nondeterministic frame-preserving update whose result may depend on the + * hidden frame. + * + * Exact theorem contracts in `proof/theory/logic` use C* surface spelling so + * that they can be pasted into proof terms: `==` is object-level HOL equality, + * `==>` is implication, and `<=>` is Boolean equivalence. Documentation-only + * metanotation instead uses `=`, `⇒`, and `⇔`; `≃_R` is resource-proposition + * equivalence and must not be read as raw HOL equality. + * + * This header deliberately hides the representation, `ra_abs`, `ra_rep`, and + * the type-bijection theorem. Code defining a new RA instance should include + * `proof/theory/logic/ra_builder.h` in addition to this client interface. + */ + +#include "proof/proof_kernel.h" + +/* ------------------------------------------------------------------------- */ +/* Core representation */ +/* ------------------------------------------------------------------------- */ + +/* + * `ra_unit R : A` + * + * Definition theorem shape: + * `forall R:(A)ra. ra_unit R == FST (ra_rep R)`. + */ +PROOF extern thm ra_unit_def; + +/* + * `ra_op R : A -> A -> A` + * + * Definition theorem shape: + * `forall R:(A)ra. ra_op R == FST (SND (ra_rep R))`. + * Application is written `ra_op R a b`. + */ +PROOF extern thm ra_op_def; + +/* + * `ra_valid R : A -> bool` + * + * Definition theorem shape: + * `forall R:(A)ra. ra_valid R == SND (SND (ra_rep R))`. + */ +PROOF extern thm ra_valid_def; + +/* ------------------------------------------------------------------------- */ +/* Order */ +/* ------------------------------------------------------------------------- */ + +/* + * Inclusion / extension order (`a ≼ b`): + * + * ra_included R a b <=> + * exists frame. b == ra_op R a frame + * + * Thus `a` is included in `b` when `b` can be obtained by framing `a`. + */ +PROOF extern thm ra_included_def; + +/* ------------------------------------------------------------------------- */ +/* Updates */ +/* ------------------------------------------------------------------------- */ + +/* + * Nondeterministic frame-preserving update: + * + * ra_update_nd R a P <=> + * forall frame. + * ra_valid R (ra_op R a frame) ==> + * exists b. P b && ra_valid R (ra_op R b frame) + * + * A result may depend on the frame, but must satisfy `P` and remain valid + * with that same frame. + */ +PROOF extern thm ra_update_nd_def; + +/* + * Deterministic frame-preserving update: + * + * ra_update R a b <=> + * forall frame. + * ra_valid R (ra_op R a frame) ==> + * ra_valid R (ra_op R b frame) + * + * This is intentionally a direct definition, rather than an abbreviation for + * an ND update to a singleton. Its backward proofs therefore expose only an + * implication, with no administrative existential witness. + */ +PROOF extern thm ra_update_def; + +/* ------------------------------------------------------------------------- */ +/* Laws: optional algebraic properties */ +/* ------------------------------------------------------------------------- */ + +/* + * Left cancellativity on valid compositions: + * + * ra_cancellative R <=> + * forall frame a b. + * ra_valid R (ra_op R frame a) ==> + * ra_op R frame a == ra_op R frame b ==> + * a == b + * + * Cancellativity is deliberately not part of `ra_laws`: many useful resource + * algebras are not cancellative. Instance modules may establish this property + * when their operation supports cancellation. + */ +PROOF extern thm ra_cancellative_def; + +/* + * Direct cancellativity application rule: + * + * ra_cancellative R ==> + * ra_valid R (ra_op R frame a) ==> + * ra_op R frame a == ra_op R frame b ==> + * a == b + * + * All operands are explicit so backward proofs can specialize this rule + * without unfolding the property definition. + */ +PROOF extern thm RA_CANCELLATIVE_APPLY; + +/* ------------------------------------------------------------------------- */ +/* Laws and validity */ +/* ------------------------------------------------------------------------- */ + +/* + * The bundled descriptor satisfies the complete raw law predicate: + * + * forall R. ra_laws (ra_unit R) (ra_op R) (ra_valid R) + * + * Ordinary clients should prefer the projected rules below. `RA_LAWS` + * exists as the compact interface theorem and as a bridge for generic + * construction proofs. + */ +PROOF extern thm RA_LAWS; + +/* `ra_op R (ra_op R a b) c == ra_op R a (ra_op R b c)`. */ +PROOF extern thm RA_ASSOC; + +/* `ra_op R a b == ra_op R b a`. */ +PROOF extern thm RA_COMM; + +/* `ra_op R (ra_unit R) a == a`. */ +PROOF extern thm RA_UNIT_L; + +/* `ra_op R a (ra_unit R) == a`. */ +PROOF extern thm RA_UNIT_R; + +/* `ra_valid R (ra_unit R)`. */ +PROOF extern thm RA_VALID_UNIT; + +/* `ra_valid R (ra_op R a b) ==> ra_valid R a`. */ +PROOF extern thm RA_VALID_OP_L; + +/* `ra_valid R (ra_op R a b) ==> ra_valid R b`. */ +PROOF extern thm RA_VALID_OP_R; + +/* ------------------------------------------------------------------------- */ +/* Order laws */ +/* ------------------------------------------------------------------------- */ + +/* Reflexivity: `ra_included R a a`. */ +PROOF extern thm RA_INCLUDED_REFL; + +/* The unit is included in every resource: `ra_included R (ra_unit R) a`. */ +PROOF extern thm RA_INCLUDED_UNIT; + +/* Left injection: `ra_included R a (ra_op R a b)`. */ +PROOF extern thm RA_INCLUDED_OP_L; + +/* Right injection: `ra_included R b (ra_op R a b)`. */ +PROOF extern thm RA_INCLUDED_OP_R; + +/* + * Transitivity: + * + * ra_included R a b ==> + * ra_included R b c ==> + * ra_included R a c + */ +PROOF extern thm RA_INCLUDED_TRANS; + +/* + * Validity is downward closed under inclusion: + * + * ra_included R a b ==> ra_valid R b ==> ra_valid R a + */ +PROOF extern thm RA_INCLUDED_VALID; + +/* ------------------------------------------------------------------------- */ +/* Nondeterministic frame-preserving update rules */ +/* ------------------------------------------------------------------------- */ + +/* + * Singleton bridge: + * + * ra_update_nd R a (\x. x == b) <=> ra_update R a b + */ +PROOF extern thm RA_UPDATE_ND_SINGLETON; + +/* ND reflexivity: `ra_update_nd R a (\x. x == a)`. */ +PROOF extern thm RA_UPDATE_ND_REFL; + +/* + * ND sequencing: + * + * ra_update_nd R a P ==> + * (forall b. P b ==> ra_update_nd R b Q) ==> + * ra_update_nd R a Q + */ +PROOF extern thm RA_UPDATE_ND_TRANS; + +/* + * Result-predicate weakening: + * + * ra_update_nd R a P ==> + * (forall b. P b ==> Q b) ==> + * ra_update_nd R a Q + */ +PROOF extern thm RA_UPDATE_ND_MONO; + +/* + * An ND update of a valid source selects a valid result: + * + * ra_update_nd R a P ==> ra_valid R a ==> + * exists b. P b && ra_valid R b + */ +PROOF extern thm RA_UPDATE_ND_VALID; + +/* + * Framing an ND update: + * + * ra_update_nd R a P ==> + * forall extra. + * ra_update_nd R (ra_op R a extra) + * (\x. exists b. P b && x == ra_op R b extra) + */ +PROOF extern thm RA_UPDATE_ND_FRAME; + +/* ------------------------------------------------------------------------- */ +/* Deterministic frame-preserving update rules */ +/* ------------------------------------------------------------------------- */ + +/* Reflexivity: `ra_update R a a`. */ +PROOF extern thm RA_UPDATE_REFL; + +/* Transitivity: `ra_update R a b ==> ra_update R b c ==> ra_update R a c`. */ +PROOF extern thm RA_UPDATE_TRANS; + +/* + * Updating a valid source preserves validity: + * + * ra_update R a b ==> ra_valid R a ==> ra_valid R b + */ +PROOF extern thm RA_UPDATE_VALID; + +/* + * Framing a deterministic update: + * + * ra_update R a b ==> + * forall extra. + * ra_update R (ra_op R a extra) (ra_op R b extra) + */ +PROOF extern thm RA_UPDATE_FRAME; diff --git a/theory/logic/ra_builder.h b/theory/logic/ra_builder.h new file mode 100644 index 0000000..60ca6af --- /dev/null +++ b/theory/logic/ra_builder.h @@ -0,0 +1,110 @@ +#pragma once + +/* + * Generic resource algebras: instance-construction API. + * + * This header is for modules that define a new `(A)ra`. A raw descriptor is + * represented by the nested pair + * + * (e,(op,valid)) : A # ((A -> A -> A) # (A -> bool)). + * + * Prove `ra_laws e op valid`, construct `ra_abs (e,(op,valid))`, and use the + * projection theorems below to establish the public computation rules of the + * instance. There is deliberately no `ra_pack` synonym: it added neither a + * law check nor any semantic abstraction over `ra_abs`. + * + * Ordinary RA clients should include only `proof/theory/logic/ra.h`. + */ + +#include "proof/theory/logic/ra.h" + +/* ------------------------------------------------------------------------- */ +/* Core representation */ +/* ------------------------------------------------------------------------- */ + +/* + * ra_laws e op valid <=> + * (forall a b c. op (op a b) c == op a (op b c)) && + * (forall a b. op a b == op b a) && + * (forall a. op e a == a) && + * valid e && + * (forall a b. valid (op a b) ==> valid a) + */ +PROOF extern thm ra_laws_def; + +/* ------------------------------------------------------------------------- */ +/* Constructors */ +/* ------------------------------------------------------------------------- */ + +/* + * Type-bijection theorem for + * `ra_abs:(A#((A->A->A)#(A->bool)))->(A)ra` and + * `ra_rep:(A)ra->A#((A->A->A)#(A->bool))`: + * + * (forall R. ra_abs (ra_rep R) == R) /\ + * (forall d. + * ra_laws (FST d) (FST (SND d)) (SND (SND d)) <=> + * ra_rep (ra_abs d) == d). + * + * Prefer `RA_ABS_REP` and the projection rules below; direct rewrites with + * the full bijection should normally remain confined to infrastructure. + */ +PROOF extern thm RA_TYPE_BIJECTION; + +/* + * Every representation selected by the abstract type satisfies `ra_laws`: + * + * forall R:(A)ra. + * ra_laws (FST (ra_rep R)) + * (FST (SND (ra_rep R))) + * (SND (SND (ra_rep R))). + * + * This is the representation-level source of the public `RA_LAWS` theorem. + */ +PROOF extern thm RA_REP_LAWS; + +/* ------------------------------------------------------------------------- */ +/* Laws: lawful `ra_abs` computation rules */ +/* ------------------------------------------------------------------------- */ + +/* + * Representation round trip for a lawful descriptor: + * + * ra_laws e op valid ==> + * ra_rep (ra_abs (e,(op,valid))) == (e,(op,valid)) + * + * `ra_abs` is total in HOL. The premise is essential: no corresponding + * representation equation is available for an unlawful descriptor. + */ +PROOF extern thm RA_ABS_REP; + +/* + * Unit projection: + * + * ra_laws e op valid ==> + * ra_unit (ra_abs (e,(op,valid))) == e + */ +PROOF extern thm RA_UNIT_ABS; + +/* + * Operation projection: + * + * ra_laws e op valid ==> + * ra_op (ra_abs (e,(op,valid))) == op + */ +PROOF extern thm RA_OP_ABS; + +/* + * Validity projection: + * + * ra_laws e op valid ==> + * ra_valid (ra_abs (e,(op,valid))) == valid + */ +PROOF extern thm RA_VALID_ABS; + +/* + * Abstract eta law: + * + * ra_abs (ra_unit R,(ra_op R,ra_valid R)) == R + */ +PROOF extern thm RA_ABS_ETA; diff --git a/theory/logic/unit_ra.c b/theory/logic/unit_ra.c new file mode 100644 index 0000000..26a6345 --- /dev/null +++ b/theory/logic/unit_ra.c @@ -0,0 +1,197 @@ +#include "proof/theory/logic/unit_ra.h" +#include "proof/theory/logic/ra_builder.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/ra.c" + +PROOF static size_t UNIT_RA_AXIOMS_BEFORE = vector_size(get_all_axioms()); + +PROOF static thm unit_ra_op_def = new_fun_definition(` + unit_ra_op (a:1) (b:1) : 1 = one +`); + +PROOF static thm unit_ra_valid_def = new_fun_definition(` + unit_ra_valid (a:1) <=> T +`); + +/* + * All five RA obligations normalize by the two definitions and the singleton + * theorem `|- forall v:1. v == one`. + */ +PROOF static thm prove_unit_ra_laws(void) { + term goal_tm = ` + ra_laws (one:1) unit_ra_op unit_ra_valid + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode unfolded = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_laws_def))); + + gnode_list law1 = CONJ_TAC(unfolded); + gnode assoc = AUTO_INTROS_TAC(law1[0]); + CONV_TAC(assoc, rewrite_conv(THM_LIST(unit_ra_op_def))); + + gnode_list law2 = CONJ_TAC(law1[1]); + gnode comm = AUTO_INTROS_TAC(law2[0]); + CONV_TAC(comm, rewrite_conv(THM_LIST(unit_ra_op_def))); + + gnode_list law3 = CONJ_TAC(law2[1]); + gnode unit = GEN_TAC(law3[0], "a"); + unit = CONV_TAC( + unit, + once_rewrite_conv(THM_LIST(unit_ra_op_def))); + ACCEPT_TAC( + unit, + sym_rule(spec_rule( + `a:1`, + get_theorem_by_name("one")))); + + gnode_list law4 = CONJ_TAC(law3[1]); + CONV_TAC( + law4[0], + rewrite_conv(THM_LIST(unit_ra_valid_def))); + CONV_TAC( + law4[1], + rewrite_conv(THM_LIST(unit_ra_valid_def))); + return gnode_prove(root); +} + +PROOF static thm UNIT_RA_LAWS = prove_unit_ra_laws(); + +PROOF static thm unit_ra_def = new_fun_definition(` + unit_ra : (1)ra = + ra_abs ((one:1),(unit_ra_op,unit_ra_valid)) +`); + +PROOF static thm prove_unit_ra_unit(void) { + thm computed = mp_rule( + ispecl_rule( + TERM_LIST( + `one:1`, + `unit_ra_op:1->1->1`, + `unit_ra_valid:1->bool`), + RA_UNIT_ABS), + UNIT_RA_LAWS); + return pure_once_rewrite_rule( + THM_LIST(gsym_rule(unit_ra_def)), + computed); +} + +PROOF thm UNIT_RA_UNIT = prove_unit_ra_unit(); + +PROOF static thm prove_unit_ra_op_fn(void) { + thm computed = mp_rule( + ispecl_rule( + TERM_LIST( + `one:1`, + `unit_ra_op:1->1->1`, + `unit_ra_valid:1->bool`), + RA_OP_ABS), + UNIT_RA_LAWS); + return pure_once_rewrite_rule( + THM_LIST(gsym_rule(unit_ra_def)), + computed); +} + +PROOF static thm UNIT_RA_OP_FN = prove_unit_ra_op_fn(); + +PROOF static thm prove_unit_ra_valid_fn(void) { + thm computed = mp_rule( + ispecl_rule( + TERM_LIST( + `one:1`, + `unit_ra_op:1->1->1`, + `unit_ra_valid:1->bool`), + RA_VALID_ABS), + UNIT_RA_LAWS); + return pure_once_rewrite_rule( + THM_LIST(gsym_rule(unit_ra_def)), + computed); +} + +PROOF static thm UNIT_RA_VALID_FN = prove_unit_ra_valid_fn(); + +PROOF static thm prove_unit_ra_op(void) { + term goal_tm = ` + forall a b:1. ra_op unit_ra a b == one + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + UNIT_RA_OP_FN, + unit_ra_op_def))); + return gnode_prove(root); +} + +PROOF thm UNIT_RA_OP = prove_unit_ra_op(); + +PROOF static thm prove_unit_ra_valid(void) { + term goal_tm = ` + forall a:1. ra_valid unit_ra a + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + UNIT_RA_VALID_FN, + unit_ra_valid_def))); + return gnode_prove(root); +} + +PROOF thm UNIT_RA_VALID = prove_unit_ra_valid(); + +/* Every two values of the singleton carrier are equal, independently of the + * common frame. The validity and operation-equality premises of generic + * cancellativity are therefore unnecessary after introduction. */ +PROOF static thm prove_unit_ra_cancellative(void) { + term goal_tm = `ra_cancellative unit_ra`; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_cancellative_def))); + body = AUTO_INTROS_TAC(body); + thm a_is_one = spec_rule( + `a:1`, + get_theorem_by_name("one")); + thm b_is_one = spec_rule( + `b:1`, + get_theorem_by_name("one")); + ACCEPT_TAC( + body, + trans_rule(a_is_one, gsym_rule(b_is_one))); + return gnode_prove(root); +} + +PROOF thm UNIT_RA_CANCELLATIVE = + prove_unit_ra_cancellative(); + +PROOF static int audit_unit_ra(void) { + thm_list audited_theorems = THM_LIST( + unit_ra_op_def, + unit_ra_valid_def, + UNIT_RA_LAWS, + unit_ra_def, + UNIT_RA_UNIT, + UNIT_RA_OP_FN, + UNIT_RA_VALID_FN, + UNIT_RA_OP, + UNIT_RA_VALID, + UNIT_RA_CANCELLATIVE); + + for (size_t i = 0; i < vector_size(audited_theorems); ++i) { + ENSURE_COND(!IS_NULL(audited_theorems[i]), + "unit RA theorem %zu is empty", i); + ENSURE_COND(vector_size(hyp(audited_theorems[i])) == 0, + "unit RA theorem %zu has hypotheses", i); + } + ENSURE_COND(vector_size(get_all_axioms()) == UNIT_RA_AXIOMS_BEFORE, + "unit RA introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_unit_ra"); + return -1; +} + +PROOF static int _UNIT_RA_AUDIT = audit_unit_ra(); diff --git a/theory/logic/unit_ra.h b/theory/logic/unit_ra.h new file mode 100644 index 0000000..17cd2cc --- /dev/null +++ b/theory/logic/unit_ra.h @@ -0,0 +1,55 @@ +#pragma once + +/* + * `unit_ra:(1)ra` is the resource algebra over HOL Light's singleton type + * `1`: carrier `1`, unit `one`, operation `\a b. one`, and validity + * `\a. T`. + * + * This is the complete client interface. The raw operation, raw validity + * predicate, construction laws, and `ra_abs` projection equations are + * intentionally private to `unit_ra.c`. + */ + +#include "proof/theory/logic/ra.h" + +/* ------------------------------------------------------------------------- */ +/* Core representation */ +/* ------------------------------------------------------------------------- */ + +/* `ra_unit unit_ra == (one:1)`. */ +PROOF extern thm UNIT_RA_UNIT; + +/* `forall a b:1. ra_op unit_ra a b == one`. */ +PROOF extern thm UNIT_RA_OP; + +/* ------------------------------------------------------------------------- */ +/* Validity */ +/* ------------------------------------------------------------------------- */ + +/* `forall a:1. ra_valid unit_ra a`. */ +PROOF extern thm UNIT_RA_VALID; + +/* ------------------------------------------------------------------------- */ +/* Laws */ +/* ------------------------------------------------------------------------- */ + +/* + * No unit-specific domain theorem is needed: all carrier values are equal to + * `one`, and the generic laws from `ra.h` apply directly. + */ + +/* ------------------------------------------------------------------------- */ +/* Laws: optional algebraic properties */ +/* ------------------------------------------------------------------------- */ + +/* Singleton composition is cancellative: `ra_cancellative unit_ra`. */ +PROOF extern thm UNIT_RA_CANCELLATIVE; + +/* ------------------------------------------------------------------------- */ +/* Updates */ +/* ------------------------------------------------------------------------- */ + +/* + * Unit-resource updates are discharged by the generic update rules in + * `ra.h`; no raw representation theorem is exposed here. + */ -- Gitee From 201304506c1c26531f6d95261fa5e9c6886af67f Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Wed, 29 Jul 2026 04:14:22 +0800 Subject: [PATCH 02/35] feat(logic): add compositional RA constructions --- theory/logic/agree_ra.c | 454 ++++++++ theory/logic/agree_ra.h | 69 ++ theory/logic/excl_ra.c | 483 ++++++++ theory/logic/excl_ra.h | 65 ++ theory/logic/excl_ra_internal.h | 41 + theory/logic/finmap.c | 385 +++++++ theory/logic/finmap.h | 108 ++ theory/logic/frac_ra.c | 1866 +++++++++++++++++++++++++++++++ theory/logic/frac_ra.h | 176 +++ theory/logic/gmap_ra.c | 1058 ++++++++++++++++++ theory/logic/gmap_ra.h | 145 +++ theory/logic/max_nat_ra.c | 631 +++++++++++ theory/logic/max_nat_ra.h | 118 ++ theory/logic/option_ra.c | 859 ++++++++++++++ theory/logic/option_ra.h | 116 ++ theory/logic/prod_ra.c | 1207 ++++++++++++++++++++ theory/logic/prod_ra.h | 135 +++ 17 files changed, 7916 insertions(+) create mode 100644 theory/logic/agree_ra.c create mode 100644 theory/logic/agree_ra.h create mode 100644 theory/logic/excl_ra.c create mode 100644 theory/logic/excl_ra.h create mode 100644 theory/logic/excl_ra_internal.h create mode 100644 theory/logic/finmap.c create mode 100644 theory/logic/finmap.h create mode 100644 theory/logic/frac_ra.c create mode 100644 theory/logic/frac_ra.h create mode 100644 theory/logic/gmap_ra.c create mode 100644 theory/logic/gmap_ra.h create mode 100644 theory/logic/max_nat_ra.c create mode 100644 theory/logic/max_nat_ra.h create mode 100644 theory/logic/option_ra.c create mode 100644 theory/logic/option_ra.h create mode 100644 theory/logic/prod_ra.c create mode 100644 theory/logic/prod_ra.h diff --git a/theory/logic/agree_ra.c b/theory/logic/agree_ra.c new file mode 100644 index 0000000..8ff6f3d --- /dev/null +++ b/theory/logic/agree_ra.c @@ -0,0 +1,454 @@ +#include "proof/theory/logic/agree_ra.h" +#include "proof/theory/logic/ra_builder.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/ra.c" + +PROOF static size_t AGREE_RA_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF static indtype agree_type = new_datatype_definition( + "agree = AgreeUnit" + " | Agree A" + " | AgreeInvalid"); + +PROOF static thm agree_owned_op_def = new_rec_definition( + agree_type.rec, + ` + agree_owned_op + (a:A) + (AgreeUnit:(A)agree) = + Agree a && + agree_owned_op + (a:A) + (Agree b) = + (if a == b + then Agree a + else (AgreeInvalid:(A)agree)) && + agree_owned_op + (a:A) + (AgreeInvalid:(A)agree) = + AgreeInvalid + `); + +PROOF static thm agree_op_def = new_rec_definition( + agree_type.rec, + ` + agree_op + (AgreeUnit:(A)agree) + (y:(A)agree) = + y && + agree_op + (Agree a) + (y:(A)agree) = + agree_owned_op a y && + agree_op + (AgreeInvalid:(A)agree) + (y:(A)agree) = + AgreeInvalid + `); + +PROOF static thm agree_valid_def = new_rec_definition( + agree_type.rec, + ` + (agree_valid (AgreeUnit:(A)agree) <=> T) && + (agree_valid (Agree a) <=> T) && + (agree_valid (AgreeInvalid:(A)agree) <=> F) + `); + +PROOF static thm prove_agree_owned_assoc(void) { + term goal_tm = ` + forall a b c:A. + agree_op + (agree_owned_op a (Agree b)) + (Agree c) == + agree_owned_op + a + (agree_owned_op b (Agree c)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list ab_cases = BOOL_CASES_TAC( + body, `(a:A) == (b:A)`, "Hab"); + for (size_t i = 0; i < vector_size(ab_cases); ++i) { + gnode_list bc_cases = BOOL_CASES_TAC( + ab_cases[i], `(b:A) == (c:A)`, "Hbc"); + for (size_t j = 0; j < vector_size(bc_cases); ++j) { + gnode reduced = CONV_WITH_ASMP_TAC( + bc_cases[j], + rewrite_conv, + THM_LIST( + agree_op_def, + agree_owned_op_def)); + if (i == 1 && j == 0) { + thm not_ac = pure_once_rewrite_rule( + THM_LIST(assume_rule(`(b:A) == (c:A)`)), + assume_rule(`~((a:A) == (b:A))`)); + CONV_TAC( + reduced, + rewrite_conv(THM_LIST(not_ac))); + } + } + } + return gnode_prove(root); +} + +PROOF static thm AGREE_OWNED_ASSOC = + prove_agree_owned_assoc(); + +PROOF static thm prove_agree_owned_comm(void) { + term goal_tm = ` + forall a b:A. + agree_owned_op a (Agree b) == + agree_owned_op b (Agree a) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list cases = BOOL_CASES_TAC( + body, `(a:A) == (b:A)`, "Hab"); + + gnode equal = CONV_TAC( + cases[0], + subs_conv(THM_LIST( + assume_rule(`(a:A) == (b:A)`)))); + CONV_TAC( + equal, + rewrite_conv(THM_LIST(agree_owned_op_def))); + + thm eqsym = ispecl_rule( + TERM_LIST(`a:A`, `b:A`), + get_theorem_by_name("EQ_SYM_EQ")); + thm reverse_unequal = pure_once_rewrite_rule( + THM_LIST(eqsym), + assume_rule(`~((a:A) == (b:A))`)); + CONV_TAC( + cases[1], + rewrite_conv(THM_LIST( + agree_owned_op_def, + assume_rule(`~((a:A) == (b:A))`), + reverse_unequal))); + return gnode_prove(root); +} + +PROOF static thm AGREE_OWNED_COMM = + prove_agree_owned_comm(); + +PROOF static thm prove_agree_ra_laws(void) { + term goal_tm = ` + ra_laws + (AgreeUnit:(A)agree) + agree_op + agree_valid + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode unfolded = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_laws_def))); + + gnode_list law1 = CONJ_TAC(unfolded); + gnode assoc = AUTO_INTROS_TAC(law1[0]); + gnode_list assoc_x = CASES_TAC( + assoc, `a:(A)agree`, NULL); + for (size_t i = 0; i < vector_size(assoc_x); ++i) { + gnode_list assoc_y = CASES_TAC( + assoc_x[i], `b:(A)agree`, NULL); + for (size_t j = 0; j < vector_size(assoc_y); ++j) { + gnode_list assoc_z = CASES_TAC( + assoc_y[j], `c:(A)agree`, NULL); + for (size_t k = 0; k < vector_size(assoc_z); ++k) { + if (i == 1 && j == 1 && k == 1) { + gnode substituted = CONV_WITH_ASMP_TAC( + assoc_z[k], + subs_conv, + THM_LIST()); + gnode normalized = substituted; + for (size_t l = 0; l < 3; ++l) { + normalized = CONV_TAC( + normalized, + once_rewrite_conv(THM_LIST(agree_op_def))); + } + gnode associated = CONV_TAC( + normalized, + once_rewrite_conv(THM_LIST(AGREE_OWNED_ASSOC))); + CONV_TAC( + associated, + rewrite_conv(THM_LIST())); + } else if (i == 1 && j == 1) { + gnode_list payload_cases = BOOL_CASES_TAC( + assoc_z[k], `(a:A) == (a_:A)`, "Hab_payload"); + for (size_t l = 0; l < vector_size(payload_cases); ++l) { + CONV_WITH_ASMP_TAC( + payload_cases[l], + rewrite_conv, + THM_LIST( + agree_op_def, + agree_owned_op_def)); + } + } else { + CONV_WITH_ASMP_TAC( + assoc_z[k], + rewrite_conv, + THM_LIST( + agree_op_def, + agree_owned_op_def)); + } + } + } + } + + gnode_list law2 = CONJ_TAC(law1[1]); + gnode comm = AUTO_INTROS_TAC(law2[0]); + gnode_list comm_x = CASES_TAC( + comm, `a:(A)agree`, NULL); + for (size_t i = 0; i < vector_size(comm_x); ++i) { + gnode_list comm_y = CASES_TAC( + comm_x[i], `b:(A)agree`, NULL); + for (size_t j = 0; j < vector_size(comm_y); ++j) { + CONV_WITH_ASMP_TAC( + comm_y[j], + rewrite_conv, + THM_LIST( + agree_op_def, + agree_owned_op_def, + AGREE_OWNED_COMM)); + } + } + + gnode_list law3 = CONJ_TAC(law2[1]); + gnode unit = AUTO_INTROS_TAC(law3[0]); + gnode_list unit_cases = CASES_TAC( + unit, `a:(A)agree`, NULL); + for (size_t i = 0; i < vector_size(unit_cases); ++i) { + CONV_WITH_ASMP_TAC( + unit_cases[i], + rewrite_conv, + THM_LIST( + agree_op_def, + agree_owned_op_def)); + } + + gnode_list law4 = CONJ_TAC(law3[1]); + CONV_TAC( + law4[0], + rewrite_conv(THM_LIST(agree_valid_def))); + + gnode valid_down = GEN_TAC(law4[1], "a"); + valid_down = GEN_TAC(valid_down, "b"); + gnode_list valid_x = CASES_TAC( + valid_down, `a:(A)agree`, NULL); + for (size_t i = 0; i < vector_size(valid_x); ++i) { + gnode_list valid_y = CASES_TAC( + valid_x[i], `b:(A)agree`, NULL); + for (size_t j = 0; j < vector_size(valid_y); ++j) { + CONV_WITH_ASMP_TAC( + valid_y[j], + rewrite_conv, + THM_LIST( + agree_op_def, + agree_owned_op_def, + agree_valid_def)); + } + } + return gnode_prove(root); +} + +PROOF static thm AGREE_RA_LAWS = + prove_agree_ra_laws(); + +PROOF static thm agree_ra_def = new_fun_definition(` + agree_ra : ((A)agree)ra = + ra_abs + ((AgreeUnit:(A)agree), + (agree_op:(A)agree->(A)agree->(A)agree, + agree_valid:(A)agree->bool)) +`); + +PROOF static thm prove_agree_ra_unit(void) { + thm computed = mp_rule( + ispecl_rule( + TERM_LIST( + `AgreeUnit:(A)agree`, + `agree_op:(A)agree->(A)agree->(A)agree`, + `agree_valid:(A)agree->bool`), + RA_UNIT_ABS), + AGREE_RA_LAWS); + return pure_once_rewrite_rule( + THM_LIST(gsym_rule(agree_ra_def)), + computed); +} + +PROOF thm AGREE_RA_UNIT = + prove_agree_ra_unit(); + +PROOF static thm prove_agree_ra_op_fn(void) { + thm computed = mp_rule( + ispecl_rule( + TERM_LIST( + `AgreeUnit:(A)agree`, + `agree_op:(A)agree->(A)agree->(A)agree`, + `agree_valid:(A)agree->bool`), + RA_OP_ABS), + AGREE_RA_LAWS); + return pure_once_rewrite_rule( + THM_LIST(gsym_rule(agree_ra_def)), + computed); +} + +PROOF static thm AGREE_RA_OP_FN = + prove_agree_ra_op_fn(); + +PROOF static thm prove_agree_ra_valid_fn(void) { + thm computed = mp_rule( + ispecl_rule( + TERM_LIST( + `AgreeUnit:(A)agree`, + `agree_op:(A)agree->(A)agree->(A)agree`, + `agree_valid:(A)agree->bool`), + RA_VALID_ABS), + AGREE_RA_LAWS); + return pure_once_rewrite_rule( + THM_LIST(gsym_rule(agree_ra_def)), + computed); +} + +PROOF static thm AGREE_RA_VALID_FN = + prove_agree_ra_valid_fn(); + +PROOF static thm prove_agree_ra_idempotent(void) { + term goal_tm = ` + forall a:A. + ra_op agree_ra (Agree a) (Agree a) == + (Agree a:(A)agree) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + AGREE_RA_OP_FN, + agree_op_def, + agree_owned_op_def))); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_IDEMPOTENT = + prove_agree_ra_idempotent(); + +PROOF static thm prove_agree_ra_valid_owned(void) { + term goal_tm = ` + forall a:A. + ra_valid agree_ra (Agree a) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + AGREE_RA_VALID_FN, + agree_valid_def))); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_VALID_OWNED = + prove_agree_ra_valid_owned(); + +PROOF static thm prove_agree_ra_invalid(void) { + term goal_tm = ` + ~(ra_valid agree_ra (AgreeInvalid:(A)agree)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + AGREE_RA_VALID_FN, + agree_valid_def))); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_INVALID = + prove_agree_ra_invalid(); + +PROOF static thm prove_agree_ra_valid_combine_iff(void) { + term goal_tm = ` + forall a b:A. + ra_valid agree_ra + (ra_op agree_ra (Agree a) (Agree b)) <=> + a == b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list cases = BOOL_CASES_TAC( + body, `(a:A) == (b:A)`, "Hab"); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST( + AGREE_RA_OP_FN, + AGREE_RA_VALID_FN, + agree_op_def, + agree_owned_op_def, + agree_valid_def)); + } + return gnode_prove(root); +} + +PROOF thm AGREE_RA_VALID_COMBINE_IFF = + prove_agree_ra_valid_combine_iff(); + +PROOF static thm prove_agree_ra_agreement(void) { + term a = `a:A`; + term b = `b:A`; + term combined_valid = ` + ra_valid agree_ra + (ra_op agree_ra (Agree (a:A)) (Agree (b:A))) + `; + thm equivalence = ispecl_rule( + TERM_LIST(a, b), + AGREE_RA_VALID_COMBINE_IFF); + thm conclusion = eq_mp_rule( + equivalence, + assume_rule(combined_valid)); + conclusion = disch_rule(combined_valid, conclusion); + conclusion = gen_rule(b, conclusion); + return gen_rule(a, conclusion); +} + +PROOF thm AGREE_RA_AGREEMENT = + prove_agree_ra_agreement(); + +PROOF static int audit_agree_ra(void) { + thm_list audited_theorems = THM_LIST( + agree_type.ind, + agree_type.rec, + agree_owned_op_def, + agree_op_def, + agree_valid_def, + AGREE_RA_LAWS, + agree_ra_def, + AGREE_RA_UNIT, + AGREE_RA_OP_FN, + AGREE_RA_VALID_FN, + AGREE_RA_IDEMPOTENT, + AGREE_RA_VALID_OWNED, + AGREE_RA_INVALID, + AGREE_RA_VALID_COMBINE_IFF, + AGREE_RA_AGREEMENT); + + for (size_t i = 0; i < vector_size(audited_theorems); ++i) { + ENSURE_COND(!IS_NULL(audited_theorems[i]), + "agreement RA theorem %zu is empty", i); + ENSURE_COND(vector_size(hyp(audited_theorems[i])) == 0, + "agreement RA theorem %zu has hypotheses", i); + } + ENSURE_COND(vector_size(get_all_axioms()) == AGREE_RA_AXIOMS_BEFORE, + "agreement RA introduced an axiom"); + ENSURE_COND(get_tyconst_arity("agree") == 1, + "agree is not a unary HOL type constructor"); + return 0; +err: + ERR_FUN_PUTS("audit_agree_ra"); + return -1; +} + +PROOF static int _AGREE_RA_AUDIT = + audit_agree_ra(); diff --git a/theory/logic/agree_ra.h b/theory/logic/agree_ra.h new file mode 100644 index 0000000..d311085 --- /dev/null +++ b/theory/logic/agree_ra.h @@ -0,0 +1,69 @@ +#pragma once + +/* + * `agree_ra:((A)agree)ra` is the discrete agreement resource algebra. An + * owned value `Agree a` may be duplicated, but two owned values compose + * validly only when their payloads agree. `AgreeUnit` is empty and + * `AgreeInvalid` represents disagreement. Its carrier is `(A)agree`, unit + * is `AgreeUnit`, disagreement composes to `AgreeInvalid`, and exactly + * `AgreeUnit` plus all `Agree a` values are valid. + * + * This header exposes only semantic laws stated directly over the abstract RA + * operations. The datatype handle, recursive implementation, construction + * laws, and `ra_abs` projection equations are private to `agree_ra.c`. + */ + +#include "proof/theory/logic/ra.h" + +/* ------------------------------------------------------------------------- */ +/* Core representation */ +/* ------------------------------------------------------------------------- */ + +/* `ra_unit agree_ra == (AgreeUnit:(A)agree)`. */ +PROOF extern thm AGREE_RA_UNIT; + +/* + * `forall a:A. + * ra_op agree_ra (Agree a) (Agree a) == (Agree a:(A)agree)` + */ +PROOF extern thm AGREE_RA_IDEMPOTENT; + +/* ------------------------------------------------------------------------- */ +/* Validity */ +/* ------------------------------------------------------------------------- */ + +/* `forall a:A. ra_valid agree_ra (Agree a)`. */ +PROOF extern thm AGREE_RA_VALID_OWNED; + +/* `~(ra_valid agree_ra (AgreeInvalid:(A)agree))`. */ +PROOF extern thm AGREE_RA_INVALID; + +/* + * `forall a b:A. + * ra_valid agree_ra + * (ra_op agree_ra (Agree a) (Agree b)) <=> + * a == b` + */ +PROOF extern thm AGREE_RA_VALID_COMBINE_IFF; + +/* ------------------------------------------------------------------------- */ +/* Laws */ +/* ------------------------------------------------------------------------- */ + +/* + * `forall a b:A. + * ra_valid agree_ra + * (ra_op agree_ra (Agree a) (Agree b)) ==> + * a == b` + */ +PROOF extern thm AGREE_RA_AGREEMENT; + +/* ------------------------------------------------------------------------- */ +/* Updates */ +/* ------------------------------------------------------------------------- */ + +/* + * Agreement payloads cannot in general be changed frame-preservingly. + * Generic reflexive, transitive, and framed update rules remain available + * from `ra.h`. + */ diff --git a/theory/logic/excl_ra.c b/theory/logic/excl_ra.c new file mode 100644 index 0000000..8238538 --- /dev/null +++ b/theory/logic/excl_ra.c @@ -0,0 +1,483 @@ +#include "proof/theory/logic/excl_ra_internal.h" +#include "proof/theory/logic/ra_builder.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/ra.c" + +PROOF static size_t EXCL_RA_AXIOMS_BEFORE = vector_size(get_all_axioms()); + +PROOF indtype excl_type = new_datatype_definition( + "excl = ExclUnit" + " | Excl A" + " | ExclInvalid"); + +/* + * Multiplication with an owned value on the left, defined by cases on the + * right operand. + */ +PROOF thm excl_owned_op_def = new_rec_definition( + excl_type.rec, + ` + excl_owned_op (a:A) (ExclUnit:(A)excl) = Excl a && + excl_owned_op (a:A) (Excl b) = (ExclInvalid:(A)excl) && + excl_owned_op (a:A) ExclInvalid = (ExclInvalid:(A)excl) + `); + +PROOF thm excl_op_def = new_rec_definition( + excl_type.rec, + ` + excl_op (ExclUnit:(A)excl) (y:(A)excl) = y && + excl_op (Excl a) (y:(A)excl) = excl_owned_op a y && + excl_op (ExclInvalid:(A)excl) (y:(A)excl) = ExclInvalid + `); + +PROOF thm excl_valid_def = new_rec_definition( + excl_type.rec, + ` + (excl_valid (ExclUnit:(A)excl) <=> T) && + (excl_valid (Excl a) <=> T) && + (excl_valid (ExclInvalid:(A)excl) <=> F) + `); + +/* + * Internal discriminator used to derive constructor-distinct facts. C*'s + * datatype wrapper returns induction and recursion theorems but does not + * register a named `excl_DISTINCT` theorem in the live theorem database. + */ +PROOF static thm excl_is_unit_def = new_rec_definition( + excl_type.rec, + ` + (excl_is_unit (ExclUnit:(A)excl) <=> T) && + (excl_is_unit (Excl a) <=> F) && + (excl_is_unit (ExclInvalid:(A)excl) <=> F) + `); + +PROOF static thm prove_excl_owned_ne_unit(void) { + term goal_tm = ` + forall a:A. ~((Excl a:(A)excl) == ExclUnit) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "a"); + body = DISCH_TAC(body, "Heq"); + thm distinguished = ap_term_rule( + `excl_is_unit:(A)excl->bool`, + assume_rule(`(Excl (a:A):(A)excl) == ExclUnit`)); + thm contradiction = rewrite_rule( + THM_LIST(excl_is_unit_def), + distinguished); + CONTR_TAC(body, contradiction); + return gnode_prove(root); +} + +PROOF thm EXCL_OWNED_NE_UNIT = + prove_excl_owned_ne_unit(); + +PROOF static thm prove_excl_invalid_ne_unit(void) { + term goal_tm = ` + ~((ExclInvalid:(A)excl) == ExclUnit) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = DISCH_TAC(root, "Heq"); + thm distinguished = ap_term_rule( + `excl_is_unit:(A)excl->bool`, + assume_rule(`(ExclInvalid:(A)excl) == ExclUnit`)); + thm contradiction = rewrite_rule( + THM_LIST(excl_is_unit_def), + distinguished); + CONTR_TAC(body, contradiction); + return gnode_prove(root); +} + +PROOF thm EXCL_INVALID_NE_UNIT = + prove_excl_invalid_ne_unit(); + +PROOF static conv excl_reduce_conv(void) { + return rewrite_conv(THM_LIST( + excl_op_def, + excl_owned_op_def, + excl_valid_def)); +} + +PROOF static thm excl_reduce_goal_rule(const term goal_tm) { + thm reduced = apply_conversion(excl_reduce_conv(), goal_tm); + return eqt_elim_rule(reduced); +} + +PROOF static thm prove_excl_ra_laws(void) { + term goal_tm = ` + ra_laws + (ExclUnit:(A)excl) + excl_op + excl_valid + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode unfolded = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_laws_def))); + + gnode_list law1 = CONJ_TAC(unfolded); + gnode assoc = AUTO_INTROS_TAC(law1[0]); + gnode_list assoc_a = CASES_TAC( + assoc, `a:(A)excl`, NULL); + for (size_t i = 0; i < vector_size(assoc_a); ++i) { + gnode_list assoc_b = CASES_TAC( + assoc_a[i], `b:(A)excl`, NULL); + for (size_t j = 0; j < vector_size(assoc_b); ++j) { + gnode_list assoc_c = CASES_TAC( + assoc_b[j], `c:(A)excl`, NULL); + for (size_t k = 0; k < vector_size(assoc_c); ++k) { + CONV_WITH_ASMP_TAC( + assoc_c[k], + rewrite_conv, + THM_LIST( + excl_op_def, + excl_owned_op_def, + excl_valid_def)); + } + } + } + + gnode_list law2 = CONJ_TAC(law1[1]); + gnode comm = AUTO_INTROS_TAC(law2[0]); + gnode_list comm_a = CASES_TAC( + comm, `a:(A)excl`, NULL); + for (size_t i = 0; i < vector_size(comm_a); ++i) { + gnode_list comm_b = CASES_TAC( + comm_a[i], `b:(A)excl`, NULL); + for (size_t j = 0; j < vector_size(comm_b); ++j) { + CONV_WITH_ASMP_TAC( + comm_b[j], + rewrite_conv, + THM_LIST( + excl_op_def, + excl_owned_op_def, + excl_valid_def)); + } + } + + gnode_list law3 = CONJ_TAC(law2[1]); + gnode unit = AUTO_INTROS_TAC(law3[0]); + gnode_list unit_a = CASES_TAC( + unit, `a:(A)excl`, NULL); + for (size_t i = 0; i < vector_size(unit_a); ++i) { + CONV_WITH_ASMP_TAC( + unit_a[i], + rewrite_conv, + THM_LIST( + excl_op_def, + excl_owned_op_def, + excl_valid_def)); + } + + gnode_list law4 = CONJ_TAC(law3[1]); + RULE_TAC(law4[0], excl_reduce_goal_rule); + + gnode valid_down = GEN_TAC(law4[1], "a"); + valid_down = GEN_TAC(valid_down, "b"); + gnode_list valid_a = CASES_TAC( + valid_down, `a:(A)excl`, NULL); + for (size_t i = 0; i < vector_size(valid_a); ++i) { + gnode_list valid_b = CASES_TAC( + valid_a[i], `b:(A)excl`, NULL); + for (size_t j = 0; j < vector_size(valid_b); ++j) { + CONV_WITH_ASMP_TAC( + valid_b[j], + rewrite_conv, + THM_LIST( + excl_op_def, + excl_owned_op_def, + excl_valid_def)); + } + } + return gnode_prove(root); +} + +PROOF thm EXCL_RA_LAWS = prove_excl_ra_laws(); + +PROOF thm excl_ra_def = new_fun_definition(` + excl_ra : ((A)excl)ra = + ra_abs + ((ExclUnit:(A)excl),(excl_op,excl_valid)) +`); + +PROOF static thm prove_excl_ra_unit(void) { + thm computed = mp_rule( + ispecl_rule( + TERM_LIST( + `ExclUnit:(A)excl`, + `excl_op:(A)excl->(A)excl->(A)excl`, + `excl_valid:(A)excl->bool`), + RA_UNIT_ABS), + EXCL_RA_LAWS); + return pure_once_rewrite_rule( + THM_LIST(gsym_rule(excl_ra_def)), + computed); +} + +PROOF thm EXCL_RA_UNIT = prove_excl_ra_unit(); + +PROOF static thm prove_excl_ra_op_fn(void) { + thm computed = mp_rule( + ispecl_rule( + TERM_LIST( + `ExclUnit:(A)excl`, + `excl_op:(A)excl->(A)excl->(A)excl`, + `excl_valid:(A)excl->bool`), + RA_OP_ABS), + EXCL_RA_LAWS); + return pure_once_rewrite_rule( + THM_LIST(gsym_rule(excl_ra_def)), + computed); +} + +PROOF thm EXCL_RA_OP_FN = prove_excl_ra_op_fn(); + +PROOF static thm prove_excl_ra_valid_fn(void) { + thm computed = mp_rule( + ispecl_rule( + TERM_LIST( + `ExclUnit:(A)excl`, + `excl_op:(A)excl->(A)excl->(A)excl`, + `excl_valid:(A)excl->bool`), + RA_VALID_ABS), + EXCL_RA_LAWS); + return pure_once_rewrite_rule( + THM_LIST(gsym_rule(excl_ra_def)), + computed); +} + +PROOF thm EXCL_RA_VALID_FN = prove_excl_ra_valid_fn(); + +PROOF static thm prove_excl_ra_owned_conflict(void) { + term goal_tm = ` + forall a b:A. + ra_op excl_ra (Excl a) (Excl b) == + (ExclInvalid:(A)excl) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + EXCL_RA_OP_FN, + excl_op_def, + excl_owned_op_def))); + return gnode_prove(root); +} + +PROOF thm EXCL_RA_OWNED_CONFLICT = prove_excl_ra_owned_conflict(); + +PROOF static thm prove_excl_ra_valid_unit(void) { + term goal_tm = ` + ra_valid excl_ra (ExclUnit:(A)excl) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + EXCL_RA_VALID_FN, + excl_valid_def))); + return gnode_prove(root); +} + +PROOF thm EXCL_RA_VALID_UNIT = prove_excl_ra_valid_unit(); + +PROOF static thm prove_excl_ra_valid_owned(void) { + term goal_tm = ` + forall a:A. ra_valid excl_ra (Excl a) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + EXCL_RA_VALID_FN, + excl_valid_def))); + return gnode_prove(root); +} + +PROOF thm EXCL_RA_VALID_OWNED = prove_excl_ra_valid_owned(); + +PROOF static thm prove_excl_ra_invalid(void) { + term goal_tm = ` + ~(ra_valid excl_ra (ExclInvalid:(A)excl)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + EXCL_RA_VALID_FN, + excl_valid_def))); + return gnode_prove(root); +} + +PROOF thm EXCL_RA_INVALID = prove_excl_ra_invalid(); + +/* Exclusive composition is cancellative on valid sources. Explicit cases + * keep the proof local: an owned common frame admits only ExclUnit on the + * source side, while an invalid common frame admits no valid source at all. */ +PROOF static thm prove_excl_ra_cancellative(void) { + term goal_tm = `ra_cancellative (excl_ra:((A)excl)ra)`; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_cancellative_def))); + body = GEN_TAC(body, "frame"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "b"); + body = DISCH_TAC(body, "Hsource_valid"); + body = DISCH_TAC(body, "Hops_equal"); + + gnode_list frame_cases = CASES_TAC( + body, `frame:(A)excl`, "Hframe"); + for (size_t i = 0; i < vector_size(frame_cases); ++i) { + gnode_list a_cases = CASES_TAC( + frame_cases[i], `a:(A)excl`, "Ha"); + for (size_t j = 0; j < vector_size(a_cases); ++j) { + gnode_list b_cases = CASES_TAC( + a_cases[j], `b:(A)excl`, "Hb"); + for (size_t k = 0; k < vector_size(b_cases); ++k) { + gnode branch = b_cases[k]; + thm frame_eq = assume_rule(gnode_get_asmps( + branch, + CONST_STRING_LIST("Hframe"))[0]); + thm a_eq = assume_rule(gnode_get_asmps( + branch, + CONST_STRING_LIST("Ha"))[0]); + thm b_eq = assume_rule(gnode_get_asmps( + branch, + CONST_STRING_LIST("Hb"))[0]); + thm source_valid = assume_rule(gnode_get_asmps( + branch, + CONST_STRING_LIST("Hsource_valid"))[0]); + thm ops_equal = assume_rule(gnode_get_asmps( + branch, + CONST_STRING_LIST("Hops_equal"))[0]); + + if (i == 0 && j < 2) { + thm result = rewrite_rule( + THM_LIST( + frame_eq, + EXCL_RA_OP_FN, + excl_op_def), + ops_equal); + ACCEPT_TAC(branch, result); + } else if (i == 1 && j == 0 && k == 0) { + ACCEPT_TAC( + branch, + trans_rule(a_eq, gsym_rule(b_eq))); + } else if (i == 1 && j == 0) { + thm validity_eq = ap_term_rule( + `ra_valid + (excl_ra:((A)excl)ra): + (A)excl->bool`, + ops_equal); + thm target_valid = eq_mp_rule( + validity_eq, + source_valid); + thm contradiction = rewrite_rule( + THM_LIST( + frame_eq, + b_eq, + EXCL_RA_OP_FN, + EXCL_RA_VALID_FN, + excl_op_def, + excl_owned_op_def, + excl_valid_def), + target_valid); + CONTR_TAC(branch, contradiction); + } else { + thm contradiction = rewrite_rule( + THM_LIST( + frame_eq, + a_eq, + EXCL_RA_OP_FN, + EXCL_RA_VALID_FN, + excl_op_def, + excl_owned_op_def, + excl_valid_def), + source_valid); + CONTR_TAC(branch, contradiction); + } + } + } + } + return gnode_prove(root); +} + +PROOF thm EXCL_RA_CANCELLATIVE = + prove_excl_ra_cancellative(); + +/* + * Any owned exclusive value can be replaced by any other owned value. A + * frame compatible with an owned value must be ExclUnit; the other two cases + * have an invalid premise. + */ +PROOF static thm prove_excl_ra_update(void) { + term goal_tm = ` + forall a b:A. + ra_update excl_ra (Excl a) (Excl b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode unfolded = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_update_def))); + gnode body = GEN_TAC(unfolded, "a"); + body = GEN_TAC(body, "b"); + body = GEN_TAC(body, "frame"); + gnode_list frame_cases = CASES_TAC( + body, `frame:(A)excl`, NULL); + for (size_t i = 0; i < vector_size(frame_cases); ++i) { + CONV_WITH_ASMP_TAC( + frame_cases[i], + rewrite_conv, + THM_LIST( + EXCL_RA_OP_FN, + EXCL_RA_VALID_FN, + excl_op_def, + excl_owned_op_def, + excl_valid_def)); + } + return gnode_prove(root); +} + +PROOF thm EXCL_RA_UPDATE = prove_excl_ra_update(); + +PROOF static int audit_excl_ra(void) { + thm_list audited_theorems = THM_LIST( + excl_type.ind, + excl_type.rec, + excl_owned_op_def, + excl_op_def, + excl_valid_def, + excl_is_unit_def, + EXCL_OWNED_NE_UNIT, + EXCL_INVALID_NE_UNIT, + EXCL_RA_LAWS, + excl_ra_def, + EXCL_RA_UNIT, + EXCL_RA_OP_FN, + EXCL_RA_VALID_FN, + EXCL_RA_OWNED_CONFLICT, + EXCL_RA_VALID_UNIT, + EXCL_RA_VALID_OWNED, + EXCL_RA_INVALID, + EXCL_RA_CANCELLATIVE, + EXCL_RA_UPDATE); + + for (size_t i = 0; i < vector_size(audited_theorems); ++i) { + ENSURE_COND(!IS_NULL(audited_theorems[i]), + "exclusive RA theorem %zu is empty", i); + ENSURE_COND(vector_size(hyp(audited_theorems[i])) == 0, + "exclusive RA theorem %zu has hypotheses", i); + } + ENSURE_COND(vector_size(get_all_axioms()) == EXCL_RA_AXIOMS_BEFORE, + "exclusive RA introduced an axiom"); + ENSURE_COND(get_tyconst_arity("excl") == 1, + "excl is not a unary HOL type constructor"); + return 0; +err: + ERR_FUN_PUTS("audit_excl_ra"); + return -1; +} + +PROOF static int _EXCL_RA_AUDIT = audit_excl_ra(); diff --git a/theory/logic/excl_ra.h b/theory/logic/excl_ra.h new file mode 100644 index 0000000..283e7d4 --- /dev/null +++ b/theory/logic/excl_ra.h @@ -0,0 +1,65 @@ +#pragma once + +/* + * `excl_ra:((A)excl)ra` is a unital exclusive resource algebra. Its carrier + * has an empty value `ExclUnit`, owned values `Excl a`, and the inconsistent + * value `ExclInvalid`. `ExclUnit` is the unit; combining two owned values + * produces `ExclInvalid`; exactly the unit and owned values are valid. + * + * Only semantic client rules are exposed here. The datatype handle, raw + * recursive definitions, construction laws, and `ra_abs` projection + * equations live in `excl_ra_internal.h` for the implementation of dependent + * constructions such as `auth_ra`. + */ + +#include "proof/theory/logic/ra.h" + +/* ------------------------------------------------------------------------- */ +/* Core representation */ +/* ------------------------------------------------------------------------- */ + +/* `ra_unit excl_ra == (ExclUnit:(A)excl)`. */ +PROOF extern thm EXCL_RA_UNIT; + +/* + * `forall a b:A. + * ra_op excl_ra (Excl a) (Excl b) == + * (ExclInvalid:(A)excl)` + */ +PROOF extern thm EXCL_RA_OWNED_CONFLICT; + +/* ------------------------------------------------------------------------- */ +/* Validity */ +/* ------------------------------------------------------------------------- */ + +/* `ra_valid excl_ra (ExclUnit:(A)excl)`. */ +PROOF extern thm EXCL_RA_VALID_UNIT; + +/* `forall a:A. ra_valid excl_ra (Excl a)`. */ +PROOF extern thm EXCL_RA_VALID_OWNED; + +/* `~(ra_valid excl_ra (ExclInvalid:(A)excl))`. */ +PROOF extern thm EXCL_RA_INVALID; + +/* ------------------------------------------------------------------------- */ +/* Laws */ +/* ------------------------------------------------------------------------- */ + +/* + * `EXCL_RA_OWNED_CONFLICT` is the characteristic domain law: no valid + * composition can contain two owned exclusive values. + */ + +/* ------------------------------------------------------------------------- */ +/* Laws: optional algebraic properties */ +/* ------------------------------------------------------------------------- */ + +/* Exclusive composition is cancellative: `ra_cancellative excl_ra`. */ +PROOF extern thm EXCL_RA_CANCELLATIVE; + +/* ------------------------------------------------------------------------- */ +/* Updates */ +/* ------------------------------------------------------------------------- */ + +/* `forall a b:A. ra_update excl_ra (Excl a) (Excl b)`. */ +PROOF extern thm EXCL_RA_UPDATE; diff --git a/theory/logic/excl_ra_internal.h b/theory/logic/excl_ra_internal.h new file mode 100644 index 0000000..99e4bbb --- /dev/null +++ b/theory/logic/excl_ra_internal.h @@ -0,0 +1,41 @@ +#pragma once + +/* + * INTERNAL CONSTRUCTION INTERFACE for the exclusive RA. + * + * General clients should include `excl_ra.h`. This header exists only for + * implementations, notably `auth_ra`, whose proofs must eliminate the + * exclusive datatype or reduce its raw operation. None of the handles below + * belongs to the semantic client API; use `excl_ra.h` unless eliminating the + * representation is unavoidable in an implementation proof. + */ + +#include "proof/theory/logic/excl_ra.h" + +/** + * Datatype package for `excl = ExclUnit | Excl A | ExclInvalid`. + * Constructor, induction, and recursion handles are implementation details. + */ +PROOF extern indtype excl_type; + +/** + * Case equations for `excl_owned_op a`: unit returns `Excl a`; either an + * owned right operand or `ExclInvalid` returns `ExclInvalid`. + */ +PROOF extern thm excl_owned_op_def; + +/** + * Case equations for the raw commutative operation `excl_op`; its left-unit + * case returns the right operand and its owned case delegates to + * `excl_owned_op`. + */ +PROOF extern thm excl_op_def; + +/** Constructor distinction: `⊢ ∀a. ¬(Excl a = ExclUnit)`. */ +PROOF extern thm EXCL_OWNED_NE_UNIT; + +/** Constructor distinction: `⊢ ¬(ExclInvalid = ExclUnit)`. */ +PROOF extern thm EXCL_INVALID_NE_UNIT; + +/** Projection equation: `⊢ ra_op excl_ra = excl_op`. */ +PROOF extern thm EXCL_RA_OP_FN; diff --git a/theory/logic/finmap.c b/theory/logic/finmap.c new file mode 100644 index 0000000..0508f4b --- /dev/null +++ b/theory/logic/finmap.c @@ -0,0 +1,385 @@ +#include "proof/theory/logic/finmap.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" + +PROOF static size_t FINMAP_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF thm finmap_finite_def = new_fun_definition(` + finmap_finite (f:K->V option) <=> + FINITE {k | ~(f k == NONE)} +`); + +PROOF static thm prove_finmap_rep_exists(void) { + term goal_tm = ` + exists f:K->V option. finmap_finite f + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = EXISTS_TAC(root, `\k:K. (NONE:V option)`); + body = CONV_TAC( + body, + rewrite_conv(THM_LIST( + finmap_finite_def, + get_theorem_by_name("EMPTY_GSPEC"), + get_theorem_by_name("FINITE_EMPTY")))); + return gnode_prove(root); +} + +PROOF static thm FINMAP_REP_EXISTS = + prove_finmap_rep_exists(); + +PROOF thm FINMAP_TYPE_BIJECTION = new_type_bijection_definition( + "finmap", "finmap_abs", "finmap_rep", FINMAP_REP_EXISTS); + +PROOF static thm prove_finmap_rep_finite(void) { + term goal_tm = ` + forall m:(K,V)finmap. + finmap_finite (finmap_rep m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + CONV_TAC( + body, + rewrite_conv(THM_LIST(FINMAP_TYPE_BIJECTION))); + return gnode_prove(root); +} + +PROOF thm FINMAP_REP_FINITE = + prove_finmap_rep_finite(); + +PROOF static thm prove_finmap_eq(void) { + term goal_tm = ` + forall m n:(K,V)finmap. + m == n <=> finmap_rep m == finmap_rep n + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode quantified = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(quantified); + + gnode forward = DISCH_TAC(directions[0], "Heq"); + ACCEPT_TAC( + forward, + ap_term_rule( + `finmap_rep:(K,V)finmap->K->V option`, + assume_rule(`m:(K,V)finmap == n`))); + + gnode reverse = DISCH_TAC(directions[1], "Hrep"); + thm abstract_eq = ap_term_rule( + `finmap_abs:(K->V option)->(K,V)finmap`, + assume_rule(` + finmap_rep (m:(K,V)finmap) == finmap_rep n + `)); + abstract_eq = rewrite_rule( + THM_LIST(conjunct1_rule(FINMAP_TYPE_BIJECTION)), + abstract_eq); + ACCEPT_TAC(reverse, abstract_eq); + return gnode_prove(root); +} + +PROOF thm FINMAP_EQ = prove_finmap_eq(); + +PROOF static thm prove_finmap_empty_finite(void) { + term goal_tm = ` + finmap_finite (\k:K. (NONE:V option)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + finmap_finite_def, + get_theorem_by_name("EMPTY_GSPEC"), + get_theorem_by_name("FINITE_EMPTY")))); + return gnode_prove(root); +} + +PROOF static thm FINMAP_EMPTY_FINITE = + prove_finmap_empty_finite(); + +PROOF thm finmap_empty_def = new_fun_definition(` + finmap_empty : (K,V)finmap = + finmap_abs (\k:K. (NONE:V option)) +`); + +PROOF thm finmap_lookup_def = new_fun_definition(` + finmap_lookup (m:(K,V)finmap) (k:K) : V option = + finmap_rep m k +`); + +PROOF static thm prove_finmap_empty_rep(void) { + term raw_empty = `\k:K. (NONE:V option)`; + thm inverse = ispec_rule( + raw_empty, + conjunct2_rule(FINMAP_TYPE_BIJECTION)); + thm represented = eq_mp_rule(inverse, FINMAP_EMPTY_FINITE); + return pure_once_rewrite_rule( + THM_LIST(gsym_rule(finmap_empty_def)), + represented); +} + +PROOF thm FINMAP_EMPTY_REP = + prove_finmap_empty_rep(); + +PROOF static thm prove_finmap_empty_lookup(void) { + term goal_tm = ` + forall k:K. + finmap_lookup (finmap_empty:(K,V)finmap) k == NONE + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + finmap_lookup_def, + FINMAP_EMPTY_REP))); + return gnode_prove(root); +} + +PROOF thm FINMAP_EMPTY_LOOKUP = + prove_finmap_empty_lookup(); + +PROOF static thm prove_finmap_singleton_support(void) { + term goal_tm = ` + forall (key:K) (v:V). + {k:K | + ~((if k == key then SOME v else NONE) == NONE)} == + {key} + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST( + get_theorem_by_name("EXTENSION")))); + body = GEN_TAC(body, "k"); + gnode_list branches = BOOL_CASES_TAC( + body, `(k:K) == (key:K)`, NULL); + for (size_t i = 0; i < vector_size(branches); ++i) { + CONV_WITH_ASMP_TAC( + branches[i], + rewrite_conv, + THM_LIST( + get_theorem_by_name("IN_ELIM_THM"), + get_theorem_by_name("IN_SING"), + get_theorem_by_name("option_DISTINCT"))); + } + return gnode_prove(root); +} + +PROOF thm FINMAP_SINGLETON_SUPPORT = + prove_finmap_singleton_support(); + +PROOF static thm prove_finmap_singleton_finite(void) { + term goal_tm = ` + forall (key:K) (v:V). + finmap_finite + (\k:K. if k == key then SOME v else NONE) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + term key = `key:K`; + term v = `v:V`; + term raw = ` + \k:K. if k == (key:K) then SOME (v:V) else NONE + `; + thm support = ispecl_rule( + TERM_LIST(key, v), + FINMAP_SINGLETON_SUPPORT); + thm finite_singleton = ispec_rule( + key, + get_theorem_by_name("FINITE_SING")); + thm finite_support = eq_mp_rule( + gsym_rule(ap_term_rule( + `FINITE:(K->bool)->bool`, + support)), + finite_singleton); + thm finite_definition = inst_rule( + TERM_PAIR_LIST( + (term_pair){raw, `f:K->V option`}), + finmap_finite_def); + finite_definition = beta_rule(finite_definition); + thm finite_map = eq_mp_rule( + gsym_rule(finite_definition), + finite_support); + ACCEPT_TAC(body, finite_map); + return gnode_prove(root); +} + +PROOF static thm FINMAP_SINGLETON_FINITE = + prove_finmap_singleton_finite(); + +PROOF thm finmap_singleton_def = new_fun_definition(` + finmap_singleton (key:K) (v:V) : (K,V)finmap = + finmap_abs + (\k:K. if k == key then SOME v else NONE) +`); + +PROOF static thm prove_finmap_singleton_rep(void) { + term key = `key:K`; + term v = `v:V`; + term raw = ` + \k:K. if k == (key:K) then SOME (v:V) else NONE + `; + thm finite = ispecl_rule( + TERM_LIST(key, v), + FINMAP_SINGLETON_FINITE); + thm inverse = ispec_rule( + raw, + conjunct2_rule(FINMAP_TYPE_BIJECTION)); + thm represented = eq_mp_rule(inverse, finite); + represented = pure_once_rewrite_rule( + THM_LIST(gsym_rule(finmap_singleton_def)), + represented); + represented = gen_rule(v, represented); + return gen_rule(key, represented); +} + +PROOF thm FINMAP_SINGLETON_REP = + prove_finmap_singleton_rep(); + +PROOF static thm prove_finmap_singleton_lookup(void) { + term goal_tm = ` + forall (key:K) (v:V) (k:K). + finmap_lookup (finmap_singleton key v) k == + if k == key then SOME v else NONE + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + finmap_lookup_def, + FINMAP_SINGLETON_REP))); + return gnode_prove(root); +} + +PROOF thm FINMAP_SINGLETON_LOOKUP = + prove_finmap_singleton_lookup(); + +PROOF static thm prove_finmap_eq_lookup(void) { + term goal_tm = ` + forall (m:(K,V)finmap) (n:(K,V)finmap). + m == n <=> + forall k:K. + finmap_lookup m k == finmap_lookup n k + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ))); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST( + get_theorem_by_name("FUN_EQ_THM")))); + CONV_TAC( + body, + rewrite_conv(THM_LIST(finmap_lookup_def))); + return gnode_prove(root); +} + +PROOF thm FINMAP_EQ_LOOKUP = + prove_finmap_eq_lookup(); + +PROOF thm finmap_dom_def = new_fun_definition(` + finmap_dom (m:(K,V)finmap) : K->bool = + {k | ~(finmap_lookup m k == NONE)} +`); + +PROOF static thm prove_finmap_dom_finite(void) { + term goal_tm = ` + forall m:(K,V)finmap. + FINITE (finmap_dom m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "m"); + body = CONV_TAC( + body, + rewrite_conv(THM_LIST( + finmap_dom_def, + finmap_lookup_def))); + thm finite = ispec_rule( + `m:(K,V)finmap`, + FINMAP_REP_FINITE); + finite = rewrite_rule( + THM_LIST(finmap_finite_def), + finite); + ACCEPT_TAC(body, finite); + return gnode_prove(root); +} + +PROOF thm FINMAP_DOM_FINITE = + prove_finmap_dom_finite(); + +PROOF static thm prove_finmap_dom_empty(void) { + term goal_tm = ` + finmap_dom (finmap_empty:(K,V)finmap) == {} + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + finmap_dom_def, + FINMAP_EMPTY_LOOKUP, + get_theorem_by_name("EMPTY_GSPEC")))); + return gnode_prove(root); +} + +PROOF thm FINMAP_DOM_EMPTY = + prove_finmap_dom_empty(); + +PROOF static thm prove_finmap_dom_singleton(void) { + term goal_tm = ` + forall (key:K) (v:V). + finmap_dom (finmap_singleton key v) == {key} + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list rules = THM_LIST( + finmap_dom_def, + FINMAP_SINGLETON_LOOKUP, + FINMAP_SINGLETON_SUPPORT); + conv normalize = rewrite_conv(rules); + CONV_TAC(root, normalize); + thm result = gnode_prove(root); + return result; +} + +PROOF thm FINMAP_DOM_SINGLETON = + prove_finmap_dom_singleton(); + +PROOF static int audit_finmap(void) { + thm_list public_theorems = THM_LIST( + finmap_finite_def, + FINMAP_TYPE_BIJECTION, + FINMAP_REP_FINITE, + FINMAP_EQ, + finmap_empty_def, + finmap_lookup_def, + finmap_singleton_def, + finmap_dom_def, + FINMAP_EMPTY_REP, + FINMAP_EMPTY_LOOKUP, + FINMAP_SINGLETON_SUPPORT, + FINMAP_SINGLETON_REP, + FINMAP_SINGLETON_LOOKUP, + FINMAP_EQ_LOOKUP, + FINMAP_DOM_FINITE, + FINMAP_DOM_EMPTY, + FINMAP_DOM_SINGLETON); + + for (size_t i = 0; i < vector_size(public_theorems); ++i) { + ENSURE_COND(!IS_NULL(public_theorems[i]), + "finite-map theorem %zu is empty", i); + ENSURE_COND(vector_size(hyp(public_theorems[i])) == 0, + "finite-map theorem %zu has hypotheses", i); + } + ENSURE_COND(vector_size(get_all_axioms()) == FINMAP_AXIOMS_BEFORE, + "finite-map carrier introduced an axiom"); + ENSURE_COND(get_tyconst_arity("finmap") == 2, + "finmap is not a binary HOL type constructor"); + return 0; +err: + ERR_FUN_PUTS("audit_finmap"); + return -1; +} + +PROOF static int _FINMAP_AUDIT = audit_finmap(); diff --git a/theory/logic/finmap.h b/theory/logic/finmap.h new file mode 100644 index 0000000..2831501 --- /dev/null +++ b/theory/logic/finmap.h @@ -0,0 +1,108 @@ +#pragma once + +/* + * Finite-support maps. + * + * `(K,V)finmap` is the conservative HOL subtype of total functions + * `K->V option` satisfying + * + * finmap_finite f <=> FINITE {k | ~(f k == NONE)}. + * + * `NONE` is absence; a `SOME v` entry remains present for every payload `v`. + * The abstraction/representation functions are public theorem terms because + * RA constructions need extensional and finiteness facts at the subtype + * boundary. Clients should normally use lookup equations instead. + * Contracts use C* surface spelling: `==` is HOL equality, `==>` is + * implication, and `<=>` is Boolean equivalence. + */ + +#include "proof/proof_kernel.h" + +/* ------------------------------------------------------------------------- */ +/* Core representation */ +/* ------------------------------------------------------------------------- */ + +/* `finmap_finite f <=> FINITE {k | ~(f k == NONE)}`. */ +PROOF extern thm finmap_finite_def; + +/* + * Type-bijection theorem for + * `finmap_abs:(K->V option)->(K,V)finmap` and + * `finmap_rep:(K,V)finmap->K->V option`: + * + * (forall m. finmap_abs (finmap_rep m) == m) /\ + * (forall f. finmap_finite f <=> + * finmap_rep (finmap_abs f) == f). + */ +PROOF extern thm FINMAP_TYPE_BIJECTION; + +/* `forall m:(K,V)finmap. finmap_finite (finmap_rep m)`. */ +PROOF extern thm FINMAP_REP_FINITE; + +/* `m == n <=> finmap_rep m == finmap_rep n`. */ +PROOF extern thm FINMAP_EQ; + +/* ------------------------------------------------------------------------- */ +/* Constructors and observations */ +/* ------------------------------------------------------------------------- */ + +/* `finmap_empty:(K,V)finmap == finmap_abs (\k:K. NONE)`. */ +PROOF extern thm finmap_empty_def; + +/* `finmap_lookup m k == finmap_rep m k`. */ +PROOF extern thm finmap_lookup_def; + +/* + * `finmap_singleton key v == + * finmap_abs (\k. if k == key then SOME v else NONE)`. + */ +PROOF extern thm finmap_singleton_def; + +/* `finmap_dom m == {k | ~(finmap_lookup m k == NONE)}`. */ +PROOF extern thm finmap_dom_def; + +/* ------------------------------------------------------------------------- */ +/* Laws: representation and lookup */ +/* ------------------------------------------------------------------------- */ + +/* `finmap_rep (finmap_empty:(K,V)finmap) == (\k:K. NONE)`. */ +PROOF extern thm FINMAP_EMPTY_REP; + +/* `forall k:K. finmap_lookup (finmap_empty:(K,V)finmap) k == NONE`. */ +PROOF extern thm FINMAP_EMPTY_LOOKUP; + +/* + * `{k:K | ~((if k == key then SOME v else NONE) == NONE)} == {key}`. + */ +PROOF extern thm FINMAP_SINGLETON_SUPPORT; + +/* + * `finmap_rep (finmap_singleton key v) == + * (\k:K. if k == key then SOME v else NONE)`. + */ +PROOF extern thm FINMAP_SINGLETON_REP; + +/* + * `finmap_lookup (finmap_singleton key v) k == + * if k == key then SOME v else NONE`. + */ +PROOF extern thm FINMAP_SINGLETON_LOOKUP; + +/* + * `m == n <=> + * forall k:K. finmap_lookup m k == finmap_lookup n k`. + */ +PROOF extern thm FINMAP_EQ_LOOKUP; + +/* ------------------------------------------------------------------------- */ +/* Laws: finite domain */ +/* ------------------------------------------------------------------------- */ + +/* `forall m:(K,V)finmap. FINITE (finmap_dom m)`. */ +PROOF extern thm FINMAP_DOM_FINITE; + +/* `finmap_dom (finmap_empty:(K,V)finmap) == {}`. */ +PROOF extern thm FINMAP_DOM_EMPTY; + +/* `forall key v. finmap_dom (finmap_singleton key v) == {key}`. */ +PROOF extern thm FINMAP_DOM_SINGLETON; diff --git a/theory/logic/frac_ra.c b/theory/logic/frac_ra.c new file mode 100644 index 0000000..5a8e408 --- /dev/null +++ b/theory/logic/frac_ra.c @@ -0,0 +1,1866 @@ +#include "proof/theory/logic/frac_ra.h" +#include "proof/theory/logic/ra_builder.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/ra.c" + +PROOF static size_t FRAC_RA_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +/* ------------------------------------------------------------------------- */ +/* Positive-real weights */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_frac_weight_rep_exists(void) { + term goal_tm = `exists p:real. &0 < p`; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = EXISTS_TAC(root, `&1:real`); + ACCEPT_TAC(body, get_theorem_by_name("REAL_LT_01")); + return gnode_prove(root); +} + +PROOF static thm FRAC_WEIGHT_REP_EXISTS = + prove_frac_weight_rep_exists(); + +PROOF static thm FRAC_WEIGHT_TYPE_BIJECTION = + new_type_bijection_definition( + "frac_weight", + "frac_weight_abs", + "frac_weight_rep", + FRAC_WEIGHT_REP_EXISTS); + +PROOF static thm frac_weight_value_def = + new_fun_definition(` + frac_weight_value (q:frac_weight) : real = + frac_weight_rep q + `); + +PROOF static thm frac_weight_of_real_def = + new_fun_definition(` + frac_weight_of_real (p:real) : frac_weight = + frac_weight_abs p + `); + +PROOF static thm frac_weight_add_def = + new_fun_definition(` + frac_weight_add + (q:frac_weight) + (r:frac_weight) : frac_weight = + frac_weight_of_real + (frac_weight_value q + frac_weight_value r) + `); + +PROOF static thm prove_frac_weight_value_pos(void) { + term goal_tm = ` + forall q:frac_weight. + &0 < frac_weight_value q + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + frac_weight_value_def, + FRAC_WEIGHT_TYPE_BIJECTION))); + return gnode_prove(root); +} + +PROOF static thm FRAC_WEIGHT_VALUE_POS = + prove_frac_weight_value_pos(); + +PROOF static thm prove_frac_weight_of_real_value(void) { + term goal_tm = ` + forall p:real. + &0 < p ==> + frac_weight_value (frac_weight_of_real p) == p + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm inverse = spec_rule( + `p:real`, + conjunct2_rule(FRAC_WEIGHT_TYPE_BIJECTION)); + thm represented = eq_mp_rule( + inverse, + assume_rule(`&0 < (p:real)`)); + thm reduced_goal = apply_conversion( + pure_rewrite_conv(THM_LIST( + frac_weight_value_def, + frac_weight_of_real_def)), + ` + frac_weight_value + (frac_weight_of_real (p:real)) == p + `); + ACCEPT_TAC( + body, + eq_mp_rule( + sym_rule(reduced_goal), + represented)); + return gnode_prove(root); +} + +PROOF static thm FRAC_WEIGHT_OF_REAL_VALUE = + prove_frac_weight_of_real_value(); + +PROOF static thm prove_frac_weight_add_value(void) { + term goal_tm = ` + forall q r:frac_weight. + frac_weight_value (frac_weight_add q r) == + frac_weight_value q + frac_weight_value r + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(frac_weight_add_def))); + + thm q_pos = ispec_rule( + `q:frac_weight`, + FRAC_WEIGHT_VALUE_POS); + thm r_pos = ispec_rule( + `r:frac_weight`, + FRAC_WEIGHT_VALUE_POS); + thm sum_pos = mp_rule( + ispecl_rule( + TERM_LIST( + `frac_weight_value (q:frac_weight)`, + `frac_weight_value (r:frac_weight)`), + get_theorem_by_name("REAL_LT_ADD")), + conj_rule(q_pos, r_pos)); + ACCEPT_TAC( + body, + mp_rule( + ispec_rule( + `frac_weight_value (q:frac_weight) + + frac_weight_value (r:frac_weight)`, + FRAC_WEIGHT_OF_REAL_VALUE), + sum_pos)); + return gnode_prove(root); +} + +PROOF static thm FRAC_WEIGHT_ADD_VALUE = + prove_frac_weight_add_value(); + +PROOF static thm prove_frac_weight_eq(void) { + term goal_tm = ` + forall q r:frac_weight. + q == r <=> + frac_weight_value q == frac_weight_value r + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Heq"); + ACCEPT_TAC( + forward, + ap_term_rule( + `frac_weight_value:frac_weight->real`, + assume_rule(`q:frac_weight == r`))); + + gnode reverse = DISCH_TAC(directions[1], "Hvalue"); + thm rep_eq = pure_rewrite_rule( + THM_LIST(frac_weight_value_def), + assume_rule(` + frac_weight_value (q:frac_weight) == + frac_weight_value (r:frac_weight) + `)); + thm abs_eq = ap_term_rule( + `frac_weight_abs:real->frac_weight`, + rep_eq); + abs_eq = rewrite_rule( + THM_LIST(conjunct1_rule( + FRAC_WEIGHT_TYPE_BIJECTION)), + abs_eq); + ACCEPT_TAC(reverse, abs_eq); + return gnode_prove(root); +} + +PROOF static thm FRAC_WEIGHT_EQ = + prove_frac_weight_eq(); + +PROOF static thm prove_frac_weight_add_assoc(void) { + term goal_tm = ` + forall q r s:frac_weight. + frac_weight_add (frac_weight_add q r) s == + frac_weight_add q (frac_weight_add r s) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST( + ispecl_rule( + TERM_LIST( + `frac_weight_add + (frac_weight_add + (q:frac_weight) + (r:frac_weight)) + (s:frac_weight)`, + `frac_weight_add + (q:frac_weight) + (frac_weight_add + (r:frac_weight) + (s:frac_weight))`), + FRAC_WEIGHT_EQ)))); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + FRAC_WEIGHT_ADD_VALUE, + get_theorem_by_name("REAL_ADD_ASSOC")))); + return gnode_prove(root); +} + +PROOF static thm FRAC_WEIGHT_ADD_ASSOC = + prove_frac_weight_add_assoc(); + +PROOF static thm prove_frac_weight_add_comm(void) { + term goal_tm = ` + forall q r:frac_weight. + frac_weight_add q r == frac_weight_add r q + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST( + ispecl_rule( + TERM_LIST( + `frac_weight_add + (q:frac_weight) + (r:frac_weight)`, + `frac_weight_add + (r:frac_weight) + (q:frac_weight)`), + FRAC_WEIGHT_EQ)))); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + FRAC_WEIGHT_ADD_VALUE, + get_theorem_by_name("REAL_ADD_SYM")))); + return gnode_prove(root); +} + +PROOF static thm FRAC_WEIGHT_ADD_COMM = + prove_frac_weight_add_comm(); + +PROOF static thm prove_frac_weight_add_le_left(void) { + term goal_tm = ` + forall q r:frac_weight. + frac_weight_value (frac_weight_add q r) <= &1 ==> + frac_weight_value q <= &1 + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm sum_bound = pure_once_rewrite_rule( + THM_LIST(ispecl_rule( + TERM_LIST( + `q:frac_weight`, + `r:frac_weight`), + FRAC_WEIGHT_ADD_VALUE)), + assume_rule(` + frac_weight_value + (frac_weight_add + (q:frac_weight) + (r:frac_weight)) <= &1 + `)); + thm r_pos = ispec_rule( + `r:frac_weight`, + FRAC_WEIGHT_VALUE_POS); + thm left_bound = mp_rule( + mp_rule( + real_arith_rule(` + &0 < frac_weight_value (r:frac_weight) ==> + frac_weight_value (q:frac_weight) + + frac_weight_value r <= &1 ==> + frac_weight_value q <= &1 + `), + r_pos), + sum_bound); + ACCEPT_TAC(body, left_bound); + return gnode_prove(root); +} + +PROOF static thm FRAC_WEIGHT_ADD_LE_LEFT = + prove_frac_weight_add_le_left(); + +/* ------------------------------------------------------------------------- */ +/* Raw fractional descriptor */ +/* ------------------------------------------------------------------------- */ + +PROOF static indtype frac_type = new_datatype_definition( + "frac = FracUnit" + " | Frac frac_weight A"); + +PROOF static thm frac_token_op_def = new_rec_definition( + frac_type.rec, + ` + frac_token_op + (R:(A)ra) + (q:frac_weight) + (a:A) + (FracUnit:(A)frac) = + Frac q a && + frac_token_op + (R:(A)ra) + (q:frac_weight) + (a:A) + (Frac r b) = + Frac + (frac_weight_add q r) + (ra_op R a b) + `); + +PROOF static thm frac_op_def = new_rec_definition( + frac_type.rec, + ` + frac_op + (R:(A)ra) + (FracUnit:(A)frac) + (y:(A)frac) = + y && + frac_op + (R:(A)ra) + (Frac q a) + (y:(A)frac) = + frac_token_op R q a y + `); + +PROOF static thm frac_valid_def = new_rec_definition( + frac_type.rec, + ` + (frac_valid + (R:(A)ra) + (FracUnit:(A)frac) <=> + T) && + (frac_valid + (R:(A)ra) + (Frac q a) <=> + frac_weight_value q <= &1 && + ra_valid R a) + `); + +PROOF static thm prove_frac_op_assoc(void) { + term goal_tm = ` + forall + (R:(A)ra) + (x:(A)frac) + (y:(A)frac) + (z:(A)frac). + frac_op R (frac_op R x y) z == + frac_op R x (frac_op R y z) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list x_cases = CASES_TAC( + body, `x:(A)frac`, NULL); + for (size_t i = 0; i < vector_size(x_cases); ++i) { + gnode_list y_cases = CASES_TAC( + x_cases[i], `y:(A)frac`, NULL); + for (size_t j = 0; j < vector_size(y_cases); ++j) { + gnode_list z_cases = CASES_TAC( + y_cases[j], `z:(A)frac`, NULL); + for (size_t k = 0; k < vector_size(z_cases); ++k) { + CONV_WITH_ASMP_TAC( + z_cases[k], + rewrite_conv, + THM_LIST( + frac_op_def, + frac_token_op_def, + FRAC_WEIGHT_ADD_ASSOC, + RA_ASSOC)); + } + } + } + return gnode_prove(root); +} + +PROOF static thm FRAC_OP_ASSOC = + prove_frac_op_assoc(); + +PROOF static thm prove_frac_op_comm(void) { + term goal_tm = ` + forall + (R:(A)ra) + (x:(A)frac) + (y:(A)frac). + frac_op R x y == frac_op R y x + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list x_cases = CASES_TAC( + body, `x:(A)frac`, NULL); + for (size_t i = 0; i < vector_size(x_cases); ++i) { + gnode_list y_cases = CASES_TAC( + x_cases[i], `y:(A)frac`, NULL); + for (size_t j = 0; j < vector_size(y_cases); ++j) { + CONV_WITH_ASMP_TAC( + y_cases[j], + rewrite_conv, + THM_LIST( + frac_op_def, + frac_token_op_def, + FRAC_WEIGHT_ADD_COMM, + RA_COMM)); + } + } + return gnode_prove(root); +} + +PROOF static thm FRAC_OP_COMM = + prove_frac_op_comm(); + +PROOF static thm prove_frac_op_unit_l(void) { + term goal_tm = ` + forall (R:(A)ra) (x:(A)frac). + frac_op R FracUnit x == x + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + CONV_TAC( + body, + rewrite_conv(THM_LIST(frac_op_def))); + return gnode_prove(root); +} + +PROOF static thm FRAC_OP_UNIT_L = + prove_frac_op_unit_l(); + +PROOF static thm prove_frac_valid_unit(void) { + term goal_tm = ` + forall R:(A)ra. + frac_valid R (FracUnit:(A)frac) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST(frac_valid_def))); + return gnode_prove(root); +} + +PROOF static thm FRAC_VALID_UNIT = + prove_frac_valid_unit(); + +PROOF static thm prove_frac_valid_op_l(void) { + term goal_tm = ` + forall + (R:(A)ra) + (x:(A)frac) + (y:(A)frac). + frac_valid R (frac_op R x y) ==> + frac_valid R x + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list x_cases = CASES_TAC( + body, `x:(A)frac`, NULL); + for (size_t i = 0; i < vector_size(x_cases); ++i) { + gnode_list y_cases = CASES_TAC( + x_cases[i], `y:(A)frac`, NULL); + for (size_t j = 0; j < vector_size(y_cases); ++j) { + if (i == 0) { + CONV_WITH_ASMP_TAC( + y_cases[j], + rewrite_conv, + THM_LIST(frac_valid_def)); + } else { + thm source_valid = rewrite_rule( + THM_LIST( + assume_rule(` + (x:(A)frac) == Frac a0 a1 + `), + j == 0 + ? assume_rule(` + (y:(A)frac) == FracUnit + `) + : assume_rule(` + (y:(A)frac) == Frac a0_ a1_ + `), + frac_op_def, + frac_token_op_def, + frac_valid_def), + assume_rule(` + frac_valid + (R:(A)ra) + (frac_op R (x:(A)frac) (y:(A)frac)) + `)); + + thm target_components; + if (j == 0) { + target_components = source_valid; + } else { + thm source_weight = conjunct1_rule(source_valid); + thm source_payload = conjunct2_rule(source_valid); + thm target_weight = mp_rule( + ispecl_rule( + TERM_LIST( + `a0:frac_weight`, + `a0_:frac_weight`), + FRAC_WEIGHT_ADD_LE_LEFT), + source_weight); + thm target_payload = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a1:A`, + `a1_:A`), + RA_VALID_OP_L), + source_payload); + target_components = + conj_rule(target_weight, target_payload); + } + + thm reduced_target = apply_conversion( + pure_rewrite_conv(THM_LIST( + assume_rule(` + (x:(A)frac) == Frac a0 a1 + `), + frac_valid_def)), + `frac_valid (R:(A)ra) (x:(A)frac)`); + ACCEPT_TAC( + y_cases[j], + eq_mp_rule( + sym_rule(reduced_target), + target_components)); + } + } + } + return gnode_prove(root); +} + +PROOF static thm FRAC_VALID_OP_L = + prove_frac_valid_op_l(); + +PROOF static thm prove_frac_ra_laws(void) { + term goal_tm = ` + forall R:(A)ra. + ra_laws + (FracUnit:(A)frac) + (frac_op R) + (frac_valid R) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + gnode unfolded = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_laws_def))); + + gnode_list law1 = CONJ_TAC(unfolded); + ACCEPT_TAC( + law1[0], + spec_rule(`R:(A)ra`, FRAC_OP_ASSOC)); + + gnode_list law2 = CONJ_TAC(law1[1]); + ACCEPT_TAC( + law2[0], + spec_rule(`R:(A)ra`, FRAC_OP_COMM)); + + gnode_list law3 = CONJ_TAC(law2[1]); + ACCEPT_TAC( + law3[0], + spec_rule(`R:(A)ra`, FRAC_OP_UNIT_L)); + + gnode_list law4 = CONJ_TAC(law3[1]); + ACCEPT_TAC( + law4[0], + spec_rule(`R:(A)ra`, FRAC_VALID_UNIT)); + ACCEPT_TAC( + law4[1], + spec_rule(`R:(A)ra`, FRAC_VALID_OP_L)); + return gnode_prove(root); +} + +PROOF static thm FRAC_RA_LAWS = + prove_frac_ra_laws(); + +PROOF static thm frac_ra_def = new_fun_definition(` + frac_ra (R:(A)ra) : ((A)frac)ra = + ra_abs + ((FracUnit:(A)frac), + (frac_op R,frac_valid R)) +`); + +PROOF static thm prove_frac_ra_unit_raw(void) { + term R = `R:(A)ra`; + thm laws = ispec_rule(R, FRAC_RA_LAWS); + thm computed = mp_rule( + ispecl_rule( + TERM_LIST( + `FracUnit:(A)frac`, + `frac_op (R:(A)ra):(A)frac->(A)frac->(A)frac`, + `frac_valid (R:(A)ra):(A)frac->bool`), + RA_UNIT_ABS), + laws); + computed = pure_once_rewrite_rule( + THM_LIST(gsym_rule(frac_ra_def)), + computed); + return gen_rule(R, computed); +} + +PROOF static thm FRAC_RA_UNIT_RAW = + prove_frac_ra_unit_raw(); + +PROOF static thm prove_frac_ra_op_fn(void) { + term R = `R:(A)ra`; + thm laws = ispec_rule(R, FRAC_RA_LAWS); + thm computed = mp_rule( + ispecl_rule( + TERM_LIST( + `FracUnit:(A)frac`, + `frac_op (R:(A)ra):(A)frac->(A)frac->(A)frac`, + `frac_valid (R:(A)ra):(A)frac->bool`), + RA_OP_ABS), + laws); + computed = pure_once_rewrite_rule( + THM_LIST(gsym_rule(frac_ra_def)), + computed); + return gen_rule(R, computed); +} + +PROOF static thm FRAC_RA_OP_FN = + prove_frac_ra_op_fn(); + +PROOF static thm prove_frac_ra_valid_fn(void) { + term R = `R:(A)ra`; + thm laws = ispec_rule(R, FRAC_RA_LAWS); + thm computed = mp_rule( + ispecl_rule( + TERM_LIST( + `FracUnit:(A)frac`, + `frac_op (R:(A)ra):(A)frac->(A)frac->(A)frac`, + `frac_valid (R:(A)ra):(A)frac->bool`), + RA_VALID_ABS), + laws); + computed = pure_once_rewrite_rule( + THM_LIST(gsym_rule(frac_ra_def)), + computed); + return gen_rule(R, computed); +} + +PROOF static thm FRAC_RA_VALID_FN = + prove_frac_ra_valid_fn(); + +/* ------------------------------------------------------------------------- */ +/* Public smart constructors and semantic rules */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm frac_empty_def = new_fun_definition(` + frac_empty : (A)frac = FracUnit +`); + +PROOF static thm frac_own_def = new_fun_definition(` + frac_own (p:real) (a:A) : (A)frac = + Frac (frac_weight_of_real p) a +`); + +PROOF static thm frac_full_def = new_fun_definition(` + frac_full (a:A) : (A)frac = + frac_own (&1) a +`); + +PROOF static thm prove_frac_ra_unit(void) { + term goal_tm = ` + forall R:(A)ra. + ra_unit (frac_ra R) == + (frac_empty:(A)frac) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + FRAC_RA_UNIT_RAW, + frac_empty_def))); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_UNIT = + prove_frac_ra_unit(); + +PROOF static thm prove_frac_ra_full(void) { + term goal_tm = ` + forall a:A. + frac_full a == frac_own (&1) a + `; + thm reduced = apply_conversion( + rewrite_conv(THM_LIST(frac_full_def)), + goal_tm); + return eqt_elim_rule(reduced); +} + +PROOF thm FRAC_RA_FULL = + prove_frac_ra_full(); + +PROOF static thm prove_frac_ra_own_op(void) { + term goal_tm = ` + forall + (R:(A)ra) + (p:real) + (q:real) + (a:A) + (b:A). + &0 < (p:real) ==> + &0 < (q:real) ==> + ra_op + (frac_ra R) + (frac_own (p:real) (a:A)) + (frac_own (q:real) (b:A)) == + frac_own + ((p:real) + (q:real)) + (ra_op R (a:A) (b:A)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + term conclusion_tm = ` + ra_op + (frac_ra (R:(A)ra)) + (frac_own (p:real) (a:A)) + (frac_own (q:real) (b:A)) == + frac_own + ((p:real) + (q:real)) + (ra_op R (a:A) (b:A)) + `; + thm p_value = mp_rule( + ispec_rule( + `p:real`, + FRAC_WEIGHT_OF_REAL_VALUE), + assume_rule(`&0 < (p:real)`)); + thm q_value = mp_rule( + ispec_rule( + `q:real`, + FRAC_WEIGHT_OF_REAL_VALUE), + assume_rule(`&0 < (q:real)`)); + thm reduced = apply_conversion( + rewrite_conv(THM_LIST( + FRAC_RA_OP_FN, + frac_op_def, + frac_token_op_def, + frac_own_def, + frac_weight_add_def, + p_value, + q_value)), + conclusion_tm); + ACCEPT_TAC(body, eqt_elim_rule(reduced)); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_OWN_OP = + prove_frac_ra_own_op(); + +PROOF static thm prove_frac_ra_valid_empty(void) { + term goal_tm = ` + forall R:(A)ra. + ra_valid + (frac_ra R) + (frac_empty:(A)frac) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + FRAC_RA_VALID_FN, + frac_valid_def, + frac_empty_def))); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_VALID_EMPTY = + prove_frac_ra_valid_empty(); + +PROOF static thm prove_frac_ra_valid_own(void) { + term goal_tm = ` + forall (R:(A)ra) (p:real) (a:A). + &0 < p ==> + (ra_valid + (frac_ra R) + (frac_own p a) <=> + p <= &1 && ra_valid R a) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm p_value = mp_rule( + ispec_rule( + `p:real`, + FRAC_WEIGHT_OF_REAL_VALUE), + assume_rule(`&0 < (p:real)`)); + thm reduced = apply_conversion( + rewrite_conv(THM_LIST( + FRAC_RA_VALID_FN, + frac_valid_def, + frac_own_def, + p_value)), + ` + ra_valid + (frac_ra (R:(A)ra)) + (frac_own (p:real) (a:A)) <=> + p <= &1 && ra_valid R a + `); + ACCEPT_TAC(body, eqt_elim_rule(reduced)); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_VALID_OWN = + prove_frac_ra_valid_own(); + +PROOF static thm prove_frac_ra_valid_full(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A). + ra_valid + (frac_ra R) + (frac_full a) <=> + ra_valid R a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm owned_valid = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `&1:real`, + `a:A`), + FRAC_RA_VALID_OWN), + get_theorem_by_name("REAL_LT_01")); + owned_valid = rewrite_rule( + THM_LIST(get_theorem_by_name("REAL_LE_REFL")), + owned_valid); + thm reduced_target = apply_conversion( + pure_once_rewrite_conv(THM_LIST(frac_full_def)), + ` + ra_valid + (frac_ra (R:(A)ra)) + (frac_full (a:A)) <=> + ra_valid R a + `); + ACCEPT_TAC( + body, + eq_mp_rule( + sym_rule(reduced_target), + owned_valid)); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_VALID_FULL = + prove_frac_ra_valid_full(); + +/* ------------------------------------------------------------------------- */ +/* Optional algebraic properties */ +/* ------------------------------------------------------------------------- */ + +/* + * Positive weights make cancellation of an owned fractional frame possible: + * mixed unit/owned targets would force a positive added weight to be zero, + * while two owned targets reduce to weight cancellation and cancellativity of + * the base payload operation. + */ +PROOF static thm prove_frac_ra_cancellative(void) { + term goal_tm = ` + forall R:(A)ra. + ra_cancellative R ==> + ra_cancellative (frac_ra R) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_cancellative_def))); + body = AUTO_INTROS_TAC(body); + + thm frac_injective = + get_datatype_injectivity("frac"); + term weight_value_fn = ` + frac_weight_value:frac_weight->real + `; + thm positive_not_zero = real_arith_rule(` + forall z:real. + &0 < z ==> + z == &0 ==> + F + `); + + gnode_list frame_cases = CASES_TAC( + body, `frame:(A)frac`, "Hframe"); + + thm frame_unit_eq = assume_rule( + gnode_get_asmps( + frame_cases[0], + CONST_STRING_LIST("Hframe"))[0]); + thm unit_combination_eq = rewrite_rule( + THM_LIST( + frame_unit_eq, + FRAC_RA_OP_FN, + frac_op_def), + assume_rule(` + ra_op + (frac_ra (R:(A)ra)) + (frame:(A)frac) + (a:(A)frac) == + ra_op + (frac_ra R) + frame + (b:(A)frac) + `)); + ACCEPT_TAC( + frame_cases[0], + unit_combination_eq); + + term frame_eq_tm = gnode_get_asmps( + frame_cases[1], + CONST_STRING_LIST("Hframe"))[0]; + thm frame_owned_eq = assume_rule(frame_eq_tm); + term frame_owned_tm = dest_eq(frame_eq_tm).tm2; + term frame_weight = dest_comb( + dest_comb(frame_owned_tm).tm1).tm2; + term frame_payload = dest_comb(frame_owned_tm).tm2; + term frame_value = mk_comb( + weight_value_fn, frame_weight); + + gnode_list left_cases = CASES_TAC( + frame_cases[1], `a:(A)frac`, "Hleft"); + + gnode_list unit_left_right_cases = CASES_TAC( + left_cases[0], `b:(A)frac`, "Hright"); + + thm unit_left_eq = assume_rule( + gnode_get_asmps( + unit_left_right_cases[0], + CONST_STRING_LIST("Hleft"))[0]); + thm unit_right_eq = assume_rule( + gnode_get_asmps( + unit_left_right_cases[0], + CONST_STRING_LIST("Hright"))[0]); + ACCEPT_TAC( + unit_left_right_cases[0], + trans_rule( + unit_left_eq, + sym_rule(unit_right_eq))); + + term unit_owned_right_eq_tm = gnode_get_asmps( + unit_left_right_cases[1], + CONST_STRING_LIST("Hright"))[0]; + thm unit_owned_left_eq = assume_rule( + gnode_get_asmps( + unit_left_right_cases[1], + CONST_STRING_LIST("Hleft"))[0]); + thm unit_owned_right_eq = assume_rule( + unit_owned_right_eq_tm); + term unit_owned_right_tm = + dest_eq(unit_owned_right_eq_tm).tm2; + term unit_owned_right_weight = dest_comb( + dest_comb(unit_owned_right_tm).tm1).tm2; + term unit_owned_right_value = mk_comb( + weight_value_fn, + unit_owned_right_weight); + thm unit_owned_combination = rewrite_rule( + THM_LIST( + frame_owned_eq, + unit_owned_left_eq, + unit_owned_right_eq, + FRAC_RA_OP_FN, + frac_op_def, + frac_token_op_def, + frac_injective), + assume_rule(` + ra_op + (frac_ra (R:(A)ra)) + (frame:(A)frac) + (a:(A)frac) == + ra_op + (frac_ra R) + frame + (b:(A)frac) + `)); + thm unit_owned_weight_eq = ap_term_rule( + weight_value_fn, + conjunct1_rule(unit_owned_combination)); + unit_owned_weight_eq = pure_rewrite_rule( + THM_LIST(FRAC_WEIGHT_ADD_VALUE), + unit_owned_weight_eq); + unit_owned_weight_eq = sym_rule( + unit_owned_weight_eq); + thm unit_owned_zero = eq_mp_rule( + ispecl_rule( + TERM_LIST( + frame_value, + unit_owned_right_value), + get_theorem_by_name( + "REAL_EQ_ADD_LCANCEL_0")), + unit_owned_weight_eq); + thm unit_owned_impossible = mp_rule( + mp_rule( + spec_rule( + unit_owned_right_value, + positive_not_zero), + ispec_rule( + unit_owned_right_weight, + FRAC_WEIGHT_VALUE_POS)), + unit_owned_zero); + CONTR_TAC( + unit_left_right_cases[1], + unit_owned_impossible); + + term owned_left_eq_tm = gnode_get_asmps( + left_cases[1], + CONST_STRING_LIST("Hleft"))[0]; + term owned_left_tm = dest_eq(owned_left_eq_tm).tm2; + term owned_left_weight = dest_comb( + dest_comb(owned_left_tm).tm1).tm2; + term owned_left_payload = dest_comb(owned_left_tm).tm2; + term owned_left_value = mk_comb( + weight_value_fn, + owned_left_weight); + gnode_list owned_left_right_cases = CASES_TAC( + left_cases[1], `b:(A)frac`, "Hright"); + + thm owned_unit_left_eq = assume_rule( + gnode_get_asmps( + owned_left_right_cases[0], + CONST_STRING_LIST("Hleft"))[0]); + thm owned_unit_right_eq = assume_rule( + gnode_get_asmps( + owned_left_right_cases[0], + CONST_STRING_LIST("Hright"))[0]); + thm owned_unit_combination = rewrite_rule( + THM_LIST( + frame_owned_eq, + owned_unit_left_eq, + owned_unit_right_eq, + FRAC_RA_OP_FN, + frac_op_def, + frac_token_op_def, + frac_injective), + assume_rule(` + ra_op + (frac_ra (R:(A)ra)) + (frame:(A)frac) + (a:(A)frac) == + ra_op + (frac_ra R) + frame + (b:(A)frac) + `)); + thm owned_unit_weight_eq = ap_term_rule( + weight_value_fn, + conjunct1_rule(owned_unit_combination)); + owned_unit_weight_eq = pure_rewrite_rule( + THM_LIST(FRAC_WEIGHT_ADD_VALUE), + owned_unit_weight_eq); + thm owned_unit_zero = eq_mp_rule( + ispecl_rule( + TERM_LIST( + frame_value, + owned_left_value), + get_theorem_by_name( + "REAL_EQ_ADD_LCANCEL_0")), + owned_unit_weight_eq); + thm owned_unit_impossible = mp_rule( + mp_rule( + spec_rule( + owned_left_value, + positive_not_zero), + ispec_rule( + owned_left_weight, + FRAC_WEIGHT_VALUE_POS)), + owned_unit_zero); + CONTR_TAC( + owned_left_right_cases[0], + owned_unit_impossible); + + term owned_right_eq_tm = gnode_get_asmps( + owned_left_right_cases[1], + CONST_STRING_LIST("Hright"))[0]; + thm owned_owned_left_eq = assume_rule( + gnode_get_asmps( + owned_left_right_cases[1], + CONST_STRING_LIST("Hleft"))[0]); + thm owned_owned_right_eq = assume_rule( + owned_right_eq_tm); + term owned_right_tm = dest_eq(owned_right_eq_tm).tm2; + term owned_right_weight = dest_comb( + dest_comb(owned_right_tm).tm1).tm2; + term owned_right_payload = dest_comb(owned_right_tm).tm2; + term owned_right_value = mk_comb( + weight_value_fn, + owned_right_weight); + + thm owned_owned_combination = rewrite_rule( + THM_LIST( + frame_owned_eq, + owned_owned_left_eq, + owned_owned_right_eq, + FRAC_RA_OP_FN, + frac_op_def, + frac_token_op_def, + frac_injective), + assume_rule(` + ra_op + (frac_ra (R:(A)ra)) + (frame:(A)frac) + (a:(A)frac) == + ra_op + (frac_ra R) + frame + (b:(A)frac) + `)); + thm owned_owned_weight_value_eq = ap_term_rule( + weight_value_fn, + conjunct1_rule(owned_owned_combination)); + owned_owned_weight_value_eq = pure_rewrite_rule( + THM_LIST(FRAC_WEIGHT_ADD_VALUE), + owned_owned_weight_value_eq); + thm owned_owned_value_eq = eq_mp_rule( + ispecl_rule( + TERM_LIST( + frame_value, + owned_left_value, + owned_right_value), + get_theorem_by_name( + "REAL_EQ_ADD_LCANCEL")), + owned_owned_weight_value_eq); + thm owned_owned_weight_eq = eq_mp_rule( + sym_rule(ispecl_rule( + TERM_LIST( + owned_left_weight, + owned_right_weight), + FRAC_WEIGHT_EQ)), + owned_owned_value_eq); + + thm source_owned_valid = rewrite_rule( + THM_LIST( + frame_owned_eq, + owned_owned_left_eq, + FRAC_RA_OP_FN, + FRAC_RA_VALID_FN, + frac_op_def, + frac_token_op_def, + frac_valid_def), + assume_rule(` + ra_valid + (frac_ra (R:(A)ra)) + (ra_op + (frac_ra R) + (frame:(A)frac) + (a:(A)frac)) + `)); + thm owned_owned_payload_eq = mp_rule( + mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + frame_payload, + owned_left_payload, + owned_right_payload), + RA_CANCELLATIVE_APPLY), + assume_rule(` + ra_cancellative (R:(A)ra) + `)), + conjunct2_rule(source_owned_valid)), + conjunct2_rule(owned_owned_combination)); + gnode owned_owned_goal = CONV_TAC( + owned_left_right_cases[1], + rewrite_conv(THM_LIST( + owned_owned_left_eq, + owned_owned_right_eq, + frac_injective))); + ACCEPT_TAC( + owned_owned_goal, + conj_rule( + owned_owned_weight_eq, + owned_owned_payload_eq)); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_CANCELLATIVE = + prove_frac_ra_cancellative(); + +/* ------------------------------------------------------------------------- */ +/* Weight weakening and lifted payload updates */ +/* ------------------------------------------------------------------------- */ + +/* + * Lowering the positive weight can only make each source-compatible frame + * satisfy a weaker weight bound. Payload compatibility is preserved by the + * base frame-preserving update at the payload carried by that same frame. + */ +PROOF static thm prove_frac_ra_update_weaken(void) { + term goal_tm = ` + forall + (R:(A)ra) + (p:real) + (q:real) + (a:A) + (b:A). + &0 < q ==> + q <= p ==> + ra_update R a b ==> + ra_update + (frac_ra R) + (frac_own p a) + (frac_own q b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + thm p_pos = mp_rule( + ispecl_rule( + TERM_LIST( + `&0:real`, + `q:real`, + `p:real`), + get_theorem_by_name("REAL_LTE_TRANS")), + conj_rule( + assume_rule(`&0 < (q:real)`), + assume_rule(`(q:real) <= (p:real)`))); + thm p_value = mp_rule( + ispec_rule( + `p:real`, + FRAC_WEIGHT_OF_REAL_VALUE), + p_pos); + thm q_value = mp_rule( + ispec_rule( + `q:real`, + FRAC_WEIGHT_OF_REAL_VALUE), + assume_rule(`&0 < (q:real)`)); + + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_def))); + body = AUTO_INTROS_TAC(body); + gnode_list frame_cases = CASES_TAC( + body, `frame:(A)frac`, NULL); + + thm source_unit = rewrite_rule( + THM_LIST( + assume_rule(` + (frame:(A)frac) == FracUnit + `), + FRAC_RA_OP_FN, + FRAC_RA_VALID_FN, + frac_op_def, + frac_token_op_def, + frac_valid_def, + frac_own_def, + p_value), + assume_rule(` + ra_valid + (frac_ra (R:(A)ra)) + (ra_op + (frac_ra R) + (frac_own (p:real) (a:A)) + (frame:(A)frac)) + `)); + thm target_unit_payload = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `b:A`), + RA_UPDATE_VALID), + assume_rule(` + ra_update (R:(A)ra) (a:A) (b:A) + `)), + conjunct2_rule(source_unit)); + thm target_unit_weight = mp_rule( + ispecl_rule( + TERM_LIST( + `q:real`, + `p:real`, + `&1:real`), + get_theorem_by_name("REAL_LE_TRANS")), + conj_rule( + assume_rule(`(q:real) <= (p:real)`), + conjunct1_rule(source_unit))); + gnode target_unit = CONV_TAC( + frame_cases[0], + rewrite_conv(THM_LIST( + assume_rule(` + (frame:(A)frac) == FracUnit + `), + FRAC_RA_OP_FN, + FRAC_RA_VALID_FN, + frac_op_def, + frac_token_op_def, + frac_valid_def, + frac_own_def, + q_value))); + ACCEPT_TAC( + target_unit, + conj_rule( + target_unit_weight, + target_unit_payload)); + + thm source_owned = rewrite_rule( + THM_LIST( + assume_rule(` + (frame:(A)frac) == Frac a0 a1 + `), + FRAC_RA_OP_FN, + FRAC_RA_VALID_FN, + frac_op_def, + frac_token_op_def, + frac_valid_def, + frac_own_def, + FRAC_WEIGHT_ADD_VALUE, + p_value), + assume_rule(` + ra_valid + (frac_ra (R:(A)ra)) + (ra_op + (frac_ra R) + (frac_own (p:real) (a:A)) + (frame:(A)frac)) + `)); + thm base_update = pure_once_rewrite_rule( + THM_LIST(ra_update_def), + assume_rule(` + ra_update (R:(A)ra) (a:A) (b:A) + `)); + thm target_owned_payload = mp_rule( + spec_rule(`a1:A`, base_update), + conjunct2_rule(source_owned)); + thm weakened_sum = eq_mp_rule( + sym_rule(ispecl_rule( + TERM_LIST( + `q:real`, + `p:real`, + `frac_weight_value (a0:frac_weight)`), + get_theorem_by_name("REAL_LE_RADD"))), + assume_rule(`(q:real) <= (p:real)`)); + thm target_owned_weight = mp_rule( + ispecl_rule( + TERM_LIST( + `(q:real) + frac_weight_value (a0:frac_weight)`, + `(p:real) + frac_weight_value (a0:frac_weight)`, + `&1:real`), + get_theorem_by_name("REAL_LE_TRANS")), + conj_rule( + weakened_sum, + conjunct1_rule(source_owned))); + gnode target_owned = CONV_TAC( + frame_cases[1], + rewrite_conv(THM_LIST( + assume_rule(` + (frame:(A)frac) == Frac a0 a1 + `), + FRAC_RA_OP_FN, + FRAC_RA_VALID_FN, + frac_op_def, + frac_token_op_def, + frac_valid_def, + frac_own_def, + FRAC_WEIGHT_ADD_VALUE, + q_value))); + ACCEPT_TAC( + target_owned, + conj_rule( + target_owned_weight, + target_owned_payload)); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_UPDATE_WEAKEN = + prove_frac_ra_update_weaken(); + +/* + * The ND rule selects a base result separately for each source-compatible + * fractional frame, while exposing only the exact fixed-weight image of P. + */ +PROOF static thm prove_frac_ra_update_weaken_nd(void) { + term goal_tm = ` + forall + (R:(A)ra) + (p:real) + (q:real) + (a:A) + (P:A->bool). + &0 < q ==> + q <= p ==> + ra_update_nd R a P ==> + ra_update_nd + (frac_ra R) + (frac_own p a) + (\x:(A)frac. + exists b:A. + P b && x == frac_own q b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + thm p_pos = mp_rule( + ispecl_rule( + TERM_LIST( + `&0:real`, + `q:real`, + `p:real`), + get_theorem_by_name("REAL_LTE_TRANS")), + conj_rule( + assume_rule(`&0 < (q:real)`), + assume_rule(`(q:real) <= (p:real)`))); + thm p_value = mp_rule( + ispec_rule( + `p:real`, + FRAC_WEIGHT_OF_REAL_VALUE), + p_pos); + thm q_value = mp_rule( + ispec_rule( + `q:real`, + FRAC_WEIGHT_OF_REAL_VALUE), + assume_rule(`&0 < (q:real)`)); + + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = AUTO_INTROS_TAC(body); + gnode_list frame_cases = CASES_TAC( + body, `frame:(A)frac`, NULL); + + thm source_unit = rewrite_rule( + THM_LIST( + assume_rule(` + (frame:(A)frac) == FracUnit + `), + FRAC_RA_OP_FN, + FRAC_RA_VALID_FN, + frac_op_def, + frac_token_op_def, + frac_valid_def, + frac_own_def, + p_value), + assume_rule(` + ra_valid + (frac_ra (R:(A)ra)) + (ra_op + (frac_ra R) + (frac_own (p:real) (a:A)) + (frame:(A)frac)) + `)); + thm selected_unit = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `P:A->bool`), + RA_UPDATE_ND_VALID), + assume_rule(` + ra_update_nd + (R:(A)ra) + (a:A) + (P:A->bool) + `)), + conjunct2_rule(source_unit)); + gnode unit_branch = ASSUME_TAC( + frame_cases[0], selected_unit, "Hselected"); + unit_branch = ASMP_EXISTS_TAC( + unit_branch, "Hselected", "b"); + unit_branch = ASMP_CONJ_TAC( + unit_branch, + "Hselected", + "HP_b", + "Hb_valid"); + unit_branch = EXISTS_TAC( + unit_branch, `frac_own (q:real) (b:A)`); + gnode_list unit_result = CONJ_TAC(unit_branch); + gnode unit_predicate = EXISTS_TAC( + unit_result[0], `b:A`); + gnode_list unit_predicate_parts = CONJ_TAC( + unit_predicate); + ACCEPT_TAC( + unit_predicate_parts[0], + assume_rule(`(P:A->bool) (b:A)`)); + ACCEPT_TAC( + unit_predicate_parts[1], + refl_rule(`frac_own (q:real) (b:A)`)); + + thm target_unit_weight = mp_rule( + ispecl_rule( + TERM_LIST( + `q:real`, + `p:real`, + `&1:real`), + get_theorem_by_name("REAL_LE_TRANS")), + conj_rule( + assume_rule(`(q:real) <= (p:real)`), + conjunct1_rule(source_unit))); + gnode target_unit = CONV_TAC( + unit_result[1], + rewrite_conv(THM_LIST( + assume_rule(` + (frame:(A)frac) == FracUnit + `), + FRAC_RA_OP_FN, + FRAC_RA_VALID_FN, + frac_op_def, + frac_token_op_def, + frac_valid_def, + frac_own_def, + q_value))); + ACCEPT_TAC( + target_unit, + conj_rule( + target_unit_weight, + assume_rule(`ra_valid (R:(A)ra) (b:A)`))); + + thm source_owned = rewrite_rule( + THM_LIST( + assume_rule(` + (frame:(A)frac) == Frac a0 a1 + `), + FRAC_RA_OP_FN, + FRAC_RA_VALID_FN, + frac_op_def, + frac_token_op_def, + frac_valid_def, + frac_own_def, + FRAC_WEIGHT_ADD_VALUE, + p_value), + assume_rule(` + ra_valid + (frac_ra (R:(A)ra)) + (ra_op + (frac_ra R) + (frac_own (p:real) (a:A)) + (frame:(A)frac)) + `)); + thm base_update = pure_once_rewrite_rule( + THM_LIST(ra_update_nd_def), + assume_rule(` + ra_update_nd + (R:(A)ra) + (a:A) + (P:A->bool) + `)); + thm selected_owned = mp_rule( + spec_rule(`a1:A`, base_update), + conjunct2_rule(source_owned)); + gnode owned_branch = ASSUME_TAC( + frame_cases[1], selected_owned, "Hselected"); + owned_branch = ASMP_EXISTS_TAC( + owned_branch, "Hselected", "b"); + owned_branch = ASMP_CONJ_TAC( + owned_branch, + "Hselected", + "HP_b", + "Hb_valid"); + owned_branch = EXISTS_TAC( + owned_branch, `frac_own (q:real) (b:A)`); + gnode_list owned_result = CONJ_TAC(owned_branch); + gnode owned_predicate = EXISTS_TAC( + owned_result[0], `b:A`); + gnode_list owned_predicate_parts = CONJ_TAC( + owned_predicate); + ACCEPT_TAC( + owned_predicate_parts[0], + assume_rule(`(P:A->bool) (b:A)`)); + ACCEPT_TAC( + owned_predicate_parts[1], + refl_rule(`frac_own (q:real) (b:A)`)); + + thm weakened_sum = eq_mp_rule( + sym_rule(ispecl_rule( + TERM_LIST( + `q:real`, + `p:real`, + `frac_weight_value (a0:frac_weight)`), + get_theorem_by_name("REAL_LE_RADD"))), + assume_rule(`(q:real) <= (p:real)`)); + thm target_owned_weight = mp_rule( + ispecl_rule( + TERM_LIST( + `(q:real) + frac_weight_value (a0:frac_weight)`, + `(p:real) + frac_weight_value (a0:frac_weight)`, + `&1:real`), + get_theorem_by_name("REAL_LE_TRANS")), + conj_rule( + weakened_sum, + conjunct1_rule(source_owned))); + gnode target_owned = CONV_TAC( + owned_result[1], + rewrite_conv(THM_LIST( + assume_rule(` + (frame:(A)frac) == Frac a0 a1 + `), + FRAC_RA_OP_FN, + FRAC_RA_VALID_FN, + frac_op_def, + frac_token_op_def, + frac_valid_def, + frac_own_def, + FRAC_WEIGHT_ADD_VALUE, + q_value))); + ACCEPT_TAC( + target_owned, + conj_rule( + target_owned_weight, + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (b:A) (a1:A)) + `))); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_UPDATE_WEAKEN_ND = + prove_frac_ra_update_weaken_nd(); + +PROOF static thm prove_frac_ra_update_full(void) { + term goal_tm = ` + forall + (R:(A)ra) + (a:A) + (b:A). + ra_valid R (b:A) ==> + ra_update + (frac_ra R) + (frac_full (a:A)) + (frac_full (b:A)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_update_def))); + body = AUTO_INTROS_TAC(body); + gnode_list frame_cases = CASES_TAC( + body, `frame:(A)frac`, NULL); + + thm target_full_valid = eq_mp_rule( + sym_rule(ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `b:A`), + FRAC_RA_VALID_FULL)), + assume_rule(`ra_valid (R:(A)ra) (b:A)`)); + thm op_unit = ispecl_rule( + TERM_LIST( + `frac_ra (R:(A)ra)`, + `frac_full (b:A)`), + RA_UNIT_R); + op_unit = pure_once_rewrite_rule( + THM_LIST(spec_rule( + `R:(A)ra`, + FRAC_RA_UNIT_RAW)), + op_unit); + thm op_frame = pure_once_rewrite_rule( + THM_LIST(gsym_rule(assume_rule(` + (frame:(A)frac) == FracUnit + `))), + op_unit); + thm target_valid_eq = ap_term_rule( + `ra_valid (frac_ra (R:(A)ra)):(A)frac->bool`, + gsym_rule(op_frame)); + ACCEPT_TAC( + frame_cases[0], + eq_mp_rule( + target_valid_eq, + target_full_valid)); + + thm one_value = mp_rule( + ispec_rule( + `&1:real`, + FRAC_WEIGHT_OF_REAL_VALUE), + get_theorem_by_name("REAL_LT_01")); + thm source_valid = rewrite_rule( + THM_LIST( + assume_rule(` + (frame:(A)frac) == Frac a0 a1 + `), + FRAC_RA_OP_FN, + FRAC_RA_VALID_FN, + frac_op_def, + frac_token_op_def, + frac_valid_def, + frac_full_def, + frac_own_def, + FRAC_WEIGHT_ADD_VALUE, + one_value), + assume_rule(` + ra_valid + (frac_ra (R:(A)ra)) + (ra_op + (frac_ra R) + (frac_full (a:A)) + (frame:(A)frac)) + `)); + thm source_weight = conjunct1_rule(source_valid); + thm frame_pos = ispec_rule( + `a0:frac_weight`, + FRAC_WEIGHT_VALUE_POS); + thm impossible = mp_rule( + mp_rule( + real_arith_rule(` + &0 < frac_weight_value (a0:frac_weight) ==> + &1 + frac_weight_value a0 <= &1 ==> + F + `), + frame_pos), + source_weight); + CONTR_TAC(frame_cases[1], impossible); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_UPDATE_FULL = + prove_frac_ra_update_full(); + +PROOF static thm prove_frac_ra_update_full_nd(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (P:A->bool). + (exists b:A. P b && ra_valid R b) ==> + ra_update_nd + (frac_ra R) + (frac_full a) + (\x:(A)frac. + exists b:A. + P b && x == frac_full b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = ASMP_EXISTS_TAC(body, "H", "b"); + body = ASMP_CONJ_TAC( + body, + "H", + "HP", + "Hvalid_b"); + + thm deterministic = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `b:A`), + FRAC_RA_UPDATE_FULL), + assume_rule(`ra_valid (R:(A)ra) (b:A)`)); + thm singleton = eq_mp_rule( + sym_rule(ispecl_rule( + TERM_LIST( + `frac_ra (R:(A)ra)`, + `frac_full (a:A)`, + `frac_full (b:A)`), + RA_UPDATE_ND_SINGLETON)), + deterministic); + + term singleton_pred = ` + \x:(A)frac. x == frac_full (b:A) + `; + term image_pred = ` + \x:(A)frac. + exists c:A. + (P:A->bool) c && + x == frac_full c + `; + thm monotone = ispecl_rule( + TERM_LIST( + `frac_ra (R:(A)ra)`, + `frac_full (a:A)`, + singleton_pred, + image_pred), + RA_UPDATE_ND_MONO); + monotone = mp_rule(monotone, singleton); + monotone = conv_rule( + depth_conv(get_conversion_by_name("BETA_CONV")), + monotone); + + term source_eq = ` + (x:(A)frac) == frac_full (b:A) + `; + term image_at_x = ` + exists c:A. + (P:A->bool) c && + (x:(A)frac) == frac_full c + `; + thm exact_image = exists_rule( + image_at_x, + `b:A`, + conj_rule( + assume_rule(`(P:A->bool) (b:A)`), + assume_rule(source_eq))); + exact_image = disch_rule(source_eq, exact_image); + exact_image = gen_rule( + `x:(A)frac`, + exact_image); + + ACCEPT_TAC( + body, + mp_rule(monotone, exact_image)); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_UPDATE_FULL_ND = + prove_frac_ra_update_full_nd(); + +PROOF static int audit_frac_ra(void) { + thm_list audited_theorems = THM_LIST( + FRAC_WEIGHT_REP_EXISTS, + FRAC_WEIGHT_TYPE_BIJECTION, + frac_weight_value_def, + frac_weight_of_real_def, + frac_weight_add_def, + FRAC_WEIGHT_VALUE_POS, + FRAC_WEIGHT_OF_REAL_VALUE, + FRAC_WEIGHT_ADD_VALUE, + FRAC_WEIGHT_EQ, + FRAC_WEIGHT_ADD_ASSOC, + FRAC_WEIGHT_ADD_COMM, + FRAC_WEIGHT_ADD_LE_LEFT, + frac_type.ind, + frac_type.rec, + frac_token_op_def, + frac_op_def, + frac_valid_def, + FRAC_OP_ASSOC, + FRAC_OP_COMM, + FRAC_OP_UNIT_L, + FRAC_VALID_UNIT, + FRAC_VALID_OP_L, + FRAC_RA_LAWS, + frac_ra_def, + FRAC_RA_UNIT_RAW, + FRAC_RA_OP_FN, + FRAC_RA_VALID_FN, + frac_empty_def, + frac_own_def, + frac_full_def, + FRAC_RA_UNIT, + FRAC_RA_FULL, + FRAC_RA_OWN_OP, + FRAC_RA_VALID_EMPTY, + FRAC_RA_VALID_OWN, + FRAC_RA_VALID_FULL, + FRAC_RA_CANCELLATIVE, + FRAC_RA_UPDATE_WEAKEN, + FRAC_RA_UPDATE_WEAKEN_ND, + FRAC_RA_UPDATE_FULL, + FRAC_RA_UPDATE_FULL_ND); + + for (size_t i = 0; + i < vector_size(audited_theorems); + ++i) { + ENSURE_COND( + !IS_NULL(audited_theorems[i]), + "fractional RA theorem %zu is empty", + i); + ENSURE_COND( + vector_size(hyp(audited_theorems[i])) == 0, + "fractional RA theorem %zu has hypotheses", + i); + } + ENSURE_COND( + vector_size(get_all_axioms()) == + FRAC_RA_AXIOMS_BEFORE, + "fractional RA introduced an axiom"); + ENSURE_COND( + get_tyconst_arity("frac_weight") == 0, + "frac_weight is not a monomorphic HOL type"); + ENSURE_COND( + get_tyconst_arity("frac") == 1, + "frac is not a unary HOL type constructor"); + return 0; +err: + ERR_FUN_PUTS("audit_frac_ra"); + return -1; +} + +PROOF static int _FRAC_RA_AUDIT = + audit_frac_ra(); diff --git a/theory/logic/frac_ra.h b/theory/logic/frac_ra.h new file mode 100644 index 0000000..85ba8d9 --- /dev/null +++ b/theory/logic/frac_ra.h @@ -0,0 +1,176 @@ +#pragma once + +/* + * Positive fractional ownership over a base resource algebra. + * + * `frac_ra R : ((A)frac)ra` has carrier `(A)frac`, unit `frac_empty`, and + * positive-weight owned tokens. Two owned tokens compose by adding weights + * and composing payloads in `R`; a positive token `(p,a)` is valid exactly + * when `p <= &1` and `a` is valid in `R`. The public smart constructors are: + * + * frac_empty : (A)frac + * frac_own : real -> A -> (A)frac + * frac_full : A -> (A)frac + * + * `frac_own p a` is intended for `&0 < p`; every computation rule involving + * this constructor carries that premise explicitly. `frac_full a` is the + * canonical weight-one token. The positive-real subtype, datatype + * constructors, raw operation/validity functions, RA law proof, and + * abstraction projections are private to `frac_ra.c`. + */ + +#include "proof/theory/logic/ra.h" + +/* ------------------------------------------------------------------------- */ +/* Core representation and constructors */ +/* ------------------------------------------------------------------------- */ + +/* + * `forall R:(A)ra. + * ra_unit (frac_ra R) == (frac_empty:(A)frac)` + */ +PROOF extern thm FRAC_RA_UNIT; + +/* + * Full ownership is the canonical weight-one token: + * + * `forall a:A. + * frac_full a == frac_own (&1) a` + */ +PROOF extern thm FRAC_RA_FULL; + +/* + * Positive owned tokens compose by adding weights and composing payloads: + * + * `forall (R:(A)ra) (p q:real) (a b:A). + * &0 < p ==> + * &0 < q ==> + * ra_op (frac_ra R) (frac_own p a) (frac_own q b) == + * frac_own (p + q) (ra_op R a b)` + */ +PROOF extern thm FRAC_RA_OWN_OP; + +/* ------------------------------------------------------------------------- */ +/* Validity */ +/* ------------------------------------------------------------------------- */ + +/* + * `forall R:(A)ra. + * ra_valid (frac_ra R) (frac_empty:(A)frac)` + */ +PROOF extern thm FRAC_RA_VALID_EMPTY; + +/* + * A positive owned token is valid exactly when its weight is at most one and + * its base payload is valid: + * + * `forall (R:(A)ra) (p:real) (a:A). + * &0 < p ==> + * (ra_valid (frac_ra R) (frac_own p a) <=> + * p <= &1 && ra_valid R a)` + */ +PROOF extern thm FRAC_RA_VALID_OWN; + +/* + * Full-token validity: + * + * `forall (R:(A)ra) (a:A). + * ra_valid (frac_ra R) (frac_full a) <=> + * ra_valid R a` + */ +PROOF extern thm FRAC_RA_VALID_FULL; + +/* ------------------------------------------------------------------------- */ +/* Laws: optional algebraic properties */ +/* ------------------------------------------------------------------------- */ + +/* + * Fractional ownership preserves cancellativity of the base RA: + * + * `forall R:(A)ra. + * ra_cancellative R ==> + * ra_cancellative (frac_ra R)` + * + * Positivity of every owned weight excludes cancellation between an empty + * and an owned target. When both targets are owned, equality of the composed + * weights cancels their common frame weight, and base cancellativity cancels + * the common payload frame. + */ +PROOF extern thm FRAC_RA_CANCELLATIVE; + +/* ------------------------------------------------------------------------- */ +/* Updates: weight weakening and lifted payload updates */ +/* ------------------------------------------------------------------------- */ + +/* + * A base frame-preserving update lifts through fractional ownership while + * the owned weight is weakened. The assumptions `&0 < q` and `q <= p` + * imply `&0 < p`, so no redundant positivity premise for `p` is needed: + * + * `forall (R:(A)ra) (p q:real) (a b:A). + * &0 < q ==> + * q <= p ==> + * ra_update R a b ==> + * ra_update + * (frac_ra R) + * (frac_own p a) + * (frac_own q b)` + * + * Every frame compatible with weight `p` remains compatible after replacing + * it by the no-larger weight `q`; the base update preserves the framed + * payload validity. + */ +PROOF extern thm FRAC_RA_UPDATE_WEAKEN; + +/* + * Exact-image nondeterministic weight weakening: + * + * `forall (R:(A)ra) (p q:real) (a:A) (P:A->bool). + * &0 < q ==> + * q <= p ==> + * ra_update_nd R a P ==> + * ra_update_nd + * (frac_ra R) + * (frac_own p a) + * (\x:(A)frac. + * exists b:A. + * P b && x == frac_own q b)` + * + * The selected base result may depend on the source-compatible frame, as + * allowed by `ra_update_nd`, but every exposed result has exactly weight `q` + * and a payload satisfying `P`. + */ +PROOF extern thm FRAC_RA_UPDATE_WEAKEN_ND; + +/* ------------------------------------------------------------------------- */ +/* Updates: full ownership */ +/* ------------------------------------------------------------------------- */ + +/* + * A full token has no compatible nonempty fractional frame. Consequently + * any valid payload is a frame-preserving deterministic target: + * + * `forall (R:(A)ra) (a b:A). + * ra_valid R b ==> + * ra_update + * (frac_ra R) + * (frac_full a) + * (frac_full b)` + */ +PROOF extern thm FRAC_RA_UPDATE_FULL; + +/* + * Exact-image nondeterministic full update: + * + * `forall (R:(A)ra) (a:A) (P:A->bool). + * (exists b:A. P b && ra_valid R b) ==> + * ra_update_nd + * (frac_ra R) + * (frac_full a) + * (\x:(A)frac. + * exists b:A. P b && x == frac_full b)` + * + * The result predicate admits precisely full tokens whose payload satisfies + * `P`; it does not admit arbitrary fractional resources. + */ +PROOF extern thm FRAC_RA_UPDATE_FULL_ND; diff --git a/theory/logic/gmap_ra.c b/theory/logic/gmap_ra.c new file mode 100644 index 0000000..63d96e1 --- /dev/null +++ b/theory/logic/gmap_ra.c @@ -0,0 +1,1058 @@ +#include "proof/theory/logic/gmap_ra.h" +#include "proof/theory/logic/ra_builder.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/finmap.c" +#require "proof/theory/logic/option_ra.c" +#require "proof/theory/logic/ra.c" + +PROOF static size_t GMAP_RA_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF static thm gmap_raw_op_def = new_fun_definition(` + gmap_raw_op + (R:(V)ra) + (f:K->V option) + (g:K->V option) + (k:K) : V option = + ra_op (option_ra R) (f k) (g k) +`); + +PROOF static thm prove_gmap_raw_op_support(void) { + term goal_tm = ` + forall (R:(V)ra) (f:K->V option) (g:K->V option). + {k | ~(gmap_raw_op R f g k == NONE)} == + {k | ~(f k == NONE)} UNION {k | ~(g k == NONE)} + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST( + get_theorem_by_name("EXTENSION")))); + body = GEN_TAC(body, "k"); + gnode_list f_cases = CASES_TAC( + body, `(f:K->V option) (k:K)`, NULL); + for (size_t i = 0; i < vector_size(f_cases); ++i) { + gnode_list g_cases = CASES_TAC( + f_cases[i], `(g:K->V option) (k:K)`, NULL); + for (size_t j = 0; j < vector_size(g_cases); ++j) { + CONV_WITH_ASMP_TAC( + g_cases[j], + rewrite_conv, + THM_LIST( + gmap_raw_op_def, + OPTION_RA_OP_NONE_L, + OPTION_RA_OP_NONE_R, + OPTION_RA_OP_SOME_SOME, + get_theorem_by_name("IN_ELIM_THM"), + get_theorem_by_name("IN_UNION"), + get_theorem_by_name("option_DISTINCT"))); + } + } + return gnode_prove(root); +} + +PROOF static thm GMAP_RAW_OP_SUPPORT = + prove_gmap_raw_op_support(); + +PROOF static thm prove_gmap_raw_op_finite(void) { + term goal_tm = ` + forall (R:(V)ra) (f:K->V option) (g:K->V option). + finmap_finite f ==> + finmap_finite g ==> + finmap_finite (gmap_raw_op R f g) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(finmap_finite_def))); + body = AUTO_INTROS_TAC(body); + + term f_support = `{k:K | ~((f:K->V option) k == NONE)}`; + term g_support = `{k:K | ~((g:K->V option) k == NONE)}`; + thm union_finite = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST(f_support, g_support), + get_theorem_by_name("FINITE_UNION"))), + conj_rule( + assume_rule(` + FINITE {k:K | ~((f:K->V option) k == NONE)} + `), + assume_rule(` + FINITE {k:K | ~((g:K->V option) k == NONE)} + `))); + thm support = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `f:K->V option`, + `g:K->V option`), + GMAP_RAW_OP_SUPPORT); + thm raw_finite = rewrite_rule( + THM_LIST(gsym_rule(support)), + union_finite); + ACCEPT_TAC(body, raw_finite); + return gnode_prove(root); +} + +PROOF static thm GMAP_RAW_OP_FINITE = + prove_gmap_raw_op_finite(); + +PROOF static thm gmap_op_def = new_fun_definition(` + gmap_op + (R:(V)ra) + (m:(K,V)finmap) + (n:(K,V)finmap) : (K,V)finmap = + finmap_abs + (gmap_raw_op R (finmap_rep m) (finmap_rep n)) +`); + +PROOF static thm prove_gmap_op_rep(void) { + term R = `R:(V)ra`; + term m = `m:(K,V)finmap`; + term n = `n:(K,V)finmap`; + term raw = ` + gmap_raw_op + (R:(V)ra) + (finmap_rep (m:(K,V)finmap)) + (finmap_rep (n:(K,V)finmap)) + `; + thm finite = ispecl_rule( + TERM_LIST( + R, + `finmap_rep (m:(K,V)finmap)`, + `finmap_rep (n:(K,V)finmap)`), + GMAP_RAW_OP_FINITE); + finite = mp_rule( + finite, + ispec_rule(m, FINMAP_REP_FINITE)); + finite = mp_rule( + finite, + ispec_rule(n, FINMAP_REP_FINITE)); + + thm inverse = ispec_rule( + raw, + conjunct2_rule(FINMAP_TYPE_BIJECTION)); + thm represented = eq_mp_rule(inverse, finite); + represented = pure_once_rewrite_rule( + THM_LIST(gsym_rule(gmap_op_def)), + represented); + represented = gen_rule(n, represented); + represented = gen_rule(m, represented); + return gen_rule(R, represented); +} + +PROOF static thm GMAP_OP_REP = + prove_gmap_op_rep(); + +PROOF static thm prove_gmap_op_lookup(void) { + term goal_tm = ` + forall + (R:(V)ra) + (m:(K,V)finmap) + (n:(K,V)finmap) + (k:K). + finmap_lookup (gmap_op R m n) k == + ra_op + (option_ra R) + (finmap_lookup m k) + (finmap_lookup n k) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + finmap_lookup_def, + GMAP_OP_REP, + gmap_raw_op_def))); + return gnode_prove(root); +} + +PROOF static thm GMAP_OP_LOOKUP = + prove_gmap_op_lookup(); + +PROOF static thm gmap_valid_def = new_fun_definition(` + gmap_valid + (R:(V)ra) + (m:(K,V)finmap) <=> + forall k:K. + ra_valid (option_ra R) (finmap_lookup m k) +`); + +PROOF static thm prove_gmap_op_assoc(void) { + term goal_tm = ` + forall + (R:(V)ra) + (m:(K,V)finmap) + (n:(K,V)finmap) + (p:(K,V)finmap). + gmap_op R (gmap_op R m n) p == + gmap_op R m (gmap_op R n p) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "k"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(GMAP_OP_LOOKUP))); + ACCEPT_TAC( + body, + ispecl_rule( + TERM_LIST( + `option_ra (R:(V)ra)`, + `finmap_lookup (m:(K,V)finmap) (k:K)`, + `finmap_lookup (n:(K,V)finmap) (k:K)`, + `finmap_lookup (p:(K,V)finmap) (k:K)`), + RA_ASSOC)); + return gnode_prove(root); +} + +PROOF static thm GMAP_OP_ASSOC = + prove_gmap_op_assoc(); + +PROOF static thm prove_gmap_op_comm(void) { + term goal_tm = ` + forall + (R:(V)ra) + (m:(K,V)finmap) + (n:(K,V)finmap). + gmap_op R m n == gmap_op R n m + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "k"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(GMAP_OP_LOOKUP))); + ACCEPT_TAC( + body, + ispecl_rule( + TERM_LIST( + `option_ra (R:(V)ra)`, + `finmap_lookup (m:(K,V)finmap) (k:K)`, + `finmap_lookup (n:(K,V)finmap) (k:K)`), + RA_COMM)); + return gnode_prove(root); +} + +PROOF static thm GMAP_OP_COMM = + prove_gmap_op_comm(); + +PROOF static thm prove_gmap_op_unit_l(void) { + term goal_tm = ` + forall (R:(V)ra) (m:(K,V)finmap). + gmap_op R finmap_empty m == m + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "k"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST( + GMAP_OP_LOOKUP, + FINMAP_EMPTY_LOOKUP))); + thm unit = ispecl_rule( + TERM_LIST( + `option_ra (R:(V)ra)`, + `finmap_lookup (m:(K,V)finmap) (k:K)`), + RA_UNIT_L); + unit = rewrite_rule( + THM_LIST(OPTION_RA_UNIT), + unit); + ACCEPT_TAC(body, unit); + return gnode_prove(root); +} + +PROOF static thm GMAP_OP_UNIT_L = + prove_gmap_op_unit_l(); + +PROOF static thm prove_gmap_valid_empty(void) { + term goal_tm = ` + forall R:(V)ra. + gmap_valid R (finmap_empty:(K,V)finmap) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(gmap_valid_def))); + body = GEN_TAC(body, "k"); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + FINMAP_EMPTY_LOOKUP, + OPTION_RA_VALID_NONE))); + return gnode_prove(root); +} + +PROOF static thm GMAP_VALID_EMPTY = + prove_gmap_valid_empty(); + +PROOF static thm prove_gmap_valid_op_l(void) { + term goal_tm = ` + forall + (R:(V)ra) + (m:(K,V)finmap) + (n:(K,V)finmap). + gmap_valid R (gmap_op R m n) ==> + gmap_valid R m + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(gmap_valid_def))); + body = AUTO_INTROS_TAC(body); + + thm source_valid = spec_rule( + `k:K`, + assume_rule(` + forall k:K. + ra_valid + (option_ra (R:(V)ra)) + (finmap_lookup + (gmap_op R + (m:(K,V)finmap) + (n:(K,V)finmap)) + k) + `)); + source_valid = rewrite_rule( + THM_LIST(GMAP_OP_LOOKUP), + source_valid); + thm left_valid = mp_rule( + ispecl_rule( + TERM_LIST( + `option_ra (R:(V)ra)`, + `finmap_lookup (m:(K,V)finmap) (k:K)`, + `finmap_lookup (n:(K,V)finmap) (k:K)`), + RA_VALID_OP_L), + source_valid); + ACCEPT_TAC(body, left_valid); + return gnode_prove(root); +} + +PROOF static thm GMAP_VALID_OP_L = + prove_gmap_valid_op_l(); + +PROOF static thm prove_gmap_ra_laws(void) { + term goal_tm = ` + forall R:(V)ra. + ra_laws + (finmap_empty:(K,V)finmap) + (gmap_op R) + (gmap_valid R) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + gnode unfolded = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_laws_def))); + + gnode_list law1 = CONJ_TAC(unfolded); + ACCEPT_TAC( + law1[0], + spec_rule(`R:(V)ra`, GMAP_OP_ASSOC)); + + gnode_list law2 = CONJ_TAC(law1[1]); + ACCEPT_TAC( + law2[0], + spec_rule(`R:(V)ra`, GMAP_OP_COMM)); + + gnode_list law3 = CONJ_TAC(law2[1]); + ACCEPT_TAC( + law3[0], + spec_rule(`R:(V)ra`, GMAP_OP_UNIT_L)); + + gnode_list law4 = CONJ_TAC(law3[1]); + ACCEPT_TAC( + law4[0], + spec_rule(`R:(V)ra`, GMAP_VALID_EMPTY)); + ACCEPT_TAC( + law4[1], + spec_rule(`R:(V)ra`, GMAP_VALID_OP_L)); + return gnode_prove(root); +} + +PROOF static thm GMAP_RA_LAWS = + prove_gmap_ra_laws(); + +PROOF static thm gmap_ra_def = new_fun_definition(` + gmap_ra (R:(V)ra) : ((K,V)finmap)ra = + ra_abs + ((finmap_empty:(K,V)finmap), + ((gmap_op R: + (K,V)finmap->(K,V)finmap->(K,V)finmap), + (gmap_valid R:(K,V)finmap->bool))) +`); + +PROOF static thm prove_gmap_ra_unit(void) { + term R = `R:(V)ra`; + term empty = `finmap_empty:(K,V)finmap`; + term op = ` + gmap_op (R:(V)ra): + (K,V)finmap->(K,V)finmap->(K,V)finmap + `; + term valid = ` + gmap_valid (R:(V)ra):(K,V)finmap->bool + `; + thm laws = ispec_rule(R, GMAP_RA_LAWS); + thm computed = mp_rule( + ispecl_rule( + TERM_LIST(empty, op, valid), + RA_UNIT_ABS), + laws); + computed = pure_once_rewrite_rule( + THM_LIST(gsym_rule(gmap_ra_def)), + computed); + return gen_rule(R, computed); +} + +PROOF thm GMAP_RA_UNIT = + prove_gmap_ra_unit(); + +PROOF static thm prove_gmap_ra_op_fn(void) { + term R = `R:(V)ra`; + term empty = `finmap_empty:(K,V)finmap`; + term op = ` + gmap_op (R:(V)ra): + (K,V)finmap->(K,V)finmap->(K,V)finmap + `; + term valid = ` + gmap_valid (R:(V)ra):(K,V)finmap->bool + `; + thm laws = ispec_rule(R, GMAP_RA_LAWS); + thm computed = mp_rule( + ispecl_rule( + TERM_LIST(empty, op, valid), + RA_OP_ABS), + laws); + computed = pure_once_rewrite_rule( + THM_LIST(gsym_rule(gmap_ra_def)), + computed); + return gen_rule(R, computed); +} + +PROOF static thm GMAP_RA_OP_FN = + prove_gmap_ra_op_fn(); + +PROOF static thm prove_gmap_ra_valid_fn(void) { + term R = `R:(V)ra`; + term empty = `finmap_empty:(K,V)finmap`; + term op = ` + gmap_op (R:(V)ra): + (K,V)finmap->(K,V)finmap->(K,V)finmap + `; + term valid = ` + gmap_valid (R:(V)ra):(K,V)finmap->bool + `; + thm laws = ispec_rule(R, GMAP_RA_LAWS); + thm computed = mp_rule( + ispecl_rule( + TERM_LIST(empty, op, valid), + RA_VALID_ABS), + laws); + computed = pure_once_rewrite_rule( + THM_LIST(gsym_rule(gmap_ra_def)), + computed); + return gen_rule(R, computed); +} + +PROOF static thm GMAP_RA_VALID_FN = + prove_gmap_ra_valid_fn(); + +PROOF static thm prove_gmap_ra_op_lookup(void) { + term goal_tm = ` + forall + (R:(V)ra) + (m:(K,V)finmap) + (n:(K,V)finmap) + (k:K). + finmap_lookup (ra_op (gmap_ra R) m n) k == + ra_op + (option_ra R) + (finmap_lookup m k) + (finmap_lookup n k) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + GMAP_RA_OP_FN, + GMAP_OP_LOOKUP))); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_OP_LOOKUP = + prove_gmap_ra_op_lookup(); + +PROOF static thm prove_gmap_ra_valid(void) { + term goal_tm = ` + forall + (R:(V)ra) + (m:(K,V)finmap). + ra_valid (gmap_ra R) m <=> + forall k:K. + ra_valid + (option_ra R) + (finmap_lookup m k) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + GMAP_RA_VALID_FN, + gmap_valid_def))); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_VALID = + prove_gmap_ra_valid(); + +/* + * Two singletons at the same key compose to the singleton of the base + * composition. Map extensionality reduces the proof to the selected key and + * every other key, where the option operation computes directly. + */ +PROOF static thm prove_gmap_ra_singleton_op(void) { + term goal_tm = ` + forall (R:(V)ra) (key:K) (a:V) (b:V). + ra_op + (gmap_ra R) + (finmap_singleton key a) + (finmap_singleton key b) == + finmap_singleton key (ra_op R a b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "query"); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, "Hkey"); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST( + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_OP_NONE_L, + OPTION_RA_OP_SOME_SOME)); + } + return gnode_prove(root); +} + +PROOF thm GMAP_RA_SINGLETON_OP = + prove_gmap_ra_singleton_op(); + +/* + * Pointwise validity of a singleton has one nontrivial point. The selected + * key reduces to SOME payload validity and all other keys reduce to NONE. + */ +PROOF static thm prove_gmap_ra_valid_singleton(void) { + term goal_tm = ` + forall (R:(V)ra) (key:K) (a:V). + ra_valid (gmap_ra R) (finmap_singleton key a) <=> + ra_valid R a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(GMAP_RA_VALID))); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hall"); + thm at_key = spec_rule( + `key:K`, + assume_rule(` + forall query:K. + ra_valid + (option_ra (R:(V)ra)) + (finmap_lookup + (finmap_singleton (key:K) (a:V)) + query) + `)); + at_key = rewrite_rule( + THM_LIST( + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_VALID_SOME), + at_key); + ACCEPT_TAC(forward, at_key); + + gnode reverse = DISCH_TAC(directions[1], "Ha"); + reverse = GEN_TAC(reverse, "query"); + gnode_list cases = BOOL_CASES_TAC( + reverse, `(query:K) == (key:K)`, "Hkey"); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST( + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_VALID_NONE, + OPTION_RA_VALID_SOME)); + } + return gnode_prove(root); +} + +PROOF thm GMAP_RA_VALID_SINGLETON = + prove_gmap_ra_valid_singleton(); + +/* ------------------------------------------------------------------------- */ +/* Inclusion */ +/* ------------------------------------------------------------------------- */ + +/* A finite-map extension supplies one option-RA extension at every key. The + * pointwise witness is the corresponding lookup in the finite-map frame. */ +PROOF static thm prove_gmap_ra_included_lookup(void) { + term goal_tm = ` + forall + (R:(V)ra) + (m:(K,V)finmap) + (n:(K,V)finmap). + ra_included (gmap_ra R) m n ==> + forall k:K. + ra_included + (option_ra R) + (finmap_lookup m k) + (finmap_lookup n k) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "m"); + body = GEN_TAC(body, "n"); + body = DISCH_TAC(body, "Hincluded"); + body = GEN_TAC(body, "k"); + + thm included = pure_once_rewrite_rule( + THM_LIST(ra_included_def), + assume_rule(` + ra_included + (gmap_ra (R:(V)ra)) + (m:(K,V)finmap) + (n:(K,V)finmap) + `)); + body = ASSUME_TAC(body, included, "Hextension"); + body = ASMP_EXISTS_TAC( + body, "Hextension", "frame"); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_included_def))); + body = EXISTS_TAC( + body, + `finmap_lookup (frame:(K,V)finmap) (k:K)`); + + thm extension_at = ap_term_rule( + `\map:(K,V)finmap. finmap_lookup map (k:K)`, + assume_rule(` + (n:(K,V)finmap) == + ra_op + (gmap_ra (R:(V)ra)) + (m:(K,V)finmap) + (frame:(K,V)finmap) + `)); + extension_at = rewrite_rule( + THM_LIST(GMAP_RA_OP_LOOKUP), + extension_at); + ACCEPT_TAC(body, extension_at); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_INCLUDED_LOOKUP = + prove_gmap_ra_included_lookup(); + +/* At a fixed singleton key, finite-map inclusion is exactly payload + * inclusion. The forward direction selects the pointwise option inclusion; + * the reverse direction lifts a base frame to a singleton-map frame. */ +PROOF static thm prove_gmap_ra_included_singleton(void) { + term goal_tm = ` + forall (R:(V)ra) (key:K) (a:V) (b:V). + ra_included + (gmap_ra R) + (finmap_singleton key a) + (finmap_singleton key b) <=> + ra_included R a b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC( + directions[0], "Hgmap_included"); + thm pointwise = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `finmap_singleton (key:K) (a:V)`, + `finmap_singleton (key:K) (b:V)`), + GMAP_RA_INCLUDED_LOOKUP), + assume_rule(` + ra_included + (gmap_ra (R:(V)ra)) + (finmap_singleton (key:K) (a:V)) + (finmap_singleton (key:K) (b:V)) + `)); + thm at_key = spec_rule(`key:K`, pointwise); + at_key = rewrite_rule( + THM_LIST( + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_INCLUDED_SOME_SOME), + at_key); + ACCEPT_TAC(forward, at_key); + + gnode reverse = DISCH_TAC( + directions[1], "Hbase_included"); + thm base_included = pure_once_rewrite_rule( + THM_LIST(ra_included_def), + assume_rule(`ra_included (R:(V)ra) (a:V) (b:V)`)); + reverse = ASSUME_TAC( + reverse, base_included, "Hbase_extension"); + reverse = ASMP_EXISTS_TAC( + reverse, "Hbase_extension", "base_frame"); + reverse = CONV_TAC( + reverse, + once_rewrite_conv(THM_LIST(ra_included_def))); + reverse = EXISTS_TAC( + reverse, + `finmap_singleton (key:K) (base_frame:V)`); + + thm lifted_extension = beta_rule(ap_term_rule( + `\x:V. finmap_singleton (key:K) x`, + assume_rule(` + (b:V) == + ra_op (R:(V)ra) (a:V) (base_frame:V) + `))); + thm singleton_composition = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `base_frame:V`), + GMAP_RA_SINGLETON_OP); + ACCEPT_TAC( + reverse, + trans_rule( + lifted_extension, + gsym_rule(singleton_composition))); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_INCLUDED_SINGLETON = + prove_gmap_ra_included_singleton(); + +/* + * Lift a deterministic base update through SOME at the selected key. At all + * other keys both source and target singletons contribute NONE, so the source + * pointwise validity is reused unchanged. + */ +PROOF static thm prove_gmap_ra_update_singleton(void) { + term goal_tm = ` + forall (R:(V)ra) (key:K) (a:V) (b:V). + ra_update R a b ==> + ra_update + (gmap_ra R) + (finmap_singleton key a) + (finmap_singleton key b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_def))); + body = AUTO_INTROS_TAC(body); + + thm source_valid_rule = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `ra_op + (gmap_ra (R:(V)ra)) + (finmap_singleton (key:K) (a:V)) + (frame:(K,V)finmap)`), + GMAP_RA_VALID); + thm source_all = eq_mp_rule( + source_valid_rule, + assume_rule(` + ra_valid + (gmap_ra (R:(V)ra)) + (ra_op + (gmap_ra R) + (finmap_singleton (key:K) (a:V)) + (frame:(K,V)finmap)) + `)); + + thm option_update = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `a:V`, + `b:V`), + OPTION_RA_UPDATE), + assume_rule(`ra_update (R:(V)ra) (a:V) (b:V)`)); + option_update = pure_once_rewrite_rule( + THM_LIST(ra_update_def), + option_update); + + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(GMAP_RA_VALID))); + body = GEN_TAC(body, "query"); + thm source_at = spec_rule(`query:K`, source_all); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, "Hkey"); + for (size_t i = 0; i < vector_size(cases); ++i) { + thm branch = i == 0 + ? assume_rule(`query:K == key`) + : assume_rule(`~(query:K == key)`); + thm normalized_source = rewrite_rule( + THM_LIST( + branch, + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_OP_NONE_L), + source_at); + gnode reduced_goal = CONV_TAC( + cases[i], + rewrite_conv(THM_LIST( + branch, + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_OP_NONE_L))); + if (i == 0) { + thm updated = mp_rule( + spec_rule( + `finmap_lookup + (frame:(K,V)finmap) + (key:K)`, + option_update), + normalized_source); + ACCEPT_TAC(reduced_goal, updated); + } else { + ACCEPT_TAC(reduced_goal, normalized_source); + } + } + return gnode_prove(root); +} + +PROOF thm GMAP_RA_UPDATE_SINGLETON = + prove_gmap_ra_update_singleton(); + +/* + * The nondeterministic lift selects an exact SOME payload at the chosen key + * using OPTION_RA_UPDATE_ND, then packages that payload as an exact singleton + * map. Other keys again retain the source frame validity unchanged. + */ +PROOF static thm prove_gmap_ra_update_singleton_nd(void) { + term goal_tm = ` + forall (R:(V)ra) (key:K) (a:V) (P:V->bool). + ra_update_nd R a P ==> + ra_update_nd + (gmap_ra R) + (finmap_singleton key a) + (\m:(K,V)finmap. + exists b:V. + P b && m == finmap_singleton key b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = AUTO_INTROS_TAC(body); + + thm source_valid_rule = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `ra_op + (gmap_ra (R:(V)ra)) + (finmap_singleton (key:K) (a:V)) + (frame:(K,V)finmap)`), + GMAP_RA_VALID); + thm source_all = eq_mp_rule( + source_valid_rule, + assume_rule(` + ra_valid + (gmap_ra (R:(V)ra)) + (ra_op + (gmap_ra R) + (finmap_singleton (key:K) (a:V)) + (frame:(K,V)finmap)) + `)); + thm source_key = spec_rule(`key:K`, source_all); + source_key = rewrite_rule( + THM_LIST( + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP), + source_key); + + thm option_update = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `a:V`, + `P:V->bool`), + OPTION_RA_UPDATE_ND), + assume_rule(` + ra_update_nd (R:(V)ra) (a:V) (P:V->bool) + `)); + option_update = pure_once_rewrite_rule( + THM_LIST(ra_update_nd_def), + option_update); + option_update = beta_rule(option_update); + thm selected = mp_rule( + spec_rule( + `finmap_lookup + (frame:(K,V)finmap) + (key:K)`, + option_update), + source_key); + + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC( + body, "Hselected", "selected_option"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "Hselected_image", + "Hselected_valid"); + body = ASMP_EXISTS_TAC( + body, "Hselected_image", "b"); + body = ASMP_CONJ_TAC( + body, + "Hselected_image", + "HP_b", + "Hselected_some"); + thm selected_key_valid = rewrite_rule( + THM_LIST(assume_rule(` + (selected_option:V option) == SOME (b:V) + `)), + assume_rule(` + ra_valid + (option_ra (R:(V)ra)) + (ra_op + (option_ra R) + (selected_option:V option) + (finmap_lookup + (frame:(K,V)finmap) + (key:K))) + `)); + body = ASSUME_TAC( + body, selected_key_valid, "Hb_key_valid"); + + body = EXISTS_TAC( + body, + `finmap_singleton (key:K) (b:V)`); + gnode_list result_parts = CONJ_TAC(body); + gnode predicate = EXISTS_TAC(result_parts[0], `b:V`); + gnode_list predicate_parts = CONJ_TAC(predicate); + ACCEPT_TAC( + predicate_parts[0], + assume_rule(`(P:V->bool) (b:V)`)); + ACCEPT_TAC( + predicate_parts[1], + refl_rule(`finmap_singleton (key:K) (b:V)`)); + + gnode validity = CONV_TAC( + result_parts[1], + once_rewrite_conv(THM_LIST(GMAP_RA_VALID))); + validity = GEN_TAC(validity, "query"); + thm source_at = spec_rule(`query:K`, source_all); + gnode_list cases = BOOL_CASES_TAC( + validity, `(query:K) == (key:K)`, "Hkey"); + for (size_t i = 0; i < vector_size(cases); ++i) { + thm branch = i == 0 + ? assume_rule(`query:K == key`) + : assume_rule(`~(query:K == key)`); + gnode reduced_goal = CONV_TAC( + cases[i], + rewrite_conv(THM_LIST( + branch, + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_OP_NONE_L))); + if (i == 0) { + ACCEPT_TAC( + reduced_goal, + assume_rule(` + ra_valid + (option_ra (R:(V)ra)) + (ra_op + (option_ra R) + (SOME (b:V)) + (finmap_lookup + (frame:(K,V)finmap) + (key:K))) + `)); + } else { + thm normalized_source = rewrite_rule( + THM_LIST( + branch, + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_OP_NONE_L), + source_at); + ACCEPT_TAC(reduced_goal, normalized_source); + } + } + return gnode_prove(root); +} + +PROOF thm GMAP_RA_UPDATE_SINGLETON_ND = + prove_gmap_ra_update_singleton_nd(); + +PROOF static int audit_gmap_ra(void) { + thm_list audited_theorems = THM_LIST( + gmap_raw_op_def, + GMAP_RAW_OP_SUPPORT, + GMAP_RAW_OP_FINITE, + gmap_op_def, + GMAP_OP_REP, + GMAP_OP_LOOKUP, + gmap_valid_def, + GMAP_OP_ASSOC, + GMAP_OP_COMM, + GMAP_OP_UNIT_L, + GMAP_VALID_EMPTY, + GMAP_VALID_OP_L, + GMAP_RA_LAWS, + gmap_ra_def, + GMAP_RA_UNIT, + GMAP_RA_OP_FN, + GMAP_RA_VALID_FN, + GMAP_RA_OP_LOOKUP, + GMAP_RA_VALID, + GMAP_RA_SINGLETON_OP, + GMAP_RA_VALID_SINGLETON, + GMAP_RA_INCLUDED_LOOKUP, + GMAP_RA_INCLUDED_SINGLETON, + GMAP_RA_UPDATE_SINGLETON, + GMAP_RA_UPDATE_SINGLETON_ND); + + for (size_t i = 0; i < vector_size(audited_theorems); ++i) { + ENSURE_COND(!IS_NULL(audited_theorems[i]), + "gmap RA theorem %zu is empty", i); + ENSURE_COND(vector_size(hyp(audited_theorems[i])) == 0, + "gmap RA theorem %zu has hypotheses", i); + } + ENSURE_COND(vector_size(get_all_axioms()) == GMAP_RA_AXIOMS_BEFORE, + "gmap RA introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_gmap_ra"); + return -1; +} + +PROOF static int _GMAP_RA_AUDIT = audit_gmap_ra(); diff --git a/theory/logic/gmap_ra.h b/theory/logic/gmap_ra.h new file mode 100644 index 0000000..397e0a9 --- /dev/null +++ b/theory/logic/gmap_ra.h @@ -0,0 +1,145 @@ +#pragma once + +/* + * `gmap_ra R:((K,V)finmap)ra` lifts `R:(V)ra` pointwise to finite maps. + * Its carrier is `(K,V)finmap`, unit is `finmap_empty`, operation is + * pointwise composition in `option_ra R`, and a map is valid exactly when + * every optional lookup is valid. + * + * This client interface hides the raw finite-support construction and all + * `ra_abs` projection equations. + */ + +#include "proof/theory/logic/finmap.h" +#include "proof/theory/logic/option_ra.h" + +/* ------------------------------------------------------------------------- */ +/* Core representation */ +/* ------------------------------------------------------------------------- */ + +/* + * `forall R:(V)ra. + * ra_unit (gmap_ra R) == (finmap_empty:(K,V)finmap)` + */ +PROOF extern thm GMAP_RA_UNIT; + +/* + * `forall + * (R:(V)ra) + * (m:(K,V)finmap) + * (n:(K,V)finmap) + * (k:K). + * finmap_lookup (ra_op (gmap_ra R) m n) k == + * ra_op + * (option_ra R) + * (finmap_lookup m k) + * (finmap_lookup n k)` + */ +PROOF extern thm GMAP_RA_OP_LOOKUP; + +/* + * Singleton composition at the same key: + * + * forall (R:(V)ra) (key:K) (a:V) (b:V). + * ra_op + * (gmap_ra R) + * (finmap_singleton key a) + * (finmap_singleton key b) == + * finmap_singleton key (ra_op R a b) + */ +PROOF extern thm GMAP_RA_SINGLETON_OP; + +/* ------------------------------------------------------------------------- */ +/* Validity */ +/* ------------------------------------------------------------------------- */ + +/* + * `forall (R:(V)ra) (m:(K,V)finmap). + * ra_valid (gmap_ra R) m <=> + * forall k:K. + * ra_valid (option_ra R) (finmap_lookup m k)` + */ +PROOF extern thm GMAP_RA_VALID; + +/* + * Singleton validity is exactly payload validity: + * + * forall (R:(V)ra) (key:K) (a:V). + * ra_valid (gmap_ra R) (finmap_singleton key a) <=> + * ra_valid R a + */ +PROOF extern thm GMAP_RA_VALID_SINGLETON; + +/* ------------------------------------------------------------------------- */ +/* Order */ +/* ------------------------------------------------------------------------- */ + +/* + * Finite-map inclusion implies pointwise option-RA inclusion: + * + * forall + * (R:(V)ra) + * (m:(K,V)finmap) + * (n:(K,V)finmap). + * ra_included (gmap_ra R) m n ==> + * forall k:K. + * ra_included + * (option_ra R) + * (finmap_lookup m k) + * (finmap_lookup n k) + * + * This is the sound direction available without constructing a finite map of + * pointwise witnesses. + */ +PROOF extern thm GMAP_RA_INCLUDED_LOOKUP; + +/* + * Inclusion between singleton maps at the same key is exactly base inclusion: + * + * forall (R:(V)ra) (key:K) (a:V) (b:V). + * ra_included + * (gmap_ra R) + * (finmap_singleton key a) + * (finmap_singleton key b) <=> + * ra_included R a b + */ +PROOF extern thm GMAP_RA_INCLUDED_SINGLETON; + +/* ------------------------------------------------------------------------- */ +/* Laws */ +/* ------------------------------------------------------------------------- */ + +/* Generic reflexivity, transitivity, and validity descent come from `ra.h`. */ + +/* ------------------------------------------------------------------------- */ +/* Updates */ +/* ------------------------------------------------------------------------- */ + +/* + * A deterministic payload update lifts at a fixed singleton key: + * + * forall (R:(V)ra) (key:K) (a:V) (b:V). + * ra_update R a b ==> + * ra_update + * (gmap_ra R) + * (finmap_singleton key a) + * (finmap_singleton key b) + */ +PROOF extern thm GMAP_RA_UPDATE_SINGLETON; + +/* + * A nondeterministic payload update lifts to the exact singleton-map image: + * + * forall (R:(V)ra) (key:K) (a:V) (P:V->bool). + * ra_update_nd R a P ==> + * ra_update_nd + * (gmap_ra R) + * (finmap_singleton key a) + * (\m:(K,V)finmap. + * exists b:V. + * P b && m == finmap_singleton key b) + * + * The selected payload may depend on the ambient map frame, while every + * result map has exactly the original singleton support. + */ +PROOF extern thm GMAP_RA_UPDATE_SINGLETON_ND; diff --git a/theory/logic/max_nat_ra.c b/theory/logic/max_nat_ra.c new file mode 100644 index 0000000..2985a66 --- /dev/null +++ b/theory/logic/max_nat_ra.c @@ -0,0 +1,631 @@ +#include "proof/theory/logic/max_nat_ra.h" +#include "proof/theory/logic/ra_builder.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/ra.c" + +PROOF static size_t MAX_NAT_RA_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +/* ------------------------------------------------------------------------- */ +/* Natural-number maximum facts used by the raw descriptor */ +/* ------------------------------------------------------------------------- */ + +/* + * HOL Light exposes `MAX` by its conditional definition but does not register + * the usual natural-number semilattice equations as separate named theorems. + * We obtain them predictably from the corresponding integer maximum laws and + * the injective natural-to-integer embedding. + */ +PROOF static thm prove_max_nat_assoc_raw(void) { + term a = `a:num`; + term b = `b:num`; + term c = `c:num`; + thm integer_assoc = ispecl_rule( + TERM_LIST(`&(a:num):int`, `&(b:num):int`, `&(c:num):int`), + get_theorem_by_name("INT_MAX_ASSOC")); + thm natural_assoc = rewrite_rule( + THM_LIST( + get_theorem_by_name("INT_OF_NUM_MAX"), + get_theorem_by_name("INT_OF_NUM_EQ")), + integer_assoc); + natural_assoc = gsym_rule(natural_assoc); + natural_assoc = gen_rule(c, natural_assoc); + natural_assoc = gen_rule(b, natural_assoc); + return gen_rule(a, natural_assoc); +} + +PROOF static thm MAX_NAT_ASSOC_RAW = + prove_max_nat_assoc_raw(); + +PROOF static thm prove_max_nat_comm_raw(void) { + term a = `a:num`; + term b = `b:num`; + thm integer_comm = ispecl_rule( + TERM_LIST(`&(a:num):int`, `&(b:num):int`), + get_theorem_by_name("INT_MAX_SYM")); + thm natural_comm = rewrite_rule( + THM_LIST( + get_theorem_by_name("INT_OF_NUM_MAX"), + get_theorem_by_name("INT_OF_NUM_EQ")), + integer_comm); + natural_comm = gen_rule(b, natural_comm); + return gen_rule(a, natural_comm); +} + +PROOF static thm MAX_NAT_COMM_RAW = + prove_max_nat_comm_raw(); + +PROOF static thm prove_max_nat_zero_left_raw(void) { + term n = `n:num`; + thm unfolded = ispecl_rule( + TERM_LIST(`0`, n), + get_theorem_by_name("MAX")); + thm reduced = rewrite_rule( + THM_LIST(spec_rule(n, get_theorem_by_name("LE_0"))), + unfolded); + return gen_rule(n, reduced); +} + +PROOF static thm MAX_NAT_ZERO_LEFT_RAW = + prove_max_nat_zero_left_raw(); + +PROOF static thm prove_max_nat_le_left_raw(void) { + term a = `a:num`; + term b = `b:num`; + thm integer_bounds = ispecl_rule( + TERM_LIST(`&(a:num):int`, `&(b:num):int`), + get_theorem_by_name("INT_MAX_MAX")); + thm natural_bounds = rewrite_rule( + THM_LIST( + get_theorem_by_name("INT_OF_NUM_MAX"), + get_theorem_by_name("INT_OF_NUM_LE")), + integer_bounds); + thm result = conjunct1_rule(natural_bounds); + result = gen_rule(b, result); + return gen_rule(a, result); +} + +PROOF static thm MAX_NAT_LE_LEFT_RAW = + prove_max_nat_le_left_raw(); + +PROOF static thm prove_max_nat_le_raw(void) { + term a = `a:num`; + term b = `b:num`; + term bound = `bound:num`; + thm integer_bound = ispecl_rule( + TERM_LIST( + `&(a:num):int`, + `&(b:num):int`, + `&(bound:num):int`), + get_theorem_by_name("INT_MAX_LE")); + thm natural_bound = rewrite_rule( + THM_LIST( + get_theorem_by_name("INT_OF_NUM_MAX"), + get_theorem_by_name("INT_OF_NUM_LE")), + integer_bound); + natural_bound = gen_rule(bound, natural_bound); + natural_bound = gen_rule(b, natural_bound); + return gen_rule(a, natural_bound); +} + +PROOF static thm MAX_NAT_LE_RAW = + prove_max_nat_le_raw(); + +PROOF static thm prove_max_nat_eq_right_raw(void) { + term goal_tm = ` + forall a b:num. + a <= b ==> MAX a b == b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "a"); + body = GEN_TAC(body, "b"); + body = DISCH_TAC(body, "Hab"); + + thm unfolded = ispecl_rule( + TERM_LIST(`a:num`, `b:num`), + get_theorem_by_name("MAX")); + thm reduced = pure_once_rewrite_rule( + THM_LIST(assume_rule(`(a:num) <= (b:num)`)), + unfolded); + reduced = rewrite_rule( + THM_LIST(get_theorem_by_name("COND_CLAUSES")), + reduced); + ACCEPT_TAC(body, reduced); + return gnode_prove(root); +} + +PROOF static thm MAX_NAT_EQ_RIGHT_RAW = + prove_max_nat_eq_right_raw(); + +/* ------------------------------------------------------------------------- */ +/* Raw descriptor and intrinsic laws */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm max_nat_op_def = new_fun_definition(` + max_nat_op (a:num) (b:num) : num = MAX a b +`); + +PROOF static thm max_nat_valid_def = new_fun_definition(` + max_nat_valid (a:num) <=> T +`); + +PROOF static thm prove_max_nat_ra_laws(void) { + term goal_tm = ` + ra_laws (0:num) max_nat_op max_nat_valid + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode unfolded = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_laws_def))); + + gnode_list law1 = CONJ_TAC(unfolded); + gnode assoc = AUTO_INTROS_TAC(law1[0]); + CONV_TAC( + assoc, + rewrite_conv(THM_LIST( + max_nat_op_def, + MAX_NAT_ASSOC_RAW))); + + gnode_list law2 = CONJ_TAC(law1[1]); + gnode comm = AUTO_INTROS_TAC(law2[0]); + CONV_TAC( + comm, + rewrite_conv(THM_LIST( + max_nat_op_def, + MAX_NAT_COMM_RAW))); + + gnode_list law3 = CONJ_TAC(law2[1]); + gnode unit = AUTO_INTROS_TAC(law3[0]); + CONV_TAC( + unit, + rewrite_conv(THM_LIST( + max_nat_op_def, + MAX_NAT_ZERO_LEFT_RAW))); + + gnode_list law4 = CONJ_TAC(law3[1]); + CONV_TAC( + law4[0], + rewrite_conv(THM_LIST(max_nat_valid_def))); + CONV_TAC( + law4[1], + rewrite_conv(THM_LIST(max_nat_valid_def))); + return gnode_prove(root); +} + +PROOF static thm MAX_NAT_RA_LAWS = + prove_max_nat_ra_laws(); + +PROOF static thm max_nat_ra_def = new_fun_definition(` + max_nat_ra : (num)ra = + ra_abs ((0:num),(max_nat_op,max_nat_valid)) +`); + +/* ------------------------------------------------------------------------- */ +/* Abstract projections */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_max_nat_ra_unit(void) { + thm computed = mp_rule( + ispecl_rule( + TERM_LIST( + `0:num`, + `max_nat_op:num->num->num`, + `max_nat_valid:num->bool`), + RA_UNIT_ABS), + MAX_NAT_RA_LAWS); + return pure_once_rewrite_rule( + THM_LIST(gsym_rule(max_nat_ra_def)), + computed); +} + +PROOF thm MAX_NAT_RA_UNIT = + prove_max_nat_ra_unit(); + +PROOF static thm prove_max_nat_ra_op_fn(void) { + thm computed = mp_rule( + ispecl_rule( + TERM_LIST( + `0:num`, + `max_nat_op:num->num->num`, + `max_nat_valid:num->bool`), + RA_OP_ABS), + MAX_NAT_RA_LAWS); + return pure_once_rewrite_rule( + THM_LIST(gsym_rule(max_nat_ra_def)), + computed); +} + +PROOF static thm MAX_NAT_RA_OP_FN = + prove_max_nat_ra_op_fn(); + +PROOF static thm prove_max_nat_ra_valid_fn(void) { + thm computed = mp_rule( + ispecl_rule( + TERM_LIST( + `0:num`, + `max_nat_op:num->num->num`, + `max_nat_valid:num->bool`), + RA_VALID_ABS), + MAX_NAT_RA_LAWS); + return pure_once_rewrite_rule( + THM_LIST(gsym_rule(max_nat_ra_def)), + computed); +} + +PROOF static thm MAX_NAT_RA_VALID_FN = + prove_max_nat_ra_valid_fn(); + +PROOF static thm prove_max_nat_ra_op(void) { + term goal_tm = ` + forall a b:num. + ra_op max_nat_ra a b == MAX a b + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + MAX_NAT_RA_OP_FN, + max_nat_op_def))); + return gnode_prove(root); +} + +PROOF thm MAX_NAT_RA_OP = + prove_max_nat_ra_op(); + +PROOF static thm prove_max_nat_ra_valid(void) { + term goal_tm = ` + forall n:num. ra_valid max_nat_ra n + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + MAX_NAT_RA_VALID_FN, + max_nat_valid_def))); + return gnode_prove(root); +} + +PROOF thm MAX_NAT_RA_VALID = + prove_max_nat_ra_valid(); + +/* ------------------------------------------------------------------------- */ +/* Inclusion and maximum laws */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_max_nat_ra_included(void) { + term goal_tm = ` + forall a b:num. + ra_included max_nat_ra a b <=> a <= b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "a"); + body = GEN_TAC(body, "b"); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_included_def))); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hincluded"); + forward = ASMP_EXISTS_TAC( + forward, + "Hincluded", + "frame"); + thm framed = trans_rule( + assume_rule(` + (b:num) == + ra_op max_nat_ra (a:num) (frame:num) + `), + ispecl_rule( + TERM_LIST(`a:num`, `frame:num`), + MAX_NAT_RA_OP)); + thm transport = beta_rule(ap_term_rule( + `\x:num. (a:num) <= x`, + framed)); + thm lower_bound = ispecl_rule( + TERM_LIST(`a:num`, `frame:num`), + MAX_NAT_LE_LEFT_RAW); + ACCEPT_TAC( + forward, + eq_mp_rule(gsym_rule(transport), lower_bound)); + + gnode reverse = DISCH_TAC(directions[1], "Hle"); + reverse = EXISTS_TAC(reverse, `b:num`); + thm op_computation = ispecl_rule( + TERM_LIST(`a:num`, `b:num`), + MAX_NAT_RA_OP); + thm maximum = mp_rule( + ispecl_rule( + TERM_LIST(`a:num`, `b:num`), + MAX_NAT_EQ_RIGHT_RAW), + assume_rule(`(a:num) <= (b:num)`)); + ACCEPT_TAC( + reverse, + gsym_rule(trans_rule(op_computation, maximum))); + return gnode_prove(root); +} + +PROOF thm MAX_NAT_RA_INCLUDED = + prove_max_nat_ra_included(); + +PROOF static thm prove_max_nat_ra_included_zero(void) { + term goal_tm = ` + forall n:num. ra_included max_nat_ra 0 n + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "n"); + thm characterization = ispecl_rule( + TERM_LIST(`0`, `n:num`), + MAX_NAT_RA_INCLUDED); + thm zero_bound = spec_rule( + `n:num`, + get_theorem_by_name("LE_0")); + ACCEPT_TAC( + body, + eq_mp_rule(gsym_rule(characterization), zero_bound)); + return gnode_prove(root); +} + +PROOF thm MAX_NAT_RA_INCLUDED_ZERO = + prove_max_nat_ra_included_zero(); + +PROOF static thm prove_max_nat_ra_included_op(void) { + term goal_tm = ` + forall a b bound:num. + ra_included + max_nat_ra + (ra_op max_nat_ra a b) + bound <=> + a <= bound && b <= bound + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + MAX_NAT_RA_INCLUDED, + MAX_NAT_RA_OP, + MAX_NAT_LE_RAW))); + return gnode_prove(root); +} + +PROOF thm MAX_NAT_RA_INCLUDED_OP = + prove_max_nat_ra_included_op(); + +PROOF static thm prove_max_nat_ra_idempotent(void) { + term goal_tm = ` + forall n:num. ra_op max_nat_ra n n == n + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "n"); + thm op_computation = ispecl_rule( + TERM_LIST(`n:num`, `n:num`), + MAX_NAT_RA_OP); + thm maximum = mp_rule( + ispecl_rule( + TERM_LIST(`n:num`, `n:num`), + MAX_NAT_EQ_RIGHT_RAW), + spec_rule(`n:num`, get_theorem_by_name("LE_REFL"))); + ACCEPT_TAC( + body, + trans_rule(op_computation, maximum)); + return gnode_prove(root); +} + +PROOF thm MAX_NAT_RA_IDEMPOTENT = + prove_max_nat_ra_idempotent(); + +PROOF static thm prove_max_nat_ra_op_eq_right(void) { + term goal_tm = ` + forall a b:num. + a <= b ==> ra_op max_nat_ra a b == b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "a"); + body = GEN_TAC(body, "b"); + body = DISCH_TAC(body, "Hab"); + thm op_computation = ispecl_rule( + TERM_LIST(`a:num`, `b:num`), + MAX_NAT_RA_OP); + thm maximum = mp_rule( + ispecl_rule( + TERM_LIST(`a:num`, `b:num`), + MAX_NAT_EQ_RIGHT_RAW), + assume_rule(`(a:num) <= (b:num)`)); + ACCEPT_TAC( + body, + trans_rule(op_computation, maximum)); + return gnode_prove(root); +} + +PROOF thm MAX_NAT_RA_OP_EQ_RIGHT = + prove_max_nat_ra_op_eq_right(); + +PROOF static thm prove_max_nat_ra_op_eq_left(void) { + term goal_tm = ` + forall a b:num. + b <= a ==> ra_op max_nat_ra a b == a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "a"); + body = GEN_TAC(body, "b"); + body = DISCH_TAC(body, "Hba"); + + thm op_computation = ispecl_rule( + TERM_LIST(`a:num`, `b:num`), + MAX_NAT_RA_OP); + thm commute = ispecl_rule( + TERM_LIST(`a:num`, `b:num`), + MAX_NAT_COMM_RAW); + thm maximum = mp_rule( + ispecl_rule( + TERM_LIST(`b:num`, `a:num`), + MAX_NAT_EQ_RIGHT_RAW), + assume_rule(`(b:num) <= (a:num)`)); + ACCEPT_TAC( + body, + trans_rule( + op_computation, + trans_rule(commute, maximum))); + return gnode_prove(root); +} + +PROOF thm MAX_NAT_RA_OP_EQ_LEFT = + prove_max_nat_ra_op_eq_left(); + +PROOF static thm prove_max_nat_ra_included_mono_right(void) { + term goal_tm = ` + forall old new fragment:num. + old <= new ==> + ra_included max_nat_ra fragment old ==> + ra_included max_nat_ra fragment new + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "old"); + body = GEN_TAC(body, "new"); + body = GEN_TAC(body, "fragment"); + body = DISCH_TAC(body, "Hmonotone"); + body = DISCH_TAC(body, "Hincluded"); + + thm old_characterization = ispecl_rule( + TERM_LIST(`fragment:num`, `old:num`), + MAX_NAT_RA_INCLUDED); + thm fragment_le_old = eq_mp_rule( + old_characterization, + assume_rule(` + ra_included max_nat_ra (fragment:num) (old:num) + `)); + thm fragment_le_new = mp_rule( + ispecl_rule( + TERM_LIST( + `fragment:num`, + `old:num`, + `new:num`), + get_theorem_by_name("LE_TRANS")), + conj_rule( + fragment_le_old, + assume_rule(`(old:num) <= (new:num)`))); + thm new_characterization = ispecl_rule( + TERM_LIST(`fragment:num`, `new:num`), + MAX_NAT_RA_INCLUDED); + ACCEPT_TAC( + body, + eq_mp_rule(gsym_rule(new_characterization), fragment_le_new)); + return gnode_prove(root); +} + +PROOF thm MAX_NAT_RA_INCLUDED_MONO_RIGHT = + prove_max_nat_ra_included_mono_right(); + +/* ------------------------------------------------------------------------- */ +/* Frame-preserving updates */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_max_nat_ra_update(void) { + term goal_tm = ` + forall old new:num. + ra_update max_nat_ra old new + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_update_def))); + body = GEN_TAC(body, "old"); + body = GEN_TAC(body, "new"); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hsource_valid"); + ACCEPT_TAC( + body, + spec_rule( + `ra_op max_nat_ra (new:num) (frame:num)`, + MAX_NAT_RA_VALID)); + return gnode_prove(root); +} + +PROOF thm MAX_NAT_RA_UPDATE = + prove_max_nat_ra_update(); + +PROOF static thm prove_max_nat_ra_update_nd(void) { + term goal_tm = ` + forall (old:num) (P:num->bool). + (exists new:num. P new) ==> + ra_update_nd max_nat_ra old P + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "old"); + body = GEN_TAC(body, "P"); + body = DISCH_TAC(body, "Hinhabited"); + body = ASMP_EXISTS_TAC( + body, + "Hinhabited", + "new"); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hsource_valid"); + body = EXISTS_TAC(body, `new:num`); + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC( + result[0], + assume_rule(`(P:num->bool) (new:num)`)); + ACCEPT_TAC( + result[1], + spec_rule( + `ra_op max_nat_ra (new:num) (frame:num)`, + MAX_NAT_RA_VALID)); + return gnode_prove(root); +} + +PROOF thm MAX_NAT_RA_UPDATE_ND = + prove_max_nat_ra_update_nd(); + +/* ------------------------------------------------------------------------- */ +/* Construction audit */ +/* ------------------------------------------------------------------------- */ + +PROOF static int audit_max_nat_ra(void) { + thm_list audited_theorems = THM_LIST( + MAX_NAT_ASSOC_RAW, + MAX_NAT_COMM_RAW, + MAX_NAT_ZERO_LEFT_RAW, + MAX_NAT_LE_LEFT_RAW, + MAX_NAT_LE_RAW, + MAX_NAT_EQ_RIGHT_RAW, + max_nat_op_def, + max_nat_valid_def, + MAX_NAT_RA_LAWS, + max_nat_ra_def, + MAX_NAT_RA_UNIT, + MAX_NAT_RA_OP_FN, + MAX_NAT_RA_VALID_FN, + MAX_NAT_RA_OP, + MAX_NAT_RA_VALID, + MAX_NAT_RA_INCLUDED, + MAX_NAT_RA_INCLUDED_ZERO, + MAX_NAT_RA_INCLUDED_OP, + MAX_NAT_RA_IDEMPOTENT, + MAX_NAT_RA_OP_EQ_RIGHT, + MAX_NAT_RA_OP_EQ_LEFT, + MAX_NAT_RA_INCLUDED_MONO_RIGHT, + MAX_NAT_RA_UPDATE, + MAX_NAT_RA_UPDATE_ND); + + for (size_t i = 0; i < vector_size(audited_theorems); ++i) { + ENSURE_COND(!IS_NULL(audited_theorems[i]), + "max-nat RA theorem %zu is empty", i); + ENSURE_COND(vector_size(hyp(audited_theorems[i])) == 0, + "max-nat RA theorem %zu has hypotheses", i); + } + ENSURE_COND( + vector_size(get_all_axioms()) == MAX_NAT_RA_AXIOMS_BEFORE, + "max-nat RA introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_max_nat_ra"); + return -1; +} + +PROOF static int _MAX_NAT_RA_AUDIT = + audit_max_nat_ra(); diff --git a/theory/logic/max_nat_ra.h b/theory/logic/max_nat_ra.h new file mode 100644 index 0000000..6a2d83a --- /dev/null +++ b/theory/logic/max_nat_ra.h @@ -0,0 +1,118 @@ +#pragma once + +/* + * Natural-number maximum resource algebra. + * + * `max_nat_ra:(num)ra` has carrier `num`, uses `0` as the unit, `MAX` as + * composition, and regards every natural number as valid. Its extension + * order is ordinary + * natural-number order: + * + * ra_included max_nat_ra n m <=> n <= m. + * + * The construction is useful as the fragment algebra below an authoritative + * monotonically increasing natural number. Notice that the *base* RA has no + * validity conflicts, so its frame-preserving update relation is universal. + * Monotonicity is enforced when an authoritative value must continue to + * include every compatible fragment, not by base validity. + * + * The raw descriptor, its law proof, and the `ra_abs` projection equations + * remain private to `max_nat_ra.c`. + */ + +#include "proof/theory/logic/ra.h" + +/* ------------------------------------------------------------------------- */ +/* Core representation */ +/* ------------------------------------------------------------------------- */ + +/* `ra_unit max_nat_ra == 0`. */ +PROOF extern thm MAX_NAT_RA_UNIT; + +/* `forall n m:num. ra_op max_nat_ra n m == MAX n m`. */ +PROOF extern thm MAX_NAT_RA_OP; + +/* ------------------------------------------------------------------------- */ +/* Validity */ +/* ------------------------------------------------------------------------- */ + +/* `forall n:num. ra_valid max_nat_ra n`. */ +PROOF extern thm MAX_NAT_RA_VALID; + +/* ------------------------------------------------------------------------- */ +/* Order and laws */ +/* ------------------------------------------------------------------------- */ + +/* `forall n m:num. ra_included max_nat_ra n m <=> n <= m`. */ +PROOF extern thm MAX_NAT_RA_INCLUDED; + +/* `forall n:num. ra_included max_nat_ra 0 n`. */ +PROOF extern thm MAX_NAT_RA_INCLUDED_ZERO; + +/* + * Inclusion of a composed fragment: + * + * `forall n m bound:num. + * ra_included max_nat_ra (ra_op max_nat_ra n m) bound <=> + * n <= bound && m <= bound` + */ +PROOF extern thm MAX_NAT_RA_INCLUDED_OP; + +/* `forall n:num. ra_op max_nat_ra n n == n`. */ +PROOF extern thm MAX_NAT_RA_IDEMPOTENT; + +/* + * `forall n m:num. + * n <= m ==> ra_op max_nat_ra n m == m` + */ +PROOF extern thm MAX_NAT_RA_OP_EQ_RIGHT; + +/* + * `forall n m:num. + * m <= n ==> ra_op max_nat_ra n m == n` + */ +PROOF extern thm MAX_NAT_RA_OP_EQ_LEFT; + +/* ------------------------------------------------------------------------- */ +/* Order: authority-ready monotonicity */ +/* ------------------------------------------------------------------------- */ + +/* + * Raising an upper bound preserves every fragment already included in it: + * + * `forall old new fragment:num. + * old <= new ==> + * ra_included max_nat_ra fragment old ==> + * ra_included max_nat_ra fragment new` + * + * After reducing an empty-fragment `AUTH_RA_UPDATE` premise with the generic + * unit law, this is precisely the remaining compatibility obligation. The + * theorem deliberately mentions no `auth_ra`, keeping this base construction + * independent of the authoritative construction. + */ +PROOF extern thm MAX_NAT_RA_INCLUDED_MONO_RIGHT; + +/* ------------------------------------------------------------------------- */ +/* Updates */ +/* ------------------------------------------------------------------------- */ + +/* + * All deterministic base updates are frame preserving: + * + * `forall old new:num. ra_update max_nat_ra old new` + * + * This strong rule is sound because every framed target is valid. Clients + * needing a monotone counter should place this RA under `auth_ra` and use the + * inclusion theorem above, rather than treating this base update as the + * counter protocol. + */ +PROOF extern thm MAX_NAT_RA_UPDATE; + +/* + * Every inhabited result predicate admits a nondeterministic base update: + * + * `forall old:num. forall P:num->bool. + * (exists new:num. P new) ==> + * ra_update_nd max_nat_ra old P` + */ +PROOF extern thm MAX_NAT_RA_UPDATE_ND; diff --git a/theory/logic/option_ra.c b/theory/logic/option_ra.c new file mode 100644 index 0000000..523a363 --- /dev/null +++ b/theory/logic/option_ra.c @@ -0,0 +1,859 @@ +#include "proof/theory/logic/option_ra.h" +#include "proof/theory/logic/ra_builder.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/ra.c" + +PROOF static size_t OPTION_RA_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF static thm option_ra_some_op_def = new_rec_definition( + get_theorem_by_name("option_RECURSION"), + ` + option_ra_some_op + (R:(A)ra) + (a:A) + (NONE:A option) = + SOME a && + option_ra_some_op + (R:(A)ra) + (a:A) + (SOME b) = + SOME (ra_op R a b) + `); + +PROOF static thm option_ra_op_def = new_rec_definition( + get_theorem_by_name("option_RECURSION"), + ` + option_ra_op + (R:(A)ra) + (NONE:A option) + (y:A option) = + y && + option_ra_op + (R:(A)ra) + (SOME a) + (y:A option) = + option_ra_some_op R a y + `); + +PROOF static thm option_ra_valid_def = new_rec_definition( + get_theorem_by_name("option_RECURSION"), + ` + (option_ra_valid + (R:(A)ra) + (NONE:A option) <=> T) && + (option_ra_valid + (R:(A)ra) + (SOME a) <=> ra_valid R a) + `); + +PROOF static thm prove_option_ra_op_assoc(void) { + term goal_tm = ` + forall + (R:(A)ra) + (x:A option) + (y:A option) + (z:A option). + option_ra_op R (option_ra_op R x y) z == + option_ra_op R x (option_ra_op R y z) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list x_cases = CASES_TAC( + body, `x:A option`, NULL); + for (size_t i = 0; i < vector_size(x_cases); ++i) { + gnode_list y_cases = CASES_TAC( + x_cases[i], `y:A option`, NULL); + for (size_t j = 0; j < vector_size(y_cases); ++j) { + gnode_list z_cases = CASES_TAC( + y_cases[j], `z:A option`, NULL); + for (size_t k = 0; k < vector_size(z_cases); ++k) { + CONV_WITH_ASMP_TAC( + z_cases[k], + rewrite_conv, + THM_LIST( + option_ra_op_def, + option_ra_some_op_def, + RA_ASSOC)); + } + } + } + return gnode_prove(root); +} + +PROOF static thm OPTION_RA_OP_ASSOC = + prove_option_ra_op_assoc(); + +PROOF static thm prove_option_ra_op_comm(void) { + term goal_tm = ` + forall (R:(A)ra) (x:A option) (y:A option). + option_ra_op R x y == + option_ra_op R y x + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list x_cases = CASES_TAC( + body, `x:A option`, NULL); + for (size_t i = 0; i < vector_size(x_cases); ++i) { + gnode_list y_cases = CASES_TAC( + x_cases[i], `y:A option`, NULL); + for (size_t j = 0; j < vector_size(y_cases); ++j) { + CONV_WITH_ASMP_TAC( + y_cases[j], + rewrite_conv, + THM_LIST( + option_ra_op_def, + option_ra_some_op_def, + RA_COMM)); + } + } + return gnode_prove(root); +} + +PROOF static thm OPTION_RA_OP_COMM = + prove_option_ra_op_comm(); + +PROOF static thm prove_option_ra_op_unit_l(void) { + term goal_tm = ` + forall (R:(A)ra) (x:A option). + option_ra_op R NONE x == x + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + CONV_TAC( + body, + rewrite_conv(THM_LIST(option_ra_op_def))); + return gnode_prove(root); +} + +PROOF static thm OPTION_RA_OP_UNIT_L = + prove_option_ra_op_unit_l(); + +PROOF static thm prove_option_ra_valid_unit(void) { + term goal_tm = ` + forall R:(A)ra. + option_ra_valid R NONE + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + CONV_TAC( + body, + rewrite_conv(THM_LIST(option_ra_valid_def))); + return gnode_prove(root); +} + +PROOF static thm OPTION_RA_VALID_UNIT = + prove_option_ra_valid_unit(); + +PROOF static thm prove_option_ra_valid_op_l(void) { + term goal_tm = ` + forall (R:(A)ra) (x:A option) (y:A option). + option_ra_valid R (option_ra_op R x y) ==> + option_ra_valid R x + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "x"); + body = GEN_TAC(body, "y"); + gnode_list x_cases = CASES_TAC( + body, `x:A option`, NULL); + for (size_t i = 0; i < vector_size(x_cases); ++i) { + gnode_list y_cases = CASES_TAC( + x_cases[i], `y:A option`, NULL); + for (size_t j = 0; j < vector_size(y_cases); ++j) { + CONV_WITH_ASMP_TAC( + y_cases[j], + rewrite_conv, + THM_LIST( + option_ra_op_def, + option_ra_some_op_def, + option_ra_valid_def, + RA_VALID_OP_L)); + } + } + return gnode_prove(root); +} + +PROOF static thm OPTION_RA_VALID_OP_L = + prove_option_ra_valid_op_l(); + +PROOF static thm prove_option_ra_laws(void) { + term goal_tm = ` + forall R:(A)ra. + ra_laws + (NONE:A option) + (option_ra_op R) + (option_ra_valid R) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + gnode unfolded = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_laws_def))); + + gnode_list law1 = CONJ_TAC(unfolded); + ACCEPT_TAC( + law1[0], + spec_rule(`R:(A)ra`, OPTION_RA_OP_ASSOC)); + + gnode_list law2 = CONJ_TAC(law1[1]); + ACCEPT_TAC( + law2[0], + spec_rule(`R:(A)ra`, OPTION_RA_OP_COMM)); + + gnode_list law3 = CONJ_TAC(law2[1]); + ACCEPT_TAC( + law3[0], + spec_rule(`R:(A)ra`, OPTION_RA_OP_UNIT_L)); + + gnode_list law4 = CONJ_TAC(law3[1]); + ACCEPT_TAC( + law4[0], + spec_rule(`R:(A)ra`, OPTION_RA_VALID_UNIT)); + ACCEPT_TAC( + law4[1], + spec_rule(`R:(A)ra`, OPTION_RA_VALID_OP_L)); + return gnode_prove(root); +} + +PROOF static thm OPTION_RA_LAWS = + prove_option_ra_laws(); + +PROOF static thm option_ra_def = new_fun_definition(` + option_ra (R:(A)ra) : ((A)option)ra = + ra_abs + ((NONE:A option), + (option_ra_op R:A option->A option->A option, + option_ra_valid R:A option->bool)) +`); + +PROOF static thm prove_option_ra_unit(void) { + term R = `R:(A)ra`; + term none = `NONE:A option`; + term op = ` + option_ra_op (R:(A)ra): + A option->A option->A option + `; + term valid = ` + option_ra_valid (R:(A)ra):A option->bool + `; + thm laws = ispec_rule(R, OPTION_RA_LAWS); + thm computed = mp_rule( + ispecl_rule( + TERM_LIST(none, op, valid), + RA_UNIT_ABS), + laws); + computed = pure_once_rewrite_rule( + THM_LIST(gsym_rule(option_ra_def)), + computed); + return gen_rule(R, computed); +} + +PROOF thm OPTION_RA_UNIT = + prove_option_ra_unit(); + +PROOF static thm prove_option_ra_op_fn(void) { + term R = `R:(A)ra`; + term none = `NONE:A option`; + term op = ` + option_ra_op (R:(A)ra): + A option->A option->A option + `; + term valid = ` + option_ra_valid (R:(A)ra):A option->bool + `; + thm laws = ispec_rule(R, OPTION_RA_LAWS); + thm computed = mp_rule( + ispecl_rule( + TERM_LIST(none, op, valid), + RA_OP_ABS), + laws); + computed = pure_once_rewrite_rule( + THM_LIST(gsym_rule(option_ra_def)), + computed); + return gen_rule(R, computed); +} + +PROOF static thm OPTION_RA_OP_FN = + prove_option_ra_op_fn(); + +PROOF static thm prove_option_ra_valid_fn(void) { + term R = `R:(A)ra`; + term none = `NONE:A option`; + term op = ` + option_ra_op (R:(A)ra): + A option->A option->A option + `; + term valid = ` + option_ra_valid (R:(A)ra):A option->bool + `; + thm laws = ispec_rule(R, OPTION_RA_LAWS); + thm computed = mp_rule( + ispecl_rule( + TERM_LIST(none, op, valid), + RA_VALID_ABS), + laws); + computed = pure_once_rewrite_rule( + THM_LIST(gsym_rule(option_ra_def)), + computed); + return gen_rule(R, computed); +} + +PROOF static thm OPTION_RA_VALID_FN = + prove_option_ra_valid_fn(); + +PROOF static thm prove_option_ra_op_none_l(void) { + term goal_tm = ` + forall (R:(A)ra) (x:A option). + ra_op (option_ra R) NONE x == x + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + OPTION_RA_OP_FN, + option_ra_op_def))); + return gnode_prove(root); +} + +PROOF thm OPTION_RA_OP_NONE_L = + prove_option_ra_op_none_l(); + +PROOF static thm prove_option_ra_op_none_r(void) { + term goal_tm = ` + forall (R:(A)ra) (x:A option). + ra_op (option_ra R) x NONE == x + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list x_cases = CASES_TAC( + body, `x:A option`, NULL); + for (size_t i = 0; i < vector_size(x_cases); ++i) { + CONV_WITH_ASMP_TAC( + x_cases[i], + rewrite_conv, + THM_LIST( + OPTION_RA_OP_FN, + option_ra_op_def, + option_ra_some_op_def)); + } + return gnode_prove(root); +} + +PROOF thm OPTION_RA_OP_NONE_R = + prove_option_ra_op_none_r(); + +PROOF static thm prove_option_ra_op_some_some(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_op (option_ra R) (SOME a) (SOME b) == + SOME (ra_op R a b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + OPTION_RA_OP_FN, + option_ra_op_def, + option_ra_some_op_def))); + return gnode_prove(root); +} + +PROOF thm OPTION_RA_OP_SOME_SOME = + prove_option_ra_op_some_some(); + +PROOF static thm prove_option_ra_valid_none(void) { + term goal_tm = ` + forall R:(A)ra. + ra_valid (option_ra R) (NONE:A option) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + OPTION_RA_VALID_FN, + option_ra_valid_def))); + return gnode_prove(root); +} + +PROOF thm OPTION_RA_VALID_NONE = + prove_option_ra_valid_none(); + +PROOF static thm prove_option_ra_valid_some(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A). + ra_valid (option_ra R) (SOME a) <=> + ra_valid R a + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + OPTION_RA_VALID_FN, + option_ra_valid_def))); + return gnode_prove(root); +} + +PROOF thm OPTION_RA_VALID_SOME = + prove_option_ra_valid_some(); + +/* ------------------------------------------------------------------------- */ +/* Inclusion */ +/* ------------------------------------------------------------------------- */ + +/* NONE is the option RA unit, hence it is included in every option value. */ +PROOF static thm prove_option_ra_included_none(void) { + term goal_tm = ` + forall (R:(A)ra) (x:A option). + ra_included (option_ra R) NONE x + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm included_unit = ispecl_rule( + TERM_LIST( + `option_ra (R:(A)ra)`, + `x:A option`), + RA_INCLUDED_UNIT); + thm unit_equation = ispec_rule( + `R:(A)ra`, + OPTION_RA_UNIT); + ACCEPT_TAC( + body, + pure_once_rewrite_rule( + THM_LIST(unit_equation), + included_unit)); + return gnode_prove(root); +} + +PROOF thm OPTION_RA_INCLUDED_NONE = + prove_option_ra_included_none(); + +/* Inclusion between present values is exactly base inclusion. The adjoined + * NONE frame denotes the base unit; a SOME frame denotes its payload. */ +PROOF static thm prove_option_ra_included_some_some(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_included + (option_ra R) + (SOME a) + (SOME b) <=> + ra_included R a b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC( + directions[0], "Hoption_included"); + thm option_included = pure_once_rewrite_rule( + THM_LIST(ra_included_def), + assume_rule(` + ra_included + (option_ra (R:(A)ra)) + (SOME (a:A)) + (SOME (b:A)) + `)); + forward = ASSUME_TAC( + forward, option_included, "Hoption_extension"); + forward = ASMP_EXISTS_TAC( + forward, "Hoption_extension", "frame"); + forward = CONV_TAC( + forward, + once_rewrite_conv(THM_LIST(ra_included_def))); + gnode_list frame_cases = CASES_TAC( + forward, `frame:A option`, "Hframe"); + + term none_eq_tm = gnode_get_asmps( + frame_cases[0], + CONST_STRING_LIST("Hframe"))[0]; + thm none_extension = rewrite_rule( + THM_LIST( + assume_rule(none_eq_tm), + OPTION_RA_OP_NONE_R, + get_theorem_by_name("option_INJ")), + assume_rule(` + SOME (b:A) == + ra_op + (option_ra (R:(A)ra)) + (SOME (a:A)) + (frame:A option) + `)); + gnode none_branch = EXISTS_TAC( + frame_cases[0], + `ra_unit (R:(A)ra)`); + thm base_unit_extension = trans_rule( + none_extension, + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + RA_UNIT_R))); + ACCEPT_TAC(none_branch, base_unit_extension); + + term some_eq_tm = gnode_get_asmps( + frame_cases[1], + CONST_STRING_LIST("Hframe"))[0]; + term some_frame = dest_comb(dest_eq(some_eq_tm).tm2).tm2; + thm some_extension = rewrite_rule( + THM_LIST( + assume_rule(some_eq_tm), + OPTION_RA_OP_SOME_SOME, + get_theorem_by_name("option_INJ")), + assume_rule(` + SOME (b:A) == + ra_op + (option_ra (R:(A)ra)) + (SOME (a:A)) + (frame:A option) + `)); + gnode some_branch = EXISTS_TAC( + frame_cases[1], + some_frame); + ACCEPT_TAC(some_branch, some_extension); + + gnode reverse = DISCH_TAC( + directions[1], "Hbase_included"); + thm base_included = pure_once_rewrite_rule( + THM_LIST(ra_included_def), + assume_rule(`ra_included (R:(A)ra) (a:A) (b:A)`)); + reverse = ASSUME_TAC( + reverse, base_included, "Hbase_extension"); + reverse = ASMP_EXISTS_TAC( + reverse, "Hbase_extension", "base_frame"); + reverse = CONV_TAC( + reverse, + once_rewrite_conv(THM_LIST(ra_included_def))); + reverse = EXISTS_TAC( + reverse, + `SOME (base_frame:A)`); + + thm lifted_extension = beta_rule(ap_term_rule( + `\x:A. SOME x`, + assume_rule(` + (b:A) == + ra_op (R:(A)ra) (a:A) (base_frame:A) + `))); + thm option_composition = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `base_frame:A`), + OPTION_RA_OP_SOME_SOME); + ACCEPT_TAC( + reverse, + trans_rule( + lifted_extension, + gsym_rule(option_composition))); + return gnode_prove(root); +} + +PROOF thm OPTION_RA_INCLUDED_SOME_SOME = + prove_option_ra_included_some_some(); + +/* A present value cannot be extended back to the freshly adjoined unit. */ +PROOF static thm prove_option_ra_not_included_some_none(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A). + ~(ra_included + (option_ra R) + (SOME a) + NONE) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "a"); + body = DISCH_TAC(body, "Hincluded"); + thm included = pure_once_rewrite_rule( + THM_LIST(ra_included_def), + assume_rule(` + ra_included + (option_ra (R:(A)ra)) + (SOME (a:A)) + NONE + `)); + body = ASSUME_TAC(body, included, "Hextension"); + body = ASMP_EXISTS_TAC(body, "Hextension", "frame"); + gnode_list frame_cases = CASES_TAC( + body, `frame:A option`, "Hframe"); + for (size_t i = 0; i < vector_size(frame_cases); ++i) { + term frame_eq_tm = gnode_get_asmps( + frame_cases[i], + CONST_STRING_LIST("Hframe"))[0]; + thm contradiction = rewrite_rule( + THM_LIST( + assume_rule(frame_eq_tm), + OPTION_RA_OP_NONE_R, + OPTION_RA_OP_SOME_SOME, + get_theorem_by_name("option_DISTINCT")), + assume_rule(` + (NONE:A option) == + ra_op + (option_ra (R:(A)ra)) + (SOME (a:A)) + (frame:A option) + `)); + CONTR_TAC(frame_cases[i], contradiction); + } + return gnode_prove(root); +} + +PROOF thm OPTION_RA_NOT_INCLUDED_SOME_NONE = + prove_option_ra_not_included_some_none(); + +/* ------------------------------------------------------------------------- */ +/* Frame-preserving updates */ +/* ------------------------------------------------------------------------- */ + +/* + * A base update lifts through SOME. The option frame is inspected + * explicitly: NONE reduces to ordinary validity preservation, while a SOME + * frame is exactly the corresponding base frame. + */ +PROOF static thm prove_option_ra_update(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_update R a b ==> + ra_update (option_ra R) (SOME a) (SOME b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_def))); + body = AUTO_INTROS_TAC(body); + gnode_list frame_cases = CASES_TAC( + body, `frame:A option`, "Hframe"); + + term frame_none_eq = gnode_get_asmps( + frame_cases[0], + CONST_STRING_LIST("Hframe"))[0]; + + thm source_none = rewrite_rule( + THM_LIST( + assume_rule(frame_none_eq), + OPTION_RA_OP_NONE_R, + OPTION_RA_VALID_SOME), + assume_rule(` + ra_valid + (option_ra (R:(A)ra)) + (ra_op + (option_ra R) + (SOME (a:A)) + (frame:A option)) + `)); + thm target_none = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `b:A`), + RA_UPDATE_VALID), + assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)), + source_none); + gnode target_none_goal = CONV_TAC( + frame_cases[0], + rewrite_conv(THM_LIST( + assume_rule(frame_none_eq), + OPTION_RA_OP_NONE_R, + OPTION_RA_VALID_SOME))); + ACCEPT_TAC(target_none_goal, target_none); + + term frame_some_eq = gnode_get_asmps( + frame_cases[1], + CONST_STRING_LIST("Hframe"))[0]; + term base_frame = dest_comb( + dest_eq(frame_some_eq).tm2).tm2; + thm source_some = rewrite_rule( + THM_LIST( + assume_rule(frame_some_eq), + OPTION_RA_OP_SOME_SOME, + OPTION_RA_VALID_SOME), + assume_rule(` + ra_valid + (option_ra (R:(A)ra)) + (ra_op + (option_ra R) + (SOME (a:A)) + (frame:A option)) + `)); + thm base_update = pure_once_rewrite_rule( + THM_LIST(ra_update_def), + assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); + thm target_some = mp_rule( + spec_rule(base_frame, base_update), + source_some); + gnode target_some_goal = CONV_TAC( + frame_cases[1], + rewrite_conv(THM_LIST( + assume_rule(frame_some_eq), + OPTION_RA_OP_SOME_SOME, + OPTION_RA_VALID_SOME))); + ACCEPT_TAC(target_some_goal, target_some); + return gnode_prove(root); +} + +PROOF thm OPTION_RA_UPDATE = + prove_option_ra_update(); + +/* + * The nondeterministic rule keeps the base result witness and embeds it with + * SOME. Its result predicate is the exact image of P, rather than an + * arbitrary predicate that merely contains that image. + */ +PROOF static thm prove_option_ra_update_nd(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (P:A->bool). + ra_update_nd R a P ==> + ra_update_nd + (option_ra R) + (SOME a) + (\x:A option. exists b:A. P b && x == SOME b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = AUTO_INTROS_TAC(body); + gnode_list frame_cases = CASES_TAC( + body, `frame:A option`, "Hframe"); + + for (size_t i = 0; i < vector_size(frame_cases); ++i) { + term frame_eq_tm = gnode_get_asmps( + frame_cases[i], + CONST_STRING_LIST("Hframe"))[0]; + thm frame_eq = assume_rule(frame_eq_tm); + thm source_valid = rewrite_rule( + THM_LIST( + frame_eq, + OPTION_RA_OP_NONE_R, + OPTION_RA_OP_SOME_SOME, + OPTION_RA_VALID_SOME), + assume_rule(` + ra_valid + (option_ra (R:(A)ra)) + (ra_op + (option_ra R) + (SOME (a:A)) + (frame:A option)) + `)); + + thm selected; + if (i == 0) { + selected = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `P:A->bool`), + RA_UPDATE_ND_VALID), + assume_rule(` + ra_update_nd + (R:(A)ra) + (a:A) + (P:A->bool) + `)), + source_valid); + } else { + thm base_update = pure_once_rewrite_rule( + THM_LIST(ra_update_nd_def), + assume_rule(` + ra_update_nd + (R:(A)ra) + (a:A) + (P:A->bool) + `)); + term base_frame = dest_comb( + dest_eq(frame_eq_tm).tm2).tm2; + selected = mp_rule( + spec_rule(base_frame, base_update), + source_valid); + } + + gnode branch = ASSUME_TAC( + frame_cases[i], selected, "Hselected"); + branch = ASMP_EXISTS_TAC( + branch, "Hselected", "b"); + branch = ASMP_CONJ_TAC( + branch, + "Hselected", + "HP_b", + "Hb_valid"); + branch = EXISTS_TAC(branch, `SOME (b:A)`); + gnode_list result_parts = CONJ_TAC(branch); + + gnode predicate = EXISTS_TAC( + result_parts[0], `b:A`); + gnode_list predicate_parts = CONJ_TAC(predicate); + ACCEPT_TAC( + predicate_parts[0], + assume_rule(`(P:A->bool) (b:A)`)); + ACCEPT_TAC( + predicate_parts[1], + refl_rule(`SOME (b:A)`)); + + gnode target_valid = CONV_TAC( + result_parts[1], + rewrite_conv(THM_LIST( + frame_eq, + OPTION_RA_OP_NONE_R, + OPTION_RA_OP_SOME_SOME, + OPTION_RA_VALID_SOME))); + ACCEPT_TAC( + target_valid, + assume_rule(gnode_get_asmps( + target_valid, + CONST_STRING_LIST("Hb_valid"))[0])); + } + return gnode_prove(root); +} + +PROOF thm OPTION_RA_UPDATE_ND = + prove_option_ra_update_nd(); + +PROOF static int audit_option_ra(void) { + thm_list audited_theorems = THM_LIST( + option_ra_some_op_def, + option_ra_op_def, + option_ra_valid_def, + OPTION_RA_OP_ASSOC, + OPTION_RA_OP_COMM, + OPTION_RA_OP_UNIT_L, + OPTION_RA_VALID_UNIT, + OPTION_RA_VALID_OP_L, + OPTION_RA_LAWS, + option_ra_def, + OPTION_RA_UNIT, + OPTION_RA_OP_FN, + OPTION_RA_VALID_FN, + OPTION_RA_OP_NONE_L, + OPTION_RA_OP_NONE_R, + OPTION_RA_OP_SOME_SOME, + OPTION_RA_VALID_NONE, + OPTION_RA_VALID_SOME, + OPTION_RA_INCLUDED_NONE, + OPTION_RA_INCLUDED_SOME_SOME, + OPTION_RA_NOT_INCLUDED_SOME_NONE, + OPTION_RA_UPDATE, + OPTION_RA_UPDATE_ND); + + for (size_t i = 0; i < vector_size(audited_theorems); ++i) { + ENSURE_COND(!IS_NULL(audited_theorems[i]), + "option RA theorem %zu is empty", i); + ENSURE_COND(vector_size(hyp(audited_theorems[i])) == 0, + "option RA theorem %zu has hypotheses", i); + } + ENSURE_COND(vector_size(get_all_axioms()) == OPTION_RA_AXIOMS_BEFORE, + "option RA introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_option_ra"); + return -1; +} + +PROOF static int _OPTION_RA_AUDIT = audit_option_ra(); diff --git a/theory/logic/option_ra.h b/theory/logic/option_ra.h new file mode 100644 index 0000000..8958ee2 --- /dev/null +++ b/theory/logic/option_ra.h @@ -0,0 +1,116 @@ +#pragma once + +/* + * `option_ra R:((A)option)ra` adjoins a fresh unit `NONE` to `R:(A)ra`. + * Its carrier is `A option`; `NONE` is the unit; `SOME a` and `SOME b` + * compose to `SOME (ra_op R a b)`; `NONE` is valid and `SOME a` is valid + * exactly when `a` is valid in `R`. + * + * This client interface exposes only equations stated directly with + * `ra_unit`, `ra_op`, and `ra_valid`. The recursive implementation and the + * `ra_abs` projection equations remain private to `option_ra.c`. + */ + +#include "proof/theory/logic/ra.h" + +/* ------------------------------------------------------------------------- */ +/* Core representation */ +/* ------------------------------------------------------------------------- */ + +/* `forall R:(A)ra. ra_unit (option_ra R) == (NONE:A option)`. */ +PROOF extern thm OPTION_RA_UNIT; + +/* + * `forall (R:(A)ra) (x:A option). + * ra_op (option_ra R) NONE x == x` + */ +PROOF extern thm OPTION_RA_OP_NONE_L; + +/* + * `forall (R:(A)ra) (x:A option). + * ra_op (option_ra R) x NONE == x` + */ +PROOF extern thm OPTION_RA_OP_NONE_R; + +/* + * `forall (R:(A)ra) (a:A) (b:A). + * ra_op (option_ra R) (SOME a) (SOME b) == + * SOME (ra_op R a b)` + */ +PROOF extern thm OPTION_RA_OP_SOME_SOME; + +/* ------------------------------------------------------------------------- */ +/* Validity */ +/* ------------------------------------------------------------------------- */ + +/* `forall R:(A)ra. ra_valid (option_ra R) (NONE:A option)`. */ +PROOF extern thm OPTION_RA_VALID_NONE; + +/* + * `forall (R:(A)ra) (a:A). + * ra_valid (option_ra R) (SOME a) <=> ra_valid R a` + */ +PROOF extern thm OPTION_RA_VALID_SOME; + +/* ------------------------------------------------------------------------- */ +/* Order */ +/* ------------------------------------------------------------------------- */ + +/* + * The freshly adjoined unit is included in every option resource: + * + * forall (R:(A)ra) (x:A option). + * ra_included (option_ra R) NONE x + */ +PROOF extern thm OPTION_RA_INCLUDED_NONE; + +/* + * Inclusion between present resources is exactly base inclusion: + * + * forall (R:(A)ra) (a:A) (b:A). + * ra_included (option_ra R) (SOME a) (SOME b) <=> + * ra_included R a b + */ +PROOF extern thm OPTION_RA_INCLUDED_SOME_SOME; + +/* + * No present resource is included in the freshly adjoined unit: + * + * forall (R:(A)ra) (a:A). + * ~(ra_included (option_ra R) (SOME a) NONE) + */ +PROOF extern thm OPTION_RA_NOT_INCLUDED_SOME_NONE; + +/* ------------------------------------------------------------------------- */ +/* Laws */ +/* ------------------------------------------------------------------------- */ + +/* + * Associativity, commutativity, unit laws, and downward closure are inherited + * through the intrinsic RA interface in `ra.h`. + */ + +/* ------------------------------------------------------------------------- */ +/* Updates */ +/* ------------------------------------------------------------------------- */ + +/* + * Deterministic base update lifting: + * + * forall (R:(A)ra) (a:A) (b:A). + * ra_update R a b ==> + * ra_update (option_ra R) (SOME a) (SOME b) + */ +PROOF extern thm OPTION_RA_UPDATE; + +/* + * Nondeterministic base update lifting to the exact SOME image: + * + * forall (R:(A)ra) (a:A) (P:A->bool). + * ra_update_nd R a P ==> + * ra_update_nd + * (option_ra R) + * (SOME a) + * (\x:A option. exists b:A. P b && x == SOME b) + */ +PROOF extern thm OPTION_RA_UPDATE_ND; diff --git a/theory/logic/prod_ra.c b/theory/logic/prod_ra.c new file mode 100644 index 0000000..741e9c3 --- /dev/null +++ b/theory/logic/prod_ra.c @@ -0,0 +1,1207 @@ +#include "proof/theory/logic/prod_ra.h" +#include "proof/theory/logic/ra_builder.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/ra.c" + +PROOF static size_t PROD_RA_AXIOMS_BEFORE = vector_size(get_all_axioms()); + +PROOF static thm prod_ra_op_def = new_fun_definition(` + prod_ra_op + (R1:(A)ra) + (R2:(B)ra) + (x:A#B) + (y:A#B) : A#B = + (ra_op R1 (FST x) (FST y), + ra_op R2 (SND x) (SND y)) +`); + +PROOF static thm prod_ra_valid_def = new_fun_definition(` + prod_ra_valid + (R1:(A)ra) + (R2:(B)ra) + (x:A#B) <=> + ra_valid R1 (FST x) && + ra_valid R2 (SND x) +`); + +PROOF static thm prove_prod_ra_laws(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra). + ra_laws + (ra_unit R1,ra_unit R2) + (prod_ra_op R1 R2) + (prod_ra_valid R1 R2) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode unfolded = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_laws_def))); + + gnode_list law1 = CONJ_TAC(unfolded); + gnode assoc = AUTO_INTROS_TAC(law1[0]); + assoc = CONV_TAC( + assoc, + pure_rewrite_conv(THM_LIST( + prod_ra_op_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + assoc = CONV_TAC( + assoc, + once_rewrite_conv(THM_LIST( + get_theorem_by_name("PAIR_EQ")))); + gnode_list assoc_parts = CONJ_TAC(assoc); + ACCEPT_TAC( + assoc_parts[0], + ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `FST (a:A#B)`, + `FST (b:A#B)`, + `FST (c:A#B)`), + RA_ASSOC)); + ACCEPT_TAC( + assoc_parts[1], + ispecl_rule( + TERM_LIST( + `R2:(B)ra`, + `SND (a:A#B)`, + `SND (b:A#B)`, + `SND (c:A#B)`), + RA_ASSOC)); + + gnode_list law2 = CONJ_TAC(law1[1]); + gnode comm = AUTO_INTROS_TAC(law2[0]); + comm = CONV_TAC( + comm, + pure_rewrite_conv(THM_LIST(prod_ra_op_def))); + comm = CONV_TAC( + comm, + once_rewrite_conv(THM_LIST( + get_theorem_by_name("PAIR_EQ")))); + gnode_list comm_parts = CONJ_TAC(comm); + ACCEPT_TAC( + comm_parts[0], + ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `FST (a:A#B)`, + `FST (b:A#B)`), + RA_COMM)); + ACCEPT_TAC( + comm_parts[1], + ispecl_rule( + TERM_LIST( + `R2:(B)ra`, + `SND (a:A#B)`, + `SND (b:A#B)`), + RA_COMM)); + + gnode_list law3 = CONJ_TAC(law2[1]); + gnode unit = AUTO_INTROS_TAC(law3[0]); + CONV_TAC( + unit, + rewrite_conv(THM_LIST( + prod_ra_op_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + RA_UNIT_L, + get_theorem_by_name("PAIR")))); + + gnode_list law4 = CONJ_TAC(law3[1]); + CONV_TAC( + law4[0], + rewrite_conv(THM_LIST( + prod_ra_valid_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + RA_VALID_UNIT))); + + gnode valid_down = CONV_TAC( + law4[1], + pure_rewrite_conv(THM_LIST( + prod_ra_valid_def, + prod_ra_op_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + valid_down = AUTO_INTROS_TAC(valid_down); + valid_down = ASMP_CONJ_TAC( + valid_down, + "H", + "Hvalid_fst", + "Hvalid_snd"); + gnode_list valid_parts = CONJ_TAC(valid_down); + ACCEPT_TAC( + valid_parts[0], + mp_rule( + ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `FST (a:A#B)`, + `FST (b:A#B)`), + RA_VALID_OP_L), + assume_rule(` + ra_valid (R1:(A)ra) + (ra_op R1 (FST (a:A#B)) (FST (b:A#B))) + `))); + ACCEPT_TAC( + valid_parts[1], + mp_rule( + ispecl_rule( + TERM_LIST( + `R2:(B)ra`, + `SND (a:A#B)`, + `SND (b:A#B)`), + RA_VALID_OP_L), + assume_rule(` + ra_valid (R2:(B)ra) + (ra_op R2 (SND (a:A#B)) (SND (b:A#B))) + `))); + return gnode_prove(root); +} + +PROOF static thm PROD_RA_LAWS = prove_prod_ra_laws(); + +PROOF static thm prod_ra_def = new_fun_definition(` + prod_ra (R1:(A)ra) (R2:(B)ra) : (A#B)ra = + ra_abs + ((ra_unit R1,ra_unit R2), + (prod_ra_op R1 R2,prod_ra_valid R1 R2)) +`); + +PROOF static thm prove_prod_ra_unit(void) { + term R1 = `R1:(A)ra`; + term R2 = `R2:(B)ra`; + thm laws = ispecl_rule(TERM_LIST(R1, R2), PROD_RA_LAWS); + thm computed = mp_rule( + ispecl_rule( + TERM_LIST( + `(ra_unit (R1:(A)ra),ra_unit (R2:(B)ra))`, + `prod_ra_op (R1:(A)ra) (R2:(B)ra)`, + `prod_ra_valid (R1:(A)ra) (R2:(B)ra)`), + RA_UNIT_ABS), + laws); + computed = pure_once_rewrite_rule( + THM_LIST(gsym_rule(prod_ra_def)), + computed); + computed = gen_rule(R2, computed); + return gen_rule(R1, computed); +} + +PROOF thm PROD_RA_UNIT = prove_prod_ra_unit(); + +PROOF static thm prove_prod_ra_op_fn(void) { + term R1 = `R1:(A)ra`; + term R2 = `R2:(B)ra`; + thm laws = ispecl_rule(TERM_LIST(R1, R2), PROD_RA_LAWS); + thm computed = mp_rule( + ispecl_rule( + TERM_LIST( + `(ra_unit (R1:(A)ra),ra_unit (R2:(B)ra))`, + `prod_ra_op (R1:(A)ra) (R2:(B)ra)`, + `prod_ra_valid (R1:(A)ra) (R2:(B)ra)`), + RA_OP_ABS), + laws); + computed = pure_once_rewrite_rule( + THM_LIST(gsym_rule(prod_ra_def)), + computed); + computed = gen_rule(R2, computed); + return gen_rule(R1, computed); +} + +PROOF static thm PROD_RA_OP_FN = prove_prod_ra_op_fn(); + +PROOF static thm prove_prod_ra_valid_fn(void) { + term R1 = `R1:(A)ra`; + term R2 = `R2:(B)ra`; + thm laws = ispecl_rule(TERM_LIST(R1, R2), PROD_RA_LAWS); + thm computed = mp_rule( + ispecl_rule( + TERM_LIST( + `(ra_unit (R1:(A)ra),ra_unit (R2:(B)ra))`, + `prod_ra_op (R1:(A)ra) (R2:(B)ra)`, + `prod_ra_valid (R1:(A)ra) (R2:(B)ra)`), + RA_VALID_ABS), + laws); + computed = pure_once_rewrite_rule( + THM_LIST(gsym_rule(prod_ra_def)), + computed); + computed = gen_rule(R2, computed); + return gen_rule(R1, computed); +} + +PROOF static thm PROD_RA_VALID_FN = prove_prod_ra_valid_fn(); + +PROOF static thm prove_prod_ra_op(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) (x:A#B) (y:A#B). + ra_op (prod_ra R1 R2) x y == + (ra_op R1 (FST x) (FST y), + ra_op R2 (SND x) (SND y)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + PROD_RA_OP_FN, + prod_ra_op_def))); + return gnode_prove(root); +} + +PROOF thm PROD_RA_OP = prove_prod_ra_op(); + +PROOF static thm prove_prod_ra_valid(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) (x:A#B). + ra_valid (prod_ra R1 R2) x <=> + ra_valid R1 (FST x) && ra_valid R2 (SND x) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + PROD_RA_VALID_FN, + prod_ra_valid_def))); + return gnode_prove(root); +} + +PROOF thm PROD_RA_VALID = prove_prod_ra_valid(); + +/* + * A product is included in another product exactly when both projections are + * included. The forward direction projects the single product frame; the + * reverse direction pairs the two component frames and reconstructs the + * arbitrary target with pair eta. + */ +PROOF static thm prove_prod_ra_included(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) (x:A#B) (y:A#B). + ra_included (prod_ra R1 R2) x y <=> + ra_included R1 (FST x) (FST y) && + ra_included R2 (SND x) (SND y) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(ra_included_def))); + body = AUTO_INTROS_TAC(body); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hincluded"); + forward = ASMP_EXISTS_TAC(forward, "Hincluded", "frame"); + thm product_extension = assume_rule(` + (y:A#B) == + ra_op + (prod_ra (R1:(A)ra) (R2:(B)ra)) + (x:A#B) + (frame:A#B) + `); + thm product_op = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `x:A#B`, + `frame:A#B`), + PROD_RA_OP); + thm fst_extension = ap_term_rule( + `FST:(A#B)->A`, + product_extension); + fst_extension = pure_rewrite_rule( + THM_LIST( + product_op, + get_theorem_by_name("FST")), + fst_extension); + thm snd_extension = ap_term_rule( + `SND:(A#B)->B`, + product_extension); + snd_extension = pure_rewrite_rule( + THM_LIST( + product_op, + get_theorem_by_name("SND")), + snd_extension); + + gnode_list forward_components = CONJ_TAC(forward); + gnode left = EXISTS_TAC( + forward_components[0], + `FST (frame:A#B)`); + ACCEPT_TAC(left, fst_extension); + gnode right = EXISTS_TAC( + forward_components[1], + `SND (frame:A#B)`); + ACCEPT_TAC(right, snd_extension); + + gnode reverse = DISCH_TAC(directions[1], "Hcomponents"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hcomponents", + "Hleft", + "Hright"); + reverse = ASMP_EXISTS_TAC(reverse, "Hleft", "left_frame"); + reverse = ASMP_EXISTS_TAC(reverse, "Hright", "right_frame"); + reverse = EXISTS_TAC( + reverse, + `((left_frame:A),(right_frame:B))`); + + thm component_extensions = conj_rule( + assume_rule(` + FST (y:A#B) == + ra_op (R1:(A)ra) (FST (x:A#B)) (left_frame:A) + `), + assume_rule(` + SND (y:A#B) == + ra_op (R2:(B)ra) (SND (x:A#B)) (right_frame:B) + `)); + thm pair_equivalence = ispecl_rule( + TERM_LIST( + `FST (y:A#B)`, + `SND (y:A#B)`, + `ra_op (R1:(A)ra) (FST (x:A#B)) (left_frame:A)`, + `ra_op (R2:(B)ra) (SND (x:A#B)) (right_frame:B)`), + get_theorem_by_name("PAIR_EQ")); + thm projected_target = eq_mp_rule( + gsym_rule(pair_equivalence), + component_extensions); + thm target_eta = ispec_rule( + `y:A#B`, + get_theorem_by_name("PAIR")); + thm target_as_pair = trans_rule( + gsym_rule(target_eta), + projected_target); + + thm paired_product_op = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `x:A#B`, + `((left_frame:A),(right_frame:B))`), + PROD_RA_OP); + paired_product_op = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + paired_product_op); + ACCEPT_TAC( + reverse, + trans_rule(target_as_pair, gsym_rule(paired_product_op))); + return gnode_prove(root); +} + +PROOF thm PROD_RA_INCLUDED = prove_prod_ra_included(); + +/* + * Component cancellativity lifts to products. Product validity is + * specialized at the source composition, and product equality is first + * normalized to an explicit pair equality before PAIR_EQ is applied once. + */ +PROOF static thm prove_prod_ra_cancellative(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra). + ra_cancellative R1 ==> + ra_cancellative R2 ==> + ra_cancellative (prod_ra R1 R2) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R1"); + body = GEN_TAC(body, "R2"); + body = DISCH_TAC(body, "Hcancel_left"); + body = DISCH_TAC(body, "Hcancel_right"); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_cancellative_def))); + body = GEN_TAC(body, "frame"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "b"); + body = DISCH_TAC(body, "Hsource_valid"); + body = DISCH_TAC(body, "Hops_equal"); + + thm source_valid_rule = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `ra_op + (prod_ra (R1:(A)ra) (R2:(B)ra)) + (frame:A#B) + (a:A#B)`), + PROD_RA_VALID); + thm source_components = eq_mp_rule( + source_valid_rule, + assume_rule(` + ra_valid + (prod_ra (R1:(A)ra) (R2:(B)ra)) + (ra_op + (prod_ra R1 R2) + (frame:A#B) + (a:A#B)) + `)); + thm source_op = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `frame:A#B`, + `a:A#B`), + PROD_RA_OP); + source_components = pure_rewrite_rule( + THM_LIST( + source_op, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + source_components); + + thm target_op = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `frame:A#B`, + `b:A#B`), + PROD_RA_OP); + thm product_ops_equal = pure_rewrite_rule( + THM_LIST(source_op, target_op), + assume_rule(` + ra_op + (prod_ra (R1:(A)ra) (R2:(B)ra)) + (frame:A#B) + (a:A#B) == + ra_op + (prod_ra R1 R2) + frame + (b:A#B) + `)); + thm operation_pair_equivalence = ispecl_rule( + TERM_LIST( + `ra_op (R1:(A)ra) (FST (frame:A#B)) (FST (a:A#B))`, + `ra_op (R2:(B)ra) (SND (frame:A#B)) (SND (a:A#B))`, + `ra_op (R1:(A)ra) (FST (frame:A#B)) (FST (b:A#B))`, + `ra_op (R2:(B)ra) (SND (frame:A#B)) (SND (b:A#B))`), + get_theorem_by_name("PAIR_EQ")); + thm operation_components = eq_mp_rule( + operation_pair_equivalence, + product_ops_equal); + + thm left_equal = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `FST (frame:A#B)`, + `FST (a:A#B)`, + `FST (b:A#B)`), + RA_CANCELLATIVE_APPLY); + left_equal = mp_rule( + left_equal, + assume_rule(`ra_cancellative (R1:(A)ra)`)); + left_equal = mp_rule( + left_equal, + conjunct1_rule(source_components)); + left_equal = mp_rule( + left_equal, + conjunct1_rule(operation_components)); + + thm right_equal = ispecl_rule( + TERM_LIST( + `R2:(B)ra`, + `SND (frame:A#B)`, + `SND (a:A#B)`, + `SND (b:A#B)`), + RA_CANCELLATIVE_APPLY); + right_equal = mp_rule( + right_equal, + assume_rule(`ra_cancellative (R2:(B)ra)`)); + right_equal = mp_rule( + right_equal, + conjunct2_rule(source_components)); + right_equal = mp_rule( + right_equal, + conjunct2_rule(operation_components)); + + thm target_pair_equivalence = ispecl_rule( + TERM_LIST( + `FST (a:A#B)`, + `SND (a:A#B)`, + `FST (b:A#B)`, + `SND (b:A#B)`), + get_theorem_by_name("PAIR_EQ")); + thm projected_equal = eq_mp_rule( + gsym_rule(target_pair_equivalence), + conj_rule(left_equal, right_equal)); + thm source_eta = ispec_rule( + `a:A#B`, + get_theorem_by_name("PAIR")); + thm target_eta = ispec_rule( + `b:A#B`, + get_theorem_by_name("PAIR")); + ACCEPT_TAC( + body, + trans_rule( + gsym_rule(source_eta), + trans_rule(projected_equal, target_eta))); + return gnode_prove(root); +} + +PROOF thm PROD_RA_CANCELLATIVE = prove_prod_ra_cancellative(); + +/* + * Select one result from each component update at the corresponding + * component of an arbitrary product frame. The result predicate is kept as + * an exact existential pair, rather than weakened to projections of an + * otherwise unconstrained product value. + */ +PROOF static thm prove_prod_ra_update_nd(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) + (a1:A) (a2:B) (P1:A->bool) (P2:B->bool). + ra_update_nd R1 a1 P1 ==> + ra_update_nd R2 a2 P2 ==> + ra_update_nd + (prod_ra R1 R2) + (a1,a2) + (\x:A#B. + exists b1:A. exists b2:B. + P1 b1 && P2 b2 && x == (b1,b2)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = AUTO_INTROS_TAC(body); + + thm source_valid = assume_rule(` + ra_valid + (prod_ra (R1:(A)ra) (R2:(B)ra)) + (ra_op + (prod_ra R1 R2) + ((a1:A),(a2:B)) + (frame:A#B)) + `); + thm source_valid_rule = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `ra_op + (prod_ra (R1:(A)ra) (R2:(B)ra)) + ((a1:A),(a2:B)) + (frame:A#B)`), + PROD_RA_VALID); + thm source_components = eq_mp_rule(source_valid_rule, source_valid); + thm source_op = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `((a1:A),(a2:B))`, + `frame:A#B`), + PROD_RA_OP); + source_components = pure_rewrite_rule( + THM_LIST( + source_op, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + source_components); + + thm left_update = pure_once_rewrite_rule( + THM_LIST(ra_update_nd_def), + assume_rule(` + ra_update_nd (R1:(A)ra) (a1:A) (P1:A->bool) + `)); + thm left_selected = mp_rule( + spec_rule(`FST (frame:A#B)`, left_update), + conjunct1_rule(source_components)); + body = ASSUME_TAC(body, left_selected, "Hleft_selected"); + body = ASMP_EXISTS_TAC(body, "Hleft_selected", "b1"); + body = ASMP_CONJ_TAC( + body, + "Hleft_selected", + "HP1_b1", + "Hb1_valid"); + + thm right_update = pure_once_rewrite_rule( + THM_LIST(ra_update_nd_def), + assume_rule(` + ra_update_nd (R2:(B)ra) (a2:B) (P2:B->bool) + `)); + thm right_selected = mp_rule( + spec_rule(`SND (frame:A#B)`, right_update), + conjunct2_rule(source_components)); + body = ASSUME_TAC(body, right_selected, "Hright_selected"); + body = ASMP_EXISTS_TAC(body, "Hright_selected", "b2"); + body = ASMP_CONJ_TAC( + body, + "Hright_selected", + "HP2_b2", + "Hb2_valid"); + + body = EXISTS_TAC(body, `((b1:A),(b2:B))`); + gnode_list result_parts = CONJ_TAC(body); + + gnode predicate = EXISTS_TAC(result_parts[0], `b1:A`); + predicate = EXISTS_TAC(predicate, `b2:B`); + gnode_list predicate_left = CONJ_TAC(predicate); + ACCEPT_TAC( + predicate_left[0], + assume_rule(`(P1:A->bool) (b1:A)`)); + gnode_list predicate_right = CONJ_TAC(predicate_left[1]); + ACCEPT_TAC( + predicate_right[0], + assume_rule(`(P2:B->bool) (b2:B)`)); + ACCEPT_TAC( + predicate_right[1], + refl_rule(`((b1:A),(b2:B))`)); + + thm result_valid_rule = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `ra_op + (prod_ra (R1:(A)ra) (R2:(B)ra)) + ((b1:A),(b2:B)) + (frame:A#B)`), + PROD_RA_VALID); + thm result_op = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `((b1:A),(b2:B))`, + `frame:A#B`), + PROD_RA_OP); + result_op = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + result_op); + thm result_fst = ap_term_rule( + `FST:(A#B)->A`, + result_op); + result_fst = pure_once_rewrite_rule( + THM_LIST(get_theorem_by_name("FST")), + result_fst); + thm result_snd = ap_term_rule( + `SND:(A#B)->B`, + result_op); + result_snd = pure_once_rewrite_rule( + THM_LIST(get_theorem_by_name("SND")), + result_snd); + thm result_fst_valid = ap_term_rule( + `ra_valid (R1:(A)ra):A->bool`, + result_fst); + thm result_snd_valid = ap_term_rule( + `ra_valid (R2:(B)ra):B->bool`, + result_snd); + thm result_components = conj_rule( + eq_mp_rule( + gsym_rule(result_fst_valid), + assume_rule(` + ra_valid + (R1:(A)ra) + (ra_op R1 (b1:A) (FST (frame:A#B))) + `)), + eq_mp_rule( + gsym_rule(result_snd_valid), + assume_rule(` + ra_valid + (R2:(B)ra) + (ra_op R2 (b2:B) (SND (frame:A#B))) + `))); + ACCEPT_TAC( + result_parts[1], + eq_mp_rule(gsym_rule(result_valid_rule), result_components)); + return gnode_prove(root); +} + +PROOF thm PROD_RA_UPDATE_ND = prove_prod_ra_update_nd(); + +/* Deterministic component updates preserve every product frame pointwise. */ +PROOF static thm prove_prod_ra_update(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) + (a1:A) (a2:B) (b1:A) (b2:B). + ra_update R1 a1 b1 ==> + ra_update R2 a2 b2 ==> + ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_def))); + body = AUTO_INTROS_TAC(body); + + thm source_valid = assume_rule(` + ra_valid + (prod_ra (R1:(A)ra) (R2:(B)ra)) + (ra_op + (prod_ra R1 R2) + ((a1:A),(a2:B)) + (frame:A#B)) + `); + thm source_valid_rule = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `ra_op + (prod_ra (R1:(A)ra) (R2:(B)ra)) + ((a1:A),(a2:B)) + (frame:A#B)`), + PROD_RA_VALID); + thm source_components = eq_mp_rule(source_valid_rule, source_valid); + thm source_op = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `((a1:A),(a2:B))`, + `frame:A#B`), + PROD_RA_OP); + source_components = pure_rewrite_rule( + THM_LIST( + source_op, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + source_components); + + thm left_update = pure_once_rewrite_rule( + THM_LIST(ra_update_def), + assume_rule(`ra_update (R1:(A)ra) (a1:A) (b1:A)`)); + thm left_valid = mp_rule( + spec_rule(`FST (frame:A#B)`, left_update), + conjunct1_rule(source_components)); + thm right_update = pure_once_rewrite_rule( + THM_LIST(ra_update_def), + assume_rule(`ra_update (R2:(B)ra) (a2:B) (b2:B)`)); + thm right_valid = mp_rule( + spec_rule(`SND (frame:A#B)`, right_update), + conjunct2_rule(source_components)); + + thm result_valid_rule = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `ra_op + (prod_ra (R1:(A)ra) (R2:(B)ra)) + ((b1:A),(b2:B)) + (frame:A#B)`), + PROD_RA_VALID); + thm result_op = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `((b1:A),(b2:B))`, + `frame:A#B`), + PROD_RA_OP); + result_op = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + result_op); + thm result_fst = ap_term_rule( + `FST:(A#B)->A`, + result_op); + result_fst = pure_once_rewrite_rule( + THM_LIST(get_theorem_by_name("FST")), + result_fst); + thm result_snd = ap_term_rule( + `SND:(A#B)->B`, + result_op); + result_snd = pure_once_rewrite_rule( + THM_LIST(get_theorem_by_name("SND")), + result_snd); + thm result_fst_valid = ap_term_rule( + `ra_valid (R1:(A)ra):A->bool`, + result_fst); + thm result_snd_valid = ap_term_rule( + `ra_valid (R2:(B)ra):B->bool`, + result_snd); + ACCEPT_TAC( + body, + eq_mp_rule( + gsym_rule(result_valid_rule), + conj_rule( + eq_mp_rule(gsym_rule(result_fst_valid), left_valid), + eq_mp_rule(gsym_rule(result_snd_valid), right_valid)))); + return gnode_prove(root); +} + +PROOF thm PROD_RA_UPDATE = prove_prod_ra_update(); + +/* + * Update only the left component. The right component validity obtained + * from the source product is reused unchanged with the same projected frame. + */ +PROOF static thm prove_prod_ra_update_left_nd(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) + (a1:A) (a2:B) (P:A->bool). + ra_update_nd R1 a1 P ==> + ra_update_nd + (prod_ra R1 R2) + (a1,a2) + (\x:A#B. exists b1:A. P b1 && x == (b1,a2)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = AUTO_INTROS_TAC(body); + + thm source_valid_rule = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `ra_op + (prod_ra (R1:(A)ra) (R2:(B)ra)) + ((a1:A),(a2:B)) + (frame:A#B)`), + PROD_RA_VALID); + thm source_components = eq_mp_rule( + source_valid_rule, + assume_rule(` + ra_valid + (prod_ra (R1:(A)ra) (R2:(B)ra)) + (ra_op + (prod_ra R1 R2) + ((a1:A),(a2:B)) + (frame:A#B)) + `)); + thm source_op = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `((a1:A),(a2:B))`, + `frame:A#B`), + PROD_RA_OP); + source_components = pure_rewrite_rule( + THM_LIST( + source_op, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + source_components); + + thm left_update = pure_once_rewrite_rule( + THM_LIST(ra_update_nd_def), + assume_rule(` + ra_update_nd (R1:(A)ra) (a1:A) (P:A->bool) + `)); + thm selected = mp_rule( + spec_rule(`FST (frame:A#B)`, left_update), + conjunct1_rule(source_components)); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "b1"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "HP_b1", + "Hb1_valid"); + + body = EXISTS_TAC(body, `((b1:A),(a2:B))`); + gnode_list result_parts = CONJ_TAC(body); + gnode predicate = EXISTS_TAC(result_parts[0], `b1:A`); + gnode_list predicate_parts = CONJ_TAC(predicate); + ACCEPT_TAC( + predicate_parts[0], + assume_rule(`(P:A->bool) (b1:A)`)); + ACCEPT_TAC( + predicate_parts[1], + refl_rule(`((b1:A),(a2:B))`)); + + thm result_valid_rule = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `ra_op + (prod_ra (R1:(A)ra) (R2:(B)ra)) + ((b1:A),(a2:B)) + (frame:A#B)`), + PROD_RA_VALID); + thm result_op = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `((b1:A),(a2:B))`, + `frame:A#B`), + PROD_RA_OP); + result_op = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + result_op); + thm result_fst = ap_term_rule( + `FST:(A#B)->A`, + result_op); + result_fst = pure_once_rewrite_rule( + THM_LIST(get_theorem_by_name("FST")), + result_fst); + thm result_snd = ap_term_rule( + `SND:(A#B)->B`, + result_op); + result_snd = pure_once_rewrite_rule( + THM_LIST(get_theorem_by_name("SND")), + result_snd); + thm result_fst_valid = ap_term_rule( + `ra_valid (R1:(A)ra):A->bool`, + result_fst); + thm result_snd_valid = ap_term_rule( + `ra_valid (R2:(B)ra):B->bool`, + result_snd); + thm result_components = conj_rule( + eq_mp_rule( + gsym_rule(result_fst_valid), + assume_rule(` + ra_valid + (R1:(A)ra) + (ra_op R1 (b1:A) (FST (frame:A#B))) + `)), + eq_mp_rule( + gsym_rule(result_snd_valid), + conjunct2_rule(source_components))); + ACCEPT_TAC( + result_parts[1], + eq_mp_rule(gsym_rule(result_valid_rule), result_components)); + return gnode_prove(root); +} + +PROOF thm PROD_RA_UPDATE_LEFT_ND = prove_prod_ra_update_left_nd(); + +/* The deterministic one-sided rule is product update plus reflexivity. */ +PROOF static thm prove_prod_ra_update_left(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) + (a1:A) (a2:B) (b1:A). + ra_update R1 a1 b1 ==> + ra_update (prod_ra R1 R2) (a1,a2) (b1,a2) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm combined = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `a1:A`, + `a2:B`, + `b1:A`, + `a2:B`), + PROD_RA_UPDATE); + combined = mp_rule( + combined, + assume_rule(`ra_update (R1:(A)ra) (a1:A) (b1:A)`)); + combined = mp_rule( + combined, + ispecl_rule( + TERM_LIST(`R2:(B)ra`, `a2:B`), + RA_UPDATE_REFL)); + ACCEPT_TAC(body, combined); + return gnode_prove(root); +} + +PROOF thm PROD_RA_UPDATE_LEFT = prove_prod_ra_update_left(); + +/* Symmetric direct proof for an update confined to the right component. */ +PROOF static thm prove_prod_ra_update_right_nd(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) + (a1:A) (a2:B) (P:B->bool). + ra_update_nd R2 a2 P ==> + ra_update_nd + (prod_ra R1 R2) + (a1,a2) + (\x:A#B. exists b2:B. P b2 && x == (a1,b2)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = AUTO_INTROS_TAC(body); + + thm source_valid_rule = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `ra_op + (prod_ra (R1:(A)ra) (R2:(B)ra)) + ((a1:A),(a2:B)) + (frame:A#B)`), + PROD_RA_VALID); + thm source_components = eq_mp_rule( + source_valid_rule, + assume_rule(` + ra_valid + (prod_ra (R1:(A)ra) (R2:(B)ra)) + (ra_op + (prod_ra R1 R2) + ((a1:A),(a2:B)) + (frame:A#B)) + `)); + thm source_op = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `((a1:A),(a2:B))`, + `frame:A#B`), + PROD_RA_OP); + source_components = pure_rewrite_rule( + THM_LIST( + source_op, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + source_components); + + thm right_update = pure_once_rewrite_rule( + THM_LIST(ra_update_nd_def), + assume_rule(` + ra_update_nd (R2:(B)ra) (a2:B) (P:B->bool) + `)); + thm selected = mp_rule( + spec_rule(`SND (frame:A#B)`, right_update), + conjunct2_rule(source_components)); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "b2"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "HP_b2", + "Hb2_valid"); + + body = EXISTS_TAC(body, `((a1:A),(b2:B))`); + gnode_list result_parts = CONJ_TAC(body); + gnode predicate = EXISTS_TAC(result_parts[0], `b2:B`); + gnode_list predicate_parts = CONJ_TAC(predicate); + ACCEPT_TAC( + predicate_parts[0], + assume_rule(`(P:B->bool) (b2:B)`)); + ACCEPT_TAC( + predicate_parts[1], + refl_rule(`((a1:A),(b2:B))`)); + + thm result_valid_rule = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `ra_op + (prod_ra (R1:(A)ra) (R2:(B)ra)) + ((a1:A),(b2:B)) + (frame:A#B)`), + PROD_RA_VALID); + thm result_op = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `((a1:A),(b2:B))`, + `frame:A#B`), + PROD_RA_OP); + result_op = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + result_op); + thm result_fst = ap_term_rule( + `FST:(A#B)->A`, + result_op); + result_fst = pure_once_rewrite_rule( + THM_LIST(get_theorem_by_name("FST")), + result_fst); + thm result_snd = ap_term_rule( + `SND:(A#B)->B`, + result_op); + result_snd = pure_once_rewrite_rule( + THM_LIST(get_theorem_by_name("SND")), + result_snd); + thm result_fst_valid = ap_term_rule( + `ra_valid (R1:(A)ra):A->bool`, + result_fst); + thm result_snd_valid = ap_term_rule( + `ra_valid (R2:(B)ra):B->bool`, + result_snd); + thm result_components = conj_rule( + eq_mp_rule( + gsym_rule(result_fst_valid), + conjunct1_rule(source_components)), + eq_mp_rule( + gsym_rule(result_snd_valid), + assume_rule(` + ra_valid + (R2:(B)ra) + (ra_op R2 (b2:B) (SND (frame:A#B))) + `))); + ACCEPT_TAC( + result_parts[1], + eq_mp_rule(gsym_rule(result_valid_rule), result_components)); + return gnode_prove(root); +} + +PROOF thm PROD_RA_UPDATE_RIGHT_ND = prove_prod_ra_update_right_nd(); + +/* The deterministic right-only rule is product update plus reflexivity. */ +PROOF static thm prove_prod_ra_update_right(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) + (a1:A) (a2:B) (b2:B). + ra_update R2 a2 b2 ==> + ra_update (prod_ra R1 R2) (a1,a2) (a1,b2) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm combined = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `a1:A`, + `a2:B`, + `a1:A`, + `b2:B`), + PROD_RA_UPDATE); + combined = mp_rule( + combined, + ispecl_rule( + TERM_LIST(`R1:(A)ra`, `a1:A`), + RA_UPDATE_REFL)); + combined = mp_rule( + combined, + assume_rule(`ra_update (R2:(B)ra) (a2:B) (b2:B)`)); + ACCEPT_TAC(body, combined); + return gnode_prove(root); +} + +PROOF thm PROD_RA_UPDATE_RIGHT = prove_prod_ra_update_right(); + +PROOF static int audit_prod_ra(void) { + thm_list source_theorems = THM_LIST( + prod_ra_op_def, + prod_ra_valid_def, + PROD_RA_LAWS, + prod_ra_def, + PROD_RA_UNIT, + PROD_RA_OP_FN, + PROD_RA_VALID_FN, + PROD_RA_OP, + PROD_RA_VALID, + PROD_RA_INCLUDED, + PROD_RA_CANCELLATIVE, + PROD_RA_UPDATE_ND, + PROD_RA_UPDATE, + PROD_RA_UPDATE_LEFT_ND, + PROD_RA_UPDATE_LEFT, + PROD_RA_UPDATE_RIGHT_ND, + PROD_RA_UPDATE_RIGHT); + + for (size_t i = 0; i < vector_size(source_theorems); ++i) { + ENSURE_COND(!IS_NULL(source_theorems[i]), + "product RA theorem %zu is empty", i); + ENSURE_COND(vector_size(hyp(source_theorems[i])) == 0, + "product RA theorem %zu has hypotheses", i); + } + ENSURE_COND(vector_size(get_all_axioms()) == PROD_RA_AXIOMS_BEFORE, + "product RA introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_prod_ra"); + return -1; +} + +PROOF static int _PROD_RA_AUDIT = audit_prod_ra(); diff --git a/theory/logic/prod_ra.h b/theory/logic/prod_ra.h new file mode 100644 index 0000000..7234741 --- /dev/null +++ b/theory/logic/prod_ra.h @@ -0,0 +1,135 @@ +#pragma once + +/* + * Binary product resource algebras: public client API. + * + * For `R1=(|R1|,ε_R1,·_R1,valid_R1)` with `|R1|=A` and + * `R2=(|R2|,ε_R2,·_R2,valid_R2)` with `|R2|=B`, + * `prod_ra R1 R2 : (A#B)ra` has carrier `A#B`, unit `(ε_R1,ε_R2)`, + * pointwise operation, and conjunctive + * validity. + * The raw descriptor, its law proof, and the abstraction projection equations + * are implementation details. Clients should use only the direct rules below. + */ + +#include "proof/theory/logic/ra.h" + +/* ------------------------------------------------------------------------- */ +/* Core representation */ +/* ------------------------------------------------------------------------- */ + +/* + * Product unit: + * + * ra_unit (prod_ra R1 R2) == (ra_unit R1, ra_unit R2) + */ +PROOF extern thm PROD_RA_UNIT; + +/* + * Pointwise composition: + * + * ra_op (prod_ra R1 R2) x y == + * (ra_op R1 (FST x) (FST y), + * ra_op R2 (SND x) (SND y)) + */ +PROOF extern thm PROD_RA_OP; + +/* + * Componentwise validity: + * + * ra_valid (prod_ra R1 R2) x <=> + * ra_valid R1 (FST x) && ra_valid R2 (SND x) + */ +PROOF extern thm PROD_RA_VALID; + +/* ------------------------------------------------------------------------- */ +/* Order and optional laws */ +/* ------------------------------------------------------------------------- */ + +/* + * Inclusion is componentwise: + * + * forall (R1:(A)ra) (R2:(B)ra) (x:A#B) (y:A#B). + * ra_included (prod_ra R1 R2) x y <=> + * ra_included R1 (FST x) (FST y) && + * ra_included R2 (SND x) (SND y) + * + * Each direction preserves the exact extension frame: a product frame + * projects to the two component frames, and two component frames combine + * into exactly their pair. + */ +PROOF extern thm PROD_RA_INCLUDED; + +/* + * Cancellativity lifts componentwise: + * + * forall (R1:(A)ra) (R2:(B)ra). + * ra_cancellative R1 ==> + * ra_cancellative R2 ==> + * ra_cancellative (prod_ra R1 R2) + * + * As in the generic definition, only the source composition is required to + * be valid; product validity supplies exactly the two component premises. + */ +PROOF extern thm PROD_RA_CANCELLATIVE; + +/* ------------------------------------------------------------------------- */ +/* Product updates */ +/* ------------------------------------------------------------------------- */ + +/* + * Independent nondeterministic updates combine: + * + * ra_update_nd R1 a1 P1 ==> + * ra_update_nd R2 a2 P2 ==> + * ra_update_nd (prod_ra R1 R2) (a1,a2) + * (\x. exists b1 b2. + * P1 b1 && P2 b2 && x == (b1,b2)) + * + * The existential predicate describes exactly the pairs selected by the two + * component updates; it does not admit unrelated product values. + */ +PROOF extern thm PROD_RA_UPDATE_ND; + +/* + * Independent deterministic updates combine: + * + * ra_update R1 a1 b1 ==> + * ra_update R2 a2 b2 ==> + * ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) + */ +PROOF extern thm PROD_RA_UPDATE; + +/* + * A nondeterministic update of the left component preserves the right one: + * + * ra_update_nd R1 a1 P ==> + * ra_update_nd (prod_ra R1 R2) (a1,a2) + * (\x. exists b1. P b1 && x == (b1,a2)) + */ +PROOF extern thm PROD_RA_UPDATE_LEFT_ND; + +/* + * A deterministic update of the left component preserves the right one: + * + * ra_update R1 a1 b1 ==> + * ra_update (prod_ra R1 R2) (a1,a2) (b1,a2) + */ +PROOF extern thm PROD_RA_UPDATE_LEFT; + +/* + * A nondeterministic update of the right component preserves the left one: + * + * ra_update_nd R2 a2 P ==> + * ra_update_nd (prod_ra R1 R2) (a1,a2) + * (\x. exists b2. P b2 && x == (a1,b2)) + */ +PROOF extern thm PROD_RA_UPDATE_RIGHT_ND; + +/* + * A deterministic update of the right component preserves the left one: + * + * ra_update R2 a2 b2 ==> + * ra_update (prod_ra R1 R2) (a1,a2) (a1,b2) + */ +PROOF extern thm PROD_RA_UPDATE_RIGHT; -- Gitee From 1d2e915a75ed30f3c7b6c5caff1cb3a47ba6f010 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Wed, 29 Jul 2026 04:15:49 +0800 Subject: [PATCH 03/35] feat(logic): add authoritative resource algebra --- theory/logic/auth_ra.c | 1420 ++++++++++++++++++++++++++++++++++++++++ theory/logic/auth_ra.h | 227 +++++++ 2 files changed, 1647 insertions(+) create mode 100644 theory/logic/auth_ra.c create mode 100644 theory/logic/auth_ra.h diff --git a/theory/logic/auth_ra.c b/theory/logic/auth_ra.c new file mode 100644 index 0000000..e14f87c --- /dev/null +++ b/theory/logic/auth_ra.c @@ -0,0 +1,1420 @@ +#include "proof/theory/logic/auth_ra.h" +#include "proof/theory/logic/excl_ra_internal.h" +#include "proof/theory/logic/prod_ra.h" +#include "proof/theory/logic/ra_builder.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/excl_ra.c" +#require "proof/theory/logic/prod_ra.c" + +PROOF static size_t AUTH_RA_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF static thm auth_op_def = new_fun_definition(` + auth_op + (R:(A)ra) + (x:(A)excl#A) + (y:(A)excl#A) : (A)excl#A = + ra_op + (prod_ra (excl_ra:((A)excl)ra) R) + x + y +`); + +PROOF static thm auth_valid_at_def = new_rec_definition( + excl_type.rec, + ` + (auth_valid_at + (R:(A)ra) + (ExclUnit:(A)excl) + (fragment:A) <=> + ra_valid R fragment) && + (auth_valid_at + (R:(A)ra) + (Excl authoritative) + (fragment:A) <=> + ra_valid R authoritative && + ra_included R fragment authoritative) && + (auth_valid_at + (R:(A)ra) + (ExclInvalid:(A)excl) + (fragment:A) <=> + F) + `); + +PROOF static thm auth_valid_def = new_fun_definition(` + auth_valid + (R:(A)ra) + (x:(A)excl#A) <=> + auth_valid_at R (FST x) (SND x) +`); + +/* Hidden constructor equations. The constants are public logical syntax; + * clients use the abstract computation rules from auth_ra.h rather than + * unfolding these representation equations. */ +PROOF static thm auth_auth_def = new_fun_definition(` + auth_auth + (R:(A)ra) + (authoritative:A) : (A)excl#A = + (Excl authoritative,ra_unit R) +`); + +PROOF static thm auth_frag_def = new_fun_definition(` + auth_frag (fragment:A) : (A)excl#A = + (ExclUnit,fragment) +`); + +PROOF static thm auth_both_def = new_fun_definition(` + auth_both + (authoritative:A) + (fragment:A) : (A)excl#A = + (Excl authoritative,fragment) +`); + +PROOF static conv auth_reduce_conv(thm_list local_theorems) { + thm_list rules = vector_concat(THM_LIST( + auth_op_def, + auth_valid_def, + auth_valid_at_def, + PROD_RA_OP, + EXCL_RA_OP_FN, + excl_op_def, + excl_owned_op_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + local_theorems); + return rewrite_conv(rules); +} + +PROOF static thm prove_auth_ra_laws(void) { + term goal_tm = ` + forall R:(A)ra. + ra_laws + ((ExclUnit:(A)excl),ra_unit R) + (auth_op R) + (auth_valid R) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode unfolded = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_laws_def))); + + term product = ` + prod_ra (excl_ra:((A)excl)ra) (R:(A)ra) + `; + + gnode_list law1 = CONJ_TAC(unfolded); + gnode assoc = AUTO_INTROS_TAC(law1[0]); + assoc = CONV_TAC( + assoc, + pure_rewrite_conv(THM_LIST(auth_op_def))); + ACCEPT_TAC( + assoc, + ispecl_rule( + TERM_LIST( + product, + `a:(A)excl#A`, + `b:(A)excl#A`, + `c:(A)excl#A`), + RA_ASSOC)); + + gnode_list law2 = CONJ_TAC(law1[1]); + gnode comm = AUTO_INTROS_TAC(law2[0]); + comm = CONV_TAC( + comm, + pure_rewrite_conv(THM_LIST(auth_op_def))); + ACCEPT_TAC( + comm, + ispecl_rule( + TERM_LIST( + product, + `a:(A)excl#A`, + `b:(A)excl#A`), + RA_COMM)); + + gnode_list law3 = CONJ_TAC(law2[1]); + gnode unit = AUTO_INTROS_TAC(law3[0]); + unit = CONV_TAC( + unit, + pure_rewrite_conv(THM_LIST(auth_op_def))); + thm product_unit = ispecl_rule( + TERM_LIST( + `excl_ra:((A)excl)ra`, + `R:(A)ra`), + PROD_RA_UNIT); + product_unit = pure_once_rewrite_rule( + THM_LIST(EXCL_RA_UNIT), + product_unit); + unit = CONV_TAC( + unit, + once_rewrite_conv(THM_LIST(gsym_rule(product_unit)))); + ACCEPT_TAC( + unit, + ispecl_rule( + TERM_LIST(product, `a:(A)excl#A`), + RA_UNIT_L)); + + gnode_list law4 = CONJ_TAC(law3[1]); + CONV_TAC( + law4[0], + rewrite_conv(THM_LIST( + auth_valid_def, + auth_valid_at_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + RA_VALID_UNIT))); + + gnode valid_down = GEN_TAC(law4[1], "x"); + valid_down = GEN_TAC(valid_down, "y"); + gnode_list x_tags = CASES_TAC( + valid_down, + `FST (x:(A)excl#A)`, + NULL); + for (size_t i = 0; i < vector_size(x_tags); ++i) { + gnode_list y_tags = CASES_TAC( + x_tags[i], + `FST (y:(A)excl#A)`, + NULL); + for (size_t j = 0; j < vector_size(y_tags); ++j) { + if (i == 0 && j == 0) { + gnode reduced = CONV_WITH_ASMP_TAC( + y_tags[j], + auth_reduce_conv, + THM_LIST()); + reduced = DISCH_TAC(reduced, "Hvalid_product"); + thm valid_left = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `SND (x:(A)excl#A)`, + `SND (y:(A)excl#A)`), + RA_VALID_OP_L), + assume_rule(` + ra_valid (R:(A)ra) + (ra_op R + (SND (x:(A)excl#A)) + (SND (y:(A)excl#A))) + `)); + ACCEPT_TAC(reduced, valid_left); + } else if (i == 0 && j == 1) { + gnode reduced = CONV_WITH_ASMP_TAC( + y_tags[j], + auth_reduce_conv, + THM_LIST()); + reduced = DISCH_TAC(reduced, "Hvalid_combined"); + reduced = ASMP_CONJ_TAC( + reduced, + "Hvalid_combined", + "Hvalid_authoritative", + "Hincluded_product"); + + term_list premises = gnode_get_asmps( + reduced, + CONST_STRING_LIST( + "Hincluded_product", + "Hvalid_authoritative")); + thm valid_product = match_mp_rule( + match_mp_rule( + RA_INCLUDED_VALID, + assume_rule(premises[0])), + assume_rule(premises[1])); + thm valid_left = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `SND (x:(A)excl#A)`, + `SND (y:(A)excl#A)`), + RA_VALID_OP_L), + valid_product); + ACCEPT_TAC(reduced, valid_left); + } else if (i == 1 && j == 0) { + gnode reduced = CONV_WITH_ASMP_TAC( + y_tags[j], + auth_reduce_conv, + THM_LIST()); + reduced = DISCH_TAC(reduced, "Hvalid_combined"); + reduced = ASMP_CONJ_TAC( + reduced, + "Hvalid_combined", + "Hvalid_authoritative", + "Hincluded_product"); + gnode_list result = CONJ_TAC(reduced); + ACCEPT_TAC( + result[0], + assume_rule(gnode_get_asmps( + result[0], + CONST_STRING_LIST( + "Hvalid_authoritative"))[0])); + + thm left_in_product = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `SND (x:(A)excl#A)`, + `SND (y:(A)excl#A)`), + RA_INCLUDED_OP_L); + thm left_in_authoritative = match_mp_rule( + match_mp_rule( + RA_INCLUDED_TRANS, + left_in_product), + assume_rule(gnode_get_asmps( + result[1], + CONST_STRING_LIST( + "Hincluded_product"))[0])); + ACCEPT_TAC(result[1], left_in_authoritative); + } else { + CONV_WITH_ASMP_TAC( + y_tags[j], + auth_reduce_conv, + THM_LIST()); + } + } + } + return gnode_prove(root); +} + +PROOF static thm AUTH_RA_LAWS = + prove_auth_ra_laws(); + +PROOF static thm auth_ra_def = new_fun_definition(` + auth_ra (R:(A)ra) : ((A)excl#A)ra = + ra_abs + (((ExclUnit:(A)excl),ra_unit R), + (auth_op R: + ((A)excl#A)->((A)excl#A)->((A)excl#A), + auth_valid R:((A)excl#A)->bool)) +`); + +PROOF static thm prove_auth_ra_unit(void) { + term R = `R:(A)ra`; + term unit = `((ExclUnit:(A)excl),ra_unit (R:(A)ra))`; + term op = ` + auth_op (R:(A)ra): + ((A)excl#A)->((A)excl#A)->((A)excl#A) + `; + term valid = ` + auth_valid (R:(A)ra):((A)excl#A)->bool + `; + thm laws = ispec_rule(R, AUTH_RA_LAWS); + thm computed = mp_rule( + ispecl_rule( + TERM_LIST(unit, op, valid), + RA_UNIT_ABS), + laws); + computed = pure_once_rewrite_rule( + THM_LIST(gsym_rule(auth_ra_def)), + computed); + computed = pure_once_rewrite_rule( + THM_LIST(gsym_rule(auth_frag_def)), + computed); + return gen_rule(R, computed); +} + +PROOF thm AUTH_RA_UNIT = + prove_auth_ra_unit(); + +PROOF static thm prove_auth_ra_op(void) { + term R = `R:(A)ra`; + term unit = `((ExclUnit:(A)excl),ra_unit (R:(A)ra))`; + term op = ` + auth_op (R:(A)ra): + ((A)excl#A)->((A)excl#A)->((A)excl#A) + `; + term valid = ` + auth_valid (R:(A)ra):((A)excl#A)->bool + `; + thm laws = ispec_rule(R, AUTH_RA_LAWS); + thm computed = mp_rule( + ispecl_rule( + TERM_LIST(unit, op, valid), + RA_OP_ABS), + laws); + computed = pure_once_rewrite_rule( + THM_LIST(gsym_rule(auth_ra_def)), + computed); + return gen_rule(R, computed); +} + +PROOF static thm AUTH_RA_OP_FN = + prove_auth_ra_op(); + +PROOF static thm prove_auth_ra_valid(void) { + term R = `R:(A)ra`; + term unit = `((ExclUnit:(A)excl),ra_unit (R:(A)ra))`; + term op = ` + auth_op (R:(A)ra): + ((A)excl#A)->((A)excl#A)->((A)excl#A) + `; + term valid = ` + auth_valid (R:(A)ra):((A)excl#A)->bool + `; + thm laws = ispec_rule(R, AUTH_RA_LAWS); + thm computed = mp_rule( + ispecl_rule( + TERM_LIST(unit, op, valid), + RA_VALID_ABS), + laws); + computed = pure_once_rewrite_rule( + THM_LIST(gsym_rule(auth_ra_def)), + computed); + return gen_rule(R, computed); +} + +PROOF static thm AUTH_RA_VALID_FN = + prove_auth_ra_valid(); + +PROOF static thm prove_auth_ra_op_components(void) { + term goal_tm = ` + forall + (R:(A)ra) + (x:(A)excl#A) + (y:(A)excl#A). + ra_op (auth_ra R) x y == + (excl_op (FST x) (FST y), + ra_op R (SND x) (SND y)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + AUTH_RA_OP_FN, + auth_op_def, + PROD_RA_OP, + EXCL_RA_OP_FN))); + return gnode_prove(root); +} + +PROOF static thm AUTH_RA_OP_COMPONENTS = + prove_auth_ra_op_components(); + +PROOF static thm prove_auth_ra_valid_components(void) { + term goal_tm = ` + forall + (R:(A)ra) + (x:(A)excl#A). + ra_valid (auth_ra R) x <=> + auth_valid_at R (FST x) (SND x) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + AUTH_RA_VALID_FN, + auth_valid_def))); + return gnode_prove(root); +} + +PROOF static thm AUTH_RA_VALID_COMPONENTS = + prove_auth_ra_valid_components(); + +/* The authoritative operation is the product operation used by its raw + * construction. Keep this bridge private: clients reason with the more + * useful constructor equations below. */ +PROOF static thm prove_auth_ra_op_as_product(void) { + term goal_tm = ` + forall + (R:(A)ra) + (x:(A)excl#A) + (y:(A)excl#A). + ra_op (auth_ra R) x y == + ra_op + (prod_ra (excl_ra:((A)excl)ra) R) + x + y + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + AUTH_RA_OP_COMPONENTS, + PROD_RA_OP, + EXCL_RA_OP_FN))); + return gnode_prove(root); +} + +PROOF static thm AUTH_RA_OP_AS_PRODUCT = + prove_auth_ra_op_as_product(); + +/* Authoritative validity is stronger than validity in the carrier product. + * In the owned case, fragment validity follows by downward closure from its + * inclusion in the valid authoritative value. */ +PROOF static thm prove_auth_ra_valid_imp_product_valid(void) { + term goal_tm = ` + forall (R:(A)ra) (x:(A)excl#A). + ra_valid (auth_ra R) x ==> + ra_valid + (prod_ra (excl_ra:((A)excl)ra) R) + x + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "x"); + body = DISCH_TAC(body, "Hauth_valid"); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(PROD_RA_VALID))); + gnode_list tag_cases = CASES_TAC( + body, `FST (x:(A)excl#A)`, "Htag"); + + for (size_t i = 0; i < vector_size(tag_cases); ++i) { + gnode branch = tag_cases[i]; + term tag_eq_tm = gnode_get_asmps( + branch, + CONST_STRING_LIST("Htag"))[0]; + thm tag_eq = assume_rule(tag_eq_tm); + thm auth_details = eq_mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `x:(A)excl#A`), + AUTH_RA_VALID_COMPONENTS), + assume_rule(` + ra_valid (auth_ra (R:(A)ra)) (x:(A)excl#A) + `)); + auth_details = rewrite_rule( + THM_LIST(tag_eq, auth_valid_at_def), + auth_details); + + if (i == 0) { + gnode_list result = CONJ_TAC(branch); + thm excl_valid = pure_once_rewrite_rule( + THM_LIST(gsym_rule(tag_eq)), + EXCL_RA_VALID_UNIT); + ACCEPT_TAC(result[0], excl_valid); + ACCEPT_TAC(result[1], auth_details); + } else if (i == 1) { + term owned = dest_comb(dest_eq(tag_eq_tm).tm2).tm2; + gnode_list result = CONJ_TAC(branch); + thm excl_valid = ispec_rule( + owned, + EXCL_RA_VALID_OWNED); + excl_valid = pure_once_rewrite_rule( + THM_LIST(gsym_rule(tag_eq)), + excl_valid); + ACCEPT_TAC(result[0], excl_valid); + + thm fragment_valid = match_mp_rule( + match_mp_rule( + RA_INCLUDED_VALID, + conjunct2_rule(auth_details)), + conjunct1_rule(auth_details)); + ACCEPT_TAC(result[1], fragment_valid); + } else { + CONTR_TAC(branch, auth_details); + } + } + return gnode_prove(root); +} + +PROOF static thm AUTH_RA_VALID_IMP_PRODUCT_VALID = + prove_auth_ra_valid_imp_product_valid(); + +PROOF static thm prove_auth_ra_auth_frag(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (fragment:A). + ra_op + (auth_ra R) + (auth_auth R a) + (auth_frag fragment) == + auth_both a fragment + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm unit_left = ispecl_rule( + TERM_LIST(`R:(A)ra`, `fragment:A`), + RA_UNIT_L); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + AUTH_RA_OP_COMPONENTS, + auth_auth_def, + auth_frag_def, + auth_both_def, + excl_op_def, + excl_owned_op_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + unit_left))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_AUTH_FRAG = + prove_auth_ra_auth_frag(); + +PROOF static thm prove_auth_ra_frag_frag(void) { + term goal_tm = ` + forall (R:(A)ra) (f:A) (g:A). + ra_op + (auth_ra R) + (auth_frag f) + (auth_frag g) == + auth_frag (ra_op R f g) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + AUTH_RA_OP_COMPONENTS, + auth_frag_def, + excl_op_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_FRAG_FRAG = + prove_auth_ra_frag_frag(); + +PROOF static thm prove_auth_ra_both_frag(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A) (g:A). + ra_op + (auth_ra R) + (auth_both a f) + (auth_frag g) == + auth_both a (ra_op R f g) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + AUTH_RA_OP_COMPONENTS, + auth_both_def, + auth_frag_def, + excl_op_def, + excl_owned_op_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_BOTH_FRAG = + prove_auth_ra_both_frag(); + +/* The combined constructor at the base unit is exactly authority-only. + * Derive this through the public composition and unit equations so the raw + * constructor representation remains private. */ +PROOF static thm prove_auth_ra_both_unit(void) { + term R = `R:(A)ra`; + term a = `a:A`; + thm composed = ispecl_rule( + TERM_LIST(R, a, `ra_unit (R:(A)ra)`), + AUTH_RA_AUTH_FRAG); + thm unit_equation = ispec_rule(R, AUTH_RA_UNIT); + thm replace_fragment = gsym_rule(beta_rule(ap_term_rule( + `\x:(A)excl#A. + ra_op + (auth_ra (R:(A)ra)) + (auth_auth R (a:A)) + x`, + unit_equation))); + thm remove_unit = ispecl_rule( + TERM_LIST( + `auth_ra (R:(A)ra)`, + `auth_auth R (a:A)`), + RA_UNIT_R); + thm result = trans_rule( + gsym_rule(composed), + trans_rule(replace_fragment, remove_unit)); + result = gen_rule(a, result); + return gen_rule(R, result); +} + +PROOF thm AUTH_RA_BOTH_UNIT = + prove_auth_ra_both_unit(); + +PROOF static thm prove_auth_ra_valid_frag(void) { + term goal_tm = ` + forall (R:(A)ra) (fragment:A). + ra_valid (auth_ra R) (auth_frag fragment) <=> + ra_valid R fragment + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + AUTH_RA_VALID_COMPONENTS, + auth_frag_def, + auth_valid_at_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_VALID_FRAG = + prove_auth_ra_valid_frag(); + +PROOF static thm prove_auth_ra_valid_both(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (fragment:A). + ra_valid (auth_ra R) (auth_both a fragment) <=> + ra_valid R a && + ra_included R fragment a + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + AUTH_RA_VALID_COMPONENTS, + auth_both_def, + auth_valid_at_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_VALID_BOTH = + prove_auth_ra_valid_both(); + +PROOF static thm prove_auth_ra_valid_auth(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A). + ra_valid (auth_ra R) (auth_auth R a) <=> + ra_valid R a + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm unit_included = ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + RA_INCLUDED_UNIT); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + AUTH_RA_VALID_COMPONENTS, + auth_auth_def, + auth_valid_at_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + unit_included))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_VALID_AUTH = + prove_auth_ra_valid_auth(); + +PROOF static thm prove_auth_ra_auth_conflict(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ~(ra_valid + (auth_ra R) + (ra_op + (auth_ra R) + (auth_auth R a) + (auth_auth R b))) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + AUTH_RA_OP_COMPONENTS, + AUTH_RA_VALID_COMPONENTS, + auth_auth_def, + auth_valid_at_def, + excl_op_def, + excl_owned_op_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_AUTH_CONFLICT = + prove_auth_ra_auth_conflict(); + +/* A valid frame for an authoritative owner cannot itself contain authority. + * The remaining SND component is exactly the external fragment observed by + * the general update rules below. */ +PROOF static thm prove_auth_ra_valid_both_frame(void) { + term goal_tm = ` + forall + (R:(A)ra) + (a:A) + (f:A) + (frame:(A)excl#A). + ra_valid + (auth_ra R) + (ra_op + (auth_ra R) + (auth_both a f) + frame) <=> + FST frame == (ExclUnit:(A)excl) && + ra_valid R a && + ra_included R (ra_op R f (SND frame)) a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list cases = CASES_TAC( + body, + `FST (frame:(A)excl#A)`, + NULL); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + auth_reduce_conv, + THM_LIST( + AUTH_RA_OP_COMPONENTS, + AUTH_RA_VALID_COMPONENTS, + auth_both_def, + EXCL_OWNED_NE_UNIT, + EXCL_INVALID_NE_UNIT)); + } + return gnode_prove(root); +} + +PROOF static thm AUTH_RA_VALID_BOTH_FRAME = + prove_auth_ra_valid_both_frame(); + +/* Any two combined resources carry two exclusive authoritative owners. The + * exact valid-frame characterization exposes that impossible first component + * without unfolding the public constructors in the resulting theorem. */ +PROOF static thm prove_auth_ra_both_conflict(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + ~(ra_valid + (auth_ra R) + (ra_op + (auth_ra R) + (auth_both a f) + (auth_both b g))) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "f"); + body = GEN_TAC(body, "b"); + body = GEN_TAC(body, "g"); + body = DISCH_TAC(body, "Hvalid"); + + thm frame_details = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `f:A`, + `auth_both (b:A) (g:A)`), + AUTH_RA_VALID_BOTH_FRAME), + assume_rule(` + ra_valid + (auth_ra (R:(A)ra)) + (ra_op + (auth_ra R) + (auth_both (a:A) (f:A)) + (auth_both (b:A) (g:A))) + `)); + thm frame_is_unit = pure_once_rewrite_rule( + THM_LIST(auth_both_def), + conjunct1_rule(frame_details)); + frame_is_unit = pure_once_rewrite_rule( + THM_LIST(get_theorem_by_name("FST")), + frame_is_unit); + thm contradiction = not_elim_rule( + ispec_rule(`b:A`, EXCL_OWNED_NE_UNIT), + frame_is_unit); + CONTR_TAC(body, contradiction); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_BOTH_CONFLICT = + prove_auth_ra_both_conflict(); + +/* Cancellativity follows from the carrier product. Auth validity supplies + * the stronger source premise needed by that product, while the operation + * bridge normalizes both sides without exposing the raw descriptor. */ +PROOF static thm prove_auth_ra_cancellative(void) { + term goal_tm = ` + forall R:(A)ra. + ra_cancellative R ==> + ra_cancellative (auth_ra R) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + body = DISCH_TAC(body, "Hbase_cancellative"); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_cancellative_def))); + body = GEN_TAC(body, "frame"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "b"); + body = DISCH_TAC(body, "Hsource_valid"); + body = DISCH_TAC(body, "Hops_equal"); + + thm product_cancellative = ispecl_rule( + TERM_LIST( + `excl_ra:((A)excl)ra`, + `R:(A)ra`), + PROD_RA_CANCELLATIVE); + product_cancellative = mp_rule( + product_cancellative, + EXCL_RA_CANCELLATIVE); + product_cancellative = mp_rule( + product_cancellative, + assume_rule(`ra_cancellative (R:(A)ra)`)); + product_cancellative = pure_once_rewrite_rule( + THM_LIST(ra_cancellative_def), + product_cancellative); + + thm left_op = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `frame:(A)excl#A`, + `a:(A)excl#A`), + AUTH_RA_OP_AS_PRODUCT); + thm right_op = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `frame:(A)excl#A`, + `b:(A)excl#A`), + AUTH_RA_OP_AS_PRODUCT); + + thm source_product_at_auth_op = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `ra_op + (auth_ra (R:(A)ra)) + (frame:(A)excl#A) + (a:(A)excl#A)`), + AUTH_RA_VALID_IMP_PRODUCT_VALID), + assume_rule(` + ra_valid + (auth_ra (R:(A)ra)) + (ra_op + (auth_ra R) + (frame:(A)excl#A) + (a:(A)excl#A)) + `)); + thm source_validity_eq = ap_term_rule( + `ra_valid + (prod_ra + (excl_ra:((A)excl)ra) + (R:(A)ra)): + ((A)excl#A)->bool`, + left_op); + thm source_product_valid = eq_mp_rule( + source_validity_eq, + source_product_at_auth_op); + + thm product_ops_equal = trans_rule( + gsym_rule(left_op), + trans_rule( + assume_rule(` + ra_op + (auth_ra (R:(A)ra)) + (frame:(A)excl#A) + (a:(A)excl#A) == + ra_op + (auth_ra R) + frame + (b:(A)excl#A) + `), + right_op)); + thm result = ispecl_rule( + TERM_LIST( + `frame:(A)excl#A`, + `a:(A)excl#A`, + `b:(A)excl#A`), + product_cancellative); + result = mp_rule(result, source_product_valid); + result = mp_rule(result, product_ops_equal); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_CANCELLATIVE = + prove_auth_ra_cancellative(); + +/* Swap the final two factors while retaining a stable left prefix. Keeping + * this small AC fact explicit makes allocation proofs independent of global + * rewrite ordering. */ +PROOF static thm prove_auth_ra_op_swap_right(void) { + term R = `R:(A)ra`; + term a = `a:A`; + term b = `b:A`; + term c = `c:A`; + thm associated_left = ispecl_rule( + TERM_LIST(R, a, b, c), + RA_ASSOC); + thm commute_inner = beta_rule(ap_term_rule( + `\x:A. ra_op (R:(A)ra) (a:A) x`, + ispecl_rule( + TERM_LIST(R, b, c), + RA_COMM))); + thm associated_right = gsym_rule(ispecl_rule( + TERM_LIST(R, a, c, b), + RA_ASSOC)); + thm result = trans_rule( + associated_left, + trans_rule(commute_inner, associated_right)); + result = gen_rule(c, result); + result = gen_rule(b, result); + result = gen_rule(a, result); + return gen_rule(R, result); +} + +PROOF static thm AUTH_RA_OP_SWAP_RIGHT = + prove_auth_ra_op_swap_right(); + +/* ------------------------------------------------------------------------- */ +/* General frame-preserving updates */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_auth_ra_update(void) { + term goal_tm = ` + forall + (R:(A)ra) + (a:A) + (f:A) + (b:A) + (g:A). + (forall external:A. + ra_valid R a && + ra_included R (ra_op R f external) a ==> + ra_valid R b && + ra_included R (ra_op R g external) b) ==> + ra_update + (auth_ra R) + (auth_both a f) + (auth_both b g) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_update_def))); + body = AUTO_INTROS_TAC(body); + + thm source_characterization = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `f:A`, + `frame:(A)excl#A`), + AUTH_RA_VALID_BOTH_FRAME); + thm source_details = eq_mp_rule( + source_characterization, + assume_rule(` + ra_valid + (auth_ra (R:(A)ra)) + (ra_op + (auth_ra R) + (auth_both (a:A) (f:A)) + (frame:(A)excl#A)) + `)); + thm frame_is_fragment = conjunct1_rule(source_details); + thm source_condition = conjunct2_rule(source_details); + + thm target_condition = mp_rule( + spec_rule( + `SND (frame:(A)excl#A)`, + assume_rule(` + forall external:A. + ra_valid (R:(A)ra) (a:A) && + ra_included R (ra_op R (f:A) external) a ==> + ra_valid R (b:A) && + ra_included R (ra_op R (g:A) external) b + `)), + source_condition); + thm target_details = conj_rule( + frame_is_fragment, + target_condition); + thm target_characterization = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `b:A`, + `g:A`, + `frame:(A)excl#A`), + AUTH_RA_VALID_BOTH_FRAME); + ACCEPT_TAC( + body, + eq_mp_rule(gsym_rule(target_characterization), target_details)); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_UPDATE = + prove_auth_ra_update(); + +PROOF static thm prove_auth_ra_update_nd(void) { + term goal_tm = ` + forall + (R:(A)ra) + (a:A) + (f:A) + (P:A->A->bool). + (forall external:A. + ra_valid R a && + ra_included R (ra_op R f external) a ==> + exists (b:A) (g:A). + P b g && + ra_valid R b && + ra_included R (ra_op R g external) b) ==> + ra_update_nd + (auth_ra R) + (auth_both a f) + (\candidate:(A)excl#A. + exists (b:A) (g:A). + P b g && + candidate == auth_both b g) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = AUTO_INTROS_TAC(body); + + thm source_characterization = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `f:A`, + `frame:(A)excl#A`), + AUTH_RA_VALID_BOTH_FRAME); + thm source_details = eq_mp_rule( + source_characterization, + assume_rule(` + ra_valid + (auth_ra (R:(A)ra)) + (ra_op + (auth_ra R) + (auth_both (a:A) (f:A)) + (frame:(A)excl#A)) + `)); + thm selected = mp_rule( + spec_rule( + `SND (frame:(A)excl#A)`, + assume_rule(` + forall external:A. + ra_valid (R:(A)ra) (a:A) && + ra_included R (ra_op R (f:A) external) a ==> + exists (b:A) (g:A). + (P:A->A->bool) b g && + ra_valid R b && + ra_included R (ra_op R g external) b + `)), + conjunct2_rule(source_details)); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "b"); + body = ASMP_EXISTS_TAC(body, "Hselected", "g"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "HP", + "Htarget_condition"); + + body = EXISTS_TAC(body, `auth_both (b:A) (g:A)`); + gnode_list result = CONJ_TAC(body); + + gnode predicate = EXISTS_TAC(result[0], `b:A`); + predicate = EXISTS_TAC(predicate, `g:A`); + gnode_list predicate_parts = CONJ_TAC(predicate); + ACCEPT_TAC( + predicate_parts[0], + assume_rule(`(P:A->A->bool) (b:A) (g:A)`)); + ACCEPT_TAC( + predicate_parts[1], + refl_rule(`auth_both (b:A) (g:A)`)); + + thm target_details = conj_rule( + conjunct1_rule(source_details), + assume_rule(` + ra_valid (R:(A)ra) (b:A) && + ra_included + R + (ra_op R (g:A) (SND (frame:(A)excl#A))) + b + `)); + thm target_characterization = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `b:A`, + `g:A`, + `frame:(A)excl#A`), + AUTH_RA_VALID_BOTH_FRAME); + ACCEPT_TAC( + result[1], + eq_mp_rule(gsym_rule(target_characterization), target_details)); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_UPDATE_ND = + prove_auth_ra_update_nd(); + +/* ------------------------------------------------------------------------- */ +/* Allocation and cancellative specializations */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_auth_ra_alloc_both(void) { + term goal_tm = ` + forall + (R:(A)ra) + (a:A) + (f:A) + (piece:A). + ra_valid R (ra_op R a piece) ==> + ra_update + (auth_ra R) + (auth_both a f) + (auth_both + (ra_op R a piece) + (ra_op R f piece)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = MATCH_MP_TAC( + body, + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `f:A`, + `ra_op (R:(A)ra) (a:A) (piece:A)`, + `ra_op (R:(A)ra) (f:A) (piece:A)`), + AUTH_RA_UPDATE)); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(ra_included_def))); + body = GEN_TAC(body, "external"); + body = DISCH_TAC(body, "Hsource"); + body = ASMP_CONJ_TAC( + body, + "Hsource", + "Hvalid_source", + "Hincluded_source"); + body = ASMP_EXISTS_TAC( + body, + "Hincluded_source", + "slack"); + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC( + result[0], + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (a:A) (piece:A)) + `)); + + gnode included = EXISTS_TAC(result[1], `slack:A`); + thm extend_source = beta_rule(ap_term_rule( + `\x:A. ra_op (R:(A)ra) x (piece:A)`, + assume_rule(` + (a:A) == + ra_op + (R:(A)ra) + (ra_op R (f:A) (external:A)) + (slack:A) + `))); + thm swap_outer = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `ra_op (R:(A)ra) (f:A) (external:A)`, + `slack:A`, + `piece:A`), + AUTH_RA_OP_SWAP_RIGHT); + thm swap_inner = beta_rule(ap_term_rule( + `\x:A. ra_op (R:(A)ra) x (slack:A)`, + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `f:A`, + `external:A`, + `piece:A`), + AUTH_RA_OP_SWAP_RIGHT))); + ACCEPT_TAC( + included, + trans_rule( + extend_source, + trans_rule(swap_outer, swap_inner))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_ALLOC_BOTH = + prove_auth_ra_alloc_both(); + +PROOF static thm prove_auth_ra_alloc(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (piece:A). + ra_valid R (ra_op R a piece) ==> + ra_update + (auth_ra R) + (auth_auth R a) + (auth_both (ra_op R a piece) piece) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm allocated = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `ra_unit (R:(A)ra)`, + `piece:A`), + AUTH_RA_ALLOC_BOTH), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (a:A) (piece:A)) + `)); + thm_list reductions = THM_LIST( + auth_auth_def, + auth_both_def, + RA_UNIT_L); + body = CONV_TAC(body, rewrite_conv(reductions)); + ACCEPT_TAC(body, rewrite_rule(reductions, allocated)); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_ALLOC = + prove_auth_ra_alloc(); + +PROOF static thm prove_auth_ra_update_cancellative(void) { + term goal_tm = ` + forall + (R:(A)ra) + (a:A) + (b:A) + (frame:A). + ra_cancellative R ==> + ra_valid R (ra_op R b frame) ==> + ra_update + (auth_ra R) + (auth_both (ra_op R a frame) a) + (auth_both (ra_op R b frame) b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = MATCH_MP_TAC( + body, + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `ra_op (R:(A)ra) (a:A) (frame:A)`, + `a:A`, + `ra_op (R:(A)ra) (b:A) (frame:A)`, + `b:A`), + AUTH_RA_UPDATE)); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(ra_included_def))); + body = GEN_TAC(body, "external"); + body = DISCH_TAC(body, "Hsource"); + body = ASMP_CONJ_TAC( + body, + "Hsource", + "Hvalid_source", + "Hincluded_source"); + body = ASMP_EXISTS_TAC( + body, + "Hincluded_source", + "slack"); + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC( + result[0], + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (b:A) (frame:A)) + `)); + + thm normalized_source = trans_rule( + assume_rule(` + ra_op (R:(A)ra) (a:A) (frame:A) == + ra_op R + (ra_op R (a:A) (external:A)) + (slack:A) + `), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `external:A`, + `slack:A`), + RA_ASSOC)); + thm residual_eq = mp_rule( + mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `frame:A`, + `ra_op + (R:(A)ra) + (external:A) + (slack:A)`), + RA_CANCELLATIVE_APPLY), + assume_rule(`ra_cancellative (R:(A)ra)`)), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (a:A) (frame:A)) + `)), + normalized_source); + + gnode included = EXISTS_TAC(result[1], `slack:A`); + thm lift_residual = beta_rule(ap_term_rule( + `\x:A. ra_op (R:(A)ra) (b:A) x`, + residual_eq)); + thm reassociate = gsym_rule(ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `b:A`, + `external:A`, + `slack:A`), + RA_ASSOC)); + ACCEPT_TAC( + included, + trans_rule(lift_residual, reassociate)); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_UPDATE_CANCELLATIVE = + prove_auth_ra_update_cancellative(); + +PROOF static int audit_auth_ra(void) { + thm_list implementation_theorems = THM_LIST( + auth_op_def, + auth_valid_at_def, + auth_valid_def, + auth_auth_def, + auth_frag_def, + auth_both_def, + AUTH_RA_LAWS, + auth_ra_def, + AUTH_RA_OP_FN, + AUTH_RA_VALID_FN, + AUTH_RA_OP_COMPONENTS, + AUTH_RA_VALID_COMPONENTS, + AUTH_RA_OP_AS_PRODUCT, + AUTH_RA_VALID_IMP_PRODUCT_VALID, + AUTH_RA_UNIT, + AUTH_RA_AUTH_FRAG, + AUTH_RA_FRAG_FRAG, + AUTH_RA_BOTH_FRAG, + AUTH_RA_BOTH_UNIT, + AUTH_RA_VALID_FRAG, + AUTH_RA_VALID_BOTH, + AUTH_RA_VALID_AUTH, + AUTH_RA_AUTH_CONFLICT, + AUTH_RA_BOTH_CONFLICT, + AUTH_RA_CANCELLATIVE, + AUTH_RA_VALID_BOTH_FRAME, + AUTH_RA_OP_SWAP_RIGHT, + AUTH_RA_UPDATE, + AUTH_RA_UPDATE_ND, + AUTH_RA_ALLOC_BOTH, + AUTH_RA_ALLOC, + AUTH_RA_UPDATE_CANCELLATIVE); + + for (size_t i = 0; i < vector_size(implementation_theorems); ++i) { + ENSURE_COND(!IS_NULL(implementation_theorems[i]), + "authoritative RA theorem %zu is empty", i); + ENSURE_COND(vector_size(hyp(implementation_theorems[i])) == 0, + "authoritative RA theorem %zu has hypotheses", i); + } + ENSURE_COND(vector_size(get_all_axioms()) == AUTH_RA_AXIOMS_BEFORE, + "authoritative RA introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_auth_ra"); + return -1; +} + +PROOF static int _AUTH_RA_AUDIT = + audit_auth_ra(); diff --git a/theory/logic/auth_ra.h b/theory/logic/auth_ra.h new file mode 100644 index 0000000..595e707 --- /dev/null +++ b/theory/logic/auth_ra.h @@ -0,0 +1,227 @@ +#pragma once + +/* + * Authoritative resources over an intrinsic resource algebra. + * + * For `R=(|R|,ε_R,·_R,valid_R)` with `R:(A)ra` and `|R|=A`, the + * carrier is `(A)excl # A`. The + * exclusive first component records + * whether this resource owns the unique authoritative value; the second + * component records an ordinary fragment. Operation is the product of + * `excl_ra` and `R`; validity additionally requires every fragment to be + * included in its authoritative value when authority is present. + * + * Public HOL constructors have shapes + * + * auth_auth : (A)ra -> A -> (A)excl#A, + * auth_frag : A -> (A)excl#A, + * auth_both : A -> A -> (A)excl#A. + * + * This client interface deliberately hides the raw operation, raw validity + * predicate, abstraction descriptor, and constructor definitions. Clients + * reason through the exact computation, validity, and update rules below. + */ + +#include "proof/theory/logic/excl_ra.h" + +/* ------------------------------------------------------------------------- */ +/* Core representation and constructors */ +/* ------------------------------------------------------------------------- */ + +/* + * The authoritative RA unit is a fragment-only base unit: + * + * forall R:(A)ra. + * ra_unit (auth_ra R) == auth_frag (ra_unit R) + */ +PROOF extern thm AUTH_RA_UNIT; + +/* + * Authoritative ownership composes with a fragment: + * + * forall (R:(A)ra) (a:A) (f:A). + * ra_op (auth_ra R) (auth_auth R a) (auth_frag f) == + * auth_both a f + */ +PROOF extern thm AUTH_RA_AUTH_FRAG; + +/* + * Fragment-only resources compose through the base RA: + * + * forall (R:(A)ra) (f:A) (g:A). + * ra_op (auth_ra R) (auth_frag f) (auth_frag g) == + * auth_frag (ra_op R f g) + */ +PROOF extern thm AUTH_RA_FRAG_FRAG; + +/* + * A combined authoritative resource absorbs another fragment into its + * fragment component: + * + * forall (R:(A)ra) (a:A) (f:A) (g:A). + * ra_op (auth_ra R) (auth_both a f) (auth_frag g) == + * auth_both a (ra_op R f g) + */ +PROOF extern thm AUTH_RA_BOTH_FRAG; + +/* + * A combined resource with the base unit fragment is authority-only: + * + * forall (R:(A)ra) (a:A). + * auth_both a (ra_unit R) == auth_auth R a + */ +PROOF extern thm AUTH_RA_BOTH_UNIT; + +/* ------------------------------------------------------------------------- */ +/* Validity and exclusivity */ +/* ------------------------------------------------------------------------- */ + +/* + * forall (R:(A)ra) (f:A). + * ra_valid (auth_ra R) (auth_frag f) <=> ra_valid R f + */ +PROOF extern thm AUTH_RA_VALID_FRAG; + +/* + * Combined validity exposes the authoritative value and its fragment: + * + * forall (R:(A)ra) (a:A) (f:A). + * ra_valid (auth_ra R) (auth_both a f) <=> + * ra_valid R a && ra_included R f a + */ +PROOF extern thm AUTH_RA_VALID_BOTH; + +/* + * forall (R:(A)ra) (a:A). + * ra_valid (auth_ra R) (auth_auth R a) <=> ra_valid R a + */ +PROOF extern thm AUTH_RA_VALID_AUTH; + +/* + * forall (R:(A)ra) (a:A) (b:A). + * ~(ra_valid + * (auth_ra R) + * (ra_op + * (auth_ra R) + * (auth_auth R a) + * (auth_auth R b))) + */ +PROOF extern thm AUTH_RA_AUTH_CONFLICT; + +/* + * Two combined resources also conflict, independently of their fragments: + * + * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + * ~(ra_valid + * (auth_ra R) + * (ra_op + * (auth_ra R) + * (auth_both a f) + * (auth_both b g))) + */ +PROOF extern thm AUTH_RA_BOTH_CONFLICT; + +/* ------------------------------------------------------------------------- */ +/* Laws: optional algebraic properties */ +/* ------------------------------------------------------------------------- */ + +/* + * Cancellativity of the base RA lifts through authoritative ownership: + * + * forall R:(A)ra. + * ra_cancellative R ==> + * ra_cancellative (auth_ra R) + */ +PROOF extern thm AUTH_RA_CANCELLATIVE; + +/* ------------------------------------------------------------------------- */ +/* Updates: general frame-preserving rules */ +/* ------------------------------------------------------------------------- */ + +/* + * Exact deterministic authoritative update rule. + * + * To update `auth_both a f` to `auth_both b g`, it is sufficient to show + * that every external fragment compatible with the source remains compatible + * with the target. This condition is not implied by an attempted lift of + * `ra_update R a b`: a base update need not preserve which fragments are + * included in the authoritative value. + * + * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + * (forall external:A. + * ra_valid R a && + * ra_included R (ra_op R f external) a ==> + * ra_valid R b && + * ra_included R (ra_op R g external) b) ==> + * ra_update + * (auth_ra R) + * (auth_both a f) + * (auth_both b g) + */ +PROOF extern thm AUTH_RA_UPDATE; + +/* + * Predicate-valued authoritative update. The selected `(b,g)` may depend on + * the hidden external fragment, matching the semantics of `ra_update_nd`. + * + * forall (R:(A)ra) (a:A) (f:A) (P:A->A->bool). + * (forall external:A. + * ra_valid R a && + * ra_included R (ra_op R f external) a ==> + * exists (b:A) (g:A). + * P b g && + * ra_valid R b && + * ra_included R (ra_op R g external) b) ==> + * ra_update_nd + * (auth_ra R) + * (auth_both a f) + * (\candidate:(A)excl#A. + * exists (b:A) (g:A). + * P b g && candidate == auth_both b g) + */ +PROOF extern thm AUTH_RA_UPDATE_ND; + +/* ------------------------------------------------------------------------- */ +/* Updates: allocation and cancellative specializations */ +/* ------------------------------------------------------------------------- */ + +/* + * Extend both the authority and the locally owned fragment by `piece`: + * + * forall (R:(A)ra) (a:A) (f:A) (piece:A). + * ra_valid R (ra_op R a piece) ==> + * ra_update + * (auth_ra R) + * (auth_both a f) + * (auth_both + * (ra_op R a piece) + * (ra_op R f piece)) + */ +PROOF extern thm AUTH_RA_ALLOC_BOTH; + +/* + * Allocate a fragment while extending an authority-only resource: + * + * forall (R:(A)ra) (a:A) (piece:A). + * ra_valid R (ra_op R a piece) ==> + * ra_update + * (auth_ra R) + * (auth_auth R a) + * (auth_both (ra_op R a piece) piece) + */ +PROOF extern thm AUTH_RA_ALLOC; + +/* + * Dasheng-style synchronized update for cancellative base RAs: + * + * forall (R:(A)ra) (a:A) (b:A) (frame:A). + * ra_cancellative R ==> + * ra_valid R (ra_op R b frame) ==> + * ra_update + * (auth_ra R) + * (auth_both (ra_op R a frame) a) + * (auth_both (ra_op R b frame) b) + * + * No base `ra_update` premise is used. + */ +PROOF extern thm AUTH_RA_UPDATE_CANCELLATIVE; -- Gitee From 0792e6fb68e1fc4ed76d45a3bae4a3f732a6b172 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Wed, 29 Jul 2026 04:17:22 +0800 Subject: [PATCH 04/35] feat(logic): define ghost resources and basic updates --- theory/logic/basic_update.c | 1108 +++++++++++++ theory/logic/basic_update.h | 91 ++ theory/logic/ghost_heap.c | 551 +++++++ theory/logic/ghost_heap.h | 116 ++ theory/logic/ghost_own.c | 225 +++ theory/logic/ghost_own.h | 42 + theory/logic/ghost_update.c | 537 +++++++ theory/logic/ghost_update.h | 50 + theory/logic/resource_prop.c | 2896 ++++++++++++++++++++++++++++++++++ theory/logic/resource_prop.h | 246 +++ 10 files changed, 5862 insertions(+) create mode 100644 theory/logic/basic_update.c create mode 100644 theory/logic/basic_update.h create mode 100644 theory/logic/ghost_heap.c create mode 100644 theory/logic/ghost_heap.h create mode 100644 theory/logic/ghost_own.c create mode 100644 theory/logic/ghost_own.h create mode 100644 theory/logic/ghost_update.c create mode 100644 theory/logic/ghost_update.h create mode 100644 theory/logic/resource_prop.c create mode 100644 theory/logic/resource_prop.h diff --git a/theory/logic/basic_update.c b/theory/logic/basic_update.c new file mode 100644 index 0000000..d4eb8a7 --- /dev/null +++ b/theory/logic/basic_update.c @@ -0,0 +1,1108 @@ +#include "proof/theory/logic/basic_update.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/resource_prop.c" + +PROOF static size_t BASIC_UPDATE_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF thm r_bupd_def = new_fun_definition(` + r_bupd + (R:(A)ra) + (Q:A->bool) + (owned:A) <=> + ra_update_nd R owned Q +`); + +PROOF thm r_viewshift_def = new_fun_definition(` + r_viewshift + (R:(A)ra) + (P:A->bool) + (Q:A->bool) <=> + r_entails R P (r_bupd R Q) +`); + +PROOF static thm prove_r_bupd_intro(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool). + r_entails R P (r_bupd R P) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_bupd_def, + ra_update_nd_def))); + body = AUTO_INTROS_TAC(body); + body = EXISTS_TAC(body, `resource:A`); + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC( + result[0], + assume_rule(`(P:A->bool) (resource:A)`)); + ACCEPT_TAC( + result[1], + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (resource:A) (frame:A)) + `)); + return gnode_prove(root); +} + +PROOF thm R_BUPD_INTRO = + prove_r_bupd_intro(); + +PROOF static thm prove_r_bupd_mono(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool). + r_entails R P Q ==> + r_entails + R + (r_bupd R P) + (r_bupd R Q) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_bupd_def, + ra_update_nd_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = DISCH_TAC(body, "Hmono"); + body = GEN_TAC(body, "owned"); + body = DISCH_TAC(body, "Hvalid_owned"); + body = DISCH_TAC(body, "Hupdate"); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hvalid_source"); + + thm selected = mp_rule( + spec_rule( + `frame:A`, + assume_rule(` + forall frame:A. + ra_valid + (R:(A)ra) + (ra_op R (owned:A) frame) ==> + exists selected:A. + (P:A->bool) selected && + ra_valid R (ra_op R selected frame) + `)), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (owned:A) (frame:A)) + `)); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "selected"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "HP", + "Hvalid_selected_frame"); + + thm valid_selected = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `selected:A`, + `frame:A`), + RA_VALID_OP_L), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (selected:A) (frame:A)) + `)); + thm q_selected = mp_rule( + mp_rule( + spec_rule( + `selected:A`, + assume_rule(` + forall resource:A. + ra_valid (R:(A)ra) resource ==> + (P:A->bool) resource ==> + (Q:A->bool) resource + `)), + valid_selected), + assume_rule(`(P:A->bool) (selected:A)`)); + + body = EXISTS_TAC(body, `selected:A`); + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC(result[0], q_selected); + ACCEPT_TAC( + result[1], + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (selected:A) (frame:A)) + `)); + return gnode_prove(root); +} + +PROOF thm R_BUPD_MONO = + prove_r_bupd_mono(); + +PROOF static thm prove_r_bupd_idem(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool). + r_entails + R + (r_bupd R (r_bupd R P)) + (r_bupd R P) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_bupd_def, + ra_update_nd_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "owned"); + body = DISCH_TAC(body, "Hvalid_owned"); + body = DISCH_TAC(body, "Hnested"); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hvalid_source"); + + thm middle = mp_rule( + spec_rule( + `frame:A`, + assume_rule(` + forall frame:A. + ra_valid + (R:(A)ra) + (ra_op R (owned:A) frame) ==> + exists middle:A. + (forall hidden:A. + ra_valid R (ra_op R middle hidden) ==> + exists result:A. + (P:A->bool) result && + ra_valid R (ra_op R result hidden)) && + ra_valid R (ra_op R middle frame) + `)), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (owned:A) (frame:A)) + `)); + body = ASSUME_TAC(body, middle, "Hmiddle"); + body = ASMP_EXISTS_TAC(body, "Hmiddle", "middle"); + body = ASMP_CONJ_TAC( + body, + "Hmiddle", + "Hmiddle_update", + "Hvalid_middle_frame"); + + thm result = mp_rule( + spec_rule( + `frame:A`, + assume_rule(` + forall hidden:A. + ra_valid + (R:(A)ra) + (ra_op R (middle:A) hidden) ==> + exists result:A. + (P:A->bool) result && + ra_valid R (ra_op R result hidden) + `)), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (middle:A) (frame:A)) + `)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_BUPD_IDEM = + prove_r_bupd_idem(); + +PROOF static thm prove_r_bupd_frame(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (frame_pred:A->bool). + r_entails + R + (r_sep R (r_bupd R P) frame_pred) + (r_bupd R (r_sep R P frame_pred)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_sep_def, + r_bupd_def, + ra_update_nd_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "frame_pred"); + body = GEN_TAC(body, "owned_total"); + body = DISCH_TAC(body, "Hvalid_owned_total"); + body = DISCH_TAC(body, "Hsep"); + body = ASMP_EXISTS_TAC(body, "Hsep", "updated"); + body = ASMP_EXISTS_TAC(body, "Hsep", "explicit_frame"); + body = ASMP_CONJ_TAC( + body, + "Hsep", + "Hsplit", + "Hpreds"); + body = ASMP_CONJ_TAC( + body, + "Hpreds", + "Hupdate", + "Hframe_pred"); + body = GEN_TAC(body, "hidden"); + body = DISCH_TAC(body, "Hvalid_with_hidden"); + + thm split_with_hidden = beta_rule(ap_term_rule( + `\base:A. + ra_op (R:(A)ra) base (hidden:A)`, + assume_rule(` + (owned_total:A) == + ra_op + (R:(A)ra) + (updated:A) + (explicit_frame:A) + `))); + thm source_validity_eq = ap_term_rule( + `ra_valid (R:(A)ra):A->bool`, + split_with_hidden); + thm valid_grouped_left = eq_mp_rule( + source_validity_eq, + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (owned_total:A) (hidden:A)) + `)); + thm source_assoc = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `updated:A`, + `explicit_frame:A`, + `hidden:A`), + RA_ASSOC); + thm source_assoc_validity = ap_term_rule( + `ra_valid (R:(A)ra):A->bool`, + source_assoc); + thm valid_normalized = eq_mp_rule( + source_assoc_validity, + valid_grouped_left); + + thm selected = mp_rule( + spec_rule( + `ra_op + (R:(A)ra) + (explicit_frame:A) + (hidden:A)`, + assume_rule(` + forall frame:A. + ra_valid + (R:(A)ra) + (ra_op R (updated:A) frame) ==> + exists selected:A. + (P:A->bool) selected && + ra_valid R (ra_op R selected frame) + `)), + valid_normalized); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "selected"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "HP", + "Hvalid_selected"); + + body = EXISTS_TAC( + body, + `ra_op + (R:(A)ra) + (selected:A) + (explicit_frame:A)`); + gnode_list result = CONJ_TAC(body); + + gnode post = EXISTS_TAC(result[0], `selected:A`); + post = EXISTS_TAC(post, `explicit_frame:A`); + gnode_list post1 = CONJ_TAC(post); + ACCEPT_TAC( + post1[0], + refl_rule(` + ra_op + (R:(A)ra) + (selected:A) + (explicit_frame:A) + `)); + gnode_list post2 = CONJ_TAC(post1[1]); + ACCEPT_TAC( + post2[0], + assume_rule(`(P:A->bool) (selected:A)`)); + ACCEPT_TAC( + post2[1], + assume_rule(` + (frame_pred:A->bool) (explicit_frame:A) + `)); + + thm result_assoc = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `selected:A`, + `explicit_frame:A`, + `hidden:A`), + RA_ASSOC); + thm result_assoc_validity = ap_term_rule( + `ra_valid (R:(A)ra):A->bool`, + gsym_rule(result_assoc)); + ACCEPT_TAC( + result[1], + eq_mp_rule( + result_assoc_validity, + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op + R + (selected:A) + (ra_op + R + (explicit_frame:A) + (hidden:A))) + `))); + return gnode_prove(root); +} + +PROOF thm R_BUPD_FRAME = + prove_r_bupd_frame(); + +PROOF static thm prove_r_viewshift_refl(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool). + r_viewshift R P P + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(r_viewshift_def))); + body = AUTO_INTROS_TAC(body); + ACCEPT_TAC( + body, + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `P:A->bool`), + R_BUPD_INTRO)); + return gnode_prove(root); +} + +PROOF thm R_VIEWSHIFT_REFL = + prove_r_viewshift_refl(); + +PROOF static thm prove_r_entails_to_viewshift(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool). + r_entails R P Q ==> + r_viewshift R P Q + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(r_viewshift_def))); + body = AUTO_INTROS_TAC(body); + thm result = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `P:A->bool`, + `Q:A->bool`, + `r_bupd (R:(A)ra) (Q:A->bool)`), + R_ENTAILS_TRANS), + assume_rule(` + r_entails (R:(A)ra) (P:A->bool) (Q:A->bool) + `)), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Q:A->bool`), + R_BUPD_INTRO)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_ENTAILS_TO_VIEWSHIFT = + prove_r_entails_to_viewshift(); + +PROOF static thm prove_r_viewshift_trans(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (S:A->bool). + r_viewshift R P Q ==> + r_viewshift R Q S ==> + r_viewshift R P S + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(r_viewshift_def))); + body = AUTO_INTROS_TAC(body); + + thm lifted_second = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Q:A->bool`, + `r_bupd (R:(A)ra) (S:A->bool)`), + R_BUPD_MONO), + assume_rule(` + r_entails + (R:(A)ra) + (Q:A->bool) + (r_bupd R (S:A->bool)) + `)); + thm collapsed_second = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_bupd (R:(A)ra) (Q:A->bool)`, + `r_bupd R (r_bupd R (S:A->bool))`, + `r_bupd R (S:A->bool)`), + R_ENTAILS_TRANS), + lifted_second), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `S:A->bool`), + R_BUPD_IDEM)); + thm result = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `P:A->bool`, + `r_bupd R (Q:A->bool)`, + `r_bupd R (S:A->bool)`), + R_ENTAILS_TRANS), + assume_rule(` + r_entails + (R:(A)ra) + (P:A->bool) + (r_bupd R (Q:A->bool)) + `)), + collapsed_second); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_VIEWSHIFT_TRANS = + prove_r_viewshift_trans(); + +PROOF static thm prove_r_viewshift_mono(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P2:A->bool) + (P:A->bool) + (Q:A->bool) + (Q2:A->bool). + r_entails R P2 P ==> + r_viewshift R P Q ==> + r_entails R Q Q2 ==> + r_viewshift R P2 Q2 + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(r_viewshift_def))); + body = AUTO_INTROS_TAC(body); + + thm lifted_post = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Q:A->bool`, + `Q2:A->bool`), + R_BUPD_MONO), + assume_rule(` + r_entails (R:(A)ra) (Q:A->bool) (Q2:A->bool) + `)); + thm changed_post = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `P:A->bool`, + `r_bupd R (Q:A->bool)`, + `r_bupd R (Q2:A->bool)`), + R_ENTAILS_TRANS), + assume_rule(` + r_entails + (R:(A)ra) + (P:A->bool) + (r_bupd R (Q:A->bool)) + `)), + lifted_post); + thm result = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `P2:A->bool`, + `P:A->bool`, + `r_bupd R (Q2:A->bool)`), + R_ENTAILS_TRANS), + assume_rule(` + r_entails (R:(A)ra) (P2:A->bool) (P:A->bool) + `)), + changed_post); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_VIEWSHIFT_MONO = + prove_r_viewshift_mono(); + +PROOF static thm prove_r_viewshift_frame(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (frame_pred:A->bool). + r_viewshift R P Q ==> + r_viewshift + R + (r_sep R P frame_pred) + (r_sep R Q frame_pred) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(r_viewshift_def))); + body = AUTO_INTROS_TAC(body); + + thm explicit_frame = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `P:A->bool`, + `r_bupd R (Q:A->bool)`, + `frame_pred:A->bool`), + R_SEP_FRAME_L), + assume_rule(` + r_entails + (R:(A)ra) + (P:A->bool) + (r_bupd R (Q:A->bool)) + `)); + thm result = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_sep + R + (P:A->bool) + (frame_pred:A->bool)`, + `r_sep + R + (r_bupd R (Q:A->bool)) + (frame_pred:A->bool)`, + `r_bupd + R + (r_sep + R + (Q:A->bool) + (frame_pred:A->bool))`), + R_ENTAILS_TRANS), + explicit_frame), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Q:A->bool`, + `frame_pred:A->bool`), + R_BUPD_FRAME)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_VIEWSHIFT_FRAME = + prove_r_viewshift_frame(); + +PROOF static thm prove_r_viewshift_sep(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P1:A->bool) + (Q1:A->bool) + (P2:A->bool) + (Q2:A->bool). + r_viewshift R P1 Q1 ==> + r_viewshift R P2 Q2 ==> + r_viewshift + R + (r_sep R P1 P2) + (r_sep R Q1 Q2) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "P1"); + body = GEN_TAC(body, "Q1"); + body = GEN_TAC(body, "P2"); + body = GEN_TAC(body, "Q2"); + body = DISCH_TAC(body, "Hchange1"); + body = DISCH_TAC(body, "Hchange2"); + + thm first_framed = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `P1:A->bool`, + `Q1:A->bool`, + `P2:A->bool`), + R_VIEWSHIFT_FRAME), + assume_rule(` + r_viewshift (R:(A)ra) (P1:A->bool) (Q1:A->bool) + `)); + thm second_framed = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `P2:A->bool`, + `Q2:A->bool`, + `Q1:A->bool`), + R_VIEWSHIFT_FRAME), + assume_rule(` + r_viewshift (R:(A)ra) (P2:A->bool) (Q2:A->bool) + `)); + + thm source_commute = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `P2:A->bool`, + `Q1:A->bool`), + R_SEP_COMM); + thm source_eq = beta_rule(ap_term_rule( + `\source:A->bool. + r_viewshift + (R:(A)ra) + source + (r_sep R (Q2:A->bool) (Q1:A->bool))`, + source_commute)); + thm second_source_aligned = eq_mp_rule(source_eq, second_framed); + + thm target_commute = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Q2:A->bool`, + `Q1:A->bool`), + R_SEP_COMM); + thm target_eq = beta_rule(ap_term_rule( + `\target:A->bool. + r_viewshift + (R:(A)ra) + (r_sep R (Q1:A->bool) (P2:A->bool)) + target`, + target_commute)); + thm second_aligned = eq_mp_rule(target_eq, second_source_aligned); + + thm result = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_sep R (P1:A->bool) (P2:A->bool)`, + `r_sep R (Q1:A->bool) (P2:A->bool)`, + `r_sep R (Q1:A->bool) (Q2:A->bool)`), + R_VIEWSHIFT_TRANS), + first_framed), + second_aligned); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_VIEWSHIFT_SEP = + prove_r_viewshift_sep(); + +PROOF static thm prove_r_viewshift_exists_l(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:B->A->bool) + (Q:A->bool). + (forall witness:B. + r_viewshift R (P witness) Q) ==> + r_viewshift R (r_exists R (\bound:B. P bound)) Q + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(r_viewshift_def))); + body = AUTO_INTROS_TAC(body); + thm result = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `P:B->A->bool`, + `r_bupd R (Q:A->bool)`), + R_EXISTS_ELIM), + assume_rule(` + forall witness:B. + r_entails + (R:(A)ra) + ((P:B->A->bool) witness) + (r_bupd R (Q:A->bool)) + `)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_VIEWSHIFT_EXISTS_L = + prove_r_viewshift_exists_l(); + +PROOF static thm prove_r_viewshift_exists_r(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:B->A->bool) + (witness:B). + r_viewshift R P (Q witness) ==> + r_viewshift R P (r_exists R (\bound:B. Q bound)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(r_viewshift_def))); + body = AUTO_INTROS_TAC(body); + + thm post_inclusion = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Q:B->A->bool`, + `witness:B`), + R_EXISTS_INTRO); + thm lifted_post = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `(Q:B->A->bool) (witness:B)`, + `r_exists R (\bound:B. (Q:B->A->bool) bound)`), + R_BUPD_MONO), + post_inclusion); + thm result = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `P:A->bool`, + `r_bupd R ((Q:B->A->bool) (witness:B))`, + `r_bupd R + (r_exists R (\bound:B. (Q:B->A->bool) bound))`), + R_ENTAILS_TRANS), + assume_rule(` + r_entails + (R:(A)ra) + (P:A->bool) + (r_bupd + R + ((Q:B->A->bool) (witness:B))) + `)), + lifted_post); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_VIEWSHIFT_EXISTS_R = + prove_r_viewshift_exists_r(); + +PROOF static thm prove_r_viewshift_exists(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:B->A->bool) + (Q:B->A->bool). + (forall witness:B. + r_viewshift R (P witness) (Q witness)) ==> + r_viewshift + R + (r_exists R (\bound:B. P bound)) + (r_exists R (\bound:B. Q bound)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = DISCH_TAC(body, "Hall"); + body = MATCH_MP_TAC( + body, + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `P:B->A->bool`, + `r_exists R (\bound:B. (Q:B->A->bool) bound)`), + R_VIEWSHIFT_EXISTS_L)); + body = GEN_TAC(body, "witness"); + thm selected = spec_rule( + `witness:B`, + assume_rule(` + forall witness:B. + r_viewshift + (R:(A)ra) + ((P:B->A->bool) witness) + ((Q:B->A->bool) witness) + `)); + thm result = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `(P:B->A->bool) (witness:B)`, + `Q:B->A->bool`, + `witness:B`), + R_VIEWSHIFT_EXISTS_R), + selected); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_VIEWSHIFT_EXISTS = + prove_r_viewshift_exists(); + +PROOF static thm prove_r_own_update(void) { + term goal_tm = ` + forall + (R:(A)ra) + (a:A) + (b:A). + ra_update R a b ==> + r_viewshift + R + (r_own R a) + (r_own R b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_viewshift_def, + r_entails_def, + r_bupd_def, + r_own_def, + ra_update_nd_def, + ra_update_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "b"); + body = DISCH_TAC(body, "Hupdate"); + body = GEN_TAC(body, "owned"); + body = DISCH_TAC(body, "Hvalid_owned"); + body = DISCH_TAC(body, "Howned"); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hvalid_source"); + + thm replace_owned = beta_rule(ap_term_rule( + `\base:A. + ra_op (R:(A)ra) base (frame:A)`, + assume_rule(`(owned:A) == (a:A)`))); + thm source_validity_eq = ap_term_rule( + `ra_valid (R:(A)ra):A->bool`, + replace_owned); + thm valid_a_frame = eq_mp_rule( + source_validity_eq, + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (owned:A) (frame:A)) + `)); + thm valid_b_frame = mp_rule( + spec_rule( + `frame:A`, + assume_rule(` + forall frame:A. + ra_valid + (R:(A)ra) + (ra_op R (a:A) frame) ==> + ra_valid R (ra_op R (b:A) frame) + `)), + valid_a_frame); + + body = EXISTS_TAC(body, `b:A`); + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC(result[0], refl_rule(`b:A`)); + ACCEPT_TAC(result[1], valid_b_frame); + return gnode_prove(root); +} + +PROOF thm R_OWN_UPDATE = + prove_r_own_update(); + +PROOF static thm prove_r_own_update_nd(void) { + term goal_tm = ` + forall + (R:(A)ra) + (a:A) + (result_pred:A->bool). + ra_update_nd R a result_pred ==> + r_viewshift + R + (r_own R a) + (r_exists + R + (\selected:A. + r_and + R + (r_pure R (result_pred selected)) + (r_own R selected))) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_viewshift_def, + r_entails_def, + r_bupd_def, + r_own_def, + r_exists_def, + r_and_def, + r_pure_def, + ra_update_nd_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "result_pred"); + body = DISCH_TAC(body, "Hupdate"); + body = GEN_TAC(body, "owned"); + body = DISCH_TAC(body, "Hvalid_owned"); + body = DISCH_TAC(body, "Howned"); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hvalid_source"); + + thm replace_owned = beta_rule(ap_term_rule( + `\base:A. + ra_op (R:(A)ra) base (frame:A)`, + assume_rule(`(owned:A) == (a:A)`))); + thm source_validity_eq = ap_term_rule( + `ra_valid (R:(A)ra):A->bool`, + replace_owned); + thm valid_a_frame = eq_mp_rule( + source_validity_eq, + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (owned:A) (frame:A)) + `)); + thm selected = mp_rule( + spec_rule( + `frame:A`, + assume_rule(` + forall frame:A. + ra_valid + (R:(A)ra) + (ra_op R (a:A) frame) ==> + exists selected:A. + (result_pred:A->bool) selected && + ra_valid R (ra_op R selected frame) + `)), + valid_a_frame); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "selected"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "Hresult", + "Hvalid_selected"); + + body = EXISTS_TAC(body, `selected:A`); + gnode_list result = CONJ_TAC(body); + gnode post = EXISTS_TAC(result[0], `selected:A`); + post = CONV_TAC( + post, + pure_rewrite_conv(THM_LIST( + r_and_def, + r_pure_def, + r_own_def))); + gnode_list post_parts = CONJ_TAC(post); + ACCEPT_TAC( + post_parts[0], + assume_rule(` + (result_pred:A->bool) (selected:A) + `)); + ACCEPT_TAC(post_parts[1], refl_rule(`selected:A`)); + ACCEPT_TAC( + result[1], + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (selected:A) (frame:A)) + `)); + return gnode_prove(root); +} + +PROOF thm R_OWN_UPDATE_ND = + prove_r_own_update_nd(); + +PROOF static int audit_basic_update(void) { + thm_list public_theorems = THM_LIST( + r_bupd_def, + r_viewshift_def, + R_BUPD_INTRO, + R_BUPD_MONO, + R_BUPD_IDEM, + R_BUPD_FRAME, + R_VIEWSHIFT_REFL, + R_ENTAILS_TO_VIEWSHIFT, + R_VIEWSHIFT_TRANS, + R_VIEWSHIFT_MONO, + R_VIEWSHIFT_FRAME, + R_VIEWSHIFT_SEP, + R_VIEWSHIFT_EXISTS_L, + R_VIEWSHIFT_EXISTS_R, + R_VIEWSHIFT_EXISTS, + R_OWN_UPDATE, + R_OWN_UPDATE_ND); + + for (size_t i = 0; i < vector_size(public_theorems); ++i) { + ENSURE_COND( + !IS_NULL(public_theorems[i]), + "basic-update theorem %zu is null", + i); + ENSURE_COND( + vector_size(hyp(public_theorems[i])) == 0, + "basic-update theorem %zu has hypotheses", + i); + } + ENSURE_COND( + vector_size(get_all_axioms()) == + BASIC_UPDATE_AXIOMS_BEFORE, + "basic-update theory introduced axioms"); + return 0; +err: + ERR_FUN_PUTS("audit_basic_update"); + return -1; +} + +PROOF static int _BASIC_UPDATE_AUDIT = + audit_basic_update(); diff --git a/theory/logic/basic_update.h b/theory/logic/basic_update.h new file mode 100644 index 0000000..00be5c9 --- /dev/null +++ b/theory/logic/basic_update.h @@ -0,0 +1,91 @@ +#pragma once + +/* + * Basic updates and view shifts over `R=(|R|, ε_R, ·_R, valid_R)`, + * where `R:(A)ra` and `|R|=A`. + * + * `r_bupd R Q a` is the nondeterministic frame-preserving update `a ↝ Q`: + * + * forall frame. valid(a op frame) ==> + * exists b. Q b && valid(b op frame). + * + * We write `P ⇛_R Q` below for the HOL proposition `r_viewshift R P Q`; + * formally `P ⇛_R Q` iff `P ⊢_R r_bupd R Q`. The result witness may + * depend on the hidden frame. + * This is a pure proof-stdlib theory: loading it registers no QCP descriptor, + * parser interface, or symbolic state. + */ + +#include "proof/theory/logic/resource_prop.h" + +/* ------------------------------------------------------------------------- */ +/* Core representation */ +/* ------------------------------------------------------------------------- */ + +/* `r_bupd R Q a <=> ra_update_nd R a Q`. */ +PROOF extern thm r_bupd_def; + +/* `r_viewshift R P Q <=> r_entails R P (r_bupd R Q)`. */ +PROOF extern thm r_viewshift_def; + +/* ------------------------------------------------------------------------- */ +/* Basic-update laws */ +/* ------------------------------------------------------------------------- */ + +/* `forall R P. P ⊢_R r_bupd R P`. */ +PROOF extern thm R_BUPD_INTRO; + +/* `P ⊢_R Q ==> r_bupd R P ⊢_R r_bupd R Q`. */ +PROOF extern thm R_BUPD_MONO; + +/* `r_bupd R (r_bupd R P) ⊢_R r_bupd R P`. */ +PROOF extern thm R_BUPD_IDEM; + +/* `(r_bupd R P)*F ⊢_R r_bupd R (P*F)`. */ +PROOF extern thm R_BUPD_FRAME; + +/* ------------------------------------------------------------------------- */ +/* View-shift laws */ +/* ------------------------------------------------------------------------- */ + +/* `forall R P. r_viewshift R P P`. */ +PROOF extern thm R_VIEWSHIFT_REFL; + +/* `P ⊢_R Q ==> r_viewshift R P Q`. */ +PROOF extern thm R_ENTAILS_TO_VIEWSHIFT; + +/* `P ⇛_R Q ==> Q ⇛_R S ==> P ⇛_R S`. */ +PROOF extern thm R_VIEWSHIFT_TRANS; + +/* `P2 ⊢_R P ==> P ⇛_R Q ==> Q ⊢_R Q2 ==> P2 ⇛_R Q2`. */ +PROOF extern thm R_VIEWSHIFT_MONO; + +/* `P ⇛_R Q ==> P*F ⇛_R Q*F`. */ +PROOF extern thm R_VIEWSHIFT_FRAME; + +/* `P1 ⇛_R Q1 ==> P2 ⇛_R Q2 ==> P1*P2 ⇛_R Q1*Q2`. */ +PROOF extern thm R_VIEWSHIFT_SEP; + +/* `(forall x:B. P x ⇛_R Q) ==> r_exists R (\x. P x) ⇛_R Q`. */ +PROOF extern thm R_VIEWSHIFT_EXISTS_L; + +/* `P ⇛_R Q witness ==> P ⇛_R r_exists R (\x. Q x)`. */ +PROOF extern thm R_VIEWSHIFT_EXISTS_R; + +/* `(forall x:B. P x ⇛_R Q x) ==> + * r_exists R (\x. P x) ⇛_R r_exists R (\x. Q x)`. */ +PROOF extern thm R_VIEWSHIFT_EXISTS; + +/* ------------------------------------------------------------------------- */ +/* Ownership updates */ +/* ------------------------------------------------------------------------- */ + +/* `ra_update R a b ==> r_viewshift R (r_own R a) (r_own R b)`. */ +PROOF extern thm R_OWN_UPDATE; + +/* + * `ra_update_nd R a P ==> + * r_viewshift R (r_own R a) + * (r_exists R (\b. r_and R (r_pure R (P b)) (r_own R b)))`. + */ +PROOF extern thm R_OWN_UPDATE_ND; diff --git a/theory/logic/ghost_heap.c b/theory/logic/ghost_heap.c new file mode 100644 index 0000000..738c296 --- /dev/null +++ b/theory/logic/ghost_heap.c @@ -0,0 +1,551 @@ +#include "proof/theory/logic/ghost_heap.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/gmap_ra.c" + +PROOF static size_t GHOST_HEAP_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF thm ghost_heap_ra_def = new_fun_definition(` + ghost_heap_ra (G:(A)ra) : ((num,A)finmap)ra = + gmap_ra G +`); + +PROOF static thm prove_ghost_heap_unit(void) { + term goal_tm = ` + forall G:(A)ra. + ra_unit (ghost_heap_ra G) == + (finmap_empty:(num,A)finmap) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + ghost_heap_ra_def, + GMAP_RA_UNIT))); + return gnode_prove(root); +} + +PROOF thm GHOST_HEAP_UNIT = + prove_ghost_heap_unit(); + +PROOF static thm prove_ghost_heap_op_lookup(void) { + term goal_tm = ` + forall + (G:(A)ra) + (h:(num,A)finmap) + (k:(num,A)finmap) + (name:num). + finmap_lookup + (ra_op (ghost_heap_ra G) h k) + name == + ra_op + (option_ra G) + (finmap_lookup h name) + (finmap_lookup k name) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + ghost_heap_ra_def, + GMAP_RA_OP_LOOKUP))); + return gnode_prove(root); +} + +PROOF thm GHOST_HEAP_OP_LOOKUP = + prove_ghost_heap_op_lookup(); + +PROOF static thm prove_ghost_heap_valid(void) { + term goal_tm = ` + forall (G:(A)ra) (h:(num,A)finmap). + ra_valid (ghost_heap_ra G) h <=> + forall name:num. + ra_valid + (option_ra G) + (finmap_lookup h name) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + ghost_heap_ra_def, + GMAP_RA_VALID))); + return gnode_prove(root); +} + +PROOF thm GHOST_HEAP_VALID = + prove_ghost_heap_valid(); + +PROOF static thm prove_ghost_heap_singleton_op(void) { + term goal_tm = ` + forall (G:(A)ra) (name:num) (a:A) (b:A). + ra_op + (ghost_heap_ra G) + (finmap_singleton name a) + (finmap_singleton name b) == + finmap_singleton name (ra_op G a b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + ghost_heap_ra_def, + GMAP_RA_SINGLETON_OP))); + return gnode_prove(root); +} + +PROOF thm GHOST_HEAP_SINGLETON_OP = + prove_ghost_heap_singleton_op(); + +PROOF static thm prove_ghost_heap_valid_singleton(void) { + term goal_tm = ` + forall (G:(A)ra) (name:num) (a:A). + ra_valid + (ghost_heap_ra G) + (finmap_singleton name a) <=> + ra_valid G a + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + ghost_heap_ra_def, + GMAP_RA_VALID_SINGLETON))); + return gnode_prove(root); +} + +PROOF thm GHOST_HEAP_VALID_SINGLETON = + prove_ghost_heap_valid_singleton(); + +PROOF static thm prove_ghost_heap_singleton_unit_ne_empty(void) { + term goal_tm = ` + forall (G:(A)ra) (name:num). + ~(finmap_singleton name (ra_unit G) == + (finmap_empty:(num,A)finmap)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "G"); + body = GEN_TAC(body, "name"); + body = DISCH_TAC(body, "Heq"); + thm lookup_eq = ap_term_rule( + `\h:(num,A)finmap. finmap_lookup h (name:num)`, + assume_rule(` + finmap_singleton (name:num) (ra_unit (G:(A)ra)) == + (finmap_empty:(num,A)finmap) + `)); + lookup_eq = rewrite_rule( + THM_LIST( + FINMAP_SINGLETON_LOOKUP, + FINMAP_EMPTY_LOOKUP, + get_theorem_by_name("option_DISTINCT")), + lookup_eq); + CONTR_TAC(body, lookup_eq); + return gnode_prove(root); +} + +PROOF thm GHOST_HEAP_SINGLETON_UNIT_NE_EMPTY = + prove_ghost_heap_singleton_unit_ne_empty(); + +PROOF static thm prove_ghost_heap_update_singleton(void) { + term goal_tm = ` + forall (G:(A)ra) (name:num) (a:A) (b:A). + ra_update G a b ==> + ra_update + (ghost_heap_ra G) + (finmap_singleton name a) + (finmap_singleton name b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ghost_heap_ra_def))); + thm lifted = mp_rule( + ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `name:num`, + `a:A`, + `b:A`), + GMAP_RA_UPDATE_SINGLETON), + assume_rule(`ra_update (G:(A)ra) (a:A) (b:A)`)); + ACCEPT_TAC(body, lifted); + return gnode_prove(root); +} + +PROOF thm GHOST_HEAP_UPDATE_SINGLETON = + prove_ghost_heap_update_singleton(); + +PROOF static thm prove_ghost_heap_update_singleton_nd(void) { + term goal_tm = ` + forall + (G:(A)ra) + (name:num) + (a:A) + (P:A->bool). + ra_update_nd G a P ==> + ra_update_nd + (ghost_heap_ra G) + (finmap_singleton name a) + (\h:(num,A)finmap. + exists b:A. + P b && h == finmap_singleton name b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ghost_heap_ra_def))); + thm lifted = mp_rule( + ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `name:num`, + `a:A`, + `P:A->bool`), + GMAP_RA_UPDATE_SINGLETON_ND), + assume_rule(` + ra_update_nd (G:(A)ra) (a:A) (P:A->bool) + `)); + ACCEPT_TAC(body, lifted); + return gnode_prove(root); +} + +PROOF thm GHOST_HEAP_UPDATE_SINGLETON_ND = + prove_ghost_heap_update_singleton_nd(); + +PROOF static thm prove_ghost_heap_fresh(void) { + term goal_tm = ` + forall h:(num,A)finmap. + exists name:num. + finmap_lookup h name == NONE + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "h"); + thm avoid = mp_rule( + ispec_rule( + `finmap_dom (h:(num,A)finmap)`, + get_theorem_by_name("num_FINITE_AVOID")), + ispec_rule( + `h:(num,A)finmap`, + FINMAP_DOM_FINITE)); + body = ASSUME_TAC(body, avoid, "Hfresh"); + body = ASMP_EXISTS_TAC(body, "Hfresh", "name"); + body = EXISTS_TAC(body, `name:num`); + thm fresh = rewrite_rule( + THM_LIST( + finmap_dom_def, + get_theorem_by_name("IN_ELIM_THM"), + get_theorem_by_name("NOT_CLAUSES")), + assume_rule(` + ~((name:num) IN finmap_dom (h:(num,A)finmap)) + `)); + ACCEPT_TAC(body, fresh); + return gnode_prove(root); +} + +PROOF thm GHOST_HEAP_FRESH = + prove_ghost_heap_fresh(); + +PROOF static thm prove_ghost_heap_fresh_pair(void) { + term goal_tm = ` + forall + (h:(num,A)finmap) + (frame:(num,A)finmap). + exists name:num. + finmap_lookup h name == NONE && + finmap_lookup frame name == NONE + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + term h_dom = `finmap_dom (h:(num,A)finmap)`; + term frame_dom = `finmap_dom (frame:(num,A)finmap)`; + term union_dom = ` + finmap_dom (h:(num,A)finmap) UNION + finmap_dom (frame:(num,A)finmap) + `; + thm union_finite = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST(h_dom, frame_dom), + get_theorem_by_name("FINITE_UNION"))), + conj_rule( + ispec_rule( + `h:(num,A)finmap`, + FINMAP_DOM_FINITE), + ispec_rule( + `frame:(num,A)finmap`, + FINMAP_DOM_FINITE))); + thm avoid = mp_rule( + ispec_rule( + union_dom, + get_theorem_by_name("num_FINITE_AVOID")), + union_finite); + body = ASSUME_TAC(body, avoid, "Hfresh"); + body = ASMP_EXISTS_TAC(body, "Hfresh", "name"); + body = EXISTS_TAC(body, `name:num`); + thm fresh = rewrite_rule( + THM_LIST( + get_theorem_by_name("IN_UNION"), + finmap_dom_def, + get_theorem_by_name("IN_ELIM_THM"), + get_theorem_by_name("DE_MORGAN_THM"), + get_theorem_by_name("NOT_CLAUSES")), + assume_rule(` + ~((name:num) IN + (finmap_dom (h:(num,A)finmap) UNION + finmap_dom (frame:(num,A)finmap))) + `)); + ACCEPT_TAC(body, fresh); + return gnode_prove(root); +} + +PROOF thm GHOST_HEAP_FRESH_PAIR = + prove_ghost_heap_fresh_pair(); + +PROOF static thm prove_ghost_heap_alloc(void) { + term goal_tm = ` + forall + (G:(A)ra) + (h:(num,A)finmap) + (a:A). + ra_valid G a ==> + ra_update_nd + (ghost_heap_ra G) + h + (\result:(num,A)finmap. + exists name:num. + finmap_lookup h name == NONE && + result == + ra_op + (ghost_heap_ra G) + h + (finmap_singleton name a)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + ghost_heap_ra_def, + ra_update_nd_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = AUTO_INTROS_TAC(body); + + thm source_all = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `ra_op + (gmap_ra (G:(A)ra)) + (h:(num,A)finmap) + (frame:(num,A)finmap)`), + GMAP_RA_VALID), + assume_rule(` + ra_valid + (gmap_ra (G:(A)ra)) + (ra_op + (gmap_ra G) + (h:(num,A)finmap) + (frame:(num,A)finmap)) + `)); + thm fresh = ispecl_rule( + TERM_LIST( + `h:(num,A)finmap`, + `frame:(num,A)finmap`), + GHOST_HEAP_FRESH_PAIR); + body = ASSUME_TAC(body, fresh, "Hfresh"); + body = ASMP_EXISTS_TAC(body, "Hfresh", "name"); + body = ASMP_CONJ_TAC( + body, + "Hfresh", + "Hheap_fresh", + "Hframe_fresh"); + body = EXISTS_TAC( + body, + `ra_op + (gmap_ra (G:(A)ra)) + (h:(num,A)finmap) + (finmap_singleton (name:num) (a:A))`); + gnode_list result_parts = CONJ_TAC(body); + + gnode image = EXISTS_TAC(result_parts[0], `name:num`); + gnode_list image_parts = CONJ_TAC(image); + ACCEPT_TAC( + image_parts[0], + assume_rule(` + finmap_lookup (h:(num,A)finmap) (name:num) == NONE + `)); + ACCEPT_TAC( + image_parts[1], + refl_rule(` + ra_op + (gmap_ra (G:(A)ra)) + (h:(num,A)finmap) + (finmap_singleton (name:num) (a:A)) + `)); + + gnode validity = CONV_TAC( + result_parts[1], + once_rewrite_conv(THM_LIST(GMAP_RA_VALID))); + validity = GEN_TAC(validity, "query"); + thm source_at = spec_rule(`query:num`, source_all); + source_at = rewrite_rule( + THM_LIST(GMAP_RA_OP_LOOKUP), + source_at); + gnode_list cases = BOOL_CASES_TAC( + validity, + `(query:num) == (name:num)`, + "Hname"); + + thm heap_fresh = assume_rule(` + finmap_lookup (h:(num,A)finmap) (name:num) == NONE + `); + thm frame_fresh = assume_rule(` + finmap_lookup (frame:(num,A)finmap) (name:num) == NONE + `); + thm equal_name = assume_rule(`query:num == name`); + gnode at_name = CONV_TAC( + cases[0], + rewrite_conv(THM_LIST( + equal_name, + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP, + heap_fresh, + frame_fresh, + OPTION_RA_OP_NONE_L, + OPTION_RA_OP_NONE_R, + OPTION_RA_VALID_SOME))); + ACCEPT_TAC( + at_name, + assume_rule(`ra_valid (G:(A)ra) (a:A)`)); + + thm unequal_name = assume_rule(`~(query:num == name)`); + gnode away = CONV_TAC( + cases[1], + rewrite_conv(THM_LIST( + unequal_name, + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_OP_NONE_R))); + ACCEPT_TAC(away, source_at); + return gnode_prove(root); +} + +PROOF thm GHOST_HEAP_ALLOC = + prove_ghost_heap_alloc(); + +PROOF static thm prove_ghost_heap_alloc_empty(void) { + term goal_tm = ` + forall (G:(A)ra) (a:A). + ra_valid G a ==> + ra_update_nd + (ghost_heap_ra G) + (finmap_empty:(num,A)finmap) + (\result:(num,A)finmap. + exists name:num. + result == finmap_singleton name a) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + term source_pred = ` + \result:(num,A)finmap. + exists name:num. + finmap_lookup + (finmap_empty:(num,A)finmap) + name == NONE && + result == + ra_op + (ghost_heap_ra (G:(A)ra)) + finmap_empty + (finmap_singleton name (a:A)) + `; + term target_pred = ` + \result:(num,A)finmap. + exists name:num. + result == finmap_singleton name (a:A) + `; + thm allocated = mp_rule( + ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `finmap_empty:(num,A)finmap`, + `a:A`), + GHOST_HEAP_ALLOC), + assume_rule(`ra_valid (G:(A)ra) (a:A)`)); + thm monotone = ispecl_rule( + TERM_LIST( + `ghost_heap_ra (G:(A)ra)`, + `finmap_empty:(num,A)finmap`, + source_pred, + target_pred), + RA_UPDATE_ND_MONO); + monotone = mp_rule(monotone, allocated); + monotone = conv_rule( + depth_conv(get_conversion_by_name("BETA_CONV")), + monotone); + body = MATCH_MP_TAC(body, monotone); + body = GEN_TAC(body, "result"); + body = DISCH_TAC(body, "Hresult"); + body = ASMP_EXISTS_TAC(body, "Hresult", "name"); + body = ASMP_CONJ_TAC( + body, + "Hresult", + "Hempty", + "Hresult_eq"); + body = EXISTS_TAC(body, `name:num`); + thm empty_as_unit = gsym_rule(ispec_rule( + `G:(A)ra`, + GHOST_HEAP_UNIT)); + thm result_eq = rewrite_rule( + THM_LIST( + empty_as_unit, + RA_UNIT_L), + assume_rule(` + (result:(num,A)finmap) == + ra_op + (ghost_heap_ra (G:(A)ra)) + (finmap_empty:(num,A)finmap) + (finmap_singleton (name:num) (a:A)) + `)); + ACCEPT_TAC(body, result_eq); + return gnode_prove(root); +} + +PROOF thm GHOST_HEAP_ALLOC_EMPTY = + prove_ghost_heap_alloc_empty(); + +PROOF static int audit_ghost_heap(void) { + thm_list public_theorems = THM_LIST( + ghost_heap_ra_def, + GHOST_HEAP_UNIT, + GHOST_HEAP_OP_LOOKUP, + GHOST_HEAP_VALID, + GHOST_HEAP_SINGLETON_OP, + GHOST_HEAP_VALID_SINGLETON, + GHOST_HEAP_SINGLETON_UNIT_NE_EMPTY, + GHOST_HEAP_UPDATE_SINGLETON, + GHOST_HEAP_UPDATE_SINGLETON_ND, + GHOST_HEAP_FRESH, + GHOST_HEAP_FRESH_PAIR, + GHOST_HEAP_ALLOC, + GHOST_HEAP_ALLOC_EMPTY); + + for (size_t i = 0; i < vector_size(public_theorems); ++i) { + ENSURE_COND(!IS_NULL(public_theorems[i]), + "ghost-heap theorem %zu is empty", i); + ENSURE_COND(vector_size(hyp(public_theorems[i])) == 0, + "ghost-heap theorem %zu has hypotheses", i); + } + ENSURE_COND(vector_size(get_all_axioms()) == GHOST_HEAP_AXIOMS_BEFORE, + "ghost-heap theory introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_ghost_heap"); + return -1; +} + +PROOF static int _GHOST_HEAP_AUDIT = audit_ghost_heap(); diff --git a/theory/logic/ghost_heap.h b/theory/logic/ghost_heap.h new file mode 100644 index 0000000..8177216 --- /dev/null +++ b/theory/logic/ghost_heap.h @@ -0,0 +1,116 @@ +#pragma once + +/* + * Named ghost heaps over `G=(|G|,ε_G,·_G,valid_G)`, where `G:(A)ra` + * and `|G|=A`. + * + * The carrier is `(num,A)finmap` and + * `ghost_heap_ra G = gmap_ra G`. Consequently each name is interpreted in + * `option_ra G`: `NONE` is unallocated and `SOME a` is allocated with payload + * `a`. In particular, `SOME (ra_unit G)` is not absence. + */ + +#include "proof/theory/logic/gmap_ra.h" + +/* ------------------------------------------------------------------------- */ +/* Core representation */ +/* ------------------------------------------------------------------------- */ + +/* `ghost_heap_ra (G:(A)ra) : ((num,A)finmap)ra = gmap_ra G`. */ +PROOF extern thm ghost_heap_ra_def; + +/* ------------------------------------------------------------------------- */ +/* Constructors and laws */ +/* ------------------------------------------------------------------------- */ + +/* `ra_unit (ghost_heap_ra G) == (finmap_empty:(num,A)finmap)`. */ +PROOF extern thm GHOST_HEAP_UNIT; + +/* + * `finmap_lookup (ra_op (ghost_heap_ra G) h k) name == + * ra_op (option_ra G) (finmap_lookup h name) (finmap_lookup k name)`. + */ +PROOF extern thm GHOST_HEAP_OP_LOOKUP; + +/* ------------------------------------------------------------------------- */ +/* Validity */ +/* ------------------------------------------------------------------------- */ + +/* + * `ra_valid (ghost_heap_ra G) h <=> + * forall name. ra_valid (option_ra G) (finmap_lookup h name)`. + */ +PROOF extern thm GHOST_HEAP_VALID; + +/* ------------------------------------------------------------------------- */ +/* Laws */ +/* ------------------------------------------------------------------------- */ + +/* + * `ra_op (ghost_heap_ra G) (finmap_singleton name a) + * (finmap_singleton name b) == + * finmap_singleton name (ra_op G a b)`. + */ +PROOF extern thm GHOST_HEAP_SINGLETON_OP; + +/* + * `ra_valid (ghost_heap_ra G) (finmap_singleton name a) <=> + * ra_valid G a`. + */ +PROOF extern thm GHOST_HEAP_VALID_SINGLETON; + +/* + * An allocated unit cell is not the heap unit: + * `~(finmap_singleton name (ra_unit G) == finmap_empty)`. + */ +PROOF extern thm GHOST_HEAP_SINGLETON_UNIT_NE_EMPTY; + +/* ------------------------------------------------------------------------- */ +/* Updates */ +/* ------------------------------------------------------------------------- */ + +/* + * `ra_update G a b ==> + * ra_update (ghost_heap_ra G) + * (finmap_singleton name a) (finmap_singleton name b)`. + */ +PROOF extern thm GHOST_HEAP_UPDATE_SINGLETON; + +/* + * `ra_update_nd G a P ==> + * ra_update_nd (ghost_heap_ra G) (finmap_singleton name a) + * (\h. exists b. P b && h == finmap_singleton name b)`. + */ +PROOF extern thm GHOST_HEAP_UPDATE_SINGLETON_ND; + +/* `forall h. exists name. finmap_lookup h name == NONE`. */ +PROOF extern thm GHOST_HEAP_FRESH; + +/* + * `forall h frame. exists name. + * finmap_lookup h name == NONE && finmap_lookup frame name == NONE`. + */ +PROOF extern thm GHOST_HEAP_FRESH_PAIR; + +/* + * `ra_valid G a ==> + * ra_update_nd (ghost_heap_ra G) h + * (\result. exists name. + * finmap_lookup h name == NONE && + * result == ra_op (ghost_heap_ra G) h + * (finmap_singleton name a))`. + * + * The selected `name` may depend on the hidden frame. The proof can choose it + * absent from both `h` and that frame in order to establish framed validity, + * but the public result predicate exposes only `finmap_lookup h name == NONE` + * and the result equation above; it does not expose frame freshness to a + * caller. + */ +PROOF extern thm GHOST_HEAP_ALLOC; + +/* + * `ra_valid G a ==> + * ra_update_nd (ghost_heap_ra G) finmap_empty + * (\result. exists name. result == finmap_singleton name a)`. + */ +PROOF extern thm GHOST_HEAP_ALLOC_EMPTY; diff --git a/theory/logic/ghost_own.c b/theory/logic/ghost_own.c new file mode 100644 index 0000000..ad74c66 --- /dev/null +++ b/theory/logic/ghost_own.c @@ -0,0 +1,225 @@ +#include "proof/theory/logic/ghost_own.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/ghost_heap.c" +#require "proof/theory/logic/resource_prop.c" + +PROOF static size_t GHOST_OWN_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF thm ghost_own_def = new_fun_definition(` + ghost_own + (G:(A)ra) + (name:num) + (a:A) + (heap:(num,A)finmap) <=> + r_own + (ghost_heap_ra G) + (finmap_singleton name a) + heap +`); + +PROOF static thm prove_ghost_own_as_r_own(void) { + term goal_tm = ` + forall (G:(A)ra) (name:num) (a:A). + ghost_own G name a == + r_own + (ghost_heap_ra G) + (finmap_singleton name a) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm funext = ispecl_rule( + TERM_LIST( + `ghost_own + (G:(A)ra) + (name:num) + (a:A)`, + `r_own + (ghost_heap_ra (G:(A)ra)) + (finmap_singleton (name:num) (a:A))`), + get_theorem_by_name("FUN_EQ_THM")); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(funext))); + body = GEN_TAC(body, "heap"); + CONV_TAC( + body, + rewrite_conv(THM_LIST(ghost_own_def))); + return gnode_prove(root); +} + +PROOF thm GHOST_OWN_AS_R_OWN = + prove_ghost_own_as_r_own(); + +PROOF static thm prove_ghost_own_op(void) { + term goal_tm = ` + forall (G:(A)ra) (name:num) (a:A) (b:A). + r_sep + (ghost_heap_ra G) + (ghost_own G name a) + (ghost_own G name b) == + ghost_own G name (ra_op G a b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + thm own_a = ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `name:num`, + `a:A`), + GHOST_OWN_AS_R_OWN); + thm own_b = ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `name:num`, + `b:A`), + GHOST_OWN_AS_R_OWN); + thm own_combined = ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `name:num`, + `ra_op (G:(A)ra) (a:A) (b:A)`), + GHOST_OWN_AS_R_OWN); + + thm replace_left = beta_rule(ap_term_rule( + `\left_pred:(num,A)finmap->bool. + r_sep + (ghost_heap_ra (G:(A)ra)) + left_pred + (ghost_own G (name:num) (b:A))`, + own_a)); + thm replace_right = beta_rule(ap_term_rule( + `\right_pred:(num,A)finmap->bool. + r_sep + (ghost_heap_ra (G:(A)ra)) + (r_own + (ghost_heap_ra G) + (finmap_singleton (name:num) (a:A))) + right_pred`, + own_b)); + + thm exact_op = gsym_rule(ispecl_rule( + TERM_LIST( + `ghost_heap_ra (G:(A)ra)`, + `finmap_singleton (name:num) (a:A)`, + `finmap_singleton (name:num) (b:A)`), + R_OWN_OP)); + thm heap_op = ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `name:num`, + `a:A`, + `b:A`), + GHOST_HEAP_SINGLETON_OP); + thm replace_owned = beta_rule(ap_term_rule( + `\owned:(num,A)finmap. + r_own (ghost_heap_ra (G:(A)ra)) owned`, + heap_op)); + + thm result = trans_rule( + replace_left, + trans_rule( + replace_right, + trans_rule( + exact_op, + trans_rule( + replace_owned, + gsym_rule(own_combined))))); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm GHOST_OWN_OP = + prove_ghost_own_op(); + +PROOF static thm prove_ghost_own_valid(void) { + term goal_tm = ` + forall (G:(A)ra) (name:num) (a:A). + r_entails + (ghost_heap_ra G) + (ghost_own G name a) + (r_and + (ghost_heap_ra G) + (r_pure + (ghost_heap_ra G) + (ra_valid G a)) + (ghost_own G name a)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + ghost_own_def, + r_own_def, + r_and_def, + r_pure_def))); + body = GEN_TAC(body, "G"); + body = GEN_TAC(body, "name"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "heap"); + body = DISCH_TAC(body, "Hvalid_heap"); + body = DISCH_TAC(body, "Howned"); + gnode_list result = CONJ_TAC(body); + + thm validity_eq = ap_term_rule( + `ra_valid + (ghost_heap_ra (G:(A)ra)): + (num,A)finmap->bool`, + assume_rule(` + (heap:(num,A)finmap) == + finmap_singleton (name:num) (a:A) + `)); + thm valid_singleton = eq_mp_rule( + validity_eq, + assume_rule(` + ra_valid + (ghost_heap_ra (G:(A)ra)) + (heap:(num,A)finmap) + `)); + thm singleton_valid_iff = ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `name:num`, + `a:A`), + GHOST_HEAP_VALID_SINGLETON); + ACCEPT_TAC( + result[0], + eq_mp_rule(singleton_valid_iff, valid_singleton)); + ACCEPT_TAC( + result[1], + assume_rule(` + (heap:(num,A)finmap) == + finmap_singleton (name:num) (a:A) + `)); + return gnode_prove(root); +} + +PROOF thm GHOST_OWN_VALID = + prove_ghost_own_valid(); + +PROOF static int audit_ghost_own(void) { + thm_list public_theorems = THM_LIST( + ghost_own_def, + GHOST_OWN_AS_R_OWN, + GHOST_OWN_OP, + GHOST_OWN_VALID); + + for (size_t i = 0; i < vector_size(public_theorems); ++i) { + ENSURE_COND(!IS_NULL(public_theorems[i]), + "ghost ownership theorem %zu is null", i); + ENSURE_COND(vector_size(hyp(public_theorems[i])) == 0, + "ghost ownership theorem %zu has hypotheses", i); + } + ENSURE_COND(vector_size(get_all_axioms()) == GHOST_OWN_AXIOMS_BEFORE, + "ghost ownership theory introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_ghost_own"); + return -1; +} + +PROOF static int _GHOST_OWN_AUDIT = audit_ghost_own(); diff --git a/theory/logic/ghost_own.h b/theory/logic/ghost_own.h new file mode 100644 index 0000000..9ba144c --- /dev/null +++ b/theory/logic/ghost_own.h @@ -0,0 +1,42 @@ +#pragma once + +/* + * Exact ownership of one named ghost cell. + * + * `ghost_own G name a` is an assertion over `ghost_heap_ra G`; it owns exactly + * `finmap_singleton name a`. It neither absorbs unrelated cells nor turns a + * unit payload into `r_emp`. + */ + +#include "proof/theory/logic/ghost_heap.h" +#include "proof/theory/logic/resource_prop.h" + +/* ------------------------------------------------------------------------- */ +/* Ownership */ +/* ------------------------------------------------------------------------- */ + +/* + * `ghost_own G name a heap <=> + * r_own (ghost_heap_ra G) (finmap_singleton name a) heap`. + */ +PROOF extern thm ghost_own_def; + +/* + * `ghost_own G name a == + * r_own (ghost_heap_ra G) (finmap_singleton name a)`. + */ +PROOF extern thm GHOST_OWN_AS_R_OWN; + +/* + * `r_sep (ghost_heap_ra G) (ghost_own G name a) (ghost_own G name b) == + * ghost_own G name (ra_op G a b)`. + */ +PROOF extern thm GHOST_OWN_OP; + +/* + * `ghost_own G name a ⊢_(ghost_heap_ra G) + * r_and (ghost_heap_ra G) + * (r_pure (ghost_heap_ra G) (ra_valid G a)) + * (ghost_own G name a)`. + */ +PROOF extern thm GHOST_OWN_VALID; diff --git a/theory/logic/ghost_update.c b/theory/logic/ghost_update.c new file mode 100644 index 0000000..e05e85b --- /dev/null +++ b/theory/logic/ghost_update.c @@ -0,0 +1,537 @@ +#include "proof/theory/logic/ghost_update.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/basic_update.c" +#require "proof/theory/logic/ghost_heap.c" +#require "proof/theory/logic/ghost_own.c" + +PROOF static size_t GHOST_UPDATE_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF static thm prove_ghost_own_update(void) { + term goal_tm = ` + forall (G:(A)ra) (name:num) (a:A) (b:A). + ra_update G a b ==> + r_viewshift + (ghost_heap_ra G) + (ghost_own G name a) + (ghost_own G name b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + thm heap_update = mp_rule( + ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `name:num`, + `a:A`, + `b:A`), + GHOST_HEAP_UPDATE_SINGLETON), + assume_rule(`ra_update (G:(A)ra) (a:A) (b:A)`)); + thm logical_update = mp_rule( + ispecl_rule( + TERM_LIST( + `ghost_heap_ra (G:(A)ra)`, + `finmap_singleton (name:num) (a:A)`, + `finmap_singleton (name:num) (b:A)`), + R_OWN_UPDATE), + heap_update); + + thm own_a = gsym_rule(ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `name:num`, + `a:A`), + GHOST_OWN_AS_R_OWN)); + thm pre_eq = beta_rule(ap_term_rule( + `\pre:(num,A)finmap->bool. + r_viewshift + (ghost_heap_ra (G:(A)ra)) + pre + (r_own + (ghost_heap_ra G) + (finmap_singleton (name:num) (b:A)))`, + own_a)); + thm pre_changed = eq_mp_rule(pre_eq, logical_update); + + thm own_b = gsym_rule(ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `name:num`, + `b:A`), + GHOST_OWN_AS_R_OWN)); + thm post_eq = beta_rule(ap_term_rule( + `\post:(num,A)finmap->bool. + r_viewshift + (ghost_heap_ra (G:(A)ra)) + (ghost_own G (name:num) (a:A)) + post`, + own_b)); + ACCEPT_TAC(body, eq_mp_rule(post_eq, pre_changed)); + return gnode_prove(root); +} + +PROOF thm GHOST_OWN_UPDATE = + prove_ghost_own_update(); + +PROOF static thm prove_ghost_own_update_nd(void) { + term goal_tm = ` + forall + (G:(A)ra) + (name:num) + (a:A) + (result_pred:A->bool). + ra_update_nd G a result_pred ==> + r_viewshift + (ghost_heap_ra G) + (ghost_own G name a) + (r_exists + (ghost_heap_ra G) + (\selected:A. + r_and + (ghost_heap_ra G) + (r_pure + (ghost_heap_ra G) + (result_pred selected)) + (ghost_own G name selected))) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_viewshift_def, + r_entails_def, + r_bupd_def, + ghost_own_def, + r_own_def, + r_exists_def, + r_and_def, + r_pure_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST( + ghost_own_def, + r_own_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = GEN_TAC(body, "G"); + body = GEN_TAC(body, "name"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "result_pred"); + body = DISCH_TAC(body, "Hlocal_update"); + body = GEN_TAC(body, "owned_heap"); + body = DISCH_TAC(body, "Hvalid_owned_heap"); + body = DISCH_TAC(body, "Howned"); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hvalid_source"); + + thm heap_update = mp_rule( + ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `name:num`, + `a:A`, + `result_pred:A->bool`), + GHOST_HEAP_UPDATE_SINGLETON_ND), + assume_rule(` + ra_update_nd + (G:(A)ra) + (a:A) + (result_pred:A->bool) + `)); + thm unfolded_heap_update = rewrite_rule( + THM_LIST(ra_update_nd_def), + heap_update); + + thm replace_owned = beta_rule(ap_term_rule( + `\base:(num,A)finmap. + ra_op + (ghost_heap_ra (G:(A)ra)) + base + (frame:(num,A)finmap)`, + assume_rule(` + (owned_heap:(num,A)finmap) == + finmap_singleton (name:num) (a:A) + `))); + thm source_validity_eq = ap_term_rule( + `ra_valid + (ghost_heap_ra (G:(A)ra)): + (num,A)finmap->bool`, + replace_owned); + thm valid_singleton_source = eq_mp_rule( + source_validity_eq, + assume_rule(` + ra_valid + (ghost_heap_ra (G:(A)ra)) + (ra_op + (ghost_heap_ra G) + (owned_heap:(num,A)finmap) + (frame:(num,A)finmap)) + `)); + thm selected = mp_rule( + spec_rule(`frame:(num,A)finmap`, unfolded_heap_update), + valid_singleton_source); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "result_heap"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "Hresult", + "Hvalid_result"); + + body = EXISTS_TAC(body, `result_heap:(num,A)finmap`); + gnode_list result = CONJ_TAC(body); + gnode post = CONV_TAC( + result[0], + pure_rewrite_conv(THM_LIST( + r_exists_def, + r_and_def, + r_pure_def, + ghost_own_def, + r_own_def))); + post = CONV_TAC( + post, + depth_conv(get_conversion_by_name("BETA_CONV"))); + post = CONV_TAC( + post, + pure_rewrite_conv(THM_LIST( + r_and_def, + r_pure_def, + ghost_own_def, + r_own_def))); + post = CONV_TAC( + post, + depth_conv(get_conversion_by_name("BETA_CONV"))); + ACCEPT_TAC( + post, + assume_rule(` + exists selected:A. + (result_pred:A->bool) selected && + (result_heap:(num,A)finmap) == + finmap_singleton (name:num) selected + `)); + ACCEPT_TAC( + result[1], + assume_rule(` + ra_valid + (ghost_heap_ra (G:(A)ra)) + (ra_op + (ghost_heap_ra G) + (result_heap:(num,A)finmap) + (frame:(num,A)finmap)) + `)); + return gnode_prove(root); +} + +PROOF thm GHOST_OWN_UPDATE_ND = + prove_ghost_own_update_nd(); + +PROOF static thm prove_ghost_own_alloc_empty(void) { + term goal_tm = ` + forall (G:(A)ra) (a:A). + ra_valid G a ==> + r_viewshift + (ghost_heap_ra G) + (r_emp (ghost_heap_ra G)) + (r_exists + (ghost_heap_ra G) + (\name:num. + ghost_own G name a)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_viewshift_def, + r_entails_def, + r_bupd_def, + r_emp_def, + r_exists_def, + ghost_own_def, + r_own_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST( + ghost_own_def, + r_own_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = GEN_TAC(body, "G"); + body = GEN_TAC(body, "a"); + body = DISCH_TAC(body, "Hvalid_a"); + body = GEN_TAC(body, "owned_heap"); + body = DISCH_TAC(body, "Hvalid_owned_heap"); + body = DISCH_TAC(body, "Hemp"); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hvalid_source"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST( + r_exists_def, + ghost_own_def, + r_own_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST( + ghost_own_def, + r_own_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + + thm allocation = mp_rule( + ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `a:A`), + GHOST_HEAP_ALLOC_EMPTY), + assume_rule(`ra_valid (G:(A)ra) (a:A)`)); + thm unfolded_allocation = rewrite_rule( + THM_LIST(ra_update_nd_def), + allocation); + + thm owned_eq_empty = trans_rule( + assume_rule(` + (owned_heap:(num,A)finmap) == + ra_unit (ghost_heap_ra (G:(A)ra)) + `), + ispec_rule(`G:(A)ra`, GHOST_HEAP_UNIT)); + thm replace_owned = beta_rule(ap_term_rule( + `\base:(num,A)finmap. + ra_op + (ghost_heap_ra (G:(A)ra)) + base + (frame:(num,A)finmap)`, + owned_eq_empty)); + thm source_validity_eq = ap_term_rule( + `ra_valid + (ghost_heap_ra (G:(A)ra)): + (num,A)finmap->bool`, + replace_owned); + thm valid_empty_source = eq_mp_rule( + source_validity_eq, + assume_rule(` + ra_valid + (ghost_heap_ra (G:(A)ra)) + (ra_op + (ghost_heap_ra G) + (owned_heap:(num,A)finmap) + (frame:(num,A)finmap)) + `)); + thm selected = mp_rule( + spec_rule( + `frame:(num,A)finmap`, + unfolded_allocation), + valid_empty_source); + ACCEPT_TAC(body, selected); + return gnode_prove(root); +} + +PROOF thm GHOST_OWN_ALLOC_EMPTY = + prove_ghost_own_alloc_empty(); + +PROOF static thm prove_ghost_own_alloc(void) { + term goal_tm = ` + forall + (G:(A)ra) + (a:A) + (P:(num,A)finmap->bool). + ra_valid G a ==> + r_viewshift + (ghost_heap_ra G) + P + (r_exists + (ghost_heap_ra G) + (\name:num. + r_sep + (ghost_heap_ra G) + (ghost_own G name a) + P)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_viewshift_def, + r_entails_def, + r_bupd_def, + r_exists_def, + r_sep_def, + ghost_own_def, + r_own_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = GEN_TAC(body, "G"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "P"); + body = DISCH_TAC(body, "Hvalid_a"); + body = GEN_TAC(body, "owned_heap"); + body = DISCH_TAC(body, "Hvalid_owned_heap"); + body = DISCH_TAC(body, "HP"); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hvalid_source"); + + thm allocation = mp_rule( + ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `owned_heap:(num,A)finmap`, + `a:A`), + GHOST_HEAP_ALLOC), + assume_rule(`ra_valid (G:(A)ra) (a:A)`)); + thm unfolded_allocation = rewrite_rule( + THM_LIST(ra_update_nd_def), + allocation); + thm selected = mp_rule( + spec_rule( + `frame:(num,A)finmap`, + unfolded_allocation), + assume_rule(` + ra_valid + (ghost_heap_ra (G:(A)ra)) + (ra_op + (ghost_heap_ra G) + (owned_heap:(num,A)finmap) + (frame:(num,A)finmap)) + `)); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "result_heap"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "Hallocated", + "Hvalid_result"); + body = ASMP_EXISTS_TAC(body, "Hallocated", "name"); + body = ASMP_CONJ_TAC( + body, + "Hallocated", + "Hfresh", + "Hresult_eq"); + + body = EXISTS_TAC(body, `result_heap:(num,A)finmap`); + gnode_list result = CONJ_TAC(body); + + gnode post = CONV_TAC( + result[0], + pure_rewrite_conv(THM_LIST( + r_exists_def, + r_sep_def, + ghost_own_def, + r_own_def))); + post = CONV_TAC( + post, + depth_conv(get_conversion_by_name("BETA_CONV"))); + post = CONV_TAC( + post, + pure_rewrite_conv(THM_LIST( + r_sep_def, + ghost_own_def, + r_own_def))); + post = CONV_TAC( + post, + depth_conv(get_conversion_by_name("BETA_CONV"))); + post = CONV_TAC( + post, + pure_rewrite_conv(THM_LIST( + ghost_own_def, + r_own_def))); + post = CONV_TAC( + post, + depth_conv(get_conversion_by_name("BETA_CONV"))); + post = EXISTS_TAC(post, `name:num`); + post = EXISTS_TAC( + post, + `finmap_singleton (name:num) (a:A)`); + post = EXISTS_TAC( + post, + `owned_heap:(num,A)finmap`); + gnode_list post1 = CONJ_TAC(post); + + thm result_eq = assume_rule(` + (result_heap:(num,A)finmap) == + ra_op + (ghost_heap_ra (G:(A)ra)) + (owned_heap:(num,A)finmap) + (finmap_singleton (name:num) (a:A)) + `); + thm op_commuted = trans_rule( + result_eq, + ispecl_rule( + TERM_LIST( + `ghost_heap_ra (G:(A)ra)`, + `owned_heap:(num,A)finmap`, + `finmap_singleton (name:num) (a:A)`), + RA_COMM)); + ACCEPT_TAC(post1[0], op_commuted); + gnode_list post2 = CONJ_TAC(post1[1]); + ACCEPT_TAC( + post2[0], + refl_rule(`finmap_singleton (name:num) (a:A)`)); + ACCEPT_TAC( + post2[1], + assume_rule(` + (P:(num,A)finmap->bool) + (owned_heap:(num,A)finmap) + `)); + + ACCEPT_TAC( + result[1], + assume_rule(` + ra_valid + (ghost_heap_ra (G:(A)ra)) + (ra_op + (ghost_heap_ra G) + (result_heap:(num,A)finmap) + (frame:(num,A)finmap)) + `)); + return gnode_prove(root); +} + +PROOF thm GHOST_OWN_ALLOC = + prove_ghost_own_alloc(); + +PROOF static int audit_ghost_update(void) { + thm_list public_theorems = THM_LIST( + GHOST_OWN_UPDATE, + GHOST_OWN_UPDATE_ND, + GHOST_OWN_ALLOC_EMPTY, + GHOST_OWN_ALLOC); + + for (size_t i = 0; i < vector_size(public_theorems); ++i) { + ENSURE_COND(!IS_NULL(public_theorems[i]), + "ghost-update theorem %zu is null", i); + ENSURE_COND(vector_size(hyp(public_theorems[i])) == 0, + "ghost-update theorem %zu has hypotheses", i); + } + ENSURE_COND(vector_size(get_all_axioms()) == GHOST_UPDATE_AXIOMS_BEFORE, + "ghost-update theory introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_ghost_update"); + return -1; +} + +PROOF static int _GHOST_UPDATE_AUDIT = audit_ghost_update(); diff --git a/theory/logic/ghost_update.h b/theory/logic/ghost_update.h new file mode 100644 index 0000000..7ea7b5a --- /dev/null +++ b/theory/logic/ghost_update.h @@ -0,0 +1,50 @@ +#pragma once + +/* + * View-shift rules for named ghost ownership. + * + * Every conclusion below is a view shift `P ⇛_(ghost_heap_ra G) Q`. + * Fixed-name rules preserve the name. Allocation existentially returns a + * `num` selected after the hidden frame is known and exposes ownership at that + * name; its target contains no separate pure freshness proposition. + */ + +#include "proof/theory/logic/basic_update.h" +#include "proof/theory/logic/ghost_heap.h" +#include "proof/theory/logic/ghost_own.h" + +/* ------------------------------------------------------------------------- */ +/* Ownership updates */ +/* ------------------------------------------------------------------------- */ + +/* + * `ra_update G a b ==> + * r_viewshift (ghost_heap_ra G) + * (ghost_own G name a) (ghost_own G name b)`. + */ +PROOF extern thm GHOST_OWN_UPDATE; + +/* + * `ra_update_nd G a P ==> + * r_viewshift (ghost_heap_ra G) (ghost_own G name a) + * (r_exists (ghost_heap_ra G) + * (\b. r_and (ghost_heap_ra G) + * (r_pure (ghost_heap_ra G) (P b)) + * (ghost_own G name b)))`. + */ +PROOF extern thm GHOST_OWN_UPDATE_ND; + +/* + * `ra_valid G a ==> + * r_viewshift (ghost_heap_ra G) (r_emp (ghost_heap_ra G)) + * (r_exists (ghost_heap_ra G) (\name. ghost_own G name a))`. + */ +PROOF extern thm GHOST_OWN_ALLOC_EMPTY; + +/* + * `ra_valid G a ==> + * r_viewshift (ghost_heap_ra G) P + * (r_exists (ghost_heap_ra G) + * (\name. r_sep (ghost_heap_ra G) (ghost_own G name a) P))`. + */ +PROOF extern thm GHOST_OWN_ALLOC; diff --git a/theory/logic/resource_prop.c b/theory/logic/resource_prop.c new file mode 100644 index 0000000..d4224d7 --- /dev/null +++ b/theory/logic/resource_prop.c @@ -0,0 +1,2896 @@ +#include "proof/theory/logic/resource_prop.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/ra.c" + +/* + * The proof helpers come directly from the proof stdlib's backward-reasoning + * layer. This module does not register any constant or rule with QCP. + */ + +PROOF static size_t RESOURCE_PROP_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF thm r_entails_def = new_fun_definition(` + r_entails + (R:(A)ra) + (P:A->bool) + (Q:A->bool) <=> + forall resource:A. + ra_valid R resource ==> + P resource ==> + Q resource +`); + +PROOF thm r_equiv_def = new_fun_definition(` + r_equiv + (R:(A)ra) + (P:A->bool) + (Q:A->bool) <=> + r_entails R P Q && + r_entails R Q P +`); + +PROOF thm r_emp_def = new_fun_definition(` + r_emp + (R:(A)ra) + (resource:A) <=> + resource == ra_unit R +`); + +PROOF thm r_sep_def = new_fun_definition(` + r_sep + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (resource:A) <=> + exists left right:A. + resource == ra_op R left right && + P left && + Q right +`); + +PROOF thm r_own_def = new_fun_definition(` + r_own + (R:(A)ra) + (owned:A) + (resource:A) <=> + resource == owned +`); + +PROOF thm r_top_def = new_fun_definition(` + r_top + (R:(A)ra) + (resource:A) <=> + T +`); + +PROOF thm r_bottom_def = new_fun_definition(` + r_bottom + (R:(A)ra) + (resource:A) <=> + F +`); + +PROOF thm r_and_def = new_fun_definition(` + r_and + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (resource:A) <=> + P resource && + Q resource +`); + +PROOF thm r_or_def = new_fun_definition(` + r_or + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (resource:A) <=> + P resource || + Q resource +`); + +PROOF thm r_impl_def = new_fun_definition(` + r_impl + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (resource:A) <=> + P resource ==> + Q resource +`); + +PROOF thm r_exists_def = new_fun_definition(` + r_exists + (R:(A)ra) + (P:B->A->bool) + (resource:A) <=> + exists witness:B. + P witness resource +`); + +PROOF thm r_forall_def = new_fun_definition(` + r_forall + (R:(A)ra) + (P:B->A->bool) + (resource:A) <=> + forall witness:B. + P witness resource +`); + +PROOF thm r_pure_def = new_fun_definition(` + r_pure + (R:(A)ra) + (phi:bool) + (resource:A) <=> + phi +`); + +PROOF thm r_fact_def = new_fun_definition(` + r_fact + (R:(A)ra) + (phi:bool) + (resource:A) <=> + phi && + resource == ra_unit R +`); + +PROOF thm r_wand_def = new_fun_definition(` + r_wand + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (resource:A) <=> + forall frame:A. + ra_valid R (ra_op R resource frame) ==> + P frame ==> + Q (ra_op R resource frame) +`); + +PROOF static thm prove_r_entails_refl(void) { + term goal_tm = ` + forall (R:(A)ra) (P:A->bool). + r_entails R P P + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(r_entails_def))); + body = AUTO_INTROS_TAC(body); + ACCEPT_TAC(body, assume_rule(`(P:A->bool) (resource:A)`)); + return gnode_prove(root); +} + +PROOF thm R_ENTAILS_REFL = + prove_r_entails_refl(); + +PROOF static thm prove_r_entails_trans(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (S:A->bool). + r_entails R P Q ==> + r_entails R Q S ==> + r_entails R P S + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(r_entails_def))); + body = AUTO_INTROS_TAC(body); + + thm q_resource = mp_rule( + mp_rule( + spec_rule( + `resource:A`, + assume_rule(` + forall resource:A. + ra_valid (R:(A)ra) resource ==> + (P:A->bool) resource ==> + (Q:A->bool) resource + `)), + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)), + assume_rule(`(P:A->bool) (resource:A)`)); + thm s_resource = mp_rule( + mp_rule( + spec_rule( + `resource:A`, + assume_rule(` + forall resource:A. + ra_valid (R:(A)ra) resource ==> + (Q:A->bool) resource ==> + (S:A->bool) resource + `)), + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)), + q_resource); + ACCEPT_TAC(body, s_resource); + return gnode_prove(root); +} + +PROOF thm R_ENTAILS_TRANS = + prove_r_entails_trans(); + +PROOF static thm prove_r_entails_pointwise(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool). + (forall resource:A. + P resource ==> Q resource) ==> + r_entails R P Q + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(r_entails_def))); + body = AUTO_INTROS_TAC(body); + thm result = mp_rule( + spec_rule( + `resource:A`, + assume_rule(` + forall resource:A. + (P:A->bool) resource ==> + (Q:A->bool) resource + `)), + assume_rule(`(P:A->bool) (resource:A)`)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_ENTAILS_POINTWISE = + prove_r_entails_pointwise(); + +PROOF static thm prove_r_equiv_pointwise(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool). + r_equiv R P Q <=> + forall resource:A. + ra_valid R resource ==> + (P resource <=> Q resource) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_equiv_def, + r_entails_def))); + body = AUTO_INTROS_TAC(body); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hboth"); + forward = ASMP_CONJ_TAC( + forward, + "Hboth", + "HPQ", + "HQP"); + forward = GEN_TAC(forward, "resource"); + forward = DISCH_TAC(forward, "Hvalid"); + gnode_list iff_directions = EQ_TAC(forward); + + gnode pq = DISCH_TAC(iff_directions[0], "HP"); + thm q_resource = mp_rule( + mp_rule( + spec_rule( + `resource:A`, + assume_rule(` + forall resource:A. + ra_valid (R:(A)ra) resource ==> + (P:A->bool) resource ==> + (Q:A->bool) resource + `)), + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)), + assume_rule(`(P:A->bool) (resource:A)`)); + ACCEPT_TAC(pq, q_resource); + + gnode qp = DISCH_TAC(iff_directions[1], "HQ"); + thm p_resource = mp_rule( + mp_rule( + spec_rule( + `resource:A`, + assume_rule(` + forall resource:A. + ra_valid (R:(A)ra) resource ==> + (Q:A->bool) resource ==> + (P:A->bool) resource + `)), + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)), + assume_rule(`(Q:A->bool) (resource:A)`)); + ACCEPT_TAC(qp, p_resource); + + gnode reverse = DISCH_TAC(directions[1], "Hpointwise"); + gnode_list both = CONJ_TAC(reverse); + + gnode reverse_pq = AUTO_INTROS_TAC(both[0]); + thm pointwise_pq = mp_rule( + spec_rule( + `resource:A`, + assume_rule(` + forall resource:A. + ra_valid (R:(A)ra) resource ==> + ((P:A->bool) resource <=> + (Q:A->bool) resource) + `)), + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)); + ACCEPT_TAC( + reverse_pq, + eq_mp_rule( + pointwise_pq, + assume_rule(`(P:A->bool) (resource:A)`))); + + gnode reverse_qp = AUTO_INTROS_TAC(both[1]); + thm pointwise_qp = mp_rule( + spec_rule( + `resource:A`, + assume_rule(` + forall resource:A. + ra_valid (R:(A)ra) resource ==> + ((P:A->bool) resource <=> + (Q:A->bool) resource) + `)), + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)); + ACCEPT_TAC( + reverse_qp, + eq_mp_rule( + gsym_rule(pointwise_qp), + assume_rule(`(Q:A->bool) (resource:A)`))); + return gnode_prove(root); +} + +PROOF thm R_EQUIV_POINTWISE = + prove_r_equiv_pointwise(); + +PROOF static thm prove_r_equiv_intro(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool). + r_entails R P Q ==> + r_entails R Q P ==> + r_equiv R P Q + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(r_equiv_def))); + body = AUTO_INTROS_TAC(body); + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC( + result[0], + assume_rule(`r_entails (R:(A)ra) (P:A->bool) (Q:A->bool)`)); + ACCEPT_TAC( + result[1], + assume_rule(`r_entails (R:(A)ra) (Q:A->bool) (P:A->bool)`)); + return gnode_prove(root); +} + +PROOF thm R_EQUIV_INTRO = + prove_r_equiv_intro(); + +PROOF static thm prove_r_equiv_refl(void) { + term goal_tm = ` + forall (R:(A)ra) (P:A->bool). + r_equiv R P P + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(r_equiv_def))); + body = AUTO_INTROS_TAC(body); + gnode_list parts = CONJ_TAC(body); + ACCEPT_TAC( + parts[0], + ispecl_rule( + TERM_LIST(`R:(A)ra`, `P:A->bool`), + R_ENTAILS_REFL)); + ACCEPT_TAC( + parts[1], + ispecl_rule( + TERM_LIST(`R:(A)ra`, `P:A->bool`), + R_ENTAILS_REFL)); + return gnode_prove(root); +} + +PROOF thm R_EQUIV_REFL = + prove_r_equiv_refl(); + +PROOF static thm prove_r_equiv_sym(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool). + r_equiv R P Q ==> + r_equiv R Q P + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(r_equiv_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = DISCH_TAC(body, "Hboth"); + body = ASMP_CONJ_TAC( + body, + "Hboth", + "HPQ", + "HQP"); + gnode_list parts = CONJ_TAC(body); + ACCEPT_TAC( + parts[0], + assume_rule(`r_entails (R:(A)ra) (Q:A->bool) (P:A->bool)`)); + ACCEPT_TAC( + parts[1], + assume_rule(`r_entails (R:(A)ra) (P:A->bool) (Q:A->bool)`)); + return gnode_prove(root); +} + +PROOF thm R_EQUIV_SYM = + prove_r_equiv_sym(); + +PROOF static thm prove_r_equiv_trans(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (S:A->bool). + r_equiv R P Q ==> + r_equiv R Q S ==> + r_equiv R P S + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(r_equiv_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = GEN_TAC(body, "S"); + body = DISCH_TAC(body, "HPQ_and_QP"); + body = DISCH_TAC(body, "HQS_and_SQ"); + body = ASMP_CONJ_TAC( + body, + "HPQ_and_QP", + "HPQ", + "HQP"); + body = ASMP_CONJ_TAC( + body, + "HQS_and_SQ", + "HQS", + "HSQ"); + gnode_list parts = CONJ_TAC(body); + + thm ps = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `P:A->bool`, + `Q:A->bool`, + `S:A->bool`), + R_ENTAILS_TRANS), + assume_rule(` + r_entails (R:(A)ra) (P:A->bool) (Q:A->bool) + `)), + assume_rule(` + r_entails (R:(A)ra) (Q:A->bool) (S:A->bool) + `)); + ACCEPT_TAC(parts[0], ps); + + thm sp = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `S:A->bool`, + `Q:A->bool`, + `P:A->bool`), + R_ENTAILS_TRANS), + assume_rule(` + r_entails (R:(A)ra) (S:A->bool) (Q:A->bool) + `)), + assume_rule(` + r_entails (R:(A)ra) (Q:A->bool) (P:A->bool) + `)); + ACCEPT_TAC(parts[1], sp); + return gnode_prove(root); +} + +PROOF thm R_EQUIV_TRANS = + prove_r_equiv_trans(); + +PROOF static thm prove_r_sep_comm(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool). + r_sep R P Q == + r_sep R Q P + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm funext = ispecl_rule( + TERM_LIST( + `r_sep (R:(A)ra) (P:A->bool) (Q:A->bool)`, + `r_sep (R:(A)ra) (Q:A->bool) (P:A->bool)`), + get_theorem_by_name("FUN_EQ_THM")); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(funext))); + body = GEN_TAC(body, "resource"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(r_sep_def))); + gnode_list directions = EQ_TAC(body); + + for (size_t i = 0; i < vector_size(directions); ++i) { + const char* first_pred = i == 0 ? "HP" : "HQ"; + const char* second_pred = i == 0 ? "HQ" : "HP"; + gnode branch = DISCH_TAC(directions[i], "Hsep"); + branch = ASMP_EXISTS_TAC(branch, "Hsep", "left"); + branch = ASMP_EXISTS_TAC(branch, "Hsep", "right"); + branch = ASMP_CONJ_TAC( + branch, + "Hsep", + "Hsplit", + "Hpreds"); + branch = ASMP_CONJ_TAC( + branch, + "Hpreds", + first_pred, + second_pred); + branch = EXISTS_TAC(branch, `right:A`); + branch = EXISTS_TAC(branch, `left:A`); + gnode_list result1 = CONJ_TAC(branch); + thm swapped = trans_rule( + assume_rule(` + (resource:A) == + ra_op (R:(A)ra) (left:A) (right:A) + `), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `left:A`, + `right:A`), + RA_COMM)); + ACCEPT_TAC(result1[0], swapped); + gnode_list result2 = CONJ_TAC(result1[1]); + ACCEPT_TAC( + result2[0], + assume_rule( + i == 0 + ? `(Q:A->bool) (right:A)` + : `(P:A->bool) (right:A)`)); + ACCEPT_TAC( + result2[1], + assume_rule( + i == 0 + ? `(P:A->bool) (left:A)` + : `(Q:A->bool) (left:A)`)); + } + return gnode_prove(root); +} + +PROOF thm R_SEP_COMM = + prove_r_sep_comm(); + +PROOF static thm prove_r_sep_emp_l(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool). + r_sep R (r_emp R) P == + P + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm funext = ispecl_rule( + TERM_LIST( + `r_sep + (R:(A)ra) + (r_emp R) + (P:A->bool)`, + `P:A->bool`), + get_theorem_by_name("FUN_EQ_THM")); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(funext))); + body = GEN_TAC(body, "resource"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST( + r_sep_def, + r_emp_def))); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hsep"); + forward = ASMP_EXISTS_TAC(forward, "Hsep", "left"); + forward = ASMP_EXISTS_TAC(forward, "Hsep", "right"); + forward = ASMP_CONJ_TAC( + forward, + "Hsep", + "Hsplit", + "Hpreds"); + forward = ASMP_CONJ_TAC( + forward, + "Hpreds", + "Hleft_unit", + "HP"); + + thm replace_left = beta_rule(ap_term_rule( + `\replacement:A. + ra_op (R:(A)ra) replacement (right:A)`, + assume_rule(` + (left:A) == ra_unit (R:(A)ra) + `))); + thm resource_eq_right = trans_rule( + assume_rule(` + (resource:A) == + ra_op (R:(A)ra) (left:A) (right:A) + `), + trans_rule( + replace_left, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `right:A`), + RA_UNIT_L))); + thm pred_eq = ap_term_rule( + `P:A->bool`, + gsym_rule(resource_eq_right)); + ACCEPT_TAC( + forward, + eq_mp_rule( + pred_eq, + assume_rule(`(P:A->bool) (right:A)`))); + + gnode reverse = DISCH_TAC(directions[1], "HP"); + reverse = EXISTS_TAC(reverse, `ra_unit (R:(A)ra)`); + reverse = EXISTS_TAC(reverse, `resource:A`); + gnode_list result1 = CONJ_TAC(reverse); + ACCEPT_TAC( + result1[0], + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `resource:A`), + RA_UNIT_L))); + gnode_list result2 = CONJ_TAC(result1[1]); + ACCEPT_TAC( + result2[0], + refl_rule(`ra_unit (R:(A)ra)`)); + ACCEPT_TAC( + result2[1], + assume_rule(`(P:A->bool) (resource:A)`)); + return gnode_prove(root); +} + +PROOF thm R_SEP_EMP_L = + prove_r_sep_emp_l(); + +PROOF static thm prove_r_sep_emp_r(void) { + term R = `R:(A)ra`; + term P = `P:A->bool`; + thm commute = ispecl_rule( + TERM_LIST( + R, + P, + `r_emp (R:(A)ra)`), + R_SEP_COMM); + thm left_unit = ispecl_rule( + TERM_LIST(R, P), + R_SEP_EMP_L); + thm result = trans_rule(commute, left_unit); + result = gen_rule(P, result); + return gen_rule(R, result); +} + +PROOF thm R_SEP_EMP_R = + prove_r_sep_emp_r(); + +PROOF static thm prove_r_sep_assoc(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (S:A->bool). + r_sep R (r_sep R P Q) S == + r_sep R P (r_sep R Q S) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm funext = ispecl_rule( + TERM_LIST( + `r_sep + (R:(A)ra) + (r_sep R (P:A->bool) (Q:A->bool)) + (S:A->bool)`, + `r_sep + (R:(A)ra) + (P:A->bool) + (r_sep R (Q:A->bool) (S:A->bool))`), + get_theorem_by_name("FUN_EQ_THM")); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(funext))); + body = GEN_TAC(body, "resource"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(r_sep_def))); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Houter"); + forward = ASMP_EXISTS_TAC(forward, "Houter", "left_pair"); + forward = ASMP_EXISTS_TAC(forward, "Houter", "right"); + forward = ASMP_CONJ_TAC( + forward, + "Houter", + "Houter_split", + "Houter_preds"); + forward = ASMP_CONJ_TAC( + forward, + "Houter_preds", + "Hinner", + "HS"); + forward = ASMP_EXISTS_TAC(forward, "Hinner", "left"); + forward = ASMP_EXISTS_TAC(forward, "Hinner", "middle"); + forward = ASMP_CONJ_TAC( + forward, + "Hinner", + "Hinner_split", + "Hinner_preds"); + forward = ASMP_CONJ_TAC( + forward, + "Hinner_preds", + "HP", + "HQ"); + forward = EXISTS_TAC(forward, `left:A`); + forward = EXISTS_TAC( + forward, + `ra_op (R:(A)ra) (middle:A) (right:A)`); + gnode_list f1 = CONJ_TAC(forward); + thm replace_left_pair = beta_rule(ap_term_rule( + `\replacement:A. + ra_op (R:(A)ra) replacement (right:A)`, + assume_rule(` + (left_pair:A) == + ra_op (R:(A)ra) (left:A) (middle:A) + `))); + thm regrouped = trans_rule( + assume_rule(` + (resource:A) == + ra_op (R:(A)ra) (left_pair:A) (right:A) + `), + trans_rule( + replace_left_pair, + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `left:A`, + `middle:A`, + `right:A`), + RA_ASSOC))); + ACCEPT_TAC(f1[0], regrouped); + gnode_list f2 = CONJ_TAC(f1[1]); + ACCEPT_TAC( + f2[0], + assume_rule(`(P:A->bool) (left:A)`)); + gnode forward_inner = EXISTS_TAC(f2[1], `middle:A`); + forward_inner = EXISTS_TAC(forward_inner, `right:A`); + gnode_list f3 = CONJ_TAC(forward_inner); + ACCEPT_TAC( + f3[0], + refl_rule(` + ra_op (R:(A)ra) (middle:A) (right:A) + `)); + gnode_list f4 = CONJ_TAC(f3[1]); + ACCEPT_TAC( + f4[0], + assume_rule(`(Q:A->bool) (middle:A)`)); + ACCEPT_TAC( + f4[1], + assume_rule(`(S:A->bool) (right:A)`)); + + gnode reverse = DISCH_TAC(directions[1], "Houter"); + reverse = ASMP_EXISTS_TAC(reverse, "Houter", "left"); + reverse = ASMP_EXISTS_TAC(reverse, "Houter", "right_pair"); + reverse = ASMP_CONJ_TAC( + reverse, + "Houter", + "Houter_split", + "Houter_preds"); + reverse = ASMP_CONJ_TAC( + reverse, + "Houter_preds", + "HP", + "Hinner"); + reverse = ASMP_EXISTS_TAC(reverse, "Hinner", "middle"); + reverse = ASMP_EXISTS_TAC(reverse, "Hinner", "right"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hinner", + "Hinner_split", + "Hinner_preds"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hinner_preds", + "HQ", + "HS"); + reverse = EXISTS_TAC( + reverse, + `ra_op (R:(A)ra) (left:A) (middle:A)`); + reverse = EXISTS_TAC(reverse, `right:A`); + gnode_list r1 = CONJ_TAC(reverse); + thm replace_right_pair = beta_rule(ap_term_rule( + `\replacement:A. + ra_op (R:(A)ra) (left:A) replacement`, + assume_rule(` + (right_pair:A) == + ra_op (R:(A)ra) (middle:A) (right:A) + `))); + thm ungrouped = trans_rule( + assume_rule(` + (resource:A) == + ra_op (R:(A)ra) (left:A) (right_pair:A) + `), + trans_rule( + replace_right_pair, + gsym_rule(ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `left:A`, + `middle:A`, + `right:A`), + RA_ASSOC)))); + ACCEPT_TAC(r1[0], ungrouped); + gnode_list r2 = CONJ_TAC(r1[1]); + gnode reverse_inner = EXISTS_TAC(r2[0], `left:A`); + reverse_inner = EXISTS_TAC(reverse_inner, `middle:A`); + gnode_list r3 = CONJ_TAC(reverse_inner); + ACCEPT_TAC( + r3[0], + refl_rule(` + ra_op (R:(A)ra) (left:A) (middle:A) + `)); + gnode_list r4 = CONJ_TAC(r3[1]); + ACCEPT_TAC( + r4[0], + assume_rule(`(P:A->bool) (left:A)`)); + ACCEPT_TAC( + r4[1], + assume_rule(`(Q:A->bool) (middle:A)`)); + ACCEPT_TAC( + r2[1], + assume_rule(`(S:A->bool) (right:A)`)); + return gnode_prove(root); +} + +PROOF thm R_SEP_ASSOC = + prove_r_sep_assoc(); + +PROOF static thm prove_r_sep_mono(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (P2:A->bool) + (Q:A->bool) + (Q2:A->bool). + r_entails R P P2 ==> + r_entails R Q Q2 ==> + r_entails + R + (r_sep R P Q) + (r_sep R P2 Q2) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_sep_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "P2"); + body = GEN_TAC(body, "Q"); + body = GEN_TAC(body, "Q2"); + body = DISCH_TAC(body, "Hmono_P"); + body = DISCH_TAC(body, "Hmono_Q"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid"); + body = DISCH_TAC(body, "Hsep"); + body = ASMP_EXISTS_TAC(body, "Hsep", "left"); + body = ASMP_EXISTS_TAC(body, "Hsep", "right"); + body = ASMP_CONJ_TAC( + body, + "Hsep", + "Hsplit", + "Hpreds"); + body = ASMP_CONJ_TAC( + body, + "Hpreds", + "HP", + "HQ"); + + thm valid_eq = ap_term_rule( + `ra_valid (R:(A)ra):A->bool`, + assume_rule(` + (resource:A) == + ra_op (R:(A)ra) (left:A) (right:A) + `)); + thm valid_pair = eq_mp_rule( + valid_eq, + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)); + thm valid_left = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `left:A`, + `right:A`), + RA_VALID_OP_L), + valid_pair); + thm valid_right = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `left:A`, + `right:A`), + RA_VALID_OP_R), + valid_pair); + + thm p2_left = mp_rule( + mp_rule( + spec_rule( + `left:A`, + assume_rule(` + forall resource:A. + ra_valid (R:(A)ra) resource ==> + (P:A->bool) resource ==> + (P2:A->bool) resource + `)), + valid_left), + assume_rule(`(P:A->bool) (left:A)`)); + thm q2_right = mp_rule( + mp_rule( + spec_rule( + `right:A`, + assume_rule(` + forall resource:A. + ra_valid (R:(A)ra) resource ==> + (Q:A->bool) resource ==> + (Q2:A->bool) resource + `)), + valid_right), + assume_rule(`(Q:A->bool) (right:A)`)); + + body = EXISTS_TAC(body, `left:A`); + body = EXISTS_TAC(body, `right:A`); + gnode_list result1 = CONJ_TAC(body); + ACCEPT_TAC( + result1[0], + assume_rule(` + (resource:A) == + ra_op (R:(A)ra) (left:A) (right:A) + `)); + gnode_list result2 = CONJ_TAC(result1[1]); + ACCEPT_TAC(result2[0], p2_left); + ACCEPT_TAC(result2[1], q2_right); + return gnode_prove(root); +} + +PROOF thm R_SEP_MONO = + prove_r_sep_mono(); + +PROOF static thm prove_r_sep_frame_l(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (frame_pred:A->bool). + r_entails R P Q ==> + r_entails + R + (r_sep R P frame_pred) + (r_sep R Q frame_pred) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm framed = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `P:A->bool`, + `Q:A->bool`, + `frame_pred:A->bool`, + `frame_pred:A->bool`), + R_SEP_MONO), + assume_rule(` + r_entails (R:(A)ra) (P:A->bool) (Q:A->bool) + `)), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `frame_pred:A->bool`), + R_ENTAILS_REFL)); + ACCEPT_TAC(body, framed); + return gnode_prove(root); +} + +PROOF thm R_SEP_FRAME_L = + prove_r_sep_frame_l(); + +PROOF static thm prove_r_sep_frame_r(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (frame_pred:A->bool). + r_entails R P Q ==> + r_entails + R + (r_sep R frame_pred P) + (r_sep R frame_pred Q) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm framed = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `frame_pred:A->bool`, + `frame_pred:A->bool`, + `P:A->bool`, + `Q:A->bool`), + R_SEP_MONO), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `frame_pred:A->bool`), + R_ENTAILS_REFL)), + assume_rule(` + r_entails (R:(A)ra) (P:A->bool) (Q:A->bool) + `)); + ACCEPT_TAC(body, framed); + return gnode_prove(root); +} + +PROOF thm R_SEP_FRAME_R = + prove_r_sep_frame_r(); + +PROOF static thm prove_r_sep_exists_l(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:B->A->bool) + (Q:A->bool). + r_sep R (r_exists R (\witness:B. P witness)) Q == + r_exists R (\witness:B. r_sep R (P witness) Q) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm fun_eq_thm = get_theorem_by_name("FUN_EQ_THM"); + term_list funext_arguments = TERM_LIST( + `r_sep + (R:(A)ra) + (r_exists R (\witness:B. (P:B->A->bool) witness)) + (Q:A->bool)`, + `r_exists + (R:(A)ra) + (\witness:B. + r_sep R ((P:B->A->bool) witness) (Q:A->bool))`); + thm funext = ispecl_rule( + funext_arguments, + fun_eq_thm); + thm_list funext_rewrites = THM_LIST(funext); + conv funext_rewrite = once_rewrite_conv(funext_rewrites); + body = CONV_TAC(body, funext_rewrite); + body = GEN_TAC(body, "resource"); + thm_list outer_definitions = THM_LIST( + r_sep_def, + r_exists_def); + conv outer_rewrite = pure_rewrite_conv(outer_definitions); + body = CONV_TAC(body, outer_rewrite); + conv beta = get_conversion_by_name("BETA_CONV"); + conv beta_depth = depth_conv(beta); + body = CONV_TAC(body, beta_depth); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hsep"); + forward = ASMP_EXISTS_TAC(forward, "Hsep", "left"); + forward = ASMP_EXISTS_TAC(forward, "Hsep", "right"); + forward = ASMP_CONJ_TAC( + forward, + "Hsep", + "Hsplit", + "Hpreds"); + forward = ASMP_CONJ_TAC( + forward, + "Hpreds", + "Hexists_left", + "HQ"); + forward = ASMP_EXISTS_TAC( + forward, + "Hexists_left", + "witness"); + forward = EXISTS_TAC(forward, `witness:B`); + thm_list forward_sep_definitions = THM_LIST(r_sep_def); + conv forward_sep_rewrite = + once_rewrite_conv(forward_sep_definitions); + forward = CONV_TAC(forward, forward_sep_rewrite); + forward = EXISTS_TAC(forward, `left:A`); + forward = EXISTS_TAC(forward, `right:A`); + gnode_list forward1 = CONJ_TAC(forward); + thm forward_split = assume_rule(` + (resource:A) == + ra_op (R:(A)ra) (left:A) (right:A) + `); + ACCEPT_TAC(forward1[0], forward_split); + gnode_list forward2 = CONJ_TAC(forward1[1]); + thm forward_p = assume_rule(` + (P:B->A->bool) (witness:B) (left:A) + `); + ACCEPT_TAC(forward2[0], forward_p); + thm forward_q = assume_rule(`(Q:A->bool) (right:A)`); + ACCEPT_TAC(forward2[1], forward_q); + + gnode reverse = DISCH_TAC(directions[1], "Hexists"); + reverse = ASMP_EXISTS_TAC(reverse, "Hexists", "witness"); + thm_list reverse_sep_definitions = THM_LIST(r_sep_def); + conv reverse_sep_rewrite = + once_rewrite_conv(reverse_sep_definitions); + const_cstr_list reverse_sep_assumption = + CONST_STRING_LIST("Hexists"); + reverse = ASMP_CONV_TAC( + reverse, + reverse_sep_rewrite, + reverse_sep_assumption); + reverse = ASMP_EXISTS_TAC(reverse, "Hexists", "left"); + reverse = ASMP_EXISTS_TAC(reverse, "Hexists", "right"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hexists", + "Hsplit", + "Hpreds"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hpreds", + "HP", + "HQ"); + reverse = EXISTS_TAC(reverse, `left:A`); + reverse = EXISTS_TAC(reverse, `right:A`); + gnode_list reverse1 = CONJ_TAC(reverse); + thm reverse_split = assume_rule(` + (resource:A) == + ra_op (R:(A)ra) (left:A) (right:A) + `); + ACCEPT_TAC(reverse1[0], reverse_split); + gnode_list reverse2 = CONJ_TAC(reverse1[1]); + gnode reverse_exists_left = + EXISTS_TAC(reverse2[0], `witness:B`); + thm reverse_p = assume_rule(` + (P:B->A->bool) (witness:B) (left:A) + `); + ACCEPT_TAC(reverse_exists_left, reverse_p); + thm reverse_q = assume_rule(`(Q:A->bool) (right:A)`); + ACCEPT_TAC(reverse2[1], reverse_q); + thm result = gnode_prove(root); + return result; +} + +PROOF thm R_SEP_EXISTS_L = + prove_r_sep_exists_l(); + +PROOF static thm prove_r_sep_exists_r(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:B->A->bool). + r_sep R P (r_exists R (\witness:B. Q witness)) == + r_exists R (\witness:B. r_sep R P (Q witness)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm fun_eq_thm = get_theorem_by_name("FUN_EQ_THM"); + term_list funext_arguments = TERM_LIST( + `r_sep + (R:(A)ra) + (P:A->bool) + (r_exists R (\witness:B. (Q:B->A->bool) witness))`, + `r_exists + (R:(A)ra) + (\witness:B. + r_sep R (P:A->bool) ((Q:B->A->bool) witness))`); + thm funext = ispecl_rule( + funext_arguments, + fun_eq_thm); + thm_list funext_rewrites = THM_LIST(funext); + conv funext_rewrite = once_rewrite_conv(funext_rewrites); + body = CONV_TAC(body, funext_rewrite); + body = GEN_TAC(body, "resource"); + thm_list outer_definitions = THM_LIST( + r_sep_def, + r_exists_def); + conv outer_rewrite = pure_rewrite_conv(outer_definitions); + body = CONV_TAC(body, outer_rewrite); + conv beta = get_conversion_by_name("BETA_CONV"); + conv beta_depth = depth_conv(beta); + body = CONV_TAC(body, beta_depth); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hsep"); + forward = ASMP_EXISTS_TAC(forward, "Hsep", "left"); + forward = ASMP_EXISTS_TAC(forward, "Hsep", "right"); + forward = ASMP_CONJ_TAC( + forward, + "Hsep", + "Hsplit", + "Hpreds"); + forward = ASMP_CONJ_TAC( + forward, + "Hpreds", + "HP", + "Hexists_right"); + forward = ASMP_EXISTS_TAC( + forward, + "Hexists_right", + "witness"); + forward = EXISTS_TAC(forward, `witness:B`); + thm_list forward_sep_definitions = THM_LIST(r_sep_def); + conv forward_sep_rewrite = + once_rewrite_conv(forward_sep_definitions); + forward = CONV_TAC(forward, forward_sep_rewrite); + forward = EXISTS_TAC(forward, `left:A`); + forward = EXISTS_TAC(forward, `right:A`); + gnode_list forward1 = CONJ_TAC(forward); + thm forward_split = assume_rule(` + (resource:A) == + ra_op (R:(A)ra) (left:A) (right:A) + `); + ACCEPT_TAC(forward1[0], forward_split); + gnode_list forward2 = CONJ_TAC(forward1[1]); + thm forward_p = assume_rule(`(P:A->bool) (left:A)`); + ACCEPT_TAC(forward2[0], forward_p); + thm forward_q = assume_rule(` + (Q:B->A->bool) (witness:B) (right:A) + `); + ACCEPT_TAC(forward2[1], forward_q); + + gnode reverse = DISCH_TAC(directions[1], "Hexists"); + reverse = ASMP_EXISTS_TAC(reverse, "Hexists", "witness"); + thm_list reverse_sep_definitions = THM_LIST(r_sep_def); + conv reverse_sep_rewrite = + once_rewrite_conv(reverse_sep_definitions); + const_cstr_list reverse_sep_assumption = + CONST_STRING_LIST("Hexists"); + reverse = ASMP_CONV_TAC( + reverse, + reverse_sep_rewrite, + reverse_sep_assumption); + reverse = ASMP_EXISTS_TAC(reverse, "Hexists", "left"); + reverse = ASMP_EXISTS_TAC(reverse, "Hexists", "right"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hexists", + "Hsplit", + "Hpreds"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hpreds", + "HP", + "HQ"); + reverse = EXISTS_TAC(reverse, `left:A`); + reverse = EXISTS_TAC(reverse, `right:A`); + gnode_list reverse1 = CONJ_TAC(reverse); + thm reverse_split = assume_rule(` + (resource:A) == + ra_op (R:(A)ra) (left:A) (right:A) + `); + ACCEPT_TAC(reverse1[0], reverse_split); + gnode_list reverse2 = CONJ_TAC(reverse1[1]); + thm reverse_p = assume_rule(`(P:A->bool) (left:A)`); + ACCEPT_TAC(reverse2[0], reverse_p); + gnode reverse_exists_right = + EXISTS_TAC(reverse2[1], `witness:B`); + thm reverse_q = assume_rule(` + (Q:B->A->bool) (witness:B) (right:A) + `); + ACCEPT_TAC(reverse_exists_right, reverse_q); + thm result = gnode_prove(root); + return result; +} + +PROOF thm R_SEP_EXISTS_R = + prove_r_sep_exists_r(); + +PROOF static thm prove_r_and_intro(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (S:A->bool). + r_entails R P Q ==> + r_entails R P S ==> + r_entails R P (r_and R Q S) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_and_def))); + body = AUTO_INTROS_TAC(body); + gnode_list result = CONJ_TAC(body); + + thm q_resource = mp_rule( + mp_rule( + spec_rule( + `resource:A`, + assume_rule(` + forall resource:A. + ra_valid (R:(A)ra) resource ==> + (P:A->bool) resource ==> + (Q:A->bool) resource + `)), + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)), + assume_rule(`(P:A->bool) (resource:A)`)); + ACCEPT_TAC(result[0], q_resource); + + thm s_resource = mp_rule( + mp_rule( + spec_rule( + `resource:A`, + assume_rule(` + forall resource:A. + ra_valid (R:(A)ra) resource ==> + (P:A->bool) resource ==> + (S:A->bool) resource + `)), + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)), + assume_rule(`(P:A->bool) (resource:A)`)); + ACCEPT_TAC(result[1], s_resource); + return gnode_prove(root); +} + +PROOF thm R_AND_INTRO = + prove_r_and_intro(); + +PROOF static thm prove_r_and_elim_l(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool). + r_entails R (r_and R P Q) P + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_and_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid"); + body = DISCH_TAC(body, "Hboth"); + body = ASMP_CONJ_TAC( + body, + "Hboth", + "HP", + "HQ"); + ACCEPT_TAC(body, assume_rule(`(P:A->bool) (resource:A)`)); + return gnode_prove(root); +} + +PROOF thm R_AND_ELIM_L = + prove_r_and_elim_l(); + +PROOF static thm prove_r_and_elim_r(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool). + r_entails R (r_and R P Q) Q + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_and_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid"); + body = DISCH_TAC(body, "Hboth"); + body = ASMP_CONJ_TAC( + body, + "Hboth", + "HP", + "HQ"); + ACCEPT_TAC(body, assume_rule(`(Q:A->bool) (resource:A)`)); + return gnode_prove(root); +} + +PROOF thm R_AND_ELIM_R = + prove_r_and_elim_r(); + +PROOF static thm prove_r_or_intro_l(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool). + r_entails R P (r_or R P Q) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_or_def))); + body = AUTO_INTROS_TAC(body); + body = DISJ1_TAC(body); + ACCEPT_TAC(body, assume_rule(`(P:A->bool) (resource:A)`)); + return gnode_prove(root); +} + +PROOF thm R_OR_INTRO_L = + prove_r_or_intro_l(); + +PROOF static thm prove_r_or_intro_r(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool). + r_entails R Q (r_or R P Q) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_or_def))); + body = AUTO_INTROS_TAC(body); + body = DISJ2_TAC(body); + ACCEPT_TAC(body, assume_rule(`(Q:A->bool) (resource:A)`)); + return gnode_prove(root); +} + +PROOF thm R_OR_INTRO_R = + prove_r_or_intro_r(); + +PROOF static thm prove_r_or_elim(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (S:A->bool). + r_entails R P S ==> + r_entails R Q S ==> + r_entails R (r_or R P Q) S + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_or_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = GEN_TAC(body, "S"); + body = DISCH_TAC(body, "HPS"); + body = DISCH_TAC(body, "HQS"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid"); + body = DISCH_TAC(body, "Hor"); + gnode_list cases = ASMP_DISJ_TAC( + body, + "Hor", + "HP", + "HQ"); + + thm from_p = mp_rule( + mp_rule( + spec_rule( + `resource:A`, + assume_rule(` + forall resource:A. + ra_valid (R:(A)ra) resource ==> + (P:A->bool) resource ==> + (S:A->bool) resource + `)), + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)), + assume_rule(`(P:A->bool) (resource:A)`)); + ACCEPT_TAC(cases[0], from_p); + + thm from_q = mp_rule( + mp_rule( + spec_rule( + `resource:A`, + assume_rule(` + forall resource:A. + ra_valid (R:(A)ra) resource ==> + (Q:A->bool) resource ==> + (S:A->bool) resource + `)), + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)), + assume_rule(`(Q:A->bool) (resource:A)`)); + ACCEPT_TAC(cases[1], from_q); + return gnode_prove(root); +} + +PROOF thm R_OR_ELIM = + prove_r_or_elim(); + +PROOF static thm prove_r_exists_intro(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:B->A->bool) + (witness:B). + r_entails + R + (P witness) + (r_exists R (\bound:B. P bound)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_exists_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = AUTO_INTROS_TAC(body); + body = EXISTS_TAC(body, `witness:B`); + ACCEPT_TAC( + body, + assume_rule(`(P:B->A->bool) (witness:B) (resource:A)`)); + return gnode_prove(root); +} + +PROOF thm R_EXISTS_INTRO = + prove_r_exists_intro(); + +PROOF static thm prove_r_exists_elim(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:B->A->bool) + (Q:A->bool). + (forall witness:B. + r_entails R (P witness) Q) ==> + r_entails R (r_exists R (\bound:B. P bound)) Q + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_exists_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = DISCH_TAC(body, "Hall"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid"); + body = DISCH_TAC(body, "Hexists"); + body = ASMP_EXISTS_TAC(body, "Hexists", "witness"); + + thm selected_entailment = spec_rule( + `witness:B`, + assume_rule(` + forall witness:B. + forall resource:A. + ra_valid (R:(A)ra) resource ==> + (P:B->A->bool) witness resource ==> + (Q:A->bool) resource + `)); + thm result = mp_rule( + mp_rule( + spec_rule(`resource:A`, selected_entailment), + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)), + assume_rule(` + (P:B->A->bool) (witness:B) (resource:A) + `)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_EXISTS_ELIM = + prove_r_exists_elim(); + +PROOF static thm prove_r_exists_mono(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:B->A->bool) + (Q:B->A->bool). + (forall witness:B. + r_entails R (P witness) (Q witness)) ==> + r_entails + R + (r_exists R (\bound:B. P bound)) + (r_exists R (\bound:B. Q bound)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_exists_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = DISCH_TAC(body, "Hall"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid"); + body = DISCH_TAC(body, "Hexists"); + body = ASMP_EXISTS_TAC(body, "Hexists", "witness"); + body = EXISTS_TAC(body, `witness:B`); + + thm selected_entailment = spec_rule( + `witness:B`, + assume_rule(` + forall witness:B. + forall resource:A. + ra_valid (R:(A)ra) resource ==> + (P:B->A->bool) witness resource ==> + (Q:B->A->bool) witness resource + `)); + thm result = mp_rule( + mp_rule( + spec_rule(`resource:A`, selected_entailment), + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)), + assume_rule(` + (P:B->A->bool) (witness:B) (resource:A) + `)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_EXISTS_MONO = + prove_r_exists_mono(); + +PROOF static thm prove_r_forall_intro(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:B->A->bool). + (forall witness:B. + r_entails R P (Q witness)) ==> + r_entails + R + P + (r_forall R (\bound:B. Q bound)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_forall_def))); + /* Contract only `(\bound. Q bound) witness`, the redex introduced by the + * eta-long public theorem schema. Do not descend into P or Q. */ + conv beta = get_conversion_by_name("BETA_CONV"); + conv generated_redex = binder_conv(binder_conv(binder_conv( + rand_conv(binder_conv(rand_conv(rand_conv( + binder_conv(rator_conv(beta))))))))); + body = CONV_TAC(body, generated_redex); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = DISCH_TAC(body, "Hall"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid"); + body = DISCH_TAC(body, "HP"); + body = GEN_TAC(body, "witness"); + + thm selected_entailment = spec_rule( + `witness:B`, + assume_rule(` + forall witness:B. + forall resource:A. + ra_valid (R:(A)ra) resource ==> + (P:A->bool) resource ==> + (Q:B->A->bool) witness resource + `)); + thm result = mp_rule( + mp_rule( + spec_rule(`resource:A`, selected_entailment), + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)), + assume_rule(`(P:A->bool) (resource:A)`)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_FORALL_INTRO = + prove_r_forall_intro(); + +PROOF static thm prove_r_forall_elim(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:B->A->bool) + (Q:A->bool) + (witness:B). + r_entails R (P witness) Q ==> + r_entails + R + (r_forall R (\bound:B. P bound)) + Q + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_forall_def))); + /* Contract only `(\bound. P bound) selected`, beneath the universal source + * introduced by the eta-long theorem schema. */ + conv beta = get_conversion_by_name("BETA_CONV"); + conv generated_redex = binder_conv(binder_conv(binder_conv(binder_conv( + rand_conv(binder_conv(rand_conv(land_conv( + binder_conv(rator_conv(beta)))))))))); + body = CONV_TAC(body, generated_redex); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = GEN_TAC(body, "witness"); + body = DISCH_TAC(body, "Hselected"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid"); + body = DISCH_TAC(body, "Hall"); + + thm selected_resource = mp_rule( + mp_rule( + spec_rule( + `resource:A`, + assume_rule(` + forall resource:A. + ra_valid (R:(A)ra) resource ==> + (P:B->A->bool) (witness:B) resource ==> + (Q:A->bool) resource + `)), + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)), + spec_rule( + `witness:B`, + assume_rule(` + forall witness:B. + (P:B->A->bool) witness (resource:A) + `))); + ACCEPT_TAC(body, selected_resource); + return gnode_prove(root); +} + +PROOF thm R_FORALL_ELIM = + prove_r_forall_elim(); + +PROOF static thm prove_r_pure_and_intro(void) { + term goal_tm = ` + forall + (R:(A)ra) + (phi:bool) + (P:A->bool) + (Q:A->bool). + phi ==> + r_entails R P Q ==> + r_entails + R + P + (r_and R (r_pure R phi) Q) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_and_def, + r_pure_def))); + body = AUTO_INTROS_TAC(body); + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC(result[0], assume_rule(`phi:bool`)); + + thm q_resource = mp_rule( + mp_rule( + spec_rule( + `resource:A`, + assume_rule(` + forall resource:A. + ra_valid (R:(A)ra) resource ==> + (P:A->bool) resource ==> + (Q:A->bool) resource + `)), + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)), + assume_rule(`(P:A->bool) (resource:A)`)); + ACCEPT_TAC(result[1], q_resource); + return gnode_prove(root); +} + +PROOF thm R_PURE_AND_INTRO = + prove_r_pure_and_intro(); + +PROOF static thm prove_r_pure_and_elim(void) { + term goal_tm = ` + forall + (R:(A)ra) + (phi:bool) + (P:A->bool) + (Q:A->bool). + (phi ==> r_entails R P Q) ==> + r_entails + R + (r_and R (r_pure R phi) P) + Q + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_and_def, + r_pure_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "phi"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = DISCH_TAC(body, "Hconditional"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid"); + body = DISCH_TAC(body, "Hboth"); + body = ASMP_CONJ_TAC( + body, + "Hboth", + "Hphi", + "HP"); + + thm entailment = mp_rule( + assume_rule(` + (phi:bool) ==> + forall resource:A. + ra_valid (R:(A)ra) resource ==> + (P:A->bool) resource ==> + (Q:A->bool) resource + `), + assume_rule(`phi:bool`)); + thm result = mp_rule( + mp_rule( + spec_rule(`resource:A`, entailment), + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)), + assume_rule(`(P:A->bool) (resource:A)`)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_PURE_AND_ELIM = + prove_r_pure_and_elim(); + +PROOF static thm prove_r_fact_as_pure_and_emp(void) { + term goal_tm = ` + forall (R:(A)ra) (phi:bool). + r_fact R phi == + r_and R (r_pure R phi) (r_emp R) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm funext = ispecl_rule( + TERM_LIST( + `r_fact (R:(A)ra) (phi:bool)`, + `r_and + (R:(A)ra) + (r_pure R phi) + (r_emp R)`), + get_theorem_by_name("FUN_EQ_THM")); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(funext))); + body = GEN_TAC(body, "resource"); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + r_fact_def, + r_and_def, + r_pure_def, + r_emp_def))); + return gnode_prove(root); +} + +PROOF thm R_FACT_AS_PURE_AND_EMP = + prove_r_fact_as_pure_and_emp(); + +PROOF static thm prove_r_fact_true(void) { + term goal_tm = ` + forall R:(A)ra. + r_fact R T == + r_emp R + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm funext = ispecl_rule( + TERM_LIST( + `r_fact (R:(A)ra) T`, + `r_emp (R:(A)ra)`), + get_theorem_by_name("FUN_EQ_THM")); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(funext))); + body = GEN_TAC(body, "resource"); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + r_fact_def, + r_emp_def))); + return gnode_prove(root); +} + +PROOF thm R_FACT_TRUE = + prove_r_fact_true(); + +PROOF static thm prove_r_fact_false(void) { + term goal_tm = ` + forall R:(A)ra. + r_fact R F == + r_bottom R + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm funext = ispecl_rule( + TERM_LIST( + `r_fact (R:(A)ra) F`, + `r_bottom (R:(A)ra)`), + get_theorem_by_name("FUN_EQ_THM")); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(funext))); + body = GEN_TAC(body, "resource"); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + r_fact_def, + r_bottom_def))); + return gnode_prove(root); +} + +PROOF thm R_FACT_FALSE = + prove_r_fact_false(); + +PROOF static thm prove_r_fact_sep_l(void) { + term goal_tm = ` + forall + (R:(A)ra) + (phi:bool) + (P:A->bool). + r_sep R (r_fact R phi) P == + r_and R (r_pure R phi) P + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm funext = ispecl_rule( + TERM_LIST( + `r_sep + (R:(A)ra) + (r_fact R (phi:bool)) + (P:A->bool)`, + `r_and + (R:(A)ra) + (r_pure R phi) + (P:A->bool)`), + get_theorem_by_name("FUN_EQ_THM")); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(funext))); + body = GEN_TAC(body, "resource"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST( + r_sep_def, + r_fact_def, + r_and_def, + r_pure_def))); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hsep"); + forward = ASMP_EXISTS_TAC(forward, "Hsep", "left"); + forward = ASMP_EXISTS_TAC(forward, "Hsep", "right"); + forward = ASMP_CONJ_TAC( + forward, + "Hsep", + "Hsplit", + "Hpreds"); + forward = ASMP_CONJ_TAC( + forward, + "Hpreds", + "Hfact", + "HP"); + forward = ASMP_CONJ_TAC( + forward, + "Hfact", + "Hphi", + "Hleft_unit"); + gnode_list forward_result = CONJ_TAC(forward); + ACCEPT_TAC(forward_result[0], assume_rule(`phi:bool`)); + + thm replace_left = beta_rule(ap_term_rule( + `\replacement:A. + ra_op (R:(A)ra) replacement (right:A)`, + assume_rule(` + (left:A) == ra_unit (R:(A)ra) + `))); + thm resource_eq_right = trans_rule( + assume_rule(` + (resource:A) == + ra_op (R:(A)ra) (left:A) (right:A) + `), + trans_rule( + replace_left, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `right:A`), + RA_UNIT_L))); + thm pred_eq = ap_term_rule( + `P:A->bool`, + gsym_rule(resource_eq_right)); + ACCEPT_TAC( + forward_result[1], + eq_mp_rule( + pred_eq, + assume_rule(`(P:A->bool) (right:A)`))); + + gnode reverse = DISCH_TAC(directions[1], "Hboth"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hboth", + "Hphi", + "HP"); + reverse = EXISTS_TAC(reverse, `ra_unit (R:(A)ra)`); + reverse = EXISTS_TAC(reverse, `resource:A`); + gnode_list reverse1 = CONJ_TAC(reverse); + ACCEPT_TAC( + reverse1[0], + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `resource:A`), + RA_UNIT_L))); + gnode_list reverse2 = CONJ_TAC(reverse1[1]); + gnode_list fact_parts = CONJ_TAC(reverse2[0]); + ACCEPT_TAC(fact_parts[0], assume_rule(`phi:bool`)); + ACCEPT_TAC( + fact_parts[1], + refl_rule(`ra_unit (R:(A)ra)`)); + ACCEPT_TAC( + reverse2[1], + assume_rule(`(P:A->bool) (resource:A)`)); + return gnode_prove(root); +} + +PROOF thm R_FACT_SEP_L = + prove_r_fact_sep_l(); + +PROOF static thm prove_r_fact_sep_r(void) { + term R = `R:(A)ra`; + term phi = `phi:bool`; + term P = `P:A->bool`; + thm commute = ispecl_rule( + TERM_LIST( + R, + P, + `r_fact (R:(A)ra) (phi:bool)`), + R_SEP_COMM); + thm bridge = ispecl_rule( + TERM_LIST(R, phi, P), + R_FACT_SEP_L); + thm result = trans_rule(commute, bridge); + result = gen_rule(P, result); + result = gen_rule(phi, result); + return gen_rule(R, result); +} + +PROOF thm R_FACT_SEP_R = + prove_r_fact_sep_r(); + +PROOF static thm prove_r_fact_intro(void) { + term goal_tm = ` + forall + (R:(A)ra) + (phi:bool) + (P:A->bool) + (Q:A->bool). + phi ==> + r_entails R P Q ==> + r_entails R P (r_sep R (r_fact R phi) Q) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "phi"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = DISCH_TAC(body, "Hphi"); + body = DISCH_TAC(body, "Hentails"); + + thm pure_intro = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `phi:bool`, + `P:A->bool`, + `Q:A->bool`), + R_PURE_AND_INTRO), + assume_rule(`phi:bool`)), + assume_rule(`r_entails (R:(A)ra) (P:A->bool) (Q:A->bool)`)); + thm fact_sep = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `phi:bool`, + `Q:A->bool`), + R_FACT_SEP_L); + thm target_eq = beta_rule(ap_term_rule( + `\target:A->bool. + r_entails (R:(A)ra) (P:A->bool) target`, + gsym_rule(fact_sep))); + ACCEPT_TAC(body, eq_mp_rule(target_eq, pure_intro)); + return gnode_prove(root); +} + +PROOF thm R_FACT_INTRO = + prove_r_fact_intro(); + +PROOF static thm prove_r_fact_elim(void) { + term goal_tm = ` + forall + (R:(A)ra) + (phi:bool) + (P:A->bool) + (Q:A->bool). + (phi ==> r_entails R P Q) ==> + r_entails R (r_sep R (r_fact R phi) P) Q + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "phi"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = DISCH_TAC(body, "Hconditional"); + + thm pure_elim = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `phi:bool`, + `P:A->bool`, + `Q:A->bool`), + R_PURE_AND_ELIM), + assume_rule(` + (phi:bool) ==> + r_entails (R:(A)ra) (P:A->bool) (Q:A->bool) + `)); + thm fact_sep = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `phi:bool`, + `P:A->bool`), + R_FACT_SEP_L); + thm source_eq = beta_rule(ap_term_rule( + `\source:A->bool. + r_entails (R:(A)ra) source (Q:A->bool)`, + fact_sep)); + ACCEPT_TAC(body, eq_mp_rule(gsym_rule(source_eq), pure_elim)); + return gnode_prove(root); +} + +PROOF thm R_FACT_ELIM = + prove_r_fact_elim(); + +PROOF static thm prove_r_fact_dup(void) { + term goal_tm = ` + forall + (R:(A)ra) + (phi:bool). + r_entails + R + (r_fact R phi) + (r_sep R (r_fact R phi) (r_fact R phi)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_fact_def, + r_sep_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "phi"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid"); + body = DISCH_TAC(body, "Hfact"); + body = ASMP_CONJ_TAC( + body, + "Hfact", + "Hphi", + "Hresource_unit"); + body = EXISTS_TAC(body, `ra_unit (R:(A)ra)`); + body = EXISTS_TAC(body, `ra_unit (R:(A)ra)`); + gnode_list result1 = CONJ_TAC(body); + ACCEPT_TAC( + result1[0], + trans_rule( + assume_rule(` + (resource:A) == ra_unit (R:(A)ra) + `), + gsym_rule(ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `ra_unit (R:(A)ra)`), + RA_UNIT_L)))); + gnode_list result2 = CONJ_TAC(result1[1]); + gnode_list left_fact = CONJ_TAC(result2[0]); + ACCEPT_TAC(left_fact[0], assume_rule(`phi:bool`)); + ACCEPT_TAC( + left_fact[1], + refl_rule(`ra_unit (R:(A)ra)`)); + gnode_list right_fact = CONJ_TAC(result2[1]); + ACCEPT_TAC(right_fact[0], assume_rule(`phi:bool`)); + ACCEPT_TAC( + right_fact[1], + refl_rule(`ra_unit (R:(A)ra)`)); + return gnode_prove(root); +} + +PROOF thm R_FACT_DUP = + prove_r_fact_dup(); + +PROOF static thm prove_r_own_unit(void) { + term goal_tm = ` + forall R:(A)ra. + r_own R (ra_unit R) == + r_emp R + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm funext = ispecl_rule( + TERM_LIST( + `r_own (R:(A)ra) (ra_unit R)`, + `r_emp (R:(A)ra)`), + get_theorem_by_name("FUN_EQ_THM")); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(funext))); + body = GEN_TAC(body, "resource"); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + r_own_def, + r_emp_def))); + return gnode_prove(root); +} + +PROOF thm R_OWN_UNIT = + prove_r_own_unit(); + +PROOF static thm prove_r_own_op(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + r_own R (ra_op R a b) == + r_sep R (r_own R a) (r_own R b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm funext = ispecl_rule( + TERM_LIST( + `r_own + (R:(A)ra) + (ra_op R (a:A) (b:A))`, + `r_sep + (R:(A)ra) + (r_own R (a:A)) + (r_own R (b:A))`), + get_theorem_by_name("FUN_EQ_THM")); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(funext))); + body = GEN_TAC(body, "resource"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST( + r_own_def, + r_sep_def))); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Howned"); + forward = EXISTS_TAC(forward, `a:A`); + forward = EXISTS_TAC(forward, `b:A`); + gnode_list forward1 = CONJ_TAC(forward); + ACCEPT_TAC( + forward1[0], + assume_rule(` + (resource:A) == + ra_op (R:(A)ra) (a:A) (b:A) + `)); + gnode_list forward2 = CONJ_TAC(forward1[1]); + ACCEPT_TAC(forward2[0], refl_rule(`a:A`)); + ACCEPT_TAC(forward2[1], refl_rule(`b:A`)); + + gnode reverse = DISCH_TAC(directions[1], "Hsep"); + reverse = ASMP_EXISTS_TAC(reverse, "Hsep", "left"); + reverse = ASMP_EXISTS_TAC(reverse, "Hsep", "right"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hsep", + "Hsplit", + "Howned_parts"); + reverse = ASMP_CONJ_TAC( + reverse, + "Howned_parts", + "Hleft", + "Hright"); + thm replace_left = beta_rule(ap_term_rule( + `\replacement:A. + ra_op (R:(A)ra) replacement (right:A)`, + assume_rule(`(left:A) == (a:A)`))); + thm replace_right = beta_rule(ap_term_rule( + `\replacement:A. + ra_op (R:(A)ra) (a:A) replacement`, + assume_rule(`(right:A) == (b:A)`))); + thm result = trans_rule( + assume_rule(` + (resource:A) == + ra_op (R:(A)ra) (left:A) (right:A) + `), + trans_rule(replace_left, replace_right)); + ACCEPT_TAC(reverse, result); + return gnode_prove(root); +} + +PROOF thm R_OWN_OP = + prove_r_own_op(); + +PROOF static thm prove_r_own_valid(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A). + r_entails + R + (r_own R a) + (r_and + R + (r_pure R (ra_valid R a)) + (r_own R a)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_own_def, + r_and_def, + r_pure_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid"); + body = DISCH_TAC(body, "Howned"); + gnode_list result = CONJ_TAC(body); + + thm validity_eq = ap_term_rule( + `ra_valid (R:(A)ra):A->bool`, + assume_rule(`(resource:A) == (a:A)`)); + ACCEPT_TAC( + result[0], + eq_mp_rule( + validity_eq, + assume_rule(`ra_valid (R:(A)ra) (resource:A)`))); + ACCEPT_TAC( + result[1], + assume_rule(`(resource:A) == (a:A)`)); + return gnode_prove(root); +} + +PROOF thm R_OWN_VALID = + prove_r_own_valid(); + +PROOF static thm prove_r_impl_adjunction(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (S:A->bool). + r_entails R (r_and R P Q) S <=> + r_entails R P (r_impl R Q S) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_and_def, + r_impl_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = GEN_TAC(body, "S"); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hleft"); + forward = GEN_TAC(forward, "resource"); + forward = DISCH_TAC(forward, "Hvalid"); + forward = DISCH_TAC(forward, "HP"); + forward = DISCH_TAC(forward, "HQ"); + thm both = conj_rule( + assume_rule(`(P:A->bool) (resource:A)`), + assume_rule(`(Q:A->bool) (resource:A)`)); + thm forward_result = mp_rule( + mp_rule( + spec_rule( + `resource:A`, + assume_rule(` + forall resource:A. + ra_valid (R:(A)ra) resource ==> + ((P:A->bool) resource && + (Q:A->bool) resource) ==> + (S:A->bool) resource + `)), + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)), + both); + ACCEPT_TAC(forward, forward_result); + + gnode reverse = DISCH_TAC(directions[1], "Hright"); + reverse = GEN_TAC(reverse, "resource"); + reverse = DISCH_TAC(reverse, "Hvalid"); + reverse = DISCH_TAC(reverse, "Hboth"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hboth", + "HP", + "HQ"); + thm implication = mp_rule( + mp_rule( + spec_rule( + `resource:A`, + assume_rule(` + forall resource:A. + ra_valid (R:(A)ra) resource ==> + (P:A->bool) resource ==> + (Q:A->bool) resource ==> + (S:A->bool) resource + `)), + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)), + assume_rule(`(P:A->bool) (resource:A)`)); + ACCEPT_TAC( + reverse, + mp_rule( + implication, + assume_rule(`(Q:A->bool) (resource:A)`))); + return gnode_prove(root); +} + +PROOF thm R_IMPL_ADJUNCTION = + prove_r_impl_adjunction(); + +PROOF static thm prove_r_wand_adjunction(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (S:A->bool). + r_entails R (r_sep R P Q) S <=> + r_entails R P (r_wand R Q S) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_sep_def, + r_wand_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = GEN_TAC(body, "S"); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hsep_entails"); + forward = GEN_TAC(forward, "resource"); + forward = DISCH_TAC(forward, "Hvalid_resource"); + forward = DISCH_TAC(forward, "HP"); + forward = GEN_TAC(forward, "frame"); + forward = DISCH_TAC(forward, "Hvalid_total"); + forward = DISCH_TAC(forward, "HQ"); + + term inner_existence = ` + exists right:A. + ra_op (R:(A)ra) (resource:A) (frame:A) == + ra_op R resource right && + (P:A->bool) resource && + (Q:A->bool) right + `; + thm split_body = conj_rule( + refl_rule(` + ra_op (R:(A)ra) (resource:A) (frame:A) + `), + conj_rule( + assume_rule(`(P:A->bool) (resource:A)`), + assume_rule(`(Q:A->bool) (frame:A)`))); + thm inner_witness = exists_rule( + inner_existence, + `frame:A`, + split_body); + term outer_existence = ` + exists left right:A. + ra_op (R:(A)ra) (resource:A) (frame:A) == + ra_op R left right && + (P:A->bool) left && + (Q:A->bool) right + `; + thm sep_witness = exists_rule( + outer_existence, + `resource:A`, + inner_witness); + thm forward_result = mp_rule( + mp_rule( + spec_rule( + `ra_op + (R:(A)ra) + (resource:A) + (frame:A)`, + assume_rule(` + forall total:A. + ra_valid (R:(A)ra) total ==> + (exists left right:A. + total == ra_op R left right && + (P:A->bool) left && + (Q:A->bool) right) ==> + (S:A->bool) total + `)), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (resource:A) (frame:A)) + `)), + sep_witness); + ACCEPT_TAC(forward, forward_result); + + gnode reverse = DISCH_TAC(directions[1], "Hwand_entails"); + reverse = GEN_TAC(reverse, "resource"); + reverse = DISCH_TAC(reverse, "Hvalid_resource"); + reverse = DISCH_TAC(reverse, "Hsep"); + reverse = ASMP_EXISTS_TAC(reverse, "Hsep", "left"); + reverse = ASMP_EXISTS_TAC(reverse, "Hsep", "right"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hsep", + "Hsplit", + "Hpreds"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hpreds", + "HP", + "HQ"); + + thm validity_eq = ap_term_rule( + `ra_valid (R:(A)ra):A->bool`, + assume_rule(` + (resource:A) == + ra_op (R:(A)ra) (left:A) (right:A) + `)); + thm valid_pair = eq_mp_rule( + validity_eq, + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)); + thm valid_left = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `left:A`, + `right:A`), + RA_VALID_OP_L), + valid_pair); + thm wand_left = mp_rule( + mp_rule( + spec_rule( + `left:A`, + assume_rule(` + forall owned:A. + ra_valid (R:(A)ra) owned ==> + (P:A->bool) owned ==> + forall frame:A. + ra_valid R (ra_op R owned frame) ==> + (Q:A->bool) frame ==> + (S:A->bool) (ra_op R owned frame) + `)), + valid_left), + assume_rule(`(P:A->bool) (left:A)`)); + thm s_pair = mp_rule( + mp_rule( + spec_rule(`right:A`, wand_left), + valid_pair), + assume_rule(`(Q:A->bool) (right:A)`)); + thm predicate_eq = ap_term_rule( + `S:A->bool`, + gsym_rule(assume_rule(` + (resource:A) == + ra_op (R:(A)ra) (left:A) (right:A) + `))); + ACCEPT_TAC( + reverse, + eq_mp_rule(predicate_eq, s_pair)); + return gnode_prove(root); +} + +PROOF thm R_WAND_ADJUNCTION = + prove_r_wand_adjunction(); + +PROOF static thm prove_r_sep_and_forward_r(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (S:A->bool). + r_entails + R + (r_sep R P (r_and R Q S)) + (r_and + R + (r_sep R P Q) + (r_sep R P S)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + thm left_projection = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `P:A->bool`, + `P:A->bool`, + `r_and + (R:(A)ra) + (Q:A->bool) + (S:A->bool)`, + `Q:A->bool`), + R_SEP_MONO), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `P:A->bool`), + R_ENTAILS_REFL)), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Q:A->bool`, + `S:A->bool`), + R_AND_ELIM_L)); + thm right_projection = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `P:A->bool`, + `P:A->bool`, + `r_and + (R:(A)ra) + (Q:A->bool) + (S:A->bool)`, + `S:A->bool`), + R_SEP_MONO), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `P:A->bool`), + R_ENTAILS_REFL)), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Q:A->bool`, + `S:A->bool`), + R_AND_ELIM_R)); + thm result = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_sep + (R:(A)ra) + (P:A->bool) + (r_and R (Q:A->bool) (S:A->bool))`, + `r_sep R (P:A->bool) (Q:A->bool)`, + `r_sep R (P:A->bool) (S:A->bool)`), + R_AND_INTRO), + left_projection), + right_projection); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_SEP_AND_FORWARD_R = + prove_r_sep_and_forward_r(); + +PROOF static thm prove_r_sep_and_forward_l(void) { + term goal_tm = ` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (S:A->bool). + r_entails + R + (r_sep R (r_and R Q S) P) + (r_and + R + (r_sep R Q P) + (r_sep R S P)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + thm left_projection = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_and + (R:(A)ra) + (Q:A->bool) + (S:A->bool)`, + `Q:A->bool`, + `P:A->bool`, + `P:A->bool`), + R_SEP_MONO), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Q:A->bool`, + `S:A->bool`), + R_AND_ELIM_L)), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `P:A->bool`), + R_ENTAILS_REFL)); + thm right_projection = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_and + (R:(A)ra) + (Q:A->bool) + (S:A->bool)`, + `S:A->bool`, + `P:A->bool`, + `P:A->bool`), + R_SEP_MONO), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Q:A->bool`, + `S:A->bool`), + R_AND_ELIM_R)), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `P:A->bool`), + R_ENTAILS_REFL)); + thm result = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_sep + (R:(A)ra) + (r_and R (Q:A->bool) (S:A->bool)) + (P:A->bool)`, + `r_sep R (Q:A->bool) (P:A->bool)`, + `r_sep R (S:A->bool) (P:A->bool)`), + R_AND_INTRO), + left_projection), + right_projection); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_SEP_AND_FORWARD_L = + prove_r_sep_and_forward_l(); + +PROOF static int audit_resource_prop(void) { + thm_list public_theorems = THM_LIST( + r_entails_def, + r_equiv_def, + r_emp_def, + r_sep_def, + r_own_def, + r_top_def, + r_bottom_def, + r_and_def, + r_or_def, + r_impl_def, + r_exists_def, + r_forall_def, + r_pure_def, + r_fact_def, + r_wand_def, + R_ENTAILS_REFL, + R_ENTAILS_TRANS, + R_ENTAILS_POINTWISE, + R_EQUIV_POINTWISE, + R_EQUIV_INTRO, + R_EQUIV_REFL, + R_EQUIV_SYM, + R_EQUIV_TRANS, + R_SEP_ASSOC, + R_SEP_COMM, + R_SEP_EMP_L, + R_SEP_EMP_R, + R_SEP_MONO, + R_SEP_FRAME_L, + R_SEP_FRAME_R, + R_SEP_EXISTS_L, + R_SEP_EXISTS_R, + R_AND_INTRO, + R_AND_ELIM_L, + R_AND_ELIM_R, + R_OR_INTRO_L, + R_OR_INTRO_R, + R_OR_ELIM, + R_EXISTS_INTRO, + R_EXISTS_ELIM, + R_EXISTS_MONO, + R_FORALL_INTRO, + R_FORALL_ELIM, + R_PURE_AND_INTRO, + R_PURE_AND_ELIM, + R_FACT_AS_PURE_AND_EMP, + R_FACT_TRUE, + R_FACT_FALSE, + R_FACT_SEP_L, + R_FACT_SEP_R, + R_FACT_INTRO, + R_FACT_ELIM, + R_FACT_DUP, + R_OWN_UNIT, + R_OWN_OP, + R_OWN_VALID, + R_IMPL_ADJUNCTION, + R_WAND_ADJUNCTION, + R_SEP_AND_FORWARD_R, + R_SEP_AND_FORWARD_L); + + for (size_t i = 0; i < vector_size(public_theorems); ++i) { + ENSURE_COND( + !IS_NULL(public_theorems[i]), + "resource proposition theorem %zu is null", + i); + ENSURE_COND( + vector_size(hyp(public_theorems[i])) == 0, + "resource proposition theorem %zu has hypotheses", + i); + } + ENSURE_COND( + vector_size(get_all_axioms()) == + RESOURCE_PROP_AXIOMS_BEFORE, + "resource proposition theory introduced axioms"); + return 0; +err: + ERR_FUN_PUTS("audit_resource_prop"); + return -1; +} + +PROOF static int _RESOURCE_PROP_AUDIT = + audit_resource_prop(); diff --git a/theory/logic/resource_prop.h b/theory/logic/resource_prop.h new file mode 100644 index 0000000..243bd71 --- /dev/null +++ b/theory/logic/resource_prop.h @@ -0,0 +1,246 @@ +#pragma once + +/* + * Resource propositions over `R=(|R|, ε_R, ·_R, valid_R)`, where + * `R:(A)ra` and `|R|=A`. + * + * The carrier of assertions is `A->bool`. In the formulas below + * + * P ⊢_R Q abbreviates `r_entails R P Q`, + * P ≃_R Q abbreviates `r_equiv R P Q`, and + * P * Q abbreviates `r_sep R P Q`. + * + * Entailment observes valid resources only. Connectives are nevertheless + * defined on every carrier value and own exact resources: this theory assumes + * neither affinity, persistence, nor cancellativity. + * This is a pure proof-stdlib theory: loading it registers no QCP descriptor, + * parser interface, or symbolic state. + */ + +#include "proof/theory/logic/ra.h" + +/* ------------------------------------------------------------------------- */ +/* Core representation */ +/* ------------------------------------------------------------------------- */ + +/* `r_entails R P Q <=> forall a. ra_valid R a ==> P a ==> Q a`. */ +PROOF extern thm r_entails_def; + +/* `r_equiv R P Q <=> r_entails R P Q && r_entails R Q P`. */ +PROOF extern thm r_equiv_def; + +/* ------------------------------------------------------------------------- */ +/* Constructors */ +/* ------------------------------------------------------------------------- */ + +/* `r_emp R a <=> a == ra_unit R`. */ +PROOF extern thm r_emp_def; + +/* + * `r_sep R P Q a <=> + * exists x y. a == ra_op R x y && P x && Q y`. + */ +PROOF extern thm r_sep_def; + +/* `r_own R owned a <=> a == owned`. */ +PROOF extern thm r_own_def; + +/* `r_top R a <=> T`. */ +PROOF extern thm r_top_def; + +/* `r_bottom R a <=> F`. */ +PROOF extern thm r_bottom_def; + +/* `r_and R P Q a <=> P a && Q a`. */ +PROOF extern thm r_and_def; + +/* `r_or R P Q a <=> P a || Q a`. */ +PROOF extern thm r_or_def; + +/* `r_impl R P Q a <=> (P a ==> Q a)`. */ +PROOF extern thm r_impl_def; + +/* `r_exists R P a <=> exists x:B. P x a`, for `P:B->A->bool`. */ +PROOF extern thm r_exists_def; + +/* `r_forall R P a <=> forall x:B. P x a`, for `P:B->A->bool`. */ +PROOF extern thm r_forall_def; + +/* `r_pure R phi a <=> phi`. */ +PROOF extern thm r_pure_def; + +/* `r_fact R phi a <=> phi && a == ra_unit R`. */ +PROOF extern thm r_fact_def; + +/* + * `r_wand R P Q a <=> + * forall frame. ra_valid R (ra_op R a frame) ==> + * P frame ==> Q (ra_op R a frame)`. + */ +PROOF extern thm r_wand_def; + +/* ------------------------------------------------------------------------- */ +/* Laws: entailment and equivalence */ +/* ------------------------------------------------------------------------- */ + +/* `forall R P. r_entails R P P`. */ +PROOF extern thm R_ENTAILS_REFL; + +/* `P ⊢_R Q ==> Q ⊢_R S ==> P ⊢_R S`. */ +PROOF extern thm R_ENTAILS_TRANS; + +/* `(forall a. P a ==> Q a) ==> P ⊢_R Q`. */ +PROOF extern thm R_ENTAILS_POINTWISE; + +/* `P ≃_R Q <=> forall a. ra_valid R a ==> (P a <=> Q a)`. */ +PROOF extern thm R_EQUIV_POINTWISE; + +/* `P ⊢_R Q ==> Q ⊢_R P ==> P ≃_R Q`. */ +PROOF extern thm R_EQUIV_INTRO; + +/* `forall R P. r_equiv R P P`. */ +PROOF extern thm R_EQUIV_REFL; + +/* `P ≃_R Q ==> Q ≃_R P`. */ +PROOF extern thm R_EQUIV_SYM; + +/* `P ≃_R Q ==> Q ≃_R S ==> P ≃_R S`. */ +PROOF extern thm R_EQUIV_TRANS; + +/* ------------------------------------------------------------------------- */ +/* Laws: separating conjunction */ +/* ------------------------------------------------------------------------- */ + +/* `r_sep R (r_sep R P Q) S == r_sep R P (r_sep R Q S)`. */ +PROOF extern thm R_SEP_ASSOC; + +/* `r_sep R P Q == r_sep R Q P`. */ +PROOF extern thm R_SEP_COMM; + +/* `r_sep R (r_emp R) P == P`. */ +PROOF extern thm R_SEP_EMP_L; + +/* `r_sep R P (r_emp R) == P`. */ +PROOF extern thm R_SEP_EMP_R; + +/* `P ⊢_R P2 ==> Q ⊢_R Q2 ==> P*Q ⊢_R P2*Q2`. */ +PROOF extern thm R_SEP_MONO; + +/* `P ⊢_R Q ==> F*P ⊢_R F*Q`. */ +PROOF extern thm R_SEP_FRAME_L; + +/* `P ⊢_R Q ==> P*F ⊢_R Q*F`. */ +PROOF extern thm R_SEP_FRAME_R; + +/* `r_sep R (r_exists R (\x. P x)) Q == + * r_exists R (\x. r_sep R (P x) Q)`. */ +PROOF extern thm R_SEP_EXISTS_L; + +/* `r_sep R P (r_exists R (\x. Q x)) == + * r_exists R (\x. r_sep R P (Q x))`. */ +PROOF extern thm R_SEP_EXISTS_R; + +/* ------------------------------------------------------------------------- */ +/* Laws: additive connectives and quantification */ +/* ------------------------------------------------------------------------- */ + +/* `P ⊢_R Q ==> P ⊢_R S ==> P ⊢_R r_and R Q S`. */ +PROOF extern thm R_AND_INTRO; + +/* `r_and R P Q ⊢_R P`. */ +PROOF extern thm R_AND_ELIM_L; + +/* `r_and R P Q ⊢_R Q`. */ +PROOF extern thm R_AND_ELIM_R; + +/* `P ⊢_R r_or R P Q`. */ +PROOF extern thm R_OR_INTRO_L; + +/* `Q ⊢_R r_or R P Q`. */ +PROOF extern thm R_OR_INTRO_R; + +/* `P ⊢_R S ==> Q ⊢_R S ==> r_or R P Q ⊢_R S`. */ +PROOF extern thm R_OR_ELIM; + +/* `P witness ⊢_R r_exists R (\x. P x)`. */ +PROOF extern thm R_EXISTS_INTRO; + +/* `(forall x:B. P x ⊢_R Q) ==> + * r_exists R (\x. P x) ⊢_R Q`. */ +PROOF extern thm R_EXISTS_ELIM; + +/* `(forall x:B. P x ⊢_R Q x) ==> + * r_exists R (\x. P x) ⊢_R r_exists R (\x. Q x)`. */ +PROOF extern thm R_EXISTS_MONO; + +/* `(forall x:B. P ⊢_R Q x) ==> P ⊢_R r_forall R (\x. Q x)`. */ +PROOF extern thm R_FORALL_INTRO; + +/* `P witness ⊢_R Q ==> r_forall R (\x. P x) ⊢_R Q`. */ +PROOF extern thm R_FORALL_ELIM; + +/* ------------------------------------------------------------------------- */ +/* Laws: pure propositions and exact-unit facts */ +/* ------------------------------------------------------------------------- */ + +/* `phi ==> P ⊢_R Q ==> P ⊢_R r_and R (r_pure R phi) Q`. */ +PROOF extern thm R_PURE_AND_INTRO; + +/* `(phi ==> P ⊢_R Q) ==> r_and R (r_pure R phi) P ⊢_R Q`. */ +PROOF extern thm R_PURE_AND_ELIM; + +/* `r_fact R phi == r_and R (r_pure R phi) (r_emp R)`. */ +PROOF extern thm R_FACT_AS_PURE_AND_EMP; + +/* `r_fact R T == r_emp R`. */ +PROOF extern thm R_FACT_TRUE; + +/* `r_fact R F == r_bottom R`. */ +PROOF extern thm R_FACT_FALSE; + +/* `r_sep R (r_fact R phi) P == r_and R (r_pure R phi) P`. */ +PROOF extern thm R_FACT_SEP_L; + +/* `r_sep R P (r_fact R phi) == r_and R (r_pure R phi) P`. */ +PROOF extern thm R_FACT_SEP_R; + +/* `phi ==> P ⊢_R Q ==> P ⊢_R r_sep R (r_fact R phi) Q`. */ +PROOF extern thm R_FACT_INTRO; + +/* `(phi ==> P ⊢_R Q) ==> r_sep R (r_fact R phi) P ⊢_R Q`. */ +PROOF extern thm R_FACT_ELIM; + +/* `r_fact R phi ⊢_R r_sep R (r_fact R phi) (r_fact R phi)`. */ +PROOF extern thm R_FACT_DUP; + +/* ------------------------------------------------------------------------- */ +/* Ownership and adjunction laws */ +/* ------------------------------------------------------------------------- */ + +/* `r_own R (ra_unit R) == r_emp R`. */ +PROOF extern thm R_OWN_UNIT; + +/* `r_own R (ra_op R a b) == r_sep R (r_own R a) (r_own R b)`. */ +PROOF extern thm R_OWN_OP; + +/* `r_own R a ⊢_R r_and R (r_pure R (ra_valid R a)) (r_own R a)`. */ +PROOF extern thm R_OWN_VALID; + +/* `r_and R P Q ⊢_R S <=> P ⊢_R r_impl R Q S`. */ +PROOF extern thm R_IMPL_ADJUNCTION; + +/* `r_sep R P Q ⊢_R S <=> P ⊢_R r_wand R Q S`. */ +PROOF extern thm R_WAND_ADJUNCTION; + +/* + * `r_sep R P (r_and R Q S) ⊢_R + * r_and R (r_sep R P Q) (r_sep R P S)`. + */ +PROOF extern thm R_SEP_AND_FORWARD_R; + +/* + * `r_sep R (r_and R Q S) P ⊢_R + * r_and R (r_sep R Q P) (r_sep R S P)`. + * No converse is derivable in general. + */ +PROOF extern thm R_SEP_AND_FORWARD_L; -- Gitee From b4df74d5cc7172a93465363ffd9598caec9fc0c5 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Wed, 29 Jul 2026 04:33:21 +0800 Subject: [PATCH 05/35] feat(c-logic): combine physical and ghost resources --- adapter/ra_sl.c | 134 ++ adapter/ra_sl.h | 52 + adapter/ra_sl_scope.c | 260 ++++ adapter/ra_sl_scope.h | 48 + adapter/ra_sl_scope_internal.h | 28 + docs/BACKWARD_PROOF_SPEC.md | 25 +- docs/SL_PROOF_SPEC.md | 25 +- printers.h | 51 + proof.h | 45 +- proof_backward.c | 110 +- proof_backward.h | 272 ++-- proof_backward_sl.c | 481 +++++- proof_backward_sl.h | 240 ++- proof_kernel.h | 87 +- proof_sl.c | 1786 ++++++++++++++++++++--- proof_sl.h | 1003 +++++++++---- proof_symexec.h | 32 +- proof_user.c | 258 +++- proof_user.h | 88 +- test/proof_backward_regression.c | 38 +- test/proof_sl_regression.c | 327 +++-- theory/c_program_logic/c_basic_update.c | 1432 ++++++++++++++++++ theory/c_program_logic/c_basic_update.h | 140 ++ theory/c_program_logic/c_ghost_update.c | 702 +++++++++ theory/c_program_logic/c_ghost_update.h | 110 ++ theory/c_program_logic/c_integer.c | 248 ++++ theory/c_program_logic/c_integer.h | 71 + theory/c_program_logic/c_memory.c | 725 +++++++++ theory/c_program_logic/c_memory.h | 285 ++++ theory/c_program_logic/c_resource.c | 603 ++++++++ theory/c_program_logic/c_resource.h | 159 ++ theory/c_program_logic/c_types.c | 83 ++ theory/c_program_logic/c_types.h | 37 + theory/c_program_logic/mem_own.c | 64 + theory/c_program_logic/mem_own.h | 33 + theory/c_program_logic/mem_ra.c | 371 +++++ theory/c_program_logic/mem_ra.h | 162 ++ theory/c_program_logic/mem_value.c | 681 +++++++++ theory/c_program_logic/mem_value.h | 254 ++++ 39 files changed, 10574 insertions(+), 976 deletions(-) create mode 100644 adapter/ra_sl.c create mode 100644 adapter/ra_sl.h create mode 100644 adapter/ra_sl_scope.c create mode 100644 adapter/ra_sl_scope.h create mode 100644 adapter/ra_sl_scope_internal.h create mode 100644 printers.h create mode 100644 theory/c_program_logic/c_basic_update.c create mode 100644 theory/c_program_logic/c_basic_update.h create mode 100644 theory/c_program_logic/c_ghost_update.c create mode 100644 theory/c_program_logic/c_ghost_update.h create mode 100644 theory/c_program_logic/c_integer.c create mode 100644 theory/c_program_logic/c_integer.h create mode 100644 theory/c_program_logic/c_memory.c create mode 100644 theory/c_program_logic/c_memory.h create mode 100644 theory/c_program_logic/c_resource.c create mode 100644 theory/c_program_logic/c_resource.h create mode 100644 theory/c_program_logic/c_types.c create mode 100644 theory/c_program_logic/c_types.h create mode 100644 theory/c_program_logic/mem_own.c create mode 100644 theory/c_program_logic/mem_own.h create mode 100644 theory/c_program_logic/mem_ra.c create mode 100644 theory/c_program_logic/mem_ra.h create mode 100644 theory/c_program_logic/mem_value.c create mode 100644 theory/c_program_logic/mem_value.h diff --git a/adapter/ra_sl.c b/adapter/ra_sl.c new file mode 100644 index 0000000..b6680f9 --- /dev/null +++ b/adapter/ra_sl.c @@ -0,0 +1,134 @@ +#include "proof/adapter/ra_sl.h" + +#require "proof/proof_sl.c" +#require "proof/theory/logic/resource_prop.c" + +PROOF int ra_sl_build(const term R, sl_theory *out) { + ENSURE_COND(out != NULL, "resource SL output bundle must not be null"); + bool R_is_empty = IS_NULL(R); + ENSURE_COND(!R_is_empty, "resource SL algebra must not be empty"); + term_list R_free_vars = free_vars(R); + size_t R_free_var_count = vector_size(R_free_vars); + ENSURE_COND(R_free_var_count == 0, "resource SL algebra must be closed"); + type_list R_term_tyvars = term_tyvars(R); + size_t R_term_tyvar_count = vector_size(R_term_tyvars); + ENSURE_COND(R_term_tyvar_count == 0, + "resource SL algebra term must be monomorphic"); + + type ra_type = type_of(R); + type_list ra_type_tyvars = type_tyvars(ra_type); + size_t ra_type_tyvar_count = vector_size(ra_type_tyvars); + ENSURE_COND(ra_type_tyvar_count == 0, + "resource SL algebra type must be monomorphic"); + bool ra_type_is_application = is_app_type(ra_type); + ENSURE_COND(ra_type_is_application, + "resource SL algebra must have type `(A)ra`"); + dest_app_type_results ra_shape = dest_app_type(ra_type); + int ra_name_order = strcmp(ra_shape.s, "ra"); + size_t ra_argument_count = vector_size(ra_shape.tys); + bool ra_shape_is_unary = ra_name_order == 0 && ra_argument_count == 1; + ENSURE_COND(ra_shape_is_unary, + "resource SL algebra must have unary type `(A)ra`"); + + type carrier_type = ra_shape.tys[0]; + type bool_type = mk_bool_type(); + type prop_type = mk_fun_type(carrier_type, bool_type); + type prop_to_prop_type = mk_fun_type(prop_type, prop_type); + type binary_prop_type = mk_fun_type(prop_type, prop_to_prop_type); + type prop_to_bool_type = mk_fun_type(prop_type, bool_type); + type binary_relation_type = mk_fun_type(prop_type, prop_to_bool_type); + type fact_type = mk_fun_type(bool_type, prop_type); + type witness_type = mk_var_type("B"); + type witness_family_type = mk_fun_type(witness_type, prop_type); + type exists_type = mk_fun_type(witness_family_type, prop_type); + + sl_theory theory; + theory.prop_type = prop_type; + + type emp_head_type = mk_fun_type(ra_type, prop_type); + term head = mk_const("r_emp", emp_head_type); + theory.emp = mk_comb(head, R); + + type binary_prop_head_type = mk_fun_type(ra_type, binary_prop_type); + head = mk_const("r_sep", binary_prop_head_type); + theory.sep = mk_comb(head, R); + + head = mk_const("r_wand", binary_prop_head_type); + theory.wand = mk_comb(head, R); + + head = mk_const("r_and", binary_prop_head_type); + theory.and_op = mk_comb(head, R); + + head = mk_const("r_or", binary_prop_head_type); + theory.or_op = mk_comb(head, R); + + /* Leave only the witness type polymorphic. `proof_sl` explicitly + * instantiates this variable before applying the operator to an assertion + * family; HOL's raw `mk_comb` does not perform that instantiation. */ + type exists_head_type = mk_fun_type(ra_type, exists_type); + head = mk_const("r_exists", exists_head_type); + theory.exists_op = mk_comb(head, R); + + head = mk_const("r_forall", exists_head_type); + theory.forall_op = mk_comb(head, R); + + type relation_head_type = mk_fun_type(ra_type, binary_relation_type); + head = mk_const("r_entails", relation_head_type); + theory.entails = mk_comb(head, R); + + head = mk_const("r_equiv", relation_head_type); + theory.equiv = mk_comb(head, R); + + type fact_head_type = mk_fun_type(ra_type, fact_type); + head = mk_const("r_fact", fact_head_type); + theory.fact = mk_comb(head, R); + + /* The ACU and existential-distribution laws are exact predicate equalities; + * logical antisymmetry is deliberately installed as `r_equiv` instead. */ + theory.sep_emp_left = ispec_rule(R, R_SEP_EMP_L); + theory.sep_emp_right = ispec_rule(R, R_SEP_EMP_R); + theory.sep_assoc = ispec_rule(R, R_SEP_ASSOC); + theory.sep_comm = ispec_rule(R, R_SEP_COMM); + theory.sep_mono = ispec_rule(R, R_SEP_MONO); + theory.wand_sep_adjoint = ispec_rule(R, R_WAND_ADJUNCTION); + + theory.and_intro = ispec_rule(R, R_AND_INTRO); + theory.and_elim1 = ispec_rule(R, R_AND_ELIM_L); + theory.and_elim2 = ispec_rule(R, R_AND_ELIM_R); + theory.or_intro1 = ispec_rule(R, R_OR_INTRO_L); + theory.or_intro2 = ispec_rule(R, R_OR_INTRO_R); + theory.or_elim = ispec_rule(R, R_OR_ELIM); + + theory.exists_intro = ispec_rule(R, R_EXISTS_INTRO); + theory.exists_elim = ispec_rule(R, R_EXISTS_ELIM); + theory.exists_mono = ispec_rule(R, R_EXISTS_MONO); + theory.sep_exists_left = ispec_rule(R, R_SEP_EXISTS_L); + theory.sep_exists_right = ispec_rule(R, R_SEP_EXISTS_R); + theory.forall_intro = ispec_rule(R, R_FORALL_INTRO); + theory.forall_elim = ispec_rule(R, R_FORALL_ELIM); + + theory.ent_refl = ispec_rule(R, R_ENTAILS_REFL); + theory.ent_trans = ispec_rule(R, R_ENTAILS_TRANS); + theory.equiv_intro = ispec_rule(R, R_EQUIV_INTRO); + + theory.fact_intro = ispec_rule(R, R_FACT_INTRO); + theory.fact_elim = ispec_rule(R, R_FACT_ELIM); + theory.fact_dup = ispec_rule(R, R_FACT_DUP); + theory.fact_true_emp = ispec_rule(R, R_FACT_TRUE); + + *out = theory; + return 0; +err: + ERR_FUN_PUTS("ra_sl_build"); + return -1; +} + +PROOF int ra_sl_install(const term R) { + sl_theory theory; + ra_sl_build(R, &theory); + sl_install_theory(&theory); + return 0; +err: + ERR_FUN_PUTS("ra_sl_install"); + return -1; +} diff --git a/adapter/ra_sl.h b/adapter/ra_sl.h new file mode 100644 index 0000000..a2c6b62 --- /dev/null +++ b/adapter/ra_sl.h @@ -0,0 +1,52 @@ +/** + * @file ra_sl.h + * @brief Specialize generic resource propositions as the active SL theory. + * + * `ra_sl_install R` specializes `r_emp`, `r_sep`, `r_wand`, the + * additive connectives, entailment, equivalence, facts, and their primitive + * laws at one closed monomorphic resource algebra `R:(A)ra`. Assertions in + * the installed model consequently have type `A->bool`. + * + * The active SL signature is verification-runtime global metadata. Every + * successful installation replaces the previous signature and advances the + * generation returned by `sl_theory_generation`; generation-keyed derived-rule + * caches are rebuilt on their next use. Call this function before constructing + * SL terms or goals for a file, and do not retain such terms across an + * installation of a different RA. + * + * This adapter installs only the language-independent BI assertion theory. It + * contains no basic-update modality, C memory semantics, symbolic-state storage, + * or any dependency on the legacy heap-assertion model. + */ + +#pragma once + +#include "proof/proof_sl.h" +#include "proof/theory/logic/resource_prop.h" + +/** + * Build the generic resource-proposition proof bundle specialized at `R`. + * + * `R` must be a closed monomorphic unary RA term. The returned operators are + * the direct applications `r_emp R`, `r_sep R`, ... and the primitive rules + * use those same heads. This function does not mutate the active SL theory. + * `out` must be non-null and remains owned by the caller; its term and theorem + * handles refer to prover-global immutable HOL objects. + * + * @return Zero on success, or `-1` after setting proof error status if `R` or + * `out` violates the contract or specialization fails. + */ +PROOF int ra_sl_build(const term R, sl_theory* out); + +/** + * Specialize and install the resource-proposition SL theory at `R`. + * + * `R` must be a closed term with a monomorphic unary type `(A)ra`. The + * existential operator remains polymorphic only in its bound witness type; + * its assertion-resource carrier is fixed to `A`. + * + * @return Zero on success, or `-1` after setting proof error status when `R` + * has the wrong shape, is open or polymorphic, an operator cannot be + * specialized, or the resulting signature is rejected. + */ +PROOF int ra_sl_install(const term R); diff --git a/adapter/ra_sl_scope.c b/adapter/ra_sl_scope.c new file mode 100644 index 0000000..d57e3f5 --- /dev/null +++ b/adapter/ra_sl_scope.c @@ -0,0 +1,260 @@ +#include "proof/adapter/ra_sl_scope_internal.h" + +#require "proof/syntax/base.c" +#require "proof/adapter/ra_sl.c" + +PROOF bool sl_scope_name_is_valid(const char *scope_name) { + if (scope_name == NULL || scope_name[0] == '\0') + return false; + for (size_t i = 0; scope_name[i] != '\0'; ++i) { + char ch = scope_name[i]; + if (!(('a' <= ch && ch <= 'z') || ('A' <= ch && ch <= 'Z') || + ('0' <= ch && ch <= '9') || ch == '_')) { + return false; + } + } + return true; +} + +PROOF static bool sl_const_name_exists(const char *name) { + hol_const_list constants = get_all_consts(); + if (constants == NULL) + return false; + for (size_t i = 0; i < vector_size(constants); ++i) { + if (strcmp(constants[i].name, name) == 0) + return true; + } + return false; +} + +PROOF int sl_define_scope_alias(const char *scope_name, const char *suffix, + const term direct, term *alias, + thm *alias_def) { + bool scope_name_is_valid = sl_scope_name_is_valid(scope_name); + ENSURE_COND(scope_name_is_valid, + "SL scope must be a nonempty ASCII identifier"); + bool suffix_is_valid = sl_scope_name_is_valid(suffix); + ENSURE_COND(suffix_is_valid, + "SL alias suffix must be a nonempty ASCII identifier"); + bool direct_is_empty = IS_NULL(direct); + ENSURE_COND(!direct_is_empty, "direct SL operator must not be empty"); + ENSURE_COND(alias != NULL && alias_def != NULL, + "SL alias outputs must not be null"); + term_list direct_free_vars = free_vars(direct); + size_t direct_free_var_count = vector_size(direct_free_vars); + ENSURE_COND(direct_free_var_count == 0, + "direct SL operator must be closed"); + + const char *alias_name = gc_sprintf("cstar_sl__%s__%s", scope_name, suffix); + bool alias_exists = sl_const_name_exists(alias_name); + type direct_type = type_of(direct); + term lhs; + if (alias_exists) { + lhs = mk_const(alias_name, direct_type); + } else { + lhs = mk_var(alias_name, direct_type); + } + term equation_term = mk_eq(lhs, direct); + *alias_def = new_const_definition(equation_term); + term equation_conclusion = concl(*alias_def); + dest_eq_results equation = dest_eq(equation_conclusion); + *alias = equation.tm1; + bool alias_is_constant = is_const(*alias); + ENSURE_COND(alias_is_constant, + "scoped SL definition did not produce a constant head"); + return 0; +err: + { + char *scope_name_text = cstr_string(scope_name); + char *suffix_text = cstr_string(suffix); + char *direct_text = cstr_term(direct); + ERR_FUN_PUTS("sl_define_scope_alias", scope_name_text, suffix_text, + direct_text); + return -1; + } +} + +PROOF thm ra_sl_scope_fold(const ra_sl_scope *scope, const thm direct_rule) { + ENSURE_COND(scope != NULL, "resource scope must not be null"); + bool direct_rule_is_empty = IS_NULL(direct_rule); + ENSURE_COND(!direct_rule_is_empty, "direct resource rule is empty"); + thm emp_fold = gsym_rule(scope->emp_def); + thm sep_fold = gsym_rule(scope->sep_def); + thm wand_fold = gsym_rule(scope->wand_def); + thm and_fold = gsym_rule(scope->and_def); + thm or_fold = gsym_rule(scope->or_def); + thm exists_fold = gsym_rule(scope->exists_def); + thm forall_fold = gsym_rule(scope->forall_def); + thm entails_fold = gsym_rule(scope->entails_def); + thm equiv_fold = gsym_rule(scope->equiv_def); + thm fact_fold = gsym_rule(scope->fact_def); + thm pure_fold = gsym_rule(scope->pure_def); + thm_list folds = + THM_LIST(emp_fold, sep_fold, wand_fold, and_fold, or_fold, exists_fold, + forall_fold, entails_fold, equiv_fold, fact_fold, pure_fold); + thm result = pure_rewrite_rule(folds, direct_rule); + return result; +err: + { + char *direct_rule_text = cstr_thm(direct_rule); + ERR_FUN_PUTS("ra_sl_scope_fold", direct_rule_text); + return empty_theorem; + } +} + +PROOF int ra_sl_scope_prepare(const char *scope_name, const term R, + ra_sl_scope *out) { + ENSURE_COND(out != NULL, "resource scope output must not be null"); + bool scope_name_is_valid = sl_scope_name_is_valid(scope_name); + ENSURE_COND(scope_name_is_valid, + "SL scope must be a nonempty ASCII identifier"); + + sl_theory direct; + ra_sl_build(R, &direct); + ra_sl_scope result; + result.theory = direct; + +#define DEFINE_RESOURCE_ALIAS(field, suffix_name, definition_field) \ + sl_define_scope_alias(scope_name, suffix_name, direct.field, \ + &result.theory.field, &result.definition_field) + + DEFINE_RESOURCE_ALIAS(emp, "emp", emp_def); + DEFINE_RESOURCE_ALIAS(sep, "sep", sep_def); + DEFINE_RESOURCE_ALIAS(wand, "wand", wand_def); + DEFINE_RESOURCE_ALIAS(and_op, "and", and_def); + DEFINE_RESOURCE_ALIAS(or_op, "or", or_def); + DEFINE_RESOURCE_ALIAS(exists_op, "exists", exists_def); + DEFINE_RESOURCE_ALIAS(forall_op, "forall", forall_def); + DEFINE_RESOURCE_ALIAS(entails, "entails", entails_def); + DEFINE_RESOURCE_ALIAS(equiv, "equiv", equiv_def); + DEFINE_RESOURCE_ALIAS(fact, "fact", fact_def); +#undef DEFINE_RESOURCE_ALIAS + + type ra_type = type_of(R); + type bool_type = mk_bool_type(); + type bool_to_prop_type = mk_fun_type(bool_type, direct.prop_type); + type pure_head_type = mk_fun_type(ra_type, bool_to_prop_type); + term pure_head = mk_const("r_pure", pure_head_type); + term direct_pure = mk_comb(pure_head, R); + sl_define_scope_alias(scope_name, "pure", direct_pure, &result.pure, + &result.pure_def); + +#define FOLD_RESOURCE_RULE(field) \ + result.theory.field = ra_sl_scope_fold(&result, direct.field) + + FOLD_RESOURCE_RULE(sep_emp_left); + FOLD_RESOURCE_RULE(sep_emp_right); + FOLD_RESOURCE_RULE(sep_assoc); + FOLD_RESOURCE_RULE(sep_comm); + FOLD_RESOURCE_RULE(sep_mono); + FOLD_RESOURCE_RULE(wand_sep_adjoint); + FOLD_RESOURCE_RULE(and_intro); + FOLD_RESOURCE_RULE(and_elim1); + FOLD_RESOURCE_RULE(and_elim2); + FOLD_RESOURCE_RULE(or_intro1); + FOLD_RESOURCE_RULE(or_intro2); + FOLD_RESOURCE_RULE(or_elim); + FOLD_RESOURCE_RULE(exists_intro); + FOLD_RESOURCE_RULE(exists_elim); + FOLD_RESOURCE_RULE(exists_mono); + FOLD_RESOURCE_RULE(sep_exists_left); + FOLD_RESOURCE_RULE(sep_exists_right); + FOLD_RESOURCE_RULE(forall_intro); + FOLD_RESOURCE_RULE(forall_elim); + FOLD_RESOURCE_RULE(ent_refl); + FOLD_RESOURCE_RULE(ent_trans); + FOLD_RESOURCE_RULE(equiv_intro); + FOLD_RESOURCE_RULE(fact_intro); + FOLD_RESOURCE_RULE(fact_elim); + FOLD_RESOURCE_RULE(fact_dup); + FOLD_RESOURCE_RULE(fact_true_emp); +#undef FOLD_RESOURCE_RULE + + *out = result; + return 0; +err: + { + char *scope_name_text = cstr_string(scope_name); + char *R_text = cstr_term(R); + ERR_FUN_PUTS("ra_sl_scope_prepare", scope_name_text, R_text); + return -1; + } +} + +PROOF int ra_sl_scope_install(const ra_sl_scope *scope) { + ENSURE_COND(scope != NULL, "resource scope must not be null"); + sl_install_theory(&scope->theory); + return 0; +err: + ERR_FUN_PUTS("ra_sl_scope_install"); + return -1; +} + +PROOF int ra_sl_scope_activate(const ra_sl_scope *scope) { + ENSURE_COND(scope != NULL, "resource scope must not be null"); + const sl_theory *active = sl_current_theory(); + bool prop_type_matches = + equals_type(active->prop_type, scope->theory.prop_type); + bool emp_matches = equals_term(active->emp, scope->theory.emp); + bool sep_matches = equals_term(active->sep, scope->theory.sep); + bool wand_matches = equals_term(active->wand, scope->theory.wand); + bool and_matches = equals_term(active->and_op, scope->theory.and_op); + bool or_matches = equals_term(active->or_op, scope->theory.or_op); + bool exists_matches = + equals_term(active->exists_op, scope->theory.exists_op); + bool forall_matches = + equals_term(active->forall_op, scope->theory.forall_op); + bool entails_matches = equals_term(active->entails, scope->theory.entails); + bool equiv_matches = equals_term(active->equiv, scope->theory.equiv); + bool fact_matches = equals_term(active->fact, scope->theory.fact); + bool theory_matches = + prop_type_matches && emp_matches && sep_matches && wand_matches && + and_matches && or_matches && exists_matches && forall_matches && + entails_matches && equiv_matches && fact_matches; + ENSURE_COND(theory_matches, + "resource notation scope is not the active SL theory"); + proof_install_base_syntax(); + + parse_as_infix("**", 8, "right"); + parse_as_infix("-*", 4, "right"); + parse_as_infix("|--", 2, "right"); + parse_as_infix("-||-", 2, "right"); + parse_as_infix("-|-", 2, "right"); + + override_interface("**", scope->theory.sep); + override_interface("-*", scope->theory.wand); + override_interface("|--", scope->theory.entails); + override_interface("-||-", scope->theory.equiv); + type bool_type = mk_bool_type(); + type prop_to_bool_type = mk_fun_type(scope->theory.prop_type, bool_type); + type equality_type = + mk_fun_type(scope->theory.prop_type, prop_to_bool_type); + term scoped_equality = mk_const("=", equality_type); + override_interface("-|-", scoped_equality); + override_interface("emp", scope->theory.emp); + override_interface("fact", scope->theory.fact); + override_interface("pure", scope->pure); + overload_interface("&&", scope->theory.and_op); + overload_interface("||", scope->theory.or_op); + overload_interface("exists", scope->theory.exists_op); + overload_interface("forall", scope->theory.forall_op); + return 0; +err: + ERR_FUN_PUTS("ra_sl_scope_activate"); + return -1; +} + +PROOF int ra_sl_install_scoped(const char *scope_name, const term R) { + ra_sl_scope scope; + ra_sl_scope_prepare(scope_name, R, &scope); + ra_sl_scope_install(&scope); + ra_sl_scope_activate(&scope); + return 0; +err: + { + char *scope_name_text = cstr_string(scope_name); + char *R_text = cstr_term(R); + ERR_FUN_PUTS("ra_sl_install_scoped", scope_name_text, R_text); + return -1; + } +} diff --git a/adapter/ra_sl_scope.h b/adapter/ra_sl_scope.h new file mode 100644 index 0000000..abe0239 --- /dev/null +++ b/adapter/ra_sl_scope.h @@ -0,0 +1,48 @@ +/** + * @file ra_sl_scope.h + * @brief Install stable closed SL aliases for one selected resource algebra. + */ + +#pragma once + +#include "proof/syntax/base.h" +#include "proof/adapter/ra_sl.h" + +/** + * Conservative alias layer over one specialized resource proposition theory. + * Each definition has shape `alias = direct_operator`; primitive rules in + * `theory` have already been folded to the alias heads. + */ +PROOF typedef struct { + sl_theory theory; + term pure; + + thm emp_def; + thm sep_def; + thm wand_def; + thm and_def; + thm or_def; + thm exists_def; + thm forall_def; + thm entails_def; + thm equiv_def; + thm fact_def; + thm pure_def; +} ra_sl_scope; + +/** + * Atomically select resource-only separation logic for `R`. + * + * `scope_name` must be a nonempty ASCII identifier and `R` must be closed and + * monomorphic. The call constructs fixed constants + * `cstar_sl____`, proves and installs the corresponding + * `sl_theory`, then activates parser interfaces for the same heads. It installs + * no update theory and no C/QCP assertion descriptor. + * + * HOL definitions and parser registrations cannot be rolled back piecemeal. + * Any error is therefore proof-initialization fail-stop for this session; the + * caller must not clear it and retry a different scope. + * + * @return Zero on success, or `-1` after reporting a prover error. + */ +PROOF int ra_sl_install_scoped(const char* scope_name, const term R); diff --git a/adapter/ra_sl_scope_internal.h b/adapter/ra_sl_scope_internal.h new file mode 100644 index 0000000..8bd8f0d --- /dev/null +++ b/adapter/ra_sl_scope_internal.h @@ -0,0 +1,28 @@ +/** + * @file ra_sl_scope_internal.h + * @brief Internal construction phases for selected-resource installers. + * + * These operations exist so the C logic installer can construct and validate + * all aliases and extra modalities before it crosses runtime/parser commit + * boundaries. Ordinary clients must use `ra_sl_install_scoped`. + */ + +#pragma once + +#include "proof/adapter/ra_sl_scope.h" + +PROOF bool sl_scope_name_is_valid(const char* scope_name); + +PROOF int sl_define_scope_alias(const char* scope_name, const char* suffix, + const term direct, term* alias, + thm* alias_def); + +PROOF int ra_sl_scope_prepare(const char* scope_name, const term R, + ra_sl_scope* out); + +PROOF thm ra_sl_scope_fold(const ra_sl_scope* scope, + const thm direct_rule); + +PROOF int ra_sl_scope_install(const ra_sl_scope* scope); + +PROOF int ra_sl_scope_activate(const ra_sl_scope* scope); diff --git a/docs/BACKWARD_PROOF_SPEC.md b/docs/BACKWARD_PROOF_SPEC.md index 6d4d76e..063da0a 100644 --- a/docs/BACKWARD_PROOF_SPEC.md +++ b/docs/BACKWARD_PROOF_SPEC.md @@ -40,16 +40,20 @@ For a theorem `T` and goal `G = [Γ ?⊢ p]`, define: achieves(T, G) iff concl(T) ≡α p and hyp(T) ⊆α |Γ| ``` -Here `⊆α` is set-like containment modulo alpha-equivalence. A theorem +Conclusion matching is alpha-equivalence only; it is not a host-language +quotient and performs no implicit beta conversion. Here `⊆α` is set-like containment +modulo alpha-equivalence. A theorem hypothesis may match an assumption regardless of its label, and duplicate HOL hypotheses do not consume duplicate assumptions. -An SL goal `[Γ; Δ ?⊢SL H]` is represented by `SL_GOAL` and has logical -conclusion `Sep(Δ) ⊢SL H`, where Δ is the ordered labeled spatial context. -Generic goal-tree operations use that logical conclusion. Assumption-only -transformations preserve the goal representation; conclusion transformations -create general HOL child goals unless a dedicated SL tactic specifies -otherwise. +An SL goal `[Γ; Δ ?⊢SL H]` is an extension goal whose cached logical +conclusion is `Sep(Δ) ⊢SL H`, where Δ is the ordered labeled spatial context. +Its private payload snapshots Δ and records `H` and the active SL-theory +generation. Generic goal-tree operations use only the cached conclusion; SL +accessors additionally require the recorded generation to remain active. +Assumption-only transformations preserve the extension payload; conclusion +transformations create general HOL child goals unless a dedicated SL tactic +specifies otherwise. ## 2. Goal-tree model @@ -78,8 +82,11 @@ for every T₁, …, Tₙ, ⇒ achieves(V(T₁,…,Tₙ),G) ``` -Validators receive child theorems in child order. Their conclusions need only -be alpha-equivalent to the child conclusions. Intermediate validators do not +Validators receive child theorems in child order. Their conclusions must be +alpha-equivalent to the child conclusions. A validator that deliberately +introduces a beta-redex must prove and apply that local conversion before it +returns; `gnode_accept` performs no beta transport. An alpha match may retain +its binder names until the root. Intermediate validators do not otherwise rename binders merely to reproduce the stored goal syntax. ### 2.1 Kernel operations diff --git a/docs/SL_PROOF_SPEC.md b/docs/SL_PROOF_SPEC.md index 1291f91..84aa0bc 100644 --- a/docs/SL_PROOF_SPEC.md +++ b/docs/SL_PROOF_SPEC.md @@ -469,13 +469,15 @@ goal_hcon(G) = K fresh_hants_label(G,s) returns a label absent from Δ ``` -These functions are defined only for `SL_GOAL`; a null fresh-label prefix uses -`"H"`. +These functions are defined only for goals created by `sl_goal_new` under the +currently active SL-theory generation; a null fresh-label prefix uses `"H"`. -`Γ` and `Δ` are mutable vector handles. Callers must treat vectors -stored in a goal as immutable. Every SL tactic that changes either context -copies it first, and no implementation may retain a vector address or element -pointer across `vector_add` or `vector_erase`. +`Γ` remains a shared vector handle that callers must not mutate through a +goal, while the goal stores a private shallow snapshot of `Δ`. Accessing `Δ` +returns another shallow vector copy. Terms and label strings remain shared. +Every SL tactic that changes either context copies it first, and no +implementation may retain a vector address or element pointer across +`vector_add` or `vector_erase`. ## 6. Entering SL mode and equality @@ -840,18 +842,17 @@ For an equality, the replacement must be its left side and the current consequent its right side; callers use `sym_rule` before the tactic when the available equality has the opposite orientation. -For example, in +For example, given a closed representation theorem of the schematic form ```text -get_data_at_to_undef_data_at : - data_at p Tptr q ⊢SL undef_data_at p Tptr +CELL_VIEW : concrete_cell p q ⊢SL abstract_cell p ``` -the consequent match automatically infers `p` and `Tptr`. The variable `q` +the consequent match automatically infers `p`. The variable `q` occurs only in the left endpoint, so it is unconstrained and remains fresh in the new obligation. A caller that wants the existing term `q` there must first -specialize the theorem at `p`, `Tptr`, and `q`. Applying the resulting theorem -changes consequent `undef_data_at p Tptr` to `data_at p Tptr q` while leaving +specialize the theorem at `p` and `q`. Applying the resulting theorem changes +consequent `abstract_cell p` to `concrete_cell p q` while leaving the antecedents untouched. ### 8.2 Separating conjunction diff --git a/printers.h b/printers.h new file mode 100644 index 0000000..2c83c41 --- /dev/null +++ b/printers.h @@ -0,0 +1,51 @@ +/** + * @file printers.h + * @brief IDE value printers that do not select an assertion model. + * + * Pure proof theories should include this header when they only need C* LSP + * rendering. In particular, including it neither installs an SL theory nor + * registers anything with QCP. + */ +#pragma once + +#include "proof/proof_kernel.h" + +PROOF static inline char *cst_string_of_int(const int x) { + return cstr_int(x); +} + +PROOF static inline char *cst_string_of_term(const term tm) { + if (IS_NULL(tm)) return ""; + return cstr_term(tm); +} + +PROOF static inline char *cst_string_of_thm(const thm th) { + if (IS_NULL(th)) return ""; + return cstr_thm(th); +} + +PROOF static inline char *cst_string_of_type(const type ty) { + if (IS_NULL(ty)) return ""; + return cstr_type(ty); +} + +PROOF static inline char *cst_string_of_indtype(const indtype idt) { + return cstr_indtype(idt); +} + +PROOF static inline char *cst_string_of_inddef(const inddef idf) { + return cstr_inddef(idf); +} + +PROOF static inline char *cst_string_of_term_list(const term_list terms) { + return cstr_term_list(terms); +} + +PROOF static inline char *cst_string_of_thm_list(const thm_list theorems) { + return cstr_thm_list(theorems); +} + +PROOF static inline char *cst_string_of_term_pair_list( + const term_pair_list pairs) { + return cstr_term_pair_list(pairs); +} diff --git a/proof.h b/proof.h index fd31f8b..484f675 100644 --- a/proof.h +++ b/proof.h @@ -5,18 +5,19 @@ * * ```text * proof_kernel - * | - * proof_user user-facing HOL utilities - * | - * proof_sl forward SL theorem construction - * | - * proof_backward validated goal trees and HOL tactics - * | | - * proof_backward_sl proof_symexec SL tactics / trusted QCP bridge + * └─ proof_user user-facing HOL utilities + * ├─ proof_sl forward SL theorem construction + * └─ proof_backward generic goal trees / HOL tactics + * + * proof_sl + proof_backward + * ├─ proof_backward_sl SL backward tactics + * └─ proof_symexec trusted QCP bridge * ``` * - * Except for the explicitly unsafe `CHEAT_TAC`, `proof_backward` and - * `proof_backward_sl` reconstruct theorems bottom-up through validators. + * `proof_backward` is independent of any object logic; both SL consumers + * explicitly depend on it and `proof_sl`. Except for the explicitly unsafe + * `CHEAT_TAC`, `proof_backward` and `proof_backward_sl` reconstruct theorems + * bottom-up through validators. * `CHEAT_TAC` calls `new_axiom` for its goal. `proof_symexec` is also a * deliberate trust boundary: its documented QCP bridge and fact-purification * equations use private axioms. These APIs must be counted in the verification @@ -27,11 +28,20 @@ * `*_SLTAC` transform validated backward goals. The latter store validators * that reconstruct a theorem when their children are proved. * - * This umbrella inherits the canonical notation of `proof_kernel.h`, - * `proof_user.h`, and `proof_sl.h`. Backward-proof headers use Γ for the - * ordered labeled ordinary-assumption context, Δ for the ordered labeled - * spatial-antecedent context, and 𝒜 for the set of hypotheses of a HOL - * theorem. They do not redefine the underlying HOL or SL judgments. + * This umbrella inherits the canonical typing notation `t:τ` and theorem + * judgment `𝒜 ⊢ φ` of `proof_kernel.h`, plus `P ⊢SL Q`, `P ⇛ Q`, raw + * `P = Q`, and `P ** Q` from `proof_sl.h`. A C `thm` value is an opaque handle + * to `𝒜 ⊢ φ`, never φ itself. Backward-proof diagrams use Γ for the ordered + * labeled ordinary context and Δ for the ordered labeled spatial context; + * `|Γ|` denotes the corresponding set of ordinary HOL assumptions when a + * theorem-side condition is stated. + * + * Including this file installs the user-side parser/printer dialect and loads + * the generic proof implementation units shown above. It deliberately selects + * no assertion model: C programs normally obtain the default unit-ghost model + * from `veriftime.h`, while proof-only tests explicitly install an RA-backed + * scope such as the default unit-ghost C logic. Header inclusion transfers no + * ownership of HOL handles or runtime vector/string storage. * * The public headers are the per-function API reference. The companion * specifications explain the proof-state and validation semantics across @@ -45,6 +55,11 @@ #include "proof/proof_kernel.h" +/* Reinstall the C* proof dialect from the user-side library so parsing and + * printing do not depend on an OCaml bootstrap module. */ +#include "proof/syntax/base.h" +#require "proof/syntax/base.c" + #include "proof/proof_user.h" #require "proof/proof_user.c" diff --git a/proof_backward.c b/proof_backward.c index 2a32a52..288f321 100644 --- a/proof_backward.c +++ b/proof_backward.c @@ -22,33 +22,20 @@ PROOF gnode_list gnode_list_from_array(size_t size, gnode* nodes) { return result; } +PROOF static const goal_kind general_goal_kind = {"general", NULL}; + PROOF goal general_goal_new(const labeled_term_list lasmps, const term ccl) { - goal g; - g.type = GENERAL_GOAL; - g.lasmps = lasmps; - g.ccl = ccl; - return g; + return (goal){lasmps, ccl, &general_goal_kind, NULL}; } -PROOF goal sl_goal_new(const labeled_term_list lasmps, const labeled_term_list lhants, - const term hcon) { - goal g; - g.type = SL_GOAL; - g.lasmps = lasmps; - g.lhants = lhants; - g.hcon = hcon; - return g; +PROOF bool goal_is_general(const goal g) { + return g.kind == &general_goal_kind; } PROOF goal goal_with_lasmps(const goal g, const labeled_term_list lasmps) { - switch (g.type) { - case GENERAL_GOAL: - return general_goal_new(lasmps, g.ccl); - case SL_GOAL: - return sl_goal_new(lasmps, g.lhants, g.hcon); - default: - return empty_goal; - } + goal result = g; + result.lasmps = lasmps; + return result; } PROOF labeled_term_list goal_lasmps(const goal g) { @@ -56,18 +43,7 @@ PROOF labeled_term_list goal_lasmps(const goal g) { } PROOF term goal_ccl(const goal g) { - switch (g.type) { - case GENERAL_GOAL: - return g.ccl; - case SL_GOAL: { - term_list hants = labeled_term_list_to_term_list(g.lhants); - term hant = list_mk_sl_sep(hants); - term ccl = mk_binop(sl_ent(), hant, g.hcon); - return ccl; - } - default: - return empty_term; - } + return g.ccl; } PROOF bool var_free_in_goal(const term v, const goal g) { @@ -128,7 +104,7 @@ PROOF void gnode_accept(const gnode gn, const thm th) { term ccl = goal_ccl(gn->g); term th_ccl = concl(th); ENSURE_COND(alpha_compare(th_ccl, ccl) == 0, - "Theorem conclusion does not match the goal"); + "Theorem conclusion does not match the goal modulo alpha"); /* Every theorem hypothesis must occur among the goal assumptions, modulo * alpha-equivalence. */ term_list th_hyps = hyp(th); @@ -182,57 +158,24 @@ PROOF static char* cstr_lasmps(const labeled_term_list lasmps) { return buf; } -PROOF static char* cstr_lhants(const labeled_term_list lhants) { - char* buf = BOLD("Antecedents:"); - if (vector_size(lhants) == 0) { - buf = gc_strcat(buf, GRAY(" (none)")); - } else { - for (size_t i = 0; i < vector_size(lhants); ++i) { - buf = gc_strcat(buf, GRAY("\n")); - labeled_term ltm = lhants[i]; - char* tm_str = string_of_term(ltm.tm); - if (ltm.lb) { - buf = gc_strcat(buf, GRAY(ltm.lb)); - buf = gc_strcat(buf, GRAY(": ")); - buf = gc_strcat(buf, YELLOW(tm_str)); - } else { - buf = gc_strcat(buf, YELLOW(tm_str)); - } - } - } - return buf; -} - PROOF char* cstr_goal(const goal g) { char* buf = NORMAL("\n--------------------------------\n"); char* lasmps_cstr = cstr_lasmps(g.lasmps); buf = gc_strcat(buf, lasmps_cstr); - switch (g.type) { - case GENERAL_GOAL: { - buf = gc_strcat(buf, NORMAL("\n--------------------------------\n")); - buf = gc_strcat(buf, BOLD("Conclusion:")); - buf = gc_strcat(buf, NORMAL("\n ")); - char* ccl_str = - string_of_term(g.ccl); // TODO: use HOL Light colored printing? - buf = gc_strcat(buf, YELLOW(ccl_str)); - buf = gc_strcat(buf, NORMAL("\n")); - return buf; - } - case SL_GOAL: { - buf = gc_strcat(buf, NORMAL("\n--------------------------------\n")); - char* lhants_cstr = cstr_lhants(g.lhants); - buf = gc_strcat(buf, lhants_cstr); - buf = gc_strcat(buf, NORMAL("\n================================\n")); - buf = gc_strcat(buf, BOLD("Consequent:")); - buf = gc_strcat(buf, NORMAL("\n ")); - char* hcon_str = string_of_term(g.hcon); - buf = gc_strcat(buf, YELLOW(hcon_str)); - buf = gc_strcat(buf, NORMAL("\n")); - return buf; - } - default: - return gc_sprintf("Unknown goal type"); + buf = gc_strcat(buf, NORMAL("\n--------------------------------\n")); + if (goal_is_general(g)) { + buf = gc_strcat(buf, BOLD("Conclusion:")); + buf = gc_strcat(buf, NORMAL("\n ")); + char* ccl_str = + string_of_term(g.ccl); // TODO: use HOL Light colored printing? + buf = gc_strcat(buf, YELLOW(ccl_str)); + buf = gc_strcat(buf, NORMAL("\n")); + return buf; + } + if (g.kind == NULL || g.kind->format_payload == NULL) { + return gc_strcat(buf, gc_sprintf("Invalid goal kind")); } + return gc_strcat(buf, g.kind->format_payload(g.payload)); } PROOF char* cstr_gnode(const gnode gn) { @@ -423,9 +366,12 @@ PROOF static thm neg_disch_tac_valid(thm* ths, gnode gn) { thm imp = disch_rule(ant, ths[0]); /* NOT_DEF: |- (~) = (\p. p ==> false). Applying both sides to ant and - * beta-reducing gives |- ~ant = (ant ==> false). */ + * contracting only the generated application on the equality's right side + * gives |- ~ant = (ant ==> false). Redexes already inside ant are retained. */ thm not_def = get_theorem_by_name("NOT_DEF"); - thm not_eq_imp = beta_rule(ap_thm_rule(not_def, ant)); + thm applied = ap_thm_rule(not_def, ant); + conv beta = get_conversion_by_name("BETA_CONV"); + thm not_eq_imp = conv_rule(rand_conv(beta), applied); return eq_mp_rule(sym_rule(not_eq_imp), imp); } diff --git a/proof_backward.h b/proof_backward.h index 7969b91..8746396 100644 --- a/proof_backward.h +++ b/proof_backward.h @@ -21,9 +21,9 @@ * * An open leaf contains only its goal. Expanding it installs child nodes, a * validator, and a validator environment. A proved node stores a theorem that - * achieves its goal: the theorem conclusion is alpha-equivalent to the goal - * conclusion, and every theorem hypothesis has an alpha-equivalent proposition - * in the goal's ordinary assumption context. + * achieves its goal: theorem and goal conclusions are alpha-equivalent, and + * every theorem hypothesis has an alpha-equivalent + * proposition in the goal's ordinary assumption context. * * ## Goal-oriented proof process with explicit goal trees * @@ -46,22 +46,34 @@ * [backward-proof specification](docs/BACKWARD_PROOF_SPEC.md). * * This header inherits HOL judgments and ≡α from `proof_kernel.h` and - * `proof_user.h`, and SL connectives from `proof_sl.h`. Γ is the ordered list - * of labeled ordinary assumptions, 𝒜 is the set of hypotheses of a HOL theorem, - * and Δ is reserved for the spatial context in `proof_backward_sl.h`. Write - * `|Γ|` for the propositions in Γ, ignoring labels and duplicates, and - * `𝒜 ⊆α |Γ|` when each member of 𝒜 has an ≡α match in `|Γ|`. Consequently - * `[Γ ?⊢ p]` is a goal state, whereas `𝒜 ⊢ p` is a theorem judgment; labels - * belong only to Γ. + * `proof_user.h`; it has no dependency on a particular object logic. Γ is the + * ordered list of labeled ordinary assumptions and 𝒜 is the set of + * hypotheses of a HOL theorem. Write `|Γ|` for the propositions in Γ, ignoring + * labels and duplicates, and `𝒜 ⊆α |Γ|` when each member of 𝒜 has an ≡α + * match in `|Γ|`. Consequently `[Γ ?⊢ p]` is a goal state, whereas + * `𝒜 ⊢ p` is a theorem judgment; labels belong only to Γ. Object-logic + * layers such as `proof_backward_sl.h` may attach an immutable payload and a + * formatter through `goal_kind`, while every goal still caches its complete + * HOL conclusion. Beta-equivalent but non-alpha-equivalent conclusions are not + * interchangeable at the proof-tree boundary; a tactic that introduces a + * beta-redex must discharge it explicitly in its own validator. + * + * Node pointers, returned frontier vectors, validator environments allocated by + * library tactics, and rendered strings are prover/GC managed; callers do not + * free them. A returned `gnode` is a shared pointer into the proof tree, and a + * returned `gnode_list` is a GC-managed container of such pointers. Unless a + * tactic documents partial progress, failure is reported through the prover + * error channel and returns `empty_gnode`/`NULL`; a `void` closer leaves the + * node unsolved. These C sentinels are operational results, not HOL theorems. * * Authors: Jinkai Fan, Yiyuan Cao - * Last updated: 2026-07-19 + * Last updated: 2026-07-27 */ #pragma once -#include "proof/proof_sl.h" -#require "proof/proof_sl.c" +#include "proof/proof_user.h" +#require "proof/proof_user.c" /** * Construct a goal vector from the supplied goal values. @@ -87,7 +99,9 @@ * Nodes are visited in vector order and receive the same additional arguments. * The macro ignores tactic return values; use it only when the tactic mutates * each supplied node in place or when the new frontier will be recovered from - * the common proof tree. + * the common proof tree. `__gns` is evaluated repeatedly and therefore must be + * a stable side-effect-free vector expression. If a delegated tactic propagates + * an error, mutations already made to the visited prefix are not rolled back. */ #define APPLY_ALL_TAC(tactic, __gns, ...) \ do { \ @@ -99,43 +113,68 @@ /*----------------------------- Types -----------------------------*/ /** - * Discriminate the two goal representations. + * Render the object-logic-specific portion of an extended goal. * - * A general goal stores one HOL conclusion. An SL goal stores a labeled spatial - * antecedent context and one spatial consequent. + * The payload pointer is borrowed and kind-specific. Return a valid + * GC-managed C string; the caller concatenates it without copying or freeing + * it. A formatter must report its own errors and must not retain call-local + * pointers. */ -PROOF typedef enum { - GENERAL_GOAL, // A general goal. - SL_GOAL // A separation-logic goal, i.e., the conclusion term is a separation-logic entailment. -} goal_type; +PROOF typedef char* (*goal_payload_formatter)(const void* payload); /** - * Represent a general or separation-logic goal. + * Identify one extension of the base goal representation. * - * Both forms carry Γ in `lasmps`. `GENERAL_GOAL` uses `ccl`; `SL_GOAL` uses - * `lhants` for Δ and `hcon` for its spatial consequent. + * Extension layers keep one stable `goal_kind` object and use its address as + * the kind identity. `format_payload` renders only the extension-specific + * portion shown after the ordinary assumptions; it must tolerate every + * payload created for this kind. The kind object must outlive all of its + * goals, normally by having static storage duration. A payload must not cache + * or otherwise depend on the ordinary-assumption context Γ, because + * `goal_with_lasmps` reuses it when replacing Γ. + */ +PROOF typedef struct goal_kind { + /** Borrowed, stable diagnostic name for this goal kind. */ + const char* name; + /** Non-null renderer for this kind's immutable payload. */ + goal_payload_formatter format_payload; +} goal_kind; + +/** + * Represent a backward goal with an optional object-logic extension. + * + * Every goal stores Γ and its complete HOL conclusion. `kind` identifies the + * constructor that owns `payload`; an extension payload is immutable through + * this interface and must outlive all shallow copies of the goal. The general + * goal kind uses a null payload. */ PROOF typedef struct goal { - goal_type type; // The type of the goal. - labeled_term_list lasmps; // The list of labeled assumptions. - union { - term ccl; // The conclusion term (GENERAL_GOAL). - struct { - labeled_term_list lhants; // The labeled SL entailment antecedents (SL_GOAL). - term hcon; // The SL entailment consequent (SL_GOAL). - }; - }; + /** Borrowed ordered labeled ordinary-assumption context Γ. */ + labeled_term_list lasmps; // Ordered labeled ordinary assumptions Γ. + /** Shared, prover-managed handle to the complete HOL conclusion. */ + term ccl; // Complete cached HOL conclusion. + /** Borrowed pointer whose address is the stable kind identity. */ + const goal_kind* kind; // Stable kind identity. + /** Borrowed, kind-owned immutable extension data, possibly `NULL`. */ + const void* payload; // Kind-owned immutable extension data. } goal; +/** Shared pointer to a mutable proof-tree node; never owned by the caller. */ PROOF typedef struct goal_node* gnode; +/** Vector-backed ordered sequence of shallow-copied `goal` values. */ PROOF typedef goal* goal_list; +/** Vector-backed ordered sequence of shared `gnode` pointers. */ PROOF typedef gnode* gnode_list; /** * Reconstruct a parent theorem from theorems for its children. * - * The theorem list follows child order. The validator may inspect the parent - * node and its environment, and must return a theorem that achieves that node. + * The borrowed theorem vector follows child order and is valid for the call. + * The validator may inspect the parent node and its stored environment, and + * must return a theorem `𝒜 ⊢ φ` such that `φ ≡α goal_ccl(node->g)` and + * `𝒜 ⊆α |Γ|`. It returns a prover-managed theorem handle; on failure it must + * report a prover error and return `empty_theorem`. `gnode_accept` checks the + * stated conclusion/hypothesis obligations after the callback returns. */ PROOF typedef thm (*valid_fun)(thm_list, gnode); @@ -147,17 +186,24 @@ PROOF typedef thm (*valid_fun)(thm_list, gnode); * accepted an achieving theorem. */ PROOF typedef struct goal_node { + /** Shallow goal value represented by this node. */ goal g; // The goal to be proved at this node. + /** Accepted theorem handle, or `empty_theorem` while open. */ thm solved; // The theorem achieving the goal, empty if it hasn't been proved yet. + /** Shared child-node vector in tactic order; `NULL` before expansion. */ gnode_list children; // Child nodes in tactic-specified order; NULL before expansion. + /** Bottom-up validator, or `NULL` before expansion. */ valid_fun valid; // The validator function to combine subgoal theorems, NULL when no tactic is applied. + /** Borrowed/GC-managed validator environment, or `NULL`. */ void* env; // Captured validator environment; NULL before expansion. }* gnode; /*--------------------------- Constants ---------------------------*/ +/** All-zero invalid `goal` sentinel returned after construction errors. */ #define empty_goal ((goal){0}) +/** Null `gnode` sentinel returned after node/tactic errors. */ #define empty_gnode NULL /** @@ -181,33 +227,35 @@ PROOF goal_list goal_list_from_array(size_t size, goal* goals); */ PROOF gnode_list gnode_list_from_array(size_t size, gnode* nodes); -/*---------------------------- Kernel -----------------------------*/ +/*----------------------- Construction and access -----------------------*/ /* goal */ /** * Construct a general goal from Γ and a HOL conclusion. * - * The returned `GENERAL_GOAL` stores the supplied handles unchanged. This - * constructor performs no copying, type checking, or normalization. + * The result stores the supplied handles unchanged, uses the private general + * kind, and has no extension payload. This constructor performs no copying, + * type checking, or normalization. The caller must supply valid handles, a + * Boolean `ccl`, Boolean propositions in Γ, and label strings that outlive the + * goal; after construction the shared Γ container must be treated as immutable. */ PROOF goal general_goal_new(const labeled_term_list lasmps, const term ccl); /** - * Construct an SL goal from Γ, Δ, and a spatial consequent. + * Test whether a goal was created by `general_goal_new`. * - * The returned `SL_GOAL` stores the supplied handles unchanged. This - * constructor performs no copying, type checking, or normalization. + * Kind identity is compared by address. The payload and conclusion are not + * inspected. */ -PROOF goal sl_goal_new(const labeled_term_list lasmps, const labeled_term_list lhants, - const term hcon); +PROOF bool goal_is_general(const goal g); /** - * Replace Γ while preserving the other fields of a goal. + * Replace Γ with a shallow copy of a goal. * - * The result retains `g.type` and its general conclusion or spatial fields, and - * stores `lasmps` as its exact Γ handle. An invalid discriminant returns - * `empty_goal`. + * The result retains the exact cached conclusion, kind, and immutable payload + * pointer, and stores `lasmps` as its exact Γ handle. No object-logic + * constructor or validation callback is rerun. */ PROOF goal goal_with_lasmps(const goal g, const labeled_term_list lasmps); @@ -220,11 +268,10 @@ PROOF goal goal_with_lasmps(const goal g, const labeled_term_list lasmps); PROOF labeled_term_list goal_lasmps(const goal g); /** - * Reconstruct the HOL conclusion represented by a goal. + * Return the complete cached HOL conclusion represented by a goal. * - * A general goal returns `g.ccl`. For an SL goal, right-fold Δ with `**` - * (empty Δ becomes `emp`) and return that assertion entailing `g.hcon`. - * An invalid discriminant returns `empty_term`. + * The term handle is returned unchanged. Object-logic payloads are never + * consulted or reconstructed by the base layer. */ PROOF term goal_ccl(const goal g); @@ -233,7 +280,7 @@ PROOF term goal_ccl(const goal g); * * Test `v` for free occurrence first in every ordinary assumption in Γ, then * in `goal_ccl(g)`. Return at the first match. `v` need not itself be a - * variable; an invalid goal fails as `goal_ccl` does. + * variable. The cached conclusion must be a valid term. */ PROOF bool var_free_in_goal(const term v, const goal g); @@ -242,7 +289,7 @@ PROOF bool var_free_in_goal(const term v, const goal g); * * Apply HOL `variant` to `v` against all terms in Γ followed by * `goal_ccl(g)`, preserving its type and using its name as the base. Fail when - * `v` is not a variable or the goal is invalid. + * `v` is not a variable or the cached conclusion is not a valid term. */ PROOF term fresh_var_in_goal(const term v, const goal g); @@ -255,7 +302,7 @@ PROOF term fresh_var_in_goal(const term v, const goal g); */ PROOF const char* fresh_asmps_label(const goal g, const char* prefix); -/* gnode */ +/*---------------------- Proof-tree validation ----------------------*/ /** * Create an open proof-tree leaf for a goal. @@ -277,8 +324,10 @@ PROOF gnode gnode_new(const goal g); * The child list may be empty and is not shape-checked, but an unsolved * zero-child expansion cannot be validated: `gnode_prove` rejects it as an * open leaf. The returned vector aliases `gn->children` and must not be resized - * or reordered. Re-expansion discards the stored solved theorem and replaces - * the previous expansion. + * or reordered. `env` is stored without copying or a destructor and must have + * static/GC storage or otherwise outlive later validation. Re-expansion detaches + * the stored solved theorem and previous expansion from the parent; it does not + * destroy old nodes still reachable through external shared handles. */ PROOF gnode_list gnode_expand(const gnode gn, const goal_list child_gs, const valid_fun valid, void* env); @@ -286,15 +335,16 @@ PROOF gnode_list gnode_expand(const gnode gn, const goal_list child_gs, const va /** * Close a node with a theorem that achieves its goal. * - * Accept exactly when `concl(th) ≡α goal_ccl(gn->g)` and every member of - * `𝒜 = hyp(th)` has an ≡α match among Γ's propositions. On success store `th`, - * thereby closing the whole subtree. On either mismatch preserve the node and - * set the prover error. This is the + * Accept exactly when `concl(th) ≡α goal_ccl(gn->g)`, and every member of + * `𝒜 = hyp(th)` has an ≡α match among Γ's propositions. No beta conversion is + * attempted. A caller that deliberately constructs a beta-redex must first + * prove and apply the required local conversion. On either mismatch preserve + * the node and set the prover error. This is the * unique proof-tree boundary that checks conclusion alignment and theorem * hypothesis containment; callers do not repeat either scan. * - * The theorem need only satisfy `concl(th) ≡α goal_ccl(gn->g)`; - * `gnode_prove` performs exact user-visible binder alignment at the root. + * The accepted theorem may retain alpha-renamed binders; `gnode_prove` + * performs exact user-visible binder alignment at the root. */ PROOF void gnode_accept(const gnode gn, const thm th); @@ -306,7 +356,8 @@ PROOF void gnode_accept(const gnode gn, const thm th); * left-to-right. The proof tree is unchanged. * * A solved node contributes no leaves even if it retains children from an - * earlier expansion. + * earlier expansion. The result is a fresh GC-managed vector of shared node + * pointers; callers may resize that container without changing the tree. */ PROOF gnode_list gnode_leaves(const gnode gn); @@ -316,12 +367,11 @@ PROOF gnode_list gnode_leaves(const gnode gn); * Render a goal as an ANSI-colored string. * * Render ordinary assumptions Γ under `Assumptions:`. A general goal renders - * its proposition under `Conclusion:`. An SL goal instead renders its labeled - * SL antecedents Δ under `Antecedents:` and its right-hand assertion under - * `Consequent:`. The labels are the actual tactic-visible labels stored in the - * goal; printing does not rename either context. Preserve order and return a - * GC-managed ANSI-colored string; invalid discriminants render - * `Unknown goal type`. + * its cached proposition under `Conclusion:`. Any extension kind delegates + * the remaining display to `kind->format_payload(payload)`. Labels are the + * actual tactic-visible labels stored in the goal; printing does not rename + * the ordinary context. Preserve order and return a GC-managed ANSI-colored + * string. A missing kind or formatter renders an invalid-kind diagnostic. * * This function renders only one goal and does not inspect a proof tree. */ @@ -355,7 +405,7 @@ PROOF char* cstr_gnode_list(const gnode_list gns); * * Construct `general_goal_new(NULL, ccl)` and wrap it with `gnode_new`; the * result is an open leaf. The function performs no type checking or - * normalization of `ccl`. + * normalization of `ccl`; the caller must supply a valid Boolean term handle. */ PROOF gnode gnode_new_with_ccl(const term ccl); @@ -369,8 +419,12 @@ PROOF gnode gnode_new_with_ccl(const term ccl); * * At the requested root, HOL-checked alpha conversion aligns bound-variable * names so the returned conclusion exactly matches the stored goal syntax. - * Missing validators, unacceptable validator results, unavailable hypotheses, - * and conclusion mismatches are errors. + * Missing + * validators, unacceptable validator results, unavailable hypotheses, and + * conclusion mismatches report a prover error and return `empty_theorem`. + * Successful validation caches accepted theorem handles in every traversed + * parent node. On failure, already validated descendants and any tactic prefix + * remain installed; theorem handles are prover managed. */ PROOF thm gnode_prove(const gnode gn); @@ -378,26 +432,45 @@ PROOF thm gnode_prove(const gnode gn); * Select ordinary assumptions by label. * * Extract the Γ entry for each requested label in requested order and return - * only its proposition. Request order and duplicates are preserved. + * only its proposition in a fresh GC-managed vector. Request order and + * duplicates are preserved and term handles are shared. * - * Every requested label must be non-null and present in Γ; otherwise selection - * fails as `labeled_term_list_extract` does. + * Every requested label and every stored label in Γ must be a valid non-null + * C string. Each requested label must be present; otherwise selection reports + * a prover error and returns `NULL` as `labeled_term_list_extract` does. The + * all-label precondition is required by that function's source-wide failure + * diagnostic. */ PROOF term_list gnode_get_asmps(const gnode gn, const const_cstr_list lbs); /*------------------------- Basic Tactics -------------------------*/ +/** + * Tactic-family convention for extended goals. + * + * Tactics that only replace the ordinary context Γ use `goal_with_lasmps` and + * preserve `kind`, the immutable payload, and the cached complete conclusion. + * `ASSERT_TAC` preserves the extension on its main child but creates a general + * goal for the asserted proposition. Conclusion-transforming tactics + * (`GEN_TAC`, `SPEC_TAC`, `EXISTS_TAC`, `DISCH_TAC`, `UNDISCH_TAC`, + * `UNDISCH_ALL_TAC`, `CONJ_TAC`, `DISJ1_TAC`, `DISJ2_TAC`, `MATCH_MP_TAC`, + * `EQ_TAC`, and a non-closing `CONV_TAC`) construct general children and do not + * copy an extension payload. Derived tactics inherit the behavior of the + * primitive step that creates each child. + */ + /** * Close a goal with a supplied theorem. * * ```text - * 𝒜 ⊢ t' t' ≡α t 𝒜 ⊆α Γ + * 𝒜 ⊢ t' t' ≡α t 𝒜 ⊆α |Γ| * -------------------------------- ACCEPT_TAC * [Γ ?⊢ t] → [] * ``` - * Here `𝒜 ⊆α Γ` means that every theorem hypothesis has an alpha-equivalent + * Here `𝒜 ⊆α |Γ|` means that every theorem hypothesis has an alpha-equivalent * proposition in Γ. The tactic delegates both checks to `gnode_accept`; on - * failure it leaves the node open. + * failure it reports a prover error and leaves the node open. Its `void` C + * return is not a theorem or Boolean result. */ PROOF void ACCEPT_TAC(const gnode gn, const thm th); @@ -525,6 +598,10 @@ PROOF gnode_list ASMP_DESTRUCT_TAC(const gnode gn, const char* lb, const char* s * * A delegated decomposition or fresh-name failure is propagated. Any successful * prefix already installed in the proof tree remains in place. + * Every structured assumption visited by this tactic must have a valid non-null + * label. Atomic unlabeled assumptions are skipped, but attempting to destruct a + * structured unlabeled entry reaches label lookup with `NULL`; this is currently + * a host-language precondition rather than a recoverable prover mismatch. */ PROOF gnode_list AUTO_ASMP_DESTRUCT_TAC(const gnode gn); @@ -647,7 +724,9 @@ PROOF gnode_list CASES_TAC(const gnode gn, const term tm, const char* lb); * after introducing exactly its constructor variables and induction-hypothesis * premises. Fail if `var` is not a variable, has no registered induction * theorem, is neither free in the goal nor a leading universal binder, or the - * registered theorem has an unexpected induction-rule shape. + * registered theorem has an unexpected induction-rule shape. Every reverted + * `Dᵢ` must have a valid non-null label; induction currently inherits this + * host-language precondition from `REVERT_TAC`. */ PROOF gnode_list INDUCT_TAC(const gnode gn, const term var); @@ -779,9 +858,12 @@ PROOF gnode DISJ2_TAC(const gnode gn); * ```text * [Γ ?⊢ t'] → [Γ ?⊢ ∃z₁ … zₚ. s'] * ``` - * Match `t` from `∀x₁ … xₙ. s ⇒ t` against the current conclusion; `s'` - * receives the same instantiation, and only unmatched quantified variables - * become existential subgoal binders. + * Strip `∀X. s ⇒ t` and first define + * `Y = [x ∈ X | x ∈ FV(s) ∧ x ∉ FV(t)]`, preserving quantifier order. Match + * `t` against the current conclusion, apply that instantiation to + * `∃Y. s`, and use the resulting term as the child conclusion. Thus the + * existential set is determined syntactically before matching; it is not the + * set of variables left unmatched by the matcher. * * Fail if stripping leading universal quantifiers from `th` does not expose an * implication, or if its consequent cannot match the current conclusion. The @@ -868,7 +950,9 @@ PROOF gnode AUTO_INTROS_TAC(const gnode gn); * `pₙ ⇒ … ⇒ p₁ ⇒ q`. * * `v` must be a variable. It remains free; use `SPEC_TAC` afterwards when it - * should also be generalized. + * should also be generalized. Every selected Γ entry must have a valid + * non-null label; passing an affected unlabeled assumption to the delegated + * label lookup is currently a host-language precondition, not a safe mismatch. */ PROOF gnode REVERT_TAC(const gnode gn, const term v); @@ -911,23 +995,34 @@ PROOF gnode CONV_WITH_ASMP_TAC(const gnode gn, const conv_builder builder, * Close a goal by false elimination. * * ```text - * 𝒜 ⊢ ⊥ 𝒜 ⊆α Γ + * 𝒜 ⊢ ⊥ 𝒜 ⊆α |Γ| * ------------------- CONTR_TAC * [Γ ?⊢ t] → [] * ``` * Derive the current Boolean conclusion from `fth`, then pass the result to * `gnode_accept`. Fail if `fth` does not conclude false or any hypothesis in 𝒜 - * lacks an alpha-equivalent proposition in Γ. + * lacks an alpha-equivalent proposition in `|Γ|`. On failure report a prover + * error and leave the node unsolved; the `void` return is not a theorem. */ PROOF void CONTR_TAC(const gnode gn, const thm fth); /*----------------------- Pattern Matching ------------------------*/ +/** + * Outermost constructor recognized by `parse_pattern`. + * + * `PT_NONE` is a leaf, `PT_AND`/`PT_OR` are `&`/`|`, `PT_EX` is `?`, + * `PT_SEP` is `*`, and `PT_FACT` is an SL fact selector `[label]`. + */ PROOF typedef enum { PT_NONE, PT_AND, PT_OR, PT_EX, PT_SEP, PT_FACT } parsed_type; +/** Parsed outer pattern and its GC-managed operand strings. */ PROOF typedef struct { + /** Recognized outer constructor. */ parsed_type pt; + /** Left operand, binder name, leaf text, or fact label. */ char* left; + /** Right operand for binary forms; otherwise `NULL`. */ char* right; } parsed_pattern; @@ -948,6 +1043,11 @@ PROOF typedef struct { * Return the outer operator and trimmed operands. A leaf returns `PT_NONE` with * its text in `left`; `[L]` returns `PT_FACT` with `L` in `left`. Fail on an * empty pattern, unbalanced or nested brackets, unbalanced parentheses, an - * empty fact label, or a binary operator with an empty operand. + * empty fact label, or a binary operator with an empty operand. Returned + * strings are GC-managed and remain valid beyond the call; on error the + * function reports a prover error and returns a zero-initialized record. + * `parse_pattern(NULL)` is also a successful leaf represented by that same + * zero record, so callers distinguish it from malformed non-null input through + * the prover error status rather than record fields alone. */ PROOF parsed_pattern parse_pattern(const char* str); diff --git a/proof_backward_sl.c b/proof_backward_sl.c index 8c2eeff..3538681 100644 --- a/proof_backward_sl.c +++ b/proof_backward_sl.c @@ -10,6 +10,82 @@ PROOF static bool distinct_labels(const const_cstr_list lbs) { return true; } +PROOF typedef struct { + labeled_term_list lhants; + term hcon; + size_t theory_generation; +} sl_goal_payload; + +PROOF static char* cstr_lhants(const labeled_term_list lhants) { + char* buf = BOLD("Antecedents:"); + if (vector_size(lhants) == 0) { + buf = gc_strcat(buf, GRAY(" (none)")); + } else { + for (size_t i = 0; i < vector_size(lhants); ++i) { + buf = gc_strcat(buf, GRAY("\n")); + labeled_term ltm = lhants[i]; + char* tm_str = string_of_term(ltm.tm); + if (ltm.lb) { + buf = gc_strcat(buf, GRAY(ltm.lb)); + buf = gc_strcat(buf, GRAY(": ")); + buf = gc_strcat(buf, YELLOW(tm_str)); + } else { + buf = gc_strcat(buf, YELLOW(tm_str)); + } + } + } + return buf; +} + +PROOF static char* cstr_sl_goal_payload(const void* raw_payload) { + if (raw_payload == NULL) return gc_sprintf("Invalid SL goal payload"); + const sl_goal_payload* payload = (const sl_goal_payload*)raw_payload; + char* buf = cstr_lhants(payload->lhants); + buf = gc_strcat(buf, NORMAL("\n================================\n")); + buf = gc_strcat(buf, BOLD("Consequent:")); + buf = gc_strcat(buf, NORMAL("\n ")); + buf = gc_strcat(buf, YELLOW(string_of_term(payload->hcon))); + return gc_strcat(buf, NORMAL("\n")); +} + +PROOF static const goal_kind sl_goal_kind = {"sl", cstr_sl_goal_payload}; + +PROOF bool goal_is_sl(const goal g) { + return g.kind == &sl_goal_kind; +} + +PROOF goal sl_goal_new(const labeled_term_list lasmps, + const labeled_term_list lhants, const term hcon) { + bool hcon_is_prop = is_sl_prop(hcon); + ENSURE_COND(hcon_is_prop, + "SL consequent(`%s`) does not have the active assertion type", + string_of_term(hcon)); + for (size_t i = 0; i < vector_size(lhants); ++i) { + bool hant_is_prop = is_sl_prop(lhants[i].tm); + ENSURE_COND( + hant_is_prop, + "SL antecedent %d (`%s`) does not have the active assertion type", + (int)i, string_of_term(lhants[i].tm)); + } + + labeled_term_list payload_lhants = + (labeled_term_list)vector_copy(lhants); + term_list hants = labeled_term_list_to_term_list(payload_lhants); + term hant = list_mk_sl_sep(hants); + term ccl = mk_sl_ent(hant, hcon); + size_t generation = sl_theory_generation(); + + sl_goal_payload* payload = GC_MALLOC(sizeof(sl_goal_payload)); + payload->lhants = payload_lhants; + payload->hcon = hcon; + payload->theory_generation = generation; + return (goal){lasmps, ccl, &sl_goal_kind, payload}; +err: + ERR_FUN_PUTS("sl_goal_new", cstr_labeled_term_list(lasmps), + cstr_labeled_term_list(lhants), cstr_term(hcon)); + return empty_goal; +} + PROOF typedef struct { labeled_term_list lasmps; labeled_term_list lhants; @@ -17,8 +93,14 @@ PROOF typedef struct { } sl_goal_view; PROOF static sl_goal_view dest_sl_goal(const goal g) { - ENSURE_COND(g.type == SL_GOAL, "Goal is not a SL goal"); - return (sl_goal_view){g.lasmps, g.lhants, g.hcon}; + ENSURE_COND(goal_is_sl(g), "Goal is not an SL goal"); + ENSURE_COND(g.payload != NULL, "SL goal has no payload"); + const sl_goal_payload* payload = (const sl_goal_payload*)g.payload; + size_t generation = sl_theory_generation(); + ENSURE_COND(payload->theory_generation == generation, + "SL goal belongs to inactive theory generation %zu, current is %zu", + payload->theory_generation, generation); + return (sl_goal_view){g.lasmps, payload->lhants, payload->hcon}; err: ERR_FUN_PUTS("dest_sl_goal", cstr_goal(g)); return (sl_goal_view){NULL, NULL, empty_term}; @@ -26,7 +108,7 @@ err: PROOF labeled_term_list goal_lhants(const goal g) { sl_goal_view view = dest_sl_goal(g); - return view.lhants; + return (labeled_term_list)vector_copy(view.lhants); err: ERR_FUN_PUTS("goal_lhants", cstr_goal(g)); return NULL; @@ -71,18 +153,18 @@ err: return NULL; } -PROOF static thm eq_sltac_valid(thm* ths, const gnode gn) { - thm th = antisym_slrule(ths[0], ths[1]); +PROOF static thm equiv_sltac_valid(thm* ths, const gnode gn) { + thm th = equiv_slrule(ths[0], ths[1]); return th; } -PROOF gnode_list EQ_SLTAC(const gnode gn, const char* lb1, const char* lb2) { - labeled_term_list lasmps = goal_lasmps(gn->g); - term ccl = goal_ccl(gn->g); - - dest_binop_results res = dest_sl_eq(ccl); - term hp1 = res.tm1; - term hp2 = res.tm2; +PROOF static gnode_list expand_equiv_sltac(const gnode gn, + const labeled_term_list lasmps, + const term hp1, const term hp2, + const char* lb1, + const char* lb2) { + ENSURE_COND(lb1 != NULL && lb2 != NULL, + "Equivalence branch labels must be non-null"); labeled_term lhant1 = {hp1, GC_STRDUP(lb1)}; labeled_term_list lhants1 = LABELED_TERM_LIST(lhant1); @@ -91,12 +173,306 @@ PROOF gnode_list EQ_SLTAC(const gnode gn, const char* lb1, const char* lb2) { labeled_term_list lhants2 = LABELED_TERM_LIST(lhant2); goal new_g2 = sl_goal_new(lasmps, lhants2, hp1); - return gnode_expand(gn, LIST_GOAL(new_g1, new_g2), eq_sltac_valid, NULL); + return gnode_expand(gn, LIST_GOAL(new_g1, new_g2), equiv_sltac_valid, NULL); +err: + ERR_FUN_PUTS("expand_equiv_sltac", cstr_gnode(gn), cstr_term(hp1), + cstr_term(hp2), cstr_string(lb1), cstr_string(lb2)); + return NULL; +} + +PROOF gnode_list EQUIV_SLTAC(const gnode gn, const char* lb1, + const char* lb2) { + labeled_term_list lasmps = goal_lasmps(gn->g); + term ccl = goal_ccl(gn->g); + + dest_binop_results res = dest_sl_equiv(ccl); + term hp1 = res.tm1; + term hp2 = res.tm2; + + return expand_equiv_sltac(gn, lasmps, hp1, hp2, lb1, lb2); +err: + ERR_FUN_PUTS("EQUIV_SLTAC", cstr_gnode(gn), cstr_string(lb1), + cstr_string(lb2)); + return NULL; +} + +PROOF gnode_list EQ_SLTAC(const gnode gn, const char* lb1, const char* lb2) { + /* Mutual validity-aware entailment does not imply raw HOL equality. This + * compatibility tactic is available only when the explicitly installed + * logical-equivalence operator is itself assertion equality. */ + ENSURE_COND( + equals_term(sl_equiv(), sl_eq()), + "EQ_SLTAC is unavailable: the active SL theory distinguishes logical " + "equivalence from raw HOL equality; use EQUIV_SLTAC"); + + labeled_term_list lasmps = goal_lasmps(gn->g); + term ccl = goal_ccl(gn->g); + dest_binop_results res = dest_sl_eq(ccl); + + return expand_equiv_sltac(gn, lasmps, res.tm1, res.tm2, lb1, lb2); err: ERR_FUN_PUTS("EQ_SLTAC", cstr_gnode(gn), cstr_string(lb1), cstr_string(lb2)); return NULL; } +PROOF static thm bupd_intro_sltac_valid(thm* ths, const gnode gn) { + term parent_ccl = goal_ccl(gn->g); + dest_binop_results parent = dest_sl_ent(parent_ccl); + term post = dest_sl_bupd(parent.tm2); + thm introduced = bupd_intro_slrule(post); + thm result = trans_slrule(ths[0], introduced); + return result; +err: + ERR_FUN_PUTS("bupd_intro_sltac_valid", cstr_gnode(gn)); + return empty_theorem; +} + +PROOF gnode BUPD_INTRO_SLTAC(const gnode gn) { + ENSURE_COND(sl_update_theory_is_installed(), + "No update theory is installed for the active SL theory"); + sl_goal_view view = dest_sl_goal(gn->g); + term post = dest_sl_bupd(view.hcon); + goal child = sl_goal_new(view.lasmps, view.lhants, post); + gnode_list expanded = + gnode_expand(gn, LIST_GOAL(child), bupd_intro_sltac_valid, NULL); + return expanded[0]; +err: + ERR_FUN_PUTS("BUPD_INTRO_SLTAC", cstr_gnode(gn)); + return empty_gnode; +} + +PROOF static thm bupd_mono_sltac_valid(thm* ths, const gnode gn) { + ENSURE_COND(sl_update_theory_is_installed(), + "No update theory is installed for the active SL theory"); + thm result = bupd_mono_slrule(ths[0]); + return result; +err: + ERR_FUN_PUTS("bupd_mono_sltac_valid", cstr_gnode(gn)); + return empty_theorem; +} + +PROOF gnode BUPD_MONO_SLTAC(const gnode gn) { + ENSURE_COND(sl_update_theory_is_installed(), + "No update theory is installed for the active SL theory"); + sl_goal_view view = dest_sl_goal(gn->g); + ENSURE_COND(vector_size(view.lhants) == 1, + "Basic-update monotonicity requires one exact antecedent"); + term source = dest_sl_bupd(view.lhants[0].tm); + term target = dest_sl_bupd(view.hcon); + + labeled_term_list child_lhants = + (labeled_term_list)vector_copy(view.lhants); + child_lhants[0].tm = source; + goal child = sl_goal_new(view.lasmps, child_lhants, target); + gnode_list expanded = + gnode_expand(gn, LIST_GOAL(child), bupd_mono_sltac_valid, NULL); + return expanded[0]; +err: + ERR_FUN_PUTS("BUPD_MONO_SLTAC", cstr_gnode(gn)); + return empty_gnode; +} + +PROOF void BUPD_IDEM_SLTAC(const gnode gn) { + ENSURE_COND(sl_update_theory_is_installed(), + "No update theory is installed for the active SL theory"); + sl_goal_view view = dest_sl_goal(gn->g); + term goal_conclusion = goal_ccl(gn->g); + dest_binop_results entailment = dest_sl_ent(goal_conclusion); + term nested = dest_sl_bupd(entailment.tm1); + term source = dest_sl_bupd(nested); + term target = dest_sl_bupd(view.hcon); + int endpoint_order = alpha_compare(source, target); + ENSURE_COND(endpoint_order == 0, + "Goal is not exact basic-update idempotence"); + thm proof = bupd_idem_slrule(source); + ACCEPT_TAC(gn, proof); + return; +err: + ERR_FUN_PUTS("BUPD_IDEM_SLTAC", cstr_gnode(gn)); + return; +} + +PROOF void BUPD_FRAME_SLTAC(const gnode gn) { + ENSURE_COND(sl_update_theory_is_installed(), + "No update theory is installed for the active SL theory"); + sl_goal_view view = dest_sl_goal(gn->g); + term goal_conclusion = goal_ccl(gn->g); + dest_binop_results entailment = dest_sl_ent(goal_conclusion); + dest_binop_results source_sep = dest_sl_sep(entailment.tm1); + term source = dest_sl_bupd(source_sep.tm1); + term target = dest_sl_bupd(view.hcon); + dest_binop_results target_sep = dest_sl_sep(target); + int payload_order = alpha_compare(source, target_sep.tm1); + int frame_order = alpha_compare(source_sep.tm2, target_sep.tm2); + ENSURE_COND(payload_order == 0 && frame_order == 0, + "Goal is not exact framed basic update"); + thm proof = bupd_frame_slrule(source, source_sep.tm2); + ACCEPT_TAC(gn, proof); + return; +err: + ERR_FUN_PUTS("BUPD_FRAME_SLTAC", cstr_gnode(gn)); + return; +} + +PROOF void VIEWSHIFT_REFL_TAC(const gnode gn) { + ENSURE_COND(sl_update_theory_is_installed(), + "No update theory is installed for the active SL theory"); + ENSURE_COND(goal_is_general(gn->g), + "View-shift reflexivity requires a general goal"); + term goal_conclusion = goal_ccl(gn->g); + dest_binop_results endpoints = dest_sl_viewshift(goal_conclusion); + int endpoint_order = alpha_compare(endpoints.tm1, endpoints.tm2); + ENSURE_COND(endpoint_order == 0, + "View-shift endpoints are not alpha-equivalent"); + thm proof = viewshift_refl_slrule(endpoints.tm1); + ACCEPT_TAC(gn, proof); + return; +err: + ERR_FUN_PUTS("VIEWSHIFT_REFL_TAC", cstr_gnode(gn)); + return; +} + +PROOF static thm viewshift_trans_tac_valid(thm* ths, const gnode gn) { + ENSURE_COND(sl_update_theory_is_installed(), + "No update theory is installed for the active SL theory"); + thm result = viewshift_trans_slrule(ths[0], ths[1]); + return result; +err: + ERR_FUN_PUTS("viewshift_trans_tac_valid", cstr_gnode(gn)); + return empty_theorem; +} + +PROOF gnode_list VIEWSHIFT_TRANS_TAC(const gnode gn, const term mid) { + ENSURE_COND(sl_update_theory_is_installed(), + "No update theory is installed for the active SL theory"); + ENSURE_COND(goal_is_general(gn->g), + "View-shift transitivity requires a general goal"); + bool mid_is_prop = is_sl_prop(mid); + ENSURE_COND(mid_is_prop, + "Intermediate term(`%s`) is not an active SL assertion", + string_of_term(mid)); + term goal_conclusion = goal_ccl(gn->g); + dest_binop_results endpoints = dest_sl_viewshift(goal_conclusion); + labeled_term_list lasmps = goal_lasmps(gn->g); + term first_ccl = mk_sl_viewshift(endpoints.tm1, mid); + goal first = general_goal_new(lasmps, first_ccl); + term second_ccl = mk_sl_viewshift(mid, endpoints.tm2); + goal second = general_goal_new(lasmps, second_ccl); + gnode_list expanded = gnode_expand( + gn, LIST_GOAL(first, second), viewshift_trans_tac_valid, NULL); + return expanded; +err: + ERR_FUN_PUTS("VIEWSHIFT_TRANS_TAC", cstr_gnode(gn), cstr_term(mid)); + return NULL; +} + +PROOF static thm viewshift_frame_tac_valid(thm* ths, const gnode gn) { + term parent_ccl = goal_ccl(gn->g); + dest_binop_results parent = dest_sl_viewshift(parent_ccl); + dest_binop_results source = dest_sl_sep(parent.tm1); + thm result = viewshift_frame_slrule(ths[0], source.tm2); + return result; +err: + ERR_FUN_PUTS("viewshift_frame_tac_valid", cstr_gnode(gn)); + return empty_theorem; +} + +PROOF gnode VIEWSHIFT_FRAME_TAC(const gnode gn) { + ENSURE_COND(sl_update_theory_is_installed(), + "No update theory is installed for the active SL theory"); + ENSURE_COND(goal_is_general(gn->g), + "View-shift framing requires a general goal"); + term goal_conclusion = goal_ccl(gn->g); + dest_binop_results endpoints = dest_sl_viewshift(goal_conclusion); + dest_binop_results source = dest_sl_sep(endpoints.tm1); + dest_binop_results target = dest_sl_sep(endpoints.tm2); + int frame_order = alpha_compare(source.tm2, target.tm2); + ENSURE_COND(frame_order == 0, + "View-shift goal has no exact shared right frame"); + + labeled_term_list lasmps = goal_lasmps(gn->g); + term child_ccl = mk_sl_viewshift(source.tm1, target.tm1); + goal child = general_goal_new(lasmps, child_ccl); + gnode_list expanded = + gnode_expand(gn, LIST_GOAL(child), viewshift_frame_tac_valid, NULL); + return expanded[0]; +err: + ERR_FUN_PUTS("VIEWSHIFT_FRAME_TAC", cstr_gnode(gn)); + return empty_gnode; +} + +PROOF static thm viewshift_sep_tac_valid(thm* ths, const gnode gn) { + ENSURE_COND(sl_update_theory_is_installed(), + "No update theory is installed for the active SL theory"); + thm result = viewshift_sep_slrule(ths[0], ths[1]); + return result; +err: + ERR_FUN_PUTS("viewshift_sep_tac_valid", cstr_gnode(gn)); + return empty_theorem; +} + +PROOF gnode_list VIEWSHIFT_SEP_TAC(const gnode gn) { + ENSURE_COND(sl_update_theory_is_installed(), + "No update theory is installed for the active SL theory"); + ENSURE_COND(goal_is_general(gn->g), + "View-shift separation requires a general goal"); + term goal_conclusion = goal_ccl(gn->g); + dest_binop_results endpoints = dest_sl_viewshift(goal_conclusion); + dest_binop_results source = dest_sl_sep(endpoints.tm1); + dest_binop_results target = dest_sl_sep(endpoints.tm2); + labeled_term_list lasmps = goal_lasmps(gn->g); + term first_ccl = mk_sl_viewshift(source.tm1, target.tm1); + goal first = general_goal_new(lasmps, first_ccl); + term second_ccl = mk_sl_viewshift(source.tm2, target.tm2); + goal second = general_goal_new(lasmps, second_ccl); + gnode_list expanded = gnode_expand( + gn, LIST_GOAL(first, second), viewshift_sep_tac_valid, NULL); + return expanded; +err: + ERR_FUN_PUTS("VIEWSHIFT_SEP_TAC", cstr_gnode(gn)); + return NULL; +} + +PROOF static thm viewshift_exists_tac_valid(thm* ths, const gnode gn) { + ENSURE_COND(sl_update_theory_is_installed(), + "No update theory is installed for the active SL theory"); + thm result = viewshift_exists_slrule(ths[0]); + return result; +err: + ERR_FUN_PUTS("viewshift_exists_tac_valid", cstr_gnode(gn)); + return empty_theorem; +} + +PROOF gnode VIEWSHIFT_EXISTS_TAC(const gnode gn) { + ENSURE_COND(sl_update_theory_is_installed(), + "No update theory is installed for the active SL theory"); + ENSURE_COND(goal_is_general(gn->g), + "Existential view shift requires a general goal"); + term goal_conclusion = goal_ccl(gn->g); + dest_binop_results endpoints = dest_sl_viewshift(goal_conclusion); + dest_binder_results source = dest_sl_exists(endpoints.tm1); + dest_binder_results target = dest_sl_exists(endpoints.tm2); + type source_type = type_of(source.v); + type target_type = type_of(target.v); + bool witness_types_equal = equals_type(source_type, target_type); + ENSURE_COND(witness_types_equal, + "View-shift existential witness types differ"); + + term witness = fresh_var_in_goal(source.v, gn->g); + term source_body = subst_one(witness, source.v, source.tm); + term target_body = subst_one(witness, target.v, target.tm); + term pointwise_body = mk_sl_viewshift(source_body, target_body); + term pointwise = list_mk_forall(TERM_LIST(witness), pointwise_body); + labeled_term_list lasmps = goal_lasmps(gn->g); + goal child = general_goal_new(lasmps, pointwise); + gnode_list expanded = + gnode_expand(gn, LIST_GOAL(child), viewshift_exists_tac_valid, NULL); + return expanded[0]; +err: + ERR_FUN_PUTS("VIEWSHIFT_EXISTS_TAC", cstr_gnode(gn)); + return empty_gnode; +} + /* * Labeled SL antecedent tactics * ---------------------------- @@ -202,7 +578,7 @@ PROOF static thm hant_disj_sltac_valid(thm* ths, gnode gn) { thm endpoint2 = acu_slrule(current2, framed2); thm parent_endpoint = acu_slrule(hant, framed_disj); thm res_ent = list_match_mp_rule( - sl_or_elim_frame(), + sl_or_elim_frame, THM_LIST(endpoint1, endpoint2, parent_endpoint, ths[0], ths[1])); return res_ent; } @@ -786,7 +1162,7 @@ PROOF static thm hant_conv_sltac_valid(thm* ths, gnode gn) { term new_hant = dest_sl_eq(eq_tm).tm2; term current_hant = dest_sl_ent(concl(res_th)).tm1; thm lift = sep_lift_slrule(current_hant, new_hant); - res_th = list_match_mp_rule(sl_ent_subst_frame(), + res_th = list_match_mp_rule(sl_ent_subst_frame, THM_LIST(eqs[i], lift, res_th)); } labeled_term_list lhants = goal_lhants(gn->g); @@ -859,7 +1235,7 @@ PROOF static thm sep_sltac_valid(thm* ths, gnode gn) { thm hcon_eq = acu_slrule(hcon, mk_sl_sep(child1.tm2, child2.tm2)); thm res_ent = list_match_mp_rule( - sl_sep_combine(), THM_LIST(hant_eq, hcon_eq, ths[0], ths[1])); + sl_sep_combine, THM_LIST(hant_eq, hcon_eq, ths[0], ths[1])); return res_ent; } @@ -1091,21 +1467,66 @@ err: return empty_gnode; } -PROOF static conv get_exists_pull_conv() { - static bool initialized = false; - static conv value; - if (!initialized) { - thm left = sl_sep_exists_left(); - thm right = sl_sep_exists_right(); - value = pure_rewrite_conv(THM_LIST(left, right)); - initialized = true; +/* Find one pullable existential occurrence in deterministic pre-order and + * return a rule already specialized to that exact binder and frame. */ +PROOF static bool find_exists_pull_rule(const term tm, thm* rule) { + if (is_sl_sep(tm)) { + dest_binop_results operands = dest_sl_sep(tm); + if (is_sl_exists(operands.tm1)) { + *rule = sep_exists_left_slrule(operands.tm1, operands.tm2); + return true; + } + if (is_sl_exists(operands.tm2)) { + *rule = sep_exists_right_slrule(operands.tm1, operands.tm2); + return true; + } + } + if (is_comb(tm)) { + dest_comb_results application = dest_comb(tm); + if (find_exists_pull_rule(application.tm1, rule)) return true; + return find_exists_pull_rule(application.tm2, rule); } - return value; + if (is_abs(tm)) { + dest_abs_results abstraction = dest_abs(tm); + return find_exists_pull_rule(abstraction.tm, rule); + } + return false; +} + +PROOF static thm pull_exists_eq(const term hp) { + thm result = refl_rule(hp); + term current = hp; + while (true) { + thm rule = empty_theorem; + if (!find_exists_pull_rule(current, &rule)) break; + ENSURE_COND(!IS_NULL(rule), + "Could not specialize an existential pull rule"); + conv rewrite_one = pure_once_rewrite_conv(THM_LIST(rule)); + thm step = apply_conversion(rewrite_one, current); + dest_binop_results endpoints = dest_sl_eq(concl(step)); + ENSURE_COND(alpha_compare(current, endpoints.tm2) != 0, + "Existential pull conversion made no progress"); + result = trans_rule(result, step); + current = endpoints.tm2; + } + return result; +err: + ERR_FUN_PUTS("pull_exists_eq", cstr_term(hp)); + return empty_theorem; } PROOF gnode EXISTS_PULL_SLTAC(const gnode gn) { - gnode new_gn = HCON_CONV_SLTAC(gn, get_exists_pull_conv()); - return new_gn; + sl_goal_view view = dest_sl_goal(gn->g); + thm pulled = pull_exists_eq(view.hcon); + ENSURE_COND(!IS_NULL(pulled), + "Could not construct the existential pull equality"); + dest_binop_results endpoints = dest_sl_eq(concl(pulled)); + if (equals_term(endpoints.tm1, endpoints.tm2)) return gn; + conv exact_rewrite = pure_once_rewrite_conv(THM_LIST(pulled)); + return HCON_CONV_SLTAC(gn, exact_rewrite); +err: + ERR_FUN_PUTS("EXISTS_PULL_SLTAC", cstr_gnode(gn)); + return empty_gnode; } PROOF typedef struct { @@ -1122,7 +1543,7 @@ PROOF static thm conv_sltac_valid(thm* ths, gnode gn) { ? refl_rule(parent_h) : alpha_rule(parent_h, child_h); thm res_ent = list_match_mp_rule( - sl_ent_restate(), THM_LIST(h_eq, env->eq, ths[0])); + sl_ent_restate, THM_LIST(h_eq, env->eq, ths[0])); res_ent = rehant_slrule(res_ent, parent_h); res_ent = rehcon_slrule(res_ent, view.hcon); return res_ent; @@ -1265,7 +1686,7 @@ PROOF static thm frame_sltac_valid(thm* ths, gnode gn) { thm hant_eq = acu_slrule(hant, mk_sl_sep(frame, child.tm1)); thm hcon_eq = acu_slrule(hcon, mk_sl_sep(frame, child.tm2)); thm res_ent = list_match_mp_rule( - sl_frame_restate(), THM_LIST(hant_eq, hcon_eq, ths[0])); + sl_frame_restate, THM_LIST(hant_eq, hcon_eq, ths[0])); return res_ent; } @@ -1409,7 +1830,7 @@ PROOF static thm clean_sltac_valid(thm* ths, gnode gn) { thm hant_eq = acu_slrule(hant, current.tm1); thm hcon_eq = acu_slrule(hcon, current.tm2); thm res_ent = list_match_mp_rule( - sl_ent_restate(), THM_LIST(hant_eq, hcon_eq, ths[0])); + sl_ent_restate, THM_LIST(hant_eq, hcon_eq, ths[0])); return res_ent; } diff --git a/proof_backward_sl.h b/proof_backward_sl.h index 2aeace7..51495ec 100644 --- a/proof_backward_sl.h +++ b/proof_backward_sl.h @@ -1,7 +1,7 @@ /** * Backward tactics for separation-logic entailments. * - * An `SL_GOAL` is displayed as + * An SL goal is displayed as * * ```text * [Γ; Δ ?⊢SL K] @@ -29,32 +29,63 @@ * tactic transition `G → [G₁, …, Gₙ]` describes the top-down proof-state * change and return order. Its soundness is a bottom-up derivation: the * validator maps child theorems T₁, …, Tₙ to a theorem achieving G. + * Returned nodes/frontier vectors and SL payload snapshots are prover/GC + * managed and share their HOL term handles. C failure sentinels are + * `empty_gnode` or `NULL`; they are not logical conclusions. * * Author: Jinkai Fan, Yiyuan Cao - * Last updated: 2026-07-19 + * Last updated: 2026-07-27 */ #pragma once +#include "proof/proof_sl.h" +#require "proof/proof_sl.c" #include "proof/proof_backward.h" #require "proof/proof_backward.c" -/*---------------------------- Goal access ----------------------------*/ +/*----------------------- Goal construction and access -----------------------*/ /** - * Return the ordered labeled spatial context of an `SL_GOAL`. + * Test whether a goal was created by `sl_goal_new`. * - * Return Δ by reference, preserving labels, order, and duplicates. Fail and - * return `NULL` when `g.type != SL_GOAL`; callers must not mutate the stored - * vector. + * Kind identity is compared by address. This predicate does not inspect the + * payload or require its recorded SL theory generation to remain active; use + * the accessors below when reading SL-specific fields. + */ +PROOF bool goal_is_sl(const goal g); + +/** + * Construct an SL goal from Γ, Δ, and a spatial consequent. + * + * Require every member of Δ and the consequent to have the active theory's + * `sl_prop()` type. Right-fold Δ with `**` (empty Δ becomes `emp`) and cache + * the complete HOL entailment to the consequent. The private immutable payload + * records a shallow vector snapshot of Δ, the consequent, and the active + * theory generation. Terms, labels, Γ, and the consequent remain shared. Every + * label pointer must remain valid for the goal lifetime; SL tactic clients + * should use non-null labels because label-directed operations and diagnostic + * rendering require them. On a type or construction error, report a prover + * error and return `empty_goal`. + */ +PROOF goal sl_goal_new(const labeled_term_list lasmps, + const labeled_term_list lhants, const term hcon); + +/** + * Return the ordered labeled spatial context of an SL goal. + * + * Return a shallow vector copy of Δ, preserving labels, order, and duplicates. + * Terms and label strings remain shared. Fail and return `NULL` when `g` is + * not an SL goal or its recorded theory generation is no longer active. */ PROOF labeled_term_list goal_lhants(const goal g); /** - * Return the spatial consequent of an `SL_GOAL`. + * Return the spatial consequent of an SL goal. * - * Return `g.hcon` unchanged. Fail and return `empty_term` when - * `g.type != SL_GOAL`. + * Return the private payload's consequent unchanged. Fail and return + * `empty_term` when `g` is not an SL goal or its recorded theory generation is + * no longer active. */ PROOF term goal_hcon(const goal g); @@ -63,7 +94,7 @@ PROOF term goal_hcon(const goal g); * * Return a `variant_label` absent from Δ, using `"H"` when `prefix == NULL`. * Preserve the context and fail as `goal_lhants` does when `g` is not an - * `SL_GOAL`. + * SL goal. The returned label string is GC-managed. */ PROOF const char* fresh_hants_label(const goal g, const char* prefix); @@ -93,19 +124,155 @@ PROOF const char* fresh_hants_label(const goal g, const char* prefix); PROOF gnode_list SL_MODE(const gnode gn, const char* pattern); /** - * Reduce equality between SL assertions to two entailment goals. + * Reduce logical equivalence between SL assertions to two entailment goals. * * ```text - * [Γ ?⊢ (H =ₕ K)] → [Γ; LH:H ?⊢SL K], [Γ; LK:K ?⊢SL H] + * [Γ ?⊢ (H ≃SL K)] → [Γ; LH:H ?⊢SL K], [Γ; LK:K ?⊢SL H] * ``` - * Children are returned in the displayed order. The validator applies SL - * antisymmetry to their theorems in that order. Both labels must be valid - * non-null C strings; this is a caller precondition. Fail if the conclusion is - * not equality at `hprop`. The labels may coincide because the branches are - * independent. + * Children are returned in the displayed order. The validator applies the + * active theory's logical-equivalence introduction theorem. Both labels must + * be valid non-null C strings; this is a caller precondition. Fail if the + * conclusion is not logical equivalence at the active assertion type. The + * labels may coincide because the branches are independent. + */ +PROOF gnode_list EQUIV_SLTAC(const gnode gn, const char* lb1, + const char* lb2); + +/** + * Compatibility variant of `EQUIV_SLTAC` for raw assertion equality. + * + * This tactic is sound only when the explicitly installed logical-equivalence + * operator is raw HOL equality. Otherwise it fails and directs callers to + * `EQUIV_SLTAC`; mutual validity-aware + * entailment is not sufficient to prove equality outside the valid domain. */ PROOF gnode_list EQ_SLTAC(const gnode gn, const char* lb1, const char* lb2); +/*---------------- Optional basic updates and view shifts ----------------*/ + +/** + * Introduce a basic update on an SL consequent. + * + * ```text + * [Γ; Δ ?⊢SL bupd Q] → [Γ; Δ ?⊢SL Q] + * ``` + * + * This tactic exposes exactly one outer `bupd`; it never unfolds the modality + * or searches for a resource update. Require an installed update theory, an + * SL goal, and a consequent with outer form `bupd Q`. Return the single child; + * on failure report a prover error and return `empty_gnode`. The validator + * preserves the parent HOL hypotheses by composing the child entailment with + * `∅ ⊢ (Q ⊢SL bupd Q)`. + */ +PROOF gnode BUPD_INTRO_SLTAC(const gnode gn); + +/** + * Reduce exact basic-update monotonicity to its underlying entailment. + * + * ```text + * [Γ; bupd P ?⊢SL bupd Q] → [Γ; P ?⊢SL Q] + * ``` + * + * Require an installed update theory, a singleton spatial antecedent, and an + * outer `bupd` on both endpoints. Return the single child and preserve Γ; on + * any shape/type failure report a prover error and return `empty_gnode`. The + * validator maps `ℬ ⊢ (P ⊢SL Q)` to + * `ℬ ⊢ (bupd P ⊢SL bupd Q)` without adding hypotheses. + */ +PROOF gnode BUPD_MONO_SLTAC(const gnode gn); + +/** + * Close the exact SL goal `bupd (bupd P) ⊢SL bupd P`. + * + * Require an installed update theory and alpha-equivalent occurrences of `P` + * at the two endpoints. On success install the closed primitive instance and + * return normally. On a non-SL goal, malformed `bupd` nesting, endpoint + * mismatch, or acceptance error, report a prover error and leave the node + * unsolved; this `void` function has no logical return value. + */ +PROOF void BUPD_IDEM_SLTAC(const gnode gn); + +/** + * Close the exact SL goal `bupd P ** F ⊢SL bupd (P ** F)`. + * + * Both outer `**` structure and the right frame are explicit; payload and + * frame matching is modulo alpha-equivalence, with no AC search. Require an + * installed update theory. A shape/matching/acceptance error is reported and + * leaves the node unsolved; the `void` C return is not a HOL proposition. + */ +PROOF void BUPD_FRAME_SLTAC(const gnode gn); + +/** + * Close a general goal whose conclusion is the exact view shift `P ⇛ P`. + * + * Require an installed update theory, a general rather than SL goal, and + * alpha-equivalent endpoints. On success accept `∅ ⊢ (P ⇛ P)`; otherwise + * report a prover error and leave the node unsolved. The `void` return carries + * no theorem object. + */ +PROOF void VIEWSHIFT_REFL_TAC(const gnode gn); + +/** + * Split `P ⇛ Q` at an explicit intermediate assertion `M`. + * + * ```text + * [Γ ?⊢ P ⇛ Q] → [Γ ?⊢ P ⇛ M], [Γ ?⊢ M ⇛ Q] + * ``` + * + * Require an installed update theory, a general view-shift goal, and + * `M:sl_prop()`. Return children in the displayed order; validation composes + * their theorem handles by view-shift transitivity and unions their HOL + * hypotheses. On error return `NULL` and do not create children. + */ +PROOF gnode_list VIEWSHIFT_TRANS_TAC(const gnode gn, const term mid); + +/** + * Remove an identical explicit right frame. + * + * ```text + * [Γ ?⊢ P ** F ⇛ Q ** F] → [Γ ?⊢ P ⇛ Q] + * ``` + * + * Matching is syntactic modulo alpha-equivalence; no AC frame search occurs. + * Require an installed update theory and a general goal with explicit `**` at + * both endpoints. Return the single child, or `empty_gnode` on a shape/frame + * mismatch. Validation preserves the child's HOL hypotheses. + */ +PROOF gnode VIEWSHIFT_FRAME_TAC(const gnode gn); + +/** + * Split a view shift over two explicit separating-conjunction nodes. + * + * ```text + * [Γ ?⊢ P1 ** P2 ⇛ Q1 ** Q2] + * → [Γ ?⊢ P1 ⇛ Q1], [Γ ?⊢ P2 ⇛ Q2] + * ``` + * + * Require an installed update theory and a general goal whose two endpoints + * both have explicit outer `**`. Return left-component then right-component + * child; the validator combines their hypotheses by HOL inference. Return + * `NULL` on malformed input. + */ +PROOF gnode_list VIEWSHIFT_SEP_TAC(const gnode gn); + +/** + * Reduce an existential-to-existential view shift to one pointwise theorem. + * + * ```text + * [Γ ?⊢ (∃SL x. P(x)) ⇛ (∃SL x. Q(x))] + * → [Γ ?⊢ ∀z. P(z) ⇛ Q(z)] + * ``` + * + * Both endpoints must be active SL existentials with the same witness type. + * The tactic chooses `z` fresh for the complete parent goal and substitutes + * it capture-avoidantly into both bodies, so different source/target binder + * names are handled correctly. The validator applies + * `viewshift_exists_slrule` to the proved pointwise theorem and preserves its + * hypotheses. Require an installed update theory and a general goal; on any + * shape/type/freshness error return `empty_gnode`. + */ +PROOF gnode VIEWSHIFT_EXISTS_TAC(const gnode gn); + /*----------------------- Antecedent transformations ------------------*/ /** @@ -115,7 +282,7 @@ PROOF gnode_list EQ_SLTAC(const gnode gn, const char* lb1, const char* lb2); * [Γ; Δ₀,L:H,Δ₁ ?⊢SL K] → [Γ; Δ₀,L':H,Δ₁ ?⊢SL K] * ``` * - * The assertion and index are preserved. The goal must be an `SL_GOAL`, `L` + * The assertion and index are preserved. The goal must be an SL goal, `L` * must exist, and the non-null label `L'` must be absent from Δ. */ PROOF gnode HANT_RENAME_SLTAC(const gnode gn, const char* lb, const char* new_lb); @@ -212,7 +379,7 @@ PROOF gnode_list HANT_DESTRUCT_SLTAC(const gnode gn, const char* lb, const char* * existentials until no such constructor remains; apply the scan independently * to every disjunction branch. Return open leaves depth-first, left-to-right. * - * Return `NULL` when the input is not an `SL_GOAL` or a delegated + * Return `NULL` when the input is not an SL goal or a delegated * decomposition fails. A successfully installed prefix is not rolled back. */ PROOF gnode_list AUTO_HANT_DESTRUCT_SLTAC(const gnode gn); @@ -221,8 +388,9 @@ PROOF gnode_list AUTO_HANT_DESTRUCT_SLTAC(const gnode gn); * Apply an equality or entailment theorem to selected spatial antecedents. * * Open the outer universal quantifiers of `relation` with fresh matching - * variables. After `undisch_all_rule`, convert an equality at `hprop` with - * `eq2ent`; otherwise require an entailment `L ⊢SL R`. Only the opened + * variables. After `undisch_all_rule`, convert an equality at the active + * assertion type with `eq2ent`; otherwise require an entailment `L ⊢SL R`. + * Only the opened * variables are instantiable; every other theorem or goal free term variable * is rigid. HOL type variables may be instantiated by matching. * @@ -356,7 +524,7 @@ PROOF gnode_list SEP_SLTAC(const gnode gn, const const_cstr_list lbs); * Select the left branch of an additive-disjunction consequent. * * ```text - * [Γ; Δ ?⊢SL K₁ || K₂] → [Γ; Δ ?⊢SL K₁] + * [Γ; Δ ?⊢SL (K₁ || K₂)] → [Γ; Δ ?⊢SL K₁] * ``` * * The validator applies left disjunction introduction. Both contexts are @@ -368,7 +536,7 @@ PROOF gnode DISJ1_SLTAC(const gnode gn); * Select the right branch of an additive-disjunction consequent. * * ```text - * [Γ; Δ ?⊢SL K₁ || K₂] → [Γ; Δ ?⊢SL K₂] + * [Γ; Δ ?⊢SL (K₁ || K₂)] → [Γ; Δ ?⊢SL K₂] * ``` * * The validator applies right disjunction introduction. Both contexts are @@ -391,7 +559,7 @@ PROOF gnode DISJ2_SLTAC(const gnode gn); * introduced antecedent; `NULL` requests a fresh label and no decomposition. * * The validator applies `intro_wand_slrule` and restores the parent's exact - * antecedent modulo ≡ACU. Fail if the goal is not an `SL_GOAL`, the consequent + * antecedent modulo ≡ACU. Fail if the goal is not an SL goal, the consequent * is not an outermost magic wand, the leaf label conflicts in Δ, or pattern * decomposition fails. A successfully installed introduction child is not * rolled back when a later decomposition step fails. @@ -424,10 +592,16 @@ PROOF gnode LIST_EXISTS_SLTAC(const gnode gn, const term_list wits); /** * Pull consequent existentials outward through separating conjunction. * - * Rewrite only the consequent with the registered left/right `**`-existential - * equations until movable existentials are outermost. Do not rewrite Γ or Δ. - * Return the converted child and fail if the goal is not an `SL_GOAL` or a - * required conversion cannot be constructed or validated. + * Rewrite only the consequent until every existential movable through `**` is + * outermost. At each occurrence, specialize the active distribution theorem + * to the actual binder and frame. Only family applications introduced by that + * specialization are beta-contracted; caller-owned body/frame redexes are + * retained. Rewriting uses only the resulting exact equality, without HOL's + * basic rewrite net or generic beta normalization. + * Do not rewrite Γ or Δ. A consequent with no pullable occurrence is returned + * unchanged. Fail if the goal is not an SL goal or a required local theorem + * cannot be constructed or validated. No conversion is cached across theory + * generations. */ PROOF gnode EXISTS_PULL_SLTAC(const gnode gn); @@ -540,7 +714,7 @@ PROOF gnode INTRO_FACT_SLTAC(const gnode gn, const const_cstr_list lbs); * * `R` is the separating conjunction of the remaining consequent assertions; * it is `emp` when none remain. Preserve left-to-right order and duplicates. - * Fail unless the input is an `SL_GOAL` or a validator construction fails. + * Fail unless the input is an SL goal or a validator construction fails. */ PROOF gnode_list PURE_SLTAC(const gnode gn); @@ -550,7 +724,7 @@ PROOF gnode_list PURE_SLTAC(const gnode gn); * Normalize `emp` and `fact(T)` recursively in every labeled antecedent and * in the consequent. Remove antecedents whose normalized form is `emp`; retain * the labels and order of all others. Return the converted child. Fail if the - * input is not an `SL_GOAL` or a normalization theorem cannot be validated. + * input is not an SL goal or a normalization theorem cannot be validated. */ PROOF gnode CLEAN_SLTAC(const gnode gn); @@ -567,7 +741,7 @@ PROOF gnode CLEAN_SLTAC(const gnode gn); * returns the cleaned open descendant, even if no more complete antecedent can * be framed. * - * Return `empty_gnode` when the input is not an `SL_GOAL` or framing, + * Return `empty_gnode` when the input is not an SL goal or framing, * cleaning, or closing fails. A successfully installed prefix is not rolled * back. */ @@ -579,7 +753,7 @@ PROOF gnode AUTO_FRAME_SLTAC(const gnode gn); * Select all top-level `fact(p)` antecedents in Δ from left to right and call * `INTRO_FACT_SLTAC`; leave every non-fact antecedent in relative order. If * there are no facts, install and return an identity child. Fail only when the - * input is not an `SL_GOAL` or the delegated transformation fails. + * input is not an SL goal or the delegated transformation fails. */ PROOF gnode AUTO_INTRO_FACT_SLTAC(const gnode gn); diff --git a/proof_kernel.h b/proof_kernel.h index 5b90c88..b52fd9b 100644 --- a/proof_kernel.h +++ b/proof_kernel.h @@ -5,12 +5,15 @@ * A dependent header may extend it, but must not give these symbols another * meaning. * - * - t, u, v, p, q range over HOL terms, and α, β over HOL - * types. A HOL Boolean term is still a term; letters p, q merely - * emphasize that role. - * - 𝒜 and ℬ range over finite HOL hypothesis sets. 𝒜 ⊢ p denotes a HOL - * theorem with hypothesis set 𝒜 and conclusion p. ∅ is the empty hypothesis - * set and ∪ is set union. + * - `t:τ` means the intrinsically typed HOL term `t` satisfies + * `type_of(t) = τ`. Letters `t`, `u`, `v`, `p`, and `q` range over HOL + * terms, and `α`, `β`, and `τ` over HOL types. A Boolean term is still a + * term; `p` and `q` merely emphasize type `bool`. + * - `𝒜 ⊢ φ` is a HOL theorem whose finite hypothesis set is 𝒜 and whose + * Boolean conclusion is φ. `∅` is the empty hypothesis set and `∪` is set + * union. A C value of type `thm` is only an opaque handle to such a theorem; + * it is not itself the Boolean φ and a C function returning `thm` does not + * return a C truth value. * - t ≡α u means alpha-equivalence. Exact representation identity is stated * explicitly as `equals_term(t,u)`; object-level HOL equality remains a * term in the logic and is printed with `=`. @@ -25,56 +28,113 @@ * element types are C ABI preconditions: violating them is undefined behavior, * not a recoverable prover error. Opaque handles are likewise assumed valid * unless a function explicitly checks them. + * + * HOL handles and pointer/vector/string results created by the proof runtime + * are prover/GC managed: callers copy handles freely but never `free` them. + * A fresh vector owns only a new mutable container; its elements are shallow + * copies, and resizing may relocate the container. Unless an API explicitly + * accepts `NULL`, a successful empty vector is a non-null size-zero vector and + * `NULL` denotes failure or absence. Borrowed vectors must not be resized or + * mutated. String-vector constructors copy pointers rather than characters, so + * caller-provided strings must outlive every use of the resulting vector. */ #pragma once #cst_include "cstar.h" +/** C null-pointer sentinel used by proof-library pointer APIs. */ #define NULL ((void*)0) +/** Mark a declaration or definition for C* proof-time execution. */ #define PROOF [[cst::proof]] +/** Opaque, prover-managed handle to a HOL term `t` with some type `τ`. */ PROOF typedef struct hol_term term; +/** Opaque, prover-managed handle to a HOL theorem `𝒜 ⊢ φ`. */ PROOF typedef struct hol_theorem thm; +/** Opaque, prover-managed handle to a HOL type `τ`. */ PROOF typedef struct hol_type type; +/** Opaque handle to a conversion mapping `t` to a theorem `𝒜 ⊢ t = u`. */ PROOF typedef struct hol_conversion conv; +/** Opaque pair record with shared term fields `.fst` and `.snd`. */ PROOF typedef struct hol_term_pair term_pair; +/** Opaque pair record with shared theorem fields `.fst` and `.snd`. */ PROOF typedef struct hol_thm_pair thm_pair; +/** Opaque pair record with shared type fields `.fst` and `.snd`. */ PROOF typedef struct hol_type_pair type_pair; +/** Opaque HOL type-and-term substitution returned by matching APIs. */ PROOF typedef struct hol_instantiation instantiation; +/** Opaque constant descriptor with borrowed fields `.name` and `.type`. */ +PROOF typedef struct hol_const hol_const; +/** Datatype-definition result with theorem fields `.ind` and `.rec`. */ PROOF typedef struct new_datatype_definition_results indtype; +/** Inductive-definition result with theorem fields `.def`, `.ind`, `.cases`. */ PROOF typedef struct new_inductive_definition_results inddef; /* HOL client result records are defined by cstar.h at C compilation time. * These matching opaque typedefs make their names available to the C* frontend; * member accesses are preserved for the generated C compiler to type-check. */ +/** Result of decomposing an applied type: constructor `.s`, argument vector `.tys`. */ PROOF typedef struct dest_app_type_results dest_app_type_results; +/** Lambda result with binder `.v` and body `.tm`. */ PROOF typedef struct dest_abs_results dest_abs_results; +/** Generic binder result with variable `.v` and body `.tm`. */ PROOF typedef struct dest_binder_results dest_binder_results; +/** Generic binary result with left `.tm1` and right `.tm2`. */ PROOF typedef struct dest_binop_results dest_binop_results; +/** Combination result with operator `.tm1` and operand `.tm2`. */ PROOF typedef struct dest_comb_results dest_comb_results; +/** Conjunction result with left/right conjuncts `.tm1`/`.tm2`. */ PROOF typedef struct dest_conj_results dest_conj_results; +/** Constant result with borrowed name `.s` and instantiated type `.ty`. */ +PROOF typedef struct dest_const_results dest_const_results; +/** Disjunction result with alternatives `.tm1` and `.tm2`. */ PROOF typedef struct dest_disj_results dest_disj_results; +/** Equality result with left/right operands `.tm1`/`.tm2`. */ +PROOF typedef struct dest_eq_results dest_eq_results; +/** Existential result with binder `.v` and body `.tm`. */ PROOF typedef struct dest_exists_results dest_exists_results; +/** Universal result with binder `.v` and body `.tm`. */ PROOF typedef struct dest_forall_results dest_forall_results; +/** Boolean-equivalence result with sides `.tm1` and `.tm2`. */ PROOF typedef struct dest_iff_results dest_iff_results; +/** Implication result with antecedent `.tm1` and consequent `.tm2`. */ PROOF typedef struct dest_imp_results dest_imp_results; +/** Universal-prefix result with fresh binder vector `.vs` and body `.tm`. */ PROOF typedef struct strip_forall_results strip_forall_results; +/** Vector-backed ordered sequence of shared term handles. */ PROOF typedef term* term_list; +/** Vector-backed ordered sequence of shared theorem handles. */ PROOF typedef thm* thm_list; +/** Vector-backed ordered sequence of shared type handles. */ PROOF typedef type* type_list; +/** Vector-backed ordered sequence of term-pair values. */ PROOF typedef term_pair* term_pair_list; +/** Vector-backed ordered sequence of theorem-pair values. */ PROOF typedef thm_pair* thm_pair_list; +/** Vector-backed ordered sequence of type-pair values. */ PROOF typedef type_pair* type_pair_list; +/** Vector-backed ordered sequence of HOL constant descriptors. */ +PROOF typedef hol_const* hol_const_list; -/* Build a HOL conversion from an ordered theorem context. */ +/** + * Callback that builds a HOL conversion from an ordered theorem context. + * + * The input vector container and theorem handles are borrowed for the call. + * The callback returns a prover-managed conversion handle; failure is reported + * through the prover error channel and normally yields an empty conversion. + */ PROOF typedef conv (*conv_builder)(thm_list); +/** Mutable C-string pointer; ownership is specified by each producing API. */ PROOF typedef char* cstr; +/** Read-only C-string pointer; lifetime is specified by each producing API. */ PROOF typedef const char* const_cstr; +/** Vector-backed ordered sequence of mutable string pointers. */ PROOF typedef cstr* cstr_list; +/** Vector-backed ordered sequence of read-only string pointers. */ PROOF typedef const_cstr* const_cstr_list; /* C* frontend shadow for size_t. Generated C obtains the canonical definition @@ -85,17 +145,26 @@ PROOF typedef __SIZE_TYPE__ size_t; * from cstar.h. */ PROOF typedef __builtin_va_list va_list; -/* These macros exist here for C* preprocessing and in proof_runtime.h for the - * generated-C phase. Keep their spelling identical across the two phases. */ +/** + * Construct a fresh term-vector container from zero or more `term` values. + * + * This is the arity-safe source spelling of `term_list_n`; argument handles + * are shared and remain prover managed. Macro arguments are evaluated once by + * the generated call expression. + */ #define TERM_LIST(...) \ term_list_n(sizeof((term[]){__VA_ARGS__}) / sizeof(term) __VA_OPT__(, ) __VA_ARGS__) +/** Construct a fresh theorem-vector container; theorem handles are shared. */ #define THM_LIST(...) \ thm_list_n(sizeof((thm[]){__VA_ARGS__}) / sizeof(thm) __VA_OPT__(, ) __VA_ARGS__) +/** Construct a fresh term-pair-vector container from `term_pair` values. */ #define TERM_PAIR_LIST(...) \ term_pair_list_n(sizeof((term_pair[]){__VA_ARGS__}) / sizeof(term_pair) __VA_OPT__(, ) \ __VA_ARGS__) +/** Construct a fresh mutable-string-pointer vector without copying strings. */ #define STRING_LIST(...) \ string_list_n(sizeof((char*[]){__VA_ARGS__}) / sizeof(char*) __VA_OPT__(, ) __VA_ARGS__) +/** Construct a fresh read-only-string-pointer vector without copying strings. */ #define CONST_STRING_LIST(...) \ const_string_list_n(sizeof((const char*[]){__VA_ARGS__}) / sizeof(const char*) __VA_OPT__(, ) \ __VA_ARGS__) diff --git a/proof_sl.c b/proof_sl.c index 1100463..2bf672c 100644 --- a/proof_sl.c +++ b/proof_sl.c @@ -9,54 +9,685 @@ * functions then combine kernel theorems into derived separation-logic rules. */ -PROOF void sl_thm_lazy_init_check(const char* name, thm th, - const char* expected_str) { - if (NOT_OK) { - log_fatal("sl_thm_lazy_init(%s): prover error before check: %s", name, - get_last_error() ? get_last_error() : "(none)"); - } - if (IS_NULL(th)) { - log_fatal("sl_thm_lazy_init(%s): prove_%s() returned empty theorem", name, - name); - } - term expected = parse_term(expected_str); - if (NOT_OK) { - log_fatal( - "sl_thm_lazy_init(%s): failed to parse expected conclusion `%s`: %s", - name, expected_str, get_last_error() ? get_last_error() : "(none)"); - } - if (vector_size(hyp(th)) != 0) { - log_fatal("sl_thm_lazy_init(%s): expected unconditional `|-`, got `%s`", - name, string_of_thm(th)); +PROOF static sl_theory active_sl_theory; +PROOF static bool active_sl_theory_initialized = false; +PROOF static size_t active_sl_theory_generation = 0; +PROOF static sl_update_theory active_sl_update_theory; +PROOF static bool active_sl_update_theory_initialized = false; +PROOF static size_t active_sl_update_theory_generation = 0; + +PROOF thm sl_ent_sym_left; +PROOF thm sl_ent_restate; +PROOF thm sl_frame_restate; +PROOF thm sl_ent_frame_left; +PROOF thm sl_ent_frame_right; +PROOF thm sl_ent_subst_frame; +PROOF thm sl_sep_combine; +PROOF thm sl_ac_rule; +PROOF thm sl_disj_mono; +PROOF thm sl_or_elim_frame; +PROOF thm sl_exists_elim_frame; +PROOF thm sl_undisch; +PROOF thm sl_conj1; +PROOF thm sl_conj2; +PROOF thm sl_disj1_mono; +PROOF thm sl_disj2_mono; +PROOF thm sl_exists_wit; + +PROOF static thm prove_sl_ent_sym_left(void); +PROOF static thm prove_sl_ent_restate(void); +PROOF static thm prove_sl_frame_restate(void); +PROOF static thm prove_sl_ent_frame_left(void); +PROOF static thm prove_sl_ent_frame_right(void); +PROOF static thm prove_sl_ent_subst_frame(void); +PROOF static thm prove_sl_sep_combine(void); +PROOF static thm prove_sl_ac_rule(void); +PROOF static thm prove_sl_disj_mono(void); +PROOF static thm prove_sl_or_elim_frame(void); +PROOF static thm prove_sl_exists_elim_frame(void); +PROOF static thm prove_sl_undisch(void); +PROOF static thm prove_sl_conj1(void); +PROOF static thm prove_sl_conj2(void); +PROOF static thm prove_sl_disj1_mono(void); +PROOF static thm prove_sl_disj2_mono(void); +PROOF static thm prove_sl_exists_wit(void); +PROOF static int sl_build_derived_theorems(void); + +PROOF static void sl_clear_update_theory(void) { + active_sl_update_theory = (sl_update_theory){0}; + active_sl_update_theory_initialized = false; + active_sl_update_theory_generation = 0; +} + +PROOF static int sl_check_exact_primitive(const char* name, const thm actual, + const term expected) { + ENSURE_COND(!IS_NULL(actual), + "SL primitive %s is empty", name); + term_list assumptions = hyp(actual); + ENSURE_COND(vector_size(assumptions) == 0, + "SL primitive %s has assumptions", name); + term actual_ccl = concl(actual); + term_list actual_frees = free_vars(actual_ccl); + ENSURE_COND(vector_size(actual_frees) == 0, + "SL primitive %s has free term variables", name); + int schema_order = alpha_compare(actual_ccl, expected); + ENSURE_COND(schema_order == 0, + "SL primitive %s does not match its schema", name); + return 0; +err: + ERR_FUN_PUTS("sl_check_exact_primitive", cstr_string(name), + cstr_thm(actual), cstr_term(expected)); + return -1; +} + +PROOF static int sl_check_exact_derived(const char* name, const thm actual, + const term expected) { + ENSURE_COND(!IS_NULL(actual), "Derived SL theorem %s is empty", name); + term_list assumptions = hyp(actual); + ENSURE_COND(vector_size(assumptions) == 0, + "Derived SL theorem %s has assumptions", name); + term actual_ccl = concl(actual); + term_list actual_frees = free_vars(actual_ccl); + ENSURE_COND(vector_size(actual_frees) == 0, + "Derived SL theorem %s has free term variables", name); + ENSURE_COND(equals_term(actual_ccl, expected), + "Derived SL theorem %s does not have its documented exact " + "conclusion; actual `%s`, expected `%s`", + name, string_of_term(actual_ccl), string_of_term(expected)); + return 0; +err: + ERR_FUN_PUTS("sl_check_exact_derived", cstr_string(name), + cstr_thm(actual), cstr_term(expected)); + return -1; +} + +PROOF static int sl_bind_exact_derived(const char* name, thm* binding, + const thm proved, + const term expected) { + thm aligned = proved; + term proved_ccl = concl(proved); + if (!equals_term(proved_ccl, expected)) { + ENSURE_COND(alpha_compare(proved_ccl, expected) == 0, + "Derived SL theorem %s is not alpha-equivalent to its " + "documented conclusion", + name); + thm alignment = alpha_rule(proved_ccl, expected); + aligned = eq_mp_rule(alignment, proved); } - term got = concl(th); - if (alpha_compare(got, expected) != 0) { - log_fatal( - "sl_thm_lazy_init(%s): conclusion mismatch modulo alpha-equivalence\n" - " got: `%s`\n " - "expected: `%s`", - name, string_of_term(got), string_of_term(expected)); + int check_status = sl_check_exact_derived(name, aligned, expected); + ENSURE_COND(check_status == 0, + "Derived SL theorem %s failed exact validation", name); + *binding = aligned; + return 0; +err: + ERR_FUN_PUTS("sl_bind_exact_derived", cstr_string(name), + cstr_thm(proved), cstr_term(expected)); + return -1; +} + +PROOF static int sl_check_existential_primitives(const sl_theory* theory) { + type_list intro_types = term_tyvars(concl(theory->exists_intro)); + type_list elim_types = term_tyvars(concl(theory->exists_elim)); + type_list mono_types = term_tyvars(concl(theory->exists_mono)); + type_list left_types = term_tyvars(concl(theory->sep_exists_left)); + type_list right_types = term_tyvars(concl(theory->sep_exists_right)); + ENSURE_COND(vector_size(intro_types) == 1, + "SL exists_intro must have exactly one witness type variable"); + ENSURE_COND(vector_size(elim_types) == 1, + "SL exists_elim must have exactly one witness type variable"); + ENSURE_COND(vector_size(mono_types) == 1, + "SL exists_mono must have exactly one witness type variable"); + ENSURE_COND(vector_size(left_types) == 1, + "SL sep_exists_left must have exactly one witness type variable"); + ENSURE_COND(vector_size(right_types) == 1, + "SL sep_exists_right must have exactly one witness type variable"); + + type prop_type = theory->prop_type; + type intro_witness_type = intro_types[0]; + type intro_family_type = mk_fun_type(intro_witness_type, prop_type); + term intro_P = mk_var("__sl_exists_intro_P", intro_family_type); + term intro_w = mk_var("__sl_exists_intro_w", intro_witness_type); + term intro_x = mk_var("__sl_exists_intro_x", intro_witness_type); + term intro_P_w = mk_comb(intro_P, intro_w); + term intro_P_x = mk_comb(intro_P, intro_x); + term intro_exists_P = + mk_icomb(theory->exists_op, mk_abs(intro_x, intro_P_x)); + term intro = mk_binop(theory->entails, intro_P_w, intro_exists_P); + term intro_schema = + list_mk_forall(TERM_LIST(intro_P, intro_w), intro); + ENSURE_COND(sl_check_exact_primitive( + "exists_intro", theory->exists_intro, intro_schema) == 0, + "Invalid SL primitive exists_intro"); + + type elim_witness_type = elim_types[0]; + type elim_family_type = mk_fun_type(elim_witness_type, prop_type); + term elim_P = mk_var("__sl_exists_elim_P", elim_family_type); + term elim_F = mk_var("__sl_exists_elim_F", prop_type); + term elim_x = mk_var("__sl_exists_elim_x", elim_witness_type); + term elim_P_x = mk_comb(elim_P, elim_x); + term elim_exists_P = + mk_icomb(theory->exists_op, mk_abs(elim_x, elim_P_x)); + term pointwise_elim = mk_forall( + elim_x, mk_binop(theory->entails, elim_P_x, elim_F)); + term elim = mk_imp( + pointwise_elim, + mk_binop(theory->entails, elim_exists_P, elim_F)); + term elim_schema = list_mk_forall(TERM_LIST(elim_P, elim_F), elim); + ENSURE_COND(sl_check_exact_primitive( + "exists_elim", theory->exists_elim, elim_schema) == 0, + "Invalid SL primitive exists_elim"); + + type mono_witness_type = mono_types[0]; + type mono_family_type = mk_fun_type(mono_witness_type, prop_type); + term mono_P = mk_var("__sl_exists_mono_P", mono_family_type); + term mono_Q = mk_var("__sl_exists_mono_Q", mono_family_type); + term mono_x = mk_var("__sl_exists_mono_x", mono_witness_type); + term mono_P_x = mk_comb(mono_P, mono_x); + term mono_Q_x = mk_comb(mono_Q, mono_x); + term mono_exists_P = + mk_icomb(theory->exists_op, mk_abs(mono_x, mono_P_x)); + term mono_exists_Q = + mk_icomb(theory->exists_op, mk_abs(mono_x, mono_Q_x)); + term pointwise_mono = mk_forall( + mono_x, mk_binop(theory->entails, mono_P_x, mono_Q_x)); + term mono = mk_imp( + pointwise_mono, + mk_binop(theory->entails, mono_exists_P, mono_exists_Q)); + term mono_schema = list_mk_forall(TERM_LIST(mono_P, mono_Q), mono); + ENSURE_COND(sl_check_exact_primitive( + "exists_mono", theory->exists_mono, mono_schema) == 0, + "Invalid SL primitive exists_mono"); + + type left_witness_type = left_types[0]; + type left_family_type = mk_fun_type(left_witness_type, prop_type); + term left_P = mk_var("__sl_exists_left_P", left_family_type); + term left_F = mk_var("__sl_exists_left_F", prop_type); + term left_x = mk_var("__sl_exists_left_x", left_witness_type); + term left_P_x = mk_comb(left_P, left_x); + term left_exists_P = + mk_icomb(theory->exists_op, mk_abs(left_x, left_P_x)); + term left_body = mk_binop(theory->sep, left_P_x, left_F); + term left_target = + mk_icomb(theory->exists_op, mk_abs(left_x, left_body)); + term left = mk_eq( + mk_binop(theory->sep, left_exists_P, left_F), left_target); + term left_schema = list_mk_forall(TERM_LIST(left_P, left_F), left); + ENSURE_COND(sl_check_exact_primitive( + "sep_exists_left", theory->sep_exists_left, + left_schema) == 0, + "Invalid SL primitive sep_exists_left"); + + type right_witness_type = right_types[0]; + type right_family_type = mk_fun_type(right_witness_type, prop_type); + term right_P = mk_var("__sl_exists_right_P", right_family_type); + term right_F = mk_var("__sl_exists_right_F", prop_type); + term right_x = mk_var("__sl_exists_right_x", right_witness_type); + term right_P_x = mk_comb(right_P, right_x); + term right_exists_P = + mk_icomb(theory->exists_op, mk_abs(right_x, right_P_x)); + term right_body = mk_binop(theory->sep, right_F, right_P_x); + term right_target = + mk_icomb(theory->exists_op, mk_abs(right_x, right_body)); + term right = mk_eq( + mk_binop(theory->sep, right_F, right_exists_P), right_target); + term right_schema = list_mk_forall(TERM_LIST(right_F, right_P), right); + ENSURE_COND(sl_check_exact_primitive( + "sep_exists_right", theory->sep_exists_right, + right_schema) == 0, + "Invalid SL primitive sep_exists_right"); + return 0; +err: + ERR_FUN_PUTS("sl_check_existential_primitives"); + return -1; +} + +PROOF static int sl_check_universal_primitives(const sl_theory* theory) { + type_list intro_types = term_tyvars(concl(theory->forall_intro)); + type_list elim_types = term_tyvars(concl(theory->forall_elim)); + ENSURE_COND(vector_size(intro_types) == 1, + "SL forall_intro must have exactly one witness type variable"); + ENSURE_COND(vector_size(elim_types) == 1, + "SL forall_elim must have exactly one witness type variable"); + + type prop_type = theory->prop_type; + type intro_witness_type = intro_types[0]; + type intro_family_type = mk_fun_type(intro_witness_type, prop_type); + term intro_P = mk_var("__sl_forall_intro_P", prop_type); + term intro_Q = mk_var("__sl_forall_intro_Q", intro_family_type); + term intro_x = mk_var("__sl_forall_intro_x", intro_witness_type); + term intro_Q_x = mk_comb(intro_Q, intro_x); + term intro_pointwise = mk_forall( + intro_x, mk_binop(theory->entails, intro_P, intro_Q_x)); + term intro_forall_Q = + mk_icomb(theory->forall_op, mk_abs(intro_x, intro_Q_x)); + term intro_result = mk_binop(theory->entails, intro_P, intro_forall_Q); + term intro_schema = list_mk_forall( + TERM_LIST(intro_P, intro_Q), mk_imp(intro_pointwise, intro_result)); + ENSURE_COND(sl_check_exact_primitive( + "forall_intro", theory->forall_intro, intro_schema) == 0, + "Invalid SL primitive forall_intro"); + + type elim_witness_type = elim_types[0]; + type elim_family_type = mk_fun_type(elim_witness_type, prop_type); + term elim_P = mk_var("__sl_forall_elim_P", elim_family_type); + term elim_Q = mk_var("__sl_forall_elim_Q", prop_type); + term elim_w = mk_var("__sl_forall_elim_w", elim_witness_type); + term elim_x = mk_var("__sl_forall_elim_x", elim_witness_type); + term elim_P_w = mk_comb(elim_P, elim_w); + term elim_P_x = mk_comb(elim_P, elim_x); + term elim_premise = mk_binop(theory->entails, elim_P_w, elim_Q); + term elim_forall_P = + mk_icomb(theory->forall_op, mk_abs(elim_x, elim_P_x)); + term elim_result = mk_binop(theory->entails, elim_forall_P, elim_Q); + term elim_schema = list_mk_forall( + TERM_LIST(elim_P, elim_Q, elim_w), + mk_imp(elim_premise, elim_result)); + ENSURE_COND(sl_check_exact_primitive( + "forall_elim", theory->forall_elim, elim_schema) == 0, + "Invalid SL primitive forall_elim"); + return 0; +err: + ERR_FUN_PUTS("sl_check_universal_primitives"); + return -1; +} + +PROOF const sl_theory* sl_current_theory(void) { + ENSURE_COND(active_sl_theory_initialized, + "No SL theory is installed; call sl_install_theory first"); + return &active_sl_theory; +err: + ERR_FUN_PUTS("sl_current_theory"); + return &active_sl_theory; +} + +PROOF bool sl_theory_is_installed(void) { + return active_sl_theory_initialized; +} + +PROOF size_t sl_theory_generation(void) { + ENSURE_COND(active_sl_theory_initialized, + "No SL theory is installed; call sl_install_theory first"); + return active_sl_theory_generation; +err: + ERR_FUN_PUTS("sl_theory_generation"); + return 0; +} + +PROOF int sl_install_theory(const sl_theory* theory) { + sl_theory previous_theory = active_sl_theory; + bool previous_initialized = active_sl_theory_initialized; + size_t previous_generation = active_sl_theory_generation; + thm previous_ent_sym_left = sl_ent_sym_left; + thm previous_ent_restate = sl_ent_restate; + thm previous_frame_restate = sl_frame_restate; + thm previous_ent_frame_left = sl_ent_frame_left; + thm previous_ent_frame_right = sl_ent_frame_right; + thm previous_ent_subst_frame = sl_ent_subst_frame; + thm previous_sep_combine = sl_sep_combine; + thm previous_ac_rule = sl_ac_rule; + thm previous_disj_mono = sl_disj_mono; + thm previous_or_elim_frame = sl_or_elim_frame; + thm previous_exists_elim_frame = sl_exists_elim_frame; + thm previous_undisch = sl_undisch; + thm previous_conj1 = sl_conj1; + thm previous_conj2 = sl_conj2; + thm previous_disj1_mono = sl_disj1_mono; + thm previous_disj2_mono = sl_disj2_mono; + thm previous_exists_wit = sl_exists_wit; + bool candidate_active = false; + + ENSURE_COND(theory != NULL, "SL theory bundle is null"); + ENSURE_COND(!IS_NULL(theory->prop_type), + "SL theory assertion type is empty"); + + type prop_type = theory->prop_type; + type_list prop_tyvars = type_tyvars(prop_type); + ENSURE_COND(vector_size(prop_tyvars) == 0, + "SL assertion type must be monomorphic"); + type bool_type = mk_bool_type(); + type assertion_to_assertion = mk_fun_type(prop_type, prop_type); + type bin_assertion_type = + mk_fun_type(prop_type, assertion_to_assertion); + type assertion_to_bool = mk_fun_type(prop_type, bool_type); + type relation_type = mk_fun_type(prop_type, assertion_to_bool); + type emp_type = type_of(theory->emp); + ENSURE_COND(equals_type(emp_type, prop_type), + "SL emp has the wrong type"); + type sep_type = type_of(theory->sep); + ENSURE_COND(equals_type(sep_type, bin_assertion_type), + "SL separating conjunction has the wrong type"); + type wand_type = type_of(theory->wand); + ENSURE_COND(equals_type(wand_type, bin_assertion_type), + "SL wand has the wrong type"); + type and_type = type_of(theory->and_op); + ENSURE_COND(equals_type(and_type, bin_assertion_type), + "SL additive conjunction has the wrong type"); + type or_type = type_of(theory->or_op); + ENSURE_COND(equals_type(or_type, bin_assertion_type), + "SL additive disjunction has the wrong type"); + type entails_type = type_of(theory->entails); + ENSURE_COND(equals_type(entails_type, relation_type), + "SL entailment has the wrong type"); + type equiv_type = type_of(theory->equiv); + ENSURE_COND(equals_type(equiv_type, relation_type), + "SL logical equivalence has the wrong type"); + type fact_type = type_of(theory->fact); + type expected_fact_type = mk_fun_type(bool_type, prop_type); + ENSURE_COND(equals_type(fact_type, expected_fact_type), + "SL fact embedding has the wrong type"); + + /* Existential quantification is polymorphic in its witness type. Check one + * explicitly instantiated concrete instance without imposing a parser + * binder name. */ + type_list exists_tyvars = term_tyvars(theory->exists_op); + ENSURE_COND(vector_size(exists_tyvars) == 1, + "SL existential operator must have exactly one witness type " + "variable"); + type bool_predicate_type = mk_fun_type(bool_type, prop_type); + term bool_predicate = + mk_var("__sl_bool_predicate", bool_predicate_type); + term exists_probe = mk_icomb(theory->exists_op, bool_predicate); + type exists_probe_type = type_of(exists_probe); + ENSURE_COND(equals_type(exists_probe_type, prop_type), + "SL existential operator has the wrong result type"); + + type_list forall_tyvars = term_tyvars(theory->forall_op); + ENSURE_COND(vector_size(forall_tyvars) == 1, + "SL universal operator must have exactly one witness type " + "variable"); + term forall_probe = mk_icomb(theory->forall_op, bool_predicate); + type forall_probe_type = type_of(forall_probe); + ENSURE_COND(equals_type(forall_probe_type, prop_type), + "SL universal operator has the wrong result type"); + + ENSURE_COND( + !IS_NULL(theory->sep_emp_left) && + !IS_NULL(theory->sep_emp_right) && + !IS_NULL(theory->sep_assoc) && !IS_NULL(theory->sep_comm) && + !IS_NULL(theory->sep_mono) && + !IS_NULL(theory->wand_sep_adjoint) && + !IS_NULL(theory->and_intro) && !IS_NULL(theory->and_elim1) && + !IS_NULL(theory->and_elim2) && !IS_NULL(theory->or_intro1) && + !IS_NULL(theory->or_intro2) && !IS_NULL(theory->or_elim) && + !IS_NULL(theory->exists_intro) && + !IS_NULL(theory->exists_elim) && + !IS_NULL(theory->exists_mono) && + !IS_NULL(theory->sep_exists_left) && + !IS_NULL(theory->sep_exists_right) && + !IS_NULL(theory->forall_intro) && + !IS_NULL(theory->forall_elim) && + !IS_NULL(theory->ent_refl) && !IS_NULL(theory->ent_trans) && + !IS_NULL(theory->equiv_intro) && + !IS_NULL(theory->fact_intro) && !IS_NULL(theory->fact_elim) && + !IS_NULL(theory->fact_dup) && + !IS_NULL(theory->fact_true_emp), + "SL theory bundle contains an empty primitive theorem"); + + ENSURE_COND(sl_check_existential_primitives(theory) == 0, + "SL existential primitive validation failed"); + ENSURE_COND(sl_check_universal_primitives(theory) == 0, + "SL universal primitive validation failed"); + + active_sl_theory = *theory; + active_sl_theory_initialized = true; + active_sl_theory_generation = previous_generation + 1; + candidate_active = true; + int derived_status = sl_build_derived_theorems(); + ENSURE_COND(derived_status == 0, + "SL derived theorem construction failed"); + + sl_clear_update_theory(); + candidate_active = false; + return 0; +err: + if (candidate_active) { + active_sl_theory = previous_theory; + active_sl_theory_initialized = previous_initialized; + active_sl_theory_generation = previous_generation; + sl_ent_sym_left = previous_ent_sym_left; + sl_ent_restate = previous_ent_restate; + sl_frame_restate = previous_frame_restate; + sl_ent_frame_left = previous_ent_frame_left; + sl_ent_frame_right = previous_ent_frame_right; + sl_ent_subst_frame = previous_ent_subst_frame; + sl_sep_combine = previous_sep_combine; + sl_ac_rule = previous_ac_rule; + sl_disj_mono = previous_disj_mono; + sl_or_elim_frame = previous_or_elim_frame; + sl_exists_elim_frame = previous_exists_elim_frame; + sl_undisch = previous_undisch; + sl_conj1 = previous_conj1; + sl_conj2 = previous_conj2; + sl_disj1_mono = previous_disj1_mono; + sl_disj2_mono = previous_disj2_mono; + sl_exists_wit = previous_exists_wit; } + ERR_FUN_PUTS("sl_install_theory"); + return -1; +} + +PROOF int sl_install_update_theory(const sl_update_theory* theory) { + ENSURE_COND(active_sl_theory_initialized, + "Install an SL theory before its update theory"); + ENSURE_COND(theory != NULL, "SL update theory bundle is null"); + ENSURE_COND(!IS_NULL(theory->bupd), + "SL basic-update operator is empty"); + ENSURE_COND(!IS_NULL(theory->viewshift), + "SL view-shift operator is empty"); + + type prop_type = active_sl_theory.prop_type; + type bool_type = mk_bool_type(); + type expected_bupd_type = mk_fun_type(prop_type, prop_type); + type bupd_type = type_of(theory->bupd); + ENSURE_COND(equals_type(bupd_type, expected_bupd_type), + "SL basic-update operator has the wrong type"); + type assertion_to_bool = mk_fun_type(prop_type, bool_type); + type expected_viewshift_type = + mk_fun_type(prop_type, assertion_to_bool); + type viewshift_type = type_of(theory->viewshift); + ENSURE_COND(equals_type(viewshift_type, expected_viewshift_type), + "SL view-shift operator has the wrong type"); + + ENSURE_COND( + !IS_NULL(theory->bupd_intro) && + !IS_NULL(theory->bupd_mono) && + !IS_NULL(theory->bupd_idem) && + !IS_NULL(theory->bupd_frame) && + !IS_NULL(theory->viewshift_refl) && + !IS_NULL(theory->viewshift_entails) && + !IS_NULL(theory->viewshift_trans) && + !IS_NULL(theory->viewshift_mono) && + !IS_NULL(theory->viewshift_frame) && + !IS_NULL(theory->viewshift_sep) && + !IS_NULL(theory->viewshift_exists), + "SL update theory contains an empty primitive theorem"); + + term P = mk_var("__sl_update_P", prop_type); + term Q = mk_var("__sl_update_Q", prop_type); + term S = mk_var("__sl_update_S", prop_type); + term P2 = mk_var("__sl_update_P2", prop_type); + term Q2 = mk_var("__sl_update_Q2", prop_type); + term F = mk_var("__sl_update_F", prop_type); + + term bP = mk_comb(theory->bupd, P); + term bQ = mk_comb(theory->bupd, Q); + term bbP = mk_comb(theory->bupd, bP); + term sep_P_F = mk_binop(active_sl_theory.sep, P, F); + term sep_Q_F = mk_binop(active_sl_theory.sep, Q, F); + term b_sep_P_F = mk_comb(theory->bupd, sep_P_F); + + term ent_P_Q = mk_binop(active_sl_theory.entails, P, Q); + term ent_P2_P = mk_binop(active_sl_theory.entails, P2, P); + term ent_Q_Q2 = mk_binop(active_sl_theory.entails, Q, Q2); + term ent_bP_bQ = mk_binop(active_sl_theory.entails, bP, bQ); + term view_P_Q = mk_binop(theory->viewshift, P, Q); + term view_Q_S = mk_binop(theory->viewshift, Q, S); + +#define CHECK_UPDATE_PRIMITIVE(field, expected) \ + int field##_status = \ + sl_check_exact_primitive(#field, theory->field, (expected)); \ + ENSURE_COND(field##_status == 0, \ + "Invalid SL update primitive %s", #field) + + term ent_P_bP = mk_binop(active_sl_theory.entails, P, bP); + term bupd_intro_schema = list_mk_forall(TERM_LIST(P), ent_P_bP); + CHECK_UPDATE_PRIMITIVE(bupd_intro, bupd_intro_schema); + + term bupd_mono_body = mk_imp(ent_P_Q, ent_bP_bQ); + term bupd_mono_schema = + list_mk_forall(TERM_LIST(P, Q), bupd_mono_body); + CHECK_UPDATE_PRIMITIVE(bupd_mono, bupd_mono_schema); + + term ent_bbP_bP = mk_binop(active_sl_theory.entails, bbP, bP); + term bupd_idem_schema = list_mk_forall(TERM_LIST(P), ent_bbP_bP); + CHECK_UPDATE_PRIMITIVE(bupd_idem, bupd_idem_schema); + + term sep_bP_F = mk_binop(active_sl_theory.sep, bP, F); + term ent_sep_bP_F = + mk_binop(active_sl_theory.entails, sep_bP_F, b_sep_P_F); + term bupd_frame_schema = + list_mk_forall(TERM_LIST(P, F), ent_sep_bP_F); + CHECK_UPDATE_PRIMITIVE(bupd_frame, bupd_frame_schema); + + term view_P_P = mk_binop(theory->viewshift, P, P); + term viewshift_refl_schema = list_mk_forall(TERM_LIST(P), view_P_P); + CHECK_UPDATE_PRIMITIVE(viewshift_refl, viewshift_refl_schema); + + term viewshift_entails_body = mk_imp(ent_P_Q, view_P_Q); + term viewshift_entails_schema = + list_mk_forall(TERM_LIST(P, Q), viewshift_entails_body); + CHECK_UPDATE_PRIMITIVE(viewshift_entails, viewshift_entails_schema); + + term view_P_S = mk_binop(theory->viewshift, P, S); + term viewshift_trans_tail = mk_imp(view_Q_S, view_P_S); + term viewshift_trans_body = mk_imp(view_P_Q, viewshift_trans_tail); + term viewshift_trans_schema = + list_mk_forall(TERM_LIST(P, Q, S), viewshift_trans_body); + CHECK_UPDATE_PRIMITIVE(viewshift_trans, viewshift_trans_schema); + + term view_P2_Q2 = mk_binop(theory->viewshift, P2, Q2); + term viewshift_mono_post = mk_imp(ent_Q_Q2, view_P2_Q2); + term viewshift_mono_change = mk_imp(view_P_Q, viewshift_mono_post); + term viewshift_mono_body = mk_imp(ent_P2_P, viewshift_mono_change); + term viewshift_mono_schema = list_mk_forall( + TERM_LIST(P2, P, Q, Q2), viewshift_mono_body); + CHECK_UPDATE_PRIMITIVE(viewshift_mono, viewshift_mono_schema); + + term view_sep_P_F_Q_F = + mk_binop(theory->viewshift, sep_P_F, sep_Q_F); + term viewshift_frame_body = mk_imp(view_P_Q, view_sep_P_F_Q_F); + term viewshift_frame_schema = + list_mk_forall(TERM_LIST(P, Q, F), viewshift_frame_body); + CHECK_UPDATE_PRIMITIVE(viewshift_frame, viewshift_frame_schema); + + term P1 = mk_var("__sl_update_P1", prop_type); + term Q1 = mk_var("__sl_update_Q1", prop_type); + term view_P1_Q1 = mk_binop(theory->viewshift, P1, Q1); + term view_P2_Q2_for_sep = mk_binop(theory->viewshift, P2, Q2); + term sep_P1_P2 = mk_binop(active_sl_theory.sep, P1, P2); + term sep_Q1_Q2 = mk_binop(active_sl_theory.sep, Q1, Q2); + term view_sep_P1_P2_Q1_Q2 = + mk_binop(theory->viewshift, sep_P1_P2, sep_Q1_Q2); + term viewshift_sep_tail = + mk_imp(view_P2_Q2_for_sep, view_sep_P1_P2_Q1_Q2); + term viewshift_sep_body = mk_imp(view_P1_Q1, viewshift_sep_tail); + term viewshift_sep_schema = list_mk_forall( + TERM_LIST(P1, Q1, P2, Q2), viewshift_sep_body); + CHECK_UPDATE_PRIMITIVE(viewshift_sep, viewshift_sep_schema); + + term viewshift_exists_ccl = concl(theory->viewshift_exists); + type_list witness_types = term_tyvars(viewshift_exists_ccl); + ENSURE_COND(vector_size(witness_types) == 1, + "SL viewshift_exists primitive must have exactly one witness " + "type variable"); + type witness_type = witness_types[0]; + type witness_family_type = mk_fun_type(witness_type, prop_type); + term PX = mk_var("__sl_update_PX", witness_family_type); + term QX = mk_var("__sl_update_QX", witness_family_type); + term x = mk_var("__sl_update_x", witness_type); + term P_x = mk_comb(PX, x); + term Q_x = mk_comb(QX, x); + /* The public existential interface is eta-long: the endpoint is the binder + * `exists x. P x`, never the merely eta-equivalent application `exists P`. */ + term exists_P = + mk_icomb(active_sl_theory.exists_op, mk_abs(x, P_x)); + term exists_Q = + mk_icomb(active_sl_theory.exists_op, mk_abs(x, Q_x)); + term pointwise_change = mk_binop(theory->viewshift, P_x, Q_x); + term pointwise = list_mk_forall(TERM_LIST(x), pointwise_change); + term exists_change = mk_binop(theory->viewshift, exists_P, exists_Q); + term viewshift_exists_body = mk_imp(pointwise, exists_change); + term viewshift_exists_schema = + list_mk_forall(TERM_LIST(PX, QX), viewshift_exists_body); + CHECK_UPDATE_PRIMITIVE(viewshift_exists, viewshift_exists_schema); + +#undef CHECK_UPDATE_PRIMITIVE + + active_sl_update_theory = *theory; + active_sl_update_theory_initialized = true; + active_sl_update_theory_generation = active_sl_theory_generation; + return 0; +err: + ERR_FUN_PUTS("sl_install_update_theory"); + return -1; +} + +PROOF bool sl_update_theory_is_installed(void) { + return active_sl_theory_initialized && + active_sl_update_theory_initialized && + active_sl_update_theory_generation == active_sl_theory_generation; +} + +PROOF const sl_update_theory* sl_current_update_theory(void) { + ENSURE_COND( + sl_update_theory_is_installed(), + "No update theory is installed for the active SL generation"); + return &active_sl_update_theory; +err: + ERR_FUN_PUTS("sl_current_update_theory"); + return &active_sl_update_theory; +} + +PROOF term sl_raw_eq(void) { + type prop_type = sl_prop(); + term probe = mk_var("__sl_eq_probe", prop_type); + term equation = mk_eq(probe, probe); + dest_comb_results rhs_application = dest_comb(equation); + dest_comb_results lhs_application = dest_comb(rhs_application.tm1); + return lhs_application.tm1; +err: + ERR_FUN_PUTS("sl_raw_eq"); + return empty_term; } PROOF bool is_sl_prop(const term tm) { - return equals_type(type_of(tm), sl_prop()); + type tm_type = type_of(tm); + type prop_type = sl_prop(); + bool result = equals_type(tm_type, prop_type); + return result; } PROOF term mk_sl_prop(const char* s) { - return mk_var(s, sl_prop()); + type prop_type = sl_prop(); + term result = mk_var(s, prop_type); + return result; } PROOF bool is_sl_emp(const term tm) { - return equals_term(tm, sl_emp()); + term emp = sl_emp(); + bool result = equals_term(tm, emp); + return result; } PROOF bool is_sl_sep(const term hp) { - return is_binop(sl_sep(), hp); + term sep = sl_sep(); + bool result = is_binop(sep, hp); + return result; } PROOF term mk_sl_sep(const term hp1, const term hp2) { - term res_tm = mk_binop(sl_sep(), hp1, hp2); + term sep = sl_sep(); + term res_tm = mk_binop(sep, hp1, hp2); return res_tm; err: ERR_FUN_PUTS("mk_sl_sep", cstr_term(hp1), cstr_term(hp2)); @@ -64,7 +695,8 @@ err: } PROOF dest_binop_results dest_sl_sep(const term hp) { - dest_binop_results res = dest_binop(sl_sep(), hp); + term sep = sl_sep(); + dest_binop_results res = dest_binop(sep, hp); return res; err: ERR_FUN_PUTS("dest_sl_sep", cstr_term(hp)); @@ -72,11 +704,14 @@ err: } PROOF bool is_sl_wand(const term hp) { - return is_binop(sl_wand(), hp); + term wand = sl_wand(); + bool result = is_binop(wand, hp); + return result; } PROOF term mk_sl_wand(const term hp1, const term hp2) { - term res_tm = mk_binop(sl_wand(), hp1, hp2); + term wand = sl_wand(); + term res_tm = mk_binop(wand, hp1, hp2); return res_tm; err: ERR_FUN_PUTS("mk_sl_wand", cstr_term(hp1), cstr_term(hp2)); @@ -84,7 +719,8 @@ err: } PROOF dest_binop_results dest_sl_wand(const term hp) { - dest_binop_results res = dest_binop(sl_wand(), hp); + term wand = sl_wand(); + dest_binop_results res = dest_binop(wand, hp); return res; err: ERR_FUN_PUTS("dest_sl_wand", cstr_term(hp)); @@ -92,11 +728,14 @@ err: } PROOF bool is_sl_and(const term hp) { - return is_binop(sl_and(), hp); + term and_op = sl_and(); + bool result = is_binop(and_op, hp); + return result; } PROOF term mk_sl_and(const term hp1, const term hp2) { - term res_tm = mk_binop(sl_and(), hp1, hp2); + term and_op = sl_and(); + term res_tm = mk_binop(and_op, hp1, hp2); return res_tm; err: ERR_FUN_PUTS("mk_sl_and", cstr_term(hp1), cstr_term(hp2)); @@ -104,7 +743,8 @@ err: } PROOF dest_binop_results dest_sl_and(const term hp) { - dest_binop_results res = dest_binop(sl_and(), hp); + term and_op = sl_and(); + dest_binop_results res = dest_binop(and_op, hp); return res; err: ERR_FUN_PUTS("dest_sl_and", cstr_term(hp)); @@ -112,11 +752,14 @@ err: } PROOF bool is_sl_or(const term hp) { - return is_binop(sl_or(), hp); + term or_op = sl_or(); + bool result = is_binop(or_op, hp); + return result; } PROOF term mk_sl_or(const term hp1, const term hp2) { - term res_tm = mk_binop(sl_or(), hp1, hp2); + term or_op = sl_or(); + term res_tm = mk_binop(or_op, hp1, hp2); return res_tm; err: ERR_FUN_PUTS("mk_sl_or", cstr_term(hp1), cstr_term(hp2)); @@ -124,7 +767,8 @@ err: } PROOF dest_binop_results dest_sl_or(const term hp) { - dest_binop_results res = dest_binop(sl_or(), hp); + term or_op = sl_or(); + dest_binop_results res = dest_binop(or_op, hp); return res; err: ERR_FUN_PUTS("dest_sl_or", cstr_term(hp)); @@ -132,11 +776,29 @@ err: } PROOF bool is_sl_exists(const term tm) { - return is_binder(sl_exists_str(), tm); + if (!is_comb(tm)) return false; + + dest_comb_results application = dest_comb(tm); + if (!is_abs(application.tm2)) return false; + + /* Instantiate only the witness type; no file-local RA parameter is treated + * as a matchable term variable. Exact alpha-comparison then checks the + * application head. */ + proof_try_begin(); + term expected = mk_icomb(sl_exists(), application.tm2); + bool failed = NOT_OK; + if (failed) SET_OK(); + proof_try_end(); + return !failed && alpha_compare(expected, tm) == 0; } PROOF term mk_sl_exists(const term v, const term hp) { - term res_tm = mk_binder(sl_exists_str(), v, hp); + ENSURE_COND(is_var(v), "Term(`%s`) is not a variable", string_of_term(v)); + ENSURE_COND(is_sl_prop(hp), + "Term(`%s`) is not a separation logic proposition", + string_of_term(hp)); + term family = mk_abs(v, hp); + term res_tm = mk_icomb(sl_exists(), family); return res_tm; err: ERR_FUN_PUTS("mk_sl_exists", cstr_term(v), cstr_term(hp)); @@ -144,8 +806,11 @@ err: } PROOF dest_binder_results dest_sl_exists(const term hp) { - dest_binder_results res = dest_binder(sl_exists_str(), hp); - return res; + ENSURE_COND(is_sl_exists(hp), + "Term(`%s`) is not an SL existential", string_of_term(hp)); + dest_comb_results application = dest_comb(hp); + dest_abs_results abstraction = dest_abs(application.tm2); + return (dest_binder_results){abstraction.v, abstraction.tm}; err: ERR_FUN_PUTS("dest_sl_exists", cstr_term(hp)); return (dest_binder_results){empty_term, empty_term}; @@ -165,6 +830,42 @@ err: return empty_term; } +PROOF bool is_sl_forall(const term tm) { + if (!is_comb(tm)) return false; + dest_comb_results application = dest_comb(tm); + if (!is_abs(application.tm2)) return false; + + proof_try_begin(); + term expected = mk_icomb(sl_forall(), application.tm2); + bool failed = NOT_OK; + if (failed) SET_OK(); + proof_try_end(); + return !failed && alpha_compare(expected, tm) == 0; +} + +PROOF term mk_sl_forall(const term v, const term hp) { + ENSURE_COND(is_var(v), "Term(`%s`) is not a variable", string_of_term(v)); + ENSURE_COND(is_sl_prop(hp), + "Term(`%s`) is not a separation logic proposition", + string_of_term(hp)); + term family = mk_abs(v, hp); + return mk_icomb(sl_forall(), family); +err: + ERR_FUN_PUTS("mk_sl_forall", cstr_term(v), cstr_term(hp)); + return empty_term; +} + +PROOF dest_binder_results dest_sl_forall(const term hp) { + ENSURE_COND(is_sl_forall(hp), + "Term(`%s`) is not an SL universal", string_of_term(hp)); + dest_comb_results application = dest_comb(hp); + dest_abs_results abstraction = dest_abs(application.tm2); + return (dest_binder_results){abstraction.v, abstraction.tm}; +err: + ERR_FUN_PUTS("dest_sl_forall", cstr_term(hp)); + return (dest_binder_results){empty_term, empty_term}; +} + PROOF strip_sl_exists_results strip_sl_exists(const term hp) { ENSURE_COND(is_sl_prop(hp), "Term(`%s`) is not a separation logic proposition", @@ -183,6 +884,70 @@ err: return (strip_sl_exists_results){NULL, empty_term}; } +PROOF bool is_sl_bupd(const term tm) { + if (!sl_update_theory_is_installed() || !is_comb(tm)) return false; + const sl_update_theory* update = &active_sl_update_theory; + dest_comb_results application = dest_comb(tm); + bool result = equals_term(application.tm1, update->bupd); + return result; +} + +PROOF term mk_sl_bupd(const term hp) { + bool hp_is_prop = is_sl_prop(hp); + ENSURE_COND(hp_is_prop, + "Term(`%s`) is not an active SL assertion", + string_of_term(hp)); + const sl_update_theory* update = sl_current_update_theory(); + term result = mk_comb(update->bupd, hp); + return result; +err: + ERR_FUN_PUTS("mk_sl_bupd", cstr_term(hp)); + return empty_term; +} + +PROOF term dest_sl_bupd(const term tm) { + bool tm_is_bupd = is_sl_bupd(tm); + ENSURE_COND(tm_is_bupd, "Term(`%s`) is not a basic update", + string_of_term(tm)); + dest_comb_results application = dest_comb(tm); + return application.tm2; +err: + ERR_FUN_PUTS("dest_sl_bupd", cstr_term(tm)); + return empty_term; +} + +PROOF bool is_sl_viewshift(const term tm) { + if (!sl_update_theory_is_installed()) return false; + const sl_update_theory* update = &active_sl_update_theory; + bool result = is_binop(update->viewshift, tm); + return result; +} + +PROOF term mk_sl_viewshift(const term hp1, const term hp2) { + bool hp1_is_prop = is_sl_prop(hp1); + bool hp2_is_prop = is_sl_prop(hp2); + ENSURE_COND(hp1_is_prop && hp2_is_prop, + "View-shift endpoints must have the active assertion type"); + const sl_update_theory* update = sl_current_update_theory(); + term result = mk_binop(update->viewshift, hp1, hp2); + return result; +err: + ERR_FUN_PUTS("mk_sl_viewshift", cstr_term(hp1), cstr_term(hp2)); + return empty_term; +} + +PROOF dest_binop_results dest_sl_viewshift(const term tm) { + bool tm_is_viewshift = is_sl_viewshift(tm); + ENSURE_COND(tm_is_viewshift, "Term(`%s`) is not a view shift", + string_of_term(tm)); + const sl_update_theory* update = sl_current_update_theory(); + dest_binop_results result = dest_binop(update->viewshift, tm); + return result; +err: + ERR_FUN_PUTS("dest_sl_viewshift", cstr_term(tm)); + return (dest_binop_results){empty_term, empty_term}; +} + PROOF bool is_sl_ent(const term tm) { return is_binop(sl_ent(), tm); } @@ -203,6 +968,26 @@ err: return (dest_binop_results){empty_term, empty_term}; } +PROOF bool is_sl_equiv(const term tm) { + return is_binop(sl_equiv(), tm); +} + +PROOF term mk_sl_equiv(const term hp1, const term hp2) { + term res_tm = mk_binop(sl_equiv(), hp1, hp2); + return res_tm; +err: + ERR_FUN_PUTS("mk_sl_equiv", cstr_term(hp1), cstr_term(hp2)); + return empty_term; +} + +PROOF dest_binop_results dest_sl_equiv(const term tm) { + dest_binop_results res = dest_binop(sl_equiv(), tm); + return res; +err: + ERR_FUN_PUTS("dest_sl_equiv", cstr_term(tm)); + return (dest_binop_results){empty_term, empty_term}; +} + PROOF bool is_sl_eq(const term tm) { return is_binop(sl_eq(), tm); } @@ -276,7 +1061,7 @@ PROOF term_list strip_sl_resources(const term hp) { return resources; } -PROOF thm prove_sl_ent_sym_left() { +PROOF static thm prove_sl_ent_sym_left(void) { thm ent_refl_th = sl_ent_refl(); term hp1 = mk_sl_prop("hp1"); term hp2 = mk_sl_prop("hp2"); @@ -294,9 +1079,7 @@ PROOF thm prove_sl_ent_sym_left() { return res_th; } -SL_THM_LAZY_INIT(sl_ent_sym_left, "!hp1 hp2. (hp1 = hp2) ==> (hp1 |-- hp2)"); - -PROOF thm prove_sl_ent_restate() { +PROOF static thm prove_sl_ent_restate(void) { term original_h = mk_sl_prop("original_h"); term current_h = mk_sl_prop("current_h"); term original_k = mk_sl_prop("original_k"); @@ -323,14 +1106,7 @@ PROOF thm prove_sl_ent_restate() { return generalized; } -SL_THM_LAZY_INIT( - sl_ent_restate, - "!(original_h:hprop) (current_h:hprop) (original_k:hprop) " - "(current_k:hprop). (original_h -|- current_h) ==> " - "(original_k -|- current_k) ==> (current_h |-- current_k) ==> " - "(original_h |-- original_k)"); - -PROOF thm prove_sl_frame_restate() { +PROOF static thm prove_sl_frame_restate(void) { term original_h = mk_sl_prop("original_h"); term frame = mk_sl_prop("frame"); term child_h = mk_sl_prop("child_h"); @@ -345,7 +1121,7 @@ PROOF thm prove_sl_frame_restate() { thm child_ent = assume_rule(child_ent_tm); thm framed = frame_left_slrule(frame, child_ent); - thm result = list_match_mp_rule(sl_ent_restate(), + thm result = list_match_mp_rule(sl_ent_restate, THM_LIST(h_eq, k_eq, framed)); result = disch_rule(child_ent_tm, result); result = disch_rule(k_eq_tm, result); @@ -355,15 +1131,7 @@ PROOF thm prove_sl_frame_restate() { return generalized; } -SL_THM_LAZY_INIT( - sl_frame_restate, - "!(original_h:hprop) (frame:hprop) (child_h:hprop) " - "(original_k:hprop) (child_k:hprop). " - "(original_h -|- frame ** child_h) ==> " - "(original_k -|- frame ** child_k) ==> (child_h |-- child_k) ==> " - "(original_h |-- original_k)"); - -PROOF thm prove_sl_ent_frame_left() { +PROOF static thm prove_sl_ent_frame_left(void) { thm sep_mono_th = sl_sep_mono(); term hp1 = mk_sl_prop("hp1"); term hp2 = mk_sl_prop("hp2"); @@ -378,10 +1146,7 @@ PROOF thm prove_sl_ent_frame_left() { return res_th; } -SL_THM_LAZY_INIT(sl_ent_frame_left, - "!hp1 hp2 hp3. (hp1 |-- hp2) ==> (hp3 ** hp1 |-- hp3 ** hp2)"); - -PROOF thm prove_sl_ent_frame_right() { +PROOF static thm prove_sl_ent_frame_right(void) { thm sep_mono_th = sl_sep_mono(); term hp1 = mk_sl_prop("hp1"); term hp2 = mk_sl_prop("hp2"); @@ -396,10 +1161,7 @@ PROOF thm prove_sl_ent_frame_right() { return res_th; } -SL_THM_LAZY_INIT(sl_ent_frame_right, - "!hp1 hp2 hp3. (hp1 |-- hp2) ==> (hp1 ** hp3 |-- hp2 ** hp3)"); - -PROOF thm prove_sl_ent_subst_frame() { +PROOF static thm prove_sl_ent_subst_frame(void) { term old_hp = mk_sl_prop("old_hp"); term new_hp = mk_sl_prop("new_hp"); term frame = mk_sl_prop("frame"); @@ -426,14 +1188,7 @@ PROOF thm prove_sl_ent_subst_frame() { return generalized; } -SL_THM_LAZY_INIT( - sl_ent_subst_frame, - "!(old_hp:hprop) (new_hp:hprop) (frame:hprop) (current:hprop) " - "(hcon:hprop). (old_hp -|- new_hp) ==> " - "(current -|- new_hp ** frame) ==> (current |-- hcon) ==> " - "(old_hp ** frame |-- hcon)"); - -PROOF thm prove_sl_sep_combine() { +PROOF static thm prove_sl_sep_combine(void) { term parent_h = mk_sl_prop("parent_h"); term child_h1 = mk_sl_prop("child_h1"); term child_h2 = mk_sl_prop("child_h2"); @@ -452,7 +1207,7 @@ PROOF thm prove_sl_sep_combine() { thm combined = frame_mono_slrule(child1, child2); thm result = list_match_mp_rule( - sl_ent_restate(), THM_LIST(h_eq, k_eq, combined)); + sl_ent_restate, THM_LIST(h_eq, k_eq, combined)); result = disch_rule(child2_tm, result); result = disch_rule(child1_tm, result); result = disch_rule(k_eq_tm, result); @@ -463,16 +1218,7 @@ PROOF thm prove_sl_sep_combine() { return generalized; } -SL_THM_LAZY_INIT( - sl_sep_combine, - "!(parent_h:hprop) (child_h1:hprop) (child_h2:hprop) " - "(parent_k:hprop) (child_k1:hprop) (child_k2:hprop). " - "(parent_h -|- child_h1 ** child_h2) ==> " - "(parent_k -|- child_k1 ** child_k2) ==> " - "(child_h1 |-- child_k1) ==> (child_h2 |-- child_k2) ==> " - "(parent_h |-- parent_k)"); - -PROOF thm prove_sl_ac_rule() { +PROOF static thm prove_sl_ac_rule(void) { term hp1 = mk_sl_prop("hp1"); term hp2 = mk_sl_prop("hp2"); term hp3 = mk_sl_prop("hp3"); @@ -488,12 +1234,6 @@ PROOF thm prove_sl_ac_rule() { return conj_rule(sl_sep_comm(), conj_rule(sl_sep_assoc(), left_comm)); } -SL_THM_LAZY_INIT(sl_ac_rule, - "(!hp1 hp2. (hp1 ** hp2) = (hp2 ** hp1)) &&" - "(!hp1 hp2 hp3. ((hp1 ** hp2) ** hp3) = " - "(hp1 ** hp2 ** hp3)) &&" - "(!hp1 hp2 hp3. (hp1 ** hp2 ** hp3) = " - "(hp2 ** hp1 ** hp3))"); /* * Basic entailment/equality rules @@ -522,15 +1262,16 @@ PROOF thm trans_slrule(const thm ent1, const thm ent2) { string_of_thm(ent2)); thm trans_th = sl_ent_trans(); - thm res_ent = list_match_mp_rule(trans_th, THM_LIST(ent1, ent2)); - return res_ent; + thm_list premises = THM_LIST(ent1, ent2); + thm result = list_match_mp_rule(trans_th, premises); + return result; err: ERR_FUN_PUTS("trans_slrule", cstr_thm(ent1), cstr_thm(ent2)); return empty_theorem; } PROOF thm eq2ent(const thm eq) { - thm eq2ent_th = sl_ent_sym_left(); + thm eq2ent_th = sl_ent_sym_left; thm res_ent = match_mp_rule(eq2ent_th, eq); return res_ent; err: @@ -538,7 +1279,7 @@ err: return empty_theorem; } -PROOF thm antisym_slrule(const thm ent1, const thm ent2) { +PROOF thm equiv_slrule(const thm ent1, const thm ent2) { term ent1_tm = concl(ent1); term ent2_tm = concl(ent2); dest_binop_results ent1_dest = dest_sl_ent(ent1_tm); @@ -548,16 +1289,276 @@ PROOF thm antisym_slrule(const thm ent1, const thm ent2) { "Theorems(`%s`, `%s`) are not antisymmetric", string_of_thm(ent1), string_of_thm(ent2)); - thm antisym_th = sl_ent_antisym(); - thm res_ent = list_match_mp_rule(antisym_th, THM_LIST(ent1, ent2)); - return res_ent; + thm equiv_intro = sl_equiv_intro(); + thm res_equiv = + list_match_mp_rule(equiv_intro, THM_LIST(ent1, ent2)); + return res_equiv; +err: + ERR_FUN_PUTS("equiv_slrule", cstr_thm(ent1), cstr_thm(ent2)); + return empty_theorem; +} + +PROOF thm antisym_slrule(const thm ent1, const thm ent2) { + thm result = equiv_slrule(ent1, ent2); + return result; err: ERR_FUN_PUTS("antisym_slrule", cstr_thm(ent1), cstr_thm(ent2)); return empty_theorem; } +PROOF thm bupd_intro_slrule(const term hp) { + bool hp_is_prop = is_sl_prop(hp); + ENSURE_COND(hp_is_prop, + "Term(`%s`) is not an active SL assertion", + string_of_term(hp)); + thm primitive = sl_bupd_intro_primitive(); + thm result = ispec_rule(hp, primitive); + return result; +err: + ERR_FUN_PUTS("bupd_intro_slrule", cstr_term(hp)); + return empty_theorem; +} + +PROOF thm bupd_mono_slrule(const thm ent) { + term ent_ccl = concl(ent); + dest_binop_results endpoints = dest_sl_ent(ent_ccl); + thm primitive = sl_bupd_mono_primitive(); + thm instance = + ispecl_rule(TERM_LIST(endpoints.tm1, endpoints.tm2), primitive); + thm result = match_mp_rule(instance, ent); + return result; +err: + ERR_FUN_PUTS("bupd_mono_slrule", cstr_thm(ent)); + return empty_theorem; +} + +PROOF thm bupd_idem_slrule(const term hp) { + bool hp_is_prop = is_sl_prop(hp); + ENSURE_COND(hp_is_prop, + "Term(`%s`) is not an active SL assertion", + string_of_term(hp)); + thm primitive = sl_bupd_idem_primitive(); + thm result = ispec_rule(hp, primitive); + return result; +err: + ERR_FUN_PUTS("bupd_idem_slrule", cstr_term(hp)); + return empty_theorem; +} + +PROOF thm bupd_frame_slrule(const term hp, const term frame) { + bool hp_is_prop = is_sl_prop(hp); + bool frame_is_prop = is_sl_prop(frame); + ENSURE_COND(hp_is_prop && frame_is_prop, + "Basic-update frame endpoints must be active SL assertions"); + thm primitive = sl_bupd_frame_primitive(); + thm result = ispecl_rule(TERM_LIST(hp, frame), primitive); + return result; +err: + ERR_FUN_PUTS("bupd_frame_slrule", cstr_term(hp), cstr_term(frame)); + return empty_theorem; +} + +PROOF thm viewshift_refl_slrule(const term hp) { + bool hp_is_prop = is_sl_prop(hp); + ENSURE_COND(hp_is_prop, + "Term(`%s`) is not an active SL assertion", + string_of_term(hp)); + thm primitive = sl_viewshift_refl_primitive(); + thm result = ispec_rule(hp, primitive); + return result; +err: + ERR_FUN_PUTS("viewshift_refl_slrule", cstr_term(hp)); + return empty_theorem; +} + +PROOF thm entails_viewshift_slrule(const thm ent) { + term ent_ccl = concl(ent); + dest_binop_results endpoints = dest_sl_ent(ent_ccl); + thm primitive = sl_entails_viewshift_primitive(); + thm instance = + ispecl_rule(TERM_LIST(endpoints.tm1, endpoints.tm2), primitive); + thm result = match_mp_rule(instance, ent); + return result; +err: + ERR_FUN_PUTS("entails_viewshift_slrule", cstr_thm(ent)); + return empty_theorem; +} + +PROOF thm viewshift_trans_slrule(const thm first, const thm second) { + term first_ccl = concl(first); + dest_binop_results first_endpoints = dest_sl_viewshift(first_ccl); + term second_ccl = concl(second); + dest_binop_results second_endpoints = dest_sl_viewshift(second_ccl); + int endpoint_order = + alpha_compare(first_endpoints.tm2, second_endpoints.tm1); + ENSURE_COND(endpoint_order == 0, "View shifts are not composable"); + + thm primitive = sl_viewshift_trans_primitive(); + thm instance = ispecl_rule( + TERM_LIST(first_endpoints.tm1, first_endpoints.tm2, + second_endpoints.tm2), + primitive); + thm after_first = match_mp_rule(instance, first); + thm result = match_mp_rule(after_first, second); + return result; +err: + ERR_FUN_PUTS("viewshift_trans_slrule", cstr_thm(first), cstr_thm(second)); + return empty_theorem; +} + +PROOF thm viewshift_mono_slrule(const thm pre_ent, const thm change, + const thm post_ent) { + term pre_ccl = concl(pre_ent); + dest_binop_results pre = dest_sl_ent(pre_ccl); + term change_ccl = concl(change); + dest_binop_results middle = dest_sl_viewshift(change_ccl); + term post_ccl = concl(post_ent); + dest_binop_results post = dest_sl_ent(post_ccl); + int pre_order = alpha_compare(pre.tm2, middle.tm1); + int post_order = alpha_compare(middle.tm2, post.tm1); + ENSURE_COND(pre_order == 0 && post_order == 0, + "View-shift consequence theorems do not share endpoints"); + + thm primitive = sl_viewshift_mono_primitive(); + thm instance = ispecl_rule( + TERM_LIST(pre.tm1, pre.tm2, middle.tm2, post.tm2), primitive); + thm after_pre = match_mp_rule(instance, pre_ent); + thm after_change = match_mp_rule(after_pre, change); + thm result = match_mp_rule(after_change, post_ent); + return result; +err: + ERR_FUN_PUTS("viewshift_mono_slrule", cstr_thm(pre_ent), + cstr_thm(change), cstr_thm(post_ent)); + return empty_theorem; +} + +PROOF thm viewshift_frame_slrule(const thm change, const term frame) { + term change_ccl = concl(change); + dest_binop_results endpoints = dest_sl_viewshift(change_ccl); + bool frame_is_prop = is_sl_prop(frame); + ENSURE_COND(frame_is_prop, + "Term(`%s`) is not an active SL assertion", + string_of_term(frame)); + thm primitive = sl_viewshift_frame_primitive(); + thm instance = ispecl_rule( + TERM_LIST(endpoints.tm1, endpoints.tm2, frame), primitive); + thm result = match_mp_rule(instance, change); + return result; +err: + ERR_FUN_PUTS("viewshift_frame_slrule", cstr_thm(change), + cstr_term(frame)); + return empty_theorem; +} + +PROOF thm viewshift_sep_slrule(const thm first, const thm second) { + term first_ccl = concl(first); + dest_binop_results first_endpoints = dest_sl_viewshift(first_ccl); + term second_ccl = concl(second); + dest_binop_results second_endpoints = dest_sl_viewshift(second_ccl); + thm primitive = sl_viewshift_sep_primitive(); + thm instance = ispecl_rule( + TERM_LIST(first_endpoints.tm1, first_endpoints.tm2, + second_endpoints.tm1, second_endpoints.tm2), + primitive); + thm after_first = match_mp_rule(instance, first); + thm result = match_mp_rule(after_first, second); + return result; +err: + ERR_FUN_PUTS("viewshift_sep_slrule", cstr_thm(first), cstr_thm(second)); + return empty_theorem; +} + +/* Contract only the four family applications introduced by specializing a + * pointwise existential law: + * + * (!x. (\v. H) x REL (\v. K) x) ==> + * EX (\x. (\v. H) x) REL EX (\x. (\v. K) x). + * + * The conversion never descends into H or K, so beta-redexes already present + * in caller assertions remain part of their exact syntax. */ +PROOF static thm beta_pointwise_family_instance(const thm instance) { + conv beta = get_conversion_by_name("BETA_CONV"); + conv premise = land_conv(binder_conv(binop_conv(beta))); + conv endpoints = rand_conv(binop_conv(binder_conv(beta))); + thm result = conv_rule(then_conv(premise, endpoints), instance); + return result; +err: + ERR_FUN_PUTS("beta_pointwise_family_instance", cstr_thm(instance)); + return empty_theorem; +} + +PROOF thm viewshift_exists_slrule(const thm pointwise) { + term pointwise_ccl = concl(pointwise); + dest_forall_results quantified = dest_forall(pointwise_ccl); + term witness = quantified.v; + dest_binop_results endpoints = dest_sl_viewshift(quantified.tm); + term source_family = mk_abs(witness, endpoints.tm1); + term target_family = mk_abs(witness, endpoints.tm2); + + thm primitive = sl_viewshift_exists_primitive(); + thm instance = ispecl_rule( + TERM_LIST(source_family, target_family), primitive); + instance = beta_pointwise_family_instance(instance); + thm result = match_mp_rule(instance, pointwise); + term exact_source = mk_sl_exists(witness, endpoints.tm1); + term exact_target = mk_sl_exists(witness, endpoints.tm2); + term exact_conclusion = mk_sl_viewshift(exact_source, exact_target); + term actual_conclusion = concl(result); + ENSURE_COND(alpha_compare(actual_conclusion, exact_conclusion) == 0, + "Existential view shift has conclusion `%s`; expected `%s`", + string_of_term(actual_conclusion), + string_of_term(exact_conclusion)); + if (!equals_term(actual_conclusion, exact_conclusion)) { + thm alignment = alpha_rule(actual_conclusion, exact_conclusion); + result = eq_mp_rule(alignment, result); + } + return result; +err: + ERR_FUN_PUTS("viewshift_exists_slrule", cstr_thm(pointwise)); + return empty_theorem; +} + +PROOF thm viewshift_frame_at_slrule(const thm change, + const term whole_source) { + term change_ccl = concl(change); + dest_binop_results change_endpoints = dest_sl_viewshift(change_ccl); + bool whole_source_is_prop = is_sl_prop(whole_source); + ENSURE_COND(whole_source_is_prop, + "Complete view-shift source is not an active SL assertion"); + + thm lifted = sep_lift_slrule(whole_source, change_endpoints.tm1); + term lifted_ccl = concl(lifted); + dest_binop_results lift_endpoints = dest_sl_eq(lifted_ccl); + dest_binop_results split = dest_sl_sep(lift_endpoints.tm2); + int source_order = alpha_compare(split.tm1, change_endpoints.tm1); + ENSURE_COND(source_order == 0, + "Extracted view-shift source is not alpha-equivalent to the change source"); + + thm framed = viewshift_frame_slrule(change, split.tm2); + term framed_ccl = concl(framed); + dest_binop_results framed_endpoints = dest_sl_viewshift(framed_ccl); + + type prop_type = sl_prop(); + term source = mk_var("__viewshift_complete_source", prop_type); + term viewshift_op = sl_viewshift(); + term relation_at_source = mk_comb(viewshift_op, source); + term relation_at_endpoint = + mk_comb(relation_at_source, framed_endpoints.tm2); + term relation_at_target = mk_abs(source, relation_at_endpoint); + thm proposition_eq_raw = ap_term_rule(relation_at_target, lifted); + conv beta = get_conversion_by_name("BETA_CONV"); + thm proposition_eq = conv_rule(binop_conv(beta), proposition_eq_raw); + thm symmetric_eq = sym_rule(proposition_eq); + thm result = eq_mp_rule(symmetric_eq, framed); + return result; +err: + ERR_FUN_PUTS("viewshift_frame_at_slrule", cstr_thm(change), + cstr_term(whole_source)); + return empty_theorem; +} + PROOF thm frame_left_slrule(const term hp, const thm ent) { - thm frame_left_th = sl_ent_frame_left(); + thm frame_left_th = sl_ent_frame_left; thm mid_th1 = match_mp_rule(frame_left_th, ent); thm res_ent = ispec_rule(hp, mid_th1); return res_ent; @@ -567,7 +1568,7 @@ err: } PROOF thm frame_right_slrule(const thm ent, const term hp) { - thm frame_right_th = sl_ent_frame_right(); + thm frame_right_th = sl_ent_frame_right; thm mid_th1 = match_mp_rule(frame_right_th, ent); thm res_ent = ispec_rule(hp, mid_th1); return res_ent; @@ -604,7 +1605,7 @@ err: } PROOF thm conj1_slrule(const thm ent) { - thm conj1_th = sl_conj1(); + thm conj1_th = sl_conj1; thm res_ent = match_mp_rule(conj1_th, ent); return res_ent; err: @@ -613,7 +1614,7 @@ err: } PROOF thm conj2_slrule(const thm ent) { - thm conj2_th = sl_conj2(); + thm conj2_th = sl_conj2; thm res_ent = match_mp_rule(conj2_th, ent); return res_ent; err: @@ -626,7 +1627,7 @@ PROOF thm disj1_slrule(const thm ent, const term hp) { dest_binop_results ent_dest = dest_sl_ent(ent_tm); term hant = ent_dest.tm1; term hcon = ent_dest.tm2; - thm disj1_th = sl_disj1_mono(); + thm disj1_th = sl_disj1_mono; thm inst = ispecl_rule(TERM_LIST(hant, hcon, hp), disj1_th); thm res_ent = match_mp_rule(inst, ent); return res_ent; @@ -640,7 +1641,7 @@ PROOF thm disj2_slrule(const term hp, const thm ent) { dest_binop_results ent_dest = dest_sl_ent(ent_tm); term hant = ent_dest.tm1; term hcon = ent_dest.tm2; - thm disj2_th = sl_disj2_mono(); + thm disj2_th = sl_disj2_mono; thm inst = ispecl_rule(TERM_LIST(hp, hant, hcon), disj2_th); thm res_ent = match_mp_rule(inst, ent); return res_ent; @@ -666,7 +1667,7 @@ err: return empty_theorem; } -PROOF thm prove_sl_disj_mono() { +PROOF static thm prove_sl_disj_mono(void) { thm or_intro1_th = sl_or_intro1(); thm or_intro2_th = sl_or_intro2(); thm or_elim_th = sl_or_elim(); @@ -704,12 +1705,7 @@ PROOF thm prove_sl_disj_mono() { return result; } -SL_THM_LAZY_INIT( - sl_disj_mono, - "!hp1 hp2 hp3 hp4. " - "(hp1 |-- hp3) ==> (hp2 |-- hp4) ==> ((hp1 || hp2) |-- (hp3 || hp4))"); - -PROOF thm prove_sl_or_elim_frame() { +PROOF static thm prove_sl_or_elim_frame(void) { term hp1 = mk_sl_prop("hp1"); term hp2 = mk_sl_prop("hp2"); term frame = mk_sl_prop("frame"); @@ -754,16 +1750,8 @@ PROOF thm prove_sl_or_elim_frame() { return generalized; } -SL_THM_LAZY_INIT( - sl_or_elim_frame, - "!(hp1:hprop) (hp2:hprop) (frame:hprop) (current1:hprop) " - "(current2:hprop) (parent_hp:hprop) (hcon:hprop). " - "(current1 -|- hp1 ** frame) ==> (current2 -|- hp2 ** frame) ==> " - "(parent_hp -|- (hp1 || hp2) ** frame) ==> (current1 |-- hcon) ==> " - "(current2 |-- hcon) ==> (parent_hp |-- hcon)"); - PROOF thm disj_mono_slrule(const thm ent1, const thm ent2) { - thm disj_mono_th = sl_disj_mono(); + thm disj_mono_th = sl_disj_mono; thm res_ent = list_match_mp_rule(disj_mono_th, THM_LIST(ent1, ent2)); return res_ent; err: @@ -771,37 +1759,130 @@ err: return empty_theorem; } -PROOF thm prove_sl_exists_elim_frame() { +PROOF static thm prove_sl_exists_elim_frame(void) { type a_type = mk_var_type("A"); term x = mk_var("x", a_type); - term body_fn = mk_var("body_fn", mk_fun_type(a_type, sl_prop())); + type proposition_type = sl_prop(); + type body_fn_type = mk_fun_type(a_type, proposition_type); + term body_fn = mk_var("body_fn", body_fn_type); term frame = mk_sl_prop("frame"); term hcon = mk_sl_prop("hcon"); term body = mk_comb(body_fn, x); term framed_body = mk_sl_sep(body, frame); - term premise_tm = mk_forall(x, mk_sl_ent(framed_body, hcon)); + term framed_entailment = mk_sl_ent(framed_body, hcon); + term premise_tm = mk_forall(x, framed_entailment); thm premise = assume_rule(premise_tm); term framed_body_fn = mk_abs(x, framed_body); - thm eliminate = - ispecl_rule(TERM_LIST(hcon, framed_body_fn), sl_exists_elim()); + thm exists_elim_th = sl_exists_elim(); + term_list eliminate_arguments = TERM_LIST(framed_body_fn, hcon); + thm eliminate = ispecl_rule(eliminate_arguments, exists_elim_th); eliminate = beta_rule(eliminate); thm eliminated = match_mp_rule(eliminate, premise); - thm pull_frame = - ispecl_rule(TERM_LIST(body_fn, frame), sl_sep_exists_left()); + term body_exists = mk_sl_exists(x, body); + thm pull_frame = sep_exists_left_slrule(body_exists, frame); thm pull_frame_ent = eq2ent(pull_frame); thm result = trans_slrule(pull_frame_ent, eliminated); result = disch_rule(premise_tm, result); - thm generalized = genl_rule(TERM_LIST(body_fn, frame, hcon), result); + term_list generalized_terms = TERM_LIST(body_fn, frame, hcon); + thm generalized = genl_rule(generalized_terms, result); return generalized; } -SL_THM_LAZY_INIT( - sl_exists_elim_frame, - "!(body_fn:A->hprop) (frame:hprop) (hcon:hprop). " - "(!x. body_fn x ** frame |-- hcon) ==> " - "((exists x. body_fn x) ** frame |-- hcon)"); +PROOF thm sep_exists_left_slrule(const term ehp, const term frame) { + dest_binder_results existential = dest_sl_exists(ehp); + ENSURE_COND(is_sl_prop(frame), + "Term(`%s`) is not an active SL assertion", + string_of_term(frame)); + + term family = dest_comb(ehp).tm2; + thm instance = ispecl_rule( + TERM_LIST(family, frame), sl_sep_exists_left()); + conv beta = get_conversion_by_name("BETA_CONV"); + conv source_application = + land_conv(land_conv(binder_conv(beta))); + conv target_application = + rand_conv(binder_conv(land_conv(beta))); + instance = conv_rule( + then_conv(source_application, target_application), instance); + + term exact_left = mk_sl_sep(ehp, frame); + dest_binop_results actual_endpoints = dest_sl_eq(concl(instance)); + term exact_right = actual_endpoints.tm2; + if (!var_free_in(existential.v, frame)) { + exact_right = mk_sl_exists( + existential.v, mk_sl_sep(existential.tm, frame)); + } else { + ENSURE_COND(is_sl_exists(exact_right), + "Instantiated left existential distribution lost its binder"); + dest_binder_results freshened = dest_sl_exists(exact_right); + ENSURE_COND(!var_free_in(freshened.v, frame), + "Instantiated left existential distribution captured its frame"); + } + term exact_conclusion = mk_sl_eq(exact_left, exact_right); + term actual_conclusion = concl(instance); + ENSURE_COND(alpha_compare(actual_conclusion, exact_conclusion) == 0, + "Instantiated left existential distribution has an unexpected " + "conclusion `%s`; expected `%s`", + string_of_term(actual_conclusion), + string_of_term(exact_conclusion)); + if (!equals_term(actual_conclusion, exact_conclusion)) { + thm alignment = alpha_rule(actual_conclusion, exact_conclusion); + instance = eq_mp_rule(alignment, instance); + } + return instance; +err: + ERR_FUN_PUTS("sep_exists_left_slrule", cstr_term(ehp), cstr_term(frame)); + return empty_theorem; +} + +PROOF thm sep_exists_right_slrule(const term frame, const term ehp) { + dest_binder_results existential = dest_sl_exists(ehp); + ENSURE_COND(is_sl_prop(frame), + "Term(`%s`) is not an active SL assertion", + string_of_term(frame)); + + term family = dest_comb(ehp).tm2; + thm instance = ispecl_rule( + TERM_LIST(frame, family), sl_sep_exists_right()); + conv beta = get_conversion_by_name("BETA_CONV"); + conv source_application = + land_conv(rand_conv(binder_conv(beta))); + conv target_application = + rand_conv(binder_conv(rand_conv(beta))); + instance = conv_rule( + then_conv(source_application, target_application), instance); + + term exact_left = mk_sl_sep(frame, ehp); + dest_binop_results actual_endpoints = dest_sl_eq(concl(instance)); + term exact_right = actual_endpoints.tm2; + if (!var_free_in(existential.v, frame)) { + exact_right = mk_sl_exists( + existential.v, mk_sl_sep(frame, existential.tm)); + } else { + ENSURE_COND(is_sl_exists(exact_right), + "Instantiated right existential distribution lost its binder"); + dest_binder_results freshened = dest_sl_exists(exact_right); + ENSURE_COND(!var_free_in(freshened.v, frame), + "Instantiated right existential distribution captured its frame"); + } + term exact_conclusion = mk_sl_eq(exact_left, exact_right); + term actual_conclusion = concl(instance); + ENSURE_COND(alpha_compare(actual_conclusion, exact_conclusion) == 0, + "Instantiated right existential distribution has an unexpected " + "conclusion `%s`; expected `%s`", + string_of_term(actual_conclusion), + string_of_term(exact_conclusion)); + if (!equals_term(actual_conclusion, exact_conclusion)) { + thm alignment = alpha_rule(actual_conclusion, exact_conclusion); + instance = eq_mp_rule(alignment, instance); + } + return instance; +err: + ERR_FUN_PUTS("sep_exists_right_slrule", cstr_term(frame), cstr_term(ehp)); + return empty_theorem; +} PROOF thm choose_slrule(const term v, const term ehp, const thm ent) { dest_binder_results ehp_dest = dest_sl_exists(ehp); @@ -828,8 +1909,14 @@ PROOF thm choose_slrule(const term v, const term ehp, const thm ent) { thm generalized = gen_rule(v, opened); term hp_fn = dest_comb(ehp).tm2; thm framed_elim = ispecl_rule( - TERM_LIST(hp_fn, frame, hcon), sl_exists_elim_frame()); - framed_elim = beta_rule(framed_elim); + TERM_LIST(hp_fn, frame, hcon), sl_exists_elim_frame); + conv beta = get_conversion_by_name("BETA_CONV"); + conv premise_application = + land_conv(binder_conv(land_conv(land_conv(beta)))); + conv source_application = + rand_conv(land_conv(land_conv(binder_conv(beta)))); + framed_elim = conv_rule( + then_conv(premise_application, source_application), framed_elim); thm result = match_mp_rule(framed_elim, generalized); if (vector_size(frames) == 0) { thm res_ent = rehant_slrule(result, ehp); @@ -848,11 +1935,16 @@ PROOF thm exists_slrule(const term ehp, const term wit, const thm ent) { term ent_tm = concl(ent); dest_binop_results ent_dest = dest_sl_ent(ent_tm); - thm exists_th = sl_exists_wit(); + thm exists_th = sl_exists_wit; term hant = ent_dest.tm1; term hcon_fn = mk_abs(ehp_dest.v, ehp_dest.tm); thm mid_th1 = ispecl_rule(TERM_LIST(wit, hant, hcon_fn), exists_th); - thm mid_th2 = beta_rule(mid_th1); + conv beta = get_conversion_by_name("BETA_CONV"); + conv premise_application = land_conv(rand_conv(beta)); + conv target_application = + rand_conv(rand_conv(binder_conv(beta))); + thm mid_th2 = conv_rule( + then_conv(premise_application, target_application), mid_th1); thm mid_th3 = match_mp_rule(mid_th2, ent); thm res_ent = rehcon_slrule(mid_th3, ehp); return res_ent; @@ -861,37 +1953,13 @@ err: return empty_theorem; } -PROOF static thm get_mp_eq_aux() { - static bool initialized = false; - static thm value; - if (!initialized) { - term statement = - parse_term("!A1 A2 B. ((A1 = A2) ==> (A1 ==> B) ==> A2 ==> B)"); - value = meson_solver((thm_list)vector_create(), statement); - initialized = true; - } - return value; -} - -PROOF static conv get_beta_eq_conv() { - static bool initialized = false; - static conv value; - if (!initialized) { - conv beta = get_conversion_by_name("BETA_CONV"); - conv beta_binop = binop_conv(beta); - value = binder_conv(beta_binop); - initialized = true; - } - return value; -} - PROOF thm exists_mono_slrule(const term v, const thm ent) { term ent_tm = concl(ent); dest_binop_results h_dest = dest_sl_ent(ent_tm); term hant = h_dest.tm1; term hcon = h_dest.tm2; - thm mono = sl_exists_mono(); + thm mono = sl_exists_mono_primitive(); // Wrap hant, hcon as functions \v. hant and \v. hcon term fn_hant = mk_abs(v, hant); @@ -899,15 +1967,15 @@ PROOF thm exists_mono_slrule(const term v, const thm ent) { // Instantiate hpA, hpA' with the function wrappers thm inst = ispecl_rule(TERM_LIST(fn_hant, fn_hcon), mono); - // inst: (!x. (\v. hant) x |-- (\v. hcon) x) ==> (hexists (\v. hant) |-- hexists (\v. hcon)) + inst = beta_pointwise_family_instance(inst); // GEN enforces that v is a variable and is not free in any hypothesis. thm gen = gen_rule(v, ent); - thm beta_equiv = - apply_conversion(get_beta_eq_conv(), dest_imp(concl(inst)).tm1); - // beta_equiv: !x. (\v. hant) x |-- (\v. hcon) x <=> !x. hant |-- hcon - thm res_ent = - list_match_mp_rule(get_mp_eq_aux(), THM_LIST(beta_equiv, inst, gen)); + thm res_ent = match_mp_rule(inst, gen); + term exact_hant = mk_sl_exists(v, hant); + term exact_hcon = mk_sl_exists(v, hcon); + res_ent = rehant_slrule(res_ent, exact_hant); + res_ent = rehcon_slrule(res_ent, exact_hcon); return res_ent; err: ERR_FUN_PUTS("exists_mono_slrule", cstr_term(v), cstr_thm(ent)); @@ -936,7 +2004,7 @@ err: return empty_theorem; } -PROOF thm prove_sl_undisch() { +PROOF static thm prove_sl_undisch(void) { thm wand_sep_adjoint_th = sl_wand_sep_adjoint(); term a = mk_sl_prop("a"); @@ -963,10 +2031,8 @@ PROOF thm prove_sl_undisch() { return result; } -SL_THM_LAZY_INIT(sl_undisch, "!a b c. (a |-- b -* c) ==> (a ** b |-- c)"); - PROOF thm elim_wand_slrule(const thm ent) { - thm undisch_th = sl_undisch(); + thm undisch_th = sl_undisch; thm res_ent = match_mp_rule(undisch_th, ent); return res_ent; err: @@ -974,9 +2040,7 @@ err: return empty_theorem; } -// === NEW: prove_sl_conj1, prove_sl_conj2, prove_sl_disj1_mono, prove_sl_disj2_mono === - -PROOF thm prove_sl_conj1() { +PROOF static thm prove_sl_conj1(void) { thm and_elim1_th = sl_and_elim1(); term a = mk_sl_prop("a"); term b = mk_sl_prop("b"); @@ -994,9 +2058,7 @@ PROOF thm prove_sl_conj1() { return result; } -SL_THM_LAZY_INIT(sl_conj1, "!a b c. (a |-- b && c) ==> (a |-- b)"); - -PROOF thm prove_sl_conj2() { +PROOF static thm prove_sl_conj2(void) { thm and_elim2_th = sl_and_elim2(); term a = mk_sl_prop("a"); term b = mk_sl_prop("b"); @@ -1014,9 +2076,7 @@ PROOF thm prove_sl_conj2() { return result; } -SL_THM_LAZY_INIT(sl_conj2, "!a b c. (a |-- b && c) ==> (a |-- c)"); - -PROOF thm prove_sl_disj1_mono() { +PROOF static thm prove_sl_disj1_mono(void) { thm or_intro1_th = sl_or_intro1(); term a = mk_sl_prop("a"); term b = mk_sl_prop("b"); @@ -1034,9 +2094,7 @@ PROOF thm prove_sl_disj1_mono() { return result; } -SL_THM_LAZY_INIT(sl_disj1_mono, "!a b c. (a |-- b) ==> (a |-- b || c)"); - -PROOF thm prove_sl_disj2_mono() { +PROOF static thm prove_sl_disj2_mono(void) { thm or_intro2_th = sl_or_intro2(); term a = mk_sl_prop("a"); term b = mk_sl_prop("b"); @@ -1054,8 +2112,6 @@ PROOF thm prove_sl_disj2_mono() { return result; } -SL_THM_LAZY_INIT(sl_disj2_mono, "!a b c. (b |-- c) ==> (b |-- a || c)"); - PROOF thm intro_fact_slrule(const thm th, const thm ent) { thm fact_intro_th = sl_fact_intro(); thm res_ent = list_match_mp_rule(fact_intro_th, THM_LIST(th, ent)); @@ -1075,62 +2131,322 @@ err: return empty_theorem; } -PROOF thm prove_sl_exists_wit() { +PROOF static thm prove_sl_exists_wit(void) { thm exists_intro_th = sl_exists_intro(); type a_type = mk_var_type("A"); term wit = mk_var("wit", a_type); term h = mk_sl_prop("h"); - term body_fn = mk_var("body_fn", mk_fun_type(a_type, sl_prop())); + type proposition_type = sl_prop(); + type body_fn_type = mk_fun_type(a_type, proposition_type); + term body_fn = mk_var("body_fn", body_fn_type); - term ent_tm = mk_sl_ent(h, mk_comb(body_fn, wit)); + term body_at_wit = mk_comb(body_fn, wit); + term ent_tm = mk_sl_ent(h, body_at_wit); thm ent_th = assume_rule(ent_tm); - // exists_intro: !x hp hpA. (hp |-- hpA x) ==> (hp |-- (exists x. hpA x)) - thm intro_inst = ispecl_rule(TERM_LIST(wit, h, body_fn), exists_intro_th); - // intro_inst: (h |-- body_fn wit) ==> (h |-- (exists x. body_fn x)) - - thm step1 = match_mp_rule(intro_inst, ent_th); + // exists_intro: !P witness. P witness |-- (exists x. P x) + term_list intro_arguments = TERM_LIST(body_fn, wit); + thm intro_inst = ispecl_rule(intro_arguments, exists_intro_th); + // Compose h |-- body_fn wit with the primitive introduction entailment. + thm step1 = trans_slrule(ent_th, intro_inst); thm step2 = disch_rule(ent_tm, step1); - thm result = genl_rule(TERM_LIST(wit, h, body_fn), step2); + term_list generalized_terms = TERM_LIST(wit, h, body_fn); + thm result = genl_rule(generalized_terms, step2); return result; } -SL_THM_LAZY_INIT( - sl_exists_wit, - "!wit (h: hprop) (body_fn: A -> hprop). (h |-- body_fn wit) ==> " - "(h |-- (exists x. body_fn x))"); - -// `|- !hpA hpA'. (!x:A. hpA x |-- hpA' x) ==> (hexists hpA) |-- (hexists hpA' ))` -PROOF thm prove_sl_exists_mono() { - // `|- !hpA hpA'. (!x:A. hpA x |-- hpA' x) ==> (exists x. hpA x) |-- (exists x. hpA' x))` - thm init = get_hexists_monotone(); - term hpA = `hpA:A->hprop`; - term hpA1 = `hpA':A->hprop`; - init = specl_rule(TERM_LIST(hpA, hpA1), init); - thm help = apply_conversion((get_conversion_by_name("ETA_CONV")), - `\(x:A). (hpA:A->hprop) x`); - help = mk_comb_rule(refl_rule(`hexists:(A->hprop)->hprop`), help); - help = gen_rule(hpA, help); - thm result = pure_rewrite_rule( - THM_LIST(spec_rule(hpA, help), spec_rule(hpA1, help)), init); - result = genl_rule(TERM_LIST(hpA, hpA1), result); - return result; -} +PROOF static int sl_build_derived_theorems(void) { + { + term H = mk_sl_prop("H"); + term K = mk_sl_prop("K"); + term premise = mk_sl_eq(H, K); + term conclusion = mk_sl_ent(H, K); + term expected = + list_mk_forall(TERM_LIST(H, K), mk_imp(premise, conclusion)); + thm proved = prove_sl_ent_sym_left(); + int status = sl_bind_exact_derived("sl_ent_sym_left", &sl_ent_sym_left, + proved, expected); + ENSURE_COND(status == 0, "Failed to bind sl_ent_sym_left"); + } + + { + term H = mk_sl_prop("H"); + term K = mk_sl_prop("K"); + term F = mk_sl_prop("F"); + term premise = mk_sl_ent(H, K); + term conclusion = mk_sl_ent(mk_sl_sep(F, H), mk_sl_sep(F, K)); + term expected = + list_mk_forall(TERM_LIST(H, K, F), mk_imp(premise, conclusion)); + thm proved = prove_sl_ent_frame_left(); + int status = sl_bind_exact_derived("sl_ent_frame_left", &sl_ent_frame_left, + proved, expected); + ENSURE_COND(status == 0, "Failed to bind sl_ent_frame_left"); + } -SL_THM_LAZY_INIT(sl_exists_mono, - "forall hpA:A->hprop hpA'. (forall x. hpA x |-- hpA' x) ==> " - "((exists) hpA |-- (exists) hpA')"); + { + term H = mk_sl_prop("H"); + term K = mk_sl_prop("K"); + term F = mk_sl_prop("F"); + term premise = mk_sl_ent(H, K); + term conclusion = mk_sl_ent(mk_sl_sep(H, F), mk_sl_sep(K, F)); + term expected = + list_mk_forall(TERM_LIST(H, K, F), mk_imp(premise, conclusion)); + thm proved = prove_sl_ent_frame_right(); + int status = sl_bind_exact_derived("sl_ent_frame_right", + &sl_ent_frame_right, proved, expected); + ENSURE_COND(status == 0, "Failed to bind sl_ent_frame_right"); + } + + { + term H = mk_sl_prop("H"); + term H1 = mk_sl_prop("H1"); + term K = mk_sl_prop("K"); + term K1 = mk_sl_prop("K1"); + term H_eq = mk_sl_eq(H, H1); + term K_eq = mk_sl_eq(K, K1); + term child = mk_sl_ent(H1, K1); + term conclusion = mk_sl_ent(H, K); + term body = mk_imp(H_eq, mk_imp(K_eq, mk_imp(child, conclusion))); + term expected = list_mk_forall(TERM_LIST(H, H1, K, K1), body); + thm proved = prove_sl_ent_restate(); + int status = sl_bind_exact_derived("sl_ent_restate", &sl_ent_restate, + proved, expected); + ENSURE_COND(status == 0, "Failed to bind sl_ent_restate"); + } + + { + term H = mk_sl_prop("H"); + term F = mk_sl_prop("F"); + term H1 = mk_sl_prop("H1"); + term K = mk_sl_prop("K"); + term K1 = mk_sl_prop("K1"); + term H_eq = mk_sl_eq(H, mk_sl_sep(F, H1)); + term K_eq = mk_sl_eq(K, mk_sl_sep(F, K1)); + term child = mk_sl_ent(H1, K1); + term conclusion = mk_sl_ent(H, K); + term body = mk_imp(H_eq, mk_imp(K_eq, mk_imp(child, conclusion))); + term expected = list_mk_forall(TERM_LIST(H, F, H1, K, K1), body); + thm proved = prove_sl_frame_restate(); + int status = sl_bind_exact_derived("sl_frame_restate", &sl_frame_restate, + proved, expected); + ENSURE_COND(status == 0, "Failed to bind sl_frame_restate"); + } + + { + term H = mk_sl_prop("H"); + term K = mk_sl_prop("K"); + term F = mk_sl_prop("F"); + term C = mk_sl_prop("C"); + term G = mk_sl_prop("G"); + term H_eq = mk_sl_eq(H, K); + term C_eq = mk_sl_eq(C, mk_sl_sep(K, F)); + term child = mk_sl_ent(C, G); + term conclusion = mk_sl_ent(mk_sl_sep(H, F), G); + term body = mk_imp(H_eq, mk_imp(C_eq, mk_imp(child, conclusion))); + term expected = list_mk_forall(TERM_LIST(H, K, F, C, G), body); + thm proved = prove_sl_ent_subst_frame(); + int status = sl_bind_exact_derived("sl_ent_subst_frame", + &sl_ent_subst_frame, proved, expected); + ENSURE_COND(status == 0, "Failed to bind sl_ent_subst_frame"); + } + + { + term H = mk_sl_prop("H"); + term H1 = mk_sl_prop("H1"); + term H2 = mk_sl_prop("H2"); + term K = mk_sl_prop("K"); + term K1 = mk_sl_prop("K1"); + term K2 = mk_sl_prop("K2"); + term H_eq = mk_sl_eq(H, mk_sl_sep(H1, H2)); + term K_eq = mk_sl_eq(K, mk_sl_sep(K1, K2)); + term child1 = mk_sl_ent(H1, K1); + term child2 = mk_sl_ent(H2, K2); + term conclusion = mk_sl_ent(H, K); + term body = + mk_imp(H_eq, mk_imp(K_eq, mk_imp(child1, mk_imp(child2, conclusion)))); + term expected = list_mk_forall(TERM_LIST(H, H1, H2, K, K1, K2), body); + thm proved = prove_sl_sep_combine(); + int status = sl_bind_exact_derived("sl_sep_combine", &sl_sep_combine, + proved, expected); + ENSURE_COND(status == 0, "Failed to bind sl_sep_combine"); + } + + { + term H = mk_sl_prop("H"); + term K = mk_sl_prop("K"); + term F = mk_sl_prop("F"); + term left_comm = + mk_sl_eq(mk_sl_sep(H, mk_sl_sep(K, F)), mk_sl_sep(K, mk_sl_sep(H, F))); + term left_comm_law = list_mk_forall(TERM_LIST(H, K, F), left_comm); + term expected = mk_conj(concl(sl_sep_comm()), + mk_conj(concl(sl_sep_assoc()), left_comm_law)); + thm proved = prove_sl_ac_rule(); + int status = + sl_bind_exact_derived("sl_ac_rule", &sl_ac_rule, proved, expected); + ENSURE_COND(status == 0, "Failed to bind sl_ac_rule"); + } + + { + term H1 = mk_sl_prop("H1"); + term H2 = mk_sl_prop("H2"); + term K1 = mk_sl_prop("K1"); + term K2 = mk_sl_prop("K2"); + term premise1 = mk_sl_ent(H1, K1); + term premise2 = mk_sl_ent(H2, K2); + term conclusion = mk_sl_ent(mk_sl_or(H1, H2), mk_sl_or(K1, K2)); + term body = mk_imp(premise1, mk_imp(premise2, conclusion)); + term expected = list_mk_forall(TERM_LIST(H1, H2, K1, K2), body); + thm proved = prove_sl_disj_mono(); + int status = + sl_bind_exact_derived("sl_disj_mono", &sl_disj_mono, proved, expected); + ENSURE_COND(status == 0, "Failed to bind sl_disj_mono"); + } + + { + term H = mk_sl_prop("H"); + term K = mk_sl_prop("K"); + term G = mk_sl_prop("G"); + term premise = mk_sl_ent(H, mk_sl_wand(K, G)); + term conclusion = mk_sl_ent(mk_sl_sep(H, K), G); + term expected = + list_mk_forall(TERM_LIST(H, K, G), mk_imp(premise, conclusion)); + thm proved = prove_sl_undisch(); + int status = + sl_bind_exact_derived("sl_undisch", &sl_undisch, proved, expected); + ENSURE_COND(status == 0, "Failed to bind sl_undisch"); + } + + { + term H = mk_sl_prop("H"); + term K = mk_sl_prop("K"); + term F = mk_sl_prop("F"); + term premise = mk_sl_ent(H, mk_sl_and(K, F)); + term conclusion = mk_sl_ent(H, K); + term expected = + list_mk_forall(TERM_LIST(H, K, F), mk_imp(premise, conclusion)); + thm proved = prove_sl_conj1(); + int status = sl_bind_exact_derived("sl_conj1", &sl_conj1, proved, expected); + ENSURE_COND(status == 0, "Failed to bind sl_conj1"); + } + + { + term H = mk_sl_prop("H"); + term K = mk_sl_prop("K"); + term F = mk_sl_prop("F"); + term premise = mk_sl_ent(H, mk_sl_and(K, F)); + term conclusion = mk_sl_ent(H, F); + term expected = + list_mk_forall(TERM_LIST(H, K, F), mk_imp(premise, conclusion)); + thm proved = prove_sl_conj2(); + int status = sl_bind_exact_derived("sl_conj2", &sl_conj2, proved, expected); + ENSURE_COND(status == 0, "Failed to bind sl_conj2"); + } + + { + term H = mk_sl_prop("H"); + term K = mk_sl_prop("K"); + term F = mk_sl_prop("F"); + term premise = mk_sl_ent(H, K); + term conclusion = mk_sl_ent(H, mk_sl_or(K, F)); + term expected = + list_mk_forall(TERM_LIST(H, K, F), mk_imp(premise, conclusion)); + thm proved = prove_sl_disj1_mono(); + int status = sl_bind_exact_derived("sl_disj1_mono", &sl_disj1_mono, proved, + expected); + ENSURE_COND(status == 0, "Failed to bind sl_disj1_mono"); + } + + { + term F = mk_sl_prop("F"); + term H = mk_sl_prop("H"); + term K = mk_sl_prop("K"); + term premise = mk_sl_ent(H, K); + term conclusion = mk_sl_ent(H, mk_sl_or(F, K)); + term expected = + list_mk_forall(TERM_LIST(F, H, K), mk_imp(premise, conclusion)); + thm proved = prove_sl_disj2_mono(); + int status = sl_bind_exact_derived("sl_disj2_mono", &sl_disj2_mono, proved, + expected); + ENSURE_COND(status == 0, "Failed to bind sl_disj2_mono"); + } + + { + type A = mk_var_type("A"); + term w = mk_var("w", A); + term H = mk_sl_prop("H"); + term B = mk_var("B", mk_fun_type(A, sl_prop())); + term x = mk_var("x", A); + term B_w = mk_comb(B, w); + term B_x = mk_comb(B, x); + term premise = mk_sl_ent(H, B_w); + term conclusion = mk_sl_ent(H, mk_sl_exists(x, B_x)); + term expected = + list_mk_forall(TERM_LIST(w, H, B), mk_imp(premise, conclusion)); + thm proved = prove_sl_exists_wit(); + int status = sl_bind_exact_derived("sl_exists_wit", &sl_exists_wit, proved, + expected); + ENSURE_COND(status == 0, "Failed to bind sl_exists_wit"); + } + + { + type A = mk_var_type("A"); + term B = mk_var("B", mk_fun_type(A, sl_prop())); + term F = mk_sl_prop("F"); + term K = mk_sl_prop("K"); + term x = mk_var("x", A); + term B_x = mk_comb(B, x); + term pointwise = mk_forall(x, mk_sl_ent(mk_sl_sep(B_x, F), K)); + term conclusion = mk_sl_ent(mk_sl_sep(mk_sl_exists(x, B_x), F), K); + term expected = + list_mk_forall(TERM_LIST(B, F, K), mk_imp(pointwise, conclusion)); + thm proved = prove_sl_exists_elim_frame(); + int status = sl_bind_exact_derived("sl_exists_elim_frame", + &sl_exists_elim_frame, proved, expected); + ENSURE_COND(status == 0, "Failed to bind sl_exists_elim_frame"); + } + + { + term H = mk_sl_prop("H"); + term K = mk_sl_prop("K"); + term F = mk_sl_prop("F"); + term C1 = mk_sl_prop("C1"); + term C2 = mk_sl_prop("C2"); + term P = mk_sl_prop("P"); + term G = mk_sl_prop("G"); + term C1_eq = mk_sl_eq(C1, mk_sl_sep(H, F)); + term C2_eq = mk_sl_eq(C2, mk_sl_sep(K, F)); + term P_eq = mk_sl_eq(P, mk_sl_sep(mk_sl_or(H, K), F)); + term branch1 = mk_sl_ent(C1, G); + term branch2 = mk_sl_ent(C2, G); + term conclusion = mk_sl_ent(P, G); + term body = mk_imp( + C1_eq, + mk_imp(C2_eq, + mk_imp(P_eq, mk_imp(branch1, mk_imp(branch2, conclusion))))); + term expected = list_mk_forall(TERM_LIST(H, K, F, C1, C2, P, G), body); + thm proved = prove_sl_or_elim_frame(); + int status = sl_bind_exact_derived("sl_or_elim_frame", &sl_or_elim_frame, + proved, expected); + ENSURE_COND(status == 0, "Failed to bind sl_or_elim_frame"); + } + + return 0; +err: + ERR_FUN_PUTS("sl_build_derived_theorems"); + return -1; +} PROOF static conv normalize_sl_conv() { - static bool initialized = false; + static size_t generation = 0; static conv value; - if (!initialized) { + size_t current_generation = sl_theory_generation(); + if (generation != current_generation) { value = pure_rewrite_conv(THM_LIST(sl_fact_true_emp(), sl_sep_emp_left(), sl_sep_emp_right())); - initialized = true; + generation = current_generation; } return value; } @@ -1140,8 +2456,8 @@ PROOF thm normalize_slrule(const term hp) { "Term(`%s`) is not a separation logic proposition", string_of_term(hp)); - conv cv = normalize_sl_conv(); - thm res_eq = apply_conversion(cv, hp); + conv unit_normalize = normalize_sl_conv(); + thm res_eq = apply_conversion(unit_normalize, hp); return res_eq; err: ERR_FUN_PUTS("normalize_slrule", cstr_term(hp)); @@ -1172,7 +2488,7 @@ PROOF thm ac_slrule(const term hp1, const term hp2) { thm res_eq = alpha_rule(hp1, hp2); return res_eq; } - thm res_eq = ac_rule(sl_ac_rule(), eq_tm); + thm res_eq = ac_rule(sl_ac_rule, eq_tm); return res_eq; err: ERR_FUN_PUTS("ac_slrule", cstr_term(hp1), cstr_term(hp2)); @@ -1280,7 +2596,7 @@ PROOF static thm duplicate_checked_fact_slrule(const term symhp, vector_remove(remaining, (vec_size_t)checked_index); term frame = list_mk_sl_sep(remaining); - thm duplicate = spec_rule(checked, get_hfact_dup()); + thm duplicate = spec_rule(checked, sl_fact_dup()); duplicate = frame_right_slrule(duplicate, frame); duplicate = rehant_slrule(duplicate, symhp); return rehcon_slrule(duplicate, mk_sl_sep(checked_fact, symhp)); diff --git a/proof_sl.h b/proof_sl.h index 94abbad..44846ec 100644 --- a/proof_sl.h +++ b/proof_sl.h @@ -1,20 +1,26 @@ /** * Separation-logic assertion constructors and proof rules. * - * This header inherits the theorem, alpha-equivalence, sequence, truth, and - * capture-avoiding-substitution notation of `proof_kernel.h`, together with - * the occurrence-sensitive sequence relations of `proof_user.h`. It uses the + * This header inherits the typing notation `t:τ` and theorem judgment + * `𝒜 ⊢ φ` from `proof_kernel.h`, together with its alpha-equivalence, + * sequence, truth, and capture-avoiding-substitution notation and the + * occurrence-sensitive sequence relations of `proof_user.h`. A C value of + * type `thm` is an opaque handle to such a theorem; writing that a function + * "returns `𝒜 ⊢ φ`" specifies the conclusion and hypotheses of the referenced + * HOL theorem, not the C function's return proposition. This header uses the * following SL-specific extension consistently: * - * - `H`, `K`, and `F` range over SL assertions of type `hprop`; `p` and `q` - * range over pure HOL propositions of type `bool`; `x` and `y` are HOL - * terms whose types are written `α` and `β`. + * - `H`, `K`, and `F` range over the active theory's assertion type + * `sl_prop()`; `p` and `q` range over pure HOL propositions of type `bool`; + * `x` and `y` are HOL terms whose types are written `α` and `β`. * - `H ** K`, `H -* K`, `H && K`, and `H || K` denote separating * conjunction, magic wand, additive conjunction, and additive disjunction. * `emp` is the separating unit, `fact(p)` embeds a pure proposition, and * `∃SL x. H` is SL existential quantification. - * - `H ⊢SL K` is SL entailment. `H =ₕ K` is ordinary HOL equality at - * `hprop`; C* assertion syntax also writes it `H -|- K`. + * - `H ⊢SL K` is SL entailment, `H ≃SL K` is the active theory's logical + * equivalence, `H ⇛ K` is an installed view shift, and `H = K` is raw HOL + * equality at `sl_prop()`. Thus `𝒜 ⊢ (H ⊢SL K)`, `𝒜 ⊢ (H ⇛ K)`, and + * `𝒜 ⊢ (H = K)` are three different HOL theorem shapes. * - For a sequence `S = [H₀, …, Hₙ₋₁]`, `Sep(S)` is its right-associated * separating product: `Sep([]) = emp`, `Sep([H]) = H`, and * `Sep(H::S) = H ** Sep(S)` for nonempty `S`. Likewise, @@ -39,153 +45,323 @@ #require "proof/proof_user.c" /** - * Late-bound constants and primitive theorems of the SL theory. + * One installable separation-logic signature. * - * The current bindings select the classical heap model. The macros below keep - * the user proof library independent of the concrete getter names. + * The terms are already-specialized HOL operators. In particular, an + * RA-backed client installs `r_emp R`, `r_sep R`, ... after selecting its + * file-local resource algebra. The proof library never unfolds those + * operators and therefore has no dependency on the carrier's implementation + * or on any bootstrapped physical-heap assertion constants. + * + * Operator fields have these HOL types, where `Prop = prop_type`: + * + * ```text + * emp : Prop + * sep, wand, and_op, or_op : Prop -> Prop -> Prop + * exists_op : (α -> Prop) -> Prop (exactly α remains polymorphic) + * entails, equiv : Prop -> Prop -> bool + * fact : bool -> Prop + * ``` + * + * The theorem fields are borrowed handles intended to have exactly these + * closed schemas (all displayed variables are universally quantified): + * + * ```text + * sep_emp_left: emp ** P = P + * sep_emp_right: P ** emp = P + * sep_assoc: (P ** Q) ** S = P ** (Q ** S) + * sep_comm: P ** Q = Q ** P + * sep_mono: (P ⊢SL P2) ⇒ (Q ⊢SL Q2) ⇒ + * (P ** Q ⊢SL P2 ** Q2) + * wand_sep_adjoint: (P ** Q ⊢SL S) ⇔ (P ⊢SL Q -* S) + * and_intro: (P ⊢SL Q) ⇒ (P ⊢SL S) ⇒ (P ⊢SL (Q && S)) + * and_elim1: P && Q ⊢SL P + * and_elim2: P && Q ⊢SL Q + * or_intro1: P ⊢SL (P || Q) + * or_intro2: Q ⊢SL (P || Q) + * or_elim: (P ⊢SL S) ⇒ (Q ⊢SL S) ⇒ ((P || Q) ⊢SL S) + * exists_intro: P w ⊢SL (∃SL x. P x) + * exists_elim: (∀x. P x ⊢SL Q) ⇒ ((∃SL x. P x) ⊢SL Q) + * exists_mono: (∀x. P x ⊢SL Q x) ⇒ + * ((∃SL x. P x) ⊢SL (∃SL x. Q x)) + * sep_exists_left: (∃SL x. P x) ** Q = ∃SL x. P x ** Q + * sep_exists_right: P ** (∃SL x. Q x) = ∃SL x. P ** Q x + * ent_refl: P ⊢SL P + * ent_trans: (P ⊢SL Q) ⇒ (Q ⊢SL S) ⇒ (P ⊢SL S) + * equiv_intro: (P ⊢SL Q) ⇒ (Q ⊢SL P) ⇒ (P ≃SL Q) + * fact_intro: p ⇒ (P ⊢SL Q) ⇒ (P ⊢SL fact(p) ** Q) + * fact_elim: (p ⇒ (P ⊢SL Q)) ⇒ (fact(p) ** P ⊢SL Q) + * fact_dup: fact(p) ⊢SL fact(p) ** fact(p) + * fact_true_emp: fact(T) = emp + * ``` + * + * `P,Q,S,P2,Q2` have `prop_type`, `p:bool`, `w:α`, and the existential + * families have type `α -> prop_type`. The installer checks operator types, + * requires every primitive handle to be nonempty, and checks the five + * existential schemas exactly in the eta-long binder form displayed above. + * The remaining theorem conclusions are a trusted adapter obligation. The + * installed slot copies handles; it does not transfer or shorten their + * prover-managed lifetime. + * + * `equiv` is logical assertion equivalence. It is deliberately separate from + * raw HOL function equality: validity-aware entailment is antisymmetric only + * up to `equiv`, not on predicates outside the valid-resource domain. */ +PROOF typedef struct { + type prop_type; + + term emp; + term sep; + term wand; + term and_op; + term or_op; + term exists_op; + term forall_op; + term entails; + term equiv; + term fact; + + thm sep_emp_left; + thm sep_emp_right; + thm sep_assoc; + thm sep_comm; + thm sep_mono; + thm wand_sep_adjoint; + thm and_intro; + thm and_elim1; + thm and_elim2; + thm or_intro1; + thm or_intro2; + thm or_elim; + thm exists_intro; + thm exists_elim; + thm exists_mono; + thm sep_exists_left; + thm sep_exists_right; + thm forall_intro; + thm forall_elim; + thm ent_refl; + thm ent_trans; + thm equiv_intro; + thm fact_intro; + thm fact_elim; + thm fact_dup; + thm fact_true_emp; +} sl_theory; + +/** + * Optional, RA-scoped basic-update and view-shift signature. + * + * This bundle is installed only after its base `sl_theory`. `bupd` has type + * `sl_prop() -> sl_prop()` and `viewshift` has type + * `sl_prop() -> sl_prop() -> bool`. Every primitive theorem must already be + * specialized to the same resource algebra as the active SL signature. + * Installing another base signature invalidates this bundle. Unlike the base + * bundle, installation verifies the exact closed conclusion of every primitive: + * + * ```text + * ∀P. P ⊢SL bupd P + * ∀P Q. (P ⊢SL Q) ⇒ (bupd P ⊢SL bupd Q) + * ∀P. bupd (bupd P) ⊢SL bupd P + * ∀P F. bupd P ** F ⊢SL bupd (P ** F) + * ∀P. P ⇛ P + * ∀P Q. (P ⊢SL Q) ⇒ (P ⇛ Q) + * ∀P Q S. (P ⇛ Q) ⇒ (Q ⇛ S) ⇒ (P ⇛ S) + * ∀P2 P Q Q2. (P2 ⊢SL P) ⇒ (P ⇛ Q) ⇒ (Q ⊢SL Q2) ⇒ (P2 ⇛ Q2) + * ∀P Q F. (P ⇛ Q) ⇒ (P ** F ⇛ Q ** F) + * ∀P1 Q1 P2 Q2. (P1 ⇛ Q1) ⇒ (P2 ⇛ Q2) ⇒ + * (P1 ** P2 ⇛ Q1 ** Q2) + * ∀P Q. (∀x. P x ⇛ Q x) ⇒ ((∃SL x. P x) ⇛ (∃SL x. Q x)) + * ``` + * + * All primitive theorems are closed. The last schema alone may be polymorphic + * in the witness type. The installed slot copies handles and owns no caller + * storage. + */ +PROOF typedef struct { + term bupd; + term viewshift; -// `hprop`: the type of separation-logic assertions -#define sl_prop() get_hprop_type() - -// `emp`: the empty resource -#define sl_emp() get_hemp() - -// `**`: the separating conjunction -#define sl_sep() get_hconj() - -// `-*`: the magic wand -#define sl_wand() get_hwand() - -// `&&`: additive conjunction on SL assertions -#define sl_and() get_hand() - -// `||`: additive disjunction on SL assertions -#define sl_or() get_hor() - -// `hexists`: existential quantification over SL assertions -#define sl_exists() get_hexists() -#define sl_exists_str() "hexists" - -// `|--`: SL entailment -#define sl_ent() get_hentail() - -// Ordinary HOL equality specialized to `hprop`; `-|-` is only a syntax alias. -#define sl_eq() get_hequal() - -// `hfact`: the fact operator -#define sl_fact() get_hfact() - -// `|- !hp:hprop. (emp ** hp) = hp` -#define sl_sep_emp_left() get_hsep_hemp_left() - -// `|- !hp:hprop. (hp ** emp) = hp` -#define sl_sep_emp_right() get_hsep_hemp_right() - -// `|- !hp1 hp2 hp3:hprop. ((hp1 ** hp2) ** hp3) = (hp1 ** (hp2 ** hp3))` -#define sl_sep_assoc() get_hsep_assoc() - -// `|- !hp1 hp2:hprop. (hp1 ** hp2) = (hp2 ** hp1)` -#define sl_sep_comm() get_hsep_comm() - -// `|- !hp1 hp2 hp3 hp4. (hp1 |-- hp2) ==> (hp3 |-- hp4) ==> (hp1 ** hp3 |-- hp2 ** hp4)` -#define sl_sep_mono() get_hsep_monotone() - -// `|- !hp1 hp2 hp3:hprop. (hp1 ** hp2 |-- hp3) = (hp1 |-- hp2 -* hp3)` -#define sl_wand_sep_adjoint() get_hwand_hsep_adjoint() - -// `|- !hp1 hp2 hp3. (hp1 |-- hp2) ==> (hp1 |-- hp3) ==> (hp1 |-- hp2 && hp3)` -#define sl_and_intro() get_hand_intro() - -// `|- !hp1 hp2. (hp1 && hp2 |-- hp1)` -#define sl_and_elim1() get_hand_elim1() - -// `|- !hp1 hp2. (hp1 && hp2 |-- hp2)` -#define sl_and_elim2() get_hand_elim2() - -// `|- !hp1 hp2. (hp1 |-- hp1 || hp2)` -#define sl_or_intro1() get_hor_intro1() - -// `|- !hp1 hp2. (hp2 |-- hp1 || hp2)` -#define sl_or_intro2() get_hor_intro2() - -// `|- !hp1 hp2 hp3. (hp1 |-- hp3) ==> (hp2 |-- hp3) ==> (hp1 || hp2 |-- hp3)` -#define sl_or_elim() get_hor_elim() - -// `|- !(x : alpha) hp hpA. (hp |-- hpA x) ==> (hp |-- (exists x : alpha. hpA x))` -#define sl_exists_intro() get_hexists_intro() - -// `|- !hp hpA. (!x : alpha. hpA x |-- hp) ==> ((exists y : alpha. hpA y) |-- hp)` -#define sl_exists_elim() get_hexists_elim() - -// `|- !hpA hp. ((exists x:alpha. hpA x) ** hp) = (exists x:alpha. hpA x ** hp)` -#define sl_sep_exists_left() get_hsep_hexists_left() - -// `|- !hp hpA. (hp ** (exists x:alpha. hpA x)) = (exists x:alpha. hp ** hpA x)` -#define sl_sep_exists_right() get_hsep_hexists_right() - -// `|- !hp. hp |-- hp` -#define sl_ent_refl() get_hentail_refl() - -// `|- !hp1 hp2 hp3. (hp1 |-- hp2) ==> (hp2 |-- hp3) ==> (hp1 |-- hp3)` -#define sl_ent_trans() get_hentail_trans() - -// `|- !hp1 hp2:hprop. (hp1 |-- hp2) ==> (hp2 |-- hp1) ==> (hp1 = hp2)` -#define sl_ent_antisym() get_hentail_antisym() - -// `|- !p hp1 hp2. p ==> (hp1 |-- hp2) ==> (hp1 |-- fact(p) ** hp2)` -#define sl_fact_intro() get_hfact_intro() + thm bupd_intro; + thm bupd_mono; + thm bupd_idem; + thm bupd_frame; + thm viewshift_refl; + thm viewshift_entails; + thm viewshift_trans; + thm viewshift_mono; + thm viewshift_frame; + thm viewshift_sep; + thm viewshift_exists; +} sl_update_theory; + +/** + * Install a complete signature and make it active until another installation. + * + * Check that the assertion type is monomorphic, check all connective types, + * require `exists_op` and its five primitive laws to expose exactly one common + * polymorphic witness type in canonical eta-long schemas, and reject an empty + * primitive theorem handle. Return zero on success and + * `-1` after reporting a prover error on failure. Before returning success, + * installation proves and exact-checks every signature-dependent derived + * theorem, binds the public theorem globals below, increments + * `sl_theory_generation()`, and invalidates any installed update signature. + * A failure while constructing derived theorems restores the previously active + * signature and theorem globals. + */ +PROOF int sl_install_theory(const sl_theory* theory); + +/** + * Return whether a base SL signature is currently installed. + * + * Unlike `sl_current_theory()` this predicate never reports an error. It is + * intended for generic proof modules whose optional closed-theorem audits may + * be compiled as standalone verification roots before any assertion model is + * selected; proof rules themselves must still require an installed theory. + */ +PROOF bool sl_theory_is_installed(void); -// `|- !p hp1 hp2. (p ==> (hp1 |-- hp2)) ==> (fact(p) ** hp1 |-- hp2)` -#define sl_fact_elim() get_hfact_elim() +/** + * Return the active signature. + * + * A signature must have been installed explicitly. If none is active, report + * a prover error and return a borrowed pointer to the empty internal slot so + * macro accessors remain non-crashing while preserving the error status. The + * slot is replaced by a later successful install. + */ +PROOF const sl_theory* sl_current_theory(void); -// `|- fact(T) = emp` -#define sl_fact_true_emp() get_htrue_hemp() +/** + * Return the monotonically increasing key for the active theory. + * Report a prover error and return zero before the first successful install. + */ +PROOF size_t sl_theory_generation(void); /** - * Validate a theorem before caching it as a derived SL rule. + * Borrowed accessors for the active assertion type and connective handles. * - * Require `th` to be closed and its conclusion to be ≡α to - * `parse_term(expected_str)`. A mismatch is a library programming error and - * aborts the process; `name` is used only in the diagnostic. Parenthesize - * entailments inside implication strings, for example - * `p ==> q ==> (H |-- K)`. + * Every macro calls `sl_current_theory()` and returns the corresponding handle + * from its internal slot; no handle or storage is copied. Before installation, + * the accessor records a prover error and yields the empty member of that slot. + * Operator types are the ones documented for `sl_theory`. */ -PROOF void sl_thm_lazy_init_check(const char* name, thm th, const char* expected_str); +#define sl_prop() (sl_current_theory()->prop_type) +#define sl_emp() (sl_current_theory()->emp) +#define sl_sep() (sl_current_theory()->sep) +#define sl_wand() (sl_current_theory()->wand) +#define sl_and() (sl_current_theory()->and_op) +#define sl_or() (sl_current_theory()->or_op) +#define sl_exists() (sl_current_theory()->exists_op) +#define sl_forall() (sl_current_theory()->forall_op) +#define sl_ent() (sl_current_theory()->entails) +#define sl_equiv() (sl_current_theory()->equiv) +#define sl_fact() (sl_current_theory()->fact) + +/** + * Return raw HOL equality specialized to `sl_prop() -> sl_prop() -> bool`. + * + * Each call builds a probe equality at `sl_prop()` and returns its shared + * instantiated operator handle. Fail with `empty_term` if no base theory is + * active or equality specialization fails. + */ +PROOF term sl_raw_eq(void); +/** Borrowed compatibility accessor for `sl_raw_eq()`. */ +#define sl_eq() sl_raw_eq() + +/** + * Borrowed accessors for the primitive theorem handles in `sl_theory`. + * + * Their intended closed HOL schemas and the installer's validation boundary + * are documented on `sl_theory`. No accessor proves, instantiates, or copies a + * theorem; it returns the currently installed handle and inherits + * `sl_current_theory()` failure behavior and lifetime. + */ +#define sl_sep_emp_left() (sl_current_theory()->sep_emp_left) +#define sl_sep_emp_right() (sl_current_theory()->sep_emp_right) +#define sl_sep_assoc() (sl_current_theory()->sep_assoc) +#define sl_sep_comm() (sl_current_theory()->sep_comm) +#define sl_sep_mono() (sl_current_theory()->sep_mono) +#define sl_wand_sep_adjoint() (sl_current_theory()->wand_sep_adjoint) +#define sl_and_intro() (sl_current_theory()->and_intro) +#define sl_and_elim1() (sl_current_theory()->and_elim1) +#define sl_and_elim2() (sl_current_theory()->and_elim2) +#define sl_or_intro1() (sl_current_theory()->or_intro1) +#define sl_or_intro2() (sl_current_theory()->or_intro2) +#define sl_or_elim() (sl_current_theory()->or_elim) +#define sl_exists_intro() (sl_current_theory()->exists_intro) +#define sl_exists_elim() (sl_current_theory()->exists_elim) +#define sl_exists_mono_primitive() (sl_current_theory()->exists_mono) +#define sl_sep_exists_left() (sl_current_theory()->sep_exists_left) +#define sl_sep_exists_right() (sl_current_theory()->sep_exists_right) +#define sl_forall_intro() (sl_current_theory()->forall_intro) +#define sl_forall_elim() (sl_current_theory()->forall_elim) +#define sl_ent_refl() (sl_current_theory()->ent_refl) +#define sl_ent_trans() (sl_current_theory()->ent_trans) +#define sl_equiv_intro() (sl_current_theory()->equiv_intro) +#define sl_fact_intro() (sl_current_theory()->fact_intro) +#define sl_fact_elim() (sl_current_theory()->fact_elim) +#define sl_fact_dup() (sl_current_theory()->fact_dup) +#define sl_fact_true_emp() (sl_current_theory()->fact_true_emp) /** - * Define a checked, lazily initialized derived-theorem getter. + * Install an update signature for the currently active SL generation. * - * ```c - * thm prove_sl_conj1() { ... } - * SL_THM_LAZY_INIT(sl_conj1, "!a b c. (a |-- b && c) ==> (a |-- b)"); - * ``` + * Validate both operator types and the exact closed schema of every primitive + * theorem. Return zero on success and `-1` on failure. A failed install leaves + * any currently valid update signature unchanged. + */ +PROOF int sl_install_update_theory(const sl_update_theory* theory); + +/** Return whether an update signature is installed for the active SL theory. */ +PROOF bool sl_update_theory_is_installed(void); + +/** + * Return the update signature bound to the active SL generation. * - * The expansion defines a zero-argument function `name()`. Its first call - * invokes `prove_name()`, validates the resulting closed theorem against - * `expected_str` modulo alpha-equivalence with `sl_thm_lazy_init_check`, and - * caches the handle. Every later call returns that same handle without - * reproving or rechecking it. - */ -#define SL_THM_LAZY_INIT(name, expected_str) \ - PROOF thm name() { \ - static bool initialized = false; \ - static thm __##name; \ - if (!initialized) { \ - initialized = true; \ - __##name = prove_##name(); \ - sl_thm_lazy_init_check(#name, __##name, expected_str); \ - } \ - return __##name; \ - } + * Report a prover error when no matching signature is installed. As with + * `sl_current_theory`, the error return points at an empty internal slot so a + * term/theorem accessor yields an empty handle instead of dereferencing null. + */ +PROOF const sl_update_theory* sl_current_update_theory(void); + +/** + * Borrowed update-operator and primitive-theorem accessors. + * + * `sl_bupd()` and `sl_viewshift()` have the operator types documented on + * `sl_update_theory`; the remaining macros return the exact closed primitive + * theorem schemas listed there. No macro constructs or instantiates a theorem. + * Without a matching update bundle, each records a prover error and yields an + * empty handle from the internal slot. + */ +#define sl_bupd() (sl_current_update_theory()->bupd) +#define sl_viewshift() (sl_current_update_theory()->viewshift) +#define sl_bupd_intro_primitive() (sl_current_update_theory()->bupd_intro) +#define sl_bupd_mono_primitive() (sl_current_update_theory()->bupd_mono) +#define sl_bupd_idem_primitive() (sl_current_update_theory()->bupd_idem) +#define sl_bupd_frame_primitive() (sl_current_update_theory()->bupd_frame) +#define sl_viewshift_refl_primitive() \ + (sl_current_update_theory()->viewshift_refl) +#define sl_entails_viewshift_primitive() \ + (sl_current_update_theory()->viewshift_entails) +#define sl_viewshift_trans_primitive() \ + (sl_current_update_theory()->viewshift_trans) +#define sl_viewshift_mono_primitive() \ + (sl_current_update_theory()->viewshift_mono) +#define sl_viewshift_frame_primitive() \ + (sl_current_update_theory()->viewshift_frame) +#define sl_viewshift_sep_primitive() \ + (sl_current_update_theory()->viewshift_sep) +#define sl_viewshift_exists_primitive() \ + (sl_current_update_theory()->viewshift_exists) + /*-------------------- Term Structure Analysis --------------------*/ /** * Recognize an SL assertion by its HOL type. * - * Return true exactly when `type_of(tm) = hprop`. This tests the type only; - * it does not inspect the assertion's outer constructor. + * Return true exactly when `type_of(tm) = sl_prop()`. This tests the type + * only; it does not inspect the assertion's outer constructor. */ PROOF bool is_sl_prop(const term tm); @@ -193,7 +369,7 @@ PROOF bool is_sl_prop(const term tm); * Create a named variable ranging over SL assertions. * * Return `mk_var(s, sl_prop())`; for example, `mk_sl_prop("H")` constructs - * `H:hprop`. Name handling and any malformed input are delegated to `mk_var`. + * `H:sl_prop()`. Name handling and malformed input are delegated to `mk_var`. */ PROOF term mk_sl_prop(const char* s); @@ -216,8 +392,8 @@ PROOF bool is_sl_sep(const term hp); /** * Construct the separating conjunction of two SL assertions. * - * For `H,K:hprop`, return `H ** K`. The HOL constructor reports a prover - * error if either operand is not an SL assertion. + * For assertions `H,K:sl_prop()`, return `H ** K`. The HOL constructor + * reports a prover error if either operand has another type. */ PROOF term mk_sl_sep(const term hp1, const term hp2); @@ -245,7 +421,7 @@ PROOF term list_mk_sl_sep(const term_list hps); * * Return `flat(H)` in left-to-right order, preserving duplicates and literal * unit leaves. Thus `flat((H ** K) ** F) = [H,K,F]` and `flat(emp) = [emp]`. - * A non-`hprop` input is a prover error. + * An input outside `sl_prop()` is a prover error. */ PROOF term_list strip_sl_sep(const term hp); @@ -270,8 +446,8 @@ PROOF bool is_sl_wand(const term hp); /** * Construct a magic wand between two SL assertions. * - * For `H,K:hprop`, return `H -* K`. The HOL constructor reports a prover error - * if either operand is not an SL assertion. + * For assertions `H,K:sl_prop()`, return `H -* K`. The HOL constructor + * reports a prover error if either operand has another type. */ PROOF term mk_sl_wand(const term hp1, const term hp2); @@ -294,8 +470,8 @@ PROOF bool is_sl_and(const term hp); /** * Create an additive conjunction from two SL assertions. * - * For `H,K:hprop`, return `H && K`. The HOL constructor reports a prover error - * if either operand is not an SL assertion. + * For assertions `H,K:sl_prop()`, return `H && K`. The HOL constructor + * reports a prover error if either operand has another type. */ PROOF term mk_sl_and(const term hp1, const term hp2); @@ -318,8 +494,8 @@ PROOF bool is_sl_or(const term tm); /** * Create an additive disjunction from two SL assertions. * - * For `H,K:hprop`, return `H || K`. The HOL constructor reports a prover error - * if either operand is not an SL assertion. + * For assertions `H,K:sl_prop()`, return `H || K`. The HOL constructor + * reports a prover error if either operand has another type. */ PROOF term mk_sl_or(const term hp1, const term hp2); @@ -334,16 +510,19 @@ PROOF dest_binop_results dest_sl_or(const term hp); /** * Recognize an outermost SL existential. * - * Return `is_binder("hexists", tm)`, so the result is true exactly for terms - * whose outer form is `∃SL x:α. H`. + * Recognize an application of the installed polymorphic `exists_op` to an + * abstraction. The operator's unique witness type variable is instantiated + * explicitly from the abstraction binder; no parser binder name is assumed. */ PROOF bool is_sl_exists(const term tm); /** * Bind one variable existentially in an SL assertion. * - * For a variable `x:α` and `H:hprop`, return `∃SL x:α. H`. Report a - * prover error if `v` is not a variable or `hp` is not an SL assertion. + * For a variable `x:α` and assertion `H`, return the operator application + * `exists_op (\x. H)`. The operator's witness type is explicitly instantiated + * to `type_of(x)`. Report a prover error if `v` is not a variable or `hp` does + * not have the installed assertion type. */ PROOF term mk_sl_exists(const term v, const term hp); @@ -364,8 +543,20 @@ PROOF dest_binder_results dest_sl_exists(const term hp); */ PROOF term list_mk_sl_exists(const term_list vs, const term hp); +/** Recognize an outermost installed SL universal binder. */ +PROOF bool is_sl_forall(const term tm); + +/** Return `forall_op (\v. hp)` using the installed assertion theory. */ +PROOF term mk_sl_forall(const term v, const term hp); + +/** Expose the variable and body of an outermost installed SL universal. */ +PROOF dest_binder_results dest_sl_forall(const term hp); + +/** Result of stripping the maximal leading SL-existential prefix. */ PROOF typedef struct { + /** Fresh binder vector ordered outermost first, or `NULL` when empty/error. */ term_list vs; // The list of variables. + /** Borrowed handle to the residual assertion after the syntactic prefix. */ term hp; // The SL assertion. } strip_sl_exists_results; @@ -373,11 +564,69 @@ PROOF typedef struct { * Remove the maximal leading prefix of SL existentials. * * If `E = Ex(V,H)` and `H` is not itself an outermost SL existential, return - * `{.vs = V, .hp = H}` with binders ordered outermost first. For a binder-free - * assertion return an empty `vs`; a non-SL input is a prover error. + * `{.vs = V, .hp = H}` with binders ordered outermost first. This is a purely + * syntactic destructor: it never performs beta reduction. Consequently an + * explicit `(\x. exists y. P) t` terminates the prefix scan at that redex; the + * constructor or rule that introduced it must reduce it explicitly. For a binder-free assertion + * return `.vs = NULL` and `.hp = hp`; this API explicitly uses `NULL` as its + * successful empty sequence representation. A non-SL input is an error and returns + * `{.vs = NULL, .hp = empty_term}`. A non-null vector container is fresh, but + * its binders and the residual assertion are shared HOL handles with prover-managed + * lifetime; callers do not free or mutate the handles themselves. */ PROOF strip_sl_exists_results strip_sl_exists(const term hp); +/*---------------- Optional update term structure ----------------*/ + +/** + * Recognize an outermost `bupd P` from the installed update signature. + * + * Return false without reporting an error when no update signature is active; + * otherwise compare only the outer operator and do no unfolding. + */ +PROOF bool is_sl_bupd(const term tm); + +/** + * Construct `bupd P` for an active-SL assertion `P`. + * + * Return a borrowed HOL term handle. Report a prover error and return + * `empty_term` if the update theory is absent or the application is ill typed. + */ +PROOF term mk_sl_bupd(const term hp); + +/** + * Return the borrowed operand `P` from an outermost `bupd P`. + * + * Report a prover error and return `empty_term` when the update theory is + * absent or the input has another outer constructor. + */ +PROOF term dest_sl_bupd(const term tm); + +/** + * Recognize the installed Boolean view-shift relation `P ⇛ Q`. + * + * Return false without reporting an error when no update signature is active; + * otherwise inspect only the outer binary operator. + */ +PROOF bool is_sl_viewshift(const term tm); + +/** + * Construct the Boolean proposition `P ⇛ Q` from active-SL assertions. + * + * Report a prover error and return `empty_term` if no update theory is active + * or either endpoint is ill typed. + */ +PROOF term mk_sl_viewshift(const term hp1, const term hp2); + +/** + * Decompose an outermost `P ⇛ Q` into borrowed source and target handles. + * + * Preserve endpoint order. Report a prover error and return the empty + * `dest_binop_results` record if the update theory is absent or the input has + * another outer constructor. + */ +PROOF dest_binop_results dest_sl_viewshift(const term tm); + /** * Recognize an outermost SL entailment. * @@ -389,8 +638,9 @@ PROOF bool is_sl_ent(const term tm); /** * Construct an SL entailment proposition. * - * For `H,K:hprop`, return the Boolean proposition `H ⊢SL K`. The HOL - * constructor reports a prover error if either endpoint is not an SL assertion. + * For assertions `H,K:sl_prop()`, return the Boolean proposition `H ⊢SL K`. + * The HOL constructor reports a prover error if either endpoint has another + * type. */ PROOF term mk_sl_ent(const term hp1, const term hp2); @@ -402,28 +652,56 @@ PROOF term mk_sl_ent(const term hp1, const term hp2); */ PROOF dest_binop_results dest_sl_ent(const term tm); +/** + * Recognize an outermost active-SL logical equivalence. + * + * Return `is_binop(sl_equiv(), tm)`, so the result is true exactly for terms + * whose outer form is `H ≃SL K`. This is distinct from raw `H = K`. With no + * active base theory, `sl_equiv()` records a prover error and the recognizer + * returns false. + */ +PROOF bool is_sl_equiv(const term tm); + +/** + * Construct active-SL logical equivalence. + * + * For `H,K:sl_prop()`, return the Boolean proposition `H ≃SL K`. Report a + * prover error and return `empty_term` when no base theory is active or either + * endpoint has another type. + */ +PROOF term mk_sl_equiv(const term hp1, const term hp2); + +/** + * Decompose an outermost active-SL logical equivalence. + * + * For `H ≃SL K`, return `{.tm1 = H, .tm2 = K}` in endpoint order. Report a + * prover error and return `{empty_term, empty_term}` when no base theory is + * active or the input has another outer constructor. + */ +PROOF dest_binop_results dest_sl_equiv(const term tm); + /** * Check for ordinary equality whose operands are SL assertions. * * Return `is_binop(sl_eq(), tm)`, so the result is true exactly for ordinary - * HOL equalities `H =ₕ K`. An SL entailment is not an SL equality. + * HOL equalities `H = K`. An SL entailment is not an SL equality. */ PROOF bool is_sl_eq(const term tm); /** * Create ordinary equality between two SL assertions. * - * For `H,K:hprop`, return `H =ₕ K`; C* assertion syntax may print this as - * `H -|- K`. The HOL constructor reports a prover error if either operand is - * not an SL assertion. + * For assertions `H,K:sl_prop()`, return ordinary HOL equality `H = K`. + * The HOL constructor reports a prover error if either operand has another + * type. */ PROOF term mk_sl_eq(const term hp1, const term hp2); /** * Decompose equality between two SL assertions. * - * For `H =ₕ K`, return `{.tm1 = H, .tm2 = K}`. Report a prover error - * when the input is not ordinary equality at `hprop`. + * For `H = K`, return `{.tm1 = H, .tm2 = K}`. Report a prover error + * when the input is not ordinary equality at `sl_prop()`. */ PROOF dest_binop_results dest_sl_eq(const term tm); @@ -454,164 +732,173 @@ PROOF term dest_sl_fact(const term tm); /*----------------------- Derived Theorems ------------------------*/ +/* + * The globals in this section are valid only after `sl_install_theory` + * succeeds. The installer constructs each displayed closed schema + * independently, alpha-aligns the proof to that schema when necessary, and + * requires `equals_term(concl(global), documented_schema)` before publishing + * the binding. A failed install publishes none of the candidate bindings. + */ + /** - * Return the cached theorem that turns SL-assertion equality into entailment. + * Globally bound theorem turning SL-assertion equality into entailment. * - * The result is exactly `∅ ⊢ ∀H K. (H =ₕ K) ⇒ (H ⊢SL K)`. Its first call - * proves and checks the closed theorem; later calls return the cached handle. + * After `sl_install_theory` succeeds, the value is exactly + * `∅ ⊢ ∀H K. (H = K) ⇒ (H ⊢SL K)`. */ -PROOF thm sl_ent_sym_left(); +PROOF extern thm sl_ent_sym_left; /** * Restate both endpoints of an entailment using supplied equalities. * * ```text - * H =ₕ H' K =ₕ K' H' ⊢SL K' + * H = H' K = K' H' ⊢SL K' * ----------------------------------- * H ⊢SL K * ``` * - * The result is closed and universally quantified over the displayed - * assertions. Applying it preserves the hypotheses of every premise. + * After installation, the value is exactly + * `∅ ⊢ ∀H H1 K K1. (H = H1) ⇒ (K = K1) ⇒` + * `(H1 ⊢SL K1) ⇒ (H ⊢SL K)`. */ -PROOF thm sl_ent_restate(); +PROOF extern thm sl_ent_restate; /** * Frame a child entailment and restate both endpoints in one derived rule. * * ```text - * H =ₕ F ** H' K =ₕ F ** K' H' ⊢SL K' + * H = F ** H' K = F ** K' H' ⊢SL K' * --------------------------------------------- * H ⊢SL K * ``` * - * The result is closed and universally quantified. The endpoint equalities - * determine the result syntax, and premise hypotheses are preserved. + * After installation, the value is exactly + * `∅ ⊢ ∀H F H1 K K1. (H = F ** H1) ⇒ (K = F ** K1) ⇒` + * `(H1 ⊢SL K1) ⇒ (H ⊢SL K)`. */ -PROOF thm sl_frame_restate(); +PROOF extern thm sl_frame_restate; /** - * Return the cached theorem for left framing. + * Globally bound theorem for left framing. * - * The result is exactly - * `∅ ⊢ ∀H K F. (H ⊢SL K) ⇒ (F ** H ⊢SL F ** K)`. It is proved, - * checked, and cached on first use. + * After installation, the value is exactly + * `∅ ⊢ ∀H K F. (H ⊢SL K) ⇒ (F ** H ⊢SL F ** K)`. */ -PROOF thm sl_ent_frame_left(); +PROOF extern thm sl_ent_frame_left; /** - * Return the cached theorem for right framing. + * Globally bound theorem for right framing. * - * The result is exactly - * `∅ ⊢ ∀H K F. (H ⊢SL K) ⇒ (H ** F ⊢SL K ** F)`. It is proved, - * checked, and cached on first use. + * After installation, the value is exactly + * `∅ ⊢ ∀H K F. (H ⊢SL K) ⇒ (H ** F ⊢SL K ** F)`. */ -PROOF thm sl_ent_frame_right(); +PROOF extern thm sl_ent_frame_right; /** * Return framed substitution on an entailment antecedent. * * ```text - * H =ₕ K C =ₕ K ** F C ⊢SL G + * H = K C = K ** F C ⊢SL G * ------------------------------------- * H ** F ⊢SL G * ``` * - * The cached theorem is closed and universally quantified. It avoids first - * rewriting the supplied entailment endpoint. + * After installation, the value is exactly + * `∅ ⊢ ∀H K F C G. (H = K) ⇒ (C = K ** F) ⇒` + * `(C ⊢SL G) ⇒ (H ** F ⊢SL G)`. */ -PROOF thm sl_ent_subst_frame(); +PROOF extern thm sl_ent_subst_frame; /** * Combine two child entailments under `**` and restore the parent endpoints. * * ```text - * H =ₕ H₁ ** H₂ K =ₕ K₁ ** K₂ H₁ ⊢SL K₁ H₂ ⊢SL K₂ + * H = H₁ ** H₂ K = K₁ ** K₂ H₁ ⊢SL K₁ H₂ ⊢SL K₂ * ------------------------------------------------------------ * H ⊢SL K * ``` * - * The result is the closed, universally quantified theorem for this rule. It - * is proved and cached once for separating-conjunction validators. + * After installation, the value is exactly + * `∅ ⊢ ∀H H1 H2 K K1 K2. (H = H1 ** H2) ⇒` + * `(K = K1 ** K2) ⇒ (H1 ⊢SL K1) ⇒ (H2 ⊢SL K2) ⇒ (H ⊢SL K)`. */ -PROOF thm sl_sep_combine(); +PROOF extern thm sl_sep_combine; /** * Return the equality laws used by the HOL AC prover for `**`. * - * Return a closed conjunction containing, in order: commutativity - * `H ** K =ₕ K ** H`, associativity - * `(H ** K) ** F =ₕ H ** (K ** F)`, and lifted commutativity - * `H ** (K ** F) =ₕ K ** (H ** F)`, all universally quantified. Pass this - * theorem to `ac_rule`; units are not part of this AC theory. + * After installation, its exact conclusion is + * `concl(sl_sep_comm()) ∧ (concl(sl_sep_assoc()) ∧` + * `(∀H K F. H ** (K ** F) = K ** (H ** F)))`. Thus the conjunction order + * is commutativity, associativity, then lifted commutativity. Pass this theorem + * to `ac_rule`; units are not part of this AC theory. */ -PROOF thm sl_ac_rule(); +PROOF extern thm sl_ac_rule; /** - * Return the cached theorem for monotonicity of additive disjunction. + * Globally bound theorem for monotonicity of additive disjunction. * - * The result is exactly - * `∅ ⊢ ∀H₁ H₂ K₁ K₂. (H₁ ⊢SL K₁) ⇒ (H₂ ⊢SL K₂) ⇒` - * `(H₁ || H₂ ⊢SL K₁ || K₂)`. It is proved, checked, and cached on first - * use. + * After installation, the value is exactly + * `∅ ⊢ ∀H1 H2 K1 K2. (H1 ⊢SL K1) ⇒ (H2 ⊢SL K2) ⇒` + * `((H1 || H2) ⊢SL (K1 || K2))`. */ -PROOF thm sl_disj_mono(); +PROOF extern thm sl_disj_mono; /** * Return additive-disjunction elimination under a shared frame. * * ```text - * C₁ =ₕ H ** F C₂ =ₕ K ** F P =ₕ (H || K) ** F + * C₁ = H ** F C₂ = K ** F P = (H || K) ** F * C₁ ⊢SL G C₂ ⊢SL G * ---------------------------------------------------------- * P ⊢SL G * ``` * - * The result is closed and universally quantified. It is cached for - * disjunctive-antecedent validation. + * After installation, the value is exactly + * `∅ ⊢ ∀H K F C₁ C₂ P G. (C₁ = H ** F) ⇒ (C₂ = K ** F) ⇒` + * `(P = (H || K) ** F) ⇒ (C₁ ⊢SL G) ⇒ (C₂ ⊢SL G) ⇒ (P ⊢SL G)`. */ -PROOF thm sl_or_elim_frame(); +PROOF extern thm sl_or_elim_frame; /** - * Return the cached theorem for magic-wand elimination. + * Globally bound theorem for magic-wand elimination. * - * The result is exactly - * `∅ ⊢ ∀H K F. (H ⊢SL (K -* F)) ⇒ (H ** K ⊢SL F)`. It is proved, - * checked, and cached on first use. + * After installation, the value is exactly + * `∅ ⊢ ∀H K G. (H ⊢SL (K -* G)) ⇒ (H ** K ⊢SL G)`. */ -PROOF thm sl_undisch(); +PROOF extern thm sl_undisch; /** - * Return the cached theorem projecting the left additive conjunct. + * Globally bound theorem projecting the left additive conjunct. * * The result is exactly - * `∅ ⊢ ∀H K F. (H ⊢SL K && F) ⇒ (H ⊢SL K)`. + * `∅ ⊢ ∀H K F. (H ⊢SL (K && F)) ⇒ (H ⊢SL K)`. */ -PROOF thm sl_conj1(); +PROOF extern thm sl_conj1; /** - * Return the cached theorem projecting the right additive conjunct. + * Globally bound theorem projecting the right additive conjunct. * * The result is exactly - * `∅ ⊢ ∀H K F. (H ⊢SL K && F) ⇒ (H ⊢SL F)`. + * `∅ ⊢ ∀H K F. (H ⊢SL (K && F)) ⇒ (H ⊢SL F)`. */ -PROOF thm sl_conj2(); +PROOF extern thm sl_conj2; /** - * Return the cached theorem injecting into the left disjunct. + * Globally bound theorem injecting into the left disjunct. * * The result is exactly - * `∅ ⊢ ∀H K F. (H ⊢SL K) ⇒ (H ⊢SL K || F)`. + * `∅ ⊢ ∀H K F. (H ⊢SL K) ⇒ (H ⊢SL (K || F))`. */ -PROOF thm sl_disj1_mono(); +PROOF extern thm sl_disj1_mono; /** - * Return the cached theorem injecting into the right disjunct. + * Globally bound theorem injecting into the right disjunct. * * The result is exactly - * `∅ ⊢ ∀F H K. (H ⊢SL K) ⇒ (H ⊢SL F || K)`. + * `∅ ⊢ ∀F H K. (H ⊢SL K) ⇒ (H ⊢SL (F || K))`. */ -PROOF thm sl_disj2_mono(); +PROOF extern thm sl_disj2_mono; /** * Eliminate an SL existential while preserving a shared frame. @@ -620,28 +907,20 @@ PROOF thm sl_disj2_mono(); * ∅ ⊢ (∀x. (B(x) ** F ⊢SL K)) ⇒ ((∃SL x. B(x)) ** F ⊢SL K) * ``` * - * The theorem is closed, polymorphic in the witness type, proved once from - * the primitive existential and frame laws, and cached. + * For every type `α`, the value is exactly + * `∅ ⊢ ∀B:α→sl_prop() F K. (∀x:α. B(x) ** F ⊢SL K) ⇒` + * `((∃SL x:α. B(x)) ** F ⊢SL K)`. */ -PROOF thm sl_exists_elim_frame(); +PROOF extern thm sl_exists_elim_frame; /** - * Return the cached theorem for SL-existential introduction. + * Globally bound theorem for SL-existential introduction. * * For every type `α`, return exactly - * `∅ ⊢ ∀w:α H B:α→hprop. (H ⊢SL B(w)) ⇒` + * `∅ ⊢ ∀w:α H B:α→sl_prop(). (H ⊢SL B(w)) ⇒` * `(H ⊢SL ∃SL x:α. B(x))`. */ -PROOF thm sl_exists_wit(); - -/** - * Return the cached theorem for monotonicity of SL existentials. - * - * For every type `α`, return exactly - * `∅ ⊢ ∀P Q:α→hprop. (∀x:α. (P(x) ⊢SL Q(x))) ⇒` - * `((∃SL x. P(x)) ⊢SL (∃SL x. Q(x)))`. - */ -PROOF thm sl_exists_mono(); +PROOF extern thm sl_exists_wit; /*------------------------- Derived Rules -------------------------*/ @@ -653,8 +932,8 @@ PROOF thm sl_exists_mono(); * ∅ ⊢ (H ⊢SL H) * ``` * - * For `H:hprop`, return the displayed closed theorem. The underlying HOL - * specialization rejects a term not typed as an SL assertion. + * For `H:sl_prop()`, return the displayed closed theorem. The underlying HOL + * specialization rejects a term of another type. */ PROOF thm refl_slrule(const term hp); @@ -664,12 +943,14 @@ PROOF thm refl_slrule(const term hp); * ```text * 𝒜 ⊢ (H ⊢SL K) ℬ ⊢ (K' ⊢SL F) K ≡α K' * ------------------------------------------------ trans_slrule - * 𝒜 ∪ ℬ ⊢ (H ⊢SL F) + * 𝒜 ∪ ℬ ⊢ (H ⊢SL F) * ``` * - * Given `𝒜 ⊢ (H ⊢SL K)` and `ℬ ⊢ (K' ⊢SL F)` with `K ≡α K'`, return - * `𝒜 ∪ ℬ ⊢ (H ⊢SL F)`. A non-entailment or endpoints not matching - * modulo ≡α are prover errors. + * Given `𝒜 ⊢ (H ⊢SL K)` and `ℬ ⊢ (K' ⊢SL F)` with alpha-equivalent middle + * endpoints, return `𝒜 ∪ ℬ ⊢ (H ⊢SL F)` while retaining the original displayed + * endpoints `H` and `F`. No beta normalization is attempted; a producer of a + * beta-redex must construct its local conversion before composition. A + * non-entailment or non-alpha-equivalent endpoints are prover errors. */ PROOF thm trans_slrule(const thm ent1, const thm ent2); @@ -677,30 +958,166 @@ PROOF thm trans_slrule(const thm ent1, const thm ent2); * Convert equality between SL assertions to left-to-right entailment. * * ```text - * 𝒜 ⊢ (H =ₕ K) + * 𝒜 ⊢ (H = K) * ---------------- eq2ent * 𝒜 ⊢ (H ⊢SL K) * ``` * - * Given `𝒜 ⊢ (H =ₕ K)`, return `𝒜 ⊢ (H ⊢SL K)`, preserving all hypotheses. - * Reject a theorem whose conclusion is not equality at `hprop`. + * Given `𝒜 ⊢ (H = K)`, return `𝒜 ⊢ (H ⊢SL K)`, preserving all hypotheses. + * Reject a theorem whose conclusion is not equality at `sl_prop()`. */ PROOF thm eq2ent(const thm eq); /** - * Turn mutually opposite entailments into `hprop` equality. + * Turn mutually opposite entailments into logical assertion equivalence. * * ```text * 𝒜 ⊢ (H ⊢SL K) ℬ ⊢ (K' ⊢SL H') H ≡α H' K ≡α K' - * --------------------------------------------------------- antisym_slrule - * 𝒜 ∪ ℬ ⊢ (H =ₕ K) + * --------------------------------------------------------- equiv_slrule + * 𝒜 ∪ ℬ ⊢ (H ≃SL K) * ``` * * Given `𝒜 ⊢ (H ⊢SL K)` and `ℬ ⊢ (K' ⊢SL H')` with `H ≡α H'` and - * `K ≡α K'`, return `𝒜 ∪ ℬ ⊢ (H =ₕ K)`. Reject mismatched directions. + * `K ≡α K'`, return `𝒜 ∪ ℬ ⊢ (H ≃SL K)`. Reject mismatched directions. + * This rule never concludes raw HOL equality merely from validity-aware + * entailments. */ +PROOF thm equiv_slrule(const thm ent1, const thm ent2); + +/** Compatibility spelling; returns logical equivalence, not raw equality. */ PROOF thm antisym_slrule(const thm ent1, const thm ent2); +/*--------------------- Optional update rules --------------------*/ + +/** + * Instantiate basic-update introduction at `P`. + * + * For `P:sl_prop()`, return the closed theorem `∅ ⊢ (P ⊢SL bupd P)`. + * Require an installed update theory; malformed or ill-typed input reports a + * prover error and returns `empty_theorem`. + */ +PROOF thm bupd_intro_slrule(const term hp); + +/** + * Lift an entailment through basic update. + * + * From `𝒜 ⊢ (P ⊢SL Q)`, return + * `𝒜 ⊢ (bupd P ⊢SL bupd Q)`. The exact hypothesis set is preserved. Require + * an installed update theory and an entailment conclusion; on failure return + * `empty_theorem` after reporting a prover error. + */ +PROOF thm bupd_mono_slrule(const thm ent); + +/** + * Instantiate basic-update idempotence. + * + * The argument `hp` is the underlying assertion `P`. Return + * `∅ ⊢ (bupd (bupd P) ⊢SL bupd P)`. An absent update theory or a non-SL + * argument reports a prover error and returns `empty_theorem`. + */ +PROOF thm bupd_idem_slrule(const term hp); + +/** + * Instantiate the right-frame law for basic update. + * + * `hp` is the underlying assertion `P` and `frame` is `F`; return the closed + * theorem `∅ ⊢ (bupd P ** F ⊢SL bupd (P ** F))`. Require both active-SL + * types and an installed update theory; otherwise return `empty_theorem`. + */ +PROOF thm bupd_frame_slrule(const term hp, const term frame); + +/** + * Instantiate view-shift reflexivity at `P`. + * + * Return `∅ ⊢ (P ⇛ P)`, or `empty_theorem` on an absent update theory or an + * ill-typed assertion. + */ +PROOF thm viewshift_refl_slrule(const term hp); + +/** + * Convert an entailment into a view shift. + * + * From `𝒜 ⊢ (P ⊢SL Q)`, return `𝒜 ⊢ (P ⇛ Q)` with exactly the same HOL + * hypotheses. Require an installed update theory and an entailment conclusion; + * otherwise report a prover error and return `empty_theorem`. + */ +PROOF thm entails_viewshift_slrule(const thm ent); + +/** + * Compose view shifts in the displayed order. + * + * From `𝒜 ⊢ (P ⇛ Q)` and `ℬ ⊢ (Q' ⇛ S)` with `Q ≡α Q'`, return + * `𝒜 ∪ ℬ ⊢ (P ⇛ S)`. Reject non-view-shift conclusions or mismatched middle + * endpoints and return `empty_theorem`. + */ +PROOF thm viewshift_trans_slrule(const thm first, const thm second); + +/** + * Apply view-shift consequence. + * + * From `𝒜₁ ⊢ (P2 ⊢SL P)`, `𝒜₂ ⊢ (P ⇛ Q)`, and + * `𝒜₃ ⊢ (Q ⊢SL Q2)`, derive `𝒜₁ ∪ 𝒜₂ ∪ 𝒜₃ ⊢ (P2 ⇛ Q2)`. + * Adjacent endpoints must match modulo alpha-equivalence. Hypotheses are + * combined by HOL inference; malformed conclusions yield `empty_theorem`. + */ +PROOF thm viewshift_mono_slrule(const thm pre_ent, const thm change, + const thm post_ent); + +/** + * Frame a view shift on the right. + * + * From `𝒜 ⊢ (P ⇛ Q)` and `F:sl_prop()`, return + * `𝒜 ⊢ (P ** F ⇛ Q ** F)`. Preserve hypotheses; reject an invalid conclusion + * or frame and return `empty_theorem`. + */ +PROOF thm viewshift_frame_slrule(const thm change, const term frame); + +/** + * Combine two view shifts under separating conjunction. + * + * From `𝒜 ⊢ (P1 ⇛ Q1)` and `ℬ ⊢ (P2 ⇛ Q2)`, return + * `𝒜 ∪ ℬ ⊢ (P1 ** P2 ⇛ Q1 ** Q2)`. Malformed inputs report a prover error + * and return `empty_theorem`. + */ +PROOF thm viewshift_sep_slrule(const thm first, const thm second); + +/** + * Lift a pointwise universally quantified view shift through existential + * assertions. + * + * ```text + * 𝒜 ⊢ ∀x. P(x) ⇛ Q(x) + * ------------------------------------------------ + * 𝒜 ⊢ (∃SL x. P(x)) ⇛ (∃SL x. Q(x)) + * ``` + * + * The conclusion of `pointwise` must have exactly one outer universal binder + * whose body is an active view shift. The witness type and exact public binder + * syntax are taken from that binder. Only the four family applications + * introduced by specializing the installed primitive are beta-contracted; + * existing redexes inside `P(x)` or `Q(x)` are retained. Theorem hypotheses + * are preserved. + */ +PROOF thm viewshift_exists_slrule(const thm pointwise); + +/** + * Extract the source of a view shift from a complete assertion and preserve + * every unselected resource as its exact linear frame. + * + * ```text + * 𝒜 ⊢ P ⇛ Q ⊢ whole = P ** F + * -------------------------------------- + * 𝒜 ⊢ whole ⇛ Q ** F + * ``` + * + * `sep_lift_slrule` performs occurrence-sensitive multiset extraction. + * Source transport is certified in HOL by applying the fixed-target + * view-shift predicate to the equality and using `EQ_MP` on its symmetry; + * the endpoint is never replaced only in host code. + */ +PROOF thm viewshift_frame_at_slrule(const thm change, + const term whole_source); + /** * Frame an entailment with the same assertion on its left. * @@ -710,7 +1127,7 @@ PROOF thm antisym_slrule(const thm ent1, const thm ent2); * 𝒜 ⊢ (F ** H ⊢SL F ** K) * ``` * - * Given `𝒜 ⊢ (H ⊢SL K)` and `F:hprop`, return + * Given `𝒜 ⊢ (H ⊢SL K)` and `F:sl_prop()`, return * `𝒜 ⊢ (F ** H ⊢SL F ** K)`. Hypotheses are unchanged; a malformed * entailment or non-SL frame is a prover error. */ @@ -725,7 +1142,7 @@ PROOF thm frame_left_slrule(const term hp, const thm ent); * 𝒜 ⊢ (H ** F ⊢SL K ** F) * ``` * - * Given `𝒜 ⊢ (H ⊢SL K)` and `F:hprop`, return + * Given `𝒜 ⊢ (H ⊢SL K)` and `F:sl_prop()`, return * `𝒜 ⊢ (H ** F ⊢SL K ** F)`. Hypotheses are unchanged; a malformed * entailment or non-SL frame is a prover error. */ @@ -752,11 +1169,11 @@ PROOF thm frame_mono_slrule(const thm ent1, const thm ent2); * ```text * 𝒜 ⊢ (H ⊢SL K) ℬ ⊢ (H' ⊢SL F) H ≡α H' * --------------------------------------------- conj_slrule - * 𝒜 ∪ ℬ ⊢ (H ⊢SL K && F) + * 𝒜 ∪ ℬ ⊢ (H ⊢SL (K && F)) * ``` * * Given `𝒜 ⊢ (H ⊢SL K)` and `ℬ ⊢ (H' ⊢SL F)` with `H ≡α H'`, return - * `𝒜 ∪ ℬ ⊢ (H ⊢SL K && F)`. Non-entailments or antecedents not matching + * `𝒜 ∪ ℬ ⊢ (H ⊢SL (K && F))`. Non-entailments or antecedents not matching * modulo ≡α are prover errors. */ PROOF thm conj_slrule(const thm ent1, const thm ent2); @@ -765,12 +1182,12 @@ PROOF thm conj_slrule(const thm ent1, const thm ent2); * Project the left additive conjunct from an entailment consequent. * * ```text - * 𝒜 ⊢ (H ⊢SL K && F) + * 𝒜 ⊢ (H ⊢SL (K && F)) * ------------------------- conj1_slrule * 𝒜 ⊢ (H ⊢SL K) * ``` * - * Given `𝒜 ⊢ (H ⊢SL K && F)`, return `𝒜 ⊢ (H ⊢SL K)`. Reject a consequent + * Given `𝒜 ⊢ (H ⊢SL (K && F))`, return `𝒜 ⊢ (H ⊢SL K)`. Reject a consequent * that is not an outermost additive conjunction. */ PROOF thm conj1_slrule(const thm ent); @@ -779,12 +1196,12 @@ PROOF thm conj1_slrule(const thm ent); * Project the right additive conjunct from an entailment consequent. * * ```text - * 𝒜 ⊢ (H ⊢SL K && F) + * 𝒜 ⊢ (H ⊢SL (K && F)) * ------------------------- conj2_slrule * 𝒜 ⊢ (H ⊢SL F) * ``` * - * Given `𝒜 ⊢ (H ⊢SL K && F)`, return `𝒜 ⊢ (H ⊢SL F)`. Reject a consequent + * Given `𝒜 ⊢ (H ⊢SL (K && F))`, return `𝒜 ⊢ (H ⊢SL F)`. Reject a consequent * that is not an outermost additive conjunction. */ PROOF thm conj2_slrule(const thm ent); @@ -795,11 +1212,11 @@ PROOF thm conj2_slrule(const thm ent); * ```text * 𝒜 ⊢ (H ⊢SL K) * -------------------------- disj1_slrule F - * 𝒜 ⊢ (H ⊢SL K || F) + * 𝒜 ⊢ (H ⊢SL (K || F)) * ``` * - * Given `𝒜 ⊢ (H ⊢SL K)` and `F:hprop`, return - * `𝒜 ⊢ (H ⊢SL K || F)`. A malformed entailment or non-SL alternative is a + * Given `𝒜 ⊢ (H ⊢SL K)` and `F:sl_prop()`, return + * `𝒜 ⊢ (H ⊢SL (K || F))`. A malformed entailment or non-SL alternative is a * prover error. */ PROOF thm disj1_slrule(const thm ent, const term hp); @@ -810,11 +1227,11 @@ PROOF thm disj1_slrule(const thm ent, const term hp); * ```text * 𝒜 ⊢ (H ⊢SL K) * -------------------------- disj2_slrule F - * 𝒜 ⊢ (H ⊢SL F || K) + * 𝒜 ⊢ (H ⊢SL (F || K)) * ``` * - * Given `𝒜 ⊢ (H ⊢SL K)` and `F:hprop`, return - * `𝒜 ⊢ (H ⊢SL F || K)`. A malformed entailment or non-SL alternative is a + * Given `𝒜 ⊢ (H ⊢SL K)` and `F:sl_prop()`, return + * `𝒜 ⊢ (H ⊢SL (F || K))`. A malformed entailment or non-SL alternative is a * prover error. */ PROOF thm disj2_slrule(const term hp, const thm ent); @@ -840,11 +1257,11 @@ PROOF thm disj_slrule(const thm ent1, const thm ent2); * ```text * 𝒜 ⊢ (H₁ ⊢SL K₁) ℬ ⊢ (H₂ ⊢SL K₂) * ----------------------------------------- disj_mono_slrule - * 𝒜 ∪ ℬ ⊢ (H₁ || H₂ ⊢SL K₁ || K₂) + * 𝒜 ∪ ℬ ⊢ ((H₁ || H₂) ⊢SL (K₁ || K₂)) * ``` * * Given `𝒜 ⊢ (H₁ ⊢SL K₁)` and `ℬ ⊢ (H₂ ⊢SL K₂)`, return - * `𝒜 ∪ ℬ ⊢ (H₁ || H₂ ⊢SL K₁ || K₂)`. Both inputs must conclude SL + * `𝒜 ∪ ℬ ⊢ ((H₁ || H₂) ⊢SL (K₁ || K₂))`. Both inputs must conclude SL * entailments. */ PROOF thm disj_mono_slrule(const thm ent1, const thm ent2); @@ -888,6 +1305,33 @@ PROOF thm choose_slrule(const term v, const term ehp, const thm ent); */ PROOF thm exists_slrule(const term ehp, const term wit, const thm ent); +/** + * Pull an actual left existential through separating conjunction. + * + * For `E = ∃SL x. B`, return the capture-avoiding raw equality + * `∅ ⊢ E ** F = ∃SL y. (B[y/x] ** F)`, where `y = x` when `x` is not free + * in `F` and otherwise `y` is fresh for `F`. The rule specializes the + * installed family law to `E` and beta-contracts only the family application + * introduced in its result. The left endpoint retains the exact supplied `E` + * and `F`; the result binder is renamed only when retaining it would capture + * the frame. Existing beta-redexes inside `B` or `F` are not reduced. + * A non-existential `ehp` or a frame outside the active assertion type is a + * prover error. + */ +PROOF thm sep_exists_left_slrule(const term ehp, const term frame); + +/** + * Pull an actual right existential through separating conjunction. + * + * For `E = ∃SL x. B`, return the capture-avoiding raw equality + * `∅ ⊢ F ** E = ∃SL y. (F ** B[y/x])`, where `y = x` when safe and otherwise + * `y` is fresh for `F`. Beta reduction is confined to the generated family + * application in the specialized primitive instance. The left endpoint + * retains the exact supplied terms; the result binder is renamed only to + * avoid capturing the frame, and existing redexes in `B` or `F` are retained. + */ +PROOF thm sep_exists_right_slrule(const term frame, const term ehp); + /** * Quantify both sides of an entailment over one eigenvariable. * @@ -976,13 +1420,13 @@ PROOF thm elim_fact_slrule(const term p, const thm ent); * * ```text * ------------------------------------------------- normalize_slrule - * ∅ ⊢ (H ** fact(T) ** emp ** K =ₕ H ** K) + * ∅ ⊢ (H ** fact(T) ** emp ** K = H ** K) * ``` * - * For `H:hprop`, recursively rewrite `fact(T)` to `emp` and + * For `H:sl_prop()`, recursively rewrite `fact(T)` to `emp` and * eliminate `emp` on either side of every `**` reached by that rewrite set. * If the resulting term is `N(H)`, return the closed equality - * `∅ ⊢ (H =ₕ N(H))`. No associativity or commutativity + * `∅ ⊢ (H = N(H))`. No associativity or commutativity * reordering is performed. A non-SL input is a prover error. */ PROOF thm normalize_slrule(const term hp); @@ -993,11 +1437,11 @@ PROOF thm normalize_slrule(const term hp); * ```text * H ≡AC K * ---------------- ac_slrule H K - * ∅ ⊢ (H =ₕ K) + * ∅ ⊢ (H = K) * ``` * * For SL assertions `H` and `K`, when the current HOL AC conversion establishes - * `H ≡AC K`, return the closed equality `∅ ⊢ (H =ₕ K)` with exactly the + * `H ≡AC K`, return the closed equality `∅ ⊢ (H = K)` with exactly the * caller-supplied endpoints. Otherwise report a prover error and return * `empty_theorem`. Units are not ignored. The underlying conversion is * incomplete for some combinations of AC reordering and binder renaming. @@ -1010,11 +1454,11 @@ PROOF thm ac_slrule(const term hp1, const term hp2); * ```text * H ≡ACU K * ------------------ acu_slrule H K - * ∅ ⊢ (H =ₕ K) + * ∅ ⊢ (H = K) * ``` * * For SL assertions `H` and `K`, normalize the units and invoke `ac_slrule`. - * On success, return the closed equality `∅ ⊢ (H =ₕ K)` with exactly the + * On success, return the closed equality `∅ ⊢ (H = K)` with exactly the * caller-supplied endpoints. `emp` and `fact(T)` are the normalized units. * Otherwise report a prover error and return `empty_theorem`; the same * binder-renaming completeness limitation applies. @@ -1027,12 +1471,12 @@ PROOF thm acu_slrule(const term hp1, const term hp2); * ```text * res(L) ⊑ₘ res(H) F = Sep(res(H) ∖ₘ res(L)) * ------------------------------------------------ sep_lift_slrule H L - * ∅ ⊢ (H =ₕ L ** F) + * ∅ ⊢ (H = L ** F) * ``` * * Require `res(lifted_hp) ⊑ₘ res(hp)` and put * `F = Sep(res(hp) ∖ₘ res(lifted_hp))`. Return the closed equality - * `∅ ⊢ (hp =ₕ lifted_hp ** F)`. Each selected occurrence is + * `∅ ⊢ (hp = lifted_hp ** F)`. Each selected occurrence is * consumed once modulo ≡α; unmatched occurrences retain their relative order * in `F`. Both equality endpoints retain the caller's exact syntax. Non-SL * inputs or an unavailable resource occurrence are prover errors. @@ -1135,8 +1579,11 @@ PROOF thm list_trans_slrule(const thm_list ents); * Given `V = [x₀, …, xₙ₋₁]` and `𝒜 ⊢ (H ⊢SL K)`, require every `xᵢ` to be a * variable not free in any hypothesis in `𝒜`. Return * `𝒜 ⊢ (Ex(V, H) ⊢SL Ex(V, K))`. Binder order follows `vs`; for `V = []` the - * input theorem is returned unchanged. A nonvariable binder, a binder that - * occurs free in 𝒜, or a malformed entailment is a prover error. + * input theorem is returned unchanged. Each introduction is endpoint-aligned + * back to the explicit selected-binder syntax; internal lambda applications + * from the primitive monotonicity theorem do not escape this API. A nonvariable + * binder, a binder that occurs free in 𝒜, or a malformed entailment is a prover + * error. */ PROOF thm list_exists_mono_slrule(const term_list vs, const thm ent); diff --git a/proof_symexec.h b/proof_symexec.h index 8632d1a..b6765ec 100644 --- a/proof_symexec.h +++ b/proof_symexec.h @@ -8,15 +8,17 @@ * equations. These are explicit runtime assumptions in the trusted computing * base, not user-proved or inherited derived lemmas. * - * This header inherits the canonical HOL and SL notation from - * `proof_backward.h`. In particular, Γ is the ordered labeled ordinary - * context and 𝒜 denotes theorem hypotheses. A tactic evolves a goal as - * `G → [G₁, …, Gₙ]`; validation runs in the opposite, bottom-up direction - * from the child theorems to a theorem for G. + * This header inherits the canonical HOL and SL notation from `proof_sl.h` + * and the generic goal representation from `proof_backward.h`. In particular, + * Γ is the ordered labeled ordinary context and 𝒜 denotes theorem hypotheses. A + * tactic evolves a goal as `G → [G₁, …, Gₙ]`; validation runs in the + * opposite, bottom-up direction from the child theorems to a theorem for G. */ #pragma once +#include "proof/proof_sl.h" +#require "proof/proof_sl.c" #include "proof/proof_backward.h" #require "proof/proof_backward.c" @@ -26,11 +28,14 @@ * For `[Γ ?⊢ H ⊢SL K]`, print `H` and `K`, invoke the active backend in * `Tagcancel` scope, parse its result `p`, and create `[Γ ?⊢ p]`. The * validator uses a fresh assumed bridge `p ⇒ (H ⊢SL K)`; it does not derive - * or independently check that bridge. + * or independently check that bridge. Thus a child theorem `𝒜 ⊢ p` validates + * to `𝒜 ⊢ (H ⊢SL K)` by modus ponens; the C `gnode` result is only the child + * node handle. * * Return the Boolean child. Fail for a non-entailment conclusion, backend - * failure, an empty result, or a parse/expansion error. This tactic enlarges - * the trusted computing base whenever it is used. + * failure, an empty result, or a parse/expansion error by reporting a prover + * error and returning `empty_gnode`. This tactic enlarges the trusted computing + * base whenever it is used. */ PROOF gnode PURIFY_TAC(gnode gn); @@ -46,7 +51,14 @@ PROOF gnode PURIFY_TAC(gnode gn); * unsupported SL subterms disappear. * * Return the conversion child, or a solved node when rewriting yields `T`. - * Conversion failures propagate normally. The three private equations are - * explicit trust assumptions, not derived SL rules. + * Conversion failures propagate as a prover error and `empty_gnode`. The three + * private equations are explicit trust assumptions, not derived SL rules. + * + * On the first call, those equations are created once with `new_axiom` using + * the then-active parser and SL operator heads, and their handles are retained + * in process-global static storage. They are not keyed by + * `sl_theory_generation()`. After `POST_PURIFY_TAC` has first been called, the + * process must not install a different SL theory and call it again; doing so + * may leave the retained equations ill-typed or headed by the previous theory. */ PROOF gnode POST_PURIFY_TAC(gnode gn); diff --git a/proof_user.c b/proof_user.c index 78a9a20..5215c96 100644 --- a/proof_user.c +++ b/proof_user.c @@ -3,7 +3,7 @@ /* Scan the source once while consuming requested occurrences individually. */ PROOF static term_list term_list_subtract_once(const term_list source, const term_list removals, - size_t* unmatched_count) { + size_t *unmatched_count) { term_list unmatched = (term_list)vector_copy(removals); term_list remaining = (term_list)vector_create(); size_t source_size = vector_size(source); @@ -22,23 +22,28 @@ PROOF static term_list term_list_subtract_once(const term_list source, PROOF term_list term_list_subtract(const term_list tms1, const term_list tms2) { size_t unmatched_count = 0; - return term_list_subtract_once(tms1, tms2, &unmatched_count); + term_list result = term_list_subtract_once(tms1, tms2, &unmatched_count); + return result; } PROOF bool term_list_try_subtract(const term_list source, const term_list removals, - term_list* remaining) { + term_list *remaining) { ENSURE_COND(remaining != NULL, "Result slot is null"); size_t unmatched_count = 0; term_list result = term_list_subtract_once(source, removals, &unmatched_count); - if (unmatched_count != 0) return false; + if (unmatched_count != 0) + return false; *remaining = result; return true; err: - ERR_FUN_PUTS("term_list_try_subtract", cstr_term_list(source), - cstr_term_list(removals)); - return false; + { + char *source_text = cstr_term_list(source); + char *removals_text = cstr_term_list(removals); + ERR_FUN_PUTS("term_list_try_subtract", source_text, removals_text); + return false; + } } PROOF term_list term_list_subtract_checked(const term_list source, @@ -50,9 +55,12 @@ PROOF term_list term_list_subtract_checked(const term_list source, "the source terms"); return remaining; err: - ERR_FUN_PUTS("term_list_subtract_checked", cstr_term_list(source), - cstr_term_list(removals)); - return NULL; + { + char *source_text = cstr_term_list(source); + char *removals_text = cstr_term_list(removals); + ERR_FUN_PUTS("term_list_subtract_checked", source_text, removals_text); + return NULL; + } } PROOF bool term_list_is_subset(const term_list tms1, const term_list tms2) { @@ -69,7 +77,8 @@ PROOF bool term_list_is_subset(const term_list tms1, const term_list tms2) { PROOF bool term_list_is_submultiset(const term_list tms1, const term_list tms2) { term_list remaining = NULL; - return term_list_try_subtract(tms2, tms1, &remaining); + bool result = term_list_try_subtract(tms2, tms1, &remaining); + return result; } PROOF int term_list_index(const term_list tms, const term tm) { @@ -94,8 +103,8 @@ PROOF labeled_term_list labeled_term_list_n(const size_t size, ...) { return ltms; } -PROOF labeled_term_list labeled_term_list_subtract(const labeled_term_list ltms1, - const labeled_term_list ltms2) { +PROOF labeled_term_list labeled_term_list_subtract( + const labeled_term_list ltms1, const labeled_term_list ltms2) { labeled_term_list copy = (labeled_term_list)vector_copy(ltms1); size_t sz = vector_size(ltms2); for (size_t i = 0; i < sz; ++i) { @@ -107,7 +116,8 @@ PROOF labeled_term_list labeled_term_list_subtract(const labeled_term_list ltms1 return copy; } -PROOF int labeled_term_list_index(const labeled_term_list ltms, const char* lb) { +PROOF int labeled_term_list_index(const labeled_term_list ltms, + const char *lb) { size_t sz = vector_size(ltms); for (size_t i = 0; i < sz; ++i) { if (ltms[i].lb && strcmp(ltms[i].lb, lb) == 0) { @@ -118,7 +128,7 @@ PROOF int labeled_term_list_index(const labeled_term_list ltms, const char* lb) } PROOF labeled_term_list labeled_term_list_extract(const labeled_term_list ltms, - const char** lbs) { + const char **lbs) { labeled_term_list result = (labeled_term_list)vector_create(); size_t sz = vector_size(lbs); for (size_t i = 0; i < sz; ++i) { @@ -129,9 +139,12 @@ PROOF labeled_term_list labeled_term_list_extract(const labeled_term_list ltms, } return result; err: - ERR_FUN_PUTS("labeled_term_list_extract", cstr_labeled_term_list(ltms), - cstr_string_list(lbs)); - return NULL; + { + char *terms_text = cstr_labeled_term_list(ltms); + char *labels_text = cstr_string_list(lbs); + ERR_FUN_PUTS("labeled_term_list_extract", terms_text, labels_text); + return NULL; + } } PROOF term_list labeled_term_list_to_term_list(const labeled_term_list ltms) { @@ -143,10 +156,10 @@ PROOF term_list labeled_term_list_to_term_list(const labeled_term_list ltms) { return tms; } -PROOF const char* variant_label(const labeled_term_list ltms, const char* prefix) { - const char* requested = prefix == NULL ? "" : prefix; - if (requested[0] != '\0' && - labeled_term_list_index(ltms, requested) == -1) { +PROOF const char *variant_label(const labeled_term_list ltms, + const char *prefix) { + const char *requested = prefix == NULL ? "" : prefix; + if (requested[0] != '\0' && labeled_term_list_index(ltms, requested) == -1) { return GC_STRDUP(requested); } @@ -166,119 +179,209 @@ PROOF const char* variant_label(const labeled_term_list ltms, const char* prefix suffix_start = base_len; } - char* base = (char*)GC_MALLOC(suffix_start + 1); + char *base = (char *)GC_MALLOC(suffix_start + 1); memcpy(base, requested, suffix_start); base[suffix_start] = '\0'; while (true) { - const char* candidate = gc_sprintf("%s_%zu", base, n); - if (labeled_term_list_index(ltms, candidate) == -1) return candidate; + const char *candidate = gc_sprintf("%s_%zu", base, n); + if (labeled_term_list_index(ltms, candidate) == -1) + return candidate; ++n; } } -PROOF char* cstr_term_list(const term_list tms) { - char* buf = GRAY("["); +PROOF char *cstr_term_list(const term_list tms) { + char *buf = GRAY("["); + char *comma = GRAY(","); + char *close = GRAY("]"); bool first = true; size_t sz = vector_size(tms); for (size_t i = 0; i < sz; ++i) { - char* tm_cstr = cstr_term(tms[i]); + char *tm_cstr = cstr_term(tms[i]); if (!first) { - buf = gc_strcat(buf, GRAY(",")); + buf = gc_strcat(buf, comma); buf = gc_strcat(buf, tm_cstr); } else { buf = gc_strcat(buf, tm_cstr); first = false; } } - buf = gc_strcat(buf, GRAY("]")); + buf = gc_strcat(buf, close); return buf; } -PROOF char* cstr_thm_list(const thm_list ths) { - char* buf = GRAY("["); +PROOF char *cstr_thm_list(const thm_list ths) { + char *buf = GRAY("["); + char *comma = GRAY(","); + char *close = GRAY("]"); bool first = true; size_t sz = vector_size(ths); for (size_t i = 0; i < sz; ++i) { - char* th_cstr = cstr_thm(ths[i]); + char *th_cstr = cstr_thm(ths[i]); if (!first) { - buf = gc_strcat(buf, GRAY(",")); + buf = gc_strcat(buf, comma); buf = gc_strcat(buf, th_cstr); } else { buf = gc_strcat(buf, th_cstr); first = false; } } - buf = gc_strcat(buf, GRAY("]")); + buf = gc_strcat(buf, close); return buf; } -PROOF char* cstr_term_pair_list(const term_pair_list tmps) { - char* buf = GRAY("["); +PROOF char *cstr_term_pair_list(const term_pair_list tmps) { + char *buf = GRAY("["); + char *comma = GRAY(","); + char *close = GRAY("]"); bool first = true; size_t sz = vector_size(tmps); for (size_t i = 0; i < sz; ++i) { - char* tmp_cstr = cstr_term_pair(tmps[i]); + char *tmp_cstr = cstr_term_pair(tmps[i]); if (!first) { - buf = gc_strcat(buf, GRAY(",")); + buf = gc_strcat(buf, comma); buf = gc_strcat(buf, tmp_cstr); } else { buf = gc_strcat(buf, tmp_cstr); first = false; } } - buf = gc_strcat(buf, GRAY("]")); + buf = gc_strcat(buf, close); return buf; } -PROOF char* cstr_labeled_term(const labeled_term_list ltm) { - char* buf = GRAY(ltm->lb); - buf = gc_strcat(buf, GRAY(":")); - buf = gc_strcat(buf, cstr_term(ltm->tm)); +PROOF char *cstr_labeled_term(const labeled_term_list ltm) { + char *buf = GRAY(ltm->lb); + char *colon = GRAY(":"); + buf = gc_strcat(buf, colon); + char *term_text = cstr_term(ltm->tm); + buf = gc_strcat(buf, term_text); return buf; } -PROOF char* cstr_labeled_term_list(const labeled_term_list ltms) { - char* buf = GRAY("["); +PROOF char *cstr_labeled_term_list(const labeled_term_list ltms) { + char *buf = GRAY("["); + char *comma = GRAY(","); + char *close = GRAY("]"); bool first = true; size_t sz = vector_size(ltms); for (size_t i = 0; i < sz; ++i) { - char* ltm_cstr = cstr_labeled_term(<ms[i]); + char *ltm_cstr = cstr_labeled_term(<ms[i]); if (!first) { - buf = gc_strcat(buf, GRAY(",")); + buf = gc_strcat(buf, comma); buf = gc_strcat(buf, ltm_cstr); } else { buf = gc_strcat(buf, ltm_cstr); first = false; } } - buf = gc_strcat(buf, GRAY("]")); + buf = gc_strcat(buf, close); return buf; } -PROOF char* cstr_string_list(const char** strs) { - char* buf = GRAY("["); +PROOF char *cstr_string_list(const char **strs) { + char *buf = GRAY("["); + char *comma = GRAY(","); + char *close = GRAY("]"); bool first = true; size_t sz = vector_size(strs); for (size_t i = 0; i < sz; ++i) { - char* str_cstr = cstr_string(strs[i]); + char *str_cstr = cstr_string(strs[i]); if (!first) { - buf = gc_strcat(buf, GRAY(",")); + buf = gc_strcat(buf, comma); buf = gc_strcat(buf, str_cstr); } else { buf = gc_strcat(buf, str_cstr); first = false; } } - buf = gc_strcat(buf, GRAY("]")); + buf = gc_strcat(buf, close); return buf; } -PROOF bool term_is_matched(const term_list local_constants, - const term pattern, const term target) { +PROOF static int type_match_for_icomb(const type pattern, const type target, + type_pair_list *type_substitution) { + ENSURE_COND(type_substitution != NULL, + "type-instantiation output must not be null"); + ENSURE_COND(*type_substitution != NULL, + "type-instantiation vector must not be null"); + + if (is_var_type(pattern)) { + for (size_t i = 0; i < vector_size(*type_substitution); ++i) { + if (equals_type((*type_substitution)[i].snd, pattern)) { + bool repeated_match_is_consistent = + equals_type((*type_substitution)[i].fst, target); + ENSURE_COND(repeated_match_is_consistent, + "inconsistent repeated type-variable match"); + return 0; + } + } + vector_add(type_substitution, ((type_pair){target, pattern})); + return 0; + } + + bool target_is_application = is_app_type(target); + ENSURE_COND(target_is_application, + "type constructor cannot match a type variable"); + dest_app_type_results pattern_app = dest_app_type(pattern); + dest_app_type_results target_app = dest_app_type(target); + int constructor_name_order = strcmp(pattern_app.s, target_app.s); + size_t pattern_arity = vector_size(pattern_app.tys); + size_t target_arity = vector_size(target_app.tys); + bool constructors_match = + constructor_name_order == 0 && pattern_arity == target_arity; + ENSURE_COND(constructors_match, + "type constructors do not match"); + for (size_t i = 0; i < vector_size(pattern_app.tys); ++i) { + type_match_for_icomb(pattern_app.tys[i], target_app.tys[i], + type_substitution); + } + return 0; +err: + { + ERR_FUN_PUTS("type_match_for_icomb"); + return -1; + } +} + +PROOF term mk_icomb(const term f, const term x) { + bool f_is_empty = IS_NULL(f); + bool x_is_empty = IS_NULL(x); + ENSURE_COND(!f_is_empty && !x_is_empty, + "combination terms must not be empty"); + type f_type = type_of(f); + bool f_is_function = is_fun_type(f_type); + ENSURE_COND(f_is_function, "combination rator is not a function"); + dest_app_type_results function_app = dest_app_type(f_type); + int function_name_order = strcmp(function_app.s, "fun"); + size_t function_arity = vector_size(function_app.tys); + bool function_shape_is_valid = + function_name_order == 0 && function_arity == 2; + ENSURE_COND(function_shape_is_valid, + "combination rator has a malformed function type"); + + type_pair_list type_substitution = (type_pair_list)vector_create(); + type x_type = type_of(x); + type_match_for_icomb(function_app.tys[0], x_type, &type_substitution); + term specialized = tyvar_inst(type_substitution, f); + term result = mk_comb(specialized, x); + return result; +err: + { + char *function_text = cstr_term(f); + char *argument_text = cstr_term(x); + ERR_FUN_PUTS("mk_icomb", function_text, argument_text); + return empty_term; + } +} + +PROOF bool term_is_matched(const term_list local_constants, const term pattern, + const term target) { proof_try_begin(); term_match((term_list)local_constants, pattern, target); bool failed = NOT_OK; - if (failed) SET_OK(); + if (failed) + SET_OK(); proof_try_end(); return !failed; } @@ -288,8 +391,13 @@ PROOF term subst_one(term tm1, term tm2, term tm) { term ret = subst(pairs, tm); return ret; err: - ERR_FUN_PUTS("subst_one", cstr_term(tm1), cstr_term(tm2), cstr_term(tm)); - return empty_term; + { + char *replacement_text = cstr_term(tm1); + char *variable_text = cstr_term(tm2); + char *body_text = cstr_term(tm); + ERR_FUN_PUTS("subst_one", replacement_text, variable_text, body_text); + return empty_term; + } } PROOF thm list_trans_rule(const thm_list ths) { @@ -301,8 +409,11 @@ PROOF thm list_trans_rule(const thm_list ths) { } return res_th; err: - ERR_FUN_PUTS("list_trans_rule", cstr_thm_list(ths)); - return empty_theorem; + { + char *theorems_text = cstr_thm_list(ths); + ERR_FUN_PUTS("list_trans_rule", theorems_text); + return empty_theorem; + } } PROOF thm list_match_mp_rule(const thm th, const thm_list ths) { @@ -316,8 +427,12 @@ PROOF thm list_match_mp_rule(const thm th, const thm_list ths) { PROOF thm undisch_all_rule(const thm th) { thm res_th = th; - while (is_imp(concl(res_th))) { + term res_conclusion = concl(res_th); + bool res_is_implication = is_imp(res_conclusion); + while (res_is_implication) { res_th = undisch_rule(res_th); + res_conclusion = concl(res_th); + res_is_implication = is_imp(res_conclusion); } return res_th; } @@ -331,8 +446,12 @@ PROOF thm list_mk_binop_rule(term op, const thm_list eqs) { } return res_th; err: - ERR_FUN_PUTS("list_mk_binop_rule", cstr_term(op), cstr_thm_list(eqs)); - return empty_theorem; + { + char *operator_text = cstr_term(op); + char *equations_text = cstr_thm_list(eqs); + ERR_FUN_PUTS("list_mk_binop_rule", operator_text, equations_text); + return empty_theorem; + } } PROOF static thm get_not_elim_thm() { @@ -346,7 +465,8 @@ PROOF static thm get_not_elim_thm() { } PROOF thm not_elim_rule(const thm not_p, const thm p) { - thm eliminate = match_mp_rule(get_not_elim_thm(), not_p); + thm not_elim = get_not_elim_thm(); + thm eliminate = match_mp_rule(not_elim, not_p); thm result = match_mp_rule(eliminate, p); return result; } @@ -367,8 +487,12 @@ PROOF thm false_elim_rule(const thm fth, const term ccl) { thm res_th = match_mp_rule(mid_th, fth); return res_th; err: - ERR_FUN_PUTS("false_elim_rule", cstr_thm(fth), cstr_term(ccl)); - return empty_theorem; + { + char *false_theorem_text = cstr_thm(fth); + char *conclusion_text = cstr_term(ccl); + ERR_FUN_PUTS("false_elim_rule", false_theorem_text, conclusion_text); + return empty_theorem; + } } PROOF thm mk_binop_rule(term op, thm eq1, thm eq2) { diff --git a/proof_user.h b/proof_user.h index bf6ff94..7721a7c 100644 --- a/proof_user.h +++ b/proof_user.h @@ -4,8 +4,14 @@ * This header provides vector operations, term utilities, printers, and * derived HOL rules built on the proof kernel. * - * This header inherits the canonical notation from `proof_kernel.h` and adds - * occurrence-sensitive relations for vector operations. + * This header inherits the canonical typing notation `t:τ` and theorem + * judgment `𝒜 ⊢ φ` from `proof_kernel.h` and adds occurrence-sensitive relations for vector + * operations. As there, a C `thm` result is an opaque theorem handle; the HOL + * conclusion and hypotheses are stated separately in each rule's contract. + * Fresh vectors and rendered strings inherit the prover/GC lifetime rules of + * `proof_kernel.h`. Unless stated otherwise, a reported prover error makes a + * returned HOL handle/record unusable (the C boundary uses its documented empty + * sentinel); it does not establish the negation of the requested theorem. * * - For an element equivalence ≈, μ≈(X, a) counts occurrences in X * equivalent to a. Then X ⊑ₘ[≈] Y means μ≈(X, a) ≤ μ≈(Y, a) for every a. @@ -19,10 +25,21 @@ #pragma once +#include "proof/syntax/base.h" +#require "proof/syntax/base.c" + #include "proof/proof_kernel.h" +/** Vector length/index type used by the runtime vector API. */ PROOF typedef size_t vec_size_t; +/** + * Construct a fresh `labeled_term_list` container from record values. + * + * The macro computes arity from its arguments and delegates to + * `labeled_term_list_n`; term handles and label pointers are shared. Arguments + * must have type `labeled_term` and are evaluated once by the generated call. + */ #define LABELED_TERM_LIST(...) \ labeled_term_list_n(sizeof((labeled_term[]){__VA_ARGS__}) / sizeof(labeled_term), ##__VA_ARGS__) @@ -31,13 +48,22 @@ PROOF typedef size_t vec_size_t; /** * Pair a HOL term with an optional user-facing label. * - * `lb` may be `NULL` for an intentionally unlabeled record. APIs that select - * records by label state their stronger non-null requirements separately. + * `lb` may be `NULL` for an intentionally unlabeled record. It is a borrowed + * pointer and must remain valid for every API that consumes the record. APIs + * that select or print records by label state stronger non-null requirements. */ PROOF typedef struct labeled_term { + /** Shared, prover-managed HOL term handle. */ term tm; /* The term. */ + /** Borrowed label string, or `NULL` when intentionally unlabeled. */ const char* lb; /* The label. */ } labeled_term; +/** + * Mutable vector-backed sequence of record values. + * + * Resizing may relocate the container; term handles and label pointers remain + * shallow shared values and are never freed with the vector. + */ PROOF typedef labeled_term* labeled_term_list; /*------------------------- Vector constructors -------------------------*/ @@ -49,7 +75,8 @@ PROOF typedef labeled_term* labeled_term_list; * `r[0], ..., r[n-1]`, returns a fresh vector `R` with `|R| = n` and * `R[i] = r[i]` for `0 <= i < n`. Term handles and label pointers are copied * into the vector without copying their targets. The result is empty for - * `n = 0`. + * `n = 0`. The fresh container is GC-managed and non-null on success; supplied + * label strings must outlive all uses of it. * * The call must supply exactly `size` arguments of type `labeled_term`; * violating this C ABI precondition is undefined behavior. @@ -169,8 +196,11 @@ PROOF int labeled_term_list_index(const labeled_term_list ltms, const char* lb); * `[(x,"H"),(y,"K"),(z,"H")]` returns * `[(y,"K"),(x,"H"),(y,"K")]`. * - * Every entry of `lbs` must be a valid non-null C string. A missing label - * reports a prover error and returns `NULL`. + * Every entry of `lbs` and every label in the source `ltms` must be a valid + * non-null C string. The source-wide requirement is needed because the + * missing-label diagnostic renders the complete source with + * `cstr_labeled_term_list`. A missing requested label reports a prover error + * and returns `NULL` when these preconditions hold. */ PROOF labeled_term_list labeled_term_list_extract(const labeled_term_list ltms, const_cstr_list lbs); @@ -194,7 +224,7 @@ PROOF term_list labeled_term_list_to_term_list(const labeled_term_list ltms); * * With existing labels `"H"`, `"H_0"`, and `"H_2"`, prefix `"H"` produces * `"H_1"`, while an unused prefix `"K"` is returned unchanged. A null or - * empty prefix starts with `"_0"`. + * empty prefix starts with `"_0"`. The returned copy is GC-managed. */ PROOF const char* variant_label(const labeled_term_list ltms, const char* prefix); @@ -231,18 +261,18 @@ PROOF char* cstr_thm_list(const thm_list ths); * index order, enclosed in gray brackets and separated by gray commas without * spaces. * - * A visibly rendered pair `(x,y)` becomes `[(x,y)]` in a singleton vector. + * A visibly rendered pair `(x, y)` becomes `[(x, y)]` in a singleton vector. */ PROOF char* cstr_term_pair_list(const term_pair_list tmps); /** - * Render one labeled-term record, omitting a null label. - * - * For the record `r` pointed to by `ltm`, returns gray `r.lb`, gray `":"`, - * and `cstr_term(r.tm)` when the label is non-null; otherwise returns only - * `cstr_term(r.tm)`. + * Render one labeled-term record as `label:term`. * - * Thus `(x,"H")` visibly renders as `H:x`, while `(x,NULL)` renders as `x`. + * For the record `r` pointed to by `ltm`, return gray `r.lb`, gray `":"`, + * and `cstr_term(r.tm)`. Both `ltm` and `r.tm` must be valid, and `r.lb` must + * be a valid non-null C string; the current implementation unconditionally + * renders the label and colon. The returned string is GC-managed. + * Thus `(x,"H")` visibly renders as `H:x`. */ PROOF char* cstr_labeled_term(const labeled_term_list ltm); @@ -253,8 +283,9 @@ PROOF char* cstr_labeled_term(const labeled_term_list ltm); * `cstr_labeled_term(<ms[i])` in index order, enclosed in gray brackets and * separated by gray commas without spaces. * - * Ignoring color escapes, `[(x,"H"),(y,NULL)]` renders as `[H:x,y]` and an - * empty vector as `[]`. + * Every record must have a valid term and a non-null valid label. Ignoring + * color escapes, `[(x,"H"),(y,"K")]` renders as `[H:x,K:y]` and an empty + * vector as `[]`. The returned string is GC-managed. */ PROOF char* cstr_labeled_term_list(const labeled_term_list ltms); @@ -272,6 +303,18 @@ PROOF char* cstr_string_list(const_cstr_list strs); /*-------------------- Term Structure Analysis --------------------*/ +/** + * Make a HOL function application with rator type instantiation. + * + * This is the user-side analogue of HOL Light's `mk_icomb(f,x)`. Match the + * domain of `type_of(f)` against `type_of(x)`, instantiate only the type + * variables of `f`, and then return the kernel-checked `mk_comb(f',x)`. + * Repeated occurrences of a domain type variable must match the same concrete + * type. Report a prover error and return `empty_term` if `f` is not a function + * or its domain cannot be instantiated compatibly. + */ +PROOF term mk_icomb(const term f, const term x); + /** * Test whether HOL Light's term matcher accepts a pattern and target. * @@ -290,6 +333,9 @@ PROOF char* cstr_string_list(const_cstr_list strs); * with `z`. * * Callers cannot distinguish an ordinary mismatch from another matcher error. + * This wrapper uses the runtime's single global proof-try slot; the incoming + * prover status must be OK and no outer proof-try scope may be active. Nested + * use would overwrite the outer try state rather than form a safe nested catch. */ PROOF bool term_is_matched(const term_list local_constants, const term pattern, const term target); @@ -338,8 +384,8 @@ PROOF thm list_trans_rule(const thm_list ths); * theorem exactly as `match_mp_rule` does. An empty `ths` vector returns * `th` unchanged; any failed step propagates the underlying prover error. * - * For example, from `𝒜 ⊢ ∀x. P(x) ⇒ Q(x)` and `ℬ ⊢ P(a)`, one application - * returns `𝒜 ∪ ℬ ⊢ Q(a)`. + * For example, from `𝒜₁ ⊢ ∀x. P(x) ⇒ Q(x)` and `𝒜₂ ⊢ P(a)`, one application + * returns `𝒜₁ ∪ 𝒜₂ ⊢ Q(a)`. */ PROOF thm list_match_mp_rule(const thm th, const thm_list ths); @@ -384,9 +430,9 @@ PROOF thm list_mk_binop_rule(term op, const thm_list eqs); * Derive false from proofs of a proposition and its negation. * * ```text - * 𝒜 ⊢ ¬p ℬ ⊢ p + * 𝒜₁ ⊢ ¬p 𝒜₂ ⊢ p * ---------------- - * 𝒜∪ℬ ⊢ ⊥ + * 𝒜₁∪𝒜₂ ⊢ ⊥ * ``` * The conclusions must use the same proposition modulo the matching accepted * by the underlying specialization and modus-ponens rules; otherwise the diff --git a/test/proof_backward_regression.c b/test/proof_backward_regression.c index 9483bd9..1e315e2 100644 --- a/test/proof_backward_regression.c +++ b/test/proof_backward_regression.c @@ -1,4 +1,6 @@ #include "proof/proof.h" +#include "userlib/qcp/c_logic_default.h" +#require "userlib/qcp/c_logic_default.c" PROOF indtype induction_test_tree = new_datatype_definition( "induction_test_tree = IndLeaf A" @@ -70,6 +72,23 @@ PROOF static thm prove_negation_introduction() { ACCEPT_TAC(auto_body, assume_rule(mk_false())); ENSURE_COND(!IS_NULL(gnode_prove(auto_root)), "AUTO_INTROS_TAC did not validate a negation proof"); + + term redex_prop = `(\p:bool. p) F`; + term neg_redex = mk_not(redex_prop); + gnode redex_root = gnode_new_with_ccl(neg_redex); + gnode redex_body = DISCH_TAC(redex_root, "Hredex"); + labeled_term_list redex_asmps = goal_lasmps(redex_body->g); + ENSURE_COND(vector_size(redex_asmps) == 1 && + equals_term(redex_asmps[0].tm, redex_prop) && + is_false(goal_ccl(redex_body->g)), + "DISCH_TAC reduced a redex inside a negated antecedent"); + conv beta = get_conversion_by_name("BETA_CONV"); + thm redex_false = eq_mp_rule( + apply_conversion(beta, redex_prop), assume_rule(redex_prop)); + ACCEPT_TAC(redex_body, redex_false); + thm redex_result = gnode_prove(redex_root); + ENSURE_COND(equals_term(concl(redex_result), neg_redex), + "Negation validation changed a caller-owned beta-redex"); return result; err: ERR_FUN_PUTS("prove_negation_introduction"); @@ -578,10 +597,10 @@ PROOF static void check_goal_printing_context_names() { strstr(general, "H_keep") != NULL, "General goal uses inconsistent context headings"); - labeled_term spatial = {`hp:hprop`, "R_keep"}; + labeled_term spatial = {`hp:cprop`, "R_keep"}; char* sl = cstr_goal(sl_goal_new(LABELED_TERM_LIST(pure), LABELED_TERM_LIST(spatial), - `hq:hprop`)); + `hq:cprop`)); ENSURE_COND(strstr(sl, "Assumptions:") != NULL && strstr(sl, "Antecedents:") != NULL && strstr(sl, "Consequent:") != NULL && @@ -656,6 +675,21 @@ PROOF static void check_gnode_accept_boundary() { bool stored_aligned = equals_term(stored_ccl, original); ENSURE_COND(returned_aligned && stored_aligned, "gnode_prove did not preserve exact root-binder alignment"); + + term beta_prop = `(\x:num. (p:bool)) 0`; + labeled_term beta_assumption = {beta_prop, "HB"}; + goal beta_goal = + general_goal_new(LABELED_TERM_LIST(beta_assumption), p); + gnode beta_node = gnode_new(beta_goal); + thm beta_assumption_th = assume_rule(beta_prop); + proof_try_begin(); + gnode_accept(beta_node, beta_assumption_th); + bool beta_rejected = NOT_OK && IS_NULL(beta_node->solved); + if (NOT_OK) SET_OK(); + proof_try_end(); + proof_clear_errors(); + ENSURE_COND(beta_rejected, + "gnode_accept accepted a merely beta-equivalent conclusion"); return; err: ERR_FUN_PUTS("check_gnode_accept_boundary"); diff --git a/test/proof_sl_regression.c b/test/proof_sl_regression.c index dcce3ad..3d5f544 100644 --- a/test/proof_sl_regression.c +++ b/test/proof_sl_regression.c @@ -1,11 +1,13 @@ #include "proof/proof.h" +#include "userlib/qcp/c_logic_default.h" +#require "userlib/qcp/c_logic_default.c" PROOF typedef struct hol_text_type_pair test_implicit_type_entry; PROOF typedef test_implicit_type_entry *test_implicit_type_entry_list; PROOF static thm prove_sep_partition() { gnode root = gnode_new_with_ccl( - `(hp_a:hprop) ** hp_b |-- hp_b ** hp_a`); + `(hp_a:cprop) ** hp_b |-- hp_b ** hp_a`); gnode sl = SL_MODE(root, "HA * HB")[0]; gnode_list parts = SEP_SLTAC(sl, CONST_STRING_LIST("HB")); AUTO_FRAME_SLTAC(parts[0]); @@ -15,7 +17,7 @@ PROOF static thm prove_sep_partition() { PROOF static thm prove_disj_swap() { gnode root = gnode_new_with_ccl( - `(hp_a:hprop) || hp_b |-- hp_b || hp_a`); + `(hp_a:cprop) || hp_b |-- hp_b || hp_a`); gnode_list branches = SL_MODE(root, "HA | HB"); AUTO_FRAME_SLTAC(DISJ2_SLTAC(branches[0])); AUTO_FRAME_SLTAC(DISJ1_SLTAC(branches[1])); @@ -24,7 +26,7 @@ PROOF static thm prove_disj_swap() { PROOF static thm prove_disj_reuses_selected_label() { gnode root = gnode_new_with_ccl( - `(hp_a:hprop) || hp_b |-- hp_a || hp_b`); + `(hp_a:cprop) || hp_b |-- hp_a || hp_b`); gnode sl = SL_MODE(root, "H")[0]; gnode_list branches = HANT_DISJ_SLTAC(sl, "H", "H", "H"); AUTO_FRAME_SLTAC(DISJ1_SLTAC(branches[0])); @@ -50,7 +52,7 @@ PROOF static thm prove_nested_exists_restores_exact_parent() { labeled_term existential = {nested, "HEX"}; goal g = sl_goal_new( (labeled_term_list)vector_create(), - LABELED_TERM_LIST(false_fact, existential), `hp_goal:hprop`); + LABELED_TERM_LIST(false_fact, existential), `hp_goal:cprop`); term expected_ccl = goal_ccl(g); gnode root = gnode_new(g); @@ -77,7 +79,7 @@ err: PROOF static thm prove_wand_application_with_frame() { gnode root = gnode_new_with_ccl( - `(hp_r:hprop) ** ((hp_a -* hp_b) ** hp_a) |-- hp_b ** hp_r`); + `(hp_r:cprop) ** ((hp_a -* hp_b) ** hp_a) |-- hp_b ** hp_r`); gnode sl = SL_MODE(root, "HR * (HW * HA)")[0]; gnode applied = WAND_MP_SLTAC(sl, "HW", "HA", "HB"); @@ -85,7 +87,7 @@ PROOF static thm prove_wand_application_with_frame() { ENSURE_COND(vector_size(lhants) == 2 && strcmp(lhants[0].lb, "HR") == 0 && strcmp(lhants[1].lb, "HB") == 0 && - alpha_compare(lhants[1].tm, `hp_b:hprop`) == 0, + alpha_compare(lhants[1].tm, `hp_b:cprop`) == 0, "WAND_MP_SLTAC did not preserve context order or append its result"); AUTO_FRAME_SLTAC(applied); return gnode_prove(root); @@ -96,7 +98,7 @@ err: PROOF static thm prove_wand_intro_with_fact_pattern() { gnode root = gnode_new_with_ccl( - `(hp_r:hprop) |-- + `(hp_r:cprop) |-- (hp_a ** fact(p)) -* (fact(p) ** hp_a ** hp_r)`); gnode sl = SL_MODE(root, "HR")[0]; gnode_list leaves = INTRO_WAND_SLTAC(sl, "HA * [HP]"); @@ -124,7 +126,7 @@ err: PROOF static thm prove_wand_intro_with_disjunction_pattern() { gnode root = gnode_new_with_ccl( - `emp |-- ((hp_a:hprop) || hp_b) -* (hp_b || hp_a)`); + `emp |-- ((hp_a:cprop) || hp_b) -* (hp_b || hp_a)`); gnode sl = SL_MODE(root, "HE")[0]; gnode_list branches = INTRO_WAND_SLTAC(sl, "HA | HB"); ENSURE_COND(vector_size(branches) == 2, @@ -138,8 +140,10 @@ err: } PROOF static thm prove_exists_pull_changes_only_consequent() { - term assertion = - `(hp_a:hprop) ** (exists x. data_at p Tint x)`; + term caller_redex = `(\z:num. (hp_a:cprop)) 0`; + term assertion = mk_sl_sep( + caller_redex, + mk_sl_sep(`hp_b:cprop`, `exists x. data_at p Tint x`)); labeled_term whole = {assertion, "H"}; goal g = sl_goal_new((labeled_term_list)vector_create(), LABELED_TERM_LIST(whole), assertion); @@ -152,8 +156,13 @@ PROOF static thm prove_exists_pull_changes_only_consequent() { "EXISTS_PULL_SLTAC rewrote an SL antecedent"); ENSURE_COND(is_sl_exists(goal_hcon(pulled->g)), "EXISTS_PULL_SLTAC did not pull the consequent existential"); + dest_binder_results pulled_exists = dest_sl_exists(goal_hcon(pulled->g)); + dest_binop_results pulled_body = dest_sl_sep(pulled_exists.tm); + ENSURE_COND(equals_term(pulled_body.tm1, caller_redex), + "EXISTS_PULL_SLTAC reduced a caller-owned beta-redex"); - gnode opened = HANT_SEP_SLTAC(pulled, "H", "HA", "HEX"); + gnode opened = HANT_SEP_SLTAC(pulled, "H", "HRED", "HREST"); + opened = HANT_SEP_SLTAC(opened, "HREST", "HB", "HEX"); opened = HANT_EXISTS_SLTAC(opened, "HEX", "w"); gnode instantiated = EXISTS_SLTAC(opened, `w:int`); AUTO_FRAME_SLTAC(instantiated); @@ -194,7 +203,7 @@ err: PROOF static thm prove_duplicate_resource_frame() { gnode root = gnode_new_with_ccl( - `(hp_a:hprop) ** hp_a |-- hp_a ** hp_a`); + `(hp_a:cprop) ** hp_a |-- hp_a ** hp_a`); gnode sl = SL_MODE(root, "HA * HB")[0]; gnode remaining = FRAME_SLTAC(sl, CONST_STRING_LIST("HA")); AUTO_FRAME_SLTAC(remaining); @@ -203,7 +212,7 @@ PROOF static thm prove_duplicate_resource_frame() { PROOF static thm prove_sl_conversion() { gnode root = gnode_new_with_ccl( - `fact(true) ** (hp_a:hprop) |-- hp_a ** emp`); + `fact(true) ** (hp_a:cprop) |-- hp_a ** emp`); gnode sl = SL_MODE(root, "H")[0]; conv normalize = pure_rewrite_conv( THM_LIST(sl_fact_true_emp(), sl_sep_emp_left(), sl_sep_emp_right())); @@ -213,11 +222,11 @@ PROOF static thm prove_sl_conversion() { } PROOF static thm prove_hcon_conversion_with_hypothesis() { - term eq_tm = `((hp_b:hprop) = hp_a)`; + term eq_tm = `((hp_b:cprop) = hp_a)`; labeled_term asmp = {eq_tm, "E"}; - labeled_term lhant = {`hp_a:hprop`, "H"}; + labeled_term lhant = {`hp_a:cprop`, "H"}; goal g = sl_goal_new(LABELED_TERM_LIST(asmp), LABELED_TERM_LIST(lhant), - `hp_b:hprop`); + `hp_b:cprop`); term expected_ccl = goal_ccl(g); gnode root = gnode_new(g); @@ -266,16 +275,16 @@ err: PROOF static thm prove_hant_apply_equation_with_frame() { term guard = `apply_guard:bool`; term equation = - `((hp_a:hprop) ** hp_b) = (hp_b ** hp_a)`; + `((hp_a:cprop) ** hp_b) = (hp_b ** hp_a)`; labeled_term guard_asmp = {guard, "HG"}; labeled_term equation_asmp = {equation, "HE"}; - labeled_term hant_a = {`hp_a:hprop`, "HA"}; - labeled_term hant_f = {`hp_f:hprop`, "HF"}; - labeled_term hant_b = {`hp_b:hprop`, "HB"}; + labeled_term hant_a = {`hp_a:cprop`, "HA"}; + labeled_term hant_f = {`hp_f:cprop`, "HF"}; + labeled_term hant_b = {`hp_b:cprop`, "HB"}; goal g = sl_goal_new( LABELED_TERM_LIST(guard_asmp, equation_asmp), LABELED_TERM_LIST(hant_a, hant_f, hant_b), - `(hp_f:hprop) ** (hp_b ** hp_a)`); + `(hp_f:cprop) ** (hp_b ** hp_a)`); term expected_ccl = goal_ccl(g); gnode root = gnode_new(g); @@ -288,7 +297,7 @@ PROOF static thm prove_hant_apply_equation_with_frame() { strcmp(applied_hants[0].lb, "HF") == 0 && strcmp(applied_hants[1].lb, "HA") == 0 && alpha_compare(applied_hants[1].tm, - `(hp_b:hprop) ** hp_a`) == 0, + `(hp_b:cprop) ** hp_a`) == 0, "HANT_APPLY_SLTAC did not preserve the frame, reuse a selected label, " "or keep the RHS whole"); @@ -309,20 +318,20 @@ err: PROOF static thm prove_hant_apply_entailment() { term cell = `data_at p Tptr q`; - term forgotten = `undef_data_at p Tptr`; - term frame = `hp_f:hprop`; + term retained = `data_at p Tptr q`; + term frame = `hp_f:cprop`; gnode root = gnode_new_with_ccl( - mk_sl_ent(mk_sl_sep(cell, frame), mk_sl_sep(forgotten, frame))); + mk_sl_ent(mk_sl_sep(cell, frame), mk_sl_sep(retained, frame))); gnode sl = SL_MODE(root, "HC * HF")[0]; gnode applied = HANT_APPLY_SLTAC( sl, CONST_STRING_LIST("HC"), "HU", - get_data_at_to_undef_data_at()); + refl_slrule(cell)); labeled_term_list hants = goal_lhants(applied->g); ENSURE_COND(vector_size(hants) == 2 && strcmp(hants[0].lb, "HF") == 0 && strcmp(hants[1].lb, "HU") == 0 && - alpha_compare(hants[1].tm, forgotten) == 0, + alpha_compare(hants[1].tm, retained) == 0, "HANT_APPLY_SLTAC did not install an entailment RHS"); AUTO_FRAME_SLTAC(applied); return gnode_prove(root); @@ -332,7 +341,7 @@ err: } PROOF static thm prove_hant_apply_empty_selection() { - term frame = `hp_f:hprop`; + term frame = `hp_f:cprop`; labeled_term hant = {frame, "HF"}; goal g = sl_goal_new((labeled_term_list)vector_create(), LABELED_TERM_LIST(hant), frame); @@ -366,10 +375,10 @@ err: PROOF static thm prove_auto_hant_apply_partial_composite() { term equation = - `(((hp_a:hprop) ** hp_b) = hp_r)`; - term composite = `(hp_a:hprop) ** hp_f`; - term hp_b = `hp_b:hprop`; - term hp_x = `hp_x:hprop`; + `(((hp_a:cprop) ** hp_b) = hp_r)`; + term composite = `(hp_a:cprop) ** hp_f`; + term hp_b = `hp_b:cprop`; + term hp_x = `hp_x:cprop`; labeled_term equation_asmp = {equation, "HE"}; labeled_term composite_hant = {composite, "HC"}; labeled_term b_hant = {hp_b, "HB"}; @@ -377,7 +386,7 @@ PROOF static thm prove_auto_hant_apply_partial_composite() { goal g = sl_goal_new( LABELED_TERM_LIST(equation_asmp), LABELED_TERM_LIST(composite_hant, b_hant, x_hant), - `(hp_f:hprop) ** hp_x ** hp_r`); + `(hp_f:cprop) ** hp_x ** hp_r`); gnode root = gnode_new(g); gnode applied = @@ -385,11 +394,11 @@ PROOF static thm prove_auto_hant_apply_partial_composite() { labeled_term_list hants = goal_lhants(applied->g); ENSURE_COND(vector_size(hants) == 3 && strcmp(hants[0].lb, "HC") == 0 && - alpha_compare(hants[0].tm, `hp_f:hprop`) == 0 && + alpha_compare(hants[0].tm, `hp_f:cprop`) == 0 && strcmp(hants[1].lb, "HX") == 0 && alpha_compare(hants[1].tm, hp_x) == 0 && strcmp(hants[2].lb, "HB") == 0 && - alpha_compare(hants[2].tm, `hp_r:hprop`) == 0, + alpha_compare(hants[2].tm, `hp_r:cprop`) == 0, "AUTO_HANT_APPLY_SLTAC did not consume exact occurrences, " "preserve residual labels, or reuse a consumed label"); AUTO_FRAME_SLTAC(applied); @@ -400,13 +409,13 @@ err: } PROOF static thm prove_auto_hant_apply_duplicate_residual() { - term equation = `((hp_a:hprop) = hp_r)`; - term composite = `(hp_a:hprop) ** (hp_f ** hp_a)`; + term equation = `((hp_a:cprop) = hp_r)`; + term composite = `(hp_a:cprop) ** (hp_f ** hp_a)`; labeled_term equation_asmp = {equation, "HE"}; labeled_term composite_hant = {composite, "HC"}; goal g = sl_goal_new(LABELED_TERM_LIST(equation_asmp), LABELED_TERM_LIST(composite_hant), - `(hp_f:hprop) ** hp_a ** hp_r`); + `(hp_f:cprop) ** hp_a ** hp_r`); gnode root = gnode_new(g); gnode applied = @@ -415,7 +424,7 @@ PROOF static thm prove_auto_hant_apply_duplicate_residual() { ENSURE_COND(vector_size(hants) == 2 && strcmp(hants[0].lb, "HC") == 0 && alpha_compare(hants[0].tm, - `(hp_f:hprop) ** hp_a`) == 0 && + `(hp_f:cprop) ** hp_a`) == 0 && strcmp(hants[1].lb, "HR") == 0, "Automatic application lost the unconsumed duplicate " "occurrence"); @@ -430,7 +439,7 @@ PROOF static thm prove_auto_hant_apply_uses_assumption_binding() { term guard_a = `(a:int) == a`; term cell_a = `data_at p Tint (a:int)`; term cell_b = `data_at p Tint (b:int)`; - term frame = `hp_f:hprop`; + term frame = `hp_f:cprop`; labeled_term guard_asmp = {guard_a, "HG"}; labeled_term cell_b_hant = {cell_b, "HB"}; labeled_term frame_hant = {frame, "HF"}; @@ -459,7 +468,7 @@ err: } PROOF static thm prove_auto_hant_apply_empty_lhs() { - term frame = `hp_f:hprop`; + term frame = `hp_f:cprop`; labeled_term frame_hant = {frame, "HF"}; goal g = sl_goal_new((labeled_term_list)vector_create(), LABELED_TERM_LIST(frame_hant), frame); @@ -485,8 +494,8 @@ PROOF static thm prove_hant_apply_matching_and_fresh_label() { term a = `a:int`; term guard = `(a:int) == a`; term cell = `data_at p Tint (a:int)`; - term frame = `hp_f:hprop`; - term frame0 = `hp_g:hprop`; + term frame = `hp_f:cprop`; + term frame0 = `hp_g:cprop`; labeled_term guard_asmp = {guard, "HG"}; labeled_term frame_hant = {frame, "H"}; labeled_term frame0_hant = {frame0, "H_0"}; @@ -692,11 +701,11 @@ err: PROOF static void check_auto_hant_apply_respects_linearity() { term equation = - `(((hp_a:hprop) ** hp_a) = hp_r)`; + `(((hp_a:cprop) ** hp_a) = hp_r)`; labeled_term equation_asmp = {equation, "HE"}; - labeled_term a_hant = {`hp_a:hprop`, "HA"}; + labeled_term a_hant = {`hp_a:cprop`, "HA"}; goal g = sl_goal_new(LABELED_TERM_LIST(equation_asmp), - LABELED_TERM_LIST(a_hant), `hp_a:hprop`); + LABELED_TERM_LIST(a_hant), `hp_a:cprop`); gnode root = gnode_new(g); proof_try_begin(); @@ -733,19 +742,19 @@ err: PROOF static thm prove_hcon_apply_equation() { term guard = `consequent_guard:bool`; - term equation = `((hp_new:hprop) = hp_old)`; + term equation = `((hp_new:cprop) = hp_old)`; labeled_term guard_asmp = {guard, "HG"}; labeled_term equation_asmp = {equation, "HE"}; - labeled_term hant = {`hp_new:hprop`, "H"}; + labeled_term hant = {`hp_new:cprop`, "H"}; goal g = sl_goal_new( LABELED_TERM_LIST(guard_asmp, equation_asmp), - LABELED_TERM_LIST(hant), `hp_old:hprop`); + LABELED_TERM_LIST(hant), `hp_old:cprop`); term expected_ccl = goal_ccl(g); gnode root = gnode_new(g); thm relation = disch_rule(guard, assume_rule(equation)); gnode applied = HCON_APPLY_SLTAC(root, relation); - ENSURE_COND(alpha_compare(goal_hcon(applied->g), `hp_new:hprop`) == 0, + ENSURE_COND(alpha_compare(goal_hcon(applied->g), `hp_new:cprop`) == 0, "HCON_APPLY_SLTAC did not install an equality LHS"); AUTO_FRAME_SLTAC(applied); thm result = gnode_prove(root); @@ -763,14 +772,10 @@ err: PROOF static thm prove_hcon_apply_entailment() { term cell = `data_at p Tptr q`; - term forgotten = `undef_data_at p Tptr`; gnode root = gnode_new_with_ccl( - mk_sl_ent(cell, mk_sl_sep(forgotten, sl_emp()))); + mk_sl_ent(cell, mk_sl_sep(cell, sl_emp()))); gnode sl = SL_MODE(root, "HC")[0]; - thm forget = specl_rule( - TERM_LIST(`p:addr`, `Tptr:ctype`, `q:addr`), - get_data_at_to_undef_data_at()); - gnode applied = HCON_APPLY_SLTAC(sl, forget); + gnode applied = HCON_APPLY_SLTAC(sl, refl_slrule(cell)); ENSURE_COND(alpha_compare(goal_hcon(applied->g), cell) == 0, "HCON_APPLY_SLTAC did not install an entailment LHS"); AUTO_FRAME_SLTAC(applied); @@ -834,10 +839,10 @@ err: } PROOF static void check_apply_requires_current_assumptions() { - term equation = `((hp_a:hprop) = hp_b)`; - labeled_term hant = {`hp_a:hprop`, "HA"}; + term equation = `((hp_a:cprop) = hp_b)`; + labeled_term hant = {`hp_a:cprop`, "HA"}; goal g = sl_goal_new((labeled_term_list)vector_create(), - LABELED_TERM_LIST(hant), `hp_b:hprop`); + LABELED_TERM_LIST(hant), `hp_b:cprop`); gnode root = gnode_new(g); gnode applied = HCON_APPLY_SLTAC(root, assume_rule(equation)); AUTO_FRAME_SLTAC(applied); @@ -857,13 +862,13 @@ err: } PROOF static thm prove_hant_conv_multiple_with_frame() { - term old_a = `hp_a:hprop`; - term new_a = `hp_a1:hprop`; - term old_b = `hp_b:hprop`; - term new_b = `hp_b1:hprop`; - term frame = `hp_f:hprop`; - term eq_a = `((hp_a:hprop) = hp_a1)`; - term eq_b = `((hp_b:hprop) = hp_b1)`; + term old_a = `hp_a:cprop`; + term new_a = `hp_a1:cprop`; + term old_b = `hp_b:cprop`; + term new_b = `hp_b1:cprop`; + term frame = `hp_f:cprop`; + term eq_a = `((hp_a:cprop) = hp_a1)`; + term eq_b = `((hp_b:cprop) = hp_b1)`; labeled_term asmp_a = {eq_a, "EA"}; labeled_term asmp_b = {eq_b, "EB"}; @@ -897,7 +902,7 @@ err: PROOF static thm prove_hant_disj_with_frame() { term ccl = - `(((hp_a:hprop) || hp_b) ** hp_f) |-- + `(((hp_a:cprop) || hp_b) ** hp_f) |-- (hp_a ** hp_f) || (hp_b ** hp_f)`; gnode root = gnode_new_with_ccl(ccl); gnode sl = SL_MODE(root, "HD * HF")[0]; @@ -917,23 +922,23 @@ err: PROOF static thm prove_neutral_resource_frame() { gnode root = gnode_new_with_ccl( - `((hp_a:hprop) ** emp) |-- hp_a`); + `((hp_a:cprop) ** emp) |-- hp_a`); gnode sl = SL_MODE(root, "H")[0]; AUTO_FRAME_SLTAC(sl); return gnode_prove(root); } PROOF static thm prove_clean_nested_units() { - labeled_term lhant = {`emp ** ((hp_a:hprop) ** fact(true))`, "H"}; + labeled_term lhant = {`emp ** ((hp_a:cprop) ** fact(true))`, "H"}; goal g = sl_goal_new((labeled_term_list)vector_create(), LABELED_TERM_LIST(lhant), - `fact(true) ** ((hp_a:hprop) ** emp)`); + `fact(true) ** ((hp_a:cprop) ** emp)`); gnode root = gnode_new(g); gnode cleaned = CLEAN_SLTAC(root); labeled_term_list cleaned_hants = goal_lhants(cleaned->g); ENSURE_COND(vector_size(cleaned_hants) == 1 && - equals_term(cleaned_hants[0].tm, `hp_a:hprop`) && - equals_term(goal_hcon(cleaned->g), `hp_a:hprop`), + equals_term(cleaned_hants[0].tm, `hp_a:cprop`) && + equals_term(goal_hcon(cleaned->g), `hp_a:cprop`), "CLEAN_SLTAC did not normalize labeled SL assertions"); AUTO_FRAME_SLTAC(cleaned); return gnode_prove(root); @@ -954,7 +959,7 @@ PROOF static thm prove_emp_nested_units() { PROOF static thm prove_contr_nested_units() { labeled_term lhant = {`emp ** fact(false)`, "H"}; goal g = sl_goal_new((labeled_term_list)vector_create(), - LABELED_TERM_LIST(lhant), `hp_a:hprop`); + LABELED_TERM_LIST(lhant), `hp_a:cprop`); gnode root = gnode_new(g); CONTR_SLTAC(root, "H"); return gnode_prove(root); @@ -1008,8 +1013,8 @@ err: } PROOF static void check_hol_owned_sl_checks() { - term hp_a = `hp_a:hprop`; - term hp_b = `hp_b:hprop`; + term hp_a = `hp_a:cprop`; + term hp_b = `hp_b:cprop`; proof_try_begin(); term truth = mk_true(); @@ -1032,6 +1037,156 @@ PROOF static void check_hol_owned_sl_checks() { ENSURE_COND(bad_trans_failed, "trans_slrule bypassed HOL's composability check"); + term explicit_beta = `(\x:num. (hp_a:cprop)) 0`; + thm beta_left = refl_slrule(explicit_beta); + thm beta_right = refl_slrule(hp_a); + proof_try_begin(); + thm beta_trans = trans_slrule(beta_left, beta_right); + bool beta_trans_rejected = IS_NULL(beta_trans) && NOT_OK; + if (NOT_OK) SET_OK(); + proof_try_end(); + proof_clear_errors(); + ENSURE_COND(beta_trans_rejected, + "trans_slrule accepted merely beta-equivalent endpoints"); + + term beta_between_exists = + `exists x:num. (\z:num. exists y:num. (hp_a:cprop)) x`; + strip_sl_exists_results stripped_beta_exists = + strip_sl_exists(beta_between_exists); + term expected_beta_body = + `(\z:num. exists y:num. (hp_a:cprop)) (x:num)`; + ENSURE_COND(vector_size(stripped_beta_exists.vs) == 1 && + equals_term(stripped_beta_exists.hp, expected_beta_body), + "strip_sl_exists reduced through a head beta-redex"); + + term mono_x = `mono_x:num`; + thm mono_body = refl_slrule(hp_a); + thm exact_exists_mono = exists_mono_slrule(mono_x, mono_body); + term exact_exists_mono_ccl = concl(exact_exists_mono); + dest_binop_results exact_exists_mono_sides = + dest_sl_ent(exact_exists_mono_ccl); + term exact_exists_endpoint = mk_sl_exists(mono_x, hp_a); + ENSURE_COND(equals_term(exact_exists_mono_sides.tm1, + exact_exists_endpoint) && + equals_term(exact_exists_mono_sides.tm2, + exact_exists_endpoint), + "exists_mono_slrule leaked its internal beta-redex syntax"); + + term body = mk_sl_fact(mk_eq(mono_x, mono_x)); + term actual_exists = mk_sl_exists(mono_x, body); + thm exact_left_distribution = + sep_exists_left_slrule(actual_exists, hp_b); + dest_binop_results exact_left_sides = + dest_sl_eq(concl(exact_left_distribution)); + term expected_left = mk_sl_sep(actual_exists, hp_b); + term expected_left_target = + mk_sl_exists(mono_x, mk_sl_sep(body, hp_b)); + ENSURE_COND(equals_term(exact_left_sides.tm1, expected_left) && + equals_term(exact_left_sides.tm2, expected_left_target), + "left existential distribution did not retain exact binder syntax"); + + thm exact_right_distribution = + sep_exists_right_slrule(hp_b, actual_exists); + dest_binop_results exact_right_sides = + dest_sl_eq(concl(exact_right_distribution)); + term expected_right = mk_sl_sep(hp_b, actual_exists); + term expected_right_target = + mk_sl_exists(mono_x, mk_sl_sep(hp_b, body)); + ENSURE_COND(equals_term(exact_right_sides.tm1, expected_right) && + equals_term(exact_right_sides.tm2, expected_right_target), + "right existential distribution did not retain exact binder syntax"); + + term capture_x = `capture_x:num`; + term capture_body = mk_sl_fact(mk_eq(capture_x, `0`)); + term capture_frame = mk_sl_fact(mk_eq(capture_x, `1`)); + term capture_exists = mk_sl_exists(capture_x, capture_body); + + thm capture_left = + sep_exists_left_slrule(capture_exists, capture_frame); + dest_binop_results capture_left_sides = + dest_sl_eq(concl(capture_left)); + dest_binder_results capture_left_target = + dest_sl_exists(capture_left_sides.tm2); + term capture_left_renamed = subst_one( + capture_left_target.v, capture_x, capture_body); + term capture_left_expected_body = + mk_sl_sep(capture_left_renamed, capture_frame); + ENSURE_COND( + equals_term(capture_left_sides.tm1, + mk_sl_sep(capture_exists, capture_frame)) && + !var_free_in(capture_left_target.v, capture_frame) && + alpha_compare(capture_left_target.tm, + capture_left_expected_body) == 0, + "left existential distribution captured a free frame variable"); + + thm capture_right = + sep_exists_right_slrule(capture_frame, capture_exists); + dest_binop_results capture_right_sides = + dest_sl_eq(concl(capture_right)); + dest_binder_results capture_right_target = + dest_sl_exists(capture_right_sides.tm2); + term capture_right_renamed = subst_one( + capture_right_target.v, capture_x, capture_body); + term capture_right_expected_body = + mk_sl_sep(capture_frame, capture_right_renamed); + ENSURE_COND( + equals_term(capture_right_sides.tm1, + mk_sl_sep(capture_frame, capture_exists)) && + !var_free_in(capture_right_target.v, capture_frame) && + alpha_compare(capture_right_target.tm, + capture_right_expected_body) == 0, + "right existential distribution captured a free frame variable"); + + term redex_exists = mk_sl_exists(mono_x, explicit_beta); + term redex_sep = mk_sl_sep(explicit_beta, explicit_beta); + term redex_sep_exists = mk_sl_exists(mono_x, redex_sep); + thm redex_left_distribution = + sep_exists_left_slrule(redex_exists, explicit_beta); + dest_binop_results redex_left_sides = + dest_sl_eq(concl(redex_left_distribution)); + ENSURE_COND( + equals_term(redex_left_sides.tm1, + mk_sl_sep(redex_exists, explicit_beta)) && + equals_term(redex_left_sides.tm2, redex_sep_exists), + "left existential distribution reduced a caller-owned beta-redex"); + + thm redex_right_distribution = + sep_exists_right_slrule(explicit_beta, redex_exists); + dest_binop_results redex_right_sides = + dest_sl_eq(concl(redex_right_distribution)); + ENSURE_COND( + equals_term(redex_right_sides.tm1, + mk_sl_sep(explicit_beta, redex_exists)) && + equals_term(redex_right_sides.tm2, redex_sep_exists), + "right existential distribution reduced a caller-owned beta-redex"); + + thm redex_mono = + exists_mono_slrule(mono_x, refl_slrule(explicit_beta)); + dest_binop_results redex_mono_sides = dest_sl_ent(concl(redex_mono)); + ENSURE_COND(equals_term(redex_mono_sides.tm1, redex_exists) && + equals_term(redex_mono_sides.tm2, redex_exists), + "existential monotonicity reduced a caller-owned beta-redex"); + + thm redex_intro = + exists_slrule(redex_exists, `0`, refl_slrule(explicit_beta)); + dest_binop_results redex_intro_sides = dest_sl_ent(concl(redex_intro)); + ENSURE_COND(equals_term(redex_intro_sides.tm1, explicit_beta) && + equals_term(redex_intro_sides.tm2, redex_exists), + "existential introduction reduced a caller-owned beta-redex"); + + term choice_y = `choice_y:num`; + thm redex_elim = choose_slrule( + choice_y, redex_exists, refl_slrule(explicit_beta)); + dest_binop_results redex_elim_sides = dest_sl_ent(concl(redex_elim)); + ENSURE_COND(equals_term(redex_elim_sides.tm1, redex_exists) && + alpha_compare(redex_elim_sides.tm2, explicit_beta) == 0, + "existential elimination returned `%s |-- %s`; expected `%s |-- " + "%s`", + string_of_term(redex_elim_sides.tm1), + string_of_term(redex_elim_sides.tm2), + string_of_term(redex_exists), + string_of_term(explicit_beta)); + proof_try_begin(); thm bad_ac = ac_slrule(`x:num`, `x:num`); bool bad_ac_failed = IS_NULL(bad_ac) && NOT_OK; @@ -1086,9 +1241,9 @@ PROOF static void check_backward_sl_rejections() { ENSURE_COND(rejected_general, "An SL tactic accepted a general goal"); - labeled_term lhant = {`hp_a:hprop`, "H"}; + labeled_term lhant = {`hp_a:cprop`, "H"}; goal g = sl_goal_new((labeled_term_list)vector_create(), - LABELED_TERM_LIST(lhant), `hp_a:hprop`); + LABELED_TERM_LIST(lhant), `hp_a:cprop`); gnode sl = gnode_new(g); proof_try_begin(); @@ -1174,9 +1329,9 @@ PROOF int proof_sl_regression() { ENSURE_COND(!IS_NULL(prove_hcon_apply_polymorphic_type_match()), "Polymorphic consequent application regression failed"); ENSURE_OK(""); - term hp_a = `hp_a:hprop`; - term hp_b = `hp_b:hprop`; - term hp_c = `hp_c:hprop`; + term hp_a = `hp_a:cprop`; + term hp_b = `hp_b:cprop`; + term hp_c = `hp_c:cprop`; ENSURE_COND( term_list_is_subset(TERM_LIST(hp_a, hp_a), TERM_LIST(hp_a)), @@ -1285,7 +1440,7 @@ PROOF int proof_sl_regression() { equals_term(alpha_rehcon_sides.tm2, alpha_ex_y), "An alpha endpoint rewrite did not retain caller syntax"); - thm ac = sl_ac_rule(); + thm ac = sl_ac_rule; ENSURE_COND(vector_size(hyp(ac)) == 0, "The AC package unexpectedly has hypotheses"); ENSURE_COND(alpha_compare( @@ -1320,19 +1475,19 @@ PROOF int proof_sl_regression() { thm conjunction = conj_slrule(refl_slrule(hp_a), refl_slrule(hp_a)); ENSURE_COND(alpha_compare(concl(conjunction), - `(hp_a:hprop) |-- hp_a && hp_a`) == 0, + `(hp_a:cprop) |-- hp_a && hp_a`) == 0, "Conjunction introduction produced the wrong entailment"); thm disjunction = disj_mono_slrule(refl_slrule(hp_a), refl_slrule(hp_b)); ENSURE_COND(alpha_compare(concl(disjunction), - `((hp_a:hprop) || hp_b) |-- hp_a || hp_b`) == 0, + `((hp_a:cprop) || hp_b) |-- hp_a || hp_b`) == 0, "Disjunction monotonicity produced the wrong entailment"); thm wand_application = elim_wand_slrule(refl_slrule(mk_sl_wand(hp_a, hp_b))); ENSURE_COND(alpha_compare(concl(wand_application), - `(((hp_a:hprop) -* hp_b) ** hp_a) |-- hp_b`) == 0, + `(((hp_a:cprop) -* hp_b) ** hp_a) |-- hp_b`) == 0, "Magic-wand application produced the wrong entailment"); term joined = mk_sl_sep(hp_a, hp_b); @@ -1359,7 +1514,7 @@ PROOF int proof_sl_regression() { intro_fact_slrule(assume_rule(pure_p), refl_slrule(hp_a))); ENSURE_COND(alpha_compare( concl(preserved_fact), - `fact(pure_p) ** (hp_a:hprop) |-- fact(pure_p) ** hp_a`) == 0, + `fact(pure_p) ** (hp_a:cprop) |-- fact(pure_p) ** hp_a`) == 0, "Fact introduction/elimination composition produced the wrong entailment"); term value = `value0:int`; @@ -1560,8 +1715,6 @@ PROOF int proof_sl_regression() { !IS_NULL(contr_nested_units) && !IS_NULL(disj_branch_fact_independence), "An SL backward tactic regression returned an empty theorem"); - ENSURE_COND(!IS_NULL(sl_exists_mono()), - "Existential monotonicity depended on implicit variable types"); set_the_implicit_types(previous_implicit_types); return 0; err: diff --git a/theory/c_program_logic/c_basic_update.c b/theory/c_program_logic/c_basic_update.c new file mode 100644 index 0000000..a760070 --- /dev/null +++ b/theory/c_program_logic/c_basic_update.c @@ -0,0 +1,1432 @@ +#include "proof/theory/c_program_logic/c_basic_update.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/c_program_logic/c_resource.c" + +PROOF static thm_list C_BASIC_UPDATE_INITIAL_AXIOMS = get_all_axioms(); +PROOF static size_t C_BASIC_UPDATE_AXIOMS_BEFORE = + vector_size(C_BASIC_UPDATE_INITIAL_AXIOMS); + +/* ------------------------------------------------------------------------- */ +/* Modality and viewshift */ +/* ------------------------------------------------------------------------- */ + +PROOF thm c_bupd_def = new_fun_definition(` + c_bupd + (G:(A)ra) + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (resource:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) <=> + ra_update_nd + (ghost_heap_ra G) + (SND resource) + (\ghost':(num,A)finmap. Q (FST resource,ghost')) +`); + +PROOF thm c_viewshift_def = new_fun_definition(` + c_viewshift + (G:(A)ra) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) <=> + r_entails (c_resource_ra G) P (c_bupd G Q) +`); + +/* ------------------------------------------------------------------------- */ +/* Basic-update laws */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_c_bupd_intro(void) { + term goal_tm = ` + forall + (G:(A)ra) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). + r_entails (c_resource_ra G) P (c_bupd G P) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list definitions = THM_LIST( + r_entails_def, + c_bupd_def, + ra_update_nd_def); + conv unfold_definitions = pure_rewrite_conv(definitions); + gnode body = CONV_TAC(root, unfold_definitions); + body = AUTO_INTROS_TAC(body); + term unchanged_ghost = ` + SND (resource: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) + `; + body = EXISTS_TAC(body, unchanged_ghost); + gnode_list result = CONJ_TAC(body); + + conv beta = get_conversion_by_name("BETA_CONV"); + gnode post_goal = CONV_TAC(result[0], beta); + + term source_fact_tm = ` + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (resource:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) + `; + thm source_fact = assume_rule(source_fact_tm); + term resource_tm = ` + resource:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap + `; + thm pair = get_theorem_by_name("PAIR"); + thm resource_eta = ispec_rule(resource_tm, pair); + term predicate = ` + P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool + `; + thm predicate_eta = ap_term_rule(predicate, resource_eta); + thm resource_to_pair = gsym_rule(predicate_eta); + thm post_fact = eq_mp_rule(resource_to_pair, source_fact); + ACCEPT_TAC(post_goal, post_fact); + + term validity_fact_tm = ` + ra_valid + (ghost_heap_ra (G:(A)ra)) + (ra_op + (ghost_heap_ra G) + (SND (resource: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)) + (frame:(num,A)finmap)) + `; + thm validity_fact = assume_rule(validity_fact_tm); + ACCEPT_TAC(result[1], validity_fact); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_BUPD_INTRO = prove_c_bupd_intro(); + +PROOF static thm prove_c_bupd_mono(void) { + term goal_tm = ` + forall + (G:(A)ra) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). + r_entails (c_resource_ra G) P Q ==> + r_entails + (c_resource_ra G) + (c_bupd G P) + (c_bupd G Q) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list definitions = THM_LIST( + r_entails_def, + c_bupd_def, + ra_update_nd_def); + conv unfold_definitions = pure_rewrite_conv(definitions); + gnode body = CONV_TAC(root, unfold_definitions); + body = GEN_TAC(body, "G"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = DISCH_TAC(body, "Hmono"); + body = GEN_TAC(body, "owned"); + body = DISCH_TAC(body, "Hvalid_owned"); + body = DISCH_TAC(body, "Hupdate"); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hvalid_source"); + + term update_assumption_tm = ` + forall frame:(num,A)finmap. + ra_valid + (ghost_heap_ra (G:(A)ra)) + (ra_op + (ghost_heap_ra G) + (SND (owned: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)) + frame) ==> + exists selected:(num,A)finmap. + (\ghost':(num,A)finmap. + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (FST owned,ghost')) selected && + ra_valid + (ghost_heap_ra G) + (ra_op (ghost_heap_ra G) selected frame) + `; + thm update_assumption = assume_rule(update_assumption_tm); + term frame_tm = `frame:(num,A)finmap`; + thm update_at_frame = spec_rule(frame_tm, update_assumption); + term valid_source_tm = ` + ra_valid + (ghost_heap_ra (G:(A)ra)) + (ra_op + (ghost_heap_ra G) + (SND (owned: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)) + (frame:(num,A)finmap)) + `; + thm valid_source = assume_rule(valid_source_tm); + thm selected = mp_rule(update_at_frame, valid_source); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "selected"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "HP_selected", + "Hvalid_selected_frame"); + + term ghost_ra_tm = `G:(A)ra`; + term owned_tm = ` + owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap + `; + term_list owned_valid_arguments = TERM_LIST(ghost_ra_tm, owned_tm); + thm owned_valid_rule = ispecl_rule( + owned_valid_arguments, + C_RESOURCE_RA_VALID); + term owned_valid_tm = ` + ra_valid + (c_resource_ra (G:(A)ra)) + (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) + `; + thm owned_valid = assume_rule(owned_valid_tm); + thm owned_components = eq_mp_rule(owned_valid_rule, owned_valid); + + term ghost_heap_ra_tm = `ghost_heap_ra (G:(A)ra)`; + term selected_tm = `selected:(num,A)finmap`; + term_list op_left_arguments = TERM_LIST( + ghost_heap_ra_tm, + selected_tm, + frame_tm); + thm op_left_rule = ispecl_rule(op_left_arguments, RA_VALID_OP_L); + term selected_frame_valid_tm = ` + ra_valid + (ghost_heap_ra (G:(A)ra)) + (ra_op + (ghost_heap_ra G) + (selected:(num,A)finmap) + (frame:(num,A)finmap)) + `; + thm selected_frame_valid = assume_rule(selected_frame_valid_tm); + thm selected_ghost_valid = mp_rule( + op_left_rule, + selected_frame_valid); + + term selected_pair_tm = ` + (FST (owned: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap), + selected:(num,A)finmap) + `; + term_list selected_pair_arguments = TERM_LIST( + ghost_ra_tm, + selected_pair_tm); + thm selected_pair_rule = ispecl_rule( + selected_pair_arguments, + C_RESOURCE_RA_VALID); + thm fst = get_theorem_by_name("FST"); + thm snd = get_theorem_by_name("SND"); + thm_list pair_rewrites = THM_LIST(fst, snd); + selected_pair_rule = pure_rewrite_rule( + pair_rewrites, + selected_pair_rule); + thm physical_valid = conjunct1_rule(owned_components); + thm selected_components_valid = conj_rule( + physical_valid, + selected_ghost_valid); + thm components_to_pair_valid = gsym_rule(selected_pair_rule); + thm selected_pair_valid = eq_mp_rule( + components_to_pair_valid, + selected_components_valid); + + term mono_assumption_tm = ` + forall resource: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap. + ra_valid (c_resource_ra (G:(A)ra)) resource ==> + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + resource ==> + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + resource + `; + thm mono_assumption = assume_rule(mono_assumption_tm); + thm mono_at_selected = spec_rule(selected_pair_tm, mono_assumption); + thm selected_implication = mp_rule( + mono_at_selected, + selected_pair_valid); + term selected_p_tm = ` + (\ghost':(num,A)finmap. + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (FST (owned: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap), + ghost')) + (selected:(num,A)finmap) + `; + thm selected_p_raw = assume_rule(selected_p_tm); + thm selected_p = beta_rule(selected_p_raw); + thm selected_q = mp_rule(selected_implication, selected_p); + + body = EXISTS_TAC(body, selected_tm); + gnode_list result = CONJ_TAC(body); + conv beta = get_conversion_by_name("BETA_CONV"); + gnode post_goal = CONV_TAC(result[0], beta); + ACCEPT_TAC(post_goal, selected_q); + ACCEPT_TAC(result[1], selected_frame_valid); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_BUPD_MONO = prove_c_bupd_mono(); + +PROOF static thm prove_c_bupd_idem(void) { + term goal_tm = ` + forall + (G:(A)ra) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). + r_entails + (c_resource_ra G) + (c_bupd G (c_bupd G P)) + (c_bupd G P) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm fst = get_theorem_by_name("FST"); + thm snd = get_theorem_by_name("SND"); + thm_list definitions = THM_LIST( + r_entails_def, + c_bupd_def, + ra_update_nd_def, + fst, + snd); + conv unfold_definitions = pure_rewrite_conv(definitions); + gnode body = CONV_TAC(root, unfold_definitions); + body = GEN_TAC(body, "G"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "owned"); + body = DISCH_TAC(body, "Hvalid_owned"); + body = DISCH_TAC(body, "Hnested"); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hvalid_source"); + + const_cstr_list nested_labels = CONST_STRING_LIST("Hnested"); + term_list nested_terms = gnode_get_asmps(body, nested_labels); + term nested_update_tm = nested_terms[0]; + thm nested_update = assume_rule(nested_update_tm); + term frame_tm = `frame:(num,A)finmap`; + thm nested_at_frame = spec_rule(frame_tm, nested_update); + const_cstr_list source_labels = CONST_STRING_LIST("Hvalid_source"); + term_list source_terms = gnode_get_asmps(body, source_labels); + term valid_source_tm = source_terms[0]; + thm valid_source = assume_rule(valid_source_tm); + thm middle = mp_rule(nested_at_frame, valid_source); + body = ASSUME_TAC(body, middle, "Hmiddle"); + body = ASMP_EXISTS_TAC(body, "Hmiddle", "middle"); + body = ASMP_CONJ_TAC( + body, + "Hmiddle", + "Hmiddle_update", + "Hvalid_middle_frame"); + const_cstr_list middle_update_labels = + CONST_STRING_LIST("Hmiddle_update"); + term_list middle_update_terms = gnode_get_asmps( + body, + middle_update_labels); + term middle_update_tm = middle_update_terms[0]; + thm middle_update = assume_rule(middle_update_tm); + thm middle_update_reduced = beta_rule(middle_update); + thm middle_at_frame = spec_rule(frame_tm, middle_update_reduced); + const_cstr_list middle_valid_labels = + CONST_STRING_LIST("Hvalid_middle_frame"); + term_list middle_valid_terms = gnode_get_asmps( + body, + middle_valid_labels); + term valid_middle_frame_tm = middle_valid_terms[0]; + thm valid_middle_frame = assume_rule(valid_middle_frame_tm); + thm selected_raw = mp_rule(middle_at_frame, valid_middle_frame); + thm selected = beta_rule(selected_raw); + + conv beta = get_conversion_by_name("BETA_CONV"); + conv beta_depth = depth_conv(beta); + body = CONV_TAC(body, beta_depth); + ACCEPT_TAC(body, selected); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_BUPD_IDEM = prove_c_bupd_idem(); + +PROOF static thm prove_c_bupd_frame(void) { + term goal_tm = ` + forall + (G:(A)ra) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Frame:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). + r_entails + (c_resource_ra G) + (r_sep (c_resource_ra G) (c_bupd G P) Frame) + (c_bupd G (r_sep (c_resource_ra G) P Frame)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list definitions = THM_LIST( + r_entails_def, + r_sep_def, + c_bupd_def, + ra_update_nd_def); + conv unfold_definitions = pure_rewrite_conv(definitions); + gnode body = CONV_TAC(root, unfold_definitions); + body = GEN_TAC(body, "G"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Frame"); + body = GEN_TAC(body, "owned_total"); + body = DISCH_TAC(body, "Hvalid_owned_total"); + body = DISCH_TAC(body, "Hsep"); + body = ASMP_EXISTS_TAC(body, "Hsep", "updated"); + body = ASMP_EXISTS_TAC(body, "Hsep", "explicit_frame"); + body = ASMP_CONJ_TAC( + body, + "Hsep", + "Hsplit", + "Hpreds"); + body = ASMP_CONJ_TAC( + body, + "Hpreds", + "Hupdate", + "Hframe_pred"); + body = GEN_TAC(body, "hidden"); + body = DISCH_TAC(body, "Hvalid_with_hidden"); + + const_cstr_list split_labels = CONST_STRING_LIST("Hsplit"); + term_list split_terms = gnode_get_asmps(body, split_labels); + term split_tm = split_terms[0]; + thm split = assume_rule(split_tm); + term snd_function = ` + SND: + (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> + (num,A)finmap + `; + thm split_snd = ap_term_rule(snd_function, split); + thm snd = get_theorem_by_name("SND"); + thm_list snd_rewrites = THM_LIST(C_RESOURCE_RA_OP, snd); + split_snd = pure_rewrite_rule(snd_rewrites, split_snd); + term valid_with_hidden_predicate = ` + \base:(num,A)finmap. + ra_valid + (ghost_heap_ra (G:(A)ra)) + (ra_op (ghost_heap_ra G) base (hidden:(num,A)finmap)) + `; + thm replace_owned_ghost_raw = ap_term_rule( + valid_with_hidden_predicate, + split_snd); + thm replace_owned_ghost = beta_rule(replace_owned_ghost_raw); + const_cstr_list hidden_valid_labels = + CONST_STRING_LIST("Hvalid_with_hidden"); + term_list hidden_valid_terms = gnode_get_asmps( + body, + hidden_valid_labels); + term valid_with_hidden_tm = hidden_valid_terms[0]; + thm valid_with_hidden = assume_rule(valid_with_hidden_tm); + thm valid_grouped = eq_mp_rule( + replace_owned_ghost, + valid_with_hidden); + term ghost_heap_ra_tm = `ghost_heap_ra (G:(A)ra)`; + term updated_ghost_tm = ` + SND (updated: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) + `; + term explicit_ghost_tm = ` + SND (explicit_frame: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) + `; + term hidden_tm = `hidden:(num,A)finmap`; + term_list source_assoc_arguments = TERM_LIST( + ghost_heap_ra_tm, + updated_ghost_tm, + explicit_ghost_tm, + hidden_tm); + thm source_assoc = ispecl_rule( + source_assoc_arguments, + RA_ASSOC); + thm source_assoc_validity = ap_term_rule( + `ra_valid (ghost_heap_ra (G:(A)ra)):(num,A)finmap->bool`, + source_assoc); + thm valid_for_update = eq_mp_rule( + source_assoc_validity, + valid_grouped); + + const_cstr_list update_labels = CONST_STRING_LIST("Hupdate"); + term_list update_terms = gnode_get_asmps(body, update_labels); + term update_tm = update_terms[0]; + thm update_raw = assume_rule(update_tm); + thm update = beta_rule(update_raw); + term combined_hidden_tm = ` + ra_op + (ghost_heap_ra (G:(A)ra)) + (SND (explicit_frame: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)) + (hidden:(num,A)finmap) + `; + thm update_at_frame = spec_rule(combined_hidden_tm, update); + thm selected = mp_rule(update_at_frame, valid_for_update); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "selected"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "HP_selected", + "Hvalid_selected"); + + term selected_tm = `selected:(num,A)finmap`; + term exposed_result_tm = ` + ra_op + (ghost_heap_ra (G:(A)ra)) + (selected:(num,A)finmap) + (SND (explicit_frame: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)) + `; + body = EXISTS_TAC(body, exposed_result_tm); + gnode_list result = CONJ_TAC(body); + + conv beta = get_conversion_by_name("BETA_CONV"); + conv beta_depth = depth_conv(beta); + gnode post = CONV_TAC(result[0], beta_depth); + term updated_selected_tm = ` + (FST (updated: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap), + selected:(num,A)finmap) + `; + post = EXISTS_TAC(post, updated_selected_tm); + term explicit_frame_tm = ` + explicit_frame: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap + `; + post = EXISTS_TAC(post, explicit_frame_tm); + gnode_list post1 = CONJ_TAC(post); + + term fst_function = ` + FST: + (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> + (int,(pmem_byte_state)excl)finmap + `; + thm split_fst = ap_term_rule(fst_function, split); + thm fst = get_theorem_by_name("FST"); + thm_list fst_rewrites = THM_LIST(C_RESOURCE_RA_OP, fst); + split_fst = pure_rewrite_rule(fst_rewrites, split_fst); + + thm_list resource_op_rewrites = THM_LIST( + C_RESOURCE_RA_OP, + fst, + snd); + conv unfold_resource_op = pure_rewrite_conv(resource_op_rewrites); + gnode post_eq = CONV_TAC(post1[0], unfold_resource_op); + thm pair_eq = get_theorem_by_name("PAIR_EQ"); + thm_list pair_eq_rewrites = THM_LIST(pair_eq); + conv expose_pair_eq = once_rewrite_conv(pair_eq_rewrites); + post_eq = CONV_TAC(post_eq, expose_pair_eq); + gnode_list post_eq_parts = CONJ_TAC(post_eq); + ACCEPT_TAC(post_eq_parts[0], split_fst); + thm exposed_result_refl = refl_rule(exposed_result_tm); + ACCEPT_TAC(post_eq_parts[1], exposed_result_refl); + + gnode_list post2 = CONJ_TAC(post1[1]); + const_cstr_list selected_pred_labels = + CONST_STRING_LIST("HP_selected"); + term_list selected_pred_terms = gnode_get_asmps( + post2[0], + selected_pred_labels); + term selected_pred_tm = selected_pred_terms[0]; + thm selected_pred_raw = assume_rule(selected_pred_tm); + thm selected_pred = beta_rule(selected_pred_raw); + ACCEPT_TAC(post2[0], selected_pred); + const_cstr_list frame_pred_labels = + CONST_STRING_LIST("Hframe_pred"); + term_list frame_pred_terms = gnode_get_asmps( + post2[1], + frame_pred_labels); + term frame_pred_tm = frame_pred_terms[0]; + thm frame_pred = assume_rule(frame_pred_tm); + ACCEPT_TAC(post2[1], frame_pred); + + term_list result_assoc_arguments = TERM_LIST( + ghost_heap_ra_tm, + selected_tm, + explicit_ghost_tm, + hidden_tm); + thm result_assoc = ispecl_rule( + result_assoc_arguments, + RA_ASSOC); + thm result_assoc_validity = ap_term_rule( + `ra_valid (ghost_heap_ra (G:(A)ra)):(num,A)finmap->bool`, + result_assoc); + const_cstr_list selected_valid_labels = + CONST_STRING_LIST("Hvalid_selected"); + term_list selected_valid_terms = gnode_get_asmps( + result[1], + selected_valid_labels); + term selected_valid_tm = selected_valid_terms[0]; + thm selected_valid = assume_rule(selected_valid_tm); + thm regroup_result = gsym_rule(result_assoc_validity); + thm result_valid = eq_mp_rule(regroup_result, selected_valid); + ACCEPT_TAC(result[1], result_valid); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_BUPD_FRAME = prove_c_bupd_frame(); + +/* ------------------------------------------------------------------------- */ +/* Viewshift laws */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_c_entails_to_viewshift(void) { + term goal_tm = ` + forall + (G:(A)ra) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). + r_entails (c_resource_ra G) P Q ==> + c_viewshift G P Q + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list viewshift_definitions = THM_LIST(c_viewshift_def); + conv expose_viewshift = once_rewrite_conv(viewshift_definitions); + gnode body = CONV_TAC(root, expose_viewshift); + body = AUTO_INTROS_TAC(body); + + term resource_ra = `c_resource_ra (G:(A)ra)`; + term source = + `P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term target = + `Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term updated_target = `c_bupd (G:(A)ra) Q`; + term_list trans_arguments = TERM_LIST( + resource_ra, + source, + target, + updated_target); + thm transitivity = ispecl_rule( + trans_arguments, + R_ENTAILS_TRANS); + term entailment_tm = ` + r_entails + (c_resource_ra (G:(A)ra)) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + `; + thm entailment = assume_rule(entailment_tm); + thm transitivity_at_entailment = mp_rule( + transitivity, + entailment); + + term ghost_ra = `G:(A)ra`; + term_list intro_arguments = TERM_LIST(ghost_ra, target); + thm target_intro = ispecl_rule( + intro_arguments, + C_BUPD_INTRO); + thm result = mp_rule( + transitivity_at_entailment, + target_intro); + ACCEPT_TAC(body, result); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_ENTAILS_TO_VIEWSHIFT = + prove_c_entails_to_viewshift(); + +PROOF static thm prove_c_viewshift_refl(void) { + term goal_tm = ` + forall + (G:(A)ra) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). + c_viewshift G P P + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + term ghost_ra = `G:(A)ra`; + term assertion = + `P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term_list lift_arguments = TERM_LIST( + ghost_ra, + assertion, + assertion); + thm lift = ispecl_rule( + lift_arguments, + C_ENTAILS_TO_VIEWSHIFT); + + term resource_ra = `c_resource_ra (G:(A)ra)`; + term_list reflexivity_arguments = TERM_LIST( + resource_ra, + assertion); + thm reflexivity = ispecl_rule( + reflexivity_arguments, + R_ENTAILS_REFL); + thm result = mp_rule(lift, reflexivity); + ACCEPT_TAC(body, result); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_VIEWSHIFT_REFL = prove_c_viewshift_refl(); + +PROOF static thm prove_c_viewshift_trans(void) { + term goal_tm = ` + forall + (G:(A)ra) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (S:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). + c_viewshift G P Q ==> + c_viewshift G Q S ==> + c_viewshift G P S + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list viewshift_definitions = THM_LIST(c_viewshift_def); + conv expose_viewshift = pure_rewrite_conv(viewshift_definitions); + gnode body = CONV_TAC(root, expose_viewshift); + body = AUTO_INTROS_TAC(body); + + term ghost_ra = `G:(A)ra`; + term resource_ra = `c_resource_ra (G:(A)ra)`; + term source = + `P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term middle = + `Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term target = + `S:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term updated_middle = `c_bupd (G:(A)ra) Q`; + term updated_target = `c_bupd (G:(A)ra) S`; + term nested_updated_target = `c_bupd (G:(A)ra) (c_bupd G S)`; + + term_list mono_arguments = TERM_LIST( + ghost_ra, + middle, + updated_target); + thm lift_second = ispecl_rule( + mono_arguments, + C_BUPD_MONO); + term second_entailment_tm = ` + r_entails + (c_resource_ra (G:(A)ra)) + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (c_bupd + G + (S:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)) + `; + thm second_entailment = assume_rule(second_entailment_tm); + thm lifted_second = mp_rule(lift_second, second_entailment); + + term_list collapse_arguments = TERM_LIST( + resource_ra, + updated_middle, + nested_updated_target, + updated_target); + thm collapse_transitivity = ispecl_rule( + collapse_arguments, + R_ENTAILS_TRANS); + thm collapse_after_lift = mp_rule( + collapse_transitivity, + lifted_second); + term_list idempotence_arguments = TERM_LIST( + ghost_ra, + target); + thm idempotence = ispecl_rule( + idempotence_arguments, + C_BUPD_IDEM); + thm collapsed = mp_rule(collapse_after_lift, idempotence); + + term_list result_arguments = TERM_LIST( + resource_ra, + source, + updated_middle, + updated_target); + thm result_transitivity = ispecl_rule( + result_arguments, + R_ENTAILS_TRANS); + term first_entailment_tm = ` + r_entails + (c_resource_ra (G:(A)ra)) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (c_bupd + G + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)) + `; + thm first_entailment = assume_rule(first_entailment_tm); + thm result_after_first = mp_rule( + result_transitivity, + first_entailment); + thm result = mp_rule(result_after_first, collapsed); + ACCEPT_TAC(body, result); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_VIEWSHIFT_TRANS = prove_c_viewshift_trans(); + +PROOF static thm prove_c_viewshift_mono(void) { + term goal_tm = ` + forall + (G:(A)ra) + (P2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). + r_entails (c_resource_ra G) P2 P ==> + c_viewshift G P Q ==> + r_entails (c_resource_ra G) Q Q2 ==> + c_viewshift G P2 Q2 + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list viewshift_definitions = THM_LIST(c_viewshift_def); + conv expose_viewshift = pure_rewrite_conv(viewshift_definitions); + gnode body = CONV_TAC(root, expose_viewshift); + body = AUTO_INTROS_TAC(body); + + term ghost_ra = `G:(A)ra`; + term resource_ra = `c_resource_ra (G:(A)ra)`; + term outer_source = + `P2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term source = + `P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term target = + `Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term outer_target = + `Q2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term updated_target = `c_bupd (G:(A)ra) Q`; + term updated_outer_target = `c_bupd (G:(A)ra) Q2`; + + term_list mono_arguments = TERM_LIST( + ghost_ra, + target, + outer_target); + thm lift_post = ispecl_rule( + mono_arguments, + C_BUPD_MONO); + term post_entailment_tm = ` + r_entails + (c_resource_ra (G:(A)ra)) + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + `; + thm post_entailment = assume_rule(post_entailment_tm); + thm lifted_post = mp_rule(lift_post, post_entailment); + + term_list post_change_arguments = TERM_LIST( + resource_ra, + source, + updated_target, + updated_outer_target); + thm post_change_transitivity = ispecl_rule( + post_change_arguments, + R_ENTAILS_TRANS); + term viewshift_entailment_tm = ` + r_entails + (c_resource_ra (G:(A)ra)) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (c_bupd + G + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)) + `; + thm viewshift_entailment = assume_rule(viewshift_entailment_tm); + thm post_change_after_viewshift = mp_rule( + post_change_transitivity, + viewshift_entailment); + thm changed_post = mp_rule( + post_change_after_viewshift, + lifted_post); + + term_list result_arguments = TERM_LIST( + resource_ra, + outer_source, + source, + updated_outer_target); + thm result_transitivity = ispecl_rule( + result_arguments, + R_ENTAILS_TRANS); + term pre_entailment_tm = ` + r_entails + (c_resource_ra (G:(A)ra)) + (P2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + `; + thm pre_entailment = assume_rule(pre_entailment_tm); + thm result_after_pre = mp_rule( + result_transitivity, + pre_entailment); + thm result = mp_rule(result_after_pre, changed_post); + ACCEPT_TAC(body, result); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_VIEWSHIFT_MONO = prove_c_viewshift_mono(); + +PROOF static thm prove_c_viewshift_frame(void) { + term goal_tm = ` + forall + (G:(A)ra) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Frame:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). + c_viewshift G P Q ==> + c_viewshift + G + (r_sep (c_resource_ra G) P Frame) + (r_sep (c_resource_ra G) Q Frame) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list viewshift_definitions = THM_LIST(c_viewshift_def); + conv expose_viewshift = pure_rewrite_conv(viewshift_definitions); + gnode body = CONV_TAC(root, expose_viewshift); + body = AUTO_INTROS_TAC(body); + + term ghost_ra = `G:(A)ra`; + term resource_ra = `c_resource_ra (G:(A)ra)`; + term source = + `P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term target = + `Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term frame = + `Frame:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term updated_target = `c_bupd (G:(A)ra) Q`; + term framed_source = `r_sep (c_resource_ra (G:(A)ra)) P Frame`; + term framed_update = ` + r_sep (c_resource_ra (G:(A)ra)) (c_bupd G Q) Frame + `; + term updated_frame = ` + c_bupd (G:(A)ra) (r_sep (c_resource_ra G) Q Frame) + `; + + term_list sep_frame_arguments = TERM_LIST( + resource_ra, + source, + updated_target, + frame); + thm sep_frame = ispecl_rule( + sep_frame_arguments, + R_SEP_FRAME_L); + term viewshift_entailment_tm = ` + r_entails + (c_resource_ra (G:(A)ra)) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (c_bupd + G + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)) + `; + thm viewshift_entailment = assume_rule(viewshift_entailment_tm); + thm expose_update = mp_rule( + sep_frame, + viewshift_entailment); + + term_list transitivity_arguments = TERM_LIST( + resource_ra, + framed_source, + framed_update, + updated_frame); + thm transitivity = ispecl_rule( + transitivity_arguments, + R_ENTAILS_TRANS); + thm transitivity_after_expose = mp_rule( + transitivity, + expose_update); + term_list update_frame_arguments = TERM_LIST( + ghost_ra, + target, + frame); + thm update_frame = ispecl_rule( + update_frame_arguments, + C_BUPD_FRAME); + thm result = mp_rule( + transitivity_after_expose, + update_frame); + ACCEPT_TAC(body, result); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_VIEWSHIFT_FRAME = prove_c_viewshift_frame(); + +/* One entailment direction of exact SEP commutativity. */ +PROOF static thm prove_c_sep_comm_entails(void) { + term goal_tm = ` + forall + (G:(A)ra) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). + r_entails + (c_resource_ra G) + (r_sep (c_resource_ra G) P Q) + (r_sep (c_resource_ra G) Q P) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list entailment_definitions = THM_LIST(r_entails_def); + conv expose_entailment = once_rewrite_conv(entailment_definitions); + gnode body = CONV_TAC(root, expose_entailment); + body = AUTO_INTROS_TAC(body); + term resource_ra = `c_resource_ra (G:(A)ra)`; + term left = + `P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term right = + `Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term_list commute_arguments = TERM_LIST( + resource_ra, + left, + right); + thm commute = ispecl_rule( + commute_arguments, + R_SEP_COMM); + term resource = ` + resource:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap + `; + thm commute_at = ap_thm_rule( + commute, + resource); + term separated_tm = ` + r_sep + (c_resource_ra (G:(A)ra)) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (resource:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) + `; + thm separated = assume_rule(separated_tm); + thm result = eq_mp_rule(commute_at, separated); + ACCEPT_TAC(body, result); + thm proved = gnode_prove(root); + return proved; +} + +PROOF static thm C_SEP_COMM_ENTAILS = + prove_c_sep_comm_entails(); + +PROOF static thm prove_c_viewshift_frame_left(void) { + term goal_tm = ` + forall + (G:(A)ra) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Frame:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). + c_viewshift G P Q ==> + c_viewshift + G + (r_sep (c_resource_ra G) Frame P) + (r_sep (c_resource_ra G) Frame Q) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + term ghost_ra = `G:(A)ra`; + term source = + `P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term target = + `Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term frame = + `Frame:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + + term_list frame_arguments = TERM_LIST( + ghost_ra, + source, + target, + frame); + thm frame_rule = ispecl_rule( + frame_arguments, + C_VIEWSHIFT_FRAME); + term viewshift_tm = ` + c_viewshift + (G:(A)ra) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + `; + thm viewshift = assume_rule(viewshift_tm); + thm right_framed = mp_rule(frame_rule, viewshift); + + term_list source_commute_arguments = TERM_LIST( + ghost_ra, + frame, + source); + thm source_commute = ispecl_rule( + source_commute_arguments, + C_SEP_COMM_ENTAILS); + term_list target_commute_arguments = TERM_LIST( + ghost_ra, + target, + frame); + thm target_commute = ispecl_rule( + target_commute_arguments, + C_SEP_COMM_ENTAILS); + + term framed_source_left = ` + r_sep (c_resource_ra (G:(A)ra)) Frame P + `; + term framed_source_right = ` + r_sep (c_resource_ra (G:(A)ra)) P Frame + `; + term framed_target_right = ` + r_sep (c_resource_ra (G:(A)ra)) Q Frame + `; + term framed_target_left = ` + r_sep (c_resource_ra (G:(A)ra)) Frame Q + `; + term_list mono_arguments = TERM_LIST( + ghost_ra, + framed_source_left, + framed_source_right, + framed_target_right, + framed_target_left); + thm mono = ispecl_rule( + mono_arguments, + C_VIEWSHIFT_MONO); + thm after_source_commute = mp_rule( + mono, + source_commute); + thm after_right_frame = mp_rule( + after_source_commute, + right_framed); + thm result = mp_rule( + after_right_frame, + target_commute); + ACCEPT_TAC(body, result); + thm proved = gnode_prove(root); + return proved; +} + +PROOF static thm C_VIEWSHIFT_FRAME_LEFT = + prove_c_viewshift_frame_left(); + +PROOF static thm prove_c_viewshift_sep(void) { + term goal_tm = ` + forall + (G:(A)ra) + (P1:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q1:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (P2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). + c_viewshift G P1 Q1 ==> + c_viewshift G P2 Q2 ==> + c_viewshift + G + (r_sep (c_resource_ra G) P1 P2) + (r_sep (c_resource_ra G) Q1 Q2) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + term ghost_ra = `G:(A)ra`; + term source_left = + `P1:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term target_left = + `Q1:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term source_right = + `P2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term target_right = + `Q2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + + term_list first_arguments = TERM_LIST( + ghost_ra, + source_left, + target_left, + source_right); + thm first_frame = ispecl_rule( + first_arguments, + C_VIEWSHIFT_FRAME); + term first_viewshift_tm = ` + c_viewshift + (G:(A)ra) + (P1:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q1:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + `; + thm first_viewshift = assume_rule(first_viewshift_tm); + thm first = mp_rule(first_frame, first_viewshift); + + term_list second_arguments = TERM_LIST( + ghost_ra, + source_right, + target_right, + target_left); + thm second_frame = ispecl_rule( + second_arguments, + C_VIEWSHIFT_FRAME_LEFT); + term second_viewshift_tm = ` + c_viewshift + (G:(A)ra) + (P2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + `; + thm second_viewshift = assume_rule(second_viewshift_tm); + thm second = mp_rule(second_frame, second_viewshift); + + term source = ` + r_sep (c_resource_ra (G:(A)ra)) P1 P2 + `; + term middle = ` + r_sep (c_resource_ra (G:(A)ra)) Q1 P2 + `; + term target = ` + r_sep (c_resource_ra (G:(A)ra)) Q1 Q2 + `; + term_list transitivity_arguments = TERM_LIST( + ghost_ra, + source, + middle, + target); + thm transitivity = ispecl_rule( + transitivity_arguments, + C_VIEWSHIFT_TRANS); + thm after_first = mp_rule(transitivity, first); + thm result = mp_rule(after_first, second); + ACCEPT_TAC(body, result); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_VIEWSHIFT_SEP = prove_c_viewshift_sep(); + +/* Eliminate a source existential while retaining one common target. */ +PROOF static thm prove_c_viewshift_exists_l(void) { + term goal_tm = ` + forall + (G:(A)ra) + (P:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). + (forall witness:B. + c_viewshift G (P witness) Q) ==> + c_viewshift + G + (r_exists (c_resource_ra G) (\bound:B. P bound)) + Q + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "G"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = DISCH_TAC(body, "Hall"); + thm_list viewshift_definitions = THM_LIST(c_viewshift_def); + conv expose_viewshift = once_rewrite_conv(viewshift_definitions); + body = CONV_TAC(body, expose_viewshift); + + term resource_ra = `c_resource_ra (G:(A)ra)`; + term source_family = + `P:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term updated_target = ` + c_bupd + G + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + `; + term_list exists_elim_arguments = TERM_LIST( + resource_ra, + source_family, + updated_target); + thm exists_elim = ispecl_rule( + exists_elim_arguments, + R_EXISTS_ELIM); + body = MATCH_MP_TAC(body, exists_elim); + body = GEN_TAC(body, "witness"); + + term witness = `witness:B`; + const_cstr_list pointwise_labels = CONST_STRING_LIST("Hall"); + term_list pointwise_terms = gnode_get_asmps(body, pointwise_labels); + term pointwise_assumption_tm = pointwise_terms[0]; + thm pointwise_assumption = assume_rule(pointwise_assumption_tm); + thm selected = spec_rule(witness, pointwise_assumption); + thm exposed = pure_once_rewrite_rule( + viewshift_definitions, + selected); + ACCEPT_TAC(body, exposed); + thm proved = gnode_prove(root); + return proved; +} + +PROOF static thm C_VIEWSHIFT_EXISTS_L = + prove_c_viewshift_exists_l(); + +/* Introduce a target existential with one explicit witness. */ +PROOF static thm prove_c_viewshift_exists_r(void) { + term goal_tm = ` + forall + (G:(A)ra) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (witness:B). + c_viewshift G P (Q witness) ==> + c_viewshift + G + P + (r_exists (c_resource_ra G) (\bound:B. Q bound)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "G"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = GEN_TAC(body, "witness"); + body = DISCH_TAC(body, "Hchange"); + thm_list viewshift_definitions = THM_LIST(c_viewshift_def); + conv expose_viewshift = once_rewrite_conv(viewshift_definitions); + body = CONV_TAC(body, expose_viewshift); + + term ghost_ra = `G:(A)ra`; + term source = + `P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term selected_target = ` + (Q:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (witness:B) + `; + const_cstr_list change_labels = CONST_STRING_LIST("Hchange"); + term_list change_terms = gnode_get_asmps(body, change_labels); + term change_assumption_tm = change_terms[0]; + thm change_assumption = assume_rule(change_assumption_tm); + thm selected = pure_once_rewrite_rule( + viewshift_definitions, + change_assumption); + + term resource_ra = `c_resource_ra (G:(A)ra)`; + term target_family = + `Q:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term witness = `witness:B`; + term_list post_inclusion_arguments = TERM_LIST( + resource_ra, + target_family, + witness); + thm post_inclusion = ispecl_rule( + post_inclusion_arguments, + R_EXISTS_INTRO); + + term existential_target = ` + r_exists + (c_resource_ra G) + (\bound:B. + (Q:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + bound) + `; + term_list bupd_mono_arguments = TERM_LIST( + ghost_ra, + selected_target, + existential_target); + thm bupd_mono = ispecl_rule( + bupd_mono_arguments, + C_BUPD_MONO); + thm lifted_post = mp_rule(bupd_mono, post_inclusion); + + term selected_update = ` + c_bupd + G + ((Q:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (witness:B)) + `; + term existential_update = ` + c_bupd + G + (r_exists + (c_resource_ra G) + (\bound:B. + (Q:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + bound)) + `; + term_list transitivity_arguments = TERM_LIST( + resource_ra, + source, + selected_update, + existential_update); + thm transitivity = ispecl_rule( + transitivity_arguments, + R_ENTAILS_TRANS); + thm after_selected = mp_rule(transitivity, selected); + thm result = mp_rule(after_selected, lifted_post); + ACCEPT_TAC(body, result); + thm proved = gnode_prove(root); + return proved; +} + +PROOF static thm C_VIEWSHIFT_EXISTS_R = + prove_c_viewshift_exists_r(); + +PROOF static thm prove_c_viewshift_exists(void) { + term goal_tm = ` + forall + (G:(A)ra) + (P:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). + (forall witness:B. + c_viewshift G (P witness) (Q witness)) ==> + c_viewshift + G + (r_exists (c_resource_ra G) (\bound:B. P bound)) + (r_exists (c_resource_ra G) (\bound:B. Q bound)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "G"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = DISCH_TAC(body, "Hall"); + term ghost_ra = `G:(A)ra`; + term source_family = + `P:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term existential_target = ` + r_exists + (c_resource_ra G) + (\bound:B. + (Q:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + bound) + `; + term_list eliminate_source_arguments = TERM_LIST( + ghost_ra, + source_family, + existential_target); + thm eliminate_source = ispecl_rule( + eliminate_source_arguments, + C_VIEWSHIFT_EXISTS_L); + body = MATCH_MP_TAC(body, eliminate_source); + body = GEN_TAC(body, "witness"); + + term witness = `witness:B`; + const_cstr_list pointwise_labels = CONST_STRING_LIST("Hall"); + term_list pointwise_terms = gnode_get_asmps(body, pointwise_labels); + term pointwise_assumption_tm = pointwise_terms[0]; + thm pointwise_assumption = assume_rule(pointwise_assumption_tm); + thm selected = spec_rule(witness, pointwise_assumption); + + term selected_source = ` + (P:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (witness:B) + `; + term target_family = + `Q:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term_list introduce_target_arguments = TERM_LIST( + ghost_ra, + selected_source, + target_family, + witness); + thm introduce_target = ispecl_rule( + introduce_target_arguments, + C_VIEWSHIFT_EXISTS_R); + thm result = mp_rule(introduce_target, selected); + ACCEPT_TAC(body, result); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_VIEWSHIFT_EXISTS = + prove_c_viewshift_exists(); + +/* ------------------------------------------------------------------------- */ +/* Conservative-extension audit */ +/* ------------------------------------------------------------------------- */ + +PROOF static int audit_c_basic_update(void) { + thm_list public_theorems = THM_LIST( + c_bupd_def, + c_viewshift_def, + C_BUPD_INTRO, + C_BUPD_MONO, + C_BUPD_IDEM, + C_BUPD_FRAME, + C_ENTAILS_TO_VIEWSHIFT, + C_VIEWSHIFT_REFL, + C_VIEWSHIFT_TRANS, + C_VIEWSHIFT_MONO, + C_VIEWSHIFT_FRAME, + C_VIEWSHIFT_SEP, + C_VIEWSHIFT_EXISTS); + + for (size_t i = 0; i < vector_size(public_theorems); ++i) { + ENSURE_COND(!IS_NULL(public_theorems[i]), + "C basic-update theorem %zu is empty", i); + term_list theorem_hypotheses = hyp(public_theorems[i]); + size_t hypothesis_count = vector_size(theorem_hypotheses); + ENSURE_COND(hypothesis_count == 0, + "C basic-update theorem %zu has hypotheses", i); + } + thm_list final_axioms = get_all_axioms(); + size_t final_axiom_count = vector_size(final_axioms); + ENSURE_COND(final_axiom_count == C_BASIC_UPDATE_AXIOMS_BEFORE, + "C basic-update theory introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_c_basic_update"); + return -1; +} + +PROOF static int _C_BASIC_UPDATE_AUDIT = + audit_c_basic_update(); diff --git a/theory/c_program_logic/c_basic_update.h b/theory/c_program_logic/c_basic_update.h new file mode 100644 index 0000000..65ccb7c --- /dev/null +++ b/theory/c_program_logic/c_basic_update.h @@ -0,0 +1,140 @@ +/** + * @file c_basic_update.h + * @brief Ghost-only basic updates and view shifts for C resource assertions. + * + * `c_bupd G Q (physical,ghost)` performs an `ra_update_nd` only in + * `ghost_heap_ra G` over carrier `(num,A)finmap`, and evaluates `Q` at + * `(physical,ghost')`. The physical projection is therefore definitionally + * fixed across every result and every hidden ghost frame. The generic + * `r_viewshift (c_resource_ra G)` is not a C view shift because it can update + * physical memory; this module exports only the restricted ghost-only relation + * below. + * + * For this header, let + * + * ```text + * R_G = c_resource_ra G + * Prop_G = carrier(R_G) -> bool + * P ⊢_G Q = r_entails R_G P Q + * P **_G Q = r_sep R_G P Q + * P ⇛_G Q = c_viewshift G P Q. + * ``` + * + * The symbol `⇛_G` is notation used only in documentation; the HOL constant + * is `c_viewshift G`. Every exported theorem below is hypothesis-free and + * universally quantified over the variables displayed in its contract. + */ + +#pragma once + +#include "proof/theory/c_program_logic/c_resource.h" + +/* ------------------------------------------------------------------------- */ +/* Modality and viewshift */ +/* ------------------------------------------------------------------------- */ + +/** + * Defining theorem for the ghost-only basic-update modality: + * + * ```text + * ⊢ ∀G Q resource. + * c_bupd G Q resource ⇔ + * ra_update_nd (ghost_heap_ra G) (SND resource) + * (\ghost'. Q (FST resource, ghost')). + * ``` + * + * In particular, every result is evaluated with the original `FST resource`. + */ +PROOF extern thm c_bupd_def; + +/** + * Defining theorem for C view shift: + * + * ```text + * ⊢ ∀G P Q. c_viewshift G P Q ⇔ P ⊢_G c_bupd G Q. + * ``` + * + * This relation is intentionally narrower than + * `r_viewshift (c_resource_ra G)`. + */ +PROOF extern thm c_viewshift_def; + +/* ------------------------------------------------------------------------- */ +/* Basic-update laws */ +/* ------------------------------------------------------------------------- */ + +/** Introduction: `⊢ ∀G P. P ⊢_G c_bupd G P`. */ +PROOF extern thm C_BUPD_INTRO; + +/** + * Monotonicity: + * `⊢ ∀G P Q. (P ⊢_G Q) ⇒ (c_bupd G P ⊢_G c_bupd G Q)`. + */ +PROOF extern thm C_BUPD_MONO; + +/** Idempotence: `⊢ ∀G P. c_bupd G (c_bupd G P) ⊢_G c_bupd G P`. */ +PROOF extern thm C_BUPD_IDEM; + +/** + * Linear frame law: + * `⊢ ∀G P F. (c_bupd G P **_G F) ⊢_G c_bupd G (P **_G F)`. + * + * The frame is preserved linearly; this is not an affine weakening rule. + */ +PROOF extern thm C_BUPD_FRAME; + +/* ------------------------------------------------------------------------- */ +/* Viewshift laws */ +/* ------------------------------------------------------------------------- */ + +/** Entailment embeds into view shift: `⊢ ∀G P Q. (P ⊢_G Q) ⇒ (P ⇛_G Q)`. */ +PROOF extern thm C_ENTAILS_TO_VIEWSHIFT; + +/** Reflexivity: `⊢ ∀G P. P ⇛_G P`. */ +PROOF extern thm C_VIEWSHIFT_REFL; + +/** + * Sequential composition: + * `⊢ ∀G P Q S. (P ⇛_G Q) ⇒ (Q ⇛_G S) ⇒ (P ⇛_G S)`. + */ +PROOF extern thm C_VIEWSHIFT_TRANS; + +/** + * Consequence on both endpoints: + * + * ```text + * ⊢ ∀G P2 P Q Q2. + * (P2 ⊢_G P) ⇒ (P ⇛_G Q) ⇒ (Q ⊢_G Q2) ⇒ (P2 ⇛_G Q2). + * ``` + */ +PROOF extern thm C_VIEWSHIFT_MONO; + +/** + * Right framing: + * `⊢ ∀G P Q F. (P ⇛_G Q) ⇒ ((P **_G F) ⇛_G (Q **_G F))`. + */ +PROOF extern thm C_VIEWSHIFT_FRAME; + +/** + * Independent composition: + * + * ```text + * ⊢ ∀G P1 Q1 P2 Q2. + * (P1 ⇛_G Q1) ⇒ (P2 ⇛_G Q2) ⇒ + * ((P1 **_G P2) ⇛_G (Q1 **_G Q2)). + * ``` + */ +PROOF extern thm C_VIEWSHIFT_SEP; + +/** + * Pointwise view shifts lift through an SL existential: + * + * ```text + * ⊢ ∀G P Q. + * (∀w:B. P w ⇛_G Q w) ⇒ + * (r_exists R_G (\x. P x) ⇛_G r_exists R_G (\x. Q x)). + * ``` + * + * The same witness type `B` and pointwise family index are used on both sides. + */ +PROOF extern thm C_VIEWSHIFT_EXISTS; diff --git a/theory/c_program_logic/c_ghost_update.c b/theory/c_program_logic/c_ghost_update.c new file mode 100644 index 0000000..32c95eb --- /dev/null +++ b/theory/c_program_logic/c_ghost_update.c @@ -0,0 +1,702 @@ +#include "proof/theory/c_program_logic/c_ghost_update.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/c_program_logic/c_basic_update.c" +#require "proof/theory/logic/ghost_heap.c" + +PROOF static thm_list C_GHOST_UPDATE_INITIAL_AXIOMS = get_all_axioms(); +PROOF static size_t C_GHOST_UPDATE_AXIOMS_BEFORE = + vector_size(C_GHOST_UPDATE_INITIAL_AXIOMS); + +/* ------------------------------------------------------------------------- */ +/* Exact ownership algebra */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_c_ghost_own_op(void) { + term goal_tm = ` + forall (G:(A)ra) (name:num) (a:A) (b:A). + c_ghost_own G name (ra_op G a b) == + r_sep + (c_resource_ra G) + (c_ghost_own G name a) + (c_ghost_own G name b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm own_op_backwards = gsym_rule(R_OWN_OP); + thm fst = get_theorem_by_name("FST"); + thm snd = get_theorem_by_name("SND"); + thm_list normalization_rules = THM_LIST( + c_ghost_own_def, + own_op_backwards, + C_RESOURCE_RA_OP, + fst, + snd, + RA_UNIT_L, + GHOST_HEAP_SINGLETON_OP); + conv normalization = rewrite_conv(normalization_rules); + gnode normalized = CONV_TAC(root, normalization); + thm result = gnode_prove(root); + return result; +} + +PROOF thm C_GHOST_OWN_OP = prove_c_ghost_own_op(); + +/* ------------------------------------------------------------------------- */ +/* Fixed-name payload updates */ +/* ------------------------------------------------------------------------- */ + +/* Bridge a ghost-heap update into the C modality while fixing physical FST. */ +PROOF static thm prove_c_ghost_heap_own_update(void) { + term goal_tm = ` + forall + (G:(A)ra) + (owned:(num,A)finmap) + (selected:(num,A)finmap). + ra_update (ghost_heap_ra G) owned selected ==> + c_viewshift + G + (r_own + (c_resource_ra G) + (ra_unit mem_ra,owned)) + (r_own + (c_resource_ra G) + (ra_unit mem_ra,selected)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list definitions = THM_LIST( + c_viewshift_def, + r_entails_def, + c_bupd_def, + r_own_def, + ra_update_nd_def, + ra_update_def); + conv unfold_definitions = pure_rewrite_conv(definitions); + gnode body = CONV_TAC(root, unfold_definitions); + body = GEN_TAC(body, "G"); + body = GEN_TAC(body, "owned"); + body = GEN_TAC(body, "selected"); + body = DISCH_TAC(body, "Hupdate"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid_resource"); + body = DISCH_TAC(body, "Hown"); + body = GEN_TAC(body, "hidden"); + body = DISCH_TAC(body, "Hvalid_source"); + + const_cstr_list own_labels = CONST_STRING_LIST("Hown"); + term_list own_terms = gnode_get_asmps(body, own_labels); + term own_tm = own_terms[0]; + thm own = assume_rule(own_tm); + term fst_function = ` + FST: + (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> + (int,(pmem_byte_state)excl)finmap + `; + thm fst_owned = ap_term_rule(fst_function, own); + thm fst = get_theorem_by_name("FST"); + thm_list fst_rewrites = THM_LIST(fst); + fst_owned = pure_rewrite_rule(fst_rewrites, fst_owned); + term snd_function = ` + SND: + (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> + (num,A)finmap + `; + thm snd_owned = ap_term_rule(snd_function, own); + thm snd = get_theorem_by_name("SND"); + thm_list snd_rewrites = THM_LIST(snd); + snd_owned = pure_rewrite_rule(snd_rewrites, snd_owned); + term validity_predicate = ` + \ghost:(num,A)finmap. + ra_valid + (ghost_heap_ra (G:(A)ra)) + (ra_op (ghost_heap_ra G) ghost (hidden:(num,A)finmap)) + `; + thm replace_source_raw = ap_term_rule( + validity_predicate, + snd_owned); + thm replace_source = beta_rule(replace_source_raw); + const_cstr_list valid_source_labels = + CONST_STRING_LIST("Hvalid_source"); + term_list valid_source_terms = gnode_get_asmps( + body, + valid_source_labels); + term valid_source_tm = valid_source_terms[0]; + thm valid_source = assume_rule(valid_source_tm); + thm valid_owned = eq_mp_rule(replace_source, valid_source); + + const_cstr_list update_labels = CONST_STRING_LIST("Hupdate"); + term_list update_terms = gnode_get_asmps(body, update_labels); + term update_tm = update_terms[0]; + thm update = assume_rule(update_tm); + term hidden_tm = `hidden:(num,A)finmap`; + thm update_at_hidden = spec_rule(hidden_tm, update); + thm valid_selected = mp_rule(update_at_hidden, valid_owned); + + term selected_tm = `selected:(num,A)finmap`; + body = EXISTS_TAC(body, selected_tm); + gnode_list result = CONJ_TAC(body); + + term resource_fst_tm = ` + FST (resource: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) + `; + term physical_unit_tm = ` + ra_unit mem_ra:(int,(pmem_byte_state)excl)finmap + `; + thm pair_eq = get_theorem_by_name("PAIR_EQ"); + term_list pair_eq_arguments = TERM_LIST( + resource_fst_tm, + selected_tm, + physical_unit_tm, + selected_tm); + thm pair_components = ispecl_rule(pair_eq_arguments, pair_eq); + thm selected_refl = refl_rule(selected_tm); + thm components = conj_rule(fst_owned, selected_refl); + thm components_to_pair = gsym_rule(pair_components); + thm exact_pair = eq_mp_rule(components_to_pair, components); + conv beta = get_conversion_by_name("BETA_CONV"); + gnode exact_goal = CONV_TAC(result[0], beta); + ACCEPT_TAC(exact_goal, exact_pair); + ACCEPT_TAC(result[1], valid_selected); + thm proved = gnode_prove(root); + return proved; +} + +PROOF static thm C_GHOST_HEAP_OWN_UPDATE = + prove_c_ghost_heap_own_update(); + +PROOF static thm prove_c_ghost_own_update(void) { + term goal_tm = ` + forall + (G:(A)ra) + (name:num) + (a:A) + (b:A). + ra_update G a b ==> + c_viewshift + G + (c_ghost_own G name a) + (c_ghost_own G name b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm_list own_definitions = THM_LIST(c_ghost_own_def); + conv unfold_own = pure_rewrite_conv(own_definitions); + body = CONV_TAC(body, unfold_own); + term ghost_ra_tm = `G:(A)ra`; + term name_tm = `name:num`; + term source_value_tm = `a:A`; + term target_value_tm = `b:A`; + term_list singleton_update_arguments = TERM_LIST( + ghost_ra_tm, + name_tm, + source_value_tm, + target_value_tm); + thm singleton_update = ispecl_rule( + singleton_update_arguments, + GHOST_HEAP_UPDATE_SINGLETON); + term update_tm = `ra_update (G:(A)ra) (a:A) (b:A)`; + thm update = assume_rule(update_tm); + thm local = mp_rule(singleton_update, update); + term source_heap_tm = `finmap_singleton (name:num) (a:A)`; + term target_heap_tm = `finmap_singleton (name:num) (b:A)`; + term_list heap_update_arguments = TERM_LIST( + ghost_ra_tm, + source_heap_tm, + target_heap_tm); + thm heap_update = ispecl_rule( + heap_update_arguments, + C_GHOST_HEAP_OWN_UPDATE); + thm result = mp_rule(heap_update, local); + ACCEPT_TAC(body, result); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_GHOST_OWN_UPDATE = + prove_c_ghost_own_update(); + +PROOF static thm prove_c_ghost_own_update_nd(void) { + term goal_tm = ` + forall + (G:(A)ra) + (name:num) + (a:A) + (P:A->bool). + ra_update_nd G a P ==> + c_viewshift + G + (c_ghost_own G name a) + (r_exists + (c_resource_ra G) + (\b:A. + r_and + (c_resource_ra G) + (r_pure (c_resource_ra G) (P b)) + (c_ghost_own G name b))) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "G"); + body = GEN_TAC(body, "name"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "P"); + body = DISCH_TAC(body, "Hbase_update"); + + term ghost_ra_tm = `G:(A)ra`; + term name_tm = `name:num`; + term owned_value_tm = `a:A`; + term result_predicate_tm = `P:A->bool`; + term_list local_arguments = TERM_LIST( + ghost_ra_tm, + name_tm, + owned_value_tm, + result_predicate_tm); + thm local_rule = ispecl_rule( + local_arguments, + GHOST_HEAP_UPDATE_SINGLETON_ND); + const_cstr_list base_update_labels = + CONST_STRING_LIST("Hbase_update"); + term_list base_update_terms = gnode_get_asmps( + body, + base_update_labels); + term base_update_tm = base_update_terms[0]; + thm base_update = assume_rule(base_update_tm); + thm local = mp_rule(local_rule, base_update); + thm_list update_definitions = THM_LIST(ra_update_nd_def); + local = pure_once_rewrite_rule( + update_definitions, + local); + local = beta_rule(local); + body = ASSUME_TAC(body, local, "Hlocal_update"); + + thm_list definitions = THM_LIST( + c_viewshift_def, + r_entails_def, + c_bupd_def, + c_ghost_own_def, + r_own_def, + r_exists_def, + r_and_def, + r_pure_def, + ra_update_nd_def); + conv unfold_definitions = pure_rewrite_conv(definitions); + body = CONV_TAC(body, unfold_definitions); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid_resource"); + body = DISCH_TAC(body, "Hown"); + body = GEN_TAC(body, "hidden"); + body = DISCH_TAC(body, "Hvalid_source"); + + const_cstr_list own_labels = CONST_STRING_LIST("Hown"); + term_list own_terms = gnode_get_asmps(body, own_labels); + term own_tm = own_terms[0]; + thm own = assume_rule(own_tm); + term fst_function = ` + FST: + (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> + (int,(pmem_byte_state)excl)finmap + `; + thm fst_owned = ap_term_rule(fst_function, own); + thm fst = get_theorem_by_name("FST"); + thm_list fst_rewrites = THM_LIST(fst); + fst_owned = pure_rewrite_rule(fst_rewrites, fst_owned); + term snd_function = ` + SND: + (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> + (num,A)finmap + `; + thm snd_owned = ap_term_rule(snd_function, own); + thm snd = get_theorem_by_name("SND"); + thm_list snd_rewrites = THM_LIST(snd); + snd_owned = pure_rewrite_rule(snd_rewrites, snd_owned); + term validity_predicate = ` + \ghost:(num,A)finmap. + ra_valid + (ghost_heap_ra (G:(A)ra)) + (ra_op (ghost_heap_ra G) ghost (hidden:(num,A)finmap)) + `; + thm replace_source_raw = ap_term_rule( + validity_predicate, + snd_owned); + thm replace_source = beta_rule(replace_source_raw); + const_cstr_list valid_source_labels = + CONST_STRING_LIST("Hvalid_source"); + term_list valid_source_terms = gnode_get_asmps( + body, + valid_source_labels); + term valid_source_tm = valid_source_terms[0]; + thm valid_source = assume_rule(valid_source_tm); + thm valid_local_source = eq_mp_rule( + replace_source, + valid_source); + + const_cstr_list local_update_labels = + CONST_STRING_LIST("Hlocal_update"); + term_list local_update_terms = gnode_get_asmps( + body, + local_update_labels); + term local_update_tm = local_update_terms[0]; + thm local_update = assume_rule(local_update_tm); + term hidden_tm = `hidden:(num,A)finmap`; + thm local_at_hidden = spec_rule(hidden_tm, local_update); + thm selected = mp_rule(local_at_hidden, valid_local_source); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "selected_heap"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "Hselected_pred", + "Hvalid_selected"); + body = ASMP_EXISTS_TAC(body, "Hselected_pred", "b"); + body = ASMP_CONJ_TAC( + body, + "Hselected_pred", + "HP_b", + "Hselected_exact"); + + term selected_heap_tm = `selected_heap:(num,A)finmap`; + body = EXISTS_TAC(body, selected_heap_tm); + gnode_list result = CONJ_TAC(body); + conv beta = get_conversion_by_name("BETA_CONV"); + conv beta_depth = depth_conv(beta); + gnode post = CONV_TAC(result[0], beta_depth); + term selected_value_tm = `b:A`; + post = EXISTS_TAC(post, selected_value_tm); + thm_list post_definitions = THM_LIST( + r_and_def, + r_pure_def, + r_own_def); + conv unfold_post = pure_rewrite_conv(post_definitions); + post = CONV_TAC(post, unfold_post); + gnode_list post_parts = CONJ_TAC(post); + const_cstr_list selected_value_labels = CONST_STRING_LIST("HP_b"); + term_list selected_value_terms = gnode_get_asmps( + post_parts[0], + selected_value_labels); + term selected_value_fact_tm = selected_value_terms[0]; + thm selected_value_fact = assume_rule(selected_value_fact_tm); + ACCEPT_TAC(post_parts[0], selected_value_fact); + + const_cstr_list selected_exact_labels = + CONST_STRING_LIST("Hselected_exact"); + term_list selected_exact_terms = gnode_get_asmps( + post_parts[1], + selected_exact_labels); + term selected_exact_tm = selected_exact_terms[0]; + thm selected_exact = assume_rule(selected_exact_tm); + term resource_fst_tm = ` + FST (resource: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) + `; + term physical_unit_tm = ` + ra_unit mem_ra:(int,(pmem_byte_state)excl)finmap + `; + term singleton_selected_tm = ` + finmap_singleton (name:num) (b:A) + `; + thm pair_eq = get_theorem_by_name("PAIR_EQ"); + term_list pair_eq_arguments = TERM_LIST( + resource_fst_tm, + selected_heap_tm, + physical_unit_tm, + singleton_selected_tm); + thm pair_components = ispecl_rule(pair_eq_arguments, pair_eq); + thm components = conj_rule(fst_owned, selected_exact); + thm components_to_pair = gsym_rule(pair_components); + thm exact_pair = eq_mp_rule(components_to_pair, components); + ACCEPT_TAC(post_parts[1], exact_pair); + + const_cstr_list selected_valid_labels = + CONST_STRING_LIST("Hvalid_selected"); + term_list selected_valid_terms = gnode_get_asmps( + result[1], + selected_valid_labels); + term selected_valid_tm = selected_valid_terms[0]; + thm selected_valid = assume_rule(selected_valid_tm); + ACCEPT_TAC(result[1], selected_valid); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_GHOST_OWN_UPDATE_ND = + prove_c_ghost_own_update_nd(); + +/* ------------------------------------------------------------------------- */ +/* Fresh-name allocation */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_c_ghost_own_alloc_empty(void) { + term goal_tm = ` + forall (G:(A)ra) (a:A). + ra_valid G a ==> + c_viewshift + G + (r_emp (c_resource_ra G)) + (r_exists + (c_resource_ra G) + (\name:num. c_ghost_own G name a)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list definitions = THM_LIST( + c_viewshift_def, + r_entails_def, + c_bupd_def, + r_emp_def, + r_exists_def, + c_ghost_own_def, + r_own_def); + conv unfold_definitions = pure_rewrite_conv(definitions); + gnode body = CONV_TAC(root, unfold_definitions); + conv beta = get_conversion_by_name("BETA_CONV"); + conv beta_depth = depth_conv(beta); + body = CONV_TAC(body, beta_depth); + body = GEN_TAC(body, "G"); + body = GEN_TAC(body, "a"); + body = DISCH_TAC(body, "Hvalid_a"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid_resource"); + body = DISCH_TAC(body, "Hemp"); + thm_list update_definitions = THM_LIST(ra_update_nd_def); + conv expose_update = once_rewrite_conv(update_definitions); + body = CONV_TAC(body, expose_update); + body = GEN_TAC(body, "hidden"); + body = DISCH_TAC(body, "Hvalid_source"); + + const_cstr_list emp_labels = CONST_STRING_LIST("Hemp"); + term_list emp_terms = gnode_get_asmps(body, emp_labels); + term emp_tm = emp_terms[0]; + thm emp = assume_rule(emp_tm); + term ghost_ra_tm = `G:(A)ra`; + thm resource_unit_rule = ispec_rule( + ghost_ra_tm, + C_RESOURCE_RA_UNIT); + thm resource_unit = trans_rule(emp, resource_unit_rule); + term fst_function = ` + FST: + (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> + (int,(pmem_byte_state)excl)finmap + `; + thm fst_empty = ap_term_rule(fst_function, resource_unit); + thm fst = get_theorem_by_name("FST"); + thm_list fst_rewrites = THM_LIST(fst); + fst_empty = pure_rewrite_rule(fst_rewrites, fst_empty); + term snd_function = ` + SND: + (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> + (num,A)finmap + `; + thm snd_empty = ap_term_rule(snd_function, resource_unit); + thm snd = get_theorem_by_name("SND"); + thm_list snd_rewrites = THM_LIST(snd); + snd_empty = pure_rewrite_rule(snd_rewrites, snd_empty); + thm ghost_heap_unit = ispec_rule(ghost_ra_tm, GHOST_HEAP_UNIT); + snd_empty = trans_rule(snd_empty, ghost_heap_unit); + + term source_validity_predicate = ` + \ghost:(num,A)finmap. + ra_valid + (ghost_heap_ra (G:(A)ra)) + (ra_op + (ghost_heap_ra G) + ghost + (hidden:(num,A)finmap)) + `; + thm replace_source_raw = ap_term_rule( + source_validity_predicate, + snd_empty); + thm replace_source = beta_rule(replace_source_raw); + const_cstr_list valid_source_labels = + CONST_STRING_LIST("Hvalid_source"); + term_list valid_source_terms = gnode_get_asmps( + body, + valid_source_labels); + term valid_source_tm = valid_source_terms[0]; + thm valid_source = assume_rule(valid_source_tm); + thm valid_empty_source = eq_mp_rule( + replace_source, + valid_source); + + term owned_value_tm = `a:A`; + term_list allocation_arguments = TERM_LIST( + ghost_ra_tm, + owned_value_tm); + thm allocation_rule = ispecl_rule( + allocation_arguments, + GHOST_HEAP_ALLOC_EMPTY); + const_cstr_list value_valid_labels = CONST_STRING_LIST("Hvalid_a"); + term_list value_valid_terms = gnode_get_asmps( + body, + value_valid_labels); + term value_valid_tm = value_valid_terms[0]; + thm value_valid = assume_rule(value_valid_tm); + thm allocation = mp_rule(allocation_rule, value_valid); + allocation = pure_once_rewrite_rule( + update_definitions, + allocation); + allocation = beta_rule(allocation); + term hidden_tm = `hidden:(num,A)finmap`; + thm allocation_at_hidden = spec_rule(hidden_tm, allocation); + thm selected = mp_rule(allocation_at_hidden, valid_empty_source); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "result_heap"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "Hallocated", + "Hvalid_result"); + body = ASMP_EXISTS_TAC(body, "Hallocated", "name"); + + term result_heap_tm = `result_heap:(num,A)finmap`; + body = EXISTS_TAC(body, result_heap_tm); + gnode_list result = CONJ_TAC(body); + gnode post = CONV_TAC(result[0], beta_depth); + term name_tm = `name:num`; + post = EXISTS_TAC(post, name_tm); + thm_list own_definitions = THM_LIST(r_own_def); + conv unfold_own = pure_rewrite_conv(own_definitions); + post = CONV_TAC(post, unfold_own); + + const_cstr_list allocated_labels = CONST_STRING_LIST("Hallocated"); + term_list allocated_terms = gnode_get_asmps(post, allocated_labels); + term allocated_tm = allocated_terms[0]; + thm allocated = assume_rule(allocated_tm); + term resource_fst_tm = ` + FST (resource: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) + `; + term physical_unit_tm = ` + ra_unit mem_ra:(int,(pmem_byte_state)excl)finmap + `; + term singleton_tm = `finmap_singleton (name:num) (a:A)`; + thm pair_eq = get_theorem_by_name("PAIR_EQ"); + term_list pair_eq_arguments = TERM_LIST( + resource_fst_tm, + result_heap_tm, + physical_unit_tm, + singleton_tm); + thm pair_components = ispecl_rule(pair_eq_arguments, pair_eq); + thm components = conj_rule(fst_empty, allocated); + thm components_to_pair = gsym_rule(pair_components); + thm exact_pair = eq_mp_rule(components_to_pair, components); + ACCEPT_TAC(post, exact_pair); + + const_cstr_list result_valid_labels = + CONST_STRING_LIST("Hvalid_result"); + term_list result_valid_terms = gnode_get_asmps( + result[1], + result_valid_labels); + term result_valid_tm = result_valid_terms[0]; + thm result_valid = assume_rule(result_valid_tm); + ACCEPT_TAC(result[1], result_valid); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_GHOST_OWN_ALLOC_EMPTY = + prove_c_ghost_own_alloc_empty(); + +PROOF static thm prove_c_ghost_own_alloc(void) { + term goal_tm = ` + forall + (G:(A)ra) + (a:A) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). + ra_valid G a ==> + c_viewshift + G + P + (r_exists + (c_resource_ra G) + (\name:num. + r_sep + (c_resource_ra G) + (c_ghost_own G name a) + P)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "G"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "P"); + body = DISCH_TAC(body, "Hvalid_a"); + + term ghost_ra_tm = `G:(A)ra`; + term owned_value_tm = `a:A`; + term_list empty_allocation_arguments = TERM_LIST( + ghost_ra_tm, + owned_value_tm); + thm empty_allocation_rule = ispecl_rule( + empty_allocation_arguments, + C_GHOST_OWN_ALLOC_EMPTY); + const_cstr_list value_valid_labels = CONST_STRING_LIST("Hvalid_a"); + term_list value_valid_terms = gnode_get_asmps( + body, + value_valid_labels); + term value_valid_tm = value_valid_terms[0]; + thm value_valid = assume_rule(value_valid_tm); + thm empty_allocation = mp_rule( + empty_allocation_rule, + value_valid); + + term empty_source_tm = `r_emp (c_resource_ra (G:(A)ra))`; + term allocated_target_tm = ` + r_exists + (c_resource_ra (G:(A)ra)) + (\name:num. c_ghost_own G name (a:A)) + `; + term frame_tm = ` + P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool + `; + term_list frame_arguments = TERM_LIST( + ghost_ra_tm, + empty_source_tm, + allocated_target_tm, + frame_tm); + thm frame_rule = ispecl_rule(frame_arguments, C_VIEWSHIFT_FRAME); + thm framed = mp_rule(frame_rule, empty_allocation); + thm_list normalization_rules = THM_LIST( + R_SEP_EMP_L, + R_SEP_EXISTS_L); + thm normalized = pure_rewrite_rule( + normalization_rules, + framed); + normalized = beta_rule(normalized); + ACCEPT_TAC(body, normalized); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_GHOST_OWN_ALLOC = + prove_c_ghost_own_alloc(); + +/* ------------------------------------------------------------------------- */ +/* Conservative-extension audit */ +/* ------------------------------------------------------------------------- */ + +PROOF static int audit_c_ghost_update(void) { + thm_list public_theorems = THM_LIST( + C_GHOST_OWN_OP, + C_GHOST_OWN_UPDATE, + C_GHOST_OWN_UPDATE_ND, + C_GHOST_OWN_ALLOC_EMPTY, + C_GHOST_OWN_ALLOC); + + for (size_t i = 0; i < vector_size(public_theorems); ++i) { + ENSURE_COND(!IS_NULL(public_theorems[i]), + "C ghost-update theorem %zu is empty", i); + term_list theorem_hypotheses = hyp(public_theorems[i]); + size_t hypothesis_count = vector_size(theorem_hypotheses); + ENSURE_COND(hypothesis_count == 0, + "C ghost-update theorem %zu has hypotheses", i); + } + thm_list final_axioms = get_all_axioms(); + size_t final_axiom_count = vector_size(final_axioms); + ENSURE_COND(final_axiom_count == C_GHOST_UPDATE_AXIOMS_BEFORE, + "C ghost-update theory introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_c_ghost_update"); + return -1; +} + +PROOF static int _C_GHOST_UPDATE_AUDIT = + audit_c_ghost_update(); diff --git a/theory/c_program_logic/c_ghost_update.h b/theory/c_program_logic/c_ghost_update.h new file mode 100644 index 0000000..b0f2958 --- /dev/null +++ b/theory/c_program_logic/c_ghost_update.h @@ -0,0 +1,110 @@ +/** + * @file c_ghost_update.h + * @brief C-level algebra, update, and allocation rules for named ghost cells. + * + * The underlying finite-map updates come from `ghost_heap.h`; every theorem + * below concludes with the restricted `c_viewshift` from `c_basic_update.h`. + * Consequently the physical projection is preserved definitionally. This + * module contains no assertion-model installation or symbolic-state code. + * + * In this header, `R_G` abbreviates `c_resource_ra G`, `P ⇛_G Q` abbreviates + * `c_viewshift G P Q`, and `P **_G Q` abbreviates `r_sep R_G P Q`. + * `name:num` is a logical ghost-heap key, not a QCP-special value. All exported + * rules are hypothesis-free HOL theorems with the displayed premises + * represented as object-level implications. + */ + +#pragma once + +#include "proof/theory/c_program_logic/c_basic_update.h" + +/* ------------------------------------------------------------------------- */ +/* Exact ownership algebra */ +/* ------------------------------------------------------------------------- */ + +/** + * Two fragments of the same named cell compose through the payload RA: + * + * ```text + * ⊢ ∀G name a b. + * c_ghost_own G name (ra_op G a b) = + * (c_ghost_own G name a **_G c_ghost_own G name b). + * ``` + * + * Both sides own the physical-memory unit and exactly one ghost-heap key. + * In particular, this law preserves the shared `name`; it does not allocate + * or rename a logical cell. The conclusion is raw HOL equality of assertions, + * not merely one direction of SL entailment. + */ +PROOF extern thm C_GHOST_OWN_OP; + +/* ------------------------------------------------------------------------- */ +/* Fixed-name payload updates */ +/* ------------------------------------------------------------------------- */ + +/** + * Lift a deterministic payload update at a fixed name: + * + * ```text + * ⊢ ∀G name a b. + * ra_update G a b ⇒ + * (c_ghost_own G name a ⇛_G c_ghost_own G name b). + * ``` + */ +PROOF extern thm C_GHOST_OWN_UPDATE; + +/** + * Lift a nondeterministic payload update at a fixed name: + * + * ```text + * ⊢ ∀G name a result_pred. + * ra_update_nd G a result_pred ⇒ + * c_ghost_own G name a ⇛_G + * r_exists R_G (\b. + * r_and R_G (r_pure R_G (result_pred b)) + * (c_ghost_own G name b)). + * ``` + * + * The existential witness is the selected result `b`; the pure conjunct + * records that the selection satisfies `result_pred`. + */ +PROOF extern thm C_GHOST_OWN_UPDATE_ND; + +/* ------------------------------------------------------------------------- */ +/* Existential ghost-cell allocation */ +/* ------------------------------------------------------------------------- */ + +/** + * For each compatible hidden ghost frame, the proof can choose a name absent + * from both the owned ghost heap and that frame. The public target exposes + * ownership at the selected name but no separate pure freshness proposition; + * callers must not infer lookup freshness beyond the displayed theorem shape. + * No physical resource is allocated. + */ + +/** + * Allocate into the empty combined resource: + * + * ```text + * ⊢ ∀G a. + * ra_valid G a ⇒ + * r_emp R_G ⇛_G r_exists R_G (\name. c_ghost_own G name a). + * ``` + * + * The premise is necessary because allocation must produce a valid singleton. + */ +PROOF extern thm C_GHOST_OWN_ALLOC_EMPTY; + +/** + * Allocate while linearly preserving an arbitrary C assertion: + * + * ```text + * ⊢ ∀G a P. + * ra_valid G a ⇒ + * P ⇛_G r_exists R_G (\name. c_ghost_own G name a **_G P). + * ``` + * + * `P` is retained exactly as a linear frame; the rule does not duplicate or + * discard any physical or ghost ownership already described by `P`. + */ +PROOF extern thm C_GHOST_OWN_ALLOC; diff --git a/theory/c_program_logic/c_integer.c b/theory/c_program_logic/c_integer.c new file mode 100644 index 0000000..82ee923 --- /dev/null +++ b/theory/c_program_logic/c_integer.c @@ -0,0 +1,248 @@ +#include "proof/theory/c_program_logic/c_integer.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" + +PROOF static size_t C_INTEGER_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +/* ------------------------------------------------------------------------- */ +/* Width-generic C integer conversion */ +/* ------------------------------------------------------------------------- */ + +PROOF thm c_exp_2_def = new_fun_definition(` + exp_2 (width:int) : int = &(2 EXP num_of_int width) +`); + +PROOF thm c_max_unsigned_def = new_fun_definition(` + max_unsigned (width:int) : int = exp_2 width - &1 +`); + +PROOF thm c_max_signed_def = new_fun_definition(` + max_signed (width:int) : int = exp_2 (width - &1) - &1 +`); + +PROOF thm c_min_signed_def = new_fun_definition(` + min_signed (width:int) : int = --(exp_2 (width - &1)) +`); + +PROOF thm cast_unsigned_def = new_fun_definition(` + cast_unsigned (width:int) (value:int) : int = + value rem exp_2 width +`); + +PROOF thm cast_signed_def = new_fun_definition(` + cast_signed (width:int) (value:int) : int = + let unsigned_value = cast_unsigned width value in + if unsigned_value < exp_2 (width - &1) + then unsigned_value + else unsigned_value - exp_2 width +`); + +PROOF thm unsigned_last_nbits_def = new_fun_definition(` + unsigned_last_nbits (value:int) (width:int) : int = + cast_unsigned width value +`); + +PROOF thm signed_last_nbits_def = new_fun_definition(` + signed_last_nbits (value:int) (width:int) : int = + cast_signed width value +`); + +PROOF static thm prove_unsigned_last_nbits_id(void) { + gnode root = gnode_new_with_ccl(` + forall (value:int) (width:int). + &0 <= value && value < exp_2 width ==> + unsigned_last_nbits value width = value + `); + gnode reduced = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + unsigned_last_nbits_def, + cast_unsigned_def))); + gnode body = AUTO_INTROS_TAC(reduced); + thm identity = ispecl_rule( + TERM_LIST(`value:int`, `exp_2 (width:int)`), + get_theorem_by_name("INT_REM_LT")); + thm bounds = + assume_rule(`&0 <= value && value < exp_2 (width:int)`); + thm guarded_nonnegative = disch_rule( + `~(exp_2 (width:int) == &0)`, + conjunct1_rule(bounds)); + identity = mp_rule( + identity, + conj_rule(guarded_nonnegative, conjunct2_rule(bounds))); + ACCEPT_TAC(body, identity); + return gnode_prove(root); +} + +PROOF thm UNSIGNED_LAST_NBITS_ID = + prove_unsigned_last_nbits_id(); + +/* ------------------------------------------------------------------------- */ +/* Fixed-width bit operations */ +/* ------------------------------------------------------------------------- */ + +PROOF thm i32_and_def = new_fun_definition(` + i32_and (x:int) (y:int) : int = + ival (word_and ((iword x):(32)word) ((iword y):(32)word)) +`); +PROOF thm i32_or_def = new_fun_definition(` + i32_or (x:int) (y:int) : int = + ival (word_or ((iword x):(32)word) ((iword y):(32)word)) +`); +PROOF thm i32_xor_def = new_fun_definition(` + i32_xor (x:int) (y:int) : int = + ival (word_xor ((iword x):(32)word) ((iword y):(32)word)) +`); +PROOF thm i32_not_def = new_fun_definition(` + i32_not (x:int) : int = ival (word_not ((iword x):(32)word)) +`); +PROOF thm i32_shl_def = new_fun_definition(` + i32_shl (x:int) (y:int) : int = + ival (word_shl ((iword x):(32)word) (num_of_int y)) +`); +PROOF thm i32_shr_def = new_fun_definition(` + i32_shr (x:int) (y:int) : int = + ival (word_ishr ((iword x):(32)word) (num_of_int y)) +`); + +PROOF thm u32_and_def = new_fun_definition(` + u32_and (x:int) (y:int) : int = + &(val (word_and ((iword x):(32)word) ((iword y):(32)word))) +`); +PROOF thm u32_or_def = new_fun_definition(` + u32_or (x:int) (y:int) : int = + &(val (word_or ((iword x):(32)word) ((iword y):(32)word))) +`); +PROOF thm u32_xor_def = new_fun_definition(` + u32_xor (x:int) (y:int) : int = + &(val (word_xor ((iword x):(32)word) ((iword y):(32)word))) +`); +PROOF thm u32_not_def = new_fun_definition(` + u32_not (x:int) : int = &(val (word_not ((iword x):(32)word))) +`); +PROOF thm u32_shl_def = new_fun_definition(` + u32_shl (x:int) (y:int) : int = + &(val (word_shl ((iword x):(32)word) (num_of_int y))) +`); +PROOF thm u32_shr_def = new_fun_definition(` + u32_shr (x:int) (y:int) : int = + &(val (word_ushr ((iword x):(32)word) (num_of_int y))) +`); + +PROOF thm i64_and_def = new_fun_definition(` + i64_and (x:int) (y:int) : int = + ival (word_and ((iword x):(64)word) ((iword y):(64)word)) +`); +PROOF thm i64_or_def = new_fun_definition(` + i64_or (x:int) (y:int) : int = + ival (word_or ((iword x):(64)word) ((iword y):(64)word)) +`); +PROOF thm i64_xor_def = new_fun_definition(` + i64_xor (x:int) (y:int) : int = + ival (word_xor ((iword x):(64)word) ((iword y):(64)word)) +`); +PROOF thm i64_not_def = new_fun_definition(` + i64_not (x:int) : int = ival (word_not ((iword x):(64)word)) +`); +PROOF thm i64_shl_def = new_fun_definition(` + i64_shl (x:int) (y:int) : int = + ival (word_shl ((iword x):(64)word) (num_of_int y)) +`); +PROOF thm i64_shr_def = new_fun_definition(` + i64_shr (x:int) (y:int) : int = + ival (word_ishr ((iword x):(64)word) (num_of_int y)) +`); + +PROOF thm u64_and_def = new_fun_definition(` + u64_and (x:int) (y:int) : int = + &(val (word_and ((iword x):(64)word) ((iword y):(64)word))) +`); +PROOF thm u64_or_def = new_fun_definition(` + u64_or (x:int) (y:int) : int = + &(val (word_or ((iword x):(64)word) ((iword y):(64)word))) +`); +PROOF thm u64_xor_def = new_fun_definition(` + u64_xor (x:int) (y:int) : int = + &(val (word_xor ((iword x):(64)word) ((iword y):(64)word))) +`); +PROOF thm u64_not_def = new_fun_definition(` + u64_not (x:int) : int = &(val (word_not ((iword x):(64)word))) +`); +PROOF thm u64_shl_def = new_fun_definition(` + u64_shl (x:int) (y:int) : int = + &(val (word_shl ((iword x):(64)word) (num_of_int y))) +`); +PROOF thm u64_shr_def = new_fun_definition(` + u64_shr (x:int) (y:int) : int = + &(val (word_ushr ((iword x):(64)word) (num_of_int y))) +`); + +/* ------------------------------------------------------------------------- */ +/* Searchable theorem database */ +/* ------------------------------------------------------------------------- */ + +PROOF static int c_integer_register_theorems(void) { +#define REGISTER_THEOREM(name, theorem) \ + ENSURE_COND(add_theorem((name), (theorem)), \ + "duplicate C-integer theorem name: " name) + + thm exp_2_api = gen_rule(`width:int`, c_exp_2_def); + REGISTER_THEOREM("INT_EXP_2_DEF", exp_2_api); + REGISTER_THEOREM("max_unsigned_def", c_max_unsigned_def); + REGISTER_THEOREM("max_signed_def", c_max_signed_def); + REGISTER_THEOREM("min_signed_def", c_min_signed_def); + REGISTER_THEOREM("cast_unsigned_def", cast_unsigned_def); + REGISTER_THEOREM("cast_signed_def", cast_signed_def); + REGISTER_THEOREM("unsigned_last_nbits_def", unsigned_last_nbits_def); + REGISTER_THEOREM("signed_last_nbits_def", signed_last_nbits_def); + REGISTER_THEOREM("unsigned_last_nbits_id", UNSIGNED_LAST_NBITS_ID); + + REGISTER_THEOREM("i32_and_def", i32_and_def); + REGISTER_THEOREM("i32_or_def", i32_or_def); + REGISTER_THEOREM("i32_xor_def", i32_xor_def); + REGISTER_THEOREM("i32_not_def", i32_not_def); + REGISTER_THEOREM("i32_shl_def", i32_shl_def); + REGISTER_THEOREM("i32_shr_def", i32_shr_def); + REGISTER_THEOREM("u32_and_def", u32_and_def); + REGISTER_THEOREM("u32_or_def", u32_or_def); + REGISTER_THEOREM("u32_xor_def", u32_xor_def); + REGISTER_THEOREM("u32_not_def", u32_not_def); + REGISTER_THEOREM("u32_shl_def", u32_shl_def); + REGISTER_THEOREM("u32_shr_def", u32_shr_def); + REGISTER_THEOREM("i64_and_def", i64_and_def); + REGISTER_THEOREM("i64_or_def", i64_or_def); + REGISTER_THEOREM("i64_xor_def", i64_xor_def); + REGISTER_THEOREM("i64_not_def", i64_not_def); + REGISTER_THEOREM("i64_shl_def", i64_shl_def); + REGISTER_THEOREM("i64_shr_def", i64_shr_def); + REGISTER_THEOREM("u64_and_def", u64_and_def); + REGISTER_THEOREM("u64_or_def", u64_or_def); + REGISTER_THEOREM("u64_xor_def", u64_xor_def); + REGISTER_THEOREM("u64_not_def", u64_not_def); + REGISTER_THEOREM("u64_shl_def", u64_shl_def); + REGISTER_THEOREM("u64_shr_def", u64_shr_def); + +#undef REGISTER_THEOREM + return 0; +err: + ERR_FUN_PUTS("c_integer_register_theorems"); + return -1; +} + +PROOF static int _C_INTEGER_THEOREMS_REGISTERED = + c_integer_register_theorems(); + +PROOF static int c_integer_check_axiom_free(void) { + thm_list final_axioms = get_all_axioms(); + ENSURE_COND(vector_size(final_axioms) == C_INTEGER_AXIOMS_BEFORE, + "c_integer introduced a new axiom"); + return 0; +err: + ERR_FUN_PUTS("c_integer_check_axiom_free"); + return -1; +} + +PROOF static int _C_INTEGER_AXIOM_CHECK = + c_integer_check_axiom_free(); diff --git a/theory/c_program_logic/c_integer.h b/theory/c_program_logic/c_integer.h new file mode 100644 index 0000000..156341d --- /dev/null +++ b/theory/c_program_logic/c_integer.h @@ -0,0 +1,71 @@ +/** + * @file c_integer.h + * @brief Width-generic C integer conversions and fixed-width operations. + * + * This theory is independent of C object layout and physical memory. It + * exposes the integer operations emitted by the C* frontend over HOL `int`. + */ + +#pragma once + +#include "proof/proof_kernel.h" + +/* ------------------------------------------------------------------------- */ +/* Width-generic C integer conversion */ +/* ------------------------------------------------------------------------- */ + +/** `exp_2 n = &(2 EXP num_of_int n)`. */ +PROOF extern thm c_exp_2_def; +/** `max_unsigned n = exp_2 n - 1`. */ +PROOF extern thm c_max_unsigned_def; +/** `max_signed n = exp_2 (n - 1) - 1`. */ +PROOF extern thm c_max_signed_def; +/** `min_signed n = -exp_2 (n - 1)`. */ +PROOF extern thm c_min_signed_def; +/** `cast_unsigned n z = z rem exp_2 n`. */ +PROOF extern thm cast_unsigned_def; +/** Width-generic two's-complement signed conversion. */ +PROOF extern thm cast_signed_def; +/** `unsigned_last_nbits x n = cast_unsigned n x`. */ +PROOF extern thm unsigned_last_nbits_def; +/** `signed_last_nbits x n = cast_signed n x`. */ +PROOF extern thm signed_last_nbits_def; + +/** + * Conversion identity in the unsigned range: + * + * ```text + * |- forall x n. 0 <= x /\ x < exp_2 n ==> + * unsigned_last_nbits x n = x + * ``` + */ +PROOF extern thm UNSIGNED_LAST_NBITS_ID; + +/* ------------------------------------------------------------------------- */ +/* Fixed-width bit operations */ +/* ------------------------------------------------------------------------- */ + +PROOF extern thm i32_and_def; +PROOF extern thm i32_or_def; +PROOF extern thm i32_xor_def; +PROOF extern thm i32_not_def; +PROOF extern thm i32_shl_def; +PROOF extern thm i32_shr_def; +PROOF extern thm u32_and_def; +PROOF extern thm u32_or_def; +PROOF extern thm u32_xor_def; +PROOF extern thm u32_not_def; +PROOF extern thm u32_shl_def; +PROOF extern thm u32_shr_def; +PROOF extern thm i64_and_def; +PROOF extern thm i64_or_def; +PROOF extern thm i64_xor_def; +PROOF extern thm i64_not_def; +PROOF extern thm i64_shl_def; +PROOF extern thm i64_shr_def; +PROOF extern thm u64_and_def; +PROOF extern thm u64_or_def; +PROOF extern thm u64_xor_def; +PROOF extern thm u64_not_def; +PROOF extern thm u64_shl_def; +PROOF extern thm u64_shr_def; diff --git a/theory/c_program_logic/c_memory.c b/theory/c_program_logic/c_memory.c new file mode 100644 index 0000000..d25498b --- /dev/null +++ b/theory/c_program_logic/c_memory.c @@ -0,0 +1,725 @@ +#include "proof/theory/c_program_logic/c_memory.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/c_program_logic/c_types.c" +#require "proof/theory/c_program_logic/c_resource.c" +#require "proof/theory/c_program_logic/mem_value.c" + +PROOF static thm_list C_MEMORY_INITIAL_AXIOMS = get_all_axioms(); +PROOF static size_t C_MEMORY_AXIOMS_BEFORE = + vector_size(C_MEMORY_INITIAL_AXIOMS); + +PROOF thm pmem_ctype_distinct = get_datatype_distinctness("ctype"); + +/* ------------------------------------------------------------------------- */ +/* Scalar ABI descriptor */ +/* ------------------------------------------------------------------------- */ + +PROOF thm pmem_c_scalar_type_def = new_fun_definition(` + pmem_c_scalar_type (ty:ctype) <=> + ty == Tchar || ty == Tuchar || + ty == Tshort || ty == Tushort || + ty == Tint || ty == Tuint || + ty == Tint64 || ty == Tuint64 || + ty == Tptr +`); + +PROOF thm pmem_c_width_def = new_fun_definition(` + pmem_c_width (ty:ctype) : num = + if ty == Tchar then 1 else + if ty == Tuchar then 1 else + if ty == Tshort then 2 else + if ty == Tushort then 2 else + if ty == Tint then 4 else + if ty == Tuint then 4 else + if ty == Tint64 then 8 else + if ty == Tuint64 then 8 else + if ty == Tptr then 8 else + 0 +`); + +PROOF thm pmem_c_min_def = new_fun_definition(` + pmem_c_min (ty:ctype) : int = + if ty == Tchar then --(&128) else + if ty == Tuchar then &0 else + if ty == Tshort then --(&32768) else + if ty == Tushort then &0 else + if ty == Tint then --(&2147483648) else + if ty == Tuint then &0 else + if ty == Tint64 then --(&9223372036854775808) else + if ty == Tuint64 then &0 else + if ty == Tptr then &0 else + &0 +`); + +PROOF thm pmem_c_max_def = new_fun_definition(` + pmem_c_max (ty:ctype) : int = + if ty == Tchar then &127 else + if ty == Tuchar then &255 else + if ty == Tshort then &32767 else + if ty == Tushort then &65535 else + if ty == Tint then &2147483647 else + if ty == Tuint then &4294967295 else + if ty == Tint64 then &9223372036854775807 else + if ty == Tuint64 then &18446744073709551615 else + if ty == Tptr then &18446744073709551615 else + &0 +`); + +PROOF thm pmem_c_address_ok_def = new_fun_definition(` + pmem_c_address_ok (address:int) (ty:ctype) <=> + pmem_c_scalar_type ty && + &0 <= address && + address + &(pmem_c_width ty) - &1 <= + &18446744073709551615 && + address rem &(pmem_c_width ty) == &0 +`); + +PROOF thm pmem_uint64_address_ok_def = new_fun_definition(` + pmem_uint64_address_ok (address:int) <=> + pmem_c_address_ok address Tuint64 +`); + +PROOF thm pmem_ptr_address_ok_def = new_fun_definition(` + pmem_ptr_address_ok (address:int) <=> + pmem_c_address_ok address Tptr +`); + +PROOF thm pmem_c_value_ok_def = new_fun_definition(` + pmem_c_value_ok (ty:ctype) (integer_value:int) <=> + pmem_c_scalar_type ty && + pmem_c_min ty <= integer_value && + integer_value <= pmem_c_max ty +`); + +PROOF static thm prove_pmem_c_address_ok_tuint64(void) { + gnode root = gnode_new_with_ccl(` + forall address:int. + pmem_c_address_ok address Tuint64 <=> + &0 <= address && + address + &7 <= &18446744073709551615 && + address rem &8 == &0 + `); + thm range_normalization = int_ring_rule(` + forall address:int. + address + &8 - &1 == address + &7 + `); + CONV_TAC(root, rewrite_conv(THM_LIST( + pmem_c_address_ok_def, + pmem_c_scalar_type_def, + pmem_c_width_def, + pmem_ctype_distinct, + range_normalization))); + return gnode_prove(root); +} + +PROOF thm PMEM_C_ADDRESS_OK_TUINT64 = + prove_pmem_c_address_ok_tuint64(); + +/* ------------------------------------------------------------------------- */ +/* Pure physical-memory atoms */ +/* ------------------------------------------------------------------------- */ + +PROOF thm pmem_data_at_def = new_fun_definition(` + pmem_data_at + (address:int) + (ty:ctype) + (integer_value:int) : + (int,(pmem_byte_state)excl)finmap->bool = + r_and + mem_ra + (r_pure + mem_ra + (pmem_c_address_ok address ty && + pmem_c_value_ok ty integer_value)) + (pmem_scalar_at address (pmem_c_width ty) integer_value) +`); + +PROOF thm pmem_undef_data_at_def = new_fun_definition(` + pmem_undef_data_at + (address:int) + (ty:ctype) : + (int,(pmem_byte_state)excl)finmap->bool = + r_and + mem_ra + (r_pure mem_ra (pmem_c_address_ok address ty)) + (pmem_allocated_at address (pmem_c_width ty)) +`); + +PROOF thm c_allocated_at_def = new_fun_definition(` + c_allocated_at + (G:(A)ra) + (address:int) + (count:num) : + (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool = + c_lift_phys G (pmem_allocated_at address count) +`); + +PROOF static thm prove_c_allocated_at_zero(void) { + gnode root = gnode_new_with_ccl(` + forall (G:(A)ra) (address:int). + c_allocated_at G address 0 == + r_emp (c_resource_ra G) + `); + CONV_TAC(root, rewrite_conv(THM_LIST( + c_allocated_at_def, + PMEM_ALLOCATED_AT_ZERO, + C_LIFT_PHYS_EMP))); + return gnode_prove(root); +} + +PROOF thm C_ALLOCATED_AT_ZERO = + prove_c_allocated_at_zero(); + +PROOF static thm prove_c_allocated_at_append(void) { + gnode root = gnode_new_with_ccl(` + forall (G:(A)ra) (address:int) (m:num) (n:num). + c_allocated_at G address (m + n) == + r_sep + (c_resource_ra G) + (c_allocated_at G address m) + (c_allocated_at G (address + &m) n) + `); + CONV_TAC(root, rewrite_conv(THM_LIST( + c_allocated_at_def, + PMEM_ALLOCATED_AT_APPEND, + C_LIFT_PHYS_SEP))); + return gnode_prove(root); +} + +PROOF thm C_ALLOCATED_AT_APPEND = + prove_c_allocated_at_append(); + +PROOF static thm prove_pmem_data_at_allocated_at(void) { + gnode root = gnode_new_with_ccl(` + forall (address:int) (ty:ctype) (integer_value:int). + r_entails + mem_ra + (pmem_data_at address ty integer_value) + (pmem_allocated_at address (pmem_c_width ty)) + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + pmem_data_at_def, + r_and_def, + r_pure_def))); + body = GEN_TAC(body, "address"); + body = GEN_TAC(body, "ty"); + body = GEN_TAC(body, "integer_value"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid"); + body = DISCH_TAC(body, "Hdata"); + body = ASMP_CONJ_TAC(body, "Hdata", "Hpure", "Hscalar"); + + thm allocated = ispecl_rule( + TERM_LIST( + `address:int`, + `pmem_c_width (ty:ctype)`, + `integer_value:int`), + PMEM_SCALAR_AT_ALLOCATED); + allocated = pure_once_rewrite_rule( + THM_LIST(r_entails_def), allocated); + allocated = spec_rule(` + resource:(int,(pmem_byte_state)excl)finmap + `, allocated); + allocated = mp_rule( + allocated, + assume_rule(` + ra_valid mem_ra + (resource:(int,(pmem_byte_state)excl)finmap) + `)); + allocated = mp_rule( + allocated, + assume_rule(` + pmem_scalar_at + (address:int) + (pmem_c_width (ty:ctype)) + (integer_value:int) + (resource:(int,(pmem_byte_state)excl)finmap) + `)); + ACCEPT_TAC(body, allocated); + return gnode_prove(root); +} + +PROOF thm PMEM_DATA_AT_ALLOCATED_AT = + prove_pmem_data_at_allocated_at(); + +PROOF static thm prove_pmem_undef_data_at_allocated_at(void) { + term target = `pmem_allocated_at + (address:int) (pmem_c_width (ty:ctype))`; + thm eliminate_wrapper = ispecl_rule( + TERM_LIST( + `mem_ra`, + `r_pure mem_ra (pmem_c_address_ok (address:int) (ty:ctype))`, + target), + R_AND_ELIM_R); + eliminate_wrapper = pure_once_rewrite_rule( + THM_LIST(gsym_rule(pmem_undef_data_at_def)), + eliminate_wrapper); + return genl_rule( + TERM_LIST(`address:int`, `ty:ctype`), eliminate_wrapper); +} + +PROOF thm PMEM_UNDEF_DATA_AT_ALLOCATED_AT = + prove_pmem_undef_data_at_allocated_at(); + +PROOF static thm prove_pmem_allocated_at_to_undef_data_at(void) { + gnode root = gnode_new_with_ccl(` + forall (address:int) (ty:ctype). + pmem_c_address_ok address ty ==> + r_entails + mem_ra + (pmem_allocated_at address (pmem_c_width ty)) + (pmem_undef_data_at address ty) + `); + gnode body = AUTO_INTROS_TAC(root); + term allocated = `pmem_allocated_at + (address:int) (pmem_c_width (ty:ctype))`; + thm reflexivity = ispecl_rule( + TERM_LIST(`mem_ra`, allocated), R_ENTAILS_REFL); + thm introduce = ispecl_rule( + TERM_LIST( + `mem_ra`, + `pmem_c_address_ok (address:int) (ty:ctype)`, + allocated, + allocated), + R_PURE_AND_INTRO); + thm with_address = match_mp_rule( + introduce, + assume_rule(`pmem_c_address_ok (address:int) (ty:ctype)`)); + thm result = match_mp_rule(with_address, reflexivity); + result = pure_once_rewrite_rule( + THM_LIST(gsym_rule(pmem_undef_data_at_def)), result); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm PMEM_ALLOCATED_AT_TO_UNDEF_DATA_AT = + prove_pmem_allocated_at_to_undef_data_at(); + +PROOF static thm prove_pmem_data_at_to_undef_data_at(void) { + gnode root = gnode_new_with_ccl(` + forall (address:int) (ty:ctype) (integer_value:int). + r_entails + mem_ra + (pmem_data_at address ty integer_value) + (pmem_undef_data_at address ty) + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + pmem_data_at_def, + pmem_undef_data_at_def, + r_and_def, + r_pure_def))); + body = GEN_TAC(body, "address"); + body = GEN_TAC(body, "ty"); + body = GEN_TAC(body, "integer_value"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid"); + body = DISCH_TAC(body, "Hdata"); + body = ASMP_CONJ_TAC(body, "Hdata", "Hpure", "Hscalar"); + body = ASMP_CONJ_TAC( + body, "Hpure", "Haddress_ok", "Hvalue_ok"); + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC( + result[0], + assume_rule(`pmem_c_address_ok (address:int) (ty:ctype)`)); + + thm allocated = ispecl_rule( + TERM_LIST( + `address:int`, + `pmem_c_width (ty:ctype)`, + `integer_value:int`), + PMEM_SCALAR_AT_ALLOCATED); + allocated = pure_once_rewrite_rule( + THM_LIST(r_entails_def), allocated); + allocated = spec_rule(` + resource:(int,(pmem_byte_state)excl)finmap + `, allocated); + allocated = mp_rule( + allocated, + assume_rule(` + ra_valid mem_ra + (resource:(int,(pmem_byte_state)excl)finmap) + `)); + allocated = mp_rule( + allocated, + assume_rule(` + pmem_scalar_at + (address:int) + (pmem_c_width (ty:ctype)) + (integer_value:int) + (resource:(int,(pmem_byte_state)excl)finmap) + `)); + ACCEPT_TAC(result[1], allocated); + return gnode_prove(root); +} + +PROOF thm PMEM_DATA_AT_TO_UNDEF_DATA_AT = + prove_pmem_data_at_to_undef_data_at(); + +PROOF static thm prove_pmem_undef_scalar_at_tuint64(void) { + gnode root = gnode_new_with_ccl(` + forall address:int. + pmem_c_address_ok address Tuint64 ==> + r_entails + mem_ra + (pmem_undef_scalar_at address 8) + (pmem_undef_data_at address Tuint64) + `); + gnode body = GEN_TAC(root, "address"); + body = DISCH_TAC(body, "Haddress_ok"); + + term source = `pmem_undef_scalar_at (address:int) 8`; + term allocated = `pmem_allocated_at (address:int) 8`; + term address_ok = `pmem_c_address_ok (address:int) Tuint64`; + thm strict_to_allocated = ispecl_rule( + TERM_LIST(`8:num`, `address:int`), + PMEM_UNDEF_SCALAR_AT_ALLOCATED); + thm introduce_pure = ispecl_rule( + TERM_LIST(`mem_ra`, address_ok, source, allocated), + R_PURE_AND_INTRO); + thm with_address = match_mp_rule( + introduce_pure, + assume_rule(address_ok)); + thm untyped_to_conjunction = match_mp_rule( + with_address, + strict_to_allocated); + + thm typed_definition = inst_rule( + TERM_PAIR_LIST( + (term_pair){`Tuint64:ctype`, `ty:ctype`}), + pmem_undef_data_at_def); + typed_definition = rewrite_rule( + THM_LIST(pmem_c_width_def, pmem_ctype_distinct), + typed_definition); + thm typed = pure_once_rewrite_rule( + THM_LIST(gsym_rule(typed_definition)), + untyped_to_conjunction); + ACCEPT_TAC(body, typed); + return gnode_prove(root); +} + +PROOF thm PMEM_UNDEF_SCALAR_AT_TUINT64 = + prove_pmem_undef_scalar_at_tuint64(); + +/* ------------------------------------------------------------------------- */ +/* Complete C-resource atoms */ +/* ------------------------------------------------------------------------- */ + +PROOF thm c_data_at_def = new_fun_definition(` + c_data_at + (G:(A)ra) + (address:int) + (ty:ctype) + (integer_value:int) : + (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool = + c_lift_phys G (pmem_data_at address ty integer_value) +`); + +PROOF thm c_undef_data_at_def = new_fun_definition(` + c_undef_data_at + (G:(A)ra) + (address:int) + (ty:ctype) : + (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool = + c_lift_phys G (pmem_undef_data_at address ty) +`); + +PROOF static thm prove_c_allocated_at_to_undef_data_at(void) { + gnode root = gnode_new_with_ccl(` + forall (G:(A)ra) (address:int) (ty:ctype). + pmem_c_address_ok address ty ==> + r_entails + (c_resource_ra G) + (c_allocated_at G address (pmem_c_width ty)) + (c_undef_data_at G address ty) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC(body, pure_rewrite_conv(THM_LIST( + c_allocated_at_def, + c_undef_data_at_def))); + thm lift = ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `pmem_allocated_at + (address:int) (pmem_c_width (ty:ctype))`, + `pmem_undef_data_at (address:int) (ty:ctype)`), + C_LIFT_PHYS_ENTAILS); + thm physical = ispecl_rule( + TERM_LIST(`address:int`, `ty:ctype`), + PMEM_ALLOCATED_AT_TO_UNDEF_DATA_AT); + physical = match_mp_rule( + physical, + assume_rule(`pmem_c_address_ok (address:int) (ty:ctype)`)); + ACCEPT_TAC(body, match_mp_rule(lift, physical)); + return gnode_prove(root); +} + +PROOF thm C_ALLOCATED_AT_TO_UNDEF_DATA_AT = + prove_c_allocated_at_to_undef_data_at(); + +PROOF static thm prove_c_data_at_to_undef_data_at(void) { + gnode root = gnode_new_with_ccl(` + forall + (G:(A)ra) + (address:int) + (ty:ctype) + (integer_value:int). + r_entails + (c_resource_ra G) + (c_data_at G address ty integer_value) + (c_undef_data_at G address ty) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC(body, pure_rewrite_conv(THM_LIST( + c_data_at_def, + c_undef_data_at_def))); + thm lift = ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `pmem_data_at + (address:int) (ty:ctype) (integer_value:int)`, + `pmem_undef_data_at (address:int) (ty:ctype)`), + C_LIFT_PHYS_ENTAILS); + thm physical = ispecl_rule( + TERM_LIST(`address:int`, `ty:ctype`, `integer_value:int`), + PMEM_DATA_AT_TO_UNDEF_DATA_AT); + ACCEPT_TAC(body, match_mp_rule(lift, physical)); + return gnode_prove(root); +} + +PROOF thm C_DATA_AT_TO_UNDEF_DATA_AT = + prove_c_data_at_to_undef_data_at(); + +PROOF static thm prove_c_data_at_allocated_at(void) { + gnode root = gnode_new_with_ccl(` + forall + (G:(A)ra) + (address:int) + (ty:ctype) + (integer_value:int). + r_entails + (c_resource_ra G) + (c_data_at G address ty integer_value) + (c_allocated_at G address (pmem_c_width ty)) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC(body, pure_rewrite_conv(THM_LIST( + c_data_at_def, + c_allocated_at_def))); + thm lift = ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `pmem_data_at + (address:int) (ty:ctype) (integer_value:int)`, + `pmem_allocated_at + (address:int) (pmem_c_width (ty:ctype))`), + C_LIFT_PHYS_ENTAILS); + thm physical = ispecl_rule( + TERM_LIST(`address:int`, `ty:ctype`, `integer_value:int`), + PMEM_DATA_AT_ALLOCATED_AT); + ACCEPT_TAC(body, match_mp_rule(lift, physical)); + return gnode_prove(root); +} + +PROOF thm C_DATA_AT_ALLOCATED_AT = + prove_c_data_at_allocated_at(); + +PROOF static thm prove_c_undef_data_at_allocated_at(void) { + gnode root = gnode_new_with_ccl(` + forall (G:(A)ra) (address:int) (ty:ctype). + r_entails + (c_resource_ra G) + (c_undef_data_at G address ty) + (c_allocated_at G address (pmem_c_width ty)) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC(body, pure_rewrite_conv(THM_LIST( + c_undef_data_at_def, + c_allocated_at_def))); + thm lift = ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `pmem_undef_data_at (address:int) (ty:ctype)`, + `pmem_allocated_at + (address:int) (pmem_c_width (ty:ctype))`), + C_LIFT_PHYS_ENTAILS); + thm physical = ispecl_rule( + TERM_LIST(`address:int`, `ty:ctype`), + PMEM_UNDEF_DATA_AT_ALLOCATED_AT); + ACCEPT_TAC(body, match_mp_rule(lift, physical)); + return gnode_prove(root); +} + +PROOF thm C_UNDEF_DATA_AT_ALLOCATED_AT = + prove_c_undef_data_at_allocated_at(); + +PROOF static thm prove_c_data_at_pure_range(void) { + term goal_tm = ` + forall + (G:(A)ra) + (address:int) + (ty:ctype) + (integer_value:int). + r_entails + (c_resource_ra G) + (c_data_at G address ty integer_value) + (r_pure + (c_resource_ra G) + (pmem_c_min ty <= integer_value && + integer_value <= pmem_c_max ty)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + c_data_at_def, + c_lift_phys_def, + pmem_data_at_def, + r_and_def, + r_pure_def, + pmem_c_value_ok_def))); + body = GEN_TAC(body, "G"); + body = GEN_TAC(body, "address"); + body = GEN_TAC(body, "ty"); + body = GEN_TAC(body, "integer_value"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid"); + body = DISCH_TAC(body, "Hdata"); + body = ASMP_CONJ_TAC(body, "Hdata", "Hphysical", "Hghost_unit"); + body = ASMP_CONJ_TAC(body, "Hphysical", "Hpure", "Hscalar"); + body = ASMP_CONJ_TAC(body, "Hpure", "Haddress_ok", "Hvalue_ok"); + body = ASMP_CONJ_TAC(body, "Hvalue_ok", "Hscalar_type", "Hbounds"); + ACCEPT_TAC( + body, + assume_rule(` + pmem_c_min (ty:ctype) <= (integer_value:int) && + integer_value <= pmem_c_max ty + `)); + return gnode_prove(root); +} + +PROOF static thm C_DATA_AT_PURE_RANGE = + prove_c_data_at_pure_range(); + +PROOF static thm prove_c_data_at_value_range(void) { + term goal_tm = ` + forall + (G:(A)ra) + (address:int) + (ty:ctype) + (integer_value:int). + r_entails + (c_resource_ra G) + (c_data_at G address ty integer_value) + (r_sep + (c_resource_ra G) + (c_data_at G address ty integer_value) + (r_fact + (c_resource_ra G) + (pmem_c_min ty <= integer_value && + integer_value <= pmem_c_max ty))) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + term R = `c_resource_ra (G:(A)ra)`; + term source = `c_data_at + (G:(A)ra) (address:int) (ty:ctype) (integer_value:int)`; + term bounds = `pmem_c_min (ty:ctype) <= (integer_value:int) && + integer_value <= pmem_c_max ty`; + term pure_bounds = `r_pure + (c_resource_ra (G:(A)ra)) + (pmem_c_min (ty:ctype) <= (integer_value:int) && + integer_value <= pmem_c_max ty)`; + + thm range_rule = ispecl_rule( + TERM_LIST( + `G:(A)ra`, `address:int`, `ty:ctype`, `integer_value:int`), + C_DATA_AT_PURE_RANGE); + thm reflexivity = ispecl_rule(TERM_LIST(R, source), R_ENTAILS_REFL); + thm combined = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST(R, source, pure_bounds, source), + R_AND_INTRO), + range_rule), + reflexivity); + + thm fact_sep = ispecl_rule( + TERM_LIST(R, bounds, source), + R_FACT_SEP_R); + thm replace_target = beta_rule(ap_term_rule( + `\target:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool. + r_entails + (c_resource_ra (G:(A)ra)) + (c_data_at G (address:int) (ty:ctype) (integer_value:int)) + target`, + gsym_rule(fact_sep))); + ACCEPT_TAC(body, eq_mp_rule(replace_target, combined)); + return gnode_prove(root); +} + +PROOF thm C_DATA_AT_VALUE_RANGE = + prove_c_data_at_value_range(); + +/* ------------------------------------------------------------------------- */ +/* Conservative-extension audit */ +/* ------------------------------------------------------------------------- */ + +PROOF static int audit_c_memory(void) { + thm_list public_theorems = THM_LIST( + pmem_ctype_distinct, + pmem_c_scalar_type_def, + pmem_c_width_def, + pmem_c_min_def, + pmem_c_max_def, + pmem_c_address_ok_def, + pmem_uint64_address_ok_def, + pmem_ptr_address_ok_def, + pmem_c_value_ok_def, + PMEM_C_ADDRESS_OK_TUINT64, + pmem_data_at_def, + pmem_undef_data_at_def, + c_allocated_at_def, + C_ALLOCATED_AT_ZERO, + C_ALLOCATED_AT_APPEND, + PMEM_DATA_AT_ALLOCATED_AT, + PMEM_UNDEF_DATA_AT_ALLOCATED_AT, + PMEM_ALLOCATED_AT_TO_UNDEF_DATA_AT, + PMEM_DATA_AT_TO_UNDEF_DATA_AT, + PMEM_UNDEF_SCALAR_AT_TUINT64, + c_data_at_def, + c_undef_data_at_def, + C_ALLOCATED_AT_TO_UNDEF_DATA_AT, + C_DATA_AT_TO_UNDEF_DATA_AT, + C_DATA_AT_ALLOCATED_AT, + C_UNDEF_DATA_AT_ALLOCATED_AT, + C_DATA_AT_VALUE_RANGE); + + for (size_t i = 0; i < vector_size(public_theorems); ++i) { + ENSURE_COND(!IS_NULL(public_theorems[i]), + "C memory theorem %zu is empty", i); + term_list theorem_hypotheses = hyp(public_theorems[i]); + size_t hypothesis_count = vector_size(theorem_hypotheses); + ENSURE_COND(hypothesis_count == 0, + "C memory theorem %zu has hypotheses", i); + } + thm_list final_axioms = get_all_axioms(); + size_t final_axiom_count = vector_size(final_axioms); + ENSURE_COND(final_axiom_count == C_MEMORY_AXIOMS_BEFORE, + "C memory theory introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_c_memory"); + return -1; +} + +PROOF static int _C_MEMORY_AUDIT = audit_c_memory(); diff --git a/theory/c_program_logic/c_memory.h b/theory/c_program_logic/c_memory.h new file mode 100644 index 0000000..bd63cbb --- /dev/null +++ b/theory/c_program_logic/c_memory.h @@ -0,0 +1,285 @@ +/** + * @file c_memory.h + * @brief Scalar C-memory assertions over the byte-addressed physical resource. + * + * This module is the only layer here that interprets the existing C* `ctype` + * ABI. It supports exactly the nine scalar constructors + * + * Tchar, Tuchar, Tshort, Tushort, Tint, Tuint, + * Tint64, Tuint64, Tptr. + * + * `Tstruct` is not a scalar type. The width/min/max functions are total and + * return zero on unsupported types, but every public memory predicate carries + * an explicit scalar guard, so that fallback has no storage semantics. + * + * The ABI is provisional and self-contained: 8-bit bytes, little-endian + * scalar representations, 16/32/64-bit integer widths, 64-bit pointers, and a + * 64-bit concrete address space. This theory does not use the legacy + * `sizeof`, `min_of`, `max_of`, or `isvalidptr_*` constants. + * + * `pmem_*` assertions have type `Mem -> bool`; `c_*` assertions are their + * exact lifts to `Prop_G = (Mem # Ghost_G) -> bool`. In formulas below, + * `P ⊢_mem Q` abbreviates `r_entails mem_ra P Q`, while `P ⊢_G Q` + * abbreviates `r_entails (c_resource_ra G) P Q`. + */ + +#pragma once + +#include "proof/theory/c_program_logic/c_types.h" +#include "proof/theory/c_program_logic/c_resource.h" +#include "proof/theory/c_program_logic/mem_value.h" + +/* ------------------------------------------------------------------------- */ +/* Scalar ABI descriptor */ +/* ------------------------------------------------------------------------- */ + +/* + * Constructor distinctness for the built-in `ctype` datatype. This theorem + * is obtained from HOL Light's datatype package (not postulated): + * + * Ti <> Tj for every pair of distinct `ctype` constructors Ti,Tj. + * + * It is deliberately a proof-side normalization rule. Clients specialize a + * memory theorem to a concrete `ctype`, rewrite with this theorem, and only + * then expose the resulting `ctype`-free assertion to QCP. + */ +PROOF extern thm pmem_ctype_distinct; + +/* + * Scalar-type discriminator: + * + * pmem_c_scalar_type ty ⇔ + * ty = Tchar ∨ ty = Tuchar ∨ + * ty = Tshort ∨ ty = Tushort ∨ + * ty = Tint ∨ ty = Tuint ∨ + * ty = Tint64 ∨ ty = Tuint64 ∨ + * ty = Tptr. + * + * In particular every `Tstruct name fields types` yields false. + */ +PROOF extern thm pmem_c_scalar_type_def; + +/* + * Total scalar width in bytes: + * + * Tchar/Tuchar -> 1 + * Tshort/Tushort -> 2 + * Tint/Tuint -> 4 + * Tint64/Tuint64/Tptr-> 8 + * unsupported type -> 0. + */ +PROOF extern thm pmem_c_width_def; + +/* + * Total minimum scalar value: + * + * Tchar -> -128 Tuchar -> 0 + * Tshort -> -32768 Tushort -> 0 + * Tint -> -2147483648 Tuint -> 0 + * Tint64 -> -9223372036854775808 Tuint64 -> 0 + * Tptr -> 0 fallback-> 0. + */ +PROOF extern thm pmem_c_min_def; + +/* + * Total maximum scalar value: + * + * Tchar -> 127 Tuchar -> 255 + * Tshort -> 32767 Tushort -> 65535 + * Tint -> 2147483647 Tuint -> 4294967295 + * Tint64 -> 9223372036854775807 + * Tuint64/Tptr -> 18446744073709551615 + * fallback -> 0. + */ +PROOF extern thm pmem_c_max_def; + +/* + * Address validity, with public atom argument order `(address,type)`: + * + * pmem_c_address_ok address ty ⇔ + * pmem_c_scalar_type ty ∧ + * &0 <= address ∧ + * address + &(pmem_c_width ty) - &1 <= + * &18446744073709551615 ∧ + * address rem &(pmem_c_width ty) = &0. + * + * Thus the complete byte interval is in the concrete 64-bit address space + * and the base is naturally aligned to the scalar width. + */ +PROOF extern thm pmem_c_address_ok_def; + +/** + * QCP-safe closed specialization + * `pmem_uint64_address_ok address ⇔ pmem_c_address_ok address Tuint64`. + * The unary predicate avoids placing a `ctype` term inside an ordinary QCP + * pure predicate. + */ +PROOF extern thm pmem_uint64_address_ok_def; + +/** QCP-safe pointer specialization of `pmem_c_address_ok`. */ +PROOF extern thm pmem_ptr_address_ok_def; + +/* + * Scalar value range: + * + * pmem_c_value_ok ty value ⇔ + * pmem_c_scalar_type ty ∧ + * pmem_c_min ty <= value ∧ value <= pmem_c_max ty. + */ +PROOF extern thm pmem_c_value_ok_def; + +/** + * Exact ABI characterization for a `Tuint64` lvalue address: + * + * ```text + * ⊢ ∀address:int. pmem_c_address_ok address Tuint64 ⇔ + * 0 ≤ address ∧ + * address + 7 ≤ 18446744073709551615 ∧ + * address rem 8 = 0. + * ``` + * + * In particular, ownership of eight consecutive bytes does not imply this + * theorem's alignment conjunct; callers carving a typed cell must establish + * it as a separate pure fact. + */ +PROOF extern thm PMEM_C_ADDRESS_OK_TUINT64; + +/* ------------------------------------------------------------------------- */ +/* Pure physical-memory atoms */ +/* ------------------------------------------------------------------------- */ + +/* + * Initialized scalar storage: + * + * pmem_data_at address ty value = + * r_and mem_ra + * (r_pure mem_ra + * (pmem_c_address_ok address ty ∧ + * pmem_c_value_ok ty value)) + * (pmem_scalar_at address (pmem_c_width ty) value). + * + * The second conjunct owns the exact little-endian bytes; the first imposes + * the C ABI side conditions without consuming a second resource. + */ +PROOF extern thm pmem_data_at_def; + +/* + * Owned scalar storage of unknown current contents at a valid C address: + * + * pmem_undef_data_at address ty = + * r_and mem_ra + * (r_pure mem_ra (pmem_c_address_ok address ty)) + * (pmem_allocated_at address (pmem_c_width ty)). + * + * Each byte may be physically uninitialized or initialized. The predicate + * grants writable ownership but no readable value; QCP therefore permits an + * overwriting store but not a load. `pmem_undef_scalar_at` remains available + * separately when strict physical uninitialization matters to a proof. + */ +PROOF extern thm pmem_undef_data_at_def; + +/** + * Exact physical lift of `count` arbitrary allocated bytes. This assertion + * carries no C type, value, initialization-state uniformity, alignment, or + * QCP load/store role: + * + * ```text + * ⊢ c_allocated_at G address count = + * c_lift_phys G (pmem_allocated_at address count). + * ``` + */ +PROOF extern thm c_allocated_at_def; + +/** Zero arbitrary allocated bytes are exactly the selected separating unit. */ +PROOF extern thm C_ALLOCATED_AT_ZERO; + +/** + * Adjacent arbitrary allocated byte ranges compose exactly: + * + * ```text + * ⊢ ∀G address m n. + * c_allocated_at G address (m + n) = + * c_allocated_at G address m **_G + * c_allocated_at G (address + &m) n. + * ``` + * + * This theorem only changes the spatial grouping of the same byte range. It + * neither adds C typing nor strengthens any byte's initialization state. + */ +PROOF extern thm C_ALLOCATED_AT_APPEND; + +/** Initialized typed storage entails its allocated byte range. */ +PROOF extern thm PMEM_DATA_AT_ALLOCATED_AT; + +/** Unknown-content typed storage entails its allocated byte range. */ +PROOF extern thm PMEM_UNDEF_DATA_AT_ALLOCATED_AT; + +/** + * A valid-address allocated range can be viewed as unknown-content typed + * storage: + * + * ```text + * ⊢ address_ok address ty ⇒ + * pmem_allocated_at address (width ty) ⊢_mem + * pmem_undef_data_at address ty. + * ``` + */ +PROOF extern thm PMEM_ALLOCATED_AT_TO_UNDEF_DATA_AT; + +/** Initialized typed storage may forget its value and initialization detail. */ +PROOF extern thm PMEM_DATA_AT_TO_UNDEF_DATA_AT; + +/** + * View eight strictly uninitialized bytes as unknown-content `Tuint64` + * cell, provided the independent ABI address obligation has been proved: + * + * ```text + * ⊢ ∀address. pmem_c_address_ok address Tuint64 ⇒ + * pmem_undef_scalar_at address 8 ⊢_mem + * pmem_undef_data_at address Tuint64. + * ``` + */ +PROOF extern thm PMEM_UNDEF_SCALAR_AT_TUINT64; + +/* +/* ------------------------------------------------------------------------- */ +/* Complete C-resource atoms */ +/* ------------------------------------------------------------------------- */ + +/* + * Exact physical lift with an empty ghost projection: + * + * c_data_at G address ty value = + * c_lift_phys G (pmem_data_at address ty value). + */ +PROOF extern thm c_data_at_def; + +/* + * Exact physical lift with an empty ghost projection: + * + * c_undef_data_at G address ty = + * c_lift_phys G (pmem_undef_data_at address ty). + */ +PROOF extern thm c_undef_data_at_def; + +/** Lifted allocated-to-unknown typed view, requiring C address validity. */ +PROOF extern thm C_ALLOCATED_AT_TO_UNDEF_DATA_AT; + +/** Lifted initialized storage entails the QCP unknown-content memory atom. */ +PROOF extern thm C_DATA_AT_TO_UNDEF_DATA_AT; + +/** Lifted initialized typed storage entails arbitrary allocated bytes. */ +PROOF extern thm C_DATA_AT_ALLOCATED_AT; + +/** Lifted unknown-content typed storage entails allocated bytes. */ +PROOF extern thm C_UNDEF_DATA_AT_ALLOCATED_AT; + +/* + * Initialized scalar ownership exposes its represented-value bounds while + * retaining the cell: + * + * c_data_at G address ty value ⊢_G + * c_data_at G address ty value * + * r_fact R_G (pmem_c_min ty <= value /\ value <= pmem_c_max ty). + */ +PROOF extern thm C_DATA_AT_VALUE_RANGE; diff --git a/theory/c_program_logic/c_resource.c b/theory/c_program_logic/c_resource.c new file mode 100644 index 0000000..f2dfa7b --- /dev/null +++ b/theory/c_program_logic/c_resource.c @@ -0,0 +1,603 @@ +#include "proof/theory/c_program_logic/c_resource.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/c_program_logic/mem_own.c" +#require "proof/theory/logic/ghost_heap.c" +#require "proof/theory/logic/prod_ra.c" +#require "proof/theory/logic/resource_prop.c" + +PROOF static thm_list C_RESOURCE_INITIAL_AXIOMS = get_all_axioms(); +PROOF static size_t C_RESOURCE_AXIOMS_BEFORE = + vector_size(C_RESOURCE_INITIAL_AXIOMS); + +/* ------------------------------------------------------------------------- */ +/* Combined C resource algebra */ +/* ------------------------------------------------------------------------- */ + +PROOF thm c_resource_ra_def = new_fun_definition(` + c_resource_ra + (G:(A)ra) : + ((((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)ra) = + prod_ra mem_ra (ghost_heap_ra G) +`); + +PROOF static thm prove_c_resource_ra_unit(void) { + term goal_tm = ` + forall G:(A)ra. + ra_unit (c_resource_ra G) == + (ra_unit mem_ra,ra_unit (ghost_heap_ra G)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list rewrites = THM_LIST(c_resource_ra_def, PROD_RA_UNIT); + conv simplify = rewrite_conv(rewrites); + CONV_TAC(root, simplify); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_RESOURCE_RA_UNIT = + prove_c_resource_ra_unit(); + +PROOF static thm prove_c_resource_ra_op(void) { + term goal_tm = ` + forall + (G:(A)ra) + (left:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) + (right:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap). + ra_op (c_resource_ra G) left right == + (ra_op mem_ra (FST left) (FST right), + ra_op (ghost_heap_ra G) (SND left) (SND right)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list rewrites = THM_LIST(c_resource_ra_def, PROD_RA_OP); + conv simplify = rewrite_conv(rewrites); + CONV_TAC(root, simplify); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_RESOURCE_RA_OP = + prove_c_resource_ra_op(); + +PROOF static thm prove_c_resource_ra_valid(void) { + term goal_tm = ` + forall + (G:(A)ra) + (resource:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap). + (ra_valid (c_resource_ra G) resource <=> + ra_valid mem_ra (FST resource) && + ra_valid (ghost_heap_ra G) (SND resource)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list rewrites = THM_LIST(c_resource_ra_def, PROD_RA_VALID); + conv simplify = rewrite_conv(rewrites); + CONV_TAC(root, simplify); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_RESOURCE_RA_VALID = + prove_c_resource_ra_valid(); + +/* ------------------------------------------------------------------------- */ +/* Exact physical and ghost embeddings */ +/* ------------------------------------------------------------------------- */ + +PROOF thm c_lift_phys_def = new_fun_definition(` + c_lift_phys + (G:(A)ra) + (P:(int,(pmem_byte_state)excl)finmap->bool) + (resource:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) <=> + P (FST resource) && + SND resource == ra_unit (ghost_heap_ra G) +`); + +PROOF static thm prove_c_lift_phys_emp(void) { + term goal_tm = ` + forall G:(A)ra. + c_lift_phys G (r_emp mem_ra) == + r_emp (c_resource_ra G) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "G"); + thm fun_eq_thm = get_theorem_by_name("FUN_EQ_THM"); + term_list funext_arguments = TERM_LIST( + `c_lift_phys + (G:(A)ra) + (r_emp mem_ra)`, + `r_emp (c_resource_ra (G:(A)ra))`); + thm funext = ispecl_rule(funext_arguments, fun_eq_thm); + thm_list funext_rewrites = THM_LIST(funext); + conv funext_rewrite = once_rewrite_conv(funext_rewrites); + body = CONV_TAC(body, funext_rewrite); + body = GEN_TAC(body, "resource"); + thm_list definitions = THM_LIST( + c_lift_phys_def, + r_emp_def, + C_RESOURCE_RA_UNIT); + conv unfold_definitions = pure_rewrite_conv(definitions); + body = CONV_TAC(body, unfold_definitions); + + term physical_unit = ` + ra_unit mem_ra: + (int,(pmem_byte_state)excl)finmap + `; + term ghost_unit = ` + ra_unit (ghost_heap_ra (G:(A)ra)):(num,A)finmap + `; + term resource = ` + resource: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap + `; + term fst_resource = ` + FST (resource: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) + `; + term snd_resource = ` + SND (resource: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) + `; + thm pair_eq = get_theorem_by_name("PAIR_EQ"); + term_list pair_arguments = TERM_LIST( + fst_resource, + snd_resource, + physical_unit, + ghost_unit); + thm pair_components = ispecl_rule(pair_arguments, pair_eq); + thm components_to_pair = gsym_rule(pair_components); + + thm pair_eta = get_theorem_by_name("PAIR"); + thm resource_eta = ispec_rule(resource, pair_eta); + term has_units = ` + \candidate: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap. + candidate == + (ra_unit mem_ra, + ra_unit (ghost_heap_ra (G:(A)ra))) + `; + thm pair_to_resource_raw = ap_term_rule(has_units, resource_eta); + thm pair_to_resource = beta_rule(pair_to_resource_raw); + thm result = trans_rule(components_to_pair, pair_to_resource); + ACCEPT_TAC(body, result); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_LIFT_PHYS_EMP = + prove_c_lift_phys_emp(); + +PROOF static thm prove_c_lift_phys_sep(void) { + term goal_tm = ` + forall + (G:(A)ra) + (P:(int,(pmem_byte_state)excl)finmap->bool) + (Q:(int,(pmem_byte_state)excl)finmap->bool). + c_lift_phys G (r_sep mem_ra P Q) == + r_sep + (c_resource_ra G) + (c_lift_phys G P) + (c_lift_phys G Q) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + term source_assertion = ` + c_lift_phys + (G:(A)ra) + (r_sep mem_ra + (P:(int,(pmem_byte_state)excl)finmap->bool) + (Q:(int,(pmem_byte_state)excl)finmap->bool)) + `; + term target_assertion = ` + r_sep + (c_resource_ra (G:(A)ra)) + (c_lift_phys G + (P:(int,(pmem_byte_state)excl)finmap->bool)) + (c_lift_phys G + (Q:(int,(pmem_byte_state)excl)finmap->bool)) + `; + term_list funext_arguments = TERM_LIST( + source_assertion, + target_assertion); + thm fun_eq_thm = get_theorem_by_name("FUN_EQ_THM"); + thm funext = ispecl_rule(funext_arguments, fun_eq_thm); + thm_list funext_rewrites = THM_LIST(funext); + conv expose_pointwise = once_rewrite_conv(funext_rewrites); + body = CONV_TAC(body, expose_pointwise); + body = GEN_TAC(body, "resource"); + thm_list definitions = THM_LIST(c_lift_phys_def, r_sep_def); + conv unfold_definitions = pure_rewrite_conv(definitions); + body = CONV_TAC(body, unfold_definitions); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hlifted_physical_sep"); + forward = ASMP_CONJ_TAC( + forward, + "Hlifted_physical_sep", + "Hphysical_sep", + "Hresource_ghost_unit"); + forward = ASMP_EXISTS_TAC( + forward, "Hphysical_sep", "physical_left"); + forward = ASMP_EXISTS_TAC( + forward, "Hphysical_sep", "physical_right"); + forward = ASMP_CONJ_TAC( + forward, + "Hphysical_sep", + "Hphysical_split", + "Hphysical_predicates"); + forward = ASMP_CONJ_TAC( + forward, + "Hphysical_predicates", + "HP", + "HQ"); + + term ghost_unit = ` + ra_unit (ghost_heap_ra (G:(A)ra)):(num,A)finmap + `; + term resource = ` + resource: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap + `; + term combined_left = ` + ((physical_left:(int,(pmem_byte_state)excl)finmap), + ra_unit (ghost_heap_ra (G:(A)ra))) + `; + term combined_right = ` + ((physical_right:(int,(pmem_byte_state)excl)finmap), + ra_unit (ghost_heap_ra (G:(A)ra))) + `; + forward = EXISTS_TAC(forward, combined_left); + forward = EXISTS_TAC(forward, combined_right); + gnode_list forward_result = CONJ_TAC(forward); + + const_cstr_list projected_labels = CONST_STRING_LIST( + "Hphysical_split", + "Hresource_ghost_unit"); + term_list projected_terms = gnode_get_asmps( + forward_result[0], + projected_labels); + thm physical_split_fact = assume_rule(projected_terms[0]); + thm resource_ghost_unit = assume_rule(projected_terms[1]); + thm projected_components = conj_rule( + physical_split_fact, + resource_ghost_unit); + term fst_resource = ` + FST (resource: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) + `; + term snd_resource = ` + SND (resource: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) + `; + term physical_combination = ` + ra_op + mem_ra + (physical_left:(int,(pmem_byte_state)excl)finmap) + (physical_right:(int,(pmem_byte_state)excl)finmap) + `; + term_list pair_arguments = TERM_LIST( + fst_resource, + snd_resource, + physical_combination, + ghost_unit); + thm pair_eq = get_theorem_by_name("PAIR_EQ"); + thm pair_components = ispecl_rule(pair_arguments, pair_eq); + thm components_to_pair = gsym_rule(pair_components); + thm projected_pair = eq_mp_rule( + components_to_pair, + projected_components); + thm pair_eta = get_theorem_by_name("PAIR"); + thm resource_eta = ispec_rule(resource, pair_eta); + thm resource_eta_reverse = gsym_rule(resource_eta); + thm resource_as_pair = trans_rule( + resource_eta_reverse, + projected_pair); + term ghost_ra = `G:(A)ra`; + term_list combined_op_arguments = TERM_LIST( + ghost_ra, + combined_left, + combined_right); + thm combined_op = ispecl_rule( + combined_op_arguments, + C_RESOURCE_RA_OP); + thm fst = get_theorem_by_name("FST"); + thm snd = get_theorem_by_name("SND"); + thm_list combined_op_rewrites = THM_LIST(fst, snd, RA_UNIT_L); + combined_op = pure_rewrite_rule( + combined_op_rewrites, + combined_op); + thm combined_op_reverse = gsym_rule(combined_op); + thm combined_split = trans_rule( + resource_as_pair, + combined_op_reverse); + ACCEPT_TAC(forward_result[0], combined_split); + + gnode_list forward_predicates = CONJ_TAC(forward_result[1]); + gnode_list forward_left = CONJ_TAC(forward_predicates[0]); + thm_list fst_rewrites = THM_LIST(fst); + conv simplify_fst = rewrite_conv(fst_rewrites); + gnode left_predicate = CONV_TAC(forward_left[0], simplify_fst); + const_cstr_list left_predicate_labels = CONST_STRING_LIST("HP"); + term_list left_predicate_terms = gnode_get_asmps( + left_predicate, + left_predicate_labels); + thm left_predicate_fact = assume_rule(left_predicate_terms[0]); + ACCEPT_TAC(left_predicate, left_predicate_fact); + thm_list snd_rewrites = THM_LIST(snd); + conv simplify_snd = rewrite_conv(snd_rewrites); + CONV_TAC(forward_left[1], simplify_snd); + + gnode_list forward_right = CONJ_TAC(forward_predicates[1]); + gnode right_predicate = CONV_TAC(forward_right[0], simplify_fst); + const_cstr_list right_predicate_labels = CONST_STRING_LIST("HQ"); + term_list right_predicate_terms = gnode_get_asmps( + right_predicate, + right_predicate_labels); + thm right_predicate_fact = assume_rule(right_predicate_terms[0]); + ACCEPT_TAC(right_predicate, right_predicate_fact); + CONV_TAC(forward_right[1], simplify_snd); + + gnode reverse = DISCH_TAC(directions[1], "Hcombined_sep"); + reverse = ASMP_EXISTS_TAC(reverse, "Hcombined_sep", "left"); + reverse = ASMP_EXISTS_TAC(reverse, "Hcombined_sep", "right"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hcombined_sep", + "Hcombined_split", + "Hlifted_predicates"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hlifted_predicates", + "Hlifted_P", + "Hlifted_Q"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hlifted_P", + "HP", + "Hleft_ghost_unit"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hlifted_Q", + "HQ", + "Hright_ghost_unit"); + gnode_list reverse_result = CONJ_TAC(reverse); + + term left_physical = ` + FST (left: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) + `; + term right_physical = ` + FST (right: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) + `; + gnode physical_sep = EXISTS_TAC(reverse_result[0], left_physical); + physical_sep = EXISTS_TAC(physical_sep, right_physical); + gnode_list physical_result = CONJ_TAC(physical_sep); + const_cstr_list combined_split_labels = + CONST_STRING_LIST("Hcombined_split"); + term_list combined_split_terms = gnode_get_asmps( + physical_result[0], + combined_split_labels); + thm combined_split_fact = assume_rule(combined_split_terms[0]); + term fst_function = ` + FST: + (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> + (int,(pmem_byte_state)excl)finmap + `; + thm physical_split = ap_term_rule( + fst_function, + combined_split_fact); + thm_list physical_split_rewrites = THM_LIST( + C_RESOURCE_RA_OP, + fst); + physical_split = pure_rewrite_rule( + physical_split_rewrites, + physical_split); + ACCEPT_TAC(physical_result[0], physical_split); + gnode_list physical_predicates = CONJ_TAC(physical_result[1]); + const_cstr_list left_labels = CONST_STRING_LIST("HP"); + term_list left_terms = gnode_get_asmps( + physical_predicates[0], + left_labels); + thm left_fact = assume_rule(left_terms[0]); + ACCEPT_TAC(physical_predicates[0], left_fact); + const_cstr_list right_labels = CONST_STRING_LIST("HQ"); + term_list right_terms = gnode_get_asmps( + physical_predicates[1], + right_labels); + thm right_fact = assume_rule(right_terms[0]); + ACCEPT_TAC(physical_predicates[1], right_fact); + + term snd_function = ` + SND: + (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> + (num,A)finmap + `; + thm ghost_split = ap_term_rule( + snd_function, + combined_split_fact); + const_cstr_list ghost_unit_labels = CONST_STRING_LIST( + "Hleft_ghost_unit", + "Hright_ghost_unit"); + term_list ghost_unit_terms = gnode_get_asmps( + reverse_result[1], + ghost_unit_labels); + thm left_ghost_unit = assume_rule(ghost_unit_terms[0]); + thm right_ghost_unit = assume_rule(ghost_unit_terms[1]); + thm_list ghost_split_rewrites = THM_LIST( + C_RESOURCE_RA_OP, + snd, + left_ghost_unit, + right_ghost_unit, + RA_UNIT_L); + ghost_split = pure_rewrite_rule( + ghost_split_rewrites, + ghost_split); + ACCEPT_TAC(reverse_result[1], ghost_split); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_LIFT_PHYS_SEP = + prove_c_lift_phys_sep(); + +PROOF static thm prove_c_lift_phys_entails(void) { + term goal_tm = ` + forall + (G:(A)ra) + (P:(int,(pmem_byte_state)excl)finmap->bool) + (Q:(int,(pmem_byte_state)excl)finmap->bool). + r_entails mem_ra P Q ==> + r_entails + (c_resource_ra G) + (c_lift_phys G P) + (c_lift_phys G Q) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list entails_definitions = THM_LIST(r_entails_def); + conv unfold_entails = pure_rewrite_conv(entails_definitions); + gnode body = CONV_TAC(root, unfold_entails); + body = GEN_TAC(body, "G"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = DISCH_TAC(body, "Hphysical_entails"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hcombined_valid"); + body = DISCH_TAC(body, "Hlifted_P"); + + const_cstr_list lifted_p_labels = CONST_STRING_LIST("Hlifted_P"); + term_list lifted_p_terms = gnode_get_asmps(body, lifted_p_labels); + term lifted_p_tm = lifted_p_terms[0]; + thm lifted_p_assumption = assume_rule(lifted_p_tm); + thm_list lift_definitions = THM_LIST(c_lift_phys_def); + thm lifted_P = pure_once_rewrite_rule( + lift_definitions, + lifted_p_assumption); + body = ASSUME_TAC(body, lifted_P, "Hlifted_P_parts"); + body = ASMP_CONJ_TAC( + body, + "Hlifted_P_parts", + "HP", + "Hghost_unit"); + + term ghost_ra = `G:(A)ra`; + term resource = ` + resource:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap + `; + term_list combined_valid_arguments = TERM_LIST(ghost_ra, resource); + thm combined_valid = ispecl_rule( + combined_valid_arguments, + C_RESOURCE_RA_VALID); + const_cstr_list valid_labels = CONST_STRING_LIST("Hcombined_valid"); + term_list valid_terms = gnode_get_asmps(body, valid_labels); + term valid_tm = valid_terms[0]; + thm valid_assumption = assume_rule(valid_tm); + thm valid_components = eq_mp_rule( + combined_valid, + valid_assumption); + thm physical_valid = conjunct1_rule(valid_components); + const_cstr_list entails_labels = + CONST_STRING_LIST("Hphysical_entails"); + term_list entails_terms = gnode_get_asmps(body, entails_labels); + term physical_entails_tm = entails_terms[0]; + thm physical_entails = assume_rule(physical_entails_tm); + term physical_resource = ` + FST (resource: + ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) + `; + thm entails_at_resource = spec_rule( + physical_resource, + physical_entails); + thm entails_if_owned = mp_rule( + entails_at_resource, + physical_valid); + const_cstr_list physical_owned_labels = CONST_STRING_LIST("HP"); + term_list physical_owned_terms = gnode_get_asmps( + body, + physical_owned_labels); + term physical_owned_tm = physical_owned_terms[0]; + thm physical_owned = assume_rule(physical_owned_tm); + thm physical_Q = mp_rule(entails_if_owned, physical_owned); + + conv unfold_lift = pure_once_rewrite_conv(lift_definitions); + gnode lifted_Q = CONV_TAC(body, unfold_lift); + gnode_list result = CONJ_TAC(lifted_Q); + ACCEPT_TAC(result[0], physical_Q); + const_cstr_list ghost_unit_labels = CONST_STRING_LIST("Hghost_unit"); + term_list ghost_unit_terms = gnode_get_asmps( + result[1], + ghost_unit_labels); + thm ghost_unit_fact = assume_rule(ghost_unit_terms[0]); + ACCEPT_TAC(result[1], ghost_unit_fact); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm C_LIFT_PHYS_ENTAILS = + prove_c_lift_phys_entails(); + +PROOF thm c_ghost_own_def = new_fun_definition(` + c_ghost_own + (G:(A)ra) + (name:num) + (a:A) : + (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool = + r_own + (c_resource_ra G) + (ra_unit mem_ra,finmap_singleton name a) +`); + +PROOF thm c_pmem_uninit_at_def = new_fun_definition(` + c_pmem_uninit_at + (G:(A)ra) + (address:int) : + (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool = + c_lift_phys G (pmem_uninit_at address) +`); + +PROOF thm c_pmem_byte_at_def = new_fun_definition(` + c_pmem_byte_at + (G:(A)ra) + (address:int) + (byte:int) : + (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool = + c_lift_phys G (pmem_byte_at address byte) +`); + +/* ------------------------------------------------------------------------- */ +/* Conservative-extension audit */ +/* ------------------------------------------------------------------------- */ + +PROOF static int audit_c_resource(void) { + thm_list public_theorems = THM_LIST( + c_resource_ra_def, + C_RESOURCE_RA_UNIT, + C_RESOURCE_RA_OP, + C_RESOURCE_RA_VALID, + c_lift_phys_def, + C_LIFT_PHYS_EMP, + C_LIFT_PHYS_SEP, + C_LIFT_PHYS_ENTAILS, + c_ghost_own_def, + c_pmem_uninit_at_def, + c_pmem_byte_at_def); + + for (size_t i = 0; i < vector_size(public_theorems); ++i) { + ENSURE_COND(!IS_NULL(public_theorems[i]), + "C resource theorem %zu is empty", i); + term_list theorem_hypotheses = hyp(public_theorems[i]); + size_t hypothesis_count = vector_size(theorem_hypotheses); + ENSURE_COND(hypothesis_count == 0, + "C resource theorem %zu has hypotheses", i); + } + thm_list final_axioms = get_all_axioms(); + size_t final_axiom_count = vector_size(final_axioms); + ENSURE_COND(final_axiom_count == C_RESOURCE_AXIOMS_BEFORE, + "C resource theory introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_c_resource"); + return -1; +} + +PROOF static int _C_RESOURCE_AUDIT = audit_c_resource(); diff --git a/theory/c_program_logic/c_resource.h b/theory/c_program_logic/c_resource.h new file mode 100644 index 0000000..35ff9e0 --- /dev/null +++ b/theory/c_program_logic/c_resource.h @@ -0,0 +1,159 @@ +/** + * @file c_resource.h + * @brief Product resource used by C assertions with user-selected ghost state. + * + * For `G:(A)ra`, the assertion carrier is + * + * ((int,(pmem_byte_state)excl)finmap) # (num,A)finmap + * + * and `c_resource_ra G` combines the physical-memory RA with the typed ghost + * heap RA. Assertions are the generic `r_*` resource propositions specialized + * at this combined RA; this module does not define a second BI language. + * + * Soundness boundary: the product algebra is only the assertion resource + * model. Program-level logical updates are the ghost-only `c_bupd` and + * `c_viewshift` operations declared in `c_basic_update.h`. Clients must not + * treat a generic `r_viewshift (c_resource_ra G)` as a C view shift, because + * it could change the physical-memory projection without executing C code. + * + * Documentation below writes `R_G` for `c_resource_ra G`, `P ⊢_G Q` for + * `r_entails R_G P Q`, and `P **_G Q` for `r_sep R_G P Q`. These symbols are + * documentation notation only; no additional HOL constants are introduced. + */ + +#pragma once + +#include "proof/theory/c_program_logic/mem_own.h" +#include "proof/theory/logic/ghost_heap.h" +#include "proof/theory/logic/prod_ra.h" +#include "proof/theory/logic/resource_prop.h" + +/* ------------------------------------------------------------------------- */ +/* Combined C resource algebra */ +/* ------------------------------------------------------------------------- */ + +/** + * Defining theorem: + * `⊢ ∀G. c_resource_ra G = prod_ra mem_ra (ghost_heap_ra G)`. + */ +PROOF extern thm c_resource_ra_def; + +/** + * Unit projection law: + * + * ```text + * ⊢ ∀G. ra_unit R_G = + * (ra_unit mem_ra, ra_unit (ghost_heap_ra G)). + * ``` + */ +PROOF extern thm C_RESOURCE_RA_UNIT; + +/** + * Componentwise composition law: + * + * ```text + * ⊢ ∀G left right. + * ra_op R_G left right = + * (ra_op mem_ra (FST left) (FST right), + * ra_op (ghost_heap_ra G) (SND left) (SND right)). + * ``` + */ +PROOF extern thm C_RESOURCE_RA_OP; + +/** + * Componentwise validity law: + * + * ```text + * ⊢ ∀G resource. + * ra_valid R_G resource ⇔ + * ra_valid mem_ra (FST resource) ∧ + * ra_valid (ghost_heap_ra G) (SND resource). + * ``` + */ +PROOF extern thm C_RESOURCE_RA_VALID; + +/* ------------------------------------------------------------------------- */ +/* Exact physical and ghost embeddings */ +/* ------------------------------------------------------------------------- */ + +/** + * Exact physical lift. The physical predicate receives `FST resource`, and + * the ghost projection must be the ghost-heap unit. Thus the lift owns no + * hidden or discardable ghost resource. + * + * ```text + * ⊢ ∀G P resource. + * c_lift_phys G P resource ⇔ + * P (FST resource) ∧ + * SND resource = ra_unit (ghost_heap_ra G). + * ``` + */ +PROOF extern thm c_lift_phys_def; + +/** + * The exact physical lift preserves the empty assertion: + * + * ```text + * ⊢ ∀G. c_lift_phys G (r_emp mem_ra) = r_emp R_G. + * ``` + * + * Both sides require the physical unit and the selected ghost-heap unit; the + * equality is between predicates on the complete C resource. + */ +PROOF extern thm C_LIFT_PHYS_EMP; + +/** + * The exact physical lift preserves separating conjunction: + * + * ```text + * ⊢ ∀G P Q. + * c_lift_phys G (r_sep mem_ra P Q) = + * (c_lift_phys G P **_G c_lift_phys G Q). + * ``` + * + * The forward direction gives each lifted fragment the ghost unit. The + * reverse direction projects the physical split and uses exact ghost-unit + * ownership on both lifted fragments. + */ +PROOF extern thm C_LIFT_PHYS_SEP; + +/** + * Physical entailment lifts monotonically to complete C resources: + * + * ```text + * ⊢ ∀G P Q. + * r_entails mem_ra P Q ⇒ + * (c_lift_phys G P ⊢_G c_lift_phys G Q). + * ``` + * + * Combined validity supplies physical validity through its first projection; + * the ghost-unit equality is preserved unchanged. + */ +PROOF extern thm C_LIFT_PHYS_ENTAILS; + +/** + * Exact ownership of one logical cell: + * + * ```text + * ⊢ ∀G name a. + * c_ghost_own G name a = + * r_own R_G (ra_unit mem_ra, finmap_singleton name a). + * ``` + * + * Its physical projection is exactly empty. + */ +PROOF extern thm c_ghost_own_def; + +/** + * Exact lift of uninitialized-byte ownership: + * `⊢ ∀G address. c_pmem_uninit_at G address = + * c_lift_phys G (pmem_uninit_at address)`. + */ +PROOF extern thm c_pmem_uninit_at_def; + +/** + * Exact lift of initialized-byte ownership: + * `⊢ ∀G address byte. c_pmem_byte_at G address byte = + * c_lift_phys G (pmem_byte_at address byte)`. + */ +PROOF extern thm c_pmem_byte_at_def; diff --git a/theory/c_program_logic/c_types.c b/theory/c_program_logic/c_types.c new file mode 100644 index 0000000..8e7927c --- /dev/null +++ b/theory/c_program_logic/c_types.c @@ -0,0 +1,83 @@ +#include "proof/theory/c_program_logic/c_types.h" + +PROOF static size_t C_TYPES_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF indtype ctype_type = new_datatype_definition( + "ctype = Tchar" + " | Tuchar" + " | Tshort" + " | Tushort" + " | Tint" + " | Tuint" + " | Tint64" + " | Tuint64" + " | Tptr" + " | Tstruct string (string)list (ctype)list"); + +PROOF static int c_types_declare_layout_constants(void) { + new_tyconst("struct_name", 0); + new_tyconst("field", 0); + + type field_offset_type = parse_type("struct_name->field->int"); + new_const("field_offset", field_offset_type); + + /* A natural codomain makes nonnegative object size definitional while + * leaving padding and target-layout choices abstract. */ + type struct_size_type = + parse_type("string->(string)list->(ctype)list->num"); + new_const("c_struct_size", struct_size_type); + return 0; +} + +PROOF static int _C_TYPES_LAYOUT_CONSTANTS = + c_types_declare_layout_constants(); + +PROOF thm field_addr_prop = new_fun_definition(` + field_addr + (base:int) + (structure:struct_name) + (field_name:field) : int = + base + field_offset structure field_name +`); + +PROOF thm sizeof_def = new_fun_definition(` + (sizeof Tchar = &1) /\ + (sizeof Tuchar = &1) /\ + (sizeof Tshort = &2) /\ + (sizeof Tushort = &2) /\ + (sizeof Tint = &4) /\ + (sizeof Tuint = &4) /\ + (sizeof Tint64 = &8) /\ + (sizeof Tuint64 = &8) /\ + (sizeof Tptr = &8) /\ + (!name field_names field_types. + sizeof (Tstruct name field_names field_types) = + &(c_struct_size name field_names field_types)) +`); + +PROOF static int c_types_register_theorems(void) { + ENSURE_COND(add_theorem("field_addr_prop", field_addr_prop), + "duplicate C-types theorem name: field_addr_prop"); + ENSURE_COND(add_theorem("sizeof_def", sizeof_def), + "duplicate C-types theorem name: sizeof_def"); + return 0; +err: + ERR_FUN_PUTS("c_types_register_theorems"); + return -1; +} + +PROOF static int _C_TYPES_THEOREMS_REGISTERED = + c_types_register_theorems(); + +PROOF static int c_types_check_axiom_free(void) { + ENSURE_COND(vector_size(get_all_axioms()) == C_TYPES_AXIOMS_BEFORE, + "c_types introduced a new axiom"); + return 0; +err: + ERR_FUN_PUTS("c_types_check_axiom_free"); + return -1; +} + +PROOF static int _C_TYPES_AXIOM_CHECK = + c_types_check_axiom_free(); diff --git a/theory/c_program_logic/c_types.h b/theory/c_program_logic/c_types.h new file mode 100644 index 0000000..ab955cd --- /dev/null +++ b/theory/c_program_logic/c_types.h @@ -0,0 +1,37 @@ +/** + * @file c_types.h + * @brief C scalar types and abstract object-layout operations. + * + * Concrete addresses are HOL `int`; there is intentionally no separate + * address type. Scalar sizes describe the provisional 64-bit ABI used by the + * current verifier. Structure size and field offsets remain abstract, so + * padding and target-specific layout must be supplied by layout facts. + */ + +#pragma once + +#include "proof/proof_kernel.h" + +/** + * Datatype definition for + * + * ```text + * ctype = Tchar | Tuchar | Tshort | Tushort | Tint | Tuint + * | Tint64 | Tuint64 | Tptr + * | Tstruct string (string list) (ctype list). + * ``` + */ +PROOF extern indtype ctype_type; + +/** + * Defining equations for `sizeof : ctype -> int`. Scalar sizes are 1/2/4/8 + * bytes. A structure has abstract natural size + * `&(c_struct_size name field_names field_types)`. + */ +PROOF extern thm sizeof_def; + +/** + * `field_addr (base:int) structure field = + * base + field_offset structure field`. + */ +PROOF extern thm field_addr_prop; diff --git a/theory/c_program_logic/mem_own.c b/theory/c_program_logic/mem_own.c new file mode 100644 index 0000000..f63f501 --- /dev/null +++ b/theory/c_program_logic/mem_own.c @@ -0,0 +1,64 @@ +#include "proof/theory/c_program_logic/mem_own.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/c_program_logic/mem_ra.c" +#require "proof/theory/logic/resource_prop.c" + +PROOF static thm_list MEM_OWN_INITIAL_AXIOMS = get_all_axioms(); +PROOF static size_t MEM_OWN_AXIOMS_BEFORE = + vector_size(MEM_OWN_INITIAL_AXIOMS); + +PROOF thm pmem_own_def = new_fun_definition(` + pmem_own + (memory:(int,(pmem_byte_state)excl)finmap) : + (int,(pmem_byte_state)excl)finmap->bool = + r_own mem_ra memory +`); + +PROOF thm pmem_uninit_at_def = new_fun_definition(` + pmem_uninit_at + (address:int) : + (int,(pmem_byte_state)excl)finmap->bool = + pmem_own (pmem_uninit address) +`); + +PROOF thm pmem_byte_at_def = new_fun_definition(` + pmem_byte_at + (address:int) + (byte:int) : + (int,(pmem_byte_state)excl)finmap->bool = + pmem_own (pmem_byte address byte) +`); + +/* ------------------------------------------------------------------------- */ +/* Conservative-extension audit */ +/* ------------------------------------------------------------------------- */ + +PROOF static int audit_mem_own(void) { + thm_list public_theorems = THM_LIST( + pmem_own_def, + pmem_uninit_at_def, + pmem_byte_at_def); + + size_t public_theorem_count = vector_size(public_theorems); + for (size_t i = 0; i < public_theorem_count; ++i) { + thm public_theorem = public_theorems[i]; + ENSURE_COND(!IS_NULL(public_theorem), + "physical ownership theorem %zu is empty", i); + term_list theorem_hypotheses = hyp(public_theorem); + size_t hypothesis_count = vector_size(theorem_hypotheses); + ENSURE_COND(hypothesis_count == 0, + "physical ownership theorem %zu has hypotheses", i); + } + thm_list final_axioms = get_all_axioms(); + size_t final_axiom_count = vector_size(final_axioms); + ENSURE_COND(final_axiom_count == MEM_OWN_AXIOMS_BEFORE, + "physical ownership assertions introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_mem_own"); + return -1; +} + +PROOF static int _MEM_OWN_AUDIT = audit_mem_own(); diff --git a/theory/c_program_logic/mem_own.h b/theory/c_program_logic/mem_own.h new file mode 100644 index 0000000..2b21530 --- /dev/null +++ b/theory/c_program_logic/mem_own.h @@ -0,0 +1,33 @@ +/** + * @file mem_own.h + * @brief Exact ownership assertions over the concrete physical-memory RA. + * + * This module layers the generic resource-proposition language over the + * concrete byte algebra from `mem_ra.h`. Keeping these predicates separate + * leaves the physical carrier and its algebraic laws independent of any + * assertion model. + */ + +#pragma once + +#include "proof/theory/c_program_logic/mem_ra.h" +#include "proof/theory/logic/resource_prop.h" + +/** + * Defining theorem for exact memory ownership: + * `⊢ ∀memory. pmem_own memory = r_own mem_ra memory`. + */ +PROOF extern thm pmem_own_def; + +/** + * Defining theorem for one allocated, uninitialized byte: + * `⊢ ∀address. pmem_uninit_at address = pmem_own (pmem_uninit address)`. + */ +PROOF extern thm pmem_uninit_at_def; + +/** + * Defining theorem for one initialized byte: + * `⊢ ∀address byte. pmem_byte_at address byte = + * pmem_own (pmem_byte address byte)`. + */ +PROOF extern thm pmem_byte_at_def; diff --git a/theory/c_program_logic/mem_ra.c b/theory/c_program_logic/mem_ra.c new file mode 100644 index 0000000..352d0b8 --- /dev/null +++ b/theory/c_program_logic/mem_ra.c @@ -0,0 +1,371 @@ +#include "proof/theory/c_program_logic/mem_ra.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/excl_ra.c" +#require "proof/theory/logic/gmap_ra.c" + +PROOF static thm_list MEM_RA_INITIAL_AXIOMS = get_all_axioms(); +PROOF static size_t MEM_RA_AXIOMS_BEFORE = + vector_size(MEM_RA_INITIAL_AXIOMS); + +/* ------------------------------------------------------------------------- */ +/* Byte payload and construction */ +/* ------------------------------------------------------------------------- */ + +PROOF indtype pmem_byte_state_type = new_datatype_definition( + "pmem_byte_state = PMemUninit" + " | PMemByte int"); + +PROOF thm mem_ra_def = new_fun_definition(` + mem_ra : ((int,(pmem_byte_state)excl)finmap)ra = + gmap_ra (excl_ra:((pmem_byte_state)excl)ra) +`); + +PROOF static thm prove_mem_ra_unit(void) { + term goal_tm = ` + ra_unit mem_ra == + (finmap_empty:(int,(pmem_byte_state)excl)finmap) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list rewrites = THM_LIST( + mem_ra_def, + GMAP_RA_UNIT); + conv rewrite = rewrite_conv(rewrites); + CONV_TAC(root, rewrite); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm MEM_RA_UNIT = prove_mem_ra_unit(); + +PROOF static thm prove_mem_ra_op_lookup(void) { + term goal_tm = ` + forall + (left:(int,(pmem_byte_state)excl)finmap) + (right:(int,(pmem_byte_state)excl)finmap) + (address:int). + finmap_lookup + (ra_op mem_ra left right) + address == + ra_op + (option_ra + (excl_ra:((pmem_byte_state)excl)ra)) + (finmap_lookup left address) + (finmap_lookup right address) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list rewrites = THM_LIST( + mem_ra_def, + GMAP_RA_OP_LOOKUP); + conv rewrite = rewrite_conv(rewrites); + CONV_TAC(root, rewrite); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm MEM_RA_OP_LOOKUP = + prove_mem_ra_op_lookup(); + +PROOF static thm prove_mem_ra_valid(void) { + term goal_tm = ` + forall memory:(int,(pmem_byte_state)excl)finmap. + (ra_valid mem_ra memory <=> + forall address:int. + ra_valid + (option_ra + (excl_ra:((pmem_byte_state)excl)ra)) + (finmap_lookup memory address)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list rewrites = THM_LIST( + mem_ra_def, + GMAP_RA_VALID); + conv rewrite = rewrite_conv(rewrites); + CONV_TAC(root, rewrite); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm MEM_RA_VALID = prove_mem_ra_valid(); + +/* ------------------------------------------------------------------------- */ +/* Canonical fragments */ +/* ------------------------------------------------------------------------- */ + +PROOF thm pmem_singleton_def = new_fun_definition(` + pmem_singleton + (address:int) + (state:pmem_byte_state) : + (int,(pmem_byte_state)excl)finmap = + finmap_singleton address (Excl state) +`); + +PROOF thm pmem_uninit_def = new_fun_definition(` + pmem_uninit + (address:int) : + (int,(pmem_byte_state)excl)finmap = + pmem_singleton address PMemUninit +`); + +PROOF thm pmem_byte_def = new_fun_definition(` + pmem_byte + (address:int) + (byte:int) : + (int,(pmem_byte_state)excl)finmap = + pmem_singleton address (PMemByte byte) +`); + +PROOF static thm prove_pmem_singleton_valid(void) { + term goal_tm = ` + forall + (address:int) + (state:pmem_byte_state). + ra_valid + mem_ra + (pmem_singleton address state) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list rewrites = THM_LIST( + mem_ra_def, + pmem_singleton_def, + GMAP_RA_VALID_SINGLETON, + EXCL_RA_VALID_OWNED); + conv rewrite = rewrite_conv(rewrites); + CONV_TAC(root, rewrite); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_SINGLETON_VALID = + prove_pmem_singleton_valid(); + +PROOF static thm prove_pmem_uninit_valid(void) { + term goal_tm = ` + forall address:int. + ra_valid mem_ra (pmem_uninit address) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list rewrites = THM_LIST( + pmem_uninit_def, + PMEM_SINGLETON_VALID); + conv rewrite = rewrite_conv(rewrites); + CONV_TAC(root, rewrite); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_UNINIT_VALID = + prove_pmem_uninit_valid(); + +PROOF static thm prove_pmem_byte_valid(void) { + term goal_tm = ` + forall (address:int) (byte:int). + ra_valid mem_ra (pmem_byte address byte) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list rewrites = THM_LIST( + pmem_byte_def, + PMEM_SINGLETON_VALID); + conv rewrite = rewrite_conv(rewrites); + CONV_TAC(root, rewrite); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_BYTE_VALID = + prove_pmem_byte_valid(); + +PROOF static thm prove_pmem_singleton_overlap_invalid(void) { + term goal_tm = ` + forall + (address:int) + (left:pmem_byte_state) + (right:pmem_byte_state). + ~(ra_valid + mem_ra + (ra_op + mem_ra + (pmem_singleton address left) + (pmem_singleton address right))) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list rewrites = THM_LIST( + mem_ra_def, + pmem_singleton_def, + GMAP_RA_SINGLETON_OP, + GMAP_RA_VALID_SINGLETON, + EXCL_RA_OWNED_CONFLICT, + EXCL_RA_INVALID); + conv rewrite = rewrite_conv(rewrites); + CONV_TAC(root, rewrite); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_SINGLETON_OVERLAP_INVALID = + prove_pmem_singleton_overlap_invalid(); + +/* ------------------------------------------------------------------------- */ +/* Frame-preserving singleton updates */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm pmem_lift_excl_singleton_update( + const term address, + const term source_state, + const term target_state) { + term_list payload_arguments = TERM_LIST(source_state, target_state); + thm payload_update = ispecl_rule( + payload_arguments, + EXCL_RA_UPDATE); + term source_owned = mk_comb( + `Excl:pmem_byte_state->(pmem_byte_state)excl`, + source_state); + term target_owned = mk_comb( + `Excl:pmem_byte_state->(pmem_byte_state)excl`, + target_state); + term_list singleton_arguments = TERM_LIST( + `excl_ra:((pmem_byte_state)excl)ra`, + address, + source_owned, + target_owned); + thm singleton_update = ispecl_rule( + singleton_arguments, + GMAP_RA_UPDATE_SINGLETON); + thm lifted_update = mp_rule(singleton_update, payload_update); + return lifted_update; +} + +PROOF static thm prove_pmem_update_uninit_byte(void) { + term goal_tm = ` + forall (address:int) (byte:int). + ra_update + mem_ra + (pmem_uninit address) + (pmem_byte address byte) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm_list rewrites = THM_LIST( + mem_ra_def, + pmem_uninit_def, + pmem_byte_def, + pmem_singleton_def); + conv rewrite = pure_rewrite_conv(rewrites); + body = CONV_TAC(body, rewrite); + thm update = pmem_lift_excl_singleton_update( + `address:int`, + `PMemUninit:pmem_byte_state`, + `PMemByte (byte:int)`); + ACCEPT_TAC(body, update); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_UPDATE_UNINIT_BYTE = + prove_pmem_update_uninit_byte(); + +PROOF static thm prove_pmem_update_byte_uninit(void) { + term goal_tm = ` + forall (address:int) (byte:int). + ra_update + mem_ra + (pmem_byte address byte) + (pmem_uninit address) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm_list rewrites = THM_LIST( + mem_ra_def, + pmem_byte_def, + pmem_uninit_def, + pmem_singleton_def); + conv rewrite = pure_rewrite_conv(rewrites); + body = CONV_TAC(body, rewrite); + thm update = pmem_lift_excl_singleton_update( + `address:int`, + `PMemByte (byte:int)`, + `PMemUninit:pmem_byte_state`); + ACCEPT_TAC(body, update); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_UPDATE_BYTE_UNINIT = + prove_pmem_update_byte_uninit(); + +PROOF static thm prove_pmem_update_byte_byte(void) { + term goal_tm = ` + forall (address:int) (old_byte:int) (new_byte:int). + ra_update + mem_ra + (pmem_byte address old_byte) + (pmem_byte address new_byte) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm_list rewrites = THM_LIST( + mem_ra_def, + pmem_byte_def, + pmem_singleton_def); + conv rewrite = pure_rewrite_conv(rewrites); + body = CONV_TAC(body, rewrite); + thm update = pmem_lift_excl_singleton_update( + `address:int`, + `PMemByte (old_byte:int)`, + `PMemByte (new_byte:int)`); + ACCEPT_TAC(body, update); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_UPDATE_BYTE_BYTE = + prove_pmem_update_byte_byte(); + +/* ------------------------------------------------------------------------- */ +/* Conservative-extension audit */ +/* ------------------------------------------------------------------------- */ + +PROOF static int audit_mem_ra(void) { + thm_list public_theorems = THM_LIST( + pmem_byte_state_type.ind, + pmem_byte_state_type.rec, + mem_ra_def, + MEM_RA_UNIT, + MEM_RA_OP_LOOKUP, + MEM_RA_VALID, + pmem_singleton_def, + pmem_uninit_def, + pmem_byte_def, + PMEM_SINGLETON_VALID, + PMEM_UNINIT_VALID, + PMEM_BYTE_VALID, + PMEM_SINGLETON_OVERLAP_INVALID, + PMEM_UPDATE_UNINIT_BYTE, + PMEM_UPDATE_BYTE_UNINIT, + PMEM_UPDATE_BYTE_BYTE); + + size_t public_theorem_count = vector_size(public_theorems); + for (size_t i = 0; i < public_theorem_count; ++i) { + thm public_theorem = public_theorems[i]; + ENSURE_COND(!IS_NULL(public_theorem), + "physical-memory theorem %zu is empty", i); + term_list theorem_hypotheses = hyp(public_theorem); + size_t hypothesis_count = vector_size(theorem_hypotheses); + ENSURE_COND(hypothesis_count == 0, + "physical-memory theorem %zu has hypotheses", i); + } + thm_list final_axioms = get_all_axioms(); + size_t final_axiom_count = vector_size(final_axioms); + ENSURE_COND(final_axiom_count == MEM_RA_AXIOMS_BEFORE, + "physical-memory RA introduced an axiom"); + int pmem_byte_state_arity = get_tyconst_arity("pmem_byte_state"); + ENSURE_COND(pmem_byte_state_arity == 0, + "pmem_byte_state is not a nullary HOL type"); + return 0; +err: + ERR_FUN_PUTS("audit_mem_ra"); + return -1; +} + +PROOF static int _MEM_RA_AUDIT = audit_mem_ra(); diff --git a/theory/c_program_logic/mem_ra.h b/theory/c_program_logic/mem_ra.h new file mode 100644 index 0000000..a726d39 --- /dev/null +++ b/theory/c_program_logic/mem_ra.h @@ -0,0 +1,162 @@ +/** + * @file mem_ra.h + * @brief Concrete byte ownership as a construction-based resource algebra. + * + * The payload datatype distinguishes an allocated but uninitialized byte from + * an initialized byte carrying an integer value: + * + * pmem_byte_state = PMemUninit | PMemByte int. + * + * The memory carrier is the finite map + * + * (int,(pmem_byte_state)excl)finmap. + * + * A missing key (`NONE`) is the canonical representation of no ownership at + * that address. A present `Excl state` owns exactly one byte. Combining two + * present owned values at the same address produces `ExclInvalid`, so the + * resulting memory is invalid. The public singleton constructors never emit + * the noncanonical `ExclUnit` or `ExclInvalid` payloads admitted by the general + * carrier. + * + * This theory is independent of every assertion language. Exact ownership + * predicates over this algebra are layered separately in `mem_own.h`. + */ + +#pragma once + +#include "proof/theory/logic/excl_ra.h" +#include "proof/theory/logic/gmap_ra.h" + +/* ------------------------------------------------------------------------- */ +/* Byte payload and memory algebra */ +/* ------------------------------------------------------------------------- */ + +/** + * HOL datatype package for + * `pmem_byte_state = PMemUninit | PMemByte int`. + * + * The handle exposes the datatype's constructors and generated induction and + * recursion theorems through the ordinary `indtype` API. + */ +PROOF extern indtype pmem_byte_state_type; + +/** + * Construction equation: + * + * ```text + * ⊢ mem_ra = gmap_ra (excl_ra : ((pmem_byte_state)excl)ra). + * ``` + */ +PROOF extern thm mem_ra_def; + +/** + * The empty memory is the empty finite map: + * + * ```text + * ⊢ ra_unit mem_ra = + * (finmap_empty : (int,(pmem_byte_state)excl)finmap). + * ``` + */ +PROOF extern thm MEM_RA_UNIT; + +/** + * Composition is pointwise through option and exclusive composition: + * + * ```text + * ⊢ ∀left right address. + * finmap_lookup (ra_op mem_ra left right) address = + * ra_op (option_ra (excl_ra : ((pmem_byte_state)excl)ra)) + * (finmap_lookup left address) + * (finmap_lookup right address). + * ``` + */ +PROOF extern thm MEM_RA_OP_LOOKUP; + +/** + * Memory validity is pointwise option/exclusive validity: + * + * ```text + * ⊢ ∀memory. + * ra_valid mem_ra memory ⇔ + * ∀address:int. + * ra_valid (option_ra (excl_ra : ((pmem_byte_state)excl)ra)) + * (finmap_lookup memory address). + * ``` + */ +PROOF extern thm MEM_RA_VALID; + +/* ------------------------------------------------------------------------- */ +/* Canonical finite-memory fragments */ +/* ------------------------------------------------------------------------- */ + +/** + * Canonical singleton definition: + * `⊢ ∀address state. pmem_singleton address state = + * finmap_singleton address (Excl state)`. + */ +PROOF extern thm pmem_singleton_def; + +/** + * Uninitialized singleton definition: + * `⊢ ∀address. pmem_uninit address = + * pmem_singleton address PMemUninit`. + */ +PROOF extern thm pmem_uninit_def; + +/** + * Initialized singleton definition: + * `⊢ ∀address byte. pmem_byte address byte = + * pmem_singleton address (PMemByte byte)`. + */ +PROOF extern thm pmem_byte_def; + +/** `⊢ ∀address state. ra_valid mem_ra (pmem_singleton address state)`. */ +PROOF extern thm PMEM_SINGLETON_VALID; + +/** `⊢ ∀address. ra_valid mem_ra (pmem_uninit address)`. */ +PROOF extern thm PMEM_UNINIT_VALID; + +/** `⊢ ∀address byte. ra_valid mem_ra (pmem_byte address byte)`. */ +PROOF extern thm PMEM_BYTE_VALID; + +/** + * Two canonical owned singletons at the same address compose to an invalid + * memory, independently of their byte states: + * + * ```text + * ⊢ ∀address left right. + * ¬ ra_valid mem_ra + * (ra_op mem_ra (pmem_singleton address left) + * (pmem_singleton address right)). + * ``` + */ +PROOF extern thm PMEM_SINGLETON_OVERLAP_INVALID; + +/* ------------------------------------------------------------------------- */ +/* Frame-preserving updates */ +/* ------------------------------------------------------------------------- */ + +/* + * These algebraic updates are implementation lemmas for trusted C command + * semantic rules. They must not be exposed as program-level viewshifts: + * changing physical memory requires execution of the corresponding C command. + */ + +/** + * `⊢ ∀address byte. ra_update mem_ra (pmem_uninit address) + * (pmem_byte address byte)`. + */ +PROOF extern thm PMEM_UPDATE_UNINIT_BYTE; + +/** + * `⊢ ∀address byte. ra_update mem_ra (pmem_byte address byte) + * (pmem_uninit address)`. + */ +PROOF extern thm PMEM_UPDATE_BYTE_UNINIT; + +/** + * `⊢ ∀address old_byte new_byte. + * ra_update mem_ra (pmem_byte address old_byte) + * (pmem_byte address new_byte)`. + */ +PROOF extern thm PMEM_UPDATE_BYTE_BYTE; diff --git a/theory/c_program_logic/mem_value.c b/theory/c_program_logic/mem_value.c new file mode 100644 index 0000000..7d20308 --- /dev/null +++ b/theory/c_program_logic/mem_value.c @@ -0,0 +1,681 @@ +#include "proof/theory/c_program_logic/mem_value.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/c_program_logic/mem_own.c" + +PROOF static thm_list MEM_VALUE_INITIAL_AXIOMS = get_all_axioms(); +PROOF static size_t MEM_VALUE_AXIOMS_BEFORE = + vector_size(MEM_VALUE_INITIAL_AXIOMS); + +/* ------------------------------------------------------------------------- */ +/* Allocated bytes and contiguous regions */ +/* ------------------------------------------------------------------------- */ + +PROOF thm pmem_allocated_byte_at_def = new_fun_definition(` + pmem_allocated_byte_at + (address:int) : + (int,(pmem_byte_state)excl)finmap->bool = + r_exists + mem_ra + (\state:pmem_byte_state. + pmem_own (pmem_singleton address state)) +`); + +PROOF static thm MEM_VALUE_LIST_RECURSION = + get_theorem_by_name("list_RECURSION"); + +PROOF thm pmem_bytes_at_def = new_rec_definition( + MEM_VALUE_LIST_RECURSION, + ` + (pmem_bytes_at + (base:int) + ([]:(int)list) = + r_emp mem_ra) && + (pmem_bytes_at + base + ((byte:int) :: (bytes:(int)list)) = + r_sep + mem_ra + (pmem_byte_at base byte) + (pmem_bytes_at (base + &1) bytes)) + `); + +PROOF static thm prove_pmem_bytes_at_nil(void) { + gnode root = gnode_new_with_ccl(` + forall base:int. + pmem_bytes_at base ([]:(int)list) == r_emp mem_ra + `); + thm_list rewrites = THM_LIST(pmem_bytes_at_def); + conv simplify = rewrite_conv(rewrites); + CONV_TAC(root, simplify); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_BYTES_AT_NIL = + prove_pmem_bytes_at_nil(); + +PROOF static thm prove_pmem_bytes_at_cons(void) { + gnode root = gnode_new_with_ccl(` + forall (base:int) (byte:int) (bytes:(int)list). + pmem_bytes_at base (byte :: bytes) == + r_sep + mem_ra + (pmem_byte_at base byte) + (pmem_bytes_at (base + &1) bytes) + `); + thm_list rewrites = THM_LIST(pmem_bytes_at_def); + conv simplify = rewrite_conv(rewrites); + CONV_TAC(root, simplify); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_BYTES_AT_CONS = + prove_pmem_bytes_at_cons(); + +PROOF static thm MEM_VALUE_NUM_RECURSION = + get_theorem_by_name("num_RECURSION"); + +PROOF thm pmem_allocated_at_def = new_rec_definition( + MEM_VALUE_NUM_RECURSION, + ` + (pmem_allocated_at + (base:int) + 0 = + r_emp mem_ra) && + (pmem_allocated_at + base + (SUC count) = + r_sep + mem_ra + (pmem_allocated_byte_at base) + (pmem_allocated_at (base + &1) count)) + `); + +PROOF static thm prove_pmem_allocated_at_zero(void) { + gnode root = gnode_new_with_ccl(` + forall base:int. + pmem_allocated_at base 0 == r_emp mem_ra + `); + thm_list rewrites = THM_LIST(pmem_allocated_at_def); + conv simplify = rewrite_conv(rewrites); + CONV_TAC(root, simplify); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_ALLOCATED_AT_ZERO = + prove_pmem_allocated_at_zero(); + +PROOF static thm prove_pmem_allocated_at_suc(void) { + gnode root = gnode_new_with_ccl(` + forall (base:int) (count:num). + pmem_allocated_at base (SUC count) == + r_sep + mem_ra + (pmem_allocated_byte_at base) + (pmem_allocated_at (base + &1) count) + `); + thm_list rewrites = THM_LIST(pmem_allocated_at_def); + conv simplify = rewrite_conv(rewrites); + CONV_TAC(root, simplify); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_ALLOCATED_AT_SUC = + prove_pmem_allocated_at_suc(); + +PROOF static thm prove_pmem_allocated_at_append(void) { + gnode root = gnode_new_with_ccl(` + forall m:num. forall base:int. forall n:num. + pmem_allocated_at base (m + n) == + r_sep mem_ra + (pmem_allocated_at base m) + (pmem_allocated_at (base + &m) n) + `); + gnode body = GEN_TAC(root, "m"); + gnode_list cases = INDUCT_TAC(body, `m:num`); + + gnode base = AUTO_INTROS_TAC(cases[0]); + thm zero_address = ispec_rule( + `base:int`, get_theorem_by_name("INT_ADD_RID")); + CONV_TAC(base, simp_conv(THM_LIST( + get_theorem_by_name("ADD_CLAUSES"), + zero_address, + PMEM_ALLOCATED_AT_ZERO, + R_SEP_EMP_L))); + + gnode step = AUTO_INTROS_TAC(cases[1]); + thm ih_general = assume_rule( + gnode_get_asmps(step, CONST_STRING_LIST("H"))[0]); + thm ih = ispecl_rule( + TERM_LIST(`base + &1:int`, `n_:num`), + ih_general); + thm cast_successor = ispec_rule( + `n:num`, get_theorem_by_name("INT_OF_NUM_SUC")); + thm expose_successor = beta_rule(ap_term_rule( + `\z:int. base + z`, cast_successor)); + thm address_reassociation = int_ring_rule(` + forall (x:int) (y:int). + x + (y + &1) = (x + &1) + y + `); + address_reassociation = + ispec_rule(`base:int`, address_reassociation); + address_reassociation = + ispec_rule(`&n:int`, address_reassociation); + thm address = trans_rule( + sym_rule(expose_successor), address_reassociation); + step = CONV_TAC(step, simp_conv(THM_LIST( + get_theorem_by_name("ADD_CLAUSES"), + PMEM_ALLOCATED_AT_SUC, + address, + R_SEP_ASSOC))); + thm lifted_ih = beta_rule(ap_term_rule(` + \tail:((int,(pmem_byte_state)excl)finmap)->bool. + r_sep mem_ra (pmem_allocated_byte_at base) tail + `, ih)); + ACCEPT_TAC(step, lifted_ih); + return gnode_prove(root); +} + +PROOF thm PMEM_ALLOCATED_AT_APPEND = + prove_pmem_allocated_at_append(); + +PROOF static thm prove_pmem_allocated_at_split(void) { + gnode root = gnode_new_with_ccl(` + forall base:int. forall n k:num. + k <= n ==> + pmem_allocated_at base n == + r_sep mem_ra + (pmem_allocated_at base k) + (pmem_allocated_at (base + &k) (n - k)) + `); + gnode g = AUTO_INTROS_TAC(root); + thm decomposition = match_mp_rule( + arith_rule(`forall k n:num. k <= n ==> n = k + (n - k)`), + assume_rule(`k:num <= n`)); + thm appended = ispecl_rule( + TERM_LIST(`k:num`, `base:int`, `n - k:num`), + PMEM_ALLOCATED_AT_APPEND); + appended = conv_rule( + once_rewrite_conv(THM_LIST(gsym_rule(decomposition))), + appended); + ACCEPT_TAC(g, appended); + return gnode_prove(root); +} + +PROOF thm PMEM_ALLOCATED_AT_SPLIT = + prove_pmem_allocated_at_split(); + +PROOF static thm prove_pmem_uninit_at_allocated_byte(void) { + term goal_tm = ` + forall address:int. + r_entails + mem_ra + (pmem_uninit_at address) + (pmem_allocated_byte_at address) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list definitions = THM_LIST( + r_entails_def, + pmem_uninit_at_def, + pmem_uninit_def, + pmem_allocated_byte_at_def, + pmem_own_def, + r_own_def, + r_exists_def); + conv unfold_definitions = pure_rewrite_conv(definitions); + gnode body = CONV_TAC(root, unfold_definitions); + body = GEN_TAC(body, "address"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid_resource"); + body = DISCH_TAC(body, "Hown"); + term uninitialized_tm = `PMemUninit:pmem_byte_state`; + body = EXISTS_TAC(body, uninitialized_tm); + conv beta = get_conversion_by_name("BETA_CONV"); + conv beta_depth = depth_conv(beta); + body = CONV_TAC(body, beta_depth); + thm_list own_definitions = THM_LIST(r_own_def); + conv unfold_own = pure_rewrite_conv(own_definitions); + body = CONV_TAC(body, unfold_own); + const_cstr_list own_labels = CONST_STRING_LIST("Hown"); + term_list own_terms = gnode_get_asmps(body, own_labels); + term own_tm = own_terms[0]; + thm own = assume_rule(own_tm); + ACCEPT_TAC(body, own); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_UNINIT_AT_ALLOCATED_BYTE = + prove_pmem_uninit_at_allocated_byte(); + +PROOF static thm prove_pmem_byte_at_allocated_byte(void) { + term goal_tm = ` + forall (address:int) (byte:int). + r_entails + mem_ra + (pmem_byte_at address byte) + (pmem_allocated_byte_at address) + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm_list definitions = THM_LIST( + r_entails_def, + pmem_byte_at_def, + pmem_byte_def, + pmem_allocated_byte_at_def, + pmem_own_def, + r_own_def, + r_exists_def); + conv unfold_definitions = pure_rewrite_conv(definitions); + gnode body = CONV_TAC(root, unfold_definitions); + body = GEN_TAC(body, "address"); + body = GEN_TAC(body, "byte"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid_resource"); + body = DISCH_TAC(body, "Hown"); + term byte_state_tm = `PMemByte (byte:int):pmem_byte_state`; + body = EXISTS_TAC(body, byte_state_tm); + conv beta = get_conversion_by_name("BETA_CONV"); + conv beta_depth = depth_conv(beta); + body = CONV_TAC(body, beta_depth); + thm_list own_definitions = THM_LIST(r_own_def); + conv unfold_own = pure_rewrite_conv(own_definitions); + body = CONV_TAC(body, unfold_own); + const_cstr_list own_labels = CONST_STRING_LIST("Hown"); + term_list own_terms = gnode_get_asmps(body, own_labels); + term own_tm = own_terms[0]; + thm own = assume_rule(own_tm); + ACCEPT_TAC(body, own); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_BYTE_AT_ALLOCATED_BYTE = + prove_pmem_byte_at_allocated_byte(); + +PROOF static thm prove_pmem_bytes_at_allocated(void) { + term goal_tm = ` + forall bytes:(int)list. + forall base:int. + r_entails + mem_ra + (pmem_bytes_at base bytes) + (pmem_allocated_at base (LENGTH bytes)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "bytes"); + term bytes_tm = `bytes:(int)list`; + gnode_list cases = INDUCT_TAC(body, bytes_tm); + + gnode nil_case = GEN_TAC(cases[0], "base"); + thm length = get_theorem_by_name("LENGTH"); + thm_list nil_rewrites = THM_LIST( + PMEM_BYTES_AT_NIL, + PMEM_ALLOCATED_AT_ZERO, + length); + conv simplify_nil = rewrite_conv(nil_rewrites); + nil_case = CONV_TAC(nil_case, simplify_nil); + term mem_ra_tm = `mem_ra:((int,(pmem_byte_state)excl)finmap)ra`; + term emp_tm = ` + r_emp mem_ra:(int,(pmem_byte_state)excl)finmap->bool + `; + term_list refl_arguments = TERM_LIST(mem_ra_tm, emp_tm); + thm entails_refl = ispecl_rule(refl_arguments, R_ENTAILS_REFL); + ACCEPT_TAC(nil_case, entails_refl); + + gnode cons_case = GEN_TAC(cases[1], "base"); + thm_list cons_rewrites = THM_LIST( + PMEM_BYTES_AT_CONS, + PMEM_ALLOCATED_AT_SUC, + length); + conv simplify_cons = rewrite_conv(cons_rewrites); + cons_case = CONV_TAC(cons_case, simplify_cons); + + term base_tm = `base:int`; + term head_tm = `a0:int`; + term_list head_arguments = TERM_LIST(base_tm, head_tm); + thm head_entails = ispecl_rule( + head_arguments, + PMEM_BYTE_AT_ALLOCATED_BYTE); + term induction_tm = ` + forall base:int. + r_entails + mem_ra + (pmem_bytes_at base (a1:(int)list)) + (pmem_allocated_at base (LENGTH a1)) + `; + thm induction = assume_rule(induction_tm); + term next_base_tm = `base + &1:int`; + thm tail_entails = spec_rule(next_base_tm, induction); + thm sep_after_head = match_mp_rule(R_SEP_MONO, head_entails); + thm region_entails = match_mp_rule(sep_after_head, tail_entails); + ACCEPT_TAC(cons_case, region_entails); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_BYTES_AT_ALLOCATED = + prove_pmem_bytes_at_allocated(); + +/* ------------------------------------------------------------------------- */ +/* Provisional little-endian scalar representation */ +/* ------------------------------------------------------------------------- */ + +PROOF thm pmem_le_bytes_def = new_rec_definition( + MEM_VALUE_NUM_RECURSION, + ` + (pmem_le_bytes + 0 + (integer_value:int) = + ([]:(int)list)) && + (pmem_le_bytes + (SUC count) + integer_value = + (integer_value rem &256) :: + pmem_le_bytes count (integer_value div &256)) + `); + +PROOF static thm prove_pmem_le_bytes_zero(void) { + gnode root = gnode_new_with_ccl(` + forall integer_value:int. + pmem_le_bytes 0 integer_value == ([]:(int)list) + `); + thm_list rewrites = THM_LIST(pmem_le_bytes_def); + conv simplify = rewrite_conv(rewrites); + CONV_TAC(root, simplify); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_LE_BYTES_ZERO = + prove_pmem_le_bytes_zero(); + +PROOF static thm prove_pmem_le_bytes_suc(void) { + gnode root = gnode_new_with_ccl(` + forall (count:num) (integer_value:int). + pmem_le_bytes (SUC count) integer_value == + (integer_value rem &256) :: + pmem_le_bytes count (integer_value div &256) + `); + thm_list rewrites = THM_LIST(pmem_le_bytes_def); + conv simplify = rewrite_conv(rewrites); + CONV_TAC(root, simplify); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_LE_BYTES_SUC = + prove_pmem_le_bytes_suc(); + +PROOF static thm prove_pmem_le_bytes_length(void) { + gnode root = gnode_new_with_ccl(` + forall (count:num) (integer_value:int). + LENGTH (pmem_le_bytes count integer_value) == count + `); + gnode body = GEN_TAC(root, "count"); + term count_tm = `count:num`; + gnode_list cases = INDUCT_TAC(body, count_tm); + + thm length = get_theorem_by_name("LENGTH"); + + gnode zero_case = GEN_TAC(cases[0], "integer_value"); + thm_list zero_rewrites = THM_LIST( + PMEM_LE_BYTES_ZERO, + length); + conv simplify_zero = rewrite_conv(zero_rewrites); + CONV_TAC(zero_case, simplify_zero); + + gnode suc_case = GEN_TAC(cases[1], "integer_value"); + term induction_assumption_tm = ` + forall integer_value:int. + LENGTH (pmem_le_bytes (n:num) integer_value) == n + `; + thm induction_assumption = assume_rule(induction_assumption_tm); + term quotient_tm = `(integer_value:int) div &256`; + thm induction = spec_rule(quotient_tm, induction_assumption); + thm_list suc_rewrites = THM_LIST( + PMEM_LE_BYTES_SUC, + length, + induction); + conv simplify_suc = rewrite_conv(suc_rewrites); + CONV_TAC(suc_case, simplify_suc); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_LE_BYTES_LENGTH = + prove_pmem_le_bytes_length(); + +PROOF thm pmem_scalar_at_def = new_fun_definition(` + pmem_scalar_at + (base:int) + (count:num) + (integer_value:int) : + (int,(pmem_byte_state)excl)finmap->bool = + pmem_bytes_at base (pmem_le_bytes count integer_value) +`); + +PROOF thm pmem_undef_scalar_at_def = new_rec_definition( + MEM_VALUE_NUM_RECURSION, + ` + (pmem_undef_scalar_at + (base:int) + 0 = + r_emp mem_ra) && + (pmem_undef_scalar_at + base + (SUC count) = + r_sep + mem_ra + (pmem_uninit_at base) + (pmem_undef_scalar_at (base + &1) count)) + `); + +PROOF static thm prove_pmem_scalar_at_zero(void) { + gnode root = gnode_new_with_ccl(` + forall (base:int) (integer_value:int). + pmem_scalar_at base 0 integer_value == r_emp mem_ra + `); + thm_list rewrites = THM_LIST( + pmem_scalar_at_def, + PMEM_LE_BYTES_ZERO, + PMEM_BYTES_AT_NIL); + conv simplify = rewrite_conv(rewrites); + CONV_TAC(root, simplify); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_SCALAR_AT_ZERO = + prove_pmem_scalar_at_zero(); + +PROOF static thm prove_pmem_scalar_at_suc(void) { + gnode root = gnode_new_with_ccl(` + forall (base:int) (count:num) (integer_value:int). + pmem_scalar_at base (SUC count) integer_value == + r_sep + mem_ra + (pmem_byte_at base (integer_value rem &256)) + (pmem_scalar_at + (base + &1) + count + (integer_value div &256)) + `); + thm_list rewrites = THM_LIST( + pmem_scalar_at_def, + PMEM_LE_BYTES_SUC, + PMEM_BYTES_AT_CONS); + conv simplify = rewrite_conv(rewrites); + CONV_TAC(root, simplify); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_SCALAR_AT_SUC = + prove_pmem_scalar_at_suc(); + +PROOF static thm prove_pmem_undef_scalar_at_zero(void) { + gnode root = gnode_new_with_ccl(` + forall base:int. + pmem_undef_scalar_at base 0 == r_emp mem_ra + `); + thm_list rewrites = THM_LIST(pmem_undef_scalar_at_def); + conv simplify = rewrite_conv(rewrites); + CONV_TAC(root, simplify); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_UNDEF_SCALAR_AT_ZERO = + prove_pmem_undef_scalar_at_zero(); + +PROOF static thm prove_pmem_undef_scalar_at_suc(void) { + gnode root = gnode_new_with_ccl(` + forall (base:int) (count:num). + pmem_undef_scalar_at base (SUC count) == + r_sep + mem_ra + (pmem_uninit_at base) + (pmem_undef_scalar_at (base + &1) count) + `); + thm_list rewrites = THM_LIST(pmem_undef_scalar_at_def); + conv simplify = rewrite_conv(rewrites); + CONV_TAC(root, simplify); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_UNDEF_SCALAR_AT_SUC = + prove_pmem_undef_scalar_at_suc(); + +PROOF static thm prove_pmem_undef_scalar_at_allocated(void) { + gnode root = gnode_new_with_ccl(` + forall count:num. forall base:int. + r_entails + mem_ra + (pmem_undef_scalar_at base count) + (pmem_allocated_at base count) + `); + gnode body = GEN_TAC(root, "count"); + gnode_list cases = INDUCT_TAC(body, `count:num`); + + gnode zero = GEN_TAC(cases[0], "base"); + zero = CONV_TAC(zero, rewrite_conv(THM_LIST( + PMEM_UNDEF_SCALAR_AT_ZERO, + PMEM_ALLOCATED_AT_ZERO))); + ACCEPT_TAC( + zero, + ispecl_rule( + TERM_LIST( + `mem_ra`, + `r_emp mem_ra: + (int,(pmem_byte_state)excl)finmap->bool`), + R_ENTAILS_REFL)); + + gnode step = GEN_TAC(cases[1], "base"); + step = CONV_TAC(step, rewrite_conv(THM_LIST( + PMEM_UNDEF_SCALAR_AT_SUC, + PMEM_ALLOCATED_AT_SUC))); + thm head = ispec_rule( + `base:int`, + PMEM_UNINIT_AT_ALLOCATED_BYTE); + thm induction = spec_rule( + `base + &1:int`, + assume_rule(` + forall base:int. + r_entails mem_ra + (pmem_undef_scalar_at base (n:num)) + (pmem_allocated_at base n) + `)); + ACCEPT_TAC( + step, + match_mp_rule(match_mp_rule(R_SEP_MONO, head), induction)); + return gnode_prove(root); +} + +PROOF thm PMEM_UNDEF_SCALAR_AT_ALLOCATED = + prove_pmem_undef_scalar_at_allocated(); + +PROOF static thm prove_pmem_scalar_at_allocated(void) { + gnode root = gnode_new_with_ccl(` + forall (base:int) (count:num) (integer_value:int). + r_entails + mem_ra + (pmem_scalar_at base count integer_value) + (pmem_allocated_at base count) + `); + gnode body = AUTO_INTROS_TAC(root); + thm_list definitions = THM_LIST(pmem_scalar_at_def); + conv unfold_definitions = pure_rewrite_conv(definitions); + body = CONV_TAC(body, unfold_definitions); + term bytes_tm = `pmem_le_bytes (count:num) (integer_value:int)`; + term base_tm = `base:int`; + term_list allocated_arguments = TERM_LIST(bytes_tm, base_tm); + thm allocated = ispecl_rule( + allocated_arguments, + PMEM_BYTES_AT_ALLOCATED); + thm_list length_rewrites = THM_LIST(PMEM_LE_BYTES_LENGTH); + allocated = rewrite_rule(length_rewrites, allocated); + ACCEPT_TAC(body, allocated); + thm proved = gnode_prove(root); + return proved; +} + +PROOF thm PMEM_SCALAR_AT_ALLOCATED = + prove_pmem_scalar_at_allocated(); + +/* ------------------------------------------------------------------------- */ +/* Conservative-extension audit */ +/* ------------------------------------------------------------------------- */ + +PROOF static int audit_mem_value(void) { + thm_list public_theorems = THM_LIST( + pmem_allocated_byte_at_def, + pmem_bytes_at_def, + PMEM_BYTES_AT_NIL, + PMEM_BYTES_AT_CONS, + pmem_allocated_at_def, + PMEM_ALLOCATED_AT_ZERO, + PMEM_ALLOCATED_AT_SUC, + PMEM_ALLOCATED_AT_APPEND, + PMEM_ALLOCATED_AT_SPLIT, + PMEM_UNINIT_AT_ALLOCATED_BYTE, + PMEM_BYTE_AT_ALLOCATED_BYTE, + PMEM_BYTES_AT_ALLOCATED, + pmem_le_bytes_def, + PMEM_LE_BYTES_ZERO, + PMEM_LE_BYTES_SUC, + PMEM_LE_BYTES_LENGTH, + pmem_scalar_at_def, + pmem_undef_scalar_at_def, + PMEM_SCALAR_AT_ZERO, + PMEM_SCALAR_AT_SUC, + PMEM_UNDEF_SCALAR_AT_ZERO, + PMEM_UNDEF_SCALAR_AT_SUC, + PMEM_UNDEF_SCALAR_AT_ALLOCATED, + PMEM_SCALAR_AT_ALLOCATED); + + size_t public_theorem_count = vector_size(public_theorems); + for (size_t i = 0; i < public_theorem_count; ++i) { + ENSURE_COND(!IS_NULL(public_theorems[i]), + "physical value theorem %zu is empty", i); + term_list theorem_hypotheses = hyp(public_theorems[i]); + size_t hypothesis_count = vector_size(theorem_hypotheses); + ENSURE_COND(hypothesis_count == 0, + "physical value theorem %zu has hypotheses", i); + } + thm_list final_axioms = get_all_axioms(); + size_t final_axiom_count = vector_size(final_axioms); + ENSURE_COND(final_axiom_count == MEM_VALUE_AXIOMS_BEFORE, + "physical value assertions introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_mem_value"); + return -1; +} + +PROOF static int _MEM_VALUE_AUDIT = audit_mem_value(); diff --git a/theory/c_program_logic/mem_value.h b/theory/c_program_logic/mem_value.h new file mode 100644 index 0000000..2a9ec5e --- /dev/null +++ b/theory/c_program_logic/mem_value.h @@ -0,0 +1,254 @@ +/** + * @file mem_value.h + * @brief Contiguous byte and scalar-value assertions over `mem_ra`. + * + * This module is the assertion-level bridge between exact byte ownership and + * the scalar `data_at`/`undef_data_at` atoms installed by a C-program logic. + * It deliberately contains no C type, alignment, signedness, range, combined + * physical/ghost resource, or QCP registration. Those target-dependent + * choices belong to the layer that lifts these pure `mem_ra` assertions. + * + * Addresses and scalar values are mathematical HOL integers. Scalar bytes + * use the provisional little-endian ABI described below. In particular, no + * premise that the scalar value is nonnegative is built into this theory. + * + * In this header `P ⊢_mem Q` abbreviates `r_entails mem_ra P Q` and + * `P **_mem Q` abbreviates `r_sep mem_ra P Q`. Both are documentation + * notation; the exported theorems use the `r_*` constants directly. + */ + +#pragma once + +#include "proof/theory/c_program_logic/mem_own.h" + +/* ------------------------------------------------------------------------- */ +/* Allocated bytes and contiguous regions */ +/* ------------------------------------------------------------------------- */ + +/** + * One allocated byte with unspecified initialization state: + * + * ⊢ ∀address:int. + * pmem_allocated_byte_at address = + * r_exists mem_ra + * (\state:pmem_byte_state. + * pmem_own (pmem_singleton address state)). + * + * Hence the witness may be `PMemUninit` or `PMemByte byte`. This is the + * content-forgetting assertion used for raw allocated memory. It is strictly + * weaker than the actually-uninitialized `pmem_uninit_at` assertion and is + * not the meaning of `undef_data_at`. + */ +PROOF extern thm pmem_allocated_byte_at_def; + +/* + * Exact ownership of initialized bytes at consecutive addresses: + * + * pmem_bytes_at base [] = r_emp mem_ra + * pmem_bytes_at base (byte :: bytes) = + * r_sep mem_ra + * (pmem_byte_at base byte) + * (pmem_bytes_at (base + &1) bytes). + */ +PROOF extern thm pmem_bytes_at_def; + +/** Base equation: `⊢ ∀base. pmem_bytes_at base [] = r_emp mem_ra`. */ +PROOF extern thm PMEM_BYTES_AT_NIL; + +/** + * Step equation: + * `⊢ ∀base byte bytes. pmem_bytes_at base (byte::bytes) = + * pmem_byte_at base byte **_mem pmem_bytes_at (base + &1) bytes`. + */ +PROOF extern thm PMEM_BYTES_AT_CONS; + +/* + * Exact ownership of `count` consecutive allocated bytes with unspecified + * contents: + * + * pmem_allocated_at base 0 = r_emp mem_ra + * pmem_allocated_at base (SUC count) = + * r_sep mem_ra + * (pmem_allocated_byte_at base) + * (pmem_allocated_at (base + &1) count). + */ +PROOF extern thm pmem_allocated_at_def; + +/** Base equation: `⊢ ∀base. pmem_allocated_at base 0 = r_emp mem_ra`. */ +PROOF extern thm PMEM_ALLOCATED_AT_ZERO; + +/** + * Step equation: + * `⊢ ∀base count. pmem_allocated_at base (SUC count) = + * pmem_allocated_byte_at base **_mem + * pmem_allocated_at (base + &1) count`. + */ +PROOF extern thm PMEM_ALLOCATED_AT_SUC; + +/** + * Contiguous allocated ranges compose without overlap: + * + * ```text + * ⊢ ∀m base n. + * pmem_allocated_at base (m + n) = + * r_sep mem_ra + * (pmem_allocated_at base m) + * (pmem_allocated_at (base + &m) n). + * ``` + */ +PROOF extern thm PMEM_ALLOCATED_AT_APPEND; + +/** + * Bounded split form of `PMEM_ALLOCATED_AT_APPEND`: + * + * ```text + * ⊢ ∀base n k. k ≤ n ⇒ + * pmem_allocated_at base n = + * r_sep mem_ra + * (pmem_allocated_at base k) + * (pmem_allocated_at (base + &k) (n - k)). + * ``` + */ +PROOF extern thm PMEM_ALLOCATED_AT_SPLIT; + +/* + * An actually uninitialized singleton entails unspecified allocation: + * + * ⊢ ∀address:int. + * r_entails mem_ra + * (pmem_uninit_at address) + * (pmem_allocated_byte_at address). + */ +PROOF extern thm PMEM_UNINIT_AT_ALLOCATED_BYTE; + +/* + * An initialized singleton entails unspecified allocation: + * + * ⊢ ∀(address:int) (byte:int). + * r_entails mem_ra + * (pmem_byte_at address byte) + * (pmem_allocated_byte_at address). + */ +PROOF extern thm PMEM_BYTE_AT_ALLOCATED_BYTE; + +/* + * Initialized consecutive bytes may be forgotten to allocated bytes: + * + * ⊢ ∀(bytes:int list) (base:int). + * r_entails mem_ra + * (pmem_bytes_at base bytes) + * (pmem_allocated_at base (LENGTH bytes)). + */ +PROOF extern thm PMEM_BYTES_AT_ALLOCATED; + +/* ------------------------------------------------------------------------- */ +/* Provisional little-endian scalar representation */ +/* ------------------------------------------------------------------------- */ + +/* + * `pmem_le_bytes count value` is the low `count` base-256 digits of `value`, + * least-significant digit first: + * + * pmem_le_bytes 0 value = [] + * pmem_le_bytes (SUC count) value = + * (value rem &256) :: + * pmem_le_bytes count (value div &256). + * + * Fixed-width recursion also gives negative HOL integers their usual + * truncated two's-complement byte representation; range and signedness are + * imposed only by the later C scalar-type layer. + */ +PROOF extern thm pmem_le_bytes_def; + +/** Base equation: `⊢ ∀value. pmem_le_bytes 0 value = []`. */ +PROOF extern thm PMEM_LE_BYTES_ZERO; + +/** + * Step equation: + * `⊢ ∀count value. pmem_le_bytes (SUC count) value = + * (value rem &256)::pmem_le_bytes count (value div &256)`. + */ +PROOF extern thm PMEM_LE_BYTES_SUC; + +/** `⊢ ∀(count:num)(value:int). LENGTH (pmem_le_bytes count value) = count`. */ +PROOF extern thm PMEM_LE_BYTES_LENGTH; + +/* + * Exact initialized scalar storage at byte width `count`: + * + * pmem_scalar_at base count value = + * pmem_bytes_at base (pmem_le_bytes count value). + */ +PROOF extern thm pmem_scalar_at_def; + +/* + * Strictly uninitialized scalar storage: + * + * pmem_undef_scalar_at base 0 = r_emp mem_ra + * pmem_undef_scalar_at base (SUC count) = + * r_sep mem_ra + * (pmem_uninit_at base) + * (pmem_undef_scalar_at (base + &1) count). + * + * Every owned byte is exactly `PMemUninit`; this assertion does not admit an + * initialized byte with an existentially hidden value. + */ +PROOF extern thm pmem_undef_scalar_at_def; + +/** + * Empty initialized scalar storage: + * `⊢ ∀(base:int)(value:int). pmem_scalar_at base 0 value = r_emp mem_ra`. + */ +PROOF extern thm PMEM_SCALAR_AT_ZERO; + +/* + * Little-endian head/tail equation: + * + * ⊢ ∀(base:int)(count:num)(value:int). + * pmem_scalar_at base (SUC count) value = + * r_sep mem_ra + * (pmem_byte_at base (value rem &256)) + * (pmem_scalar_at + * (base + &1) count (value div &256)). + */ +PROOF extern thm PMEM_SCALAR_AT_SUC; + +/** + * Empty uninitialized scalar storage: + * `⊢ ∀base:int. pmem_undef_scalar_at base 0 = r_emp mem_ra`. + */ +PROOF extern thm PMEM_UNDEF_SCALAR_AT_ZERO; + +/* + * Uninitialized scalar storage unfolds by one uninitialized byte: + * + * ⊢ ∀(base:int)(count:num). + * pmem_undef_scalar_at base (SUC count) = + * r_sep mem_ra + * (pmem_uninit_at base) + * (pmem_undef_scalar_at (base + &1) count). + */ +PROOF extern thm PMEM_UNDEF_SCALAR_AT_SUC; + +/** + * Strictly uninitialized storage may be weakened to arbitrary allocated + * storage without claiming that initialized storage is uninitialized: + * + * ```text + * ⊢ ∀count base. + * pmem_undef_scalar_at base count ⊢_mem + * pmem_allocated_at base count. + * ``` + */ +PROOF extern thm PMEM_UNDEF_SCALAR_AT_ALLOCATED; + +/* + * Initialized scalar contents can soundly be forgotten only to arbitrary + * allocated storage, not to uninitialized storage: + * + * ⊢ ∀(base:int) (count:num) (value:int). + * r_entails mem_ra + * (pmem_scalar_at base count value) + * (pmem_allocated_at base count). + */ +PROOF extern thm PMEM_SCALAR_AT_ALLOCATED; -- Gitee From 86b5b5bce67077494426eac911fc3bc8228f575a Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Wed, 29 Jul 2026 04:42:21 +0800 Subject: [PATCH 06/35] feat(data): add explicit integer-list theory --- theory/data/int_list.c | 173 +++++++++++++++++++++++++++++++++++++++++ theory/data/int_list.h | 42 ++++++++++ 2 files changed, 215 insertions(+) create mode 100644 theory/data/int_list.c create mode 100644 theory/data/int_list.h diff --git a/theory/data/int_list.c b/theory/data/int_list.c new file mode 100644 index 0000000..8011a6c --- /dev/null +++ b/theory/data/int_list.c @@ -0,0 +1,173 @@ +#include "proof/theory/data/int_list.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" + +PROOF static thm_list INT_LIST_INITIAL_AXIOMS = get_all_axioms(); +PROOF static size_t INT_LIST_AXIOMS_BEFORE = + vector_size(INT_LIST_INITIAL_AXIOMS); + +PROOF thm ILENGTH_DEF = new_rec_definition( + get_theorem_by_name("list_RECURSION"), + ` + (ilength ([]:(A)list) = &0) && + (ilength ((head:A) :: (tail:(A)list)) = &1 + ilength tail) + `); + +PROOF thm NTH_DEF = new_fun_definition(` + (NTH 0 ((head:A) :: (tail:(A)list)) = head) && + (NTH (SUC index) (head :: tail) = NTH index tail) +`); + +PROOF thm INTH_DEF = new_fun_definition(` + inth (index:int) (values:(A)list) = + NTH (num_of_int index) values +`); + +PROOF thm REPLACE_NTH_DEF = new_fun_definition(` + (REPLACE_NTH index (value:A) [] = []) && + (REPLACE_NTH 0 value ((head:A) :: tail) = value :: tail) && + (REPLACE_NTH (SUC index) value (head :: tail) = + head :: REPLACE_NTH index value tail) +`); + +PROOF thm REPLACE_INTH_DEF = new_fun_definition(` + replace_inth (index:int) (value:A) (values:(A)list) = + REPLACE_NTH (num_of_int index) value values +`); + +PROOF thm FIRSTN_DEF = new_fun_definition(` + (FIRSTN 0 (values:(A)list) = []) && + (FIRSTN (SUC count) ([]:(A)list) = []) && + (FIRSTN (SUC count) ((head:A) :: tail) = + head :: FIRSTN count tail) +`); + +PROOF thm IFIRSTN_DEF = new_fun_definition(` + ifirstn (count:int) (values:(A)list) = + FIRSTN (num_of_int count) values +`); + +PROOF thm SKIPN_DEF = new_fun_definition(` + (SKIPN 0 (values:(A)list) = values) && + (SKIPN (SUC count) ([]:(A)list) = []) && + (SKIPN (SUC count) ((head:A) :: tail) = SKIPN count tail) +`); + +PROOF thm ISKIPN_DEF = new_fun_definition(` + iskipn (count:int) (values:(A)list) = + SKIPN (num_of_int count) values +`); + +PROOF thm IREPLICATE_DEF = new_fun_definition(` + ireplicate (count:int) (value:A) = + REPLICATE (num_of_int count) value +`); + +PROOF thm SUBLIST_DEF = new_fun_definition(` + sublist (lower:int) (upper:int) (values:(A)list) = + SKIPN (num_of_int lower) (FIRSTN (num_of_int upper) values) +`); + +PROOF static thm prove_ilength_nonnegative(void) { + gnode root = gnode_new_with_ccl(` + forall values:(A)list. &0 <= ilength values + `); + gnode body = GEN_TAC(root, "values"); + gnode_list cases = INDUCT_TAC(body, `values:(A)list`); + + gnode reduced_base = CONV_TAC( + cases[0], + rewrite_conv(THM_LIST(conjunct1_rule(ILENGTH_DEF)))); + ACCEPT_TAC(reduced_base, int_arith_rule(`&0 <= &0`)); + + thm induction_hypothesis = assume_rule( + gnode_get_asmps(cases[1], CONST_STRING_LIST("H"))[0]); + thm successor_step = int_arith_rule(` + &0 <= ilength (a1:(A)list) ==> + &0 <= &1 + ilength a1 + `); + thm successor_nonnegative = + mp_rule(successor_step, induction_hypothesis); + thm cons_length = inst_rule( + TERM_PAIR_LIST( + (term_pair){`head:A`, `head:A`}, + (term_pair){`a1:(A)list`, `tail:(A)list`}), + conjunct2_rule(ILENGTH_DEF)); + gnode reduced_step = CONV_TAC( + cases[1], + rewrite_conv(THM_LIST( + conjunct1_rule(ILENGTH_DEF), cons_length))); + ACCEPT_TAC(reduced_step, successor_nonnegative); + return gnode_prove(root); +} + +PROOF thm ILENGTH_NONNEG = prove_ilength_nonnegative(); + +PROOF static thm prove_ilength_append(void) { + gnode root = gnode_new_with_ccl(` + forall left:(A)list. forall right:(A)list. + ilength (left ++ right) = ilength left + ilength right + `); + gnode body = GEN_TAC(root, "left"); + gnode_list cases = INDUCT_TAC(body, `left:(A)list`); + + gnode base = AUTO_INTROS_TAC(cases[0]); + gnode reduced_base = CONV_TAC(base, pure_rewrite_conv(THM_LIST( + ILENGTH_DEF, + get_theorem_by_name("APPEND"), + get_theorem_by_name("INT_ADD_LID")))); + RULE_TAC(reduced_base, int_arith_rule); + + gnode step = AUTO_INTROS_TAC(cases[1]); + gnode reduced_step = CONV_WITH_ASMP_TAC( + step, pure_rewrite_conv, THM_LIST( + ILENGTH_DEF, + get_theorem_by_name("APPEND"), + get_theorem_by_name("INT_ADD_ASSOC"))); + RULE_TAC(reduced_step, int_arith_rule); + return gnode_prove(root); +} + +PROOF thm ILENGTH_APPEND = prove_ilength_append(); + +PROOF static int int_list_register_theorems(void) { +#define REGISTER_THEOREM(name, theorem) \ + ENSURE_COND(add_theorem((name), (theorem)), \ + "duplicate integer-list theorem name: " name) + + REGISTER_THEOREM("ILENGTH_DEF", ILENGTH_DEF); + REGISTER_THEOREM("NTH_DEF", NTH_DEF); + REGISTER_THEOREM("INTH_DEF", INTH_DEF); + REGISTER_THEOREM("REPLACE_NTH_DEF", REPLACE_NTH_DEF); + REGISTER_THEOREM("REPLACE_INTH_DEF", REPLACE_INTH_DEF); + REGISTER_THEOREM("FIRSTN_DEF", FIRSTN_DEF); + REGISTER_THEOREM("IFIRSTN_DEF", IFIRSTN_DEF); + REGISTER_THEOREM("SKIPN_DEF", SKIPN_DEF); + REGISTER_THEOREM("ISKIPN_DEF", ISKIPN_DEF); + REGISTER_THEOREM("IREPLICATE_DEF", IREPLICATE_DEF); + REGISTER_THEOREM("SUBLIST_DEF", SUBLIST_DEF); + REGISTER_THEOREM("ILENGTH_NONNEG", ILENGTH_NONNEG); + REGISTER_THEOREM("ILENGTH_APPEND", ILENGTH_APPEND); + +#undef REGISTER_THEOREM + return 0; +err: + ERR_FUN_PUTS("int_list_register_theorems"); + return -1; +} + +PROOF static int _INT_LIST_THEOREMS_REGISTERED = + int_list_register_theorems(); + +PROOF static int int_list_check_axiom_free(void) { + thm_list final_axioms = get_all_axioms(); + ENSURE_COND(vector_size(final_axioms) == INT_LIST_AXIOMS_BEFORE, + "int_list introduced a new axiom"); + return 0; +err: + ERR_FUN_PUTS("int_list_check_axiom_free"); + return -1; +} + +PROOF static int _INT_LIST_AXIOM_CHECK = int_list_check_axiom_free(); diff --git a/theory/data/int_list.h b/theory/data/int_list.h new file mode 100644 index 0000000..6766c79 --- /dev/null +++ b/theory/data/int_list.h @@ -0,0 +1,42 @@ +/** + * @file int_list.h + * @brief Integer-indexed wrappers around HOL lists. + * + * This language-independent theory contains the list constants historically + * created by the OCaml C* bootstrap. Integer indices are converted with + * `num_of_int`; clients should establish nonnegativity before applying bounded + * indexing theorems. No C type, memory model, assertion model, or RA occurs + * in this module. + */ + +#pragma once + +#include "proof/proof_kernel.h" + +/** Recursive integer-valued list length. */ +PROOF extern thm ILENGTH_DEF; +/** Partial natural-number list indexing equations. */ +PROOF extern thm NTH_DEF; +/** `inth i xs = NTH (num_of_int i) xs`. */ +PROOF extern thm INTH_DEF; +/** Natural-number functional list replacement equations. */ +PROOF extern thm REPLACE_NTH_DEF; +/** `replace_inth i x xs = REPLACE_NTH (num_of_int i) x xs`. */ +PROOF extern thm REPLACE_INTH_DEF; +/** Truncating natural-number prefix equations. */ +PROOF extern thm FIRSTN_DEF; +/** Integer-indexed prefix wrapper. */ +PROOF extern thm IFIRSTN_DEF; +/** Truncating natural-number suffix equations. */ +PROOF extern thm SKIPN_DEF; +/** Integer-indexed suffix wrapper. */ +PROOF extern thm ISKIPN_DEF; +/** `ireplicate n x = REPLICATE (num_of_int n) x`. */ +PROOF extern thm IREPLICATE_DEF; +/** Absolute-endpoint slice `SKIPN lo (FIRSTN hi xs)`. */ +PROOF extern thm SUBLIST_DEF; + +/** `|- forall xs:(A)list. 0 <= ilength xs`. */ +PROOF extern thm ILENGTH_NONNEG; +/** `|- ilength (xs ++ ys) = ilength xs + ilength ys`. */ +PROOF extern thm ILENGTH_APPEND; -- Gitee From 182a2525fb2831cab1de5f3cd635cef6073ec994 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Wed, 29 Jul 2026 08:04:37 +0800 Subject: [PATCH 07/35] feat(sl): internalize pure guards in viewshifts --- proof_sl.c | 31 +++++++++++ proof_sl.h | 18 ++++++ theory/c_program_logic/c_basic_update.c | 74 +++++++++++++++++++++++++ theory/c_program_logic/c_basic_update.h | 14 +++++ 4 files changed, 137 insertions(+) diff --git a/proof_sl.c b/proof_sl.c index 2bf672c..d2bd500 100644 --- a/proof_sl.c +++ b/proof_sl.c @@ -499,6 +499,7 @@ PROOF int sl_install_update_theory(const sl_update_theory* theory) { !IS_NULL(theory->viewshift_mono) && !IS_NULL(theory->viewshift_frame) && !IS_NULL(theory->viewshift_sep) && + !IS_NULL(theory->viewshift_fact) && !IS_NULL(theory->viewshift_exists), "SL update theory contains an empty primitive theorem"); @@ -595,6 +596,18 @@ PROOF int sl_install_update_theory(const sl_update_theory* theory) { TERM_LIST(P1, Q1, P2, Q2), viewshift_sep_body); CHECK_UPDATE_PRIMITIVE(viewshift_sep, viewshift_sep_schema); + term guard = mk_var("__sl_update_guard", bool_type); + term fact_guard = mk_comb(active_sl_theory.fact, guard); + term sep_fact_P = mk_binop(active_sl_theory.sep, fact_guard, P); + term sep_fact_Q = mk_binop(active_sl_theory.sep, fact_guard, Q); + term guarded_view = mk_imp(guard, view_P_Q); + term view_sep_fact = + mk_binop(theory->viewshift, sep_fact_P, sep_fact_Q); + term viewshift_fact_body = mk_imp(guarded_view, view_sep_fact); + term viewshift_fact_schema = list_mk_forall( + TERM_LIST(guard, P, Q), viewshift_fact_body); + CHECK_UPDATE_PRIMITIVE(viewshift_fact, viewshift_fact_schema); + term viewshift_exists_ccl = concl(theory->viewshift_exists); type_list witness_types = term_tyvars(viewshift_exists_ccl); ENSURE_COND(vector_size(witness_types) == 1, @@ -1468,6 +1481,24 @@ err: return empty_theorem; } +PROOF thm viewshift_elim_fact_slrule(const term p, const thm change) { + ENSURE_COND(equals_type(type_of(p), mk_bool_type()), + "View-shift fact guard is not Boolean"); + dest_binop_results endpoints = dest_sl_viewshift(concl(change)); + thm guarded = disch_rule(p, change); + thm primitive = sl_viewshift_fact_primitive(); + thm instance = ispecl_rule( + TERM_LIST(p, endpoints.tm1, endpoints.tm2), + primitive); + return match_mp_rule(instance, guarded); +err: + ERR_FUN_PUTS( + "viewshift_elim_fact_slrule", + cstr_term(p), + cstr_thm(change)); + return empty_theorem; +} + /* Contract only the four family applications introduced by specializing a * pointwise existential law: * diff --git a/proof_sl.h b/proof_sl.h index 44846ec..c6432c5 100644 --- a/proof_sl.h +++ b/proof_sl.h @@ -192,6 +192,7 @@ PROOF typedef struct { thm viewshift_mono; thm viewshift_frame; thm viewshift_sep; + thm viewshift_fact; thm viewshift_exists; } sl_update_theory; @@ -351,6 +352,8 @@ PROOF const sl_update_theory* sl_current_update_theory(void); (sl_current_update_theory()->viewshift_frame) #define sl_viewshift_sep_primitive() \ (sl_current_update_theory()->viewshift_sep) +#define sl_viewshift_fact_primitive() \ + (sl_current_update_theory()->viewshift_fact) #define sl_viewshift_exists_primitive() \ (sl_current_update_theory()->viewshift_exists) @@ -1081,6 +1084,21 @@ PROOF thm viewshift_frame_slrule(const thm change, const term frame); */ PROOF thm viewshift_sep_slrule(const thm first, const thm second); +/** + * Internalize one Boolean hypothesis as a preserved spatial fact. + * + * ```text + * 𝒜 ⊢ P ⇛ Q + * -------------------------------- viewshift_elim_fact_slrule p + * 𝒜 ∖ {p} ⊢ fact(p) ** P ⇛ fact(p) ** Q + * ``` + * + * `p` must be Boolean and `change` must conclude an active view shift. The + * rule discharges one alpha-equivalent `p` hypothesis when present, preserves + * all other hypotheses, and uses the installed exact `viewshift_fact` law. + */ +PROOF thm viewshift_elim_fact_slrule(const term p, const thm change); + /** * Lift a pointwise universally quantified view shift through existential * assertions. diff --git a/theory/c_program_logic/c_basic_update.c b/theory/c_program_logic/c_basic_update.c index a760070..edb6f66 100644 --- a/theory/c_program_logic/c_basic_update.c +++ b/theory/c_program_logic/c_basic_update.c @@ -1164,6 +1164,79 @@ PROOF static thm prove_c_viewshift_sep(void) { PROOF thm C_VIEWSHIFT_SEP = prove_c_viewshift_sep(); +PROOF static thm prove_c_viewshift_fact(void) { + term goal_tm = ` + forall + (G:(A)ra) + (guard:bool) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). + (guard ==> c_viewshift G P Q) ==> + c_viewshift + G + (r_sep + (c_resource_ra G) + (r_fact (c_resource_ra G) guard) + P) + (r_sep + (c_resource_ra G) + (r_fact (c_resource_ra G) guard) + Q) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list cases = BOOL_CASES_TAC(body, `guard:bool`, "Hguard"); + + term ghost_ra = `G:(A)ra`; + term resource_ra = `c_resource_ra (G:(A)ra)`; + term guard = `guard:bool`; + term fact = `r_fact (c_resource_ra (G:(A)ra)) (guard:bool)`; + term source = + `P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + term target = + `Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; + + thm guarded_change = assume_rule(` + (guard:bool) ==> + c_viewshift + (G:(A)ra) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) + `); + thm selected_change = mp_rule( + guarded_change, + assume_rule(`guard:bool`)); + thm fact_refl = ispecl_rule( + TERM_LIST(ghost_ra, fact), + C_VIEWSHIFT_REFL); + thm combine = ispecl_rule( + TERM_LIST(ghost_ra, fact, fact, source, target), + C_VIEWSHIFT_SEP); + thm after_fact = mp_rule(combine, fact_refl); + ACCEPT_TAC(cases[0], mp_rule(after_fact, selected_change)); + + CONV_WITH_ASMP_TAC( + cases[1], + simp_conv, + THM_LIST( + c_viewshift_def, + r_entails_def, + r_sep_def, + r_fact_def)); + (void)resource_ra; + thm proved = gnode_prove(root); + ENSURE_COND( + equals_term(concl(proved), goal_tm), + "C_VIEWSHIFT_FACT does not exactly match its documented statement"); + return proved; +err: + ERR_FUN_PUTS("prove_c_viewshift_fact"); + return empty_theorem; +} + +PROOF thm C_VIEWSHIFT_FACT = + prove_c_viewshift_fact(); + /* Eliminate a source existential while retaining one common target. */ PROOF static thm prove_c_viewshift_exists_l(void) { term goal_tm = ` @@ -1408,6 +1481,7 @@ PROOF static int audit_c_basic_update(void) { C_VIEWSHIFT_MONO, C_VIEWSHIFT_FRAME, C_VIEWSHIFT_SEP, + C_VIEWSHIFT_FACT, C_VIEWSHIFT_EXISTS); for (size_t i = 0; i < vector_size(public_theorems); ++i) { diff --git a/theory/c_program_logic/c_basic_update.h b/theory/c_program_logic/c_basic_update.h index 65ccb7c..24f4638 100644 --- a/theory/c_program_logic/c_basic_update.h +++ b/theory/c_program_logic/c_basic_update.h @@ -126,6 +126,20 @@ PROOF extern thm C_VIEWSHIFT_FRAME; */ PROOF extern thm C_VIEWSHIFT_SEP; +/** + * Internalize a pure guard while preserving it linearly: + * + * ```text + * ⊢ ∀G p P Q. + * (p ⇒ P ⇛_G Q) ⇒ + * ((fact_G(p) **_G P) ⇛_G (fact_G(p) **_G Q)). + * ``` + * + * When `p` is false the source assertion is empty; when it is true the fact + * is the separating unit and the supplied view shift applies. + */ +PROOF extern thm C_VIEWSHIFT_FACT; + /** * Pointwise view shifts lift through an SL existential: * -- Gitee From c42ce4958018d0b97477d29425c3287e2b8e859f Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Wed, 29 Jul 2026 08:19:22 +0800 Subject: [PATCH 08/35] feat(ghost): add named-cell deallocation --- theory/c_program_logic/c_ghost_update.c | 51 +++++++++++++++++++++++++ theory/c_program_logic/c_ghost_update.h | 13 +++++++ theory/logic/ghost_heap.c | 33 ++++++++++++++++ theory/logic/ghost_heap.h | 15 ++++++++ theory/logic/ra.c | 35 +++++++++++++++++ theory/logic/ra.h | 11 ++++++ 6 files changed, 158 insertions(+) diff --git a/theory/c_program_logic/c_ghost_update.c b/theory/c_program_logic/c_ghost_update.c index 32c95eb..9789ee5 100644 --- a/theory/c_program_logic/c_ghost_update.c +++ b/theory/c_program_logic/c_ghost_update.c @@ -421,6 +421,56 @@ PROOF static thm prove_c_ghost_own_update_nd(void) { PROOF thm C_GHOST_OWN_UPDATE_ND = prove_c_ghost_own_update_nd(); +PROOF static thm prove_c_ghost_own_dealloc(void) { + term goal_tm = ` + forall (G:(A)ra) (name:num) (a:A). + c_viewshift + G + (c_ghost_own G name a) + (r_emp (c_resource_ra G)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(c_ghost_own_def))); + + term ghost_ra = `G:(A)ra`; + term source = `finmap_singleton (name:num) (a:A)`; + term empty = `finmap_empty:(num,A)finmap`; + thm heap_release = ispecl_rule( + TERM_LIST(ghost_ra, `name:num`, `a:A`), + GHOST_HEAP_DEALLOC); + thm bridge = ispecl_rule( + TERM_LIST(ghost_ra, source, empty), + C_GHOST_HEAP_OWN_UPDATE); + thm released = mp_rule(bridge, heap_release); + + thm ghost_unit = ispec_rule(ghost_ra, GHOST_HEAP_UNIT); + released = pure_once_rewrite_rule( + THM_LIST(gsym_rule(ghost_unit)), + released); + thm resource_unit = ispec_rule(ghost_ra, C_RESOURCE_RA_UNIT); + released = pure_once_rewrite_rule( + THM_LIST(gsym_rule(resource_unit)), + released); + released = pure_once_rewrite_rule( + THM_LIST(R_OWN_UNIT), + released); + ACCEPT_TAC(body, released); + thm proved = gnode_prove(root); + ENSURE_COND( + equals_term(concl(proved), goal_tm), + "C_GHOST_OWN_DEALLOC does not exactly match its documented statement"); + return proved; +err: + ERR_FUN_PUTS("prove_c_ghost_own_dealloc"); + return empty_theorem; +} + +PROOF thm C_GHOST_OWN_DEALLOC = + prove_c_ghost_own_dealloc(); + /* ------------------------------------------------------------------------- */ /* Fresh-name allocation */ /* ------------------------------------------------------------------------- */ @@ -677,6 +727,7 @@ PROOF static int audit_c_ghost_update(void) { C_GHOST_OWN_OP, C_GHOST_OWN_UPDATE, C_GHOST_OWN_UPDATE_ND, + C_GHOST_OWN_DEALLOC, C_GHOST_OWN_ALLOC_EMPTY, C_GHOST_OWN_ALLOC); diff --git a/theory/c_program_logic/c_ghost_update.h b/theory/c_program_logic/c_ghost_update.h index b0f2958..ffdd4e3 100644 --- a/theory/c_program_logic/c_ghost_update.h +++ b/theory/c_program_logic/c_ghost_update.h @@ -70,6 +70,19 @@ PROOF extern thm C_GHOST_OWN_UPDATE; */ PROOF extern thm C_GHOST_OWN_UPDATE_ND; +/** + * Release one owned named-cell fragment while preserving every hidden frame: + * + * ```text + * ⊢ ∀G name a. c_ghost_own G name a ⇛_G r_emp R_G. + * ``` + * + * This removes the caller's singleton ghost-heap resource. It does not assert + * that no compatible fragment remains at `name`, and it never changes the + * physical projection. + */ +PROOF extern thm C_GHOST_OWN_DEALLOC; + /* ------------------------------------------------------------------------- */ /* Existential ghost-cell allocation */ /* ------------------------------------------------------------------------- */ diff --git a/theory/logic/ghost_heap.c b/theory/logic/ghost_heap.c index 738c296..86175f9 100644 --- a/theory/logic/ghost_heap.c +++ b/theory/logic/ghost_heap.c @@ -216,6 +216,38 @@ PROOF static thm prove_ghost_heap_update_singleton_nd(void) { PROOF thm GHOST_HEAP_UPDATE_SINGLETON_ND = prove_ghost_heap_update_singleton_nd(); +PROOF static thm prove_ghost_heap_dealloc(void) { + term goal_tm = ` + forall (G:(A)ra) (name:num) (a:A). + ra_update + (ghost_heap_ra G) + (finmap_singleton name a) + (finmap_empty:(num,A)finmap) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm release = ispecl_rule( + TERM_LIST( + `ghost_heap_ra (G:(A)ra)`, + `finmap_singleton (name:num) (a:A)`), + RA_UPDATE_UNIT); + release = pure_once_rewrite_rule( + THM_LIST(GHOST_HEAP_UNIT), + release); + ACCEPT_TAC(body, release); + thm proved = gnode_prove(root); + ENSURE_COND( + equals_term(concl(proved), goal_tm), + "GHOST_HEAP_DEALLOC does not exactly match its documented statement"); + return proved; +err: + ERR_FUN_PUTS("prove_ghost_heap_dealloc"); + return empty_theorem; +} + +PROOF thm GHOST_HEAP_DEALLOC = + prove_ghost_heap_dealloc(); + PROOF static thm prove_ghost_heap_fresh(void) { term goal_tm = ` forall h:(num,A)finmap. @@ -529,6 +561,7 @@ PROOF static int audit_ghost_heap(void) { GHOST_HEAP_SINGLETON_UNIT_NE_EMPTY, GHOST_HEAP_UPDATE_SINGLETON, GHOST_HEAP_UPDATE_SINGLETON_ND, + GHOST_HEAP_DEALLOC, GHOST_HEAP_FRESH, GHOST_HEAP_FRESH_PAIR, GHOST_HEAP_ALLOC, diff --git a/theory/logic/ghost_heap.h b/theory/logic/ghost_heap.h index 8177216..7d18dbc 100644 --- a/theory/logic/ghost_heap.h +++ b/theory/logic/ghost_heap.h @@ -83,6 +83,21 @@ PROOF extern thm GHOST_HEAP_UPDATE_SINGLETON; */ PROOF extern thm GHOST_HEAP_UPDATE_SINGLETON_ND; +/* + * Release one completely owned singleton entry: + * + * forall (G:(A)ra) (name:num) (a:A). + * ra_update + * (ghost_heap_ra G) + * (finmap_singleton name a) + * finmap_empty + * + * Compatible hidden frames are retained. In particular, a frame may still + * own another compatible fragment at `name`; only this singleton resource is + * changed to the ghost-heap unit. + */ +PROOF extern thm GHOST_HEAP_DEALLOC; + /* `forall h. exists name. finmap_lookup h name == NONE`. */ PROOF extern thm GHOST_HEAP_FRESH; diff --git a/theory/logic/ra.c b/theory/logic/ra.c index 3a170f4..b71592e 100644 --- a/theory/logic/ra.c +++ b/theory/logic/ra.c @@ -950,6 +950,40 @@ PROOF static thm prove_ra_update_refl(void) { PROOF thm RA_UPDATE_REFL = prove_ra_update_refl(); +PROOF static thm prove_ra_update_unit(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A). + ra_update R a (ra_unit R) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_update_def))); + body = AUTO_INTROS_TAC(body); + thm frame_valid = mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `frame:A`), + RA_VALID_OP_R), + assume_rule(` + ra_valid (R:(A)ra) (ra_op R (a:A) (frame:A)) + `)); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(RA_UNIT_L))); + ACCEPT_TAC(body, frame_valid); + thm proved = gnode_prove(root); + ENSURE_COND( + equals_term(concl(proved), goal_tm), + "RA_UPDATE_UNIT does not exactly match its documented statement"); + return proved; +err: + ERR_FUN_PUTS("prove_ra_update_unit"); + return empty_theorem; +} + +PROOF thm RA_UPDATE_UNIT = + prove_ra_update_unit(); + PROOF static thm prove_ra_update_trans(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (b:A) (c:A). @@ -1354,6 +1388,7 @@ PROOF static int audit_ra_core(void) { RA_UPDATE_ND_VALID, RA_UPDATE_ND_FRAME, RA_UPDATE_REFL, + RA_UPDATE_UNIT, RA_UPDATE_TRANS, RA_UPDATE_VALID, RA_UPDATE_FRAME); diff --git a/theory/logic/ra.h b/theory/logic/ra.h index 5aae70a..53dbec1 100644 --- a/theory/logic/ra.h +++ b/theory/logic/ra.h @@ -263,6 +263,17 @@ PROOF extern thm RA_UPDATE_ND_FRAME; /* Reflexivity: `ra_update R a a`. */ PROOF extern thm RA_UPDATE_REFL; +/* + * Discard the owned component while preserving every compatible frame: + * + * forall (R:(A)ra) (a:A). + * ra_update R a (ra_unit R) + * + * This follows from downward validity: validity of `a · frame` implies + * validity of `frame`, which is exactly `unit · frame`. + */ +PROOF extern thm RA_UPDATE_UNIT; + /* Transitivity: `ra_update R a b ==> ra_update R b c ==> ra_update R a c`. */ PROOF extern thm RA_UPDATE_TRANS; -- Gitee From baae5d067b7f0694cdee6a24879b462322cd2bb3 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Wed, 29 Jul 2026 08:25:10 +0800 Subject: [PATCH 09/35] feat(ghost): expose ownership validity --- theory/c_program_logic/c_ghost_update.c | 55 +++++++++++++++++++++++++ theory/c_program_logic/c_ghost_update.h | 14 +++++++ 2 files changed, 69 insertions(+) diff --git a/theory/c_program_logic/c_ghost_update.c b/theory/c_program_logic/c_ghost_update.c index 9789ee5..fc9a903 100644 --- a/theory/c_program_logic/c_ghost_update.c +++ b/theory/c_program_logic/c_ghost_update.c @@ -42,6 +42,60 @@ PROOF static thm prove_c_ghost_own_op(void) { PROOF thm C_GHOST_OWN_OP = prove_c_ghost_own_op(); +PROOF static thm prove_c_ghost_own_valid(void) { + term goal_tm = ` + forall (G:(A)ra) (name:num) (a:A). + r_entails + (c_resource_ra G) + (c_ghost_own G name a) + (r_sep + (c_resource_ra G) + (r_fact + (c_resource_ra G) + (ra_valid G a)) + (c_ghost_own G name a)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(c_ghost_own_def))); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(R_FACT_SEP_L))); + + thm owned_valid = ispecl_rule( + TERM_LIST( + `c_resource_ra (G:(A)ra)`, + `(ra_unit mem_ra, + finmap_singleton (name:num) (a:A))`), + R_OWN_VALID); + thm fst = get_theorem_by_name("FST"); + thm snd = get_theorem_by_name("SND"); + thm and_clauses = get_theorem_by_name("AND_CLAUSES"); + owned_valid = pure_rewrite_rule( + THM_LIST( + C_RESOURCE_RA_VALID, + fst, + snd, + RA_VALID_UNIT, + GHOST_HEAP_VALID_SINGLETON, + and_clauses), + owned_valid); + ACCEPT_TAC(body, owned_valid); + thm proved = gnode_prove(root); + ENSURE_COND( + equals_term(concl(proved), goal_tm), + "C_GHOST_OWN_VALID does not exactly match its documented statement"); + return proved; +err: + ERR_FUN_PUTS("prove_c_ghost_own_valid"); + return empty_theorem; +} + +PROOF thm C_GHOST_OWN_VALID = + prove_c_ghost_own_valid(); + /* ------------------------------------------------------------------------- */ /* Fixed-name payload updates */ /* ------------------------------------------------------------------------- */ @@ -725,6 +779,7 @@ PROOF thm C_GHOST_OWN_ALLOC = PROOF static int audit_c_ghost_update(void) { thm_list public_theorems = THM_LIST( C_GHOST_OWN_OP, + C_GHOST_OWN_VALID, C_GHOST_OWN_UPDATE, C_GHOST_OWN_UPDATE_ND, C_GHOST_OWN_DEALLOC, diff --git a/theory/c_program_logic/c_ghost_update.h b/theory/c_program_logic/c_ghost_update.h index ffdd4e3..ca0cb7f 100644 --- a/theory/c_program_logic/c_ghost_update.h +++ b/theory/c_program_logic/c_ghost_update.h @@ -38,6 +38,20 @@ */ PROOF extern thm C_GHOST_OWN_OP; +/** + * Extract payload validity as a duplicable fact without consuming ownership: + * + * ```text + * ⊢ ∀G name a. + * c_ghost_own G name a ⊢_G + * r_fact R_G (ra_valid G a) **_G c_ghost_own G name a. + * ``` + * + * This is the C-resource specialization of `R_OWN_VALID`. It observes only + * the selected singleton ghost projection and preserves the physical unit. + */ +PROOF extern thm C_GHOST_OWN_VALID; + /* ------------------------------------------------------------------------- */ /* Fixed-name payload updates */ /* ------------------------------------------------------------------------- */ -- Gitee From b5a3175f8132a26c71ae9df1ca3742fa9af27ce4 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Wed, 29 Jul 2026 10:05:39 +0800 Subject: [PATCH 10/35] feat(logic): characterize exclusive inclusion --- theory/logic/excl_ra.c | 161 +++++++++++++++++++++++++++++++++++++++++ theory/logic/excl_ra.h | 12 +++ 2 files changed, 173 insertions(+) diff --git a/theory/logic/excl_ra.c b/theory/logic/excl_ra.c index 8238538..8bc2f12 100644 --- a/theory/logic/excl_ra.c +++ b/theory/logic/excl_ra.c @@ -92,6 +92,77 @@ PROOF static thm prove_excl_invalid_ne_unit(void) { PROOF thm EXCL_INVALID_NE_UNIT = prove_excl_invalid_ne_unit(); +/* Internal constructor discriminator used to derive injectivity and the + * remaining owned/invalid distinction without assuming generated theorem + * names for this user-defined datatype. */ +PROOF static thm excl_matches_def = new_rec_definition( + excl_type.rec, + ` + (excl_matches (a:A) (ExclUnit:(A)excl) <=> F) && + (excl_matches (a:A) (Excl b) <=> a == b) && + (excl_matches (a:A) ExclInvalid <=> F) + `); + +PROOF static thm prove_excl_owned_injective(void) { + term goal_tm = ` + forall a b:A. + ((Excl a:(A)excl) == Excl b) <=> a == b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Heq"); + thm observed = ap_term_rule( + `excl_matches (a:A):(A)excl->bool`, + assume_rule(`(Excl (a:A):(A)excl) == Excl (b:A)`)); + observed = rewrite_rule( + THM_LIST(excl_matches_def, get_theorem_by_name("EQ_REFL")), + observed); + ACCEPT_TAC(forward, observed); + + gnode reverse = DISCH_TAC(directions[1], "Heq"); + ACCEPT_TAC( + reverse, + ap_term_rule(`Excl:A->(A)excl`, assume_rule(`(a:A) == (b:A)`))); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "EXCL_OWNED_INJECTIVE has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_excl_owned_injective"); + return empty_theorem; +} + +PROOF static thm EXCL_OWNED_INJECTIVE = + prove_excl_owned_injective(); + +PROOF static thm prove_excl_invalid_ne_owned(void) { + term goal_tm = ` + forall a:A. + ~((ExclInvalid:(A)excl) == Excl a) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm observed = ap_term_rule( + `excl_matches (a:A):(A)excl->bool`, + assume_rule(`(ExclInvalid:(A)excl) == Excl (a:A)`)); + thm contradiction = rewrite_rule( + THM_LIST(excl_matches_def, get_theorem_by_name("EQ_REFL")), + observed); + CONTR_TAC(body, contradiction); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "EXCL_INVALID_NE_OWNED has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_excl_invalid_ne_owned"); + return empty_theorem; +} + +PROOF static thm EXCL_INVALID_NE_OWNED = + prove_excl_invalid_ne_owned(); + PROOF static conv excl_reduce_conv(void) { return rewrite_conv(THM_LIST( excl_op_def, @@ -312,6 +383,92 @@ PROOF static thm prove_excl_ra_invalid(void) { PROOF thm EXCL_RA_INVALID = prove_excl_ra_invalid(); +PROOF static thm prove_excl_ra_included_owned(void) { + term goal_tm = ` + forall a b:A. + ra_included + (excl_ra:((A)excl)ra) + (Excl a) + (Excl b) <=> + a == b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_included_def))); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hincluded"); + forward = ASMP_EXISTS_TAC(forward, "Hincluded", "frame"); + gnode_list frame_cases = CASES_TAC( + forward, `frame:(A)excl`, "Hframe"); + thm unit_frame = assume_rule(gnode_get_asmps( + frame_cases[0], CONST_STRING_LIST("Hframe"))[0]); + thm unit_extension = rewrite_rule( + THM_LIST( + unit_frame, + EXCL_RA_OP_FN, + excl_op_def, + excl_owned_op_def), + assume_rule(` + (Excl (b:A):(A)excl) == + ra_op + (excl_ra:((A)excl)ra) + (Excl (a:A)) + (frame:(A)excl)`)); + thm unit_payloads = eq_mp_rule( + ispecl_rule(TERM_LIST(`b:A`, `a:A`), EXCL_OWNED_INJECTIVE), + unit_extension); + ACCEPT_TAC(frame_cases[0], gsym_rule(unit_payloads)); + + for (size_t i = 1; i < vector_size(frame_cases); ++i) { + thm frame_eq = assume_rule(gnode_get_asmps( + frame_cases[i], CONST_STRING_LIST("Hframe"))[0]); + thm invalid_extension = rewrite_rule( + THM_LIST( + frame_eq, + EXCL_RA_OP_FN, + excl_op_def, + excl_owned_op_def), + assume_rule(` + (Excl (b:A):(A)excl) == + ra_op + (excl_ra:((A)excl)ra) + (Excl (a:A)) + (frame:(A)excl)`)); + thm impossible = not_elim_rule( + ispec_rule(`b:A`, EXCL_INVALID_NE_OWNED), + gsym_rule(invalid_extension)); + CONTR_TAC(frame_cases[i], impossible); + } + + gnode reverse = DISCH_TAC(directions[1], "Heq"); + reverse = EXISTS_TAC(reverse, `ExclUnit:(A)excl`); + thm unit_op = pure_once_rewrite_rule( + THM_LIST(EXCL_RA_UNIT), + ispecl_rule( + TERM_LIST( + `excl_ra:((A)excl)ra`, + `Excl (a:A):(A)excl`), + RA_UNIT_R)); + thm payload_eq = ap_term_rule( + `Excl:A->(A)excl`, + gsym_rule(assume_rule(`(a:A) == (b:A)`))); + ACCEPT_TAC(reverse, trans_rule(payload_eq, gsym_rule(unit_op))); + + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "EXCL_RA_INCLUDED_OWNED has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_excl_ra_included_owned"); + return empty_theorem; +} + +PROOF thm EXCL_RA_INCLUDED_OWNED = + prove_excl_ra_included_owned(); + /* Exclusive composition is cancellative on valid sources. Explicit cases * keep the proof local: an owned common frame admits only ExclUnit on the * source side, while an invalid common frame admits no valid source at all. */ @@ -450,8 +607,11 @@ PROOF static int audit_excl_ra(void) { excl_op_def, excl_valid_def, excl_is_unit_def, + excl_matches_def, EXCL_OWNED_NE_UNIT, EXCL_INVALID_NE_UNIT, + EXCL_OWNED_INJECTIVE, + EXCL_INVALID_NE_OWNED, EXCL_RA_LAWS, excl_ra_def, EXCL_RA_UNIT, @@ -461,6 +621,7 @@ PROOF static int audit_excl_ra(void) { EXCL_RA_VALID_UNIT, EXCL_RA_VALID_OWNED, EXCL_RA_INVALID, + EXCL_RA_INCLUDED_OWNED, EXCL_RA_CANCELLATIVE, EXCL_RA_UPDATE); diff --git a/theory/logic/excl_ra.h b/theory/logic/excl_ra.h index 283e7d4..224ceb8 100644 --- a/theory/logic/excl_ra.h +++ b/theory/logic/excl_ra.h @@ -50,6 +50,18 @@ PROOF extern thm EXCL_RA_INVALID; * composition can contain two owned exclusive values. */ +/* + * Inclusion between two owned values forces equality of their payloads: + * + * forall a b:A. + * ra_included excl_ra (Excl a) (Excl b) <=> a == b + * + * The only frame compatible with an owned exclusive value is `ExclUnit`. + * This rule is the public abstraction boundary used by authoritative + * protocols to recover agreement between an authority and a fragment. + */ +PROOF extern thm EXCL_RA_INCLUDED_OWNED; + /* ------------------------------------------------------------------------- */ /* Laws: optional algebraic properties */ /* ------------------------------------------------------------------------- */ -- Gitee From 9d0f3a5e52b8f1b9b9a819d37937ce4312f060d6 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Wed, 29 Jul 2026 14:44:11 +0800 Subject: [PATCH 11/35] refactor(sl): optimize existential monotonicity handling and conversion caching --- docs/SL_PROOF_SPEC.md | 6 ++- proof_backward_sl.c | 69 ++++++------------------ proof_backward_sl.h | 16 +++--- proof_sl.c | 108 +++++++++++++++++++++++++++++-------- proof_sl.h | 26 +++++++-- test/proof_sl_regression.c | 14 +++++ 6 files changed, 150 insertions(+), 89 deletions(-) diff --git a/docs/SL_PROOF_SPEC.md b/docs/SL_PROOF_SPEC.md index 84aa0bc..2e77c96 100644 --- a/docs/SL_PROOF_SPEC.md +++ b/docs/SL_PROOF_SPEC.md @@ -925,7 +925,11 @@ left to right, so `w₁` instantiates the outermost existential visible at the first step. `EXISTS_PULL_SLTAC` applies the trusted `**`/existential rewrite rules to the -consequent only. It does not rewrite any labeled antecedent. +consequent only. It uses one `PURE_REWRITE_CONV` containing exactly the active +left/right distribution theorems. Because the pure conversion has no HOL basic +rewrite net, it does not beta-reduce unrelated caller syntax. The conversion is +cached only for the current installed SL-theory generation. No labeled +antecedent is rewritten. ## 9. Conversion tactics diff --git a/proof_backward_sl.c b/proof_backward_sl.c index 3538681..e8922be 100644 --- a/proof_backward_sl.c +++ b/proof_backward_sl.c @@ -1467,63 +1467,28 @@ err: return empty_gnode; } -/* Find one pullable existential occurrence in deterministic pre-order and - * return a rule already specialized to that exact binder and frame. */ -PROOF static bool find_exists_pull_rule(const term tm, thm* rule) { - if (is_sl_sep(tm)) { - dest_binop_results operands = dest_sl_sep(tm); - if (is_sl_exists(operands.tm1)) { - *rule = sep_exists_left_slrule(operands.tm1, operands.tm2); - return true; - } - if (is_sl_exists(operands.tm2)) { - *rule = sep_exists_right_slrule(operands.tm1, operands.tm2); - return true; - } - } - if (is_comb(tm)) { - dest_comb_results application = dest_comb(tm); - if (find_exists_pull_rule(application.tm1, rule)) return true; - return find_exists_pull_rule(application.tm2, rule); - } - if (is_abs(tm)) { - dest_abs_results abstraction = dest_abs(tm); - return find_exists_pull_rule(abstraction.tm, rule); +/* PURE_REWRITE_CONV uses only the supplied distribution laws. In particular, + * it does not include HOL's basic beta rewrite, so caller-owned redexes outside + * those laws' left-hand sides are retained. Rebuild the remote conversion when + * the active assertion theory changes: its theorem handles belong to that + * theory generation. */ +PROOF static conv get_exists_pull_conv(void) { + static size_t generation = 0; + static conv value; + size_t current_generation = sl_theory_generation(); + if (IS_NULL(value) || generation != current_generation) { + value = pure_rewrite_conv( + THM_LIST(sl_sep_exists_left(), sl_sep_exists_right())); + generation = current_generation; } - return false; -} - -PROOF static thm pull_exists_eq(const term hp) { - thm result = refl_rule(hp); - term current = hp; - while (true) { - thm rule = empty_theorem; - if (!find_exists_pull_rule(current, &rule)) break; - ENSURE_COND(!IS_NULL(rule), - "Could not specialize an existential pull rule"); - conv rewrite_one = pure_once_rewrite_conv(THM_LIST(rule)); - thm step = apply_conversion(rewrite_one, current); - dest_binop_results endpoints = dest_sl_eq(concl(step)); - ENSURE_COND(alpha_compare(current, endpoints.tm2) != 0, - "Existential pull conversion made no progress"); - result = trans_rule(result, step); - current = endpoints.tm2; - } - return result; + return value; err: - ERR_FUN_PUTS("pull_exists_eq", cstr_term(hp)); - return empty_theorem; + ERR_FUN_PUTS("get_exists_pull_conv"); + return empty_conversion; } PROOF gnode EXISTS_PULL_SLTAC(const gnode gn) { - sl_goal_view view = dest_sl_goal(gn->g); - thm pulled = pull_exists_eq(view.hcon); - ENSURE_COND(!IS_NULL(pulled), - "Could not construct the existential pull equality"); - dest_binop_results endpoints = dest_sl_eq(concl(pulled)); - if (equals_term(endpoints.tm1, endpoints.tm2)) return gn; - conv exact_rewrite = pure_once_rewrite_conv(THM_LIST(pulled)); - return HCON_CONV_SLTAC(gn, exact_rewrite); + return HCON_CONV_SLTAC(gn, get_exists_pull_conv()); err: ERR_FUN_PUTS("EXISTS_PULL_SLTAC", cstr_gnode(gn)); return empty_gnode; diff --git a/proof_backward_sl.h b/proof_backward_sl.h index 51495ec..23e5c61 100644 --- a/proof_backward_sl.h +++ b/proof_backward_sl.h @@ -593,15 +593,13 @@ PROOF gnode LIST_EXISTS_SLTAC(const gnode gn, const term_list wits); * Pull consequent existentials outward through separating conjunction. * * Rewrite only the consequent until every existential movable through `**` is - * outermost. At each occurrence, specialize the active distribution theorem - * to the actual binder and frame. Only family applications introduced by that - * specialization are beta-contracted; caller-owned body/frame redexes are - * retained. Rewriting uses only the resulting exact equality, without HOL's - * basic rewrite net or generic beta normalization. - * Do not rewrite Γ or Δ. A consequent with no pullable occurrence is returned - * unchanged. Fail if the goal is not an SL goal or a required local theorem - * cannot be constructed or validated. No conversion is cached across theory - * generations. + * outermost. A single `PURE_REWRITE_CONV` uses only the active left/right + * existential-distribution laws; HOL's basic rewrite net, including its beta + * rewrite, is not present. Consequently caller-owned beta-redexes that do not + * match those laws are retained. The remote conversion is reused within one + * installed SL-theory generation and rebuilt after the generation changes. + * Do not rewrite Γ or Δ. Fail if the goal is not an SL goal or the conversion + * result cannot be validated. */ PROOF gnode EXISTS_PULL_SLTAC(const gnode gn); diff --git a/proof_sl.c b/proof_sl.c index d2bd500..5b0b554 100644 --- a/proof_sl.c +++ b/proof_sl.c @@ -33,6 +33,9 @@ PROOF thm sl_conj2; PROOF thm sl_disj1_mono; PROOF thm sl_disj2_mono; PROOF thm sl_exists_wit; +/* Internal eta-short form used to instantiate existential monotonicity + * without repairing both endpoints after every binder. */ +PROOF static thm sl_exists_mono_eta; PROOF static thm prove_sl_ent_sym_left(void); PROOF static thm prove_sl_ent_restate(void); @@ -51,6 +54,7 @@ PROOF static thm prove_sl_conj2(void); PROOF static thm prove_sl_disj1_mono(void); PROOF static thm prove_sl_disj2_mono(void); PROOF static thm prove_sl_exists_wit(void); +PROOF static thm prove_sl_exists_mono_eta(void); PROOF static int sl_build_derived_theorems(void); PROOF static void sl_clear_update_theory(void) { @@ -334,6 +338,7 @@ PROOF int sl_install_theory(const sl_theory* theory) { thm previous_disj1_mono = sl_disj1_mono; thm previous_disj2_mono = sl_disj2_mono; thm previous_exists_wit = sl_exists_wit; + thm previous_exists_mono_eta = sl_exists_mono_eta; bool candidate_active = false; ENSURE_COND(theory != NULL, "SL theory bundle is null"); @@ -461,6 +466,7 @@ err: sl_disj1_mono = previous_disj1_mono; sl_disj2_mono = previous_disj2_mono; sl_exists_wit = previous_exists_wit; + sl_exists_mono_eta = previous_exists_mono_eta; } ERR_FUN_PUTS("sl_install_theory"); return -1; @@ -1984,30 +1990,61 @@ err: return empty_theorem; } -PROOF thm exists_mono_slrule(const term v, const thm ent) { +/* Apply the cached eta-short monotonicity theorem once. Specializing its + * premise introduces exactly the two redexes selected below; its endpoints + * are already `EX (\v. H)` and `EX (\v. K)`. */ +PROOF static thm exists_mono_raw_slrule(const term v, const thm ent) { term ent_tm = concl(ent); dest_binop_results h_dest = dest_sl_ent(ent_tm); term hant = h_dest.tm1; term hcon = h_dest.tm2; - thm mono = sl_exists_mono_primitive(); - // Wrap hant, hcon as functions \v. hant and \v. hcon term fn_hant = mk_abs(v, hant); term fn_hcon = mk_abs(v, hcon); // Instantiate hpA, hpA' with the function wrappers - thm inst = ispecl_rule(TERM_LIST(fn_hant, fn_hcon), mono); - inst = beta_pointwise_family_instance(inst); + thm inst = ispecl_rule( + TERM_LIST(fn_hant, fn_hcon), sl_exists_mono_eta); + conv beta = get_conversion_by_name("BETA_CONV"); + conv premise = land_conv(binder_conv(binop_conv(beta))); + inst = conv_rule(premise, inst); // GEN enforces that v is a variable and is not free in any hypothesis. thm gen = gen_rule(v, ent); - thm res_ent = match_mp_rule(inst, gen); - term exact_hant = mk_sl_exists(v, hant); - term exact_hcon = mk_sl_exists(v, hcon); - res_ent = rehant_slrule(res_ent, exact_hant); - res_ent = rehcon_slrule(res_ent, exact_hcon); - return res_ent; + return match_mp_rule(inst, gen); +err: + ERR_FUN_PUTS("exists_mono_raw_slrule", cstr_term(v), cstr_thm(ent)); + return empty_theorem; +} + +PROOF thm exists_mono_many_slrule(const term_list vs, const thm ent) { + term ent_tm = concl(ent); + dest_binop_results endpoints = dest_sl_ent(ent_tm); + thm result = ent; + + for (int i = (int)vector_size(vs) - 1; i >= 0; --i) { + result = exists_mono_raw_slrule(vs[i], result); + } + + term exact_hant = list_mk_sl_exists(vs, endpoints.tm1); + term exact_hcon = list_mk_sl_exists(vs, endpoints.tm2); + term expected = mk_sl_ent(exact_hant, exact_hcon); + term actual = concl(result); + ENSURE_COND(alpha_compare(actual, expected) == 0, + "Batch existential monotonicity concluded `%s`; expected `%s`", + string_of_term(actual), string_of_term(expected)); + if (!equals_term(actual, expected)) { + result = eq_mp_rule(alpha_rule(actual, expected), result); + } + return result; +err: + ERR_FUN_PUTS("exists_mono_many_slrule", cstr_term_list(vs), cstr_thm(ent)); + return empty_theorem; +} + +PROOF thm exists_mono_slrule(const term v, const thm ent) { + return exists_mono_many_slrule(TERM_LIST(v), ent); err: ERR_FUN_PUTS("exists_mono_slrule", cstr_term(v), cstr_thm(ent)); return empty_theorem; @@ -2189,7 +2226,44 @@ PROOF static thm prove_sl_exists_wit(void) { return result; } +/* The installed primitive intentionally has eta-long endpoints: + * + * (!x. P x |-- Q x) ==> (EX (\x. P x) |-- EX (\x. Q x)). + * + * ETA_AX is applied once to that closed schema, during theory installation, + * to obtain a reusable instantiation theorem with endpoints `EX P` and + * `EX Q`. No caller assertion participates in this rewrite. */ +PROOF static thm prove_sl_exists_mono_eta(void) { + thm eta = get_theorem_by_name("ETA_AX"); + thm result = pure_rewrite_rule(THM_LIST(eta), + sl_exists_mono_primitive()); + return result; +err: + ERR_FUN_PUTS("prove_sl_exists_mono_eta"); + return empty_theorem; +} + PROOF static int sl_build_derived_theorems(void) { + { + thm proved = prove_sl_exists_mono_eta(); + type_list witness_types = term_tyvars(concl(proved)); + ENSURE_COND(vector_size(witness_types) == 1, + "sl_exists_mono_eta must have one witness type variable"); + type A = witness_types[0]; + term P = mk_var("P", mk_fun_type(A, sl_prop())); + term Q = mk_var("Q", mk_fun_type(A, sl_prop())); + term x = mk_var("x", A); + term pointwise = mk_forall( + x, mk_sl_ent(mk_comb(P, x), mk_comb(Q, x))); + term conclusion = mk_sl_ent( + mk_icomb(sl_exists(), P), mk_icomb(sl_exists(), Q)); + term expected = list_mk_forall( + TERM_LIST(P, Q), mk_imp(pointwise, conclusion)); + int status = sl_bind_exact_derived( + "sl_exists_mono_eta", &sl_exists_mono_eta, proved, expected); + ENSURE_COND(status == 0, "Failed to bind sl_exists_mono_eta"); + } + { term H = mk_sl_prop("H"); term K = mk_sl_prop("K"); @@ -2697,17 +2771,7 @@ err: } PROOF thm list_exists_mono_slrule(const term_list vs, const thm ent) { - size_t sz = vector_size(vs); - thm res_ent = ent; - if (sz == 0) { - term ent_tm = concl(ent); - dest_sl_ent(ent_tm); - return res_ent; - } - for (int i = (int)sz - 1; i >= 0; i--) { - res_ent = exists_mono_slrule(vs[i], res_ent); - } - return res_ent; + return exists_mono_many_slrule(vs, ent); err: ERR_FUN_PUTS("list_exists_mono_slrule", cstr_term_list(vs), cstr_thm(ent)); return empty_theorem; diff --git a/proof_sl.h b/proof_sl.h index c6432c5..e3bbce4 100644 --- a/proof_sl.h +++ b/proof_sl.h @@ -1367,6 +1367,25 @@ PROOF thm sep_exists_right_slrule(const term frame, const term ehp); */ PROOF thm exists_mono_slrule(const term v, const thm ent); +/** + * Quantify both sides of an entailment over a complete binder prefix. + * + * ```text + * 𝒜 ⊢ (H ⊢SL K) + * ------------------------------------------------ exists_mono_many_slrule V + * 𝒜 ⊢ (Ex(V,H) ⊢SL Ex(V,K)) + * ``` + * + * Given `V = [x₀, …, xₙ₋₁]`, introduce the binders in that exact outer-to- + * inner order. Every `xᵢ` must be a variable absent from the theorem's + * hypotheses. The implementation uses the cached eta-short instance theorem, + * contracts only the two family applications generated at each layer, and + * validates the complete exact endpoint syntax once after the whole prefix is + * installed. Existing beta-redexes in `H` and `K` are retained. For `V = []`, + * validate and return `ent` unchanged. + */ +PROOF thm exists_mono_many_slrule(const term_list vs, const thm ent); + /** * Move every selected antecedent resource into a magic wand. * @@ -1597,11 +1616,8 @@ PROOF thm list_trans_slrule(const thm_list ents); * Given `V = [x₀, …, xₙ₋₁]` and `𝒜 ⊢ (H ⊢SL K)`, require every `xᵢ` to be a * variable not free in any hypothesis in `𝒜`. Return * `𝒜 ⊢ (Ex(V, H) ⊢SL Ex(V, K))`. Binder order follows `vs`; for `V = []` the - * input theorem is returned unchanged. Each introduction is endpoint-aligned - * back to the explicit selected-binder syntax; internal lambda applications - * from the primitive monotonicity theorem do not escape this API. A nonvariable - * binder, a binder that occurs free in 𝒜, or a malformed entailment is a prover - * error. + * input theorem is returned unchanged. This is the compatibility spelling of + * `exists_mono_many_slrule`; it has the same exact-syntax and error contract. */ PROOF thm list_exists_mono_slrule(const term_list vs, const thm ent); diff --git a/test/proof_sl_regression.c b/test/proof_sl_regression.c index 3d5f544..2d409f1 100644 --- a/test/proof_sl_regression.c +++ b/test/proof_sl_regression.c @@ -1167,6 +1167,20 @@ PROOF static void check_hol_owned_sl_checks() { equals_term(redex_mono_sides.tm2, redex_exists), "existential monotonicity reduced a caller-owned beta-redex"); + term mono_y = `mono_y:num`; + term_list mono_prefix = TERM_LIST(mono_x, mono_y); + thm redex_mono_many = exists_mono_many_slrule( + mono_prefix, refl_slrule(explicit_beta)); + dest_binop_results redex_mono_many_sides = + dest_sl_ent(concl(redex_mono_many)); + term redex_many_exists = list_mk_sl_exists( + mono_prefix, explicit_beta); + ENSURE_COND( + equals_term(redex_mono_many_sides.tm1, redex_many_exists) && + equals_term(redex_mono_many_sides.tm2, redex_many_exists), + "batch existential monotonicity changed binder order or reduced a " + "caller-owned beta-redex"); + thm redex_intro = exists_slrule(redex_exists, `0`, refl_slrule(explicit_beta)); dest_binop_results redex_intro_sides = dest_sl_ent(concl(redex_intro)); -- Gitee From a64f768f765cf1d5c7301417a1264df8b6feeac9 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Wed, 29 Jul 2026 15:18:32 +0800 Subject: [PATCH 12/35] refactor(sl): remove unused RA installation APIs --- adapter/ra_sl.c | 10 ---------- adapter/ra_sl.h | 33 +++++++-------------------------- adapter/ra_sl_scope.c | 15 --------------- adapter/ra_sl_scope.h | 19 +------------------ adapter/ra_sl_scope_internal.h | 6 +++--- 5 files changed, 11 insertions(+), 72 deletions(-) diff --git a/adapter/ra_sl.c b/adapter/ra_sl.c index b6680f9..1d8f76b 100644 --- a/adapter/ra_sl.c +++ b/adapter/ra_sl.c @@ -122,13 +122,3 @@ err: ERR_FUN_PUTS("ra_sl_build"); return -1; } - -PROOF int ra_sl_install(const term R) { - sl_theory theory; - ra_sl_build(R, &theory); - sl_install_theory(&theory); - return 0; -err: - ERR_FUN_PUTS("ra_sl_install"); - return -1; -} diff --git a/adapter/ra_sl.h b/adapter/ra_sl.h index a2c6b62..a609de4 100644 --- a/adapter/ra_sl.h +++ b/adapter/ra_sl.h @@ -1,22 +1,16 @@ /** * @file ra_sl.h - * @brief Specialize generic resource propositions as the active SL theory. + * @brief Build an SL theory from generic resource propositions. * - * `ra_sl_install R` specializes `r_emp`, `r_sep`, `r_wand`, the + * `ra_sl_build R` specializes `r_emp`, `r_sep`, `r_wand`, the * additive connectives, entailment, equivalence, facts, and their primitive * laws at one closed monomorphic resource algebra `R:(A)ra`. Assertions in - * the installed model consequently have type `A->bool`. + * the resulting model consequently have type `A->bool`. * - * The active SL signature is verification-runtime global metadata. Every - * successful installation replaces the previous signature and advances the - * generation returned by `sl_theory_generation`; generation-keyed derived-rule - * caches are rebuilt on their next use. Call this function before constructing - * SL terms or goals for a file, and do not retain such terms across an - * installation of a different RA. - * - * This adapter installs only the language-independent BI assertion theory. It - * contains no basic-update modality, C memory semantics, symbolic-state storage, - * or any dependency on the legacy heap-assertion model. + * This adapter constructs only the language-independent BI assertion theory. + * It contains no basic-update modality, C memory semantics, symbolic-state + * storage, or dependency on the legacy heap-assertion model. Installation and + * parser activation belong to the concrete assertion-model adapter. */ #pragma once @@ -37,16 +31,3 @@ * `out` violates the contract or specialization fails. */ PROOF int ra_sl_build(const term R, sl_theory* out); - -/** - * Specialize and install the resource-proposition SL theory at `R`. - * - * `R` must be a closed term with a monomorphic unary type `(A)ra`. The - * existential operator remains polymorphic only in its bound witness type; - * its assertion-resource carrier is fixed to `A`. - * - * @return Zero on success, or `-1` after setting proof error status when `R` - * has the wrong shape, is open or polymorphic, an operator cannot be - * specialized, or the resulting signature is rejected. - */ -PROOF int ra_sl_install(const term R); diff --git a/adapter/ra_sl_scope.c b/adapter/ra_sl_scope.c index d57e3f5..7c19c11 100644 --- a/adapter/ra_sl_scope.c +++ b/adapter/ra_sl_scope.c @@ -243,18 +243,3 @@ err: ERR_FUN_PUTS("ra_sl_scope_activate"); return -1; } - -PROOF int ra_sl_install_scoped(const char *scope_name, const term R) { - ra_sl_scope scope; - ra_sl_scope_prepare(scope_name, R, &scope); - ra_sl_scope_install(&scope); - ra_sl_scope_activate(&scope); - return 0; -err: - { - char *scope_name_text = cstr_string(scope_name); - char *R_text = cstr_term(R); - ERR_FUN_PUTS("ra_sl_install_scoped", scope_name_text, R_text); - return -1; - } -} diff --git a/adapter/ra_sl_scope.h b/adapter/ra_sl_scope.h index abe0239..d8bff81 100644 --- a/adapter/ra_sl_scope.h +++ b/adapter/ra_sl_scope.h @@ -1,6 +1,6 @@ /** * @file ra_sl_scope.h - * @brief Install stable closed SL aliases for one selected resource algebra. + * @brief Stable closed SL aliases for one selected resource algebra. */ #pragma once @@ -29,20 +29,3 @@ PROOF typedef struct { thm fact_def; thm pure_def; } ra_sl_scope; - -/** - * Atomically select resource-only separation logic for `R`. - * - * `scope_name` must be a nonempty ASCII identifier and `R` must be closed and - * monomorphic. The call constructs fixed constants - * `cstar_sl____`, proves and installs the corresponding - * `sl_theory`, then activates parser interfaces for the same heads. It installs - * no update theory and no C/QCP assertion descriptor. - * - * HOL definitions and parser registrations cannot be rolled back piecemeal. - * Any error is therefore proof-initialization fail-stop for this session; the - * caller must not clear it and retry a different scope. - * - * @return Zero on success, or `-1` after reporting a prover error. - */ -PROOF int ra_sl_install_scoped(const char* scope_name, const term R); diff --git a/adapter/ra_sl_scope_internal.h b/adapter/ra_sl_scope_internal.h index 8bd8f0d..694e00b 100644 --- a/adapter/ra_sl_scope_internal.h +++ b/adapter/ra_sl_scope_internal.h @@ -2,9 +2,9 @@ * @file ra_sl_scope_internal.h * @brief Internal construction phases for selected-resource installers. * - * These operations exist so the C logic installer can construct and validate - * all aliases and extra modalities before it crosses runtime/parser commit - * boundaries. Ordinary clients must use `ra_sl_install_scoped`. + * These operations let the C logic installer construct and validate all + * aliases and extra modalities before it crosses runtime/parser commit + * boundaries. They are not a standalone public installation API. */ #pragma once -- Gitee From f11c5bebb986d9ba06cf4045440243e07627d596 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Wed, 29 Jul 2026 17:17:52 +0800 Subject: [PATCH 13/35] perf(sl): match installed binder heads directly --- proof_sl.c | 49 +++++++++++++++++++++++++------------- proof_sl.h | 30 ++++++++++++++--------- test/proof_sl_regression.c | 34 ++++++++++++++++++++++++++ 3 files changed, 85 insertions(+), 28 deletions(-) diff --git a/proof_sl.c b/proof_sl.c index 5b0b554..a977dbc 100644 --- a/proof_sl.c +++ b/proof_sl.c @@ -12,6 +12,8 @@ PROOF static sl_theory active_sl_theory; PROOF static bool active_sl_theory_initialized = false; PROOF static size_t active_sl_theory_generation = 0; +PROOF static const char* active_sl_exists_name = NULL; +PROOF static const char* active_sl_forall_name = NULL; PROOF static sl_update_theory active_sl_update_theory; PROOF static bool active_sl_update_theory_initialized = false; PROOF static size_t active_sl_update_theory_generation = 0; @@ -321,6 +323,8 @@ PROOF int sl_install_theory(const sl_theory* theory) { sl_theory previous_theory = active_sl_theory; bool previous_initialized = active_sl_theory_initialized; size_t previous_generation = active_sl_theory_generation; + const char* previous_exists_name = active_sl_exists_name; + const char* previous_forall_name = active_sl_forall_name; thm previous_ent_sym_left = sl_ent_sym_left; thm previous_ent_restate = sl_ent_restate; thm previous_frame_restate = sl_frame_restate; @@ -385,6 +389,8 @@ PROOF int sl_install_theory(const sl_theory* theory) { * explicitly instantiated concrete instance without imposing a parser * binder name. */ type_list exists_tyvars = term_tyvars(theory->exists_op); + ENSURE_COND(is_const(theory->exists_op), + "SL existential operator must be a HOL constant"); ENSURE_COND(vector_size(exists_tyvars) == 1, "SL existential operator must have exactly one witness type " "variable"); @@ -397,6 +403,8 @@ PROOF int sl_install_theory(const sl_theory* theory) { "SL existential operator has the wrong result type"); type_list forall_tyvars = term_tyvars(theory->forall_op); + ENSURE_COND(is_const(theory->forall_op), + "SL universal operator must be a HOL constant"); ENSURE_COND(vector_size(forall_tyvars) == 1, "SL universal operator must have exactly one witness type " "variable"); @@ -436,6 +444,8 @@ PROOF int sl_install_theory(const sl_theory* theory) { active_sl_theory = *theory; active_sl_theory_initialized = true; active_sl_theory_generation = previous_generation + 1; + active_sl_exists_name = GC_STRDUP(dest_const(theory->exists_op).s); + active_sl_forall_name = GC_STRDUP(dest_const(theory->forall_op).s); candidate_active = true; int derived_status = sl_build_derived_theorems(); ENSURE_COND(derived_status == 0, @@ -449,6 +459,8 @@ err: active_sl_theory = previous_theory; active_sl_theory_initialized = previous_initialized; active_sl_theory_generation = previous_generation; + active_sl_exists_name = previous_exists_name; + active_sl_forall_name = previous_forall_name; sl_ent_sym_left = previous_ent_sym_left; sl_ent_restate = previous_ent_restate; sl_frame_restate = previous_frame_restate; @@ -794,21 +806,29 @@ err: return (dest_binop_results){empty_term, empty_term}; } -PROOF bool is_sl_exists(const term tm) { +/* HOL constant names are unique within a session. The installer requires both + * binder operators to be constants and caches their names, so witness-type + * instances can be recognized without reconstructing or matching a term. */ +PROOF static bool is_sl_binder_application(const term tm, + const char* binder_name) { if (!is_comb(tm)) return false; dest_comb_results application = dest_comb(tm); if (!is_abs(application.tm2)) return false; - - /* Instantiate only the witness type; no file-local RA parameter is treated - * as a matchable term variable. Exact alpha-comparison then checks the - * application head. */ proof_try_begin(); - term expected = mk_icomb(sl_exists(), application.tm2); + dest_const_results head = dest_const(application.tm1); bool failed = NOT_OK; if (failed) SET_OK(); proof_try_end(); - return !failed && alpha_compare(expected, tm) == 0; + return !failed && strcmp(head.s, binder_name) == 0; +} + +PROOF bool is_sl_exists(const term tm) { + if (active_sl_exists_name == NULL) { + sl_current_theory(); + return false; + } + return is_sl_binder_application(tm, active_sl_exists_name); } PROOF term mk_sl_exists(const term v, const term hp) { @@ -850,16 +870,11 @@ err: } PROOF bool is_sl_forall(const term tm) { - if (!is_comb(tm)) return false; - dest_comb_results application = dest_comb(tm); - if (!is_abs(application.tm2)) return false; - - proof_try_begin(); - term expected = mk_icomb(sl_forall(), application.tm2); - bool failed = NOT_OK; - if (failed) SET_OK(); - proof_try_end(); - return !failed && alpha_compare(expected, tm) == 0; + if (active_sl_forall_name == NULL) { + sl_current_theory(); + return false; + } + return is_sl_binder_application(tm, active_sl_forall_name); } PROOF term mk_sl_forall(const term v, const term hp) { diff --git a/proof_sl.h b/proof_sl.h index e3bbce4..a293842 100644 --- a/proof_sl.h +++ b/proof_sl.h @@ -47,11 +47,13 @@ /** * One installable separation-logic signature. * - * The terms are already-specialized HOL operators. In particular, an - * RA-backed client installs `r_emp R`, `r_sep R`, ... after selecting its - * file-local resource algebra. The proof library never unfolds those - * operators and therefore has no dependency on the carrier's implementation - * or on any bootstrapped physical-heap assertion constants. + * The terms are already-specialized HOL operators. An RA-backed client first + * selects its file-local resource algebra and installs closed aliases for + * `r_emp R`, `r_sep R`, and the remaining operators. The binder aliases + * `exists_op` and `forall_op` must be HOL constants; their unique names are + * used to recognize polymorphic witness-type instances. The proof library + * never unfolds these operators and therefore has no dependency on the + * carrier's implementation or on bootstrapped physical-heap constants. * * Operator fields have these HOL types, where `Prop = prop_type`: * @@ -200,9 +202,9 @@ PROOF typedef struct { * Install a complete signature and make it active until another installation. * * Check that the assertion type is monomorphic, check all connective types, - * require `exists_op` and its five primitive laws to expose exactly one common - * polymorphic witness type in canonical eta-long schemas, and reject an empty - * primitive theorem handle. Return zero on success and + * require `exists_op` and `forall_op` to be HOL constants with exactly one + * polymorphic witness type, require their primitive laws in canonical eta-long + * schemas, and reject an empty primitive theorem handle. Return zero on success and * `-1` after reporting a prover error on failure. Before returning success, * installation proves and exact-checks every signature-dependent derived * theorem, binds the public theorem globals below, increments @@ -514,8 +516,9 @@ PROOF dest_binop_results dest_sl_or(const term hp); * Recognize an outermost SL existential. * * Recognize an application of the installed polymorphic `exists_op` to an - * abstraction. The operator's unique witness type variable is instantiated - * explicitly from the abstraction binder; no parser binder name is assumed. + * abstraction. The application head's HOL constant name is compared with the + * name cached at theory installation; witness-type instances therefore need + * no term reconstruction or matching. The abstraction is not beta-reduced. */ PROOF bool is_sl_exists(const term tm); @@ -546,7 +549,12 @@ PROOF dest_binder_results dest_sl_exists(const term hp); */ PROOF term list_mk_sl_exists(const term_list vs, const term hp); -/** Recognize an outermost installed SL universal binder. */ +/** + * Recognize an outermost installed SL universal binder. + * + * This uses the installed universal constant name with the same shape + * guarantees as `is_sl_exists` and performs no beta reduction. + */ PROOF bool is_sl_forall(const term tm); /** Return `forall_op (\v. hp)` using the installed assertion theory. */ diff --git a/test/proof_sl_regression.c b/test/proof_sl_regression.c index 2d409f1..194cd34 100644 --- a/test/proof_sl_regression.c +++ b/test/proof_sl_regression.c @@ -77,6 +77,38 @@ err: return empty_theorem; } +PROOF static void check_sl_binder_recognition() { + term hp = `hp_a:cprop`; + term int_witness = `x:int`; + term num_witness = `n:num`; + term int_exists = mk_sl_exists(int_witness, hp); + term num_exists = mk_sl_exists(num_witness, hp); + term int_forall = mk_sl_forall(int_witness, hp); + term num_forall = mk_sl_forall(num_witness, hp); + + ENSURE_COND(is_sl_exists(int_exists) && is_sl_exists(num_exists), + "SL existential recognition lost a witness type instance"); + ENSURE_COND(is_sl_forall(int_forall) && is_sl_forall(num_forall), + "SL universal recognition lost a witness type instance"); + ENSURE_COND(!is_sl_exists(int_forall) && !is_sl_forall(int_exists), + "SL exists/forall operator heads were confused"); + ENSURE_COND(!is_sl_exists(`?x:int. x == x`) && + !is_sl_forall(`!x:int. x == x`), + "A HOL boolean quantifier was accepted as an SL binder"); + + dest_binder_results exists_parts = dest_sl_exists(int_exists); + dest_binder_results forall_parts = dest_sl_forall(num_forall); + ENSURE_COND(equals_term(exists_parts.v, int_witness) && + equals_term(exists_parts.tm, hp) && + equals_term(forall_parts.v, num_witness) && + equals_term(forall_parts.tm, hp), + "SL binder recognition changed the original binder or body"); + return; +err: + ERR_FUN_PUTS("check_sl_binder_recognition"); + return; +} + PROOF static thm prove_wand_application_with_frame() { gnode root = gnode_new_with_ccl( `(hp_r:cprop) ** ((hp_a -* hp_b) ** hp_a) |-- hp_b ** hp_r`); @@ -1304,6 +1336,8 @@ PROOF int proof_sl_regression() { ENSURE_OK(""); check_dest_sl_fact_operator(); ENSURE_OK(""); + check_sl_binder_recognition(); + ENSURE_OK(""); check_hol_owned_sl_checks(); ENSURE_OK(""); check_backward_sl_rejections(); -- Gitee From b50ee526a8f7627ed4984e26c6e83d2216114bce Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Thu, 30 Jul 2026 21:03:34 +0800 Subject: [PATCH 14/35] chore(printers): remove conflicting integer printer --- printers.h | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/printers.h b/printers.h index 2c83c41..3ef7476 100644 --- a/printers.h +++ b/printers.h @@ -10,9 +10,9 @@ #include "proof/proof_kernel.h" -PROOF static inline char *cst_string_of_int(const int x) { - return cstr_int(x); -} +// PROOF static inline char *cst_string_of_int(const int x) { +// return cstr_int(x); +// } PROOF static inline char *cst_string_of_term(const term tm) { if (IS_NULL(tm)) return ""; -- Gitee From d4d874a0cbcf52789cbdc2dc0e0a7f1ef1800837 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Thu, 30 Jul 2026 22:38:23 +0800 Subject: [PATCH 15/35] minor(proof): cache shared HOL list theorems --- proof.h | 3 ++ proof_backward.c | 15 +++++++++- theory/data/int_list.c | 6 ++-- theory/data/list.c | 62 ++++++++++++++++++++++++++++++++++++++++++ theory/data/list.h | 35 ++++++++++++++++++++++++ 5 files changed, 118 insertions(+), 3 deletions(-) create mode 100644 theory/data/list.c create mode 100644 theory/data/list.h diff --git a/proof.h b/proof.h index 484f675..f5e36f6 100644 --- a/proof.h +++ b/proof.h @@ -63,6 +63,9 @@ #include "proof/proof_user.h" #require "proof/proof_user.c" +#include "proof/theory/data/list.h" +#require "proof/theory/data/list.c" + #include "proof/proof_sl.h" #require "proof/proof_sl.c" diff --git a/proof_backward.c b/proof_backward.c index 288f321..81dea23 100644 --- a/proof_backward.c +++ b/proof_backward.c @@ -1,5 +1,18 @@ #include "proof/proof_backward.h" +PROOF static thm prove_EXCLUDED_MIDDLE(void) { + thm result = get_theorem_by_name("EXCLUDED_MIDDLE"); + term expected = `!t : bool.t || ~t`; + ENSURE_COND(equals_term(concl(result), expected), + "HOL EXCLUDED_MIDDLE theorem has an unexpected conclusion"); + return result; +err: + ERR_FUN_PUTS("prove_EXCLUDED_MIDDLE", cstr_thm(result)); + return empty_theorem; +} + +PROOF static thm EXCLUDED_MIDDLE = prove_EXCLUDED_MIDDLE(); + PROOF static bool distinct_assumption_labels(const const_cstr_list lbs) { for (size_t i = 0; i < vector_size(lbs); ++i) { if (lbs[i] == NULL) return false; @@ -758,7 +771,7 @@ PROOF gnode_list DISJ_CASES_TAC(const gnode gn, const thm th, const char* lb) { } PROOF gnode_list BOOL_CASES_TAC(const gnode gn, const term tm, const char* lb) { - thm tt = ispec_rule(tm, get_EXCLUDED_MIDDLE()); + thm tt = ispec_rule(tm, EXCLUDED_MIDDLE); return DISJ_CASES_TAC(gn, tt, lb); err: ERR_FUN_PUTS("BOOL_CASES_TAC", cstr_gnode(gn), cstr_term(tm), diff --git a/theory/data/int_list.c b/theory/data/int_list.c index 8011a6c..f2e4148 100644 --- a/theory/data/int_list.c +++ b/theory/data/int_list.c @@ -1,7 +1,9 @@ #include "proof/theory/data/int_list.h" #include "proof/proof_backward.h" +#include "proof/theory/data/list.h" #require "proof/proof_backward.c" +#require "proof/theory/data/list.c" PROOF static thm_list INT_LIST_INITIAL_AXIOMS = get_all_axioms(); PROOF static size_t INT_LIST_AXIOMS_BEFORE = @@ -115,7 +117,7 @@ PROOF static thm prove_ilength_append(void) { gnode base = AUTO_INTROS_TAC(cases[0]); gnode reduced_base = CONV_TAC(base, pure_rewrite_conv(THM_LIST( ILENGTH_DEF, - get_theorem_by_name("APPEND"), + HOL_APPEND, get_theorem_by_name("INT_ADD_LID")))); RULE_TAC(reduced_base, int_arith_rule); @@ -123,7 +125,7 @@ PROOF static thm prove_ilength_append(void) { gnode reduced_step = CONV_WITH_ASMP_TAC( step, pure_rewrite_conv, THM_LIST( ILENGTH_DEF, - get_theorem_by_name("APPEND"), + HOL_APPEND, get_theorem_by_name("INT_ADD_ASSOC"))); RULE_TAC(reduced_step, int_arith_rule); return gnode_prove(root); diff --git a/theory/data/list.c b/theory/data/list.c new file mode 100644 index 0000000..f2fdc54 --- /dev/null +++ b/theory/data/list.c @@ -0,0 +1,62 @@ +#include "proof/theory/data/list.h" + +PROOF static thm prove_HOL_LENGTH(void) { + thm result = get_theorem_by_name("LENGTH"); + term expected = ` + (LENGTH ([]:(A)list) = 0) && + (!h:A. !t. LENGTH (CONS h t) = SUC (LENGTH t)) + `; + ENSURE_COND(equals_term(concl(result), expected), + "HOL LENGTH theorem has an unexpected conclusion"); + return result; +err: + ERR_FUN_PUTS("prove_HOL_LENGTH", cstr_thm(result), cstr_term(expected)); + return empty_theorem; +} + +PROOF static thm prove_HOL_APPEND(void) { + thm result = get_theorem_by_name("APPEND"); + term expected = ` + (!l:(A)list. APPEND [] l = l) && + (!h:A. !t l. APPEND (CONS h t) l = CONS h (APPEND t l)) + `; + ENSURE_COND(equals_term(concl(result), expected), + "HOL APPEND theorem has an unexpected conclusion"); + return result; +err: + ERR_FUN_PUTS("prove_HOL_APPEND", cstr_thm(result), cstr_term(expected)); + return empty_theorem; +} + +PROOF static thm prove_HOL_REVERSE(void) { + thm result = get_theorem_by_name("REVERSE"); + term expected = ` + (REVERSE ([]:(A)list) = []) && + (REVERSE (CONS (x:A) l) = APPEND (REVERSE l) (CONS x [])) + `; + ENSURE_COND(equals_term(concl(result), expected), + "HOL REVERSE theorem has an unexpected conclusion"); + return result; +err: + ERR_FUN_PUTS("prove_HOL_REVERSE", cstr_thm(result), cstr_term(expected)); + return empty_theorem; +} + +PROOF static thm prove_HOL_REPLICATE(void) { + thm result = get_theorem_by_name("REPLICATE"); + term expected = ` + (REPLICATE 0 (x:A) = []) && + (REPLICATE (SUC n) x = CONS x (REPLICATE n x)) + `; + ENSURE_COND(equals_term(concl(result), expected), + "HOL REPLICATE theorem has an unexpected conclusion"); + return result; +err: + ERR_FUN_PUTS("prove_HOL_REPLICATE", cstr_thm(result), cstr_term(expected)); + return empty_theorem; +} + +PROOF thm HOL_LENGTH = prove_HOL_LENGTH(); +PROOF thm HOL_APPEND = prove_HOL_APPEND(); +PROOF thm HOL_REVERSE = prove_HOL_REVERSE(); +PROOF thm HOL_REPLICATE = prove_HOL_REPLICATE(); diff --git a/theory/data/list.h b/theory/data/list.h new file mode 100644 index 0000000..21575e9 --- /dev/null +++ b/theory/data/list.h @@ -0,0 +1,35 @@ +/** + * @file list.h + * @brief Stable proof-stdlib bindings for HOL's primitive list equations. + * + * These language-independent theorems are resolved once during proof + * initialization. They live in the proof stdlib rather than the native + * verification runtime, so runtime initialization does not depend on which + * user-level data theory a proof happens to use. + */ + +#pragma once + +#include "proof/proof_kernel.h" + +/** + * `|- LENGTH ([]:(A)list) = 0 /\ + * (!h:A. !t. LENGTH (CONS h t) = SUC (LENGTH t))`. + */ +PROOF extern thm HOL_LENGTH; +/** + * `|- (!l:(A)list. APPEND [] l = l) /\ + * (!h:A. !t l. APPEND (CONS h t) l = CONS h (APPEND t l))`. + */ +PROOF extern thm HOL_APPEND; +/** + * `|- REVERSE ([]:(A)list) = [] /\ + * REVERSE (CONS (x:A) l) = + * APPEND (REVERSE l) (CONS x [])`. + */ +PROOF extern thm HOL_REVERSE; +/** + * `|- REPLICATE 0 (x:A) = [] /\ + * REPLICATE (SUC n) x = CONS x (REPLICATE n x)`. + */ +PROOF extern thm HOL_REPLICATE; -- Gitee From d2acb4a8de69093354e5037a87377e204788e33d Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Fri, 31 Jul 2026 08:17:15 +0800 Subject: [PATCH 16/35] feat(c-logic): define function specification markers --- theory/c_program_logic/c_fnspec.c | 33 +++++++++++++++++++++++++++++++ theory/c_program_logic/c_fnspec.h | 26 ++++++++++++++++++++++++ theory/c_program_logic/c_memory.h | 10 ++++++---- theory/c_program_logic/c_types.c | 5 ++++- theory/c_program_logic/c_types.h | 13 +++++++++--- 5 files changed, 79 insertions(+), 8 deletions(-) create mode 100644 theory/c_program_logic/c_fnspec.c create mode 100644 theory/c_program_logic/c_fnspec.h diff --git a/theory/c_program_logic/c_fnspec.c b/theory/c_program_logic/c_fnspec.c new file mode 100644 index 0000000..286bd7f --- /dev/null +++ b/theory/c_program_logic/c_fnspec.c @@ -0,0 +1,33 @@ +#include "proof/theory/c_program_logic/c_fnspec.h" + +#require "proof/theory/c_program_logic/c_resource.c" +#require "proof/theory/c_program_logic/c_types.c" + +PROOF static size_t C_FNSPEC_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF static int c_fnspec_declare_markers(void) { + type fnspec_type = parse_type( + "(A)ra->int->ctype->" + "((((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)->" + "((((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)->" + "(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)"); + new_const("c_fnspec", fnspec_type); + + type fnspec_w_type = parse_type( + "(A)ra->int->ctype->" + "(B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)->" + "(B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)->" + "(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)"); + new_const("c_fnspec_w", fnspec_w_type); + + ENSURE_COND(vector_size(get_all_axioms()) == C_FNSPEC_AXIOMS_BEFORE, + "C function-specification markers introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("c_fnspec_declare_markers"); + return -1; +} + +PROOF static int _C_FNSPEC_MARKERS_DECLARED = + c_fnspec_declare_markers(); diff --git a/theory/c_program_logic/c_fnspec.h b/theory/c_program_logic/c_fnspec.h new file mode 100644 index 0000000..049f253 --- /dev/null +++ b/theory/c_program_logic/c_fnspec.h @@ -0,0 +1,26 @@ +/** + * @file c_fnspec.h + * @brief Generic markers for QCP function-pointer specifications. + * + * For `G:(A)ra`, the implementation declares the opaque constants + * + * ```text + * c_fnspec G : + * int -> ctype -> Prop_G -> Prop_G -> Prop_G + * + * c_fnspec_w G : + * int -> ctype -> (B -> Prop_G) -> (B -> Prop_G) -> Prop_G + * ``` + * + * where `Prop_G = carrier(c_resource_ra G) -> bool`. They are deliberately + * opaque: their operational meaning is part of the certified C-logic/QCP + * boundary, not an RA or BI equation. `c_logic_install(G)` specializes them, + * creates scoped `fnspec`/`fnspec_w` aliases, and includes those aliases in the + * immutable runtime descriptor. + */ + +#pragma once + +#include "proof/theory/c_program_logic/c_resource.h" +#include "proof/theory/c_program_logic/c_types.h" + diff --git a/theory/c_program_logic/c_memory.h b/theory/c_program_logic/c_memory.h index bd63cbb..2bfa264 100644 --- a/theory/c_program_logic/c_memory.h +++ b/theory/c_program_logic/c_memory.h @@ -8,9 +8,10 @@ * Tchar, Tuchar, Tshort, Tushort, Tint, Tuint, * Tint64, Tuint64, Tptr. * - * `Tstruct` is not a scalar type. The width/min/max functions are total and - * return zero on unsupported types, but every public memory predicate carries - * an explicit scalar guard, so that fallback has no storage semantics. + * `Tstruct` and `Tfun` are not scalar object types. The width/min/max functions + * are total and return zero on unsupported types, but every public memory + * predicate carries an explicit scalar guard, so that fallback has no storage + * semantics. * * The ABI is provisional and self-contained: 8-bit bytes, little-endian * scalar representations, 16/32/64-bit integer widths, 64-bit pointers, and a @@ -55,7 +56,8 @@ PROOF extern thm pmem_ctype_distinct; * ty = Tint64 ∨ ty = Tuint64 ∨ * ty = Tptr. * - * In particular every `Tstruct name fields types` yields false. + * In particular every `Tstruct name fields types` and + * `Tfun argument_names argument_types return_type` yields false. */ PROOF extern thm pmem_c_scalar_type_def; diff --git a/theory/c_program_logic/c_types.c b/theory/c_program_logic/c_types.c index 8e7927c..b0fb31d 100644 --- a/theory/c_program_logic/c_types.c +++ b/theory/c_program_logic/c_types.c @@ -13,7 +13,8 @@ PROOF indtype ctype_type = new_datatype_definition( " | Tint64" " | Tuint64" " | Tptr" - " | Tstruct string (string)list (ctype)list"); + " | Tstruct string (string)list (ctype)list" + " | Tfun (string)list (ctype)list ctype"); PROOF static int c_types_declare_layout_constants(void) { new_tyconst("struct_name", 0); @@ -51,6 +52,8 @@ PROOF thm sizeof_def = new_fun_definition(` (sizeof Tint64 = &8) /\ (sizeof Tuint64 = &8) /\ (sizeof Tptr = &8) /\ + (!argument_names argument_types return_type. + sizeof (Tfun argument_names argument_types return_type) = &8) /\ (!name field_names field_types. sizeof (Tstruct name field_names field_types) = &(c_struct_size name field_names field_types)) diff --git a/theory/c_program_logic/c_types.h b/theory/c_program_logic/c_types.h index ab955cd..696803f 100644 --- a/theory/c_program_logic/c_types.h +++ b/theory/c_program_logic/c_types.h @@ -18,15 +18,22 @@ * ```text * ctype = Tchar | Tuchar | Tshort | Tushort | Tint | Tuint * | Tint64 | Tuint64 | Tptr - * | Tstruct string (string list) (ctype list). + * | Tstruct string (string list) (ctype list) + * | Tfun (string list) (ctype list) ctype. * ``` + * + * `Tfun argument_names argument_types return_type` is specification metadata + * for function pointers. It is not a scalar object type and therefore is not + * accepted by `data_at`; `sizeof` assigns it the provisional pointer width so + * nested function-pointer declarators can be rendered uniformly at the QCP + * boundary. */ PROOF extern indtype ctype_type; /** * Defining equations for `sizeof : ctype -> int`. Scalar sizes are 1/2/4/8 - * bytes. A structure has abstract natural size - * `&(c_struct_size name field_names field_types)`. + * bytes. `Tfun` has the provisional pointer width 8. A structure has abstract + * natural size `&(c_struct_size name field_names field_types)`. */ PROOF extern thm sizeof_def; -- Gitee From 6f6b525c414f195d3cef33ba5bae5fe3fe2befbd Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Fri, 31 Jul 2026 09:05:53 +0800 Subject: [PATCH 17/35] fix(c-logic): construct function-spec marker types safely --- theory/c_program_logic/c_fnspec.c | 65 ++++++++++++++++++++++++++----- 1 file changed, 55 insertions(+), 10 deletions(-) diff --git a/theory/c_program_logic/c_fnspec.c b/theory/c_program_logic/c_fnspec.c index 286bd7f..a988527 100644 --- a/theory/c_program_logic/c_fnspec.c +++ b/theory/c_program_logic/c_fnspec.c @@ -7,20 +7,65 @@ PROOF static size_t C_FNSPEC_AXIOMS_BEFORE = vector_size(get_all_axioms()); PROOF static int c_fnspec_declare_markers(void) { - type fnspec_type = parse_type( - "(A)ra->int->ctype->" - "((((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)->" - "((((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)->" - "(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)"); + type cell_type = mk_var_type("A"); + type parameter_type = mk_var_type("B"); + type int_type = mk_int_type(); + type num_type = mk_nat_type(); + type bool_type = mk_bool_type(); + + type_list nullary_arguments = empty_list(type); + type byte_state_type = + mk_app_type("pmem_byte_state", nullary_arguments); + type ctype_type = mk_app_type("ctype", nullary_arguments); + + type_list excl_arguments = empty_list(type); + vector_add(&excl_arguments, byte_state_type); + type byte_ownership_type = mk_app_type("excl", excl_arguments); + + type_list memory_arguments = empty_list(type); + vector_add(&memory_arguments, int_type); + vector_add(&memory_arguments, byte_ownership_type); + type memory_type = mk_app_type("finmap", memory_arguments); + + type_list ghost_heap_arguments = empty_list(type); + vector_add(&ghost_heap_arguments, num_type); + vector_add(&ghost_heap_arguments, cell_type); + type ghost_heap_type = mk_app_type("finmap", ghost_heap_arguments); + + type resource_type = mk_prod_type(memory_type, ghost_heap_type); + type assertion_type = mk_fun_type(resource_type, bool_type); + + type_list ra_arguments = empty_list(type); + vector_add(&ra_arguments, cell_type); + type ghost_ra_type = mk_app_type("ra", ra_arguments); + + type fnspec_post_type = mk_fun_type(assertion_type, assertion_type); + type fnspec_pre_type = mk_fun_type(assertion_type, fnspec_post_type); + type fnspec_ctype_type = mk_fun_type(ctype_type, fnspec_pre_type); + type fnspec_subject_type = mk_fun_type(int_type, fnspec_ctype_type); + type fnspec_type = mk_fun_type(ghost_ra_type, fnspec_subject_type); new_const("c_fnspec", fnspec_type); - type fnspec_w_type = parse_type( - "(A)ra->int->ctype->" - "(B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)->" - "(B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)->" - "(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)"); + type assertion_family_type = + mk_fun_type(parameter_type, assertion_type); + type fnspec_w_post_type = + mk_fun_type(assertion_family_type, assertion_type); + type fnspec_w_pre_type = + mk_fun_type(assertion_family_type, fnspec_w_post_type); + type fnspec_w_ctype_type = mk_fun_type(ctype_type, fnspec_w_pre_type); + type fnspec_w_subject_type = + mk_fun_type(int_type, fnspec_w_ctype_type); + type fnspec_w_type = + mk_fun_type(ghost_ra_type, fnspec_w_subject_type); new_const("c_fnspec_w", fnspec_w_type); + type installed_fnspec_type = get_const_type("c_fnspec"); + type installed_fnspec_w_type = get_const_type("c_fnspec_w"); + ENSURE_COND(equals_type(installed_fnspec_type, fnspec_type), + "installed c_fnspec marker has the wrong exact type"); + ENSURE_COND(equals_type(installed_fnspec_w_type, fnspec_w_type), + "installed c_fnspec_w marker has the wrong exact type"); + ENSURE_COND(vector_size(get_all_axioms()) == C_FNSPEC_AXIOMS_BEFORE, "C function-specification markers introduced an axiom"); return 0; -- Gitee From 3dfde51cb40d6c24794c1635179545738c2ec5a9 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Fri, 31 Jul 2026 11:47:05 +0800 Subject: [PATCH 18/35] fix(list): use native conjunction in theorem checks --- theory/data/list.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/theory/data/list.c b/theory/data/list.c index f2fdc54..bd09b0e 100644 --- a/theory/data/list.c +++ b/theory/data/list.c @@ -3,7 +3,7 @@ PROOF static thm prove_HOL_LENGTH(void) { thm result = get_theorem_by_name("LENGTH"); term expected = ` - (LENGTH ([]:(A)list) = 0) && + (LENGTH ([]:(A)list) = 0) /\ (!h:A. !t. LENGTH (CONS h t) = SUC (LENGTH t)) `; ENSURE_COND(equals_term(concl(result), expected), @@ -17,7 +17,7 @@ err: PROOF static thm prove_HOL_APPEND(void) { thm result = get_theorem_by_name("APPEND"); term expected = ` - (!l:(A)list. APPEND [] l = l) && + (!l:(A)list. APPEND [] l = l) /\ (!h:A. !t l. APPEND (CONS h t) l = CONS h (APPEND t l)) `; ENSURE_COND(equals_term(concl(result), expected), @@ -31,7 +31,7 @@ err: PROOF static thm prove_HOL_REVERSE(void) { thm result = get_theorem_by_name("REVERSE"); term expected = ` - (REVERSE ([]:(A)list) = []) && + (REVERSE ([]:(A)list) = []) /\ (REVERSE (CONS (x:A) l) = APPEND (REVERSE l) (CONS x [])) `; ENSURE_COND(equals_term(concl(result), expected), @@ -45,7 +45,7 @@ err: PROOF static thm prove_HOL_REPLICATE(void) { thm result = get_theorem_by_name("REPLICATE"); term expected = ` - (REPLICATE 0 (x:A) = []) && + (REPLICATE 0 (x:A) = []) /\ (REPLICATE (SUC n) x = CONS x (REPLICATE n x)) `; ENSURE_COND(equals_term(concl(result), expected), -- Gitee From 3b292d2012fbe264dacbef47b2c601353c6e7753 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Fri, 7 Aug 2026 19:33:23 +0800 Subject: [PATCH 19/35] feat(ra): add inclusion and update composition laws --- theory/logic/ra.c | 613 ++++++++++++++++++++++++++++++++++++++++++++-- theory/logic/ra.h | 92 ++++++- 2 files changed, 682 insertions(+), 23 deletions(-) diff --git a/theory/logic/ra.c b/theory/logic/ra.c index b71592e..a301441 100644 --- a/theory/logic/ra.c +++ b/theory/logic/ra.c @@ -340,6 +340,38 @@ PROOF static thm prove_ra_comm(void) { PROOF thm RA_COMM = prove_ra_comm(); +/* + * A compact AC-normalization rule for the common case where the leftmost + * factor should remain fixed and the two trailing factors should swap. + */ +PROOF static thm prove_ra_op_swap_right(void) { + term R = `R:(A)ra`; + term a = `a:A`; + term b = `b:A`; + term c = `c:A`; + thm associated_left = ispecl_rule( + TERM_LIST(R, a, b, c), + RA_ASSOC); + thm commute_inner = beta_rule(ap_term_rule( + `\x:A. ra_op (R:(A)ra) (a:A) x`, + ispecl_rule( + TERM_LIST(R, b, c), + RA_COMM))); + thm associated_right = gsym_rule(ispecl_rule( + TERM_LIST(R, a, c, b), + RA_ASSOC)); + thm result = trans_rule( + associated_left, + trans_rule(commute_inner, associated_right)); + result = gen_rule(c, result); + result = gen_rule(b, result); + result = gen_rule(a, result); + return gen_rule(R, result); +} + +PROOF thm RA_OP_SWAP_RIGHT = + prove_ra_op_swap_right(); + PROOF static thm prove_ra_unit_l(void) { term R = `R:(A)ra`; thm law_tail = conjunct2_rule(expanded_ra_laws(R)); @@ -421,6 +453,40 @@ PROOF static thm prove_ra_valid_op_r(void) { PROOF thm RA_VALID_OP_R = prove_ra_valid_op_r(); +/* + * Package the two one-sided downward-validity projections into one rule. + * This proof is a forward derivation: both conjuncts consume the same + * validity hypothesis and are then discharged together. + */ +PROOF static thm prove_ra_valid_op(void) { + term R = `R:(A)ra`; + term a = `a:A`; + term b = `b:A`; + term valid_pair = ` + ra_valid (R:(A)ra) (ra_op R (a:A) (b:A)) + `; + thm pair_assumption = assume_rule(valid_pair); + thm left_valid = mp_rule( + ispecl_rule( + TERM_LIST(R, a, b), + RA_VALID_OP_L), + pair_assumption); + thm right_valid = mp_rule( + ispecl_rule( + TERM_LIST(R, a, b), + RA_VALID_OP_R), + pair_assumption); + thm result = disch_rule( + valid_pair, + conj_rule(left_valid, right_valid)); + result = gen_rule(b, result); + result = gen_rule(a, result); + return gen_rule(R, result); +} + +PROOF thm RA_VALID_OP = + prove_ra_valid_op(); + /* * Apply the optional cancellativity property without exposing its quantified * definition to client proofs. The proof specializes each operand and @@ -608,6 +674,149 @@ PROOF static thm prove_ra_included_trans(void) { PROOF thm RA_INCLUDED_TRANS = prove_ra_included_trans(); +/* + * If a2 = a1 · extension, then + * + * a2 · b = (a1 · extension) · b + * = (a1 · b) · extension. + * + * Thus the original inclusion witness is also a witness after composition. + */ +PROOF static thm prove_ra_included_op_mono_l(void) { + term goal_tm = ` + forall (R:(A)ra) (a1:A) (a2:A) (b:A). + ra_included R a1 a2 ==> + ra_included R (ra_op R a1 b) (ra_op R a2 b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(ra_included_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "a1"); + body = GEN_TAC(body, "a2"); + body = GEN_TAC(body, "b"); + body = DISCH_TAC(body, "Hincluded"); + body = ASMP_EXISTS_TAC(body, "Hincluded", "extension"); + body = EXISTS_TAC(body, `extension:A`); + + thm lifted_witness = beta_rule(ap_term_rule( + `\x:A. ra_op (R:(A)ra) x (b:A)`, + assume_rule(` + (a2:A) == + ra_op (R:(A)ra) (a1:A) (extension:A) + `))); + thm swapped_extension = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a1:A`, + `extension:A`, + `b:A`), + RA_OP_SWAP_RIGHT); + ACCEPT_TAC( + body, + trans_rule(lifted_witness, swapped_extension)); + return gnode_prove(root); +} + +PROOF thm RA_INCLUDED_OP_MONO_L = + prove_ra_included_op_mono_l(); + +/* Right monotonicity is left monotonicity transported through commutativity. */ +PROOF static thm prove_ra_included_op_mono_r(void) { + term goal_tm = ` + forall (R:(A)ra) (a1:A) (a2:A) (b:A). + ra_included R a1 a2 ==> + ra_included R (ra_op R b a1) (ra_op R b a2) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm monotone_left = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a1:A`, + `a2:A`, + `b:A`), + RA_INCLUDED_OP_MONO_L), + assume_rule(`ra_included (R:(A)ra) (a1:A) (a2:A)`)); + thm commute_source = beta_rule(ap_term_rule( + `\x:A. + ra_included + (R:(A)ra) + x + (ra_op R (a2:A) (b:A))`, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a1:A`, `b:A`), + RA_COMM))); + thm commute_target = beta_rule(ap_term_rule( + `\x:A. + ra_included + (R:(A)ra) + (ra_op R (b:A) (a1:A)) + x`, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a2:A`, `b:A`), + RA_COMM))); + thm normalized = eq_mp_rule( + trans_rule(commute_source, commute_target), + monotone_left); + ACCEPT_TAC(body, normalized); + return gnode_prove(root); +} + +PROOF thm RA_INCLUDED_OP_MONO_R = + prove_ra_included_op_mono_r(); + +/* Monotonicity in both operands is the transitive closure of the two sides. */ +PROOF static thm prove_ra_included_op_mono(void) { + term goal_tm = ` + forall + (R:(A)ra) + (a1:A) + (a2:A) + (b1:A) + (b2:A). + ra_included R a1 a2 ==> + ra_included R b1 b2 ==> + ra_included R (ra_op R a1 b1) (ra_op R a2 b2) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm left_step = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a1:A`, + `a2:A`, + `b1:A`), + RA_INCLUDED_OP_MONO_L), + assume_rule(`ra_included (R:(A)ra) (a1:A) (a2:A)`)); + thm right_step = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `b1:A`, + `b2:A`, + `a2:A`), + RA_INCLUDED_OP_MONO_R), + assume_rule(`ra_included (R:(A)ra) (b1:A) (b2:A)`)); + thm result = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `ra_op (R:(A)ra) (a1:A) (b1:A)`, + `ra_op (R:(A)ra) (a2:A) (b1:A)`, + `ra_op (R:(A)ra) (a2:A) (b2:A)`), + RA_INCLUDED_TRANS); + result = mp_rule(result, left_step); + result = mp_rule(result, right_step); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm RA_INCLUDED_OP_MONO = + prove_ra_included_op_mono(); + PROOF static thm prove_ra_included_valid(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (b:A). @@ -647,6 +856,49 @@ PROOF static thm prove_ra_included_valid(void) { PROOF thm RA_INCLUDED_VALID = prove_ra_included_valid(); +/* + * Compatibility is downward closed in the owned resource. First compose + * the inclusion with the common frame, then apply ordinary downward validity. + */ +PROOF static thm prove_ra_included_valid_frame(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A) (frame:A). + ra_included R a b ==> + ra_valid R (ra_op R b frame) ==> + ra_valid R (ra_op R a frame) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm framed_inclusion = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `b:A`, + `frame:A`), + RA_INCLUDED_OP_MONO_L), + assume_rule(`ra_included (R:(A)ra) (a:A) (b:A)`)); + thm result = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `ra_op (R:(A)ra) (a:A) (frame:A)`, + `ra_op (R:(A)ra) (b:A) (frame:A)`), + RA_INCLUDED_VALID); + result = mp_rule(result, framed_inclusion); + result = mp_rule( + result, + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (b:A) (frame:A)) + `)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm RA_INCLUDED_VALID_FRAME = + prove_ra_included_valid_frame(); + /* * A predicate-valued update to a singleton is equivalent to the deterministic * update relation. Both directions are kept explicit so this bridge remains @@ -860,6 +1112,58 @@ PROOF static thm prove_ra_update_nd_mono(void) { PROOF thm RA_UPDATE_ND_MONO = prove_ra_update_nd_mono(); +/* + * A deterministic result can be embedded into any ND postcondition that + * contains it. The singleton bridge supplies the exact result, and ND + * monotonicity widens that singleton to P. + */ +PROOF static thm prove_ra_update_nd_of_update(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A) (P:A->bool). + ra_update R a b ==> + P b ==> + ra_update_nd R a P + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + thm singleton = eq_mp_rule( + sym_rule(ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `b:A`), + RA_UPDATE_ND_SINGLETON)), + assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); + term singleton_pred = `\x:A. x == (b:A)`; + thm weakened = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + singleton_pred, + `P:A->bool`), + RA_UPDATE_ND_MONO); + weakened = mp_rule(weakened, singleton); + weakened = conv_rule( + depth_conv(get_conversion_by_name("BETA_CONV")), + weakened); + body = MATCH_MP_TAC(body, weakened); + body = GEN_TAC(body, "candidate"); + body = DISCH_TAC(body, "Hcandidate"); + + thm predicate_equality = ap_term_rule( + `P:A->bool`, + assume_rule(`(candidate:A) == (b:A)`)); + thm selected = eq_mp_rule( + gsym_rule(predicate_equality), + assume_rule(`(P:A->bool) (b:A)`)); + ACCEPT_TAC(body, selected); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_ND_OF_UPDATE = + prove_ra_update_nd_of_update(); + /* * Applying an ND update to a valid source yields at least one valid selected * result. Instantiate the update with the unit frame and eliminate that @@ -950,35 +1254,60 @@ PROOF static thm prove_ra_update_refl(void) { PROOF thm RA_UPDATE_REFL = prove_ra_update_refl(); -PROOF static thm prove_ra_update_unit(void) { +/* + * A larger resource may always update to one of its included parts: every + * frame compatible with the larger source is compatible with the smaller + * target by RA_INCLUDED_VALID_FRAME. + */ +PROOF static thm prove_ra_update_included(void) { term goal_tm = ` - forall (R:(A)ra) (a:A). - ra_update R a (ra_unit R) + forall (R:(A)ra) (a:A) (b:A). + ra_included R b a ==> + ra_update R a b `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, once_rewrite_conv(THM_LIST(ra_update_def))); body = AUTO_INTROS_TAC(body); - thm frame_valid = mp_rule( - ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`, `frame:A`), - RA_VALID_OP_R), + thm result = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `b:A`, + `a:A`, + `frame:A`), + RA_INCLUDED_VALID_FRAME); + result = mp_rule( + result, + assume_rule(`ra_included (R:(A)ra) (b:A) (a:A)`)); + result = mp_rule( + result, assume_rule(` - ra_valid (R:(A)ra) (ra_op R (a:A) (frame:A)) + ra_valid + (R:(A)ra) + (ra_op R (a:A) (frame:A)) `)); - body = CONV_TAC( - body, - once_rewrite_conv(THM_LIST(RA_UNIT_L))); - ACCEPT_TAC(body, frame_valid); - thm proved = gnode_prove(root); - ENSURE_COND( - equals_term(concl(proved), goal_tm), - "RA_UPDATE_UNIT does not exactly match its documented statement"); - return proved; -err: - ERR_FUN_PUTS("prove_ra_update_unit"); - return empty_theorem; + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_INCLUDED = + prove_ra_update_included(); + +/* The unit update is the unit-inclusion instance of RA_UPDATE_INCLUDED. */ +PROOF static thm prove_ra_update_unit(void) { + term R = `R:(A)ra`; + term a = `a:A`; + thm result = ispecl_rule( + TERM_LIST(R, a, `ra_unit (R:(A)ra)`), + RA_UPDATE_INCLUDED); + result = mp_rule( + result, + ispecl_rule( + TERM_LIST(R, a), + RA_INCLUDED_UNIT)); + result = gen_rule(a, result); + return gen_rule(R, result); } PROOF thm RA_UPDATE_UNIT = @@ -1131,6 +1460,60 @@ PROOF static thm prove_ra_update_frame(void) { PROOF thm RA_UPDATE_FRAME = prove_ra_update_frame(); +/* + * Update the two operands independently. Frame the first update by c, frame + * the second by b, commute the latter source and target, and compose the two + * deterministic steps. + */ +PROOF static thm prove_ra_update_op(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A) (c:A) (d:A). + ra_update R a b ==> + ra_update R c d ==> + ra_update R (ra_op R a c) (ra_op R b d) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + thm first_step = mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `b:A`), + RA_UPDATE_FRAME), + assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); + first_step = spec_rule(`c:A`, first_step); + + thm second_step = mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `c:A`, `d:A`), + RA_UPDATE_FRAME), + assume_rule(`ra_update (R:(A)ra) (c:A) (d:A)`)); + second_step = spec_rule(`b:A`, second_step); + second_step = rewrite_rule( + THM_LIST( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `c:A`, `b:A`), + RA_COMM), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `d:A`, `b:A`), + RA_COMM)), + second_step); + + thm result = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `ra_op (R:(A)ra) (a:A) (c:A)`, + `ra_op (R:(A)ra) (b:A) (c:A)`, + `ra_op (R:(A)ra) (b:A) (d:A)`), + RA_UPDATE_TRANS); + result = mp_rule(result, first_step); + result = mp_rule(result, second_step); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_OP = + prove_ra_update_op(); + PROOF static thm prove_ra_update_nd_frame(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (P:A->bool). @@ -1230,6 +1613,184 @@ PROOF static thm prove_ra_update_nd_frame(void) { PROOF thm RA_UPDATE_ND_FRAME = prove_ra_update_nd_frame(); +/* + * Combine two independent ND updates. The first update sees c · frame as + * its hidden frame and selects b. The second then sees b · frame and selects + * d. Associativity and commutativity transport the intermediate validity + * facts to exactly those two frame shapes. + */ +PROOF static thm prove_ra_update_nd_op(void) { + term goal_tm = ` + forall + (R:(A)ra) + (a:A) + (c:A) + (P:A->bool) + (Q:A->bool). + ra_update_nd R a P ==> + ra_update_nd R c Q ==> + ra_update_nd + R + (ra_op R a c) + (\x:A. + exists b d:A. + P b && + Q d && + x == ra_op R b d) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "c"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = DISCH_TAC(body, "Ha_update"); + body = DISCH_TAC(body, "Hc_update"); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hsource_valid"); + + thm source_assoc = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `c:A`, + `frame:A`), + RA_ASSOC); + thm source_for_a = rewrite_rule( + THM_LIST(source_assoc), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R + (ra_op R (a:A) (c:A)) + (frame:A)) + `)); + thm selected_b = mp_rule( + spec_rule( + `ra_op (R:(A)ra) (c:A) (frame:A)`, + assume_rule(` + forall hidden:A. + ra_valid + (R:(A)ra) + (ra_op R (a:A) hidden) ==> + exists b:A. + (P:A->bool) b && + ra_valid R (ra_op R b hidden) + `)), + source_for_a); + body = ASSUME_TAC(body, selected_b, "Hselected_b"); + body = ASMP_EXISTS_TAC(body, "Hselected_b", "b"); + body = ASMP_CONJ_TAC( + body, + "Hselected_b", + "HP_b", + "Hb_valid"); + + thm regroup_bc = gsym_rule(ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `b:A`, + `c:A`, + `frame:A`), + RA_ASSOC)); + thm commute_bc = beta_rule(ap_term_rule( + `\x:A. ra_op (R:(A)ra) x (frame:A)`, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `b:A`, `c:A`), + RA_COMM))); + thm expose_c = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `c:A`, + `b:A`, + `frame:A`), + RA_ASSOC); + thm c_source_eq = trans_rule( + regroup_bc, + trans_rule(commute_bc, expose_c)); + thm c_source_valid = eq_mp_rule( + ap_term_rule(`ra_valid (R:(A)ra)`, c_source_eq), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R + (b:A) + (ra_op R (c:A) (frame:A))) + `)); + + thm selected_d = mp_rule( + spec_rule( + `ra_op (R:(A)ra) (b:A) (frame:A)`, + assume_rule(` + forall hidden:A. + ra_valid + (R:(A)ra) + (ra_op R (c:A) hidden) ==> + exists d:A. + (Q:A->bool) d && + ra_valid R (ra_op R d hidden) + `)), + c_source_valid); + body = ASSUME_TAC(body, selected_d, "Hselected_d"); + body = ASMP_EXISTS_TAC(body, "Hselected_d", "d"); + body = ASMP_CONJ_TAC( + body, + "Hselected_d", + "HQ_d", + "Hd_valid"); + + body = EXISTS_TAC( + body, + `ra_op (R:(A)ra) (b:A) (d:A)`); + gnode_list result_parts = CONJ_TAC(body); + + gnode predicate = EXISTS_TAC(result_parts[0], `b:A`); + predicate = EXISTS_TAC(predicate, `d:A`); + gnode_list predicate_parts = CONJ_TAC(predicate); + ACCEPT_TAC( + predicate_parts[0], + assume_rule(`(P:A->bool) (b:A)`)); + gnode_list predicate_tail = CONJ_TAC(predicate_parts[1]); + ACCEPT_TAC( + predicate_tail[0], + assume_rule(`(Q:A->bool) (d:A)`)); + CONV_TAC(predicate_tail[1], rewrite_conv(THM_LIST())); + + thm regroup_db = gsym_rule(ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `d:A`, + `b:A`, + `frame:A`), + RA_ASSOC)); + thm commute_db = beta_rule(ap_term_rule( + `\x:A. ra_op (R:(A)ra) x (frame:A)`, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `d:A`, `b:A`), + RA_COMM))); + thm result_eq = trans_rule(regroup_db, commute_db); + thm result_valid = eq_mp_rule( + ap_term_rule(`ra_valid (R:(A)ra)`, result_eq), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R + (d:A) + (ra_op R (b:A) (frame:A))) + `)); + ACCEPT_TAC(result_parts[1], result_valid); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_ND_OP = + prove_ra_update_nd_op(); + /* * Abstraction computes to the supplied descriptor only when that descriptor * satisfies the laws. For an ill-formed raw descriptor `ra_abs` still @@ -1369,29 +1930,39 @@ PROOF static int audit_ra_core(void) { RA_LAWS, RA_ASSOC, RA_COMM, + RA_OP_SWAP_RIGHT, RA_UNIT_L, RA_UNIT_R, RA_VALID_UNIT, RA_VALID_OP_L, RA_VALID_OP_R, + RA_VALID_OP, RA_CANCELLATIVE_APPLY, RA_INCLUDED_REFL, RA_INCLUDED_UNIT, RA_INCLUDED_OP_L, RA_INCLUDED_OP_R, RA_INCLUDED_TRANS, + RA_INCLUDED_OP_MONO_L, + RA_INCLUDED_OP_MONO_R, + RA_INCLUDED_OP_MONO, RA_INCLUDED_VALID, + RA_INCLUDED_VALID_FRAME, RA_UPDATE_ND_SINGLETON, RA_UPDATE_ND_REFL, RA_UPDATE_ND_TRANS, RA_UPDATE_ND_MONO, + RA_UPDATE_ND_OF_UPDATE, RA_UPDATE_ND_VALID, RA_UPDATE_ND_FRAME, + RA_UPDATE_ND_OP, RA_UPDATE_REFL, + RA_UPDATE_INCLUDED, RA_UPDATE_UNIT, RA_UPDATE_TRANS, RA_UPDATE_VALID, - RA_UPDATE_FRAME); + RA_UPDATE_FRAME, + RA_UPDATE_OP); thm_list builder_theorems = THM_LIST( ra_laws_def, RA_TYPE_BIJECTION, diff --git a/theory/logic/ra.h b/theory/logic/ra.h index 53dbec1..09aa7f3 100644 --- a/theory/logic/ra.h +++ b/theory/logic/ra.h @@ -159,6 +159,14 @@ PROOF extern thm RA_ASSOC; /* `ra_op R a b == ra_op R b a`. */ PROOF extern thm RA_COMM; +/* + * Swap the final two factors while retaining a stable left prefix: + * + * ra_op R (ra_op R a b) c == + * ra_op R (ra_op R a c) b + */ +PROOF extern thm RA_OP_SWAP_RIGHT; + /* `ra_op R (ra_unit R) a == a`. */ PROOF extern thm RA_UNIT_L; @@ -174,6 +182,17 @@ PROOF extern thm RA_VALID_OP_L; /* `ra_valid R (ra_op R a b) ==> ra_valid R b`. */ PROOF extern thm RA_VALID_OP_R; +/* + * Both components of a valid composition are valid: + * + * ra_valid R (ra_op R a b) ==> + * ra_valid R a && ra_valid R b + * + * The converse is not valid for a general RA: individually valid resources + * need not be compatible with one another. + */ +PROOF extern thm RA_VALID_OP; + /* ------------------------------------------------------------------------- */ /* Order laws */ /* ------------------------------------------------------------------------- */ @@ -199,6 +218,31 @@ PROOF extern thm RA_INCLUDED_OP_R; */ PROOF extern thm RA_INCLUDED_TRANS; +/* + * Inclusion is monotone under composition in the left operand: + * + * ra_included R a1 a2 ==> + * ra_included R (ra_op R a1 b) (ra_op R a2 b) + */ +PROOF extern thm RA_INCLUDED_OP_MONO_L; + +/* + * Inclusion is monotone under composition in the right operand: + * + * ra_included R a1 a2 ==> + * ra_included R (ra_op R b a1) (ra_op R b a2) + */ +PROOF extern thm RA_INCLUDED_OP_MONO_R; + +/* + * Inclusion is monotone in both operands: + * + * ra_included R a1 a2 ==> + * ra_included R b1 b2 ==> + * ra_included R (ra_op R a1 b1) (ra_op R a2 b2) + */ +PROOF extern thm RA_INCLUDED_OP_MONO; + /* * Validity is downward closed under inclusion: * @@ -206,6 +250,16 @@ PROOF extern thm RA_INCLUDED_TRANS; */ PROOF extern thm RA_INCLUDED_VALID; +/* + * Every frame compatible with a larger resource is compatible with an + * included resource: + * + * ra_included R a b ==> + * ra_valid R (ra_op R b frame) ==> + * ra_valid R (ra_op R a frame) + */ +PROOF extern thm RA_INCLUDED_VALID_FRAME; + /* ------------------------------------------------------------------------- */ /* Nondeterministic frame-preserving update rules */ /* ------------------------------------------------------------------------- */ @@ -238,6 +292,14 @@ PROOF extern thm RA_UPDATE_ND_TRANS; */ PROOF extern thm RA_UPDATE_ND_MONO; +/* + * Embed a deterministic update into any result predicate containing its + * target: + * + * ra_update R a b ==> P b ==> ra_update_nd R a P + */ +PROOF extern thm RA_UPDATE_ND_OF_UPDATE; + /* * An ND update of a valid source selects a valid result: * @@ -256,6 +318,16 @@ PROOF extern thm RA_UPDATE_ND_VALID; */ PROOF extern thm RA_UPDATE_ND_FRAME; +/* + * Compose two independent nondeterministic updates: + * + * ra_update_nd R a P ==> + * ra_update_nd R c Q ==> + * ra_update_nd R (ra_op R a c) + * (\x. exists b d. P b && Q d && x == ra_op R b d) + */ +PROOF extern thm RA_UPDATE_ND_OP; + /* ------------------------------------------------------------------------- */ /* Deterministic frame-preserving update rules */ /* ------------------------------------------------------------------------- */ @@ -263,14 +335,21 @@ PROOF extern thm RA_UPDATE_ND_FRAME; /* Reflexivity: `ra_update R a a`. */ PROOF extern thm RA_UPDATE_REFL; +/* + * Discard an extension while preserving every compatible frame: + * + * ra_included R b a ==> ra_update R a b + */ +PROOF extern thm RA_UPDATE_INCLUDED; + /* * Discard the owned component while preserving every compatible frame: * * forall (R:(A)ra) (a:A). * ra_update R a (ra_unit R) * - * This follows from downward validity: validity of `a · frame` implies - * validity of `frame`, which is exactly `unit · frame`. + * This is the `b = unit` corollary of `RA_UPDATE_INCLUDED` and + * `RA_INCLUDED_UNIT`. */ PROOF extern thm RA_UPDATE_UNIT; @@ -292,3 +371,12 @@ PROOF extern thm RA_UPDATE_VALID; * ra_update R (ra_op R a extra) (ra_op R b extra) */ PROOF extern thm RA_UPDATE_FRAME; + +/* + * Compose two independent deterministic updates: + * + * ra_update R a b ==> + * ra_update R c d ==> + * ra_update R (ra_op R a c) (ra_op R b d) + */ +PROOF extern thm RA_UPDATE_OP; -- Gitee From af8b2e3d049f0f5a520a464d7df699045d570eed Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Fri, 7 Aug 2026 21:21:47 +0800 Subject: [PATCH 20/35] feat(ra): extend exclusivity and agreement laws --- theory/logic/agree_ra.c | 171 +++++++++++++++++++++++++++-- theory/logic/agree_ra.h | 43 +++++++- theory/logic/excl_ra.c | 88 +++++++++------ theory/logic/excl_ra.h | 14 ++- theory/logic/frac_ra.c | 164 ++++++++++++++++------------ theory/logic/frac_ra.h | 20 ++++ theory/logic/ra.c | 232 +++++++++++++++++++++++++++++++++++++++- theory/logic/ra.h | 62 +++++++++++ theory/logic/unit_ra.c | 25 +++++ theory/logic/unit_ra.h | 10 ++ 10 files changed, 715 insertions(+), 114 deletions(-) diff --git a/theory/logic/agree_ra.c b/theory/logic/agree_ra.c index 8ff6f3d..d738af5 100644 --- a/theory/logic/agree_ra.c +++ b/theory/logic/agree_ra.c @@ -315,11 +315,13 @@ PROOF static thm prove_agree_ra_valid_fn(void) { PROOF static thm AGREE_RA_VALID_FN = prove_agree_ra_valid_fn(); -PROOF static thm prove_agree_ra_idempotent(void) { +PROOF static thm prove_agree_ra_owned_op(void) { term goal_tm = ` - forall a:A. - ra_op agree_ra (Agree a) (Agree a) == - (Agree a:(A)agree) + forall a b:A. + ra_op agree_ra (Agree a) (Agree b) == + (if a == b + then Agree a + else (AgreeInvalid:(A)agree)) `; gnode root = gnode_new_with_ccl(goal_tm); CONV_TAC( @@ -331,6 +333,22 @@ PROOF static thm prove_agree_ra_idempotent(void) { return gnode_prove(root); } +PROOF thm AGREE_RA_OWNED_OP = + prove_agree_ra_owned_op(); + +PROOF static thm prove_agree_ra_idempotent(void) { + term goal_tm = ` + forall a:A. + ra_op agree_ra (Agree a) (Agree a) == + (Agree a:(A)agree) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST(AGREE_RA_OWNED_OP))); + return gnode_prove(root); +} + PROOF thm AGREE_RA_IDEMPOTENT = prove_agree_ra_idempotent(); @@ -383,11 +401,9 @@ PROOF static thm prove_agree_ra_valid_combine_iff(void) { cases[i], rewrite_conv, THM_LIST( - AGREE_RA_OP_FN, - AGREE_RA_VALID_FN, - agree_op_def, - agree_owned_op_def, - agree_valid_def)); + AGREE_RA_OWNED_OP, + AGREE_RA_VALID_OWNED, + AGREE_RA_INVALID)); } return gnode_prove(root); } @@ -416,6 +432,138 @@ PROOF static thm prove_agree_ra_agreement(void) { PROOF thm AGREE_RA_AGREEMENT = prove_agree_ra_agreement(); +/* ------------------------------------------------------------------------- */ +/* Updates */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_agree_ra_update_iff(void) { + term goal_tm = ` + forall a b:A. + ra_update + agree_ra + (Agree a) + (Agree b) <=> + a == b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hupdate"); + thm source_op = ispec_rule( + `a:A`, + AGREE_RA_IDEMPOTENT); + thm source_valid_eq = ap_term_rule( + `ra_valid agree_ra:(A)agree->bool`, + source_op); + thm source_valid = eq_mp_rule( + sym_rule(source_valid_eq), + ispec_rule(`a:A`, AGREE_RA_VALID_OWNED)); + thm update = pure_once_rewrite_rule( + THM_LIST(ra_update_def), + assume_rule(` + ra_update + agree_ra + (Agree (a:A)) + (Agree (b:A)) + `)); + thm target_valid = mp_rule( + spec_rule(`Agree (a:A):(A)agree`, update), + source_valid); + thm target_agrees = mp_rule( + ispecl_rule( + TERM_LIST(`b:A`, `a:A`), + AGREE_RA_AGREEMENT), + target_valid); + ACCEPT_TAC(forward, sym_rule(target_agrees)); + + gnode reverse = DISCH_TAC(directions[1], "Heq"); + thm owned_eq = ap_term_rule( + `Agree:A->(A)agree`, + assume_rule(`(a:A) == (b:A)`)); + thm target_transport = beta_rule(ap_term_rule( + `\x:(A)agree. + ra_update agree_ra (Agree (a:A)) x`, + owned_eq)); + thm reflexive = ispecl_rule( + TERM_LIST( + `agree_ra:((A)agree)ra`, + `Agree (a:A):(A)agree`), + RA_UPDATE_REFL); + ACCEPT_TAC( + reverse, + eq_mp_rule(target_transport, reflexive)); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_UPDATE_IFF = + prove_agree_ra_update_iff(); + +/* ------------------------------------------------------------------------- */ +/* Order */ +/* ------------------------------------------------------------------------- */ + +/* + * An inclusion Agree a <= Agree b permits the generic update that discards + * the extension, Agree b ~~> Agree a. The exact owned-update theorem then + * forces b = a. The reverse direction is inclusion reflexivity. + */ +PROOF static thm prove_agree_ra_included_owned(void) { + term goal_tm = ` + forall a b:A. + ra_included + agree_ra + (Agree a) + (Agree b) <=> + a == b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hincluded"); + thm discard_extension = mp_rule( + ispecl_rule( + TERM_LIST( + `agree_ra:((A)agree)ra`, + `Agree (b:A):(A)agree`, + `Agree (a:A):(A)agree`), + RA_UPDATE_INCLUDED), + assume_rule(` + ra_included + agree_ra + (Agree (a:A)) + (Agree (b:A)) + `)); + thm payload_eq = eq_mp_rule( + ispecl_rule( + TERM_LIST(`b:A`, `a:A`), + AGREE_RA_UPDATE_IFF), + discard_extension); + ACCEPT_TAC(forward, sym_rule(payload_eq)); + + gnode reverse = DISCH_TAC(directions[1], "Heq"); + thm owned_eq = ap_term_rule( + `Agree:A->(A)agree`, + assume_rule(`(a:A) == (b:A)`)); + thm target_transport = beta_rule(ap_term_rule( + `\x:(A)agree. + ra_included agree_ra (Agree (a:A)) x`, + owned_eq)); + thm reflexive = ispecl_rule( + TERM_LIST( + `agree_ra:((A)agree)ra`, + `Agree (a:A):(A)agree`), + RA_INCLUDED_REFL); + ACCEPT_TAC( + reverse, + eq_mp_rule(target_transport, reflexive)); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_INCLUDED_OWNED = + prove_agree_ra_included_owned(); + PROOF static int audit_agree_ra(void) { thm_list audited_theorems = THM_LIST( agree_type.ind, @@ -428,11 +576,14 @@ PROOF static int audit_agree_ra(void) { AGREE_RA_UNIT, AGREE_RA_OP_FN, AGREE_RA_VALID_FN, + AGREE_RA_OWNED_OP, AGREE_RA_IDEMPOTENT, AGREE_RA_VALID_OWNED, AGREE_RA_INVALID, AGREE_RA_VALID_COMBINE_IFF, - AGREE_RA_AGREEMENT); + AGREE_RA_INCLUDED_OWNED, + AGREE_RA_AGREEMENT, + AGREE_RA_UPDATE_IFF); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { ENSURE_COND(!IS_NULL(audited_theorems[i]), diff --git a/theory/logic/agree_ra.h b/theory/logic/agree_ra.h index d311085..738466f 100644 --- a/theory/logic/agree_ra.h +++ b/theory/logic/agree_ra.h @@ -22,6 +22,17 @@ /* `ra_unit agree_ra == (AgreeUnit:(A)agree)`. */ PROOF extern thm AGREE_RA_UNIT; +/* + * Exact composition of two owned agreement tokens: + * + * `forall a b:A. + * ra_op agree_ra (Agree a) (Agree b) == + * (if a == b + * then Agree a + * else (AgreeInvalid:(A)agree))` + */ +PROOF extern thm AGREE_RA_OWNED_OP; + /* * `forall a:A. * ra_op agree_ra (Agree a) (Agree a) == (Agree a:(A)agree)` @@ -47,7 +58,24 @@ PROOF extern thm AGREE_RA_INVALID; PROOF extern thm AGREE_RA_VALID_COMBINE_IFF; /* ------------------------------------------------------------------------- */ -/* Laws */ +/* Order */ +/* ------------------------------------------------------------------------- */ + +/* + * Inclusion between owned agreement tokens is payload equality: + * + * `forall a b:A. + * ra_included agree_ra (Agree a) (Agree b) <=> + * a == b` + * + * This statement deliberately restricts the target to an owned token. + * Raw inclusion also permits the invalid extension + * `Agree a <= AgreeInvalid`. + */ +PROOF extern thm AGREE_RA_INCLUDED_OWNED; + +/* ------------------------------------------------------------------------- */ +/* Agreement */ /* ------------------------------------------------------------------------- */ /* @@ -63,7 +91,14 @@ PROOF extern thm AGREE_RA_AGREEMENT; /* ------------------------------------------------------------------------- */ /* - * Agreement payloads cannot in general be changed frame-preservingly. - * Generic reflexive, transitive, and framed update rules remain available - * from `ra.h`. + * Exact characterization of updates between owned agreement tokens: + * + * `forall a b:A. + * ra_update agree_ra (Agree a) (Agree b) <=> + * a == b` + * + * Necessity uses `Agree a` itself as a compatible frame. Sufficiency is the + * generic reflexive update after substituting equality. Dropping an owned + * token to `AgreeUnit` remains possible through `RA_UPDATE_INCLUDED`. */ +PROOF extern thm AGREE_RA_UPDATE_IFF; diff --git a/theory/logic/excl_ra.c b/theory/logic/excl_ra.c index 8bc2f12..ee358ea 100644 --- a/theory/logic/excl_ra.c +++ b/theory/logic/excl_ra.c @@ -383,6 +383,46 @@ PROOF static thm prove_excl_ra_invalid(void) { PROOF thm EXCL_RA_INVALID = prove_excl_ra_invalid(); +/* + * An owned exclusive element is compatible only with ExclUnit. Owned and + * invalid frames both reduce the composition to ExclInvalid, contradicting + * the compatibility premise in ra_exclusive. + */ +PROOF static thm prove_excl_ra_exclusive(void) { + term goal_tm = ` + forall a:A. + ra_exclusive + (excl_ra:((A)excl)ra) + (Excl a) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_exclusive_def))); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "frame"); + gnode_list frame_cases = CASES_TAC( + body, + `frame:(A)excl`, + "Hframe"); + for (size_t i = 0; i < vector_size(frame_cases); ++i) { + CONV_WITH_ASMP_TAC( + frame_cases[i], + rewrite_conv, + THM_LIST( + EXCL_RA_UNIT, + EXCL_RA_OP_FN, + EXCL_RA_VALID_FN, + excl_op_def, + excl_owned_op_def, + excl_valid_def)); + } + return gnode_prove(root); +} + +PROOF thm EXCL_RA_EXCLUSIVE = + prove_excl_ra_exclusive(); + PROOF static thm prove_excl_ra_included_owned(void) { term goal_tm = ` forall a b:A. @@ -564,37 +604,24 @@ PROOF static thm prove_excl_ra_cancellative(void) { PROOF thm EXCL_RA_CANCELLATIVE = prove_excl_ra_cancellative(); -/* - * Any owned exclusive value can be replaced by any other owned value. A - * frame compatible with an owned value must be ExclUnit; the other two cases - * have an invalid premise. - */ +/* Any valid target may replace an exclusive source. */ PROOF static thm prove_excl_ra_update(void) { - term goal_tm = ` - forall a b:A. - ra_update excl_ra (Excl a) (Excl b) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode unfolded = CONV_TAC( - root, - once_rewrite_conv(THM_LIST(ra_update_def))); - gnode body = GEN_TAC(unfolded, "a"); - body = GEN_TAC(body, "b"); - body = GEN_TAC(body, "frame"); - gnode_list frame_cases = CASES_TAC( - body, `frame:(A)excl`, NULL); - for (size_t i = 0; i < vector_size(frame_cases); ++i) { - CONV_WITH_ASMP_TAC( - frame_cases[i], - rewrite_conv, - THM_LIST( - EXCL_RA_OP_FN, - EXCL_RA_VALID_FN, - excl_op_def, - excl_owned_op_def, - excl_valid_def)); - } - return gnode_prove(root); + term a = `a:A`; + term b = `b:A`; + thm result = ispecl_rule( + TERM_LIST( + `excl_ra:((A)excl)ra`, + `Excl (a:A):(A)excl`, + `Excl (b:A):(A)excl`), + RA_EXCLUSIVE_UPDATE); + result = mp_rule( + result, + ispec_rule(a, EXCL_RA_EXCLUSIVE)); + result = mp_rule( + result, + ispec_rule(b, EXCL_RA_VALID_OWNED)); + result = gen_rule(b, result); + return gen_rule(a, result); } PROOF thm EXCL_RA_UPDATE = prove_excl_ra_update(); @@ -621,6 +648,7 @@ PROOF static int audit_excl_ra(void) { EXCL_RA_VALID_UNIT, EXCL_RA_VALID_OWNED, EXCL_RA_INVALID, + EXCL_RA_EXCLUSIVE, EXCL_RA_INCLUDED_OWNED, EXCL_RA_CANCELLATIVE, EXCL_RA_UPDATE); diff --git a/theory/logic/excl_ra.h b/theory/logic/excl_ra.h index 224ceb8..a78340a 100644 --- a/theory/logic/excl_ra.h +++ b/theory/logic/excl_ra.h @@ -62,6 +62,13 @@ PROOF extern thm EXCL_RA_INVALID; */ PROOF extern thm EXCL_RA_INCLUDED_OWNED; +/* ------------------------------------------------------------------------- */ +/* Exclusive elements */ +/* ------------------------------------------------------------------------- */ + +/* `forall a:A. ra_exclusive excl_ra (Excl a)`. */ +PROOF extern thm EXCL_RA_EXCLUSIVE; + /* ------------------------------------------------------------------------- */ /* Laws: optional algebraic properties */ /* ------------------------------------------------------------------------- */ @@ -73,5 +80,10 @@ PROOF extern thm EXCL_RA_CANCELLATIVE; /* Updates */ /* ------------------------------------------------------------------------- */ -/* `forall a b:A. ra_update excl_ra (Excl a) (Excl b)`. */ +/* + * `forall a b:A. ra_update excl_ra (Excl a) (Excl b)`. + * + * This is the instance of `RA_EXCLUSIVE_UPDATE` for an exclusive owned + * source and a valid owned target. + */ PROOF extern thm EXCL_RA_UPDATE; diff --git a/theory/logic/frac_ra.c b/theory/logic/frac_ra.c index 5a8e408..812c16b 100644 --- a/theory/logic/frac_ra.c +++ b/theory/logic/frac_ra.c @@ -841,6 +841,88 @@ PROOF static thm prove_frac_ra_valid_full(void) { PROOF thm FRAC_RA_VALID_FULL = prove_frac_ra_valid_full(); +/* ------------------------------------------------------------------------- */ +/* Exclusive elements */ +/* ------------------------------------------------------------------------- */ + +/* + * A full token already contributes weight one. A unit frame is therefore + * the only compatible frame: every owned frame contributes a strictly + * positive weight and would make the combined weight exceed one. + */ +PROOF static thm prove_frac_ra_exclusive_full(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A). + ra_exclusive + (frac_ra R) + (frac_full a) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_exclusive_def))); + body = AUTO_INTROS_TAC(body); + gnode_list frame_cases = CASES_TAC( + body, `frame:(A)frac`, NULL); + + thm frame_is_unit = assume_rule(` + (frame:(A)frac) == FracUnit + `); + thm ra_unit_is_unit = spec_rule( + `R:(A)ra`, + FRAC_RA_UNIT_RAW); + ACCEPT_TAC( + frame_cases[0], + trans_rule( + frame_is_unit, + sym_rule(ra_unit_is_unit))); + + thm one_value = mp_rule( + ispec_rule( + `&1:real`, + FRAC_WEIGHT_OF_REAL_VALUE), + get_theorem_by_name("REAL_LT_01")); + thm source_valid = rewrite_rule( + THM_LIST( + assume_rule(` + (frame:(A)frac) == Frac a0 a1 + `), + FRAC_RA_OP_FN, + FRAC_RA_VALID_FN, + frac_op_def, + frac_token_op_def, + frac_valid_def, + frac_full_def, + frac_own_def, + FRAC_WEIGHT_ADD_VALUE, + one_value), + assume_rule(` + ra_valid + (frac_ra (R:(A)ra)) + (ra_op + (frac_ra R) + (frac_full (a:A)) + (frame:(A)frac)) + `)); + thm frame_pos = ispec_rule( + `a0:frac_weight`, + FRAC_WEIGHT_VALUE_POS); + thm impossible = mp_rule( + mp_rule( + real_arith_rule(` + &0 < frac_weight_value (a0:frac_weight) ==> + &1 + frac_weight_value a0 <= &1 ==> + F + `), + frame_pos), + conjunct1_rule(source_valid)); + CONTR_TAC(frame_cases[1], impossible); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_EXCLUSIVE_FULL = + prove_frac_ra_exclusive_full(); + /* ------------------------------------------------------------------------- */ /* Optional algebraic properties */ /* ------------------------------------------------------------------------- */ @@ -1619,13 +1701,7 @@ PROOF static thm prove_frac_ra_update_full(void) { (frac_full (b:A)) `; gnode root = gnode_new_with_ccl(goal_tm); - gnode body = CONV_TAC( - root, - once_rewrite_conv(THM_LIST(ra_update_def))); - body = AUTO_INTROS_TAC(body); - gnode_list frame_cases = CASES_TAC( - body, `frame:(A)frac`, NULL); - + gnode body = AUTO_INTROS_TAC(root); thm target_full_valid = eq_mp_rule( sym_rule(ispecl_rule( TERM_LIST( @@ -1633,71 +1709,22 @@ PROOF static thm prove_frac_ra_update_full(void) { `b:A`), FRAC_RA_VALID_FULL)), assume_rule(`ra_valid (R:(A)ra) (b:A)`)); - thm op_unit = ispecl_rule( + thm update = ispecl_rule( TERM_LIST( `frac_ra (R:(A)ra)`, + `frac_full (a:A)`, `frac_full (b:A)`), - RA_UNIT_R); - op_unit = pure_once_rewrite_rule( - THM_LIST(spec_rule( - `R:(A)ra`, - FRAC_RA_UNIT_RAW)), - op_unit); - thm op_frame = pure_once_rewrite_rule( - THM_LIST(gsym_rule(assume_rule(` - (frame:(A)frac) == FracUnit - `))), - op_unit); - thm target_valid_eq = ap_term_rule( - `ra_valid (frac_ra (R:(A)ra)):(A)frac->bool`, - gsym_rule(op_frame)); + RA_EXCLUSIVE_UPDATE); + update = mp_rule( + update, + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`), + FRAC_RA_EXCLUSIVE_FULL)); ACCEPT_TAC( - frame_cases[0], - eq_mp_rule( - target_valid_eq, - target_full_valid)); - - thm one_value = mp_rule( - ispec_rule( - `&1:real`, - FRAC_WEIGHT_OF_REAL_VALUE), - get_theorem_by_name("REAL_LT_01")); - thm source_valid = rewrite_rule( - THM_LIST( - assume_rule(` - (frame:(A)frac) == Frac a0 a1 - `), - FRAC_RA_OP_FN, - FRAC_RA_VALID_FN, - frac_op_def, - frac_token_op_def, - frac_valid_def, - frac_full_def, - frac_own_def, - FRAC_WEIGHT_ADD_VALUE, - one_value), - assume_rule(` - ra_valid - (frac_ra (R:(A)ra)) - (ra_op - (frac_ra R) - (frac_full (a:A)) - (frame:(A)frac)) - `)); - thm source_weight = conjunct1_rule(source_valid); - thm frame_pos = ispec_rule( - `a0:frac_weight`, - FRAC_WEIGHT_VALUE_POS); - thm impossible = mp_rule( - mp_rule( - real_arith_rule(` - &0 < frac_weight_value (a0:frac_weight) ==> - &1 + frac_weight_value a0 <= &1 ==> - F - `), - frame_pos), - source_weight); - CONTR_TAC(frame_cases[1], impossible); + body, + mp_rule(update, target_full_valid)); return gnode_prove(root); } @@ -1828,6 +1855,7 @@ PROOF static int audit_frac_ra(void) { FRAC_RA_VALID_EMPTY, FRAC_RA_VALID_OWN, FRAC_RA_VALID_FULL, + FRAC_RA_EXCLUSIVE_FULL, FRAC_RA_CANCELLATIVE, FRAC_RA_UPDATE_WEAKEN, FRAC_RA_UPDATE_WEAKEN_ND, diff --git a/theory/logic/frac_ra.h b/theory/logic/frac_ra.h index 85ba8d9..a207cf1 100644 --- a/theory/logic/frac_ra.h +++ b/theory/logic/frac_ra.h @@ -80,6 +80,23 @@ PROOF extern thm FRAC_RA_VALID_OWN; */ PROOF extern thm FRAC_RA_VALID_FULL; +/* ------------------------------------------------------------------------- */ +/* Exclusive elements */ +/* ------------------------------------------------------------------------- */ + +/* + * Full ownership admits no compatible nonempty fractional frame: + * + * `forall (R:(A)ra) (a:A). + * ra_exclusive (frac_ra R) (frac_full a)` + * + * Any owned frame has strictly positive weight, so composing it with weight + * one would exceed the validity bound. The payload need not itself be valid: + * as in the generic definition, exclusivity may hold vacuously for an invalid + * source. + */ +PROOF extern thm FRAC_RA_EXCLUSIVE_FULL; + /* ------------------------------------------------------------------------- */ /* Laws: optional algebraic properties */ /* ------------------------------------------------------------------------- */ @@ -156,6 +173,9 @@ PROOF extern thm FRAC_RA_UPDATE_WEAKEN_ND; * (frac_ra R) * (frac_full a) * (frac_full b)` + * + * This is the instance of `RA_EXCLUSIVE_UPDATE` obtained from + * `FRAC_RA_EXCLUSIVE_FULL` and `FRAC_RA_VALID_FULL`. */ PROOF extern thm FRAC_RA_UPDATE_FULL; diff --git a/theory/logic/ra.c b/theory/logic/ra.c index a301441..76bab2b 100644 --- a/theory/logic/ra.c +++ b/theory/logic/ra.c @@ -281,6 +281,18 @@ PROOF thm ra_cancellative_def = new_fun_definition(` a == b `); +/* + * An element is exclusive when every frame compatible with it is the unit. + * This frame formulation is strong enough to justify replacement by any + * valid target, including in non-cancellative resource algebras. + */ +PROOF thm ra_exclusive_def = new_fun_definition(` + ra_exclusive (R:(A)ra) (a:A) <=> + forall frame:A. + ra_valid R (ra_op R a frame) ==> + frame == ra_unit R +`); + /* * The representation selected for any abstract RA satisfies the subtype * predicate. This is the central consequence of new_type_definition. @@ -899,6 +911,163 @@ PROOF static thm prove_ra_included_valid_frame(void) { PROOF thm RA_INCLUDED_VALID_FRAME = prove_ra_included_valid_frame(); +/* + * Exclusive elements are maximal among valid extensions. Unpack the + * inclusion witness, use validity of the extension to show that witness is + * a compatible frame, then reduce it to the unit. + */ +PROOF static thm prove_ra_exclusive_included(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_exclusive R a ==> + ra_valid R b ==> + ra_included R a b ==> + a == b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "b"); + body = DISCH_TAC(body, "Hexclusive"); + body = DISCH_TAC(body, "Hvalid_b"); + body = DISCH_TAC(body, "Hincluded"); + + thm included = rewrite_rule( + THM_LIST(ra_included_def), + assume_rule(`ra_included (R:(A)ra) (a:A) (b:A)`)); + body = ASSUME_TAC(body, included, "Hincluded_witness"); + body = ASMP_EXISTS_TAC( + body, + "Hincluded_witness", + "frame"); + + thm extension_eq = assume_rule(` + (b:A) == + ra_op (R:(A)ra) (a:A) (frame:A) + `); + thm framed_valid = rewrite_rule( + THM_LIST(extension_eq), + assume_rule(`ra_valid (R:(A)ra) (b:A)`)); + thm exclusive = rewrite_rule( + THM_LIST(ra_exclusive_def), + assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); + thm frame_is_unit = mp_rule( + spec_rule(`frame:A`, exclusive), + framed_valid); + thm replace_frame = beta_rule(ap_term_rule( + `\x:A. ra_op (R:(A)ra) (a:A) x`, + frame_is_unit)); + thm extension_is_a = trans_rule( + extension_eq, + trans_rule( + replace_frame, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + RA_UNIT_R))); + ACCEPT_TAC(body, gsym_rule(extension_is_a)); + return gnode_prove(root); +} + +PROOF thm RA_EXCLUSIVE_INCLUDED = + prove_ra_exclusive_included(); + +/* + * The converse maximality argument needs cancellation: maximality shows + * a = a · frame, and cancellation of the common a then identifies frame + * with the unit. + */ +PROOF static thm prove_ra_exclusive_iff_included(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A). + ra_cancellative R ==> + (ra_exclusive R a <=> + forall b:A. + ra_valid R b ==> + ra_included R a b ==> + a == b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "a"); + body = DISCH_TAC(body, "Hcancellative"); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hexclusive"); + forward = GEN_TAC(forward, "b"); + forward = DISCH_TAC(forward, "Hvalid_b"); + forward = DISCH_TAC(forward, "Hincluded"); + thm maximal = ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `b:A`), + RA_EXCLUSIVE_INCLUDED); + maximal = mp_rule( + maximal, + assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); + maximal = mp_rule( + maximal, + assume_rule(`ra_valid (R:(A)ra) (b:A)`)); + maximal = mp_rule( + maximal, + assume_rule(`ra_included (R:(A)ra) (a:A) (b:A)`)); + ACCEPT_TAC(forward, maximal); + + gnode reverse = DISCH_TAC(directions[1], "Hmaximal"); + reverse = CONV_TAC( + reverse, + once_rewrite_conv(THM_LIST(ra_exclusive_def))); + reverse = GEN_TAC(reverse, "frame"); + reverse = DISCH_TAC(reverse, "Hframed_valid"); + + thm extension_maximal = spec_rule( + `ra_op (R:(A)ra) (a:A) (frame:A)`, + assume_rule(` + forall b:A. + ra_valid (R:(A)ra) b ==> + ra_included R (a:A) b ==> + a == b + `)); + extension_maximal = mp_rule( + extension_maximal, + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (a:A) (frame:A)) + `)); + extension_maximal = mp_rule( + extension_maximal, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `frame:A`), + RA_INCLUDED_OP_L)); + + thm cancel_eq = trans_rule( + gsym_rule(extension_maximal), + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + RA_UNIT_R))); + thm frame_is_unit = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `frame:A`, + `ra_unit (R:(A)ra)`), + RA_CANCELLATIVE_APPLY); + frame_is_unit = mp_rule( + frame_is_unit, + assume_rule(`ra_cancellative (R:(A)ra)`)); + frame_is_unit = mp_rule( + frame_is_unit, + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (a:A) (frame:A)) + `)); + frame_is_unit = mp_rule(frame_is_unit, cancel_eq); + ACCEPT_TAC(reverse, frame_is_unit); + return gnode_prove(root); +} + +PROOF thm RA_EXCLUSIVE_IFF_INCLUDED = + prove_ra_exclusive_iff_included(); + /* * A predicate-valued update to a singleton is equivalent to the deterministic * update relation. Both directions are kept explicit so this bridge remains @@ -1235,6 +1404,63 @@ PROOF static thm prove_ra_update_nd_valid(void) { PROOF thm RA_UPDATE_ND_VALID = prove_ra_update_nd_valid(); +/* + * General exclusive update: a source-compatible frame is the unit, so a + * valid target remains valid with that same frame. + */ +PROOF static thm prove_ra_exclusive_update(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_exclusive R a ==> + ra_valid R b ==> + ra_update R a b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_update_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "b"); + body = DISCH_TAC(body, "Hexclusive"); + body = DISCH_TAC(body, "Hvalid_b"); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hsource_valid"); + + thm exclusive = rewrite_rule( + THM_LIST(ra_exclusive_def), + assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); + thm frame_is_unit = mp_rule( + spec_rule(`frame:A`, exclusive), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (a:A) (frame:A)) + `)); + thm target_unit_eq = ap_term_rule( + `ra_valid (R:(A)ra)`, + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `b:A`), + RA_UNIT_R))); + thm target_with_unit = eq_mp_rule( + target_unit_eq, + assume_rule(`ra_valid (R:(A)ra) (b:A)`)); + thm target_frame_eq = beta_rule(ap_term_rule( + `\x:A. + ra_valid + (R:(A)ra) + (ra_op R (b:A) x)`, + frame_is_unit)); + thm target_with_frame = eq_mp_rule( + gsym_rule(target_frame_eq), + target_with_unit); + ACCEPT_TAC(body, target_with_frame); + return gnode_prove(root); +} + +PROOF thm RA_EXCLUSIVE_UPDATE = + prove_ra_exclusive_update(); + PROOF static thm prove_ra_update_refl(void) { term goal_tm = ` forall (R:(A)ra) (a:A). ra_update R a a @@ -1925,7 +2151,8 @@ PROOF static int audit_ra_core(void) { ra_included_def, ra_update_nd_def, ra_update_def, - ra_cancellative_def); + ra_cancellative_def, + ra_exclusive_def); thm_list public_rules = THM_LIST( RA_LAWS, RA_ASSOC, @@ -1948,6 +2175,8 @@ PROOF static int audit_ra_core(void) { RA_INCLUDED_OP_MONO, RA_INCLUDED_VALID, RA_INCLUDED_VALID_FRAME, + RA_EXCLUSIVE_INCLUDED, + RA_EXCLUSIVE_IFF_INCLUDED, RA_UPDATE_ND_SINGLETON, RA_UPDATE_ND_REFL, RA_UPDATE_ND_TRANS, @@ -1956,6 +2185,7 @@ PROOF static int audit_ra_core(void) { RA_UPDATE_ND_VALID, RA_UPDATE_ND_FRAME, RA_UPDATE_ND_OP, + RA_EXCLUSIVE_UPDATE, RA_UPDATE_REFL, RA_UPDATE_INCLUDED, RA_UPDATE_UNIT, diff --git a/theory/logic/ra.h b/theory/logic/ra.h index 09aa7f3..0dc59cb 100644 --- a/theory/logic/ra.h +++ b/theory/logic/ra.h @@ -125,6 +125,22 @@ PROOF extern thm ra_update_def; */ PROOF extern thm ra_cancellative_def; +/* + * Compatible-frame exclusivity: + * + * ra_exclusive R a <=> + * forall frame. + * ra_valid R (ra_op R a frame) ==> + * frame == ra_unit R + * + * Thus a valid composition containing `a` has no frame other than the unit. + * The definition deliberately talks about compatible frames rather than raw + * inclusion: `ra_included` also permits invalid extensions. + * It does not assert `ra_valid R a`; an invalid element with no compatible + * frame may therefore be exclusive vacuously. + */ +PROOF extern thm ra_exclusive_def; + /* * Direct cancellativity application rule: * @@ -260,6 +276,40 @@ PROOF extern thm RA_INCLUDED_VALID; */ PROOF extern thm RA_INCLUDED_VALID_FRAME; +/* ------------------------------------------------------------------------- */ +/* Exclusive elements */ +/* ------------------------------------------------------------------------- */ + +/* + * An exclusive element has no proper valid extension: + * + * ra_exclusive R a ==> + * ra_valid R b ==> + * ra_included R a b ==> + * a == b + * + * The validity premise is essential because inclusion itself permits invalid + * extensions. For example, an owned element of `excl_ra` is included in + * `ExclInvalid`. + */ +PROOF extern thm RA_EXCLUSIVE_INCLUDED; + +/* + * In a cancellative RA, compatible-frame exclusivity is equivalent to + * maximality among valid extensions: + * + * ra_cancellative R ==> + * (ra_exclusive R a <=> + * forall b. + * ra_valid R b ==> + * ra_included R a b ==> + * a == b) + * + * Without cancellativity, maximality alone need not force the witnessing + * frame to equal the unit: a non-unit frame may be absorbed by `a`. + */ +PROOF extern thm RA_EXCLUSIVE_IFF_INCLUDED; + /* ------------------------------------------------------------------------- */ /* Nondeterministic frame-preserving update rules */ /* ------------------------------------------------------------------------- */ @@ -332,6 +382,18 @@ PROOF extern thm RA_UPDATE_ND_OP; /* Deterministic frame-preserving update rules */ /* ------------------------------------------------------------------------- */ +/* + * General exclusive update law: + * + * ra_exclusive R a ==> + * ra_valid R b ==> + * ra_update R a b + * + * Every frame compatible with `a` is the unit, so ordinary validity of `b` + * suffices for validity of the framed target. + */ +PROOF extern thm RA_EXCLUSIVE_UPDATE; + /* Reflexivity: `ra_update R a a`. */ PROOF extern thm RA_UPDATE_REFL; diff --git a/theory/logic/unit_ra.c b/theory/logic/unit_ra.c index 26a6345..b664e7b 100644 --- a/theory/logic/unit_ra.c +++ b/theory/logic/unit_ra.c @@ -142,6 +142,30 @@ PROOF static thm prove_unit_ra_valid(void) { PROOF thm UNIT_RA_VALID = prove_unit_ra_valid(); +/* Every frame in the singleton carrier is the RA unit. */ +PROOF static thm prove_unit_ra_exclusive(void) { + term goal_tm = ` + forall a:1. ra_exclusive unit_ra a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_exclusive_def))); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hcompatible"); + thm frame_is_one = spec_rule( + `frame:1`, + get_theorem_by_name("one")); + ACCEPT_TAC( + body, + trans_rule(frame_is_one, gsym_rule(UNIT_RA_UNIT))); + return gnode_prove(root); +} + +PROOF thm UNIT_RA_EXCLUSIVE = + prove_unit_ra_exclusive(); + /* Every two values of the singleton carrier are equal, independently of the * common frame. The validity and operation-equality premises of generic * cancellativity are therefore unnecessary after introduction. */ @@ -178,6 +202,7 @@ PROOF static int audit_unit_ra(void) { UNIT_RA_VALID_FN, UNIT_RA_OP, UNIT_RA_VALID, + UNIT_RA_EXCLUSIVE, UNIT_RA_CANCELLATIVE); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { diff --git a/theory/logic/unit_ra.h b/theory/logic/unit_ra.h index 17cd2cc..837151a 100644 --- a/theory/logic/unit_ra.h +++ b/theory/logic/unit_ra.h @@ -29,6 +29,16 @@ PROOF extern thm UNIT_RA_OP; /* `forall a:1. ra_valid unit_ra a`. */ PROOF extern thm UNIT_RA_VALID; +/* ------------------------------------------------------------------------- */ +/* Exclusive elements */ +/* ------------------------------------------------------------------------- */ + +/* + * Every singleton resource is exclusive: + * `forall a:1. ra_exclusive unit_ra a`. + */ +PROOF extern thm UNIT_RA_EXCLUSIVE; + /* ------------------------------------------------------------------------- */ /* Laws */ /* ------------------------------------------------------------------------- */ -- Gitee From 90b4574ef3eb435612ca446ea5375ecd267ce843 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Fri, 7 Aug 2026 22:44:50 +0800 Subject: [PATCH 21/35] refactor(prod_ra): derive one-sided ND updates compositionally --- theory/logic/prod_ra.c | 402 ++++++++++++++++++----------------------- 1 file changed, 177 insertions(+), 225 deletions(-) diff --git a/theory/logic/prod_ra.c b/theory/logic/prod_ra.c index 741e9c3..b386316 100644 --- a/theory/logic/prod_ra.c +++ b/theory/logic/prod_ra.c @@ -824,8 +824,50 @@ PROOF static thm prove_prod_ra_update(void) { PROOF thm PROD_RA_UPDATE = prove_prod_ra_update(); /* - * Update only the left component. The right component validity obtained - * from the source product is reused unchanged with the same projected frame. + * Pure predicate normalization used after combining a left update with ND + * reflexivity on the right. The equality-selected right result is + * substituted into the exact pair image; no unrelated product is admitted. + */ +PROOF static thm prove_prod_ra_left_image_imp(void) { + term goal_tm = ` + forall (P:A->bool) (a2:B) (x:A#B). + (exists b1:A. exists b2:B. + P b1 && b2 == a2 && x == (b1,b2)) ==> + exists b1:A. + P b1 && x == (b1,a2) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "P"); + body = GEN_TAC(body, "a2"); + body = GEN_TAC(body, "x"); + body = DISCH_TAC(body, "Himage"); + body = ASMP_EXISTS_TAC(body, "Himage", "b1"); + body = ASMP_EXISTS_TAC(body, "Himage", "b2"); + body = ASMP_CONJ_TAC( + body, "Himage", "HP", "Himage_rest"); + body = ASMP_CONJ_TAC( + body, "Himage_rest", "Hfixed", "Hpair"); + body = EXISTS_TAC(body, `b1:A`); + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC( + result[0], + assume_rule(`(P:A->bool) (b1:A)`)); + ACCEPT_TAC( + result[1], + rewrite_rule( + THM_LIST(assume_rule(`(b2:B) == (a2:B)`)), + assume_rule(` + (x:A#B) == ((b1:A),(b2:B)) + `))); + return gnode_prove(root); +} + +PROOF static thm PROD_RA_LEFT_IMAGE_IMP = + prove_prod_ra_left_image_imp(); + +/* + * Update only the left component by combining the requested ND update with + * right-side ND reflexivity, then normalize the exact product image. */ PROOF static thm prove_prod_ra_update_left_nd(void) { term goal_tm = ` @@ -839,127 +881,62 @@ PROOF static thm prove_prod_ra_update_left_nd(void) { `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); - body = CONV_TAC( - body, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); - body = CONV_TAC( - body, - depth_conv(get_conversion_by_name("BETA_CONV"))); - body = AUTO_INTROS_TAC(body); + term fixed_right = ` + \b2:B. b2 == (a2:B) + `; + term combined_predicate = ` + \x:A#B. + exists b1:A. exists b2:B. + (P:A->bool) b1 && + b2 == (a2:B) && + x == (b1,b2) + `; + term left_image = ` + \x:A#B. + exists b1:A. + (P:A->bool) b1 && x == (b1,(a2:B)) + `; - thm source_valid_rule = ispecl_rule( - TERM_LIST( - `R1:(A)ra`, - `R2:(B)ra`, - `ra_op - (prod_ra (R1:(A)ra) (R2:(B)ra)) - ((a1:A),(a2:B)) - (frame:A#B)`), - PROD_RA_VALID); - thm source_components = eq_mp_rule( - source_valid_rule, - assume_rule(` - ra_valid - (prod_ra (R1:(A)ra) (R2:(B)ra)) - (ra_op - (prod_ra R1 R2) - ((a1:A),(a2:B)) - (frame:A#B)) - `)); - thm source_op = ispecl_rule( + thm combined = ispecl_rule( TERM_LIST( `R1:(A)ra`, `R2:(B)ra`, - `((a1:A),(a2:B))`, - `frame:A#B`), - PROD_RA_OP); - source_components = pure_rewrite_rule( - THM_LIST( - source_op, - get_theorem_by_name("FST"), - get_theorem_by_name("SND")), - source_components); - - thm left_update = pure_once_rewrite_rule( - THM_LIST(ra_update_nd_def), + `a1:A`, + `a2:B`, + `P:A->bool`, + fixed_right), + PROD_RA_UPDATE_ND); + combined = mp_rule( + combined, assume_rule(` ra_update_nd (R1:(A)ra) (a1:A) (P:A->bool) `)); - thm selected = mp_rule( - spec_rule(`FST (frame:A#B)`, left_update), - conjunct1_rule(source_components)); - body = ASSUME_TAC(body, selected, "Hselected"); - body = ASMP_EXISTS_TAC(body, "Hselected", "b1"); - body = ASMP_CONJ_TAC( - body, - "Hselected", - "HP_b1", - "Hb1_valid"); - - body = EXISTS_TAC(body, `((b1:A),(a2:B))`); - gnode_list result_parts = CONJ_TAC(body); - gnode predicate = EXISTS_TAC(result_parts[0], `b1:A`); - gnode_list predicate_parts = CONJ_TAC(predicate); - ACCEPT_TAC( - predicate_parts[0], - assume_rule(`(P:A->bool) (b1:A)`)); - ACCEPT_TAC( - predicate_parts[1], - refl_rule(`((b1:A),(a2:B))`)); + combined = mp_rule( + combined, + ispecl_rule( + TERM_LIST(`R2:(B)ra`, `a2:B`), + RA_UPDATE_ND_REFL)); + combined = conv_rule( + depth_conv(get_conversion_by_name("BETA_CONV")), + combined); - thm result_valid_rule = ispecl_rule( - TERM_LIST( - `R1:(A)ra`, - `R2:(B)ra`, - `ra_op - (prod_ra (R1:(A)ra) (R2:(B)ra)) - ((b1:A),(a2:B)) - (frame:A#B)`), - PROD_RA_VALID); - thm result_op = ispecl_rule( + thm weakened = ispecl_rule( TERM_LIST( - `R1:(A)ra`, - `R2:(B)ra`, - `((b1:A),(a2:B))`, - `frame:A#B`), - PROD_RA_OP); - result_op = pure_rewrite_rule( - THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")), - result_op); - thm result_fst = ap_term_rule( - `FST:(A#B)->A`, - result_op); - result_fst = pure_once_rewrite_rule( - THM_LIST(get_theorem_by_name("FST")), - result_fst); - thm result_snd = ap_term_rule( - `SND:(A#B)->B`, - result_op); - result_snd = pure_once_rewrite_rule( - THM_LIST(get_theorem_by_name("SND")), - result_snd); - thm result_fst_valid = ap_term_rule( - `ra_valid (R1:(A)ra):A->bool`, - result_fst); - thm result_snd_valid = ap_term_rule( - `ra_valid (R2:(B)ra):B->bool`, - result_snd); - thm result_components = conj_rule( - eq_mp_rule( - gsym_rule(result_fst_valid), - assume_rule(` - ra_valid - (R1:(A)ra) - (ra_op R1 (b1:A) (FST (frame:A#B))) - `)), - eq_mp_rule( - gsym_rule(result_snd_valid), - conjunct2_rule(source_components))); + `prod_ra (R1:(A)ra) (R2:(B)ra)`, + `((a1:A),(a2:B))`, + combined_predicate, + left_image), + RA_UPDATE_ND_MONO); + weakened = mp_rule(weakened, combined); + weakened = conv_rule( + depth_conv(get_conversion_by_name("BETA_CONV")), + weakened); + thm image_implication = ispecl_rule( + TERM_LIST(`P:A->bool`, `a2:B`), + PROD_RA_LEFT_IMAGE_IMP); ACCEPT_TAC( - result_parts[1], - eq_mp_rule(gsym_rule(result_valid_rule), result_components)); + body, + mp_rule(weakened, image_implication)); return gnode_prove(root); } @@ -998,7 +975,45 @@ PROOF static thm prove_prod_ra_update_left(void) { PROOF thm PROD_RA_UPDATE_LEFT = prove_prod_ra_update_left(); -/* Symmetric direct proof for an update confined to the right component. */ +/* Symmetric exact-image normalization for a fixed left component. */ +PROOF static thm prove_prod_ra_right_image_imp(void) { + term goal_tm = ` + forall (a1:A) (P:B->bool) (x:A#B). + (exists b1:A. exists b2:B. + b1 == a1 && P b2 && x == (b1,b2)) ==> + exists b2:B. + P b2 && x == (a1,b2) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "a1"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "x"); + body = DISCH_TAC(body, "Himage"); + body = ASMP_EXISTS_TAC(body, "Himage", "b1"); + body = ASMP_EXISTS_TAC(body, "Himage", "b2"); + body = ASMP_CONJ_TAC( + body, "Himage", "Hfixed", "Himage_rest"); + body = ASMP_CONJ_TAC( + body, "Himage_rest", "HP", "Hpair"); + body = EXISTS_TAC(body, `b2:B`); + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC( + result[0], + assume_rule(`(P:B->bool) (b2:B)`)); + ACCEPT_TAC( + result[1], + rewrite_rule( + THM_LIST(assume_rule(`(b1:A) == (a1:A)`)), + assume_rule(` + (x:A#B) == ((b1:A),(b2:B)) + `))); + return gnode_prove(root); +} + +PROOF static thm PROD_RA_RIGHT_IMAGE_IMP = + prove_prod_ra_right_image_imp(); + +/* Combine left-side ND reflexivity with the requested right update. */ PROOF static thm prove_prod_ra_update_right_nd(void) { term goal_tm = ` forall (R1:(A)ra) (R2:(B)ra) @@ -1011,127 +1026,62 @@ PROOF static thm prove_prod_ra_update_right_nd(void) { `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); - body = CONV_TAC( - body, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); - body = CONV_TAC( - body, - depth_conv(get_conversion_by_name("BETA_CONV"))); - body = AUTO_INTROS_TAC(body); + term fixed_left = ` + \b1:A. b1 == (a1:A) + `; + term combined_predicate = ` + \x:A#B. + exists b1:A. exists b2:B. + b1 == (a1:A) && + (P:B->bool) b2 && + x == (b1,b2) + `; + term right_image = ` + \x:A#B. + exists b2:B. + (P:B->bool) b2 && x == ((a1:A),b2) + `; - thm source_valid_rule = ispecl_rule( - TERM_LIST( - `R1:(A)ra`, - `R2:(B)ra`, - `ra_op - (prod_ra (R1:(A)ra) (R2:(B)ra)) - ((a1:A),(a2:B)) - (frame:A#B)`), - PROD_RA_VALID); - thm source_components = eq_mp_rule( - source_valid_rule, - assume_rule(` - ra_valid - (prod_ra (R1:(A)ra) (R2:(B)ra)) - (ra_op - (prod_ra R1 R2) - ((a1:A),(a2:B)) - (frame:A#B)) - `)); - thm source_op = ispecl_rule( + thm combined = ispecl_rule( TERM_LIST( `R1:(A)ra`, `R2:(B)ra`, - `((a1:A),(a2:B))`, - `frame:A#B`), - PROD_RA_OP); - source_components = pure_rewrite_rule( - THM_LIST( - source_op, - get_theorem_by_name("FST"), - get_theorem_by_name("SND")), - source_components); - - thm right_update = pure_once_rewrite_rule( - THM_LIST(ra_update_nd_def), + `a1:A`, + `a2:B`, + fixed_left, + `P:B->bool`), + PROD_RA_UPDATE_ND); + combined = mp_rule( + combined, + ispecl_rule( + TERM_LIST(`R1:(A)ra`, `a1:A`), + RA_UPDATE_ND_REFL)); + combined = mp_rule( + combined, assume_rule(` ra_update_nd (R2:(B)ra) (a2:B) (P:B->bool) `)); - thm selected = mp_rule( - spec_rule(`SND (frame:A#B)`, right_update), - conjunct2_rule(source_components)); - body = ASSUME_TAC(body, selected, "Hselected"); - body = ASMP_EXISTS_TAC(body, "Hselected", "b2"); - body = ASMP_CONJ_TAC( - body, - "Hselected", - "HP_b2", - "Hb2_valid"); - - body = EXISTS_TAC(body, `((a1:A),(b2:B))`); - gnode_list result_parts = CONJ_TAC(body); - gnode predicate = EXISTS_TAC(result_parts[0], `b2:B`); - gnode_list predicate_parts = CONJ_TAC(predicate); - ACCEPT_TAC( - predicate_parts[0], - assume_rule(`(P:B->bool) (b2:B)`)); - ACCEPT_TAC( - predicate_parts[1], - refl_rule(`((a1:A),(b2:B))`)); + combined = conv_rule( + depth_conv(get_conversion_by_name("BETA_CONV")), + combined); - thm result_valid_rule = ispecl_rule( + thm weakened = ispecl_rule( TERM_LIST( - `R1:(A)ra`, - `R2:(B)ra`, - `ra_op - (prod_ra (R1:(A)ra) (R2:(B)ra)) - ((a1:A),(b2:B)) - (frame:A#B)`), - PROD_RA_VALID); - thm result_op = ispecl_rule( - TERM_LIST( - `R1:(A)ra`, - `R2:(B)ra`, - `((a1:A),(b2:B))`, - `frame:A#B`), - PROD_RA_OP); - result_op = pure_rewrite_rule( - THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")), - result_op); - thm result_fst = ap_term_rule( - `FST:(A#B)->A`, - result_op); - result_fst = pure_once_rewrite_rule( - THM_LIST(get_theorem_by_name("FST")), - result_fst); - thm result_snd = ap_term_rule( - `SND:(A#B)->B`, - result_op); - result_snd = pure_once_rewrite_rule( - THM_LIST(get_theorem_by_name("SND")), - result_snd); - thm result_fst_valid = ap_term_rule( - `ra_valid (R1:(A)ra):A->bool`, - result_fst); - thm result_snd_valid = ap_term_rule( - `ra_valid (R2:(B)ra):B->bool`, - result_snd); - thm result_components = conj_rule( - eq_mp_rule( - gsym_rule(result_fst_valid), - conjunct1_rule(source_components)), - eq_mp_rule( - gsym_rule(result_snd_valid), - assume_rule(` - ra_valid - (R2:(B)ra) - (ra_op R2 (b2:B) (SND (frame:A#B))) - `))); + `prod_ra (R1:(A)ra) (R2:(B)ra)`, + `((a1:A),(a2:B))`, + combined_predicate, + right_image), + RA_UPDATE_ND_MONO); + weakened = mp_rule(weakened, combined); + weakened = conv_rule( + depth_conv(get_conversion_by_name("BETA_CONV")), + weakened); + thm image_implication = ispecl_rule( + TERM_LIST(`a1:A`, `P:B->bool`), + PROD_RA_RIGHT_IMAGE_IMP); ACCEPT_TAC( - result_parts[1], - eq_mp_rule(gsym_rule(result_valid_rule), result_components)); + body, + mp_rule(weakened, image_implication)); return gnode_prove(root); } @@ -1185,8 +1135,10 @@ PROOF static int audit_prod_ra(void) { PROD_RA_CANCELLATIVE, PROD_RA_UPDATE_ND, PROD_RA_UPDATE, + PROD_RA_LEFT_IMAGE_IMP, PROD_RA_UPDATE_LEFT_ND, PROD_RA_UPDATE_LEFT, + PROD_RA_RIGHT_IMAGE_IMP, PROD_RA_UPDATE_RIGHT_ND, PROD_RA_UPDATE_RIGHT); -- Gitee From 6a99fe6247e393a21e7ca4003ccc1ed23926dfd1 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Fri, 7 Aug 2026 22:45:06 +0800 Subject: [PATCH 22/35] feat(finmap): add mutation laws and finite-map induction --- theory/logic/finmap.c | 1183 ++++++++++++++++++++++++++++++++++++++++- theory/logic/finmap.h | 175 ++++++ 2 files changed, 1357 insertions(+), 1 deletion(-) diff --git a/theory/logic/finmap.c b/theory/logic/finmap.c index 0508f4b..49dedea 100644 --- a/theory/logic/finmap.c +++ b/theory/logic/finmap.c @@ -255,6 +255,378 @@ PROOF static thm prove_finmap_singleton_lookup(void) { PROOF thm FINMAP_SINGLETON_LOOKUP = prove_finmap_singleton_lookup(); +PROOF static thm prove_finmap_insert_support(void) { + term goal_tm = ` + forall (key:K) (v:V) (f:K->V option). + {k:K | + ~((if k == key then SOME v else f k) == NONE)} == + key INSERT {k | ~(f k == NONE)} + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST( + get_theorem_by_name("EXTENSION")))); + body = GEN_TAC(body, "k"); + gnode_list branches = BOOL_CASES_TAC( + body, `(k:K) == (key:K)`, NULL); + for (size_t i = 0; i < vector_size(branches); ++i) { + CONV_WITH_ASMP_TAC( + branches[i], + rewrite_conv, + THM_LIST( + get_theorem_by_name("IN_ELIM_THM"), + get_theorem_by_name("IN_INSERT"), + get_theorem_by_name("option_DISTINCT"))); + } + return gnode_prove(root); +} + +PROOF thm FINMAP_INSERT_SUPPORT = + prove_finmap_insert_support(); + +PROOF static thm prove_finmap_insert_finite(void) { + term goal_tm = ` + forall + (key:K) + (v:V) + (m:(K,V)finmap). + finmap_finite + (\k:K. + if k == key then SOME v else finmap_rep m k) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + term key = `key:K`; + term v = `v:V`; + term m = `m:(K,V)finmap`; + term support = ` + {k:K | ~(finmap_rep (m:(K,V)finmap) k == NONE)} + `; + term raw = ` + \k:K. + if k == (key:K) then SOME (v:V) + else finmap_rep (m:(K,V)finmap) k + `; + + thm finite_support = rewrite_rule( + THM_LIST(finmap_finite_def), + ispec_rule(m, FINMAP_REP_FINITE)); + thm finite_insert = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST(support, key), + get_theorem_by_name("FINITE_INSERT"))), + finite_support); + thm support_eq = ispecl_rule( + TERM_LIST( + key, + v, + `finmap_rep (m:(K,V)finmap)`), + FINMAP_INSERT_SUPPORT); + thm finite_raw_support = eq_mp_rule( + gsym_rule(ap_term_rule( + `FINITE:(K->bool)->bool`, + support_eq)), + finite_insert); + thm finite_definition = inst_rule( + TERM_PAIR_LIST( + (term_pair){raw, `f:K->V option`}), + finmap_finite_def); + finite_definition = beta_rule(finite_definition); + ACCEPT_TAC( + body, + eq_mp_rule( + gsym_rule(finite_definition), + finite_raw_support)); + return gnode_prove(root); +} + +PROOF static thm FINMAP_INSERT_FINITE = + prove_finmap_insert_finite(); + +PROOF thm finmap_insert_def = new_fun_definition(` + finmap_insert + (key:K) + (v:V) + (m:(K,V)finmap) : (K,V)finmap = + finmap_abs + (\k:K. + if k == key then SOME v else finmap_rep m k) +`); + +PROOF static thm prove_finmap_insert_rep(void) { + term key = `key:K`; + term v = `v:V`; + term m = `m:(K,V)finmap`; + term raw = ` + \k:K. + if k == (key:K) then SOME (v:V) + else finmap_rep (m:(K,V)finmap) k + `; + thm finite = ispecl_rule( + TERM_LIST(key, v, m), + FINMAP_INSERT_FINITE); + thm inverse = ispec_rule( + raw, + conjunct2_rule(FINMAP_TYPE_BIJECTION)); + thm represented = eq_mp_rule(inverse, finite); + represented = pure_once_rewrite_rule( + THM_LIST(gsym_rule(finmap_insert_def)), + represented); + represented = gen_rule(m, represented); + represented = gen_rule(v, represented); + return gen_rule(key, represented); +} + +PROOF thm FINMAP_INSERT_REP = + prove_finmap_insert_rep(); + +PROOF static thm prove_finmap_insert_lookup(void) { + term goal_tm = ` + forall + (key:K) + (v:V) + (m:(K,V)finmap) + (k:K). + finmap_lookup (finmap_insert key v m) k == + if k == key then SOME v else finmap_lookup m k + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + finmap_lookup_def, + FINMAP_INSERT_REP))); + return gnode_prove(root); +} + +PROOF thm FINMAP_INSERT_LOOKUP = + prove_finmap_insert_lookup(); + +PROOF static thm prove_finmap_insert_lookup_eq(void) { + term goal_tm = ` + forall + (key:K) + (v:V) + (m:(K,V)finmap). + finmap_lookup (finmap_insert key v m) key == SOME v + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST(FINMAP_INSERT_LOOKUP))); + return gnode_prove(root); +} + +PROOF thm FINMAP_INSERT_LOOKUP_EQ = + prove_finmap_insert_lookup_eq(); + +PROOF static thm prove_finmap_insert_lookup_ne(void) { + term goal_tm = ` + forall + (key:K) + (v:V) + (m:(K,V)finmap) + (k:K). + ~(k == key) ==> + finmap_lookup (finmap_insert key v m) k == + finmap_lookup m k + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + CONV_WITH_ASMP_TAC( + body, + rewrite_conv, + THM_LIST(FINMAP_INSERT_LOOKUP)); + return gnode_prove(root); +} + +PROOF thm FINMAP_INSERT_LOOKUP_NE = + prove_finmap_insert_lookup_ne(); + +PROOF static thm prove_finmap_delete_support(void) { + term goal_tm = ` + forall (key:K) (f:K->V option). + {k:K | + ~((if k == key then NONE else f k) == NONE)} == + {k | ~(f k == NONE)} DELETE key + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST( + get_theorem_by_name("EXTENSION")))); + body = GEN_TAC(body, "k"); + gnode_list branches = BOOL_CASES_TAC( + body, `(k:K) == (key:K)`, NULL); + for (size_t i = 0; i < vector_size(branches); ++i) { + CONV_WITH_ASMP_TAC( + branches[i], + rewrite_conv, + THM_LIST( + get_theorem_by_name("IN_ELIM_THM"), + get_theorem_by_name("IN_DELETE"))); + } + return gnode_prove(root); +} + +PROOF thm FINMAP_DELETE_SUPPORT = + prove_finmap_delete_support(); + +PROOF static thm prove_finmap_delete_finite(void) { + term goal_tm = ` + forall + (key:K) + (m:(K,V)finmap). + finmap_finite + (\k:K. + if k == key then NONE else finmap_rep m k) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + term key = `key:K`; + term m = `m:(K,V)finmap`; + term support = ` + {k:K | ~(finmap_rep (m:(K,V)finmap) k == NONE)} + `; + term raw = ` + \k:K. + if k == (key:K) then (NONE:V option) + else finmap_rep (m:(K,V)finmap) k + `; + + thm finite_support = rewrite_rule( + THM_LIST(finmap_finite_def), + ispec_rule(m, FINMAP_REP_FINITE)); + thm finite_delete = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST(support, key), + get_theorem_by_name("FINITE_DELETE"))), + finite_support); + thm support_eq = ispecl_rule( + TERM_LIST( + key, + `finmap_rep (m:(K,V)finmap)`), + FINMAP_DELETE_SUPPORT); + thm finite_raw_support = eq_mp_rule( + gsym_rule(ap_term_rule( + `FINITE:(K->bool)->bool`, + support_eq)), + finite_delete); + thm finite_definition = inst_rule( + TERM_PAIR_LIST( + (term_pair){raw, `f:K->V option`}), + finmap_finite_def); + finite_definition = beta_rule(finite_definition); + ACCEPT_TAC( + body, + eq_mp_rule( + gsym_rule(finite_definition), + finite_raw_support)); + return gnode_prove(root); +} + +PROOF static thm FINMAP_DELETE_FINITE = + prove_finmap_delete_finite(); + +PROOF thm finmap_delete_def = new_fun_definition(` + finmap_delete + (key:K) + (m:(K,V)finmap) : (K,V)finmap = + finmap_abs + (\k:K. + if k == key then NONE else finmap_rep m k) +`); + +PROOF static thm prove_finmap_delete_rep(void) { + term key = `key:K`; + term m = `m:(K,V)finmap`; + term raw = ` + \k:K. + if k == (key:K) then (NONE:V option) + else finmap_rep (m:(K,V)finmap) k + `; + thm finite = ispecl_rule( + TERM_LIST(key, m), + FINMAP_DELETE_FINITE); + thm inverse = ispec_rule( + raw, + conjunct2_rule(FINMAP_TYPE_BIJECTION)); + thm represented = eq_mp_rule(inverse, finite); + represented = pure_once_rewrite_rule( + THM_LIST(gsym_rule(finmap_delete_def)), + represented); + represented = gen_rule(m, represented); + return gen_rule(key, represented); +} + +PROOF thm FINMAP_DELETE_REP = + prove_finmap_delete_rep(); + +PROOF static thm prove_finmap_delete_lookup(void) { + term goal_tm = ` + forall + (key:K) + (m:(K,V)finmap) + (k:K). + finmap_lookup (finmap_delete key m) k == + if k == key then NONE else finmap_lookup m k + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + finmap_lookup_def, + FINMAP_DELETE_REP))); + return gnode_prove(root); +} + +PROOF thm FINMAP_DELETE_LOOKUP = + prove_finmap_delete_lookup(); + +PROOF static thm prove_finmap_delete_lookup_eq(void) { + term goal_tm = ` + forall + (key:K) + (m:(K,V)finmap). + finmap_lookup (finmap_delete key m) key == NONE + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST(FINMAP_DELETE_LOOKUP))); + return gnode_prove(root); +} + +PROOF thm FINMAP_DELETE_LOOKUP_EQ = + prove_finmap_delete_lookup_eq(); + +PROOF static thm prove_finmap_delete_lookup_ne(void) { + term goal_tm = ` + forall + (key:K) + (m:(K,V)finmap) + (k:K). + ~(k == key) ==> + finmap_lookup (finmap_delete key m) k == + finmap_lookup m k + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + CONV_WITH_ASMP_TAC( + body, + rewrite_conv, + THM_LIST(FINMAP_DELETE_LOOKUP)); + return gnode_prove(root); +} + +PROOF thm FINMAP_DELETE_LOOKUP_NE = + prove_finmap_delete_lookup_ne(); + PROOF static thm prove_finmap_eq_lookup(void) { term goal_tm = ` forall (m:(K,V)finmap) (n:(K,V)finmap). @@ -280,6 +652,347 @@ PROOF static thm prove_finmap_eq_lookup(void) { PROOF thm FINMAP_EQ_LOOKUP = prove_finmap_eq_lookup(); +PROOF static thm prove_finmap_insert_empty(void) { + term goal_tm = ` + forall (key:K) (v:V). + finmap_insert key v (finmap_empty:(K,V)finmap) == + finmap_singleton key v + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "query"); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, NULL); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST( + FINMAP_INSERT_LOOKUP, + FINMAP_EMPTY_LOOKUP, + FINMAP_SINGLETON_LOOKUP)); + } + return gnode_prove(root); +} + +PROOF thm FINMAP_INSERT_EMPTY = + prove_finmap_insert_empty(); + +PROOF static thm prove_finmap_delete_empty(void) { + term goal_tm = ` + forall key:K. + finmap_delete key (finmap_empty:(K,V)finmap) == + finmap_empty + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "query"); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, NULL); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST( + FINMAP_DELETE_LOOKUP, + FINMAP_EMPTY_LOOKUP)); + } + return gnode_prove(root); +} + +PROOF thm FINMAP_DELETE_EMPTY = + prove_finmap_delete_empty(); + +PROOF static thm prove_finmap_insert_overwrite(void) { + term goal_tm = ` + forall + (key:K) + (v:V) + (w:V) + (m:(K,V)finmap). + finmap_insert key v (finmap_insert key w m) == + finmap_insert key v m + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "query"); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, NULL); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST(FINMAP_INSERT_LOOKUP)); + } + return gnode_prove(root); +} + +PROOF thm FINMAP_INSERT_OVERWRITE = + prove_finmap_insert_overwrite(); + +PROOF static thm prove_finmap_insert_comm(void) { + term goal_tm = ` + forall + (key1:K) + (v1:V) + (key2:K) + (v2:V) + (m:(K,V)finmap). + ~(key1 == key2) ==> + finmap_insert key1 v1 (finmap_insert key2 v2 m) == + finmap_insert key2 v2 (finmap_insert key1 v1 m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "query"); + gnode_list key1_cases = BOOL_CASES_TAC( + body, `(query:K) == (key1:K)`, NULL); + for (size_t i = 0; i < vector_size(key1_cases); ++i) { + gnode_list key2_cases = BOOL_CASES_TAC( + key1_cases[i], `(query:K) == (key2:K)`, NULL); + for (size_t j = 0; j < vector_size(key2_cases); ++j) { + CONV_WITH_ASMP_TAC( + key2_cases[j], + rewrite_conv, + THM_LIST(FINMAP_INSERT_LOOKUP)); + } + } + return gnode_prove(root); +} + +PROOF thm FINMAP_INSERT_COMM = + prove_finmap_insert_comm(); + +PROOF static thm prove_finmap_delete_idempotent(void) { + term goal_tm = ` + forall (key:K) (m:(K,V)finmap). + finmap_delete key (finmap_delete key m) == + finmap_delete key m + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "query"); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, NULL); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST(FINMAP_DELETE_LOOKUP)); + } + return gnode_prove(root); +} + +PROOF thm FINMAP_DELETE_IDEMPOTENT = + prove_finmap_delete_idempotent(); + +PROOF static thm prove_finmap_delete_comm(void) { + term goal_tm = ` + forall + (key1:K) + (key2:K) + (m:(K,V)finmap). + finmap_delete key1 (finmap_delete key2 m) == + finmap_delete key2 (finmap_delete key1 m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "query"); + gnode_list key_cases = BOOL_CASES_TAC( + body, `(key1:K) == (key2:K)`, NULL); + for (size_t i = 0; i < vector_size(key_cases); ++i) { + gnode_list key1_cases = BOOL_CASES_TAC( + key_cases[i], `(query:K) == (key1:K)`, NULL); + for (size_t j = 0; j < vector_size(key1_cases); ++j) { + gnode_list key2_cases = BOOL_CASES_TAC( + key1_cases[j], `(query:K) == (key2:K)`, NULL); + for (size_t k = 0; k < vector_size(key2_cases); ++k) { + CONV_WITH_ASMP_TAC( + key2_cases[k], + rewrite_conv, + THM_LIST(FINMAP_DELETE_LOOKUP)); + } + } + } + return gnode_prove(root); +} + +PROOF thm FINMAP_DELETE_COMM = + prove_finmap_delete_comm(); + +PROOF static thm prove_finmap_delete_insert(void) { + term goal_tm = ` + forall + (key:K) + (v:V) + (m:(K,V)finmap). + finmap_delete key (finmap_insert key v m) == + finmap_delete key m + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "query"); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, NULL); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST( + FINMAP_DELETE_LOOKUP, + FINMAP_INSERT_LOOKUP)); + } + return gnode_prove(root); +} + +PROOF thm FINMAP_DELETE_INSERT = + prove_finmap_delete_insert(); + +PROOF static thm prove_finmap_insert_delete(void) { + term goal_tm = ` + forall + (key:K) + (v:V) + (m:(K,V)finmap). + finmap_insert key v (finmap_delete key m) == + finmap_insert key v m + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "query"); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, NULL); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST( + FINMAP_INSERT_LOOKUP, + FINMAP_DELETE_LOOKUP)); + } + return gnode_prove(root); +} + +PROOF thm FINMAP_INSERT_DELETE = + prove_finmap_insert_delete(); + +PROOF static thm prove_finmap_insert_id(void) { + term goal_tm = ` + forall + (key:K) + (v:V) + (m:(K,V)finmap). + finmap_lookup m key == SOME v ==> + finmap_insert key v m == m + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "query"); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, NULL); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST(FINMAP_INSERT_LOOKUP)); + } + return gnode_prove(root); +} + +PROOF thm FINMAP_INSERT_ID = + prove_finmap_insert_id(); + +PROOF static thm prove_finmap_delete_id(void) { + term goal_tm = ` + forall + (key:K) + (m:(K,V)finmap). + finmap_lookup m key == NONE ==> + finmap_delete key m == m + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "query"); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, NULL); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST(FINMAP_DELETE_LOOKUP)); + } + return gnode_prove(root); +} + +PROOF thm FINMAP_DELETE_ID = + prove_finmap_delete_id(); + +PROOF static thm prove_finmap_decompose(void) { + term goal_tm = ` + forall + (key:K) + (v:V) + (m:(K,V)finmap). + finmap_lookup m key == SOME v ==> + finmap_insert key v (finmap_delete key m) == m + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm remove_then_restore = ispecl_rule( + TERM_LIST( + `key:K`, + `v:V`, + `m:(K,V)finmap`), + FINMAP_INSERT_DELETE); + thm insert_existing = mp_rule( + ispecl_rule( + TERM_LIST( + `key:K`, + `v:V`, + `m:(K,V)finmap`), + FINMAP_INSERT_ID), + assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == SOME (v:V) + `)); + ACCEPT_TAC( + body, + trans_rule(remove_then_restore, insert_existing)); + return gnode_prove(root); +} + +PROOF thm FINMAP_DECOMPOSE = + prove_finmap_decompose(); + PROOF thm finmap_dom_def = new_fun_definition(` finmap_dom (m:(K,V)finmap) : K->bool = {k | ~(finmap_lookup m k == NONE)} @@ -346,6 +1059,444 @@ PROOF static thm prove_finmap_dom_singleton(void) { PROOF thm FINMAP_DOM_SINGLETON = prove_finmap_dom_singleton(); +PROOF static thm prove_finmap_in_dom(void) { + term goal_tm = ` + forall (key:K) (m:(K,V)finmap). + key IN finmap_dom m <=> + ~(finmap_lookup m key == NONE) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + finmap_dom_def, + get_theorem_by_name("IN_ELIM_THM")))); + return gnode_prove(root); +} + +PROOF thm FINMAP_IN_DOM = + prove_finmap_in_dom(); + +PROOF static thm prove_finmap_in_dom_some(void) { + term goal_tm = ` + forall (key:K) (m:(K,V)finmap). + key IN finmap_dom m <=> + exists v:V. finmap_lookup m key == SOME v + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list cases = CASES_TAC( + body, + `finmap_lookup (m:(K,V)finmap) (key:K)`, + "Hlookup"); + + thm none_lookup = assume_rule(gnode_get_asmps( + cases[0], CONST_STRING_LIST("Hlookup"))[0]); + gnode_list none_directions = EQ_TAC(cases[0]); + gnode none_forward = DISCH_TAC( + none_directions[0], "Hin"); + thm non_none = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `key:K`, + `m:(K,V)finmap`), + FINMAP_IN_DOM), + assume_rule(` + (key:K) IN finmap_dom (m:(K,V)finmap) + `)); + CONTR_TAC( + none_forward, + not_elim_rule(non_none, none_lookup)); + + gnode none_reverse = DISCH_TAC( + none_directions[1], "Hsome"); + none_reverse = ASMP_EXISTS_TAC( + none_reverse, "Hsome", "v"); + thm claimed_some = assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == SOME (v:V) + `); + thm none_is_some = trans_rule( + gsym_rule(claimed_some), + none_lookup); + CONTR_TAC( + none_reverse, + not_elim_rule( + ispec_rule( + `v:V`, + get_theorem_by_name("option_DISTINCT")), + none_is_some)); + + thm some_lookup = assume_rule(gnode_get_asmps( + cases[1], CONST_STRING_LIST("Hlookup"))[0]); + term payload = dest_comb(dest_eq(concl(some_lookup)).tm2).tm2; + gnode_list some_directions = EQ_TAC(cases[1]); + gnode some_forward = DISCH_TAC( + some_directions[0], "Hin"); + some_forward = EXISTS_TAC(some_forward, payload); + ACCEPT_TAC(some_forward, some_lookup); + + gnode some_reverse = DISCH_TAC( + some_directions[1], "Hsome"); + thm payload_non_none = ispec_rule( + payload, + get_theorem_by_name("option_DISTINCT")); + payload_non_none = rewrite_rule( + THM_LIST(gsym_rule(some_lookup)), + payload_non_none); + ACCEPT_TAC( + some_reverse, + eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `key:K`, + `m:(K,V)finmap`), + FINMAP_IN_DOM)), + payload_non_none)); + return gnode_prove(root); +} + +PROOF thm FINMAP_IN_DOM_SOME = + prove_finmap_in_dom_some(); + +PROOF static thm prove_finmap_not_in_dom(void) { + term goal_tm = ` + forall (key:K) (m:(K,V)finmap). + ~(key IN finmap_dom m) <=> + finmap_lookup m key == NONE + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + FINMAP_IN_DOM, + get_theorem_by_name("NOT_CLAUSES")))); + return gnode_prove(root); +} + +PROOF thm FINMAP_NOT_IN_DOM = + prove_finmap_not_in_dom(); + +PROOF static thm prove_finmap_dom_eq_empty(void) { + term goal_tm = ` + forall m:(K,V)finmap. + finmap_dom m == {} <=> + m == finmap_empty + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "m"); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hdom"); + forward = CONV_TAC( + forward, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + forward = GEN_TAC(forward, "key"); + forward = CONV_TAC( + forward, + once_rewrite_conv(THM_LIST(FINMAP_EMPTY_LOOKUP))); + thm not_in_empty = ispec_rule( + `key:K`, + get_theorem_by_name("NOT_IN_EMPTY")); + thm not_in_dom = rewrite_rule( + THM_LIST(gsym_rule(assume_rule(` + finmap_dom (m:(K,V)finmap) == {} + `))), + not_in_empty); + ACCEPT_TAC( + forward, + eq_mp_rule( + ispecl_rule( + TERM_LIST( + `key:K`, + `m:(K,V)finmap`), + FINMAP_NOT_IN_DOM), + not_in_dom)); + + gnode reverse = DISCH_TAC(directions[1], "Hmap"); + thm domains_equal = ap_term_rule( + `finmap_dom:(K,V)finmap->K->bool`, + assume_rule(` + (m:(K,V)finmap) == finmap_empty + `)); + domains_equal = rewrite_rule( + THM_LIST(FINMAP_DOM_EMPTY), + domains_equal); + ACCEPT_TAC(reverse, domains_equal); + return gnode_prove(root); +} + +PROOF thm FINMAP_DOM_EQ_EMPTY = + prove_finmap_dom_eq_empty(); + +PROOF static thm prove_finmap_dom_insert(void) { + term goal_tm = ` + forall + (key:K) + (v:V) + (m:(K,V)finmap). + finmap_dom (finmap_insert key v m) == + key INSERT finmap_dom m + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST( + get_theorem_by_name("EXTENSION")))); + body = GEN_TAC(body, "query"); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, NULL); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST( + FINMAP_IN_DOM, + FINMAP_INSERT_LOOKUP, + get_theorem_by_name("IN_INSERT"), + get_theorem_by_name("option_DISTINCT"))); + } + return gnode_prove(root); +} + +PROOF thm FINMAP_DOM_INSERT = + prove_finmap_dom_insert(); + +PROOF static thm prove_finmap_dom_delete(void) { + term goal_tm = ` + forall + (key:K) + (m:(K,V)finmap). + finmap_dom (finmap_delete key m) == + finmap_dom m DELETE key + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST( + get_theorem_by_name("EXTENSION")))); + body = GEN_TAC(body, "query"); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, NULL); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST( + FINMAP_IN_DOM, + FINMAP_DELETE_LOOKUP, + get_theorem_by_name("IN_DELETE"))); + } + return gnode_prove(root); +} + +PROOF thm FINMAP_DOM_DELETE = + prove_finmap_dom_delete(); + +PROOF static thm prove_finmap_induct(void) { + term goal_tm = ` + forall P:((K,V)finmap)->bool. + P finmap_empty ==> + (forall + (key:K) + (v:V) + (m:(K,V)finmap). + finmap_lookup m key == NONE ==> + P m ==> + P (finmap_insert key v m)) ==> + forall m:(K,V)finmap. P m + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "P"); + body = DISCH_TAC(body, "Hempty"); + body = DISCH_TAC(body, "Hinsert"); + body = GEN_TAC(body, "m"); + + term domain_predicate = ` + \s:K->bool. + forall n:(K,V)finmap. + finmap_dom n == s ==> P n + `; + thm finite_induction = beta_rule(ispec_rule( + domain_predicate, + get_theorem_by_name("FINITE_INDUCT_STRONG"))); + dest_imp_results induction_imp = dest_imp(concl(finite_induction)); + term induction_cases = induction_imp.tm1; + gnode_list asserted = ASSERT_TAC( + body, induction_cases, "Hdomain_induction"); + + thm all_finite_domains = mp_rule( + finite_induction, + assume_rule(induction_cases)); + thm current_domain_case = mp_rule( + ispec_rule( + `finmap_dom (m:(K,V)finmap)`, + all_finite_domains), + ispec_rule( + `m:(K,V)finmap`, + FINMAP_DOM_FINITE)); + current_domain_case = beta_rule(current_domain_case); + thm current_map_case = mp_rule( + ispec_rule( + `m:(K,V)finmap`, + current_domain_case), + refl_rule(`finmap_dom (m:(K,V)finmap)`)); + ACCEPT_TAC(asserted[0], current_map_case); + + gnode induction_cases_goal = CONV_TAC( + asserted[1], + depth_conv(get_conversion_by_name("BETA_CONV"))); + gnode_list cases = CONJ_TAC(induction_cases_goal); + + gnode empty_case = GEN_TAC(cases[0], "n"); + empty_case = DISCH_TAC(empty_case, "Hdom_empty"); + thm map_is_empty = eq_mp_rule( + ispec_rule( + `n:(K,V)finmap`, + FINMAP_DOM_EQ_EMPTY), + assume_rule(` + finmap_dom (n:(K,V)finmap) == {} + `)); + thm predicates_equal = ap_term_rule( + `P:((K,V)finmap)->bool`, + map_is_empty); + ACCEPT_TAC( + empty_case, + eq_mp_rule( + gsym_rule(predicates_equal), + assume_rule(` + (P:((K,V)finmap)->bool) finmap_empty + `))); + + gnode insert_case = GEN_TAC(cases[1], "key"); + insert_case = GEN_TAC(insert_case, "s"); + insert_case = DISCH_TAC(insert_case, "Hcase"); + insert_case = ASMP_CONJ_TAC( + insert_case, "Hcase", "Hsmaller", "Hside"); + insert_case = ASMP_CONJ_TAC( + insert_case, "Hside", "Hfresh", "Hfinite"); + insert_case = GEN_TAC(insert_case, "n"); + insert_case = DISCH_TAC(insert_case, "Hdom_insert"); + + thm in_insert = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `key:K`, + `key:K`, + `s:K->bool`), + get_theorem_by_name("IN_INSERT"))), + disj1_rule( + refl_rule(`key:K`), + `(key:K) IN (s:K->bool)`)); + thm in_domain = rewrite_rule( + THM_LIST(gsym_rule(assume_rule(` + finmap_dom (n:(K,V)finmap) == + (key:K) INSERT (s:K->bool) + `))), + in_insert); + thm payload_exists = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `key:K`, + `n:(K,V)finmap`), + FINMAP_IN_DOM_SOME), + in_domain); + insert_case = ASSUME_TAC( + insert_case, payload_exists, "Hpayload"); + insert_case = ASMP_EXISTS_TAC( + insert_case, "Hpayload", "v"); + + thm domain_without_key = ispecl_rule( + TERM_LIST( + `key:K`, + `n:(K,V)finmap`), + FINMAP_DOM_DELETE); + thm delete_domain_congruence = beta_rule(ap_term_rule( + `\d:K->bool. d DELETE (key:K)`, + assume_rule(` + finmap_dom (n:(K,V)finmap) == + (key:K) INSERT (s:K->bool) + `))); + thm delete_inserted_key = ispecl_rule( + TERM_LIST( + `key:K`, + `key:K`, + `s:K->bool`), + get_theorem_by_name("DELETE_INSERT")); + delete_inserted_key = rewrite_rule( + THM_LIST(get_theorem_by_name("COND_CLAUSES")), + delete_inserted_key); + thm delete_absent_key = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `key:K`, + `s:K->bool`), + get_theorem_by_name("DELETE_NON_ELEMENT")), + assume_rule(`~((key:K) IN (s:K->bool))`)); + domain_without_key = trans_rule( + domain_without_key, + trans_rule( + delete_domain_congruence, + trans_rule( + delete_inserted_key, + delete_absent_key))); + + thm smaller_property = mp_rule( + ispec_rule( + `finmap_delete (key:K) (n:(K,V)finmap)`, + assume_rule(` + forall smaller:(K,V)finmap. + finmap_dom smaller == (s:K->bool) ==> + (P:((K,V)finmap)->bool) smaller + `)), + domain_without_key); + thm insert_step = ispecl_rule( + TERM_LIST( + `key:K`, + `v:V`, + `finmap_delete (key:K) (n:(K,V)finmap)`), + assume_rule(` + forall + (insert_key:K) + (insert_value:V) + (base:(K,V)finmap). + finmap_lookup base insert_key == NONE ==> + (P:((K,V)finmap)->bool) base ==> + P (finmap_insert insert_key insert_value base) + `)); + thm restored_property = mp_rule( + mp_rule( + insert_step, + ispecl_rule( + TERM_LIST( + `key:K`, + `n:(K,V)finmap`), + FINMAP_DELETE_LOOKUP_EQ)), + smaller_property); + thm restored_map = mp_rule( + ispecl_rule( + TERM_LIST( + `key:K`, + `v:V`, + `n:(K,V)finmap`), + FINMAP_DECOMPOSE), + assume_rule(` + finmap_lookup (n:(K,V)finmap) (key:K) == SOME (v:V) + `)); + ACCEPT_TAC( + insert_case, + eq_mp_rule( + ap_term_rule( + `P:((K,V)finmap)->bool`, + restored_map), + restored_property)); + return gnode_prove(root); +} + +PROOF thm FINMAP_INDUCT = + prove_finmap_induct(); + PROOF static int audit_finmap(void) { thm_list public_theorems = THM_LIST( finmap_finite_def, @@ -355,16 +1506,46 @@ PROOF static int audit_finmap(void) { finmap_empty_def, finmap_lookup_def, finmap_singleton_def, + finmap_insert_def, + finmap_delete_def, finmap_dom_def, FINMAP_EMPTY_REP, FINMAP_EMPTY_LOOKUP, FINMAP_SINGLETON_SUPPORT, FINMAP_SINGLETON_REP, FINMAP_SINGLETON_LOOKUP, + FINMAP_INSERT_SUPPORT, + FINMAP_INSERT_REP, + FINMAP_INSERT_LOOKUP, + FINMAP_INSERT_LOOKUP_EQ, + FINMAP_INSERT_LOOKUP_NE, + FINMAP_DELETE_SUPPORT, + FINMAP_DELETE_REP, + FINMAP_DELETE_LOOKUP, + FINMAP_DELETE_LOOKUP_EQ, + FINMAP_DELETE_LOOKUP_NE, FINMAP_EQ_LOOKUP, + FINMAP_INSERT_EMPTY, + FINMAP_DELETE_EMPTY, + FINMAP_INSERT_OVERWRITE, + FINMAP_INSERT_COMM, + FINMAP_DELETE_IDEMPOTENT, + FINMAP_DELETE_COMM, + FINMAP_DELETE_INSERT, + FINMAP_INSERT_DELETE, + FINMAP_INSERT_ID, + FINMAP_DELETE_ID, + FINMAP_DECOMPOSE, FINMAP_DOM_FINITE, FINMAP_DOM_EMPTY, - FINMAP_DOM_SINGLETON); + FINMAP_DOM_SINGLETON, + FINMAP_IN_DOM, + FINMAP_IN_DOM_SOME, + FINMAP_NOT_IN_DOM, + FINMAP_DOM_EQ_EMPTY, + FINMAP_DOM_INSERT, + FINMAP_DOM_DELETE, + FINMAP_INDUCT); for (size_t i = 0; i < vector_size(public_theorems); ++i) { ENSURE_COND(!IS_NULL(public_theorems[i]), diff --git a/theory/logic/finmap.h b/theory/logic/finmap.h index 2831501..4a3a265 100644 --- a/theory/logic/finmap.h +++ b/theory/logic/finmap.h @@ -58,6 +58,20 @@ PROOF extern thm finmap_lookup_def; */ PROOF extern thm finmap_singleton_def; +/* + * `finmap_insert key v m == + * finmap_abs + * (\k. if k == key then SOME v else finmap_rep m k)`. + */ +PROOF extern thm finmap_insert_def; + +/* + * `finmap_delete key m == + * finmap_abs + * (\k. if k == key then NONE else finmap_rep m k)`. + */ +PROOF extern thm finmap_delete_def; + /* `finmap_dom m == {k | ~(finmap_lookup m k == NONE)}`. */ PROOF extern thm finmap_dom_def; @@ -88,12 +102,126 @@ PROOF extern thm FINMAP_SINGLETON_REP; */ PROOF extern thm FINMAP_SINGLETON_LOOKUP; +/* + * `{k | ~((if k == key then SOME v else f k) == NONE)} == + * key INSERT {k | ~(f k == NONE)}`. + */ +PROOF extern thm FINMAP_INSERT_SUPPORT; + +/* + * `finmap_rep (finmap_insert key v m) == + * (\k. if k == key then SOME v else finmap_rep m k)`. + */ +PROOF extern thm FINMAP_INSERT_REP; + +/* + * `finmap_lookup (finmap_insert key v m) k == + * if k == key then SOME v else finmap_lookup m k`. + */ +PROOF extern thm FINMAP_INSERT_LOOKUP; + +/* `finmap_lookup (finmap_insert key v m) key == SOME v`. */ +PROOF extern thm FINMAP_INSERT_LOOKUP_EQ; + +/* + * `~(k == key) ==> + * finmap_lookup (finmap_insert key v m) k == finmap_lookup m k`. + */ +PROOF extern thm FINMAP_INSERT_LOOKUP_NE; + +/* + * `{k | ~((if k == key then NONE else f k) == NONE)} == + * {k | ~(f k == NONE)} DELETE key`. + */ +PROOF extern thm FINMAP_DELETE_SUPPORT; + +/* + * `finmap_rep (finmap_delete key m) == + * (\k. if k == key then NONE else finmap_rep m k)`. + */ +PROOF extern thm FINMAP_DELETE_REP; + +/* + * `finmap_lookup (finmap_delete key m) k == + * if k == key then NONE else finmap_lookup m k`. + */ +PROOF extern thm FINMAP_DELETE_LOOKUP; + +/* `finmap_lookup (finmap_delete key m) key == NONE`. */ +PROOF extern thm FINMAP_DELETE_LOOKUP_EQ; + +/* + * `~(k == key) ==> + * finmap_lookup (finmap_delete key m) k == finmap_lookup m k`. + */ +PROOF extern thm FINMAP_DELETE_LOOKUP_NE; + /* * `m == n <=> * forall k:K. finmap_lookup m k == finmap_lookup n k`. */ PROOF extern thm FINMAP_EQ_LOOKUP; +/* ------------------------------------------------------------------------- */ +/* Laws: insertion and deletion */ +/* ------------------------------------------------------------------------- */ + +/* `finmap_insert key v finmap_empty == finmap_singleton key v`. */ +PROOF extern thm FINMAP_INSERT_EMPTY; + +/* `finmap_delete key finmap_empty == finmap_empty`. */ +PROOF extern thm FINMAP_DELETE_EMPTY; + +/* + * `finmap_insert key v (finmap_insert key w m) == + * finmap_insert key v m`. + */ +PROOF extern thm FINMAP_INSERT_OVERWRITE; + +/* + * `~(key1 == key2) ==> + * finmap_insert key1 v1 (finmap_insert key2 v2 m) == + * finmap_insert key2 v2 (finmap_insert key1 v1 m)`. + */ +PROOF extern thm FINMAP_INSERT_COMM; + +/* + * `finmap_delete key (finmap_delete key m) == finmap_delete key m`. + */ +PROOF extern thm FINMAP_DELETE_IDEMPOTENT; + +/* + * `finmap_delete key1 (finmap_delete key2 m) == + * finmap_delete key2 (finmap_delete key1 m)`. + */ +PROOF extern thm FINMAP_DELETE_COMM; + +/* + * `finmap_delete key (finmap_insert key v m) == finmap_delete key m`. + */ +PROOF extern thm FINMAP_DELETE_INSERT; + +/* + * `finmap_insert key v (finmap_delete key m) == finmap_insert key v m`. + */ +PROOF extern thm FINMAP_INSERT_DELETE; + +/* + * `finmap_lookup m key == SOME v ==> finmap_insert key v m == m`. + */ +PROOF extern thm FINMAP_INSERT_ID; + +/* + * `finmap_lookup m key == NONE ==> finmap_delete key m == m`. + */ +PROOF extern thm FINMAP_DELETE_ID; + +/* + * `finmap_lookup m key == SOME v ==> + * finmap_insert key v (finmap_delete key m) == m`. + */ +PROOF extern thm FINMAP_DECOMPOSE; + /* ------------------------------------------------------------------------- */ /* Laws: finite domain */ /* ------------------------------------------------------------------------- */ @@ -106,3 +234,50 @@ PROOF extern thm FINMAP_DOM_EMPTY; /* `forall key v. finmap_dom (finmap_singleton key v) == {key}`. */ PROOF extern thm FINMAP_DOM_SINGLETON; + +/* + * `key IN finmap_dom m <=> ~(finmap_lookup m key == NONE)`. + */ +PROOF extern thm FINMAP_IN_DOM; + +/* + * `key IN finmap_dom m <=> + * exists v. finmap_lookup m key == SOME v`. + */ +PROOF extern thm FINMAP_IN_DOM_SOME; + +/* + * `~(key IN finmap_dom m) <=> finmap_lookup m key == NONE`. + */ +PROOF extern thm FINMAP_NOT_IN_DOM; + +/* + * `finmap_dom m == {} <=> m == finmap_empty`. + */ +PROOF extern thm FINMAP_DOM_EQ_EMPTY; + +/* + * `finmap_dom (finmap_insert key v m) == key INSERT finmap_dom m`. + */ +PROOF extern thm FINMAP_DOM_INSERT; + +/* + * `finmap_dom (finmap_delete key m) == finmap_dom m DELETE key`. + */ +PROOF extern thm FINMAP_DOM_DELETE; + +/* ------------------------------------------------------------------------- */ +/* Induction */ +/* ------------------------------------------------------------------------- */ + +/* + * Fresh-key induction: + * + * P finmap_empty ==> + * (forall key v m. + * finmap_lookup m key == NONE ==> + * P m ==> + * P (finmap_insert key v m)) ==> + * forall m:(K,V)finmap. P m. + */ +PROOF extern thm FINMAP_INDUCT; -- Gitee From c86cdba53e06ed20c8be90ab12fb19aeb080680c Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Sat, 8 Aug 2026 08:29:58 +0800 Subject: [PATCH 23/35] feat(gmap_ra): complete map algebra and update laws --- test/gmap_ra_regression.c | 333 ++++++++ theory/logic/gmap_ra.c | 1673 +++++++++++++++++++++++++++++++++++-- theory/logic/gmap_ra.h | 211 ++++- 3 files changed, 2157 insertions(+), 60 deletions(-) create mode 100644 test/gmap_ra_regression.c diff --git a/test/gmap_ra_regression.c b/test/gmap_ra_regression.c new file mode 100644 index 0000000..9820fea --- /dev/null +++ b/test/gmap_ra_regression.c @@ -0,0 +1,333 @@ +#include "proof/theory/logic/excl_ra.h" +#include "proof/theory/logic/gmap_ra.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/excl_ra.c" +#require "proof/theory/logic/gmap_ra.c" + +PROOF static void check_gmap_theorem( + const thm theorem, + const term expected, + const char *label) { + ENSURE_COND(!IS_NULL(theorem), "%s is empty", label); + ENSURE_COND(vector_size(hyp(theorem)) == 0, + "%s unexpectedly has hypotheses", label); + ENSURE_COND(alpha_compare(concl(theorem), expected) == 0, + "%s has the wrong conclusion", label); + return; +err: + ERR_FUN_PUTS("check_gmap_theorem", label); +} + +/* Overwriting an invalid entry is valid when the replacement is valid. This + * distinguishes the exact insert characterization from the too-strong and + * false condition that the pre-overwrite map itself must be valid. */ +PROOF static thm prove_gmap_valid_overwrite_regression(void) { + term old_map = ` + finmap_insert + (0:num) + (ExclInvalid:(num)excl) + (finmap_empty:(num,(num)excl)finmap) + `; + term map_ra = ` + (gmap_ra (excl_ra:((num)excl)ra)): + ((num,(num)excl)finmap)ra + `; + + thm insertion = ispecl_rule( + TERM_LIST( + `excl_ra:((num)excl)ra`, + `0:num`, + `Excl (7:num)`, + old_map), + GMAP_RA_VALID_INSERT); + thm payload_valid = ispec_rule(`7:num`, EXCL_RA_VALID_OWNED); + + thm empty_valid = ispec_rule(map_ra, RA_VALID_UNIT); + empty_valid = rewrite_rule( + THM_LIST(GMAP_RA_UNIT), + empty_valid); + + thm delete_insert = ispecl_rule( + TERM_LIST( + `0:num`, + `ExclInvalid:(num)excl`, + `finmap_empty:(num,(num)excl)finmap`), + FINMAP_DELETE_INSERT); + thm deleted_is_empty = rewrite_rule( + THM_LIST(FINMAP_DELETE_EMPTY), + delete_insert); + thm deleted_validity_eq = ap_term_rule( + `ra_valid + ((gmap_ra (excl_ra:((num)excl)ra)): + ((num,(num)excl)finmap)ra)`, + deleted_is_empty); + thm deleted_valid = eq_mp_rule( + gsym_rule(deleted_validity_eq), + empty_valid); + + thm result = eq_mp_rule( + gsym_rule(insertion), + conj_rule(payload_valid, deleted_valid)); + ENSURE_COND(alpha_compare( + concl(result), + `ra_valid + ((gmap_ra (excl_ra:((num)excl)ra)): + ((num,(num)excl)finmap)ra) + (finmap_insert + (0:num) + (Excl (7:num)) + (finmap_insert + (0:num) + (ExclInvalid:(num)excl) + (finmap_empty: + (num,(num)excl)finmap)))`) == 0, + "overwrite regression proved the wrong map"); + return result; +err: + ERR_FUN_PUTS("prove_gmap_valid_overwrite_regression"); + return empty_theorem; +} + +PROOF static thm prove_gmap_invalid_old_entry_regression(void) { + term old_map = ` + finmap_insert + (0:num) + (ExclInvalid:(num)excl) + (finmap_empty:(num,(num)excl)finmap) + `; + term goal_tm = ` + ~(ra_valid + ((gmap_ra (excl_ra:((num)excl)ra)): + ((num,(num)excl)finmap)ra) + (finmap_insert + (0:num) + (ExclInvalid:(num)excl) + (finmap_empty:(num,(num)excl)finmap))) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = DISCH_TAC(root, "Hold_valid"); + thm invalid_lookup_valid = mp_rule( + ispecl_rule( + TERM_LIST( + `excl_ra:((num)excl)ra`, + `0:num`, + `ExclInvalid:(num)excl`, + old_map), + GMAP_RA_VALID_LOOKUP), + assume_rule(` + ra_valid + ((gmap_ra (excl_ra:((num)excl)ra)): + ((num,(num)excl)finmap)ra) + (finmap_insert + (0:num) + (ExclInvalid:(num)excl) + (finmap_empty:(num,(num)excl)finmap)) + `)); + invalid_lookup_valid = mp_rule( + invalid_lookup_valid, + ispecl_rule( + TERM_LIST( + `0:num`, + `ExclInvalid:(num)excl`, + `finmap_empty:(num,(num)excl)finmap`), + FINMAP_INSERT_LOOKUP_EQ)); + ACCEPT_TAC( + body, + not_elim_rule(EXCL_RA_INVALID, invalid_lookup_valid)); + return gnode_prove(root); +} + +PROOF static int audit_gmap_regressions(void) { + term R = `excl_ra:((num)excl)ra`; + term key = `key:num`; + term a = `a:(num)excl`; + term b = `b:(num)excl`; + term m = `m:(num,(num)excl)finmap`; + term P = `P:(num)excl->bool`; + + check_gmap_theorem( + ispecl_rule(TERM_LIST(R, key, m), GMAP_RA_VALID_LOOKUP_DELETE), + `ra_valid + (gmap_ra (excl_ra:((num)excl)ra)) + (m:(num,(num)excl)finmap) <=> + ra_valid + (option_ra (excl_ra:((num)excl)ra)) + (finmap_lookup m (key:num)) && + ra_valid + (gmap_ra (excl_ra:((num)excl)ra)) + (finmap_delete key m)`, + "GMAP_RA_VALID_LOOKUP_DELETE"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, key, a, m), + GMAP_RA_VALID_DELETE_SOME), + `finmap_lookup + (m:(num,(num)excl)finmap) + (key:num) == SOME (a:(num)excl) ==> + (ra_valid + (gmap_ra (excl_ra:((num)excl)ra)) + m <=> + ra_valid (excl_ra:((num)excl)ra) a && + ra_valid + (gmap_ra (excl_ra:((num)excl)ra)) + (finmap_delete key m))`, + "GMAP_RA_VALID_DELETE_SOME"); + check_gmap_theorem( + ispecl_rule(TERM_LIST(R, key, a, m), GMAP_RA_VALID_LOOKUP), + `ra_valid + (gmap_ra (excl_ra:((num)excl)ra)) + (m:(num,(num)excl)finmap) ==> + finmap_lookup m (key:num) == SOME (a:(num)excl) ==> + ra_valid (excl_ra:((num)excl)ra) a`, + "GMAP_RA_VALID_LOOKUP"); + check_gmap_theorem( + ispecl_rule(TERM_LIST(R, key, a, m), GMAP_RA_VALID_INSERT), + `ra_valid + (gmap_ra (excl_ra:((num)excl)ra)) + (finmap_insert + (key:num) + (a:(num)excl) + (m:(num,(num)excl)finmap)) <=> + ra_valid (excl_ra:((num)excl)ra) a && + ra_valid + (gmap_ra (excl_ra:((num)excl)ra)) + (finmap_delete key m)`, + "GMAP_RA_VALID_INSERT"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, key, a, m), + GMAP_RA_VALID_INSERT_OF_VALID), + `ra_valid (excl_ra:((num)excl)ra) (a:(num)excl) ==> + ra_valid + (gmap_ra (excl_ra:((num)excl)ra)) + (m:(num,(num)excl)finmap) ==> + ra_valid + (gmap_ra (excl_ra:((num)excl)ra)) + (finmap_insert (key:num) a m)`, + "GMAP_RA_VALID_INSERT_OF_VALID"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, key, a, m), + GMAP_RA_VALID_INSERT_FRESH), + `finmap_lookup + (m:(num,(num)excl)finmap) + (key:num) == NONE ==> + (ra_valid + (gmap_ra (excl_ra:((num)excl)ra)) + (finmap_insert key (a:(num)excl) m) <=> + ra_valid (excl_ra:((num)excl)ra) a && + ra_valid + (gmap_ra (excl_ra:((num)excl)ra)) + m)`, + "GMAP_RA_VALID_INSERT_FRESH"); + check_gmap_theorem( + ispecl_rule(TERM_LIST(R, key, m), GMAP_RA_VALID_DELETE), + `ra_valid + (gmap_ra (excl_ra:((num)excl)ra)) + (m:(num,(num)excl)finmap) ==> + ra_valid + (gmap_ra (excl_ra:((num)excl)ra)) + (finmap_delete (key:num) m)`, + "GMAP_RA_VALID_DELETE"); + check_gmap_theorem( + ispecl_rule(TERM_LIST(R, key, m), GMAP_RA_INCLUDED_DELETE), + `ra_included + (gmap_ra (excl_ra:((num)excl)ra)) + (finmap_delete + (key:num) + (m:(num,(num)excl)finmap)) + m`, + "GMAP_RA_INCLUDED_DELETE"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, key, a, b, m), + GMAP_RA_UPDATE_INSERT), + `ra_update + (excl_ra:((num)excl)ra) + (a:(num)excl) + (b:(num)excl) ==> + ra_update + (gmap_ra (excl_ra:((num)excl)ra)) + (finmap_insert + (key:num) + a + (m:(num,(num)excl)finmap)) + (finmap_insert key b m)`, + "GMAP_RA_UPDATE_INSERT"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, key, a, b, m), + GMAP_RA_UPDATE_AT), + `finmap_lookup + (m:(num,(num)excl)finmap) + (key:num) == SOME (a:(num)excl) ==> + ra_update + (excl_ra:((num)excl)ra) + a + (b:(num)excl) ==> + ra_update + (gmap_ra (excl_ra:((num)excl)ra)) + m + (finmap_insert key b m)`, + "GMAP_RA_UPDATE_AT"); + check_gmap_theorem( + ispecl_rule(TERM_LIST(R, key, m), GMAP_RA_UPDATE_DELETE), + `ra_update + (gmap_ra (excl_ra:((num)excl)ra)) + (m:(num,(num)excl)finmap) + (finmap_delete (key:num) m)`, + "GMAP_RA_UPDATE_DELETE"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, key, a, P, m), + GMAP_RA_UPDATE_INSERT_ND), + `ra_update_nd + (excl_ra:((num)excl)ra) + (a:(num)excl) + (P:(num)excl->bool) ==> + ra_update_nd + (gmap_ra (excl_ra:((num)excl)ra)) + (finmap_insert + (key:num) + a + (m:(num,(num)excl)finmap)) + (\result:(num,(num)excl)finmap. + exists selected:(num)excl. + P selected && + result == finmap_insert key selected m)`, + "GMAP_RA_UPDATE_INSERT_ND"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, key, a, P, m), + GMAP_RA_UPDATE_AT_ND), + `finmap_lookup + (m:(num,(num)excl)finmap) + (key:num) == SOME (a:(num)excl) ==> + ra_update_nd + (excl_ra:((num)excl)ra) + a + (P:(num)excl->bool) ==> + ra_update_nd + (gmap_ra (excl_ra:((num)excl)ra)) + m + (\result:(num,(num)excl)finmap. + exists selected:(num)excl. + P selected && + result == finmap_insert key selected m)`, + "GMAP_RA_UPDATE_AT_ND"); + + thm overwrite = prove_gmap_valid_overwrite_regression(); + ENSURE_COND(!IS_NULL(overwrite) && vector_size(hyp(overwrite)) == 0, + "valid overwrite regression failed"); + thm old_invalid = prove_gmap_invalid_old_entry_regression(); + ENSURE_COND(!IS_NULL(old_invalid) && vector_size(hyp(old_invalid)) == 0, + "invalid overwritten entry regression failed"); + return 0; +err: + ERR_FUN_PUTS("audit_gmap_regressions"); + return -1; +} + +PROOF static int _GMAP_RA_REGRESSION = audit_gmap_regressions(); diff --git a/theory/logic/gmap_ra.c b/theory/logic/gmap_ra.c index 63d96e1..4e7745e 100644 --- a/theory/logic/gmap_ra.c +++ b/theory/logic/gmap_ra.c @@ -494,6 +494,83 @@ PROOF static thm prove_gmap_ra_op_lookup(void) { PROOF thm GMAP_RA_OP_LOOKUP = prove_gmap_ra_op_lookup(); +PROOF static thm prove_gmap_ra_op_insert_insert(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (b:V) + (m:(K,V)finmap) + (n:(K,V)finmap). + ra_op + (gmap_ra R) + (finmap_insert key a m) + (finmap_insert key b n) == + finmap_insert + key + (ra_op R a b) + (ra_op (gmap_ra R) m n) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "query"); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, NULL); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST( + GMAP_RA_OP_LOOKUP, + FINMAP_INSERT_LOOKUP, + OPTION_RA_OP_SOME_SOME)); + } + return gnode_prove(root); +} + +PROOF thm GMAP_RA_OP_INSERT_INSERT = + prove_gmap_ra_op_insert_insert(); + +PROOF static thm prove_gmap_ra_op_delete(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (m:(K,V)finmap) + (n:(K,V)finmap). + ra_op + (gmap_ra R) + (finmap_delete key m) + (finmap_delete key n) == + finmap_delete key (ra_op (gmap_ra R) m n) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "query"); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, NULL); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST( + GMAP_RA_OP_LOOKUP, + FINMAP_DELETE_LOOKUP, + OPTION_RA_OP_NONE_L)); + } + return gnode_prove(root); +} + +PROOF thm GMAP_RA_OP_DELETE = + prove_gmap_ra_op_delete(); + PROOF static thm prove_gmap_ra_valid(void) { term goal_tm = ` forall @@ -517,6 +594,351 @@ PROOF static thm prove_gmap_ra_valid(void) { PROOF thm GMAP_RA_VALID = prove_gmap_ra_valid(); +/* + * Isolating one key partitions the pointwise validity obligation into the + * optional value at that key and all remaining keys. The reverse direction + * simply puts those two disjoint cases back together. + */ +PROOF static thm prove_gmap_ra_valid_lookup_delete(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (m:(K,V)finmap). + ra_valid (gmap_ra R) m <=> + ra_valid + (option_ra R) + (finmap_lookup m key) && + ra_valid + (gmap_ra R) + (finmap_delete key m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hm_valid"); + thm source_all = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `m:(K,V)finmap`), + GMAP_RA_VALID), + assume_rule(`ra_valid (gmap_ra (R:(V)ra)) (m:(K,V)finmap)`)); + gnode_list forward_parts = CONJ_TAC(forward); + ACCEPT_TAC( + forward_parts[0], + spec_rule(`key:K`, source_all)); + + gnode deleted = CONV_TAC( + forward_parts[1], + once_rewrite_conv(THM_LIST(GMAP_RA_VALID))); + deleted = GEN_TAC(deleted, "query"); + deleted = ASSUME_TAC( + deleted, + spec_rule(`query:K`, source_all), + "Hsource_at"); + gnode_list delete_cases = BOOL_CASES_TAC( + deleted, `(query:K) == (key:K)`, "Hkey"); + for (size_t i = 0; i < vector_size(delete_cases); ++i) { + thm branch = i == 0 + ? assume_rule(`query:K == key`) + : assume_rule(`~(query:K == key)`); + gnode reduced_goal = CONV_TAC( + delete_cases[i], + rewrite_conv(THM_LIST( + branch, + FINMAP_DELETE_LOOKUP))); + if (i == 0) { + ACCEPT_TAC( + reduced_goal, + ispec_rule(`R:(V)ra`, OPTION_RA_VALID_NONE)); + } else { + ACCEPT_TAC( + reduced_goal, + assume_rule(` + ra_valid + (option_ra (R:(V)ra)) + (finmap_lookup (m:(K,V)finmap) (query:K)) + `)); + } + } + + gnode reverse = DISCH_TAC(directions[1], "Hparts"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hparts", + "Hlookup_valid", + "Hdelete_valid"); + thm deleted_all = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `finmap_delete (key:K) (m:(K,V)finmap)`), + GMAP_RA_VALID), + assume_rule(` + ra_valid + (gmap_ra (R:(V)ra)) + (finmap_delete (key:K) (m:(K,V)finmap)) + `)); + reverse = CONV_TAC( + reverse, + once_rewrite_conv(THM_LIST(GMAP_RA_VALID))); + reverse = GEN_TAC(reverse, "query"); + reverse = ASSUME_TAC( + reverse, + spec_rule(`query:K`, deleted_all), + "Hdelete_at"); + gnode_list restore_cases = BOOL_CASES_TAC( + reverse, `(query:K) == (key:K)`, "Hkey"); + for (size_t i = 0; i < vector_size(restore_cases); ++i) { + thm branch = i == 0 + ? assume_rule(`query:K == key`) + : assume_rule(`~(query:K == key)`); + if (i == 0) { + gnode reduced_goal = CONV_TAC( + restore_cases[i], + rewrite_conv(THM_LIST(branch))); + ACCEPT_TAC( + reduced_goal, + assume_rule(` + ra_valid + (option_ra (R:(V)ra)) + (finmap_lookup (m:(K,V)finmap) (key:K)) + `)); + } else { + thm restored = rewrite_rule( + THM_LIST( + branch, + FINMAP_DELETE_LOOKUP), + assume_rule(` + ra_valid + (option_ra (R:(V)ra)) + (finmap_lookup + (finmap_delete (key:K) (m:(K,V)finmap)) + (query:K)) + `)); + ACCEPT_TAC(restore_cases[i], restored); + } + } + return gnode_prove(root); +} + +PROOF thm GMAP_RA_VALID_LOOKUP_DELETE = + prove_gmap_ra_valid_lookup_delete(); + +PROOF static thm prove_gmap_ra_valid_delete_some(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (m:(K,V)finmap). + finmap_lookup m key == SOME a ==> + (ra_valid (gmap_ra R) m <=> + ra_valid R a && + ra_valid (gmap_ra R) (finmap_delete key m)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm split_validity = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `m:(K,V)finmap`), + GMAP_RA_VALID_LOOKUP_DELETE); + split_validity = rewrite_rule( + THM_LIST( + assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) + `), + OPTION_RA_VALID_SOME), + split_validity); + ACCEPT_TAC(body, split_validity); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_VALID_DELETE_SOME = + prove_gmap_ra_valid_delete_some(); + +PROOF static thm prove_gmap_ra_valid_lookup(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (m:(K,V)finmap). + ra_valid (gmap_ra R) m ==> + finmap_lookup m key == SOME a ==> + ra_valid R a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm payload_split = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `m:(K,V)finmap`), + GMAP_RA_VALID_DELETE_SOME), + assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) + `)); + thm split_validity = eq_mp_rule( + payload_split, + assume_rule(`ra_valid (gmap_ra (R:(V)ra)) (m:(K,V)finmap)`)); + ACCEPT_TAC(body, conjunct1_rule(split_validity)); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_VALID_LOOKUP = + prove_gmap_ra_valid_lookup(); + +PROOF static thm prove_gmap_ra_valid_delete(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (m:(K,V)finmap). + ra_valid (gmap_ra R) m ==> + ra_valid (gmap_ra R) (finmap_delete key m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm split_validity = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `m:(K,V)finmap`), + GMAP_RA_VALID_LOOKUP_DELETE), + assume_rule(`ra_valid (gmap_ra (R:(V)ra)) (m:(K,V)finmap)`)); + ACCEPT_TAC(body, conjunct2_rule(split_validity)); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_VALID_DELETE = + prove_gmap_ra_valid_delete(); + +PROOF static thm prove_gmap_ra_valid_insert(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (m:(K,V)finmap). + ra_valid + (gmap_ra R) + (finmap_insert key a m) <=> + ra_valid R a && + ra_valid + (gmap_ra R) + (finmap_delete key m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm split_validity = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `finmap_insert (key:K) (a:V) (m:(K,V)finmap)`), + GMAP_RA_VALID_LOOKUP_DELETE); + split_validity = rewrite_rule( + THM_LIST( + FINMAP_INSERT_LOOKUP_EQ, + OPTION_RA_VALID_SOME, + FINMAP_DELETE_INSERT), + split_validity); + ACCEPT_TAC(body, split_validity); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_VALID_INSERT = + prove_gmap_ra_valid_insert(); + +PROOF static thm prove_gmap_ra_valid_insert_of_valid(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (m:(K,V)finmap). + ra_valid R a ==> + ra_valid (gmap_ra R) m ==> + ra_valid + (gmap_ra R) + (finmap_insert key a m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm deleted_valid = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `m:(K,V)finmap`), + GMAP_RA_VALID_DELETE), + assume_rule(`ra_valid (gmap_ra (R:(V)ra)) (m:(K,V)finmap)`)); + thm insert_characterization = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `m:(K,V)finmap`), + GMAP_RA_VALID_INSERT); + thm inserted_valid = eq_mp_rule( + gsym_rule(insert_characterization), + conj_rule( + assume_rule(`ra_valid (R:(V)ra) (a:V)`), + deleted_valid)); + ACCEPT_TAC(body, inserted_valid); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_VALID_INSERT_OF_VALID = + prove_gmap_ra_valid_insert_of_valid(); + +PROOF static thm prove_gmap_ra_valid_insert_fresh(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (m:(K,V)finmap). + finmap_lookup m key == NONE ==> + (ra_valid + (gmap_ra R) + (finmap_insert key a m) <=> + ra_valid R a && ra_valid (gmap_ra R) m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm delete_id = mp_rule( + ispecl_rule( + TERM_LIST( + `key:K`, + `m:(K,V)finmap`), + FINMAP_DELETE_ID), + assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == NONE + `)); + thm insert_validity = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `m:(K,V)finmap`), + GMAP_RA_VALID_INSERT); + ACCEPT_TAC( + body, + rewrite_rule(THM_LIST(delete_id), insert_validity)); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_VALID_INSERT_FRESH = + prove_gmap_ra_valid_insert_fresh(); + /* * Two singletons at the same key compose to the singleton of the base * composition. Map extensionality reduces the proof to the selected key and @@ -524,36 +946,215 @@ PROOF thm GMAP_RA_VALID = */ PROOF static thm prove_gmap_ra_singleton_op(void) { term goal_tm = ` - forall (R:(V)ra) (key:K) (a:V) (b:V). - ra_op - (gmap_ra R) - (finmap_singleton key a) - (finmap_singleton key b) == - finmap_singleton key (ra_op R a b) + forall (R:(V)ra) (key:K) (a:V) (b:V). + ra_op + (gmap_ra R) + (finmap_singleton key a) + (finmap_singleton key b) == + finmap_singleton key (ra_op R a b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "query"); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, "Hkey"); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST( + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_OP_NONE_L, + OPTION_RA_OP_SOME_SOME)); + } + return gnode_prove(root); +} + +PROOF thm GMAP_RA_SINGLETON_OP = + prove_gmap_ra_singleton_op(); + +PROOF static thm prove_gmap_ra_singleton_op_fresh(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (m:(K,V)finmap). + finmap_lookup m key == NONE ==> + ra_op + (gmap_ra R) + (finmap_singleton key a) + m == + finmap_insert key a m + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "query"); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, NULL); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST( + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP, + FINMAP_INSERT_LOOKUP, + OPTION_RA_OP_NONE_L, + OPTION_RA_OP_NONE_R)); + } + return gnode_prove(root); +} + +PROOF thm GMAP_RA_SINGLETON_OP_FRESH = + prove_gmap_ra_singleton_op_fresh(); + +PROOF static thm prove_gmap_ra_decompose(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (m:(K,V)finmap). + finmap_lookup m key == SOME a ==> + m == + ra_op + (gmap_ra R) + (finmap_singleton key a) + (finmap_delete key m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm restored = mp_rule( + ispecl_rule( + TERM_LIST( + `key:K`, + `a:V`, + `m:(K,V)finmap`), + FINMAP_DECOMPOSE), + assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) + `)); + thm singleton_op = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `finmap_delete (key:K) (m:(K,V)finmap)`), + GMAP_RA_SINGLETON_OP_FRESH), + ispecl_rule( + TERM_LIST( + `key:K`, + `m:(K,V)finmap`), + FINMAP_DELETE_LOOKUP_EQ)); + ACCEPT_TAC( + body, + trans_rule( + gsym_rule(restored), + gsym_rule(singleton_op))); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_DECOMPOSE = + prove_gmap_ra_decompose(); + +/* The deleted remainder is always fresh at key, so recombining it with a + * singleton is exactly overwrite insertion into the original map. */ +PROOF static thm prove_gmap_ra_singleton_op_delete(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (m:(K,V)finmap). + ra_op + (gmap_ra R) + (finmap_singleton key a) + (finmap_delete key m) == + finmap_insert key a m + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm fresh_composition = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `finmap_delete (key:K) (m:(K,V)finmap)`), + GMAP_RA_SINGLETON_OP_FRESH), + ispecl_rule( + TERM_LIST( + `key:K`, + `m:(K,V)finmap`), + FINMAP_DELETE_LOOKUP_EQ)); + thm restore_insertion = ispecl_rule( + TERM_LIST( + `key:K`, + `a:V`, + `m:(K,V)finmap`), + FINMAP_INSERT_DELETE); + ACCEPT_TAC( + body, + trans_rule(fresh_composition, restore_insertion)); + return gnode_prove(root); +} + +PROOF static thm GMAP_RA_SINGLETON_OP_DELETE = + prove_gmap_ra_singleton_op_delete(); + +PROOF static thm prove_gmap_ra_dom_op(void) { + term goal_tm = ` + forall + (R:(V)ra) + (m:(K,V)finmap) + (n:(K,V)finmap). + finmap_dom (ra_op (gmap_ra R) m n) == + finmap_dom m UNION finmap_dom n `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST( + get_theorem_by_name("EXTENSION")))); body = GEN_TAC(body, "query"); - gnode_list cases = BOOL_CASES_TAC( - body, `(query:K) == (key:K)`, "Hkey"); - for (size_t i = 0; i < vector_size(cases); ++i) { - CONV_WITH_ASMP_TAC( - cases[i], - rewrite_conv, - THM_LIST( - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP, - OPTION_RA_OP_NONE_L, - OPTION_RA_OP_SOME_SOME)); + gnode_list m_cases = CASES_TAC( + body, + `finmap_lookup (m:(K,V)finmap) (query:K)`, + "Hm"); + for (size_t i = 0; i < vector_size(m_cases); ++i) { + gnode_list n_cases = CASES_TAC( + m_cases[i], + `finmap_lookup (n:(K,V)finmap) (query:K)`, + "Hn"); + for (size_t j = 0; j < vector_size(n_cases); ++j) { + CONV_WITH_ASMP_TAC( + n_cases[j], + rewrite_conv, + THM_LIST( + FINMAP_IN_DOM, + get_theorem_by_name("IN_UNION"), + GMAP_RA_OP_LOOKUP, + OPTION_RA_OP_NONE_L, + OPTION_RA_OP_NONE_R, + OPTION_RA_OP_SOME_SOME, + get_theorem_by_name("option_DISTINCT"))); + } } return gnode_prove(root); } -PROOF thm GMAP_RA_SINGLETON_OP = - prove_gmap_ra_singleton_op(); +PROOF thm GMAP_RA_DOM_OP = + prove_gmap_ra_dom_op(); /* * Pointwise validity of a singleton has one nontrivial point. The selected @@ -613,6 +1214,18 @@ PROOF thm GMAP_RA_VALID_SINGLETON = /* Inclusion */ /* ------------------------------------------------------------------------- */ +PROOF static thm gmap_lookup_included_def = new_fun_definition(` + gmap_lookup_included + (R:(V)ra) + (m:(K,V)finmap) + (n:(K,V)finmap) <=> + forall k:K. + ra_included + (option_ra R) + (finmap_lookup m k) + (finmap_lookup n k) +`); + /* A finite-map extension supplies one option-RA extension at every key. The * pointwise witness is the corresponding lookup in the finite-map frame. */ PROOF static thm prove_gmap_ra_included_lookup(void) { @@ -694,62 +1307,642 @@ PROOF static thm prove_gmap_ra_included_singleton(void) { ispecl_rule( TERM_LIST( `R:(V)ra`, - `finmap_singleton (key:K) (a:V)`, - `finmap_singleton (key:K) (b:V)`), + `finmap_singleton (key:K) (a:V)`, + `finmap_singleton (key:K) (b:V)`), + GMAP_RA_INCLUDED_LOOKUP), + assume_rule(` + ra_included + (gmap_ra (R:(V)ra)) + (finmap_singleton (key:K) (a:V)) + (finmap_singleton (key:K) (b:V)) + `)); + thm at_key = spec_rule(`key:K`, pointwise); + at_key = rewrite_rule( + THM_LIST( + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_INCLUDED_SOME_SOME), + at_key); + ACCEPT_TAC(forward, at_key); + + gnode reverse = DISCH_TAC( + directions[1], "Hbase_included"); + thm base_included = pure_once_rewrite_rule( + THM_LIST(ra_included_def), + assume_rule(`ra_included (R:(V)ra) (a:V) (b:V)`)); + reverse = ASSUME_TAC( + reverse, base_included, "Hbase_extension"); + reverse = ASMP_EXISTS_TAC( + reverse, "Hbase_extension", "base_frame"); + reverse = CONV_TAC( + reverse, + once_rewrite_conv(THM_LIST(ra_included_def))); + reverse = EXISTS_TAC( + reverse, + `finmap_singleton (key:K) (base_frame:V)`); + + thm lifted_extension = beta_rule(ap_term_rule( + `\x:V. finmap_singleton (key:K) x`, + assume_rule(` + (b:V) == + ra_op (R:(V)ra) (a:V) (base_frame:V) + `))); + thm singleton_composition = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `base_frame:V`), + GMAP_RA_SINGLETON_OP); + ACCEPT_TAC( + reverse, + trans_rule( + lifted_extension, + gsym_rule(singleton_composition))); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_INCLUDED_SINGLETON = + prove_gmap_ra_included_singleton(); + +PROOF static thm prove_gmap_lookup_included_empty(void) { + term goal_tm = ` + forall (R:(V)ra) (n:(K,V)finmap). + gmap_lookup_included R finmap_empty n ==> + ra_included (gmap_ra R) finmap_empty n + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm unit_included = ispecl_rule( + TERM_LIST( + `gmap_ra (R:(V)ra):((K,V)finmap)ra`, + `n:(K,V)finmap`), + RA_INCLUDED_UNIT); + unit_included = rewrite_rule( + THM_LIST(GMAP_RA_UNIT), + unit_included); + ACCEPT_TAC(body, unit_included); + return gnode_prove(root); +} + +PROOF static thm GMAP_LOOKUP_INCLUDED_EMPTY = + prove_gmap_lookup_included_empty(); + +PROOF static thm prove_gmap_lookup_included_insert(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (m:(K,V)finmap). + finmap_lookup m key == NONE ==> + (forall n:(K,V)finmap. + gmap_lookup_included R m n ==> + ra_included (gmap_ra R) m n) ==> + forall n:(K,V)finmap. + gmap_lookup_included R (finmap_insert key a m) n ==> + ra_included + (gmap_ra R) + (finmap_insert key a m) + n + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "key"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "m"); + body = DISCH_TAC(body, "Hfresh"); + body = DISCH_TAC(body, "Hsmaller"); + body = GEN_TAC(body, "n"); + body = DISCH_TAC(body, "Hpointwise"); + + thm pointwise = pure_once_rewrite_rule( + THM_LIST(gmap_lookup_included_def), + assume_rule(` + gmap_lookup_included + (R:(V)ra) + (finmap_insert (key:K) (a:V) (m:(K,V)finmap)) + (n:(K,V)finmap) + `)); + thm included_at_key = spec_rule(`key:K`, pointwise); + included_at_key = rewrite_rule( + THM_LIST(FINMAP_INSERT_LOOKUP), + included_at_key); + + gnode_list target_cases = CASES_TAC( + body, + `finmap_lookup (n:(K,V)finmap) (key:K)`, + "Htarget"); + + thm target_none = assume_rule(gnode_get_asmps( + target_cases[0], CONST_STRING_LIST("Htarget"))[0]); + thm impossible_inclusion = rewrite_rule( + THM_LIST(target_none), + included_at_key); + CONTR_TAC( + target_cases[0], + not_elim_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `a:V`), + OPTION_RA_NOT_INCLUDED_SOME_NONE), + impossible_inclusion)); + + thm target_some = assume_rule(gnode_get_asmps( + target_cases[1], CONST_STRING_LIST("Htarget"))[0]); + term b = dest_comb(dest_eq(concl(target_some)).tm2).tm2; + term singleton_b = mk_comb( + `finmap_singleton (key:K):V->(K,V)finmap`, + b); + thm payload_included = rewrite_rule( + THM_LIST( + target_some, + OPTION_RA_INCLUDED_SOME_SOME), + included_at_key); + + term rest_pointwise = ` + gmap_lookup_included + (R:(V)ra) + (m:(K,V)finmap) + (finmap_delete (key:K) (n:(K,V)finmap)) + `; + gnode_list rest_assertion = ASSERT_TAC( + target_cases[1], rest_pointwise, "Hrest_pointwise"); + + gnode rest_goal = CONV_TAC( + rest_assertion[1], + once_rewrite_conv(THM_LIST(gmap_lookup_included_def))); + rest_goal = GEN_TAC(rest_goal, "query"); + gnode_list query_cases = BOOL_CASES_TAC( + rest_goal, `(query:K) == (key:K)`, NULL); + + CONV_WITH_ASMP_TAC( + query_cases[0], + rewrite_conv, + THM_LIST( + FINMAP_DELETE_LOOKUP, + OPTION_RA_INCLUDED_NONE)); + + thm original_query = spec_rule(`query:K`, pointwise); + original_query = rewrite_rule( + THM_LIST( + assume_rule(`~((query:K) == (key:K))`), + FINMAP_INSERT_LOOKUP, + FINMAP_DELETE_LOOKUP), + original_query); + gnode rest_ne = CONV_WITH_ASMP_TAC( + query_cases[1], + rewrite_conv, + THM_LIST(FINMAP_DELETE_LOOKUP)); + ACCEPT_TAC(rest_ne, original_query); + + thm rest_included = mp_rule( + ispec_rule( + `finmap_delete (key:K) (n:(K,V)finmap)`, + assume_rule(` + forall target:(K,V)finmap. + gmap_lookup_included + (R:(V)ra) + (m:(K,V)finmap) + target ==> + ra_included (gmap_ra R) m target + `)), + assume_rule(rest_pointwise)); + thm singleton_included = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + b), + GMAP_RA_INCLUDED_SINGLETON)), + payload_included); + thm combined_included = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `gmap_ra (R:(V)ra):((K,V)finmap)ra`, + `finmap_singleton (key:K) (a:V)`, + singleton_b, + `m:(K,V)finmap`, + `finmap_delete (key:K) (n:(K,V)finmap)`), + RA_INCLUDED_OP_MONO), + singleton_included), + rest_included); + thm source_composition = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `m:(K,V)finmap`), + GMAP_RA_SINGLETON_OP_FRESH), + assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == NONE + `)); + thm target_composition = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + b, + `n:(K,V)finmap`), + GMAP_RA_DECOMPOSE), + target_some); + combined_included = rewrite_rule( + THM_LIST( + source_composition, + gsym_rule(target_composition)), + combined_included); + ACCEPT_TAC(rest_assertion[0], combined_included); + return gnode_prove(root); +} + +PROOF static thm GMAP_LOOKUP_INCLUDED_INSERT = + prove_gmap_lookup_included_insert(); + +PROOF static thm prove_gmap_ra_included_of_lookup(void) { + term goal_tm = ` + forall + (R:(V)ra) + (m:(K,V)finmap) + (n:(K,V)finmap). + (forall k:K. + ra_included + (option_ra R) + (finmap_lookup m k) + (finmap_lookup n k)) ==> + ra_included (gmap_ra R) m n + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + term property = ` + \source:(K,V)finmap. + forall target:(K,V)finmap. + gmap_lookup_included (R:(V)ra) source target ==> + ra_included (gmap_ra R) source target + `; + thm induction = beta_rule(ispec_rule(property, FINMAP_INDUCT)); + induction = mp_rule( + induction, + ispec_rule( + `R:(V)ra`, + GMAP_LOOKUP_INCLUDED_EMPTY)); + induction = mp_rule( + induction, + ispec_rule( + `R:(V)ra`, + GMAP_LOOKUP_INCLUDED_INSERT)); + thm selected_source = ispec_rule( + `m:(K,V)finmap`, + induction); + thm selected_target = ispec_rule( + `n:(K,V)finmap`, + selected_source); + thm pointwise = pure_once_rewrite_rule( + THM_LIST(gsym_rule(gmap_lookup_included_def)), + assume_rule(` + forall k:K. + ra_included + (option_ra (R:(V)ra)) + (finmap_lookup (m:(K,V)finmap) k) + (finmap_lookup (n:(K,V)finmap) k) + `)); + ACCEPT_TAC( + body, + mp_rule(selected_target, pointwise)); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_INCLUDED_OF_LOOKUP = + prove_gmap_ra_included_of_lookup(); + +PROOF static thm prove_gmap_ra_included_lookup_iff(void) { + term goal_tm = ` + forall + (R:(V)ra) + (m:(K,V)finmap) + (n:(K,V)finmap). + ra_included (gmap_ra R) m n <=> + forall k:K. + ra_included + (option_ra R) + (finmap_lookup m k) + (finmap_lookup n k) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + gnode forward = DISCH_TAC(directions[0], "Hincluded"); + ACCEPT_TAC( + forward, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `m:(K,V)finmap`, + `n:(K,V)finmap`), + GMAP_RA_INCLUDED_LOOKUP), + assume_rule(` + ra_included + (gmap_ra (R:(V)ra)) + (m:(K,V)finmap) + (n:(K,V)finmap) + `))); + gnode reverse = DISCH_TAC(directions[1], "Hpointwise"); + ACCEPT_TAC( + reverse, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `m:(K,V)finmap`, + `n:(K,V)finmap`), + GMAP_RA_INCLUDED_OF_LOOKUP), + assume_rule(` + forall k:K. + ra_included + (option_ra (R:(V)ra)) + (finmap_lookup (m:(K,V)finmap) k) + (finmap_lookup (n:(K,V)finmap) k) + `))); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_INCLUDED_LOOKUP_IFF = + prove_gmap_ra_included_lookup_iff(); + +PROOF static thm prove_gmap_ra_included_delete(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (m:(K,V)finmap). + ra_included + (gmap_ra R) + (finmap_delete key m) + m + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST( + GMAP_RA_INCLUDED_LOOKUP_IFF))); + body = GEN_TAC(body, "query"); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, "Hkey"); + for (size_t i = 0; i < vector_size(cases); ++i) { + thm branch = i == 0 + ? assume_rule(`query:K == key`) + : assume_rule(`~(query:K == key)`); + gnode reduced_goal = CONV_TAC( + cases[i], + rewrite_conv(THM_LIST( + branch, + FINMAP_DELETE_LOOKUP))); + if (i == 0) { + ACCEPT_TAC( + reduced_goal, + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `finmap_lookup (m:(K,V)finmap) (key:K)`), + OPTION_RA_INCLUDED_NONE)); + } else { + ACCEPT_TAC( + reduced_goal, + ispecl_rule( + TERM_LIST( + `option_ra (R:(V)ra)`, + `finmap_lookup (m:(K,V)finmap) (query:K)`), + RA_INCLUDED_REFL)); + } + } + return gnode_prove(root); +} + +PROOF thm GMAP_RA_INCLUDED_DELETE = + prove_gmap_ra_included_delete(); + +PROOF static thm prove_gmap_ra_included_lookup_some(void) { + term goal_tm = ` + forall + (R:(V)ra) + (m:(K,V)finmap) + (n:(K,V)finmap). + ra_included (gmap_ra R) m n <=> + forall (key:K) (a:V). + finmap_lookup m key == SOME a ==> + exists b:V. + finmap_lookup n key == SOME b && + ra_included R a b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hincluded"); + thm pointwise = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `m:(K,V)finmap`, + `n:(K,V)finmap`), GMAP_RA_INCLUDED_LOOKUP), assume_rule(` ra_included (gmap_ra (R:(V)ra)) - (finmap_singleton (key:K) (a:V)) - (finmap_singleton (key:K) (b:V)) + (m:(K,V)finmap) + (n:(K,V)finmap) `)); + forward = GEN_TAC(forward, "key"); + forward = GEN_TAC(forward, "a"); + forward = DISCH_TAC(forward, "Hsource"); thm at_key = spec_rule(`key:K`, pointwise); at_key = rewrite_rule( + THM_LIST(assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) + `)), + at_key); + gnode_list target_cases = CASES_TAC( + forward, + `finmap_lookup (n:(K,V)finmap) (key:K)`, + "Htarget"); + + thm target_none = assume_rule(gnode_get_asmps( + target_cases[0], CONST_STRING_LIST("Htarget"))[0]); + thm impossible = rewrite_rule( + THM_LIST(target_none), + at_key); + CONTR_TAC( + target_cases[0], + not_elim_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `a:V`), + OPTION_RA_NOT_INCLUDED_SOME_NONE), + impossible)); + + thm target_some = assume_rule(gnode_get_asmps( + target_cases[1], CONST_STRING_LIST("Htarget"))[0]); + term b = dest_comb(dest_eq(concl(target_some)).tm2).tm2; + gnode some_branch = EXISTS_TAC(target_cases[1], b); + gnode_list some_parts = CONJ_TAC(some_branch); + ACCEPT_TAC(some_parts[0], target_some); + thm base_included = rewrite_rule( THM_LIST( - FINMAP_SINGLETON_LOOKUP, + target_some, OPTION_RA_INCLUDED_SOME_SOME), at_key); - ACCEPT_TAC(forward, at_key); + ACCEPT_TAC(some_parts[1], base_included); - gnode reverse = DISCH_TAC( - directions[1], "Hbase_included"); - thm base_included = pure_once_rewrite_rule( - THM_LIST(ra_included_def), - assume_rule(`ra_included (R:(V)ra) (a:V) (b:V)`)); - reverse = ASSUME_TAC( - reverse, base_included, "Hbase_extension"); - reverse = ASMP_EXISTS_TAC( - reverse, "Hbase_extension", "base_frame"); - reverse = CONV_TAC( + gnode reverse = DISCH_TAC(directions[1], "Hpayload"); + reverse = MATCH_MP_TAC( reverse, - once_rewrite_conv(THM_LIST(ra_included_def))); - reverse = EXISTS_TAC( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `m:(K,V)finmap`, + `n:(K,V)finmap`), + GMAP_RA_INCLUDED_OF_LOOKUP)); + reverse = GEN_TAC(reverse, "key"); + gnode_list source_cases = CASES_TAC( reverse, - `finmap_singleton (key:K) (base_frame:V)`); + `finmap_lookup (m:(K,V)finmap) (key:K)`, + "Hsource"); + + CONV_WITH_ASMP_TAC( + source_cases[0], + rewrite_conv, + THM_LIST(OPTION_RA_INCLUDED_NONE)); + + thm source_some = assume_rule(gnode_get_asmps( + source_cases[1], CONST_STRING_LIST("Hsource"))[0]); + term a = dest_comb(dest_eq(concl(source_some)).tm2).tm2; + thm selected_target = mp_rule( + ispecl_rule( + TERM_LIST(`key:K`, a), + assume_rule(` + forall (query:K) (source_value:V). + finmap_lookup (m:(K,V)finmap) query == + SOME source_value ==> + exists target_value:V. + finmap_lookup (n:(K,V)finmap) query == + SOME target_value && + ra_included (R:(V)ra) source_value target_value + `)), + source_some); + gnode some_source = ASSUME_TAC( + source_cases[1], selected_target, "Hselected"); + some_source = ASMP_EXISTS_TAC( + some_source, "Hselected", "b"); + some_source = ASMP_CONJ_TAC( + some_source, "Hselected", "Htarget", "Hbase"); + thm base_inclusion = assume_rule(gnode_get_asmps( + some_source, CONST_STRING_LIST("Hbase"))[0]); + thm lifted_inclusion = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `R:(V)ra`, + a, + `b:V`), + OPTION_RA_INCLUDED_SOME_SOME)), + base_inclusion); + lifted_inclusion = rewrite_rule( + THM_LIST( + gsym_rule(source_some), + gsym_rule(assume_rule(` + finmap_lookup (n:(K,V)finmap) (key:K) == SOME (b:V) + `))), + lifted_inclusion); + ACCEPT_TAC(some_source, lifted_inclusion); + return gnode_prove(root); +} - thm lifted_extension = beta_rule(ap_term_rule( - `\x:V. finmap_singleton (key:K) x`, +PROOF thm GMAP_RA_INCLUDED_LOOKUP_SOME = + prove_gmap_ra_included_lookup_some(); + +PROOF static thm prove_gmap_ra_included_dom(void) { + term goal_tm = ` + forall + (R:(V)ra) + (m:(K,V)finmap) + (n:(K,V)finmap). + ra_included (gmap_ra R) m n ==> + finmap_dom m SUBSET finmap_dom n + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm payloads = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `m:(K,V)finmap`, + `n:(K,V)finmap`), + GMAP_RA_INCLUDED_LOOKUP_SOME), assume_rule(` - (b:V) == - ra_op (R:(V)ra) (a:V) (base_frame:V) - `))); - thm singleton_composition = ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `a:V`, - `base_frame:V`), - GMAP_RA_SINGLETON_OP); + ra_included + (gmap_ra (R:(V)ra)) + (m:(K,V)finmap) + (n:(K,V)finmap) + `)); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST( + get_theorem_by_name("SUBSET")))); + body = GEN_TAC(body, "key"); + body = DISCH_TAC(body, "Hin"); + thm source_exists = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `key:K`, + `m:(K,V)finmap`), + FINMAP_IN_DOM_SOME), + assume_rule(` + (key:K) IN finmap_dom (m:(K,V)finmap) + `)); + body = ASSUME_TAC(body, source_exists, "Hsource"); + body = ASMP_EXISTS_TAC(body, "Hsource", "a"); + thm target_exists = mp_rule( + ispecl_rule( + TERM_LIST( + `key:K`, + `a:V`), + payloads), + assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) + `)); + body = ASSUME_TAC(body, target_exists, "Htarget"); + body = ASMP_EXISTS_TAC(body, "Htarget", "b"); + body = ASMP_CONJ_TAC( + body, "Htarget", "Hlookup", "Hbase"); + term target_some_exists = ` + exists value:V. + finmap_lookup (n:(K,V)finmap) (key:K) == SOME value + `; + thm target_present = exists_rule( + target_some_exists, + `b:V`, + assume_rule(` + finmap_lookup (n:(K,V)finmap) (key:K) == SOME (b:V) + `)); ACCEPT_TAC( - reverse, - trans_rule( - lifted_extension, - gsym_rule(singleton_composition))); + body, + eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `key:K`, + `n:(K,V)finmap`), + FINMAP_IN_DOM_SOME)), + target_present)); return gnode_prove(root); } -PROOF thm GMAP_RA_INCLUDED_SINGLETON = - prove_gmap_ra_included_singleton(); +PROOF thm GMAP_RA_INCLUDED_DOM = + prove_gmap_ra_included_dom(); /* * Lift a deterministic base update through SOME at the selected key. At all @@ -847,6 +2040,151 @@ PROOF static thm prove_gmap_ra_update_singleton(void) { PROOF thm GMAP_RA_UPDATE_SINGLETON = prove_gmap_ra_update_singleton(); +/* Factor an inserted map into a singleton and the deleted remainder, frame + * the singleton update, and normalize both factorizations back to inserts. */ +PROOF static thm prove_gmap_ra_update_insert(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (b:V) + (m:(K,V)finmap). + ra_update R a b ==> + ra_update + (gmap_ra R) + (finmap_insert key a m) + (finmap_insert key b m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm singleton_update = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `b:V`), + GMAP_RA_UPDATE_SINGLETON), + assume_rule(`ra_update (R:(V)ra) (a:V) (b:V)`)); + thm framed_update = mp_rule( + ispecl_rule( + TERM_LIST( + `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, + `finmap_singleton (key:K) (a:V)`, + `finmap_singleton (key:K) (b:V)`), + RA_UPDATE_FRAME), + singleton_update); + framed_update = spec_rule( + `finmap_delete (key:K) (m:(K,V)finmap)`, + framed_update); + thm source_factorization = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `m:(K,V)finmap`), + GMAP_RA_SINGLETON_OP_DELETE); + thm target_factorization = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `b:V`, + `m:(K,V)finmap`), + GMAP_RA_SINGLETON_OP_DELETE); + ACCEPT_TAC( + body, + rewrite_rule( + THM_LIST( + source_factorization, + target_factorization), + framed_update)); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_UPDATE_INSERT = + prove_gmap_ra_update_insert(); + +PROOF static thm prove_gmap_ra_update_at(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (b:V) + (m:(K,V)finmap). + finmap_lookup m key == SOME a ==> + ra_update R a b ==> + ra_update + (gmap_ra R) + m + (finmap_insert key b m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm inserted_update = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `b:V`, + `m:(K,V)finmap`), + GMAP_RA_UPDATE_INSERT), + assume_rule(`ra_update (R:(V)ra) (a:V) (b:V)`)); + thm source_identity = mp_rule( + ispecl_rule( + TERM_LIST( + `key:K`, + `a:V`, + `m:(K,V)finmap`), + FINMAP_INSERT_ID), + assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) + `)); + ACCEPT_TAC( + body, + rewrite_rule(THM_LIST(source_identity), inserted_update)); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_UPDATE_AT = + prove_gmap_ra_update_at(); + +PROOF static thm prove_gmap_ra_update_delete(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (m:(K,V)finmap). + ra_update + (gmap_ra R) + m + (finmap_delete key m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm delete_included = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `m:(K,V)finmap`), + GMAP_RA_INCLUDED_DELETE); + thm delete_update = mp_rule( + ispecl_rule( + TERM_LIST( + `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, + `m:(K,V)finmap`, + `finmap_delete (key:K) (m:(K,V)finmap)`), + RA_UPDATE_INCLUDED), + delete_included); + ACCEPT_TAC(body, delete_update); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_UPDATE_DELETE = + prove_gmap_ra_update_delete(); + /* * The nondeterministic lift selects an exact SOME payload at the chosen key * using OPTION_RA_UPDATE_ND, then packages that payload as an exact singleton @@ -1013,6 +2351,199 @@ PROOF static thm prove_gmap_ra_update_singleton_nd(void) { PROOF thm GMAP_RA_UPDATE_SINGLETON_ND = prove_gmap_ra_update_singleton_nd(); +/* Frame the exact singleton image by the deleted remainder. ND + * monotonicity then normalizes each selected singleton back to an insertion; + * the selected payload remains free to depend on the hidden frame. */ +PROOF static thm prove_gmap_ra_update_insert_nd(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (P:V->bool) + (m:(K,V)finmap). + ra_update_nd R a P ==> + ra_update_nd + (gmap_ra R) + (finmap_insert key a m) + (\result:(K,V)finmap. + exists b:V. + P b && result == finmap_insert key b m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + term singleton_image = ` + \selected:(K,V)finmap. + exists b:V. + (P:V->bool) b && + selected == finmap_singleton (key:K) b + `; + term framed_image = ` + \result:(K,V)finmap. + exists selected:(K,V)finmap. + (exists b:V. + (P:V->bool) b && + selected == finmap_singleton (key:K) b) && + result == + ra_op + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + selected + (finmap_delete (key:K) (m:(K,V)finmap)) + `; + term insert_image = ` + \result:(K,V)finmap. + exists b:V. + (P:V->bool) b && + result == + finmap_insert (key:K) b (m:(K,V)finmap) + `; + + thm singleton_update = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `P:V->bool`), + GMAP_RA_UPDATE_SINGLETON_ND), + assume_rule(` + ra_update_nd (R:(V)ra) (a:V) (P:V->bool) + `)); + thm framed_update = mp_rule( + ispecl_rule( + TERM_LIST( + `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, + `finmap_singleton (key:K) (a:V)`, + singleton_image), + RA_UPDATE_ND_FRAME), + singleton_update); + framed_update = spec_rule( + `finmap_delete (key:K) (m:(K,V)finmap)`, + framed_update); + framed_update = beta_rule(framed_update); + + thm source_factorization = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `m:(K,V)finmap`), + GMAP_RA_SINGLETON_OP_DELETE); + framed_update = rewrite_rule( + THM_LIST(source_factorization), + framed_update); + + thm weakened = ispecl_rule( + TERM_LIST( + `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, + `finmap_insert (key:K) (a:V) (m:(K,V)finmap)`, + framed_image, + insert_image), + RA_UPDATE_ND_MONO); + weakened = mp_rule(weakened, framed_update); + weakened = beta_rule(weakened); + body = MATCH_MP_TAC(body, weakened); + body = GEN_TAC(body, "result"); + body = DISCH_TAC(body, "Hframed"); + body = ASMP_EXISTS_TAC( + body, "Hframed", "selected"); + body = ASMP_CONJ_TAC( + body, + "Hframed", + "Hselected_image", + "Hresult_op"); + body = ASMP_EXISTS_TAC( + body, "Hselected_image", "b"); + body = ASMP_CONJ_TAC( + body, + "Hselected_image", + "HP_b", + "Hselected_singleton"); + body = EXISTS_TAC(body, `b:V`); + gnode_list result_parts = CONJ_TAC(body); + ACCEPT_TAC( + result_parts[0], + assume_rule(`(P:V->bool) (b:V)`)); + + thm target_factorization = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `b:V`, + `m:(K,V)finmap`), + GMAP_RA_SINGLETON_OP_DELETE); + thm result_equality = rewrite_rule( + THM_LIST( + assume_rule(` + (selected:(K,V)finmap) == + finmap_singleton (key:K) (b:V) + `), + target_factorization), + assume_rule(` + (result:(K,V)finmap) == + ra_op + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (selected:(K,V)finmap) + (finmap_delete (key:K) (m:(K,V)finmap)) + `)); + ACCEPT_TAC(result_parts[1], result_equality); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_UPDATE_INSERT_ND = + prove_gmap_ra_update_insert_nd(); + +PROOF static thm prove_gmap_ra_update_at_nd(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (P:V->bool) + (m:(K,V)finmap). + finmap_lookup m key == SOME a ==> + ra_update_nd R a P ==> + ra_update_nd + (gmap_ra R) + m + (\result:(K,V)finmap. + exists b:V. + P b && result == finmap_insert key b m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm inserted_update = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `P:V->bool`, + `m:(K,V)finmap`), + GMAP_RA_UPDATE_INSERT_ND), + assume_rule(` + ra_update_nd (R:(V)ra) (a:V) (P:V->bool) + `)); + thm source_identity = mp_rule( + ispecl_rule( + TERM_LIST( + `key:K`, + `a:V`, + `m:(K,V)finmap`), + FINMAP_INSERT_ID), + assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) + `)); + ACCEPT_TAC( + body, + rewrite_rule(THM_LIST(source_identity), inserted_update)); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_UPDATE_AT_ND = + prove_gmap_ra_update_at_nd(); + PROOF static int audit_gmap_ra(void) { thm_list audited_theorems = THM_LIST( gmap_raw_op_def, @@ -1033,13 +2564,39 @@ PROOF static int audit_gmap_ra(void) { GMAP_RA_OP_FN, GMAP_RA_VALID_FN, GMAP_RA_OP_LOOKUP, + GMAP_RA_OP_INSERT_INSERT, + GMAP_RA_OP_DELETE, GMAP_RA_VALID, + GMAP_RA_VALID_LOOKUP_DELETE, + GMAP_RA_VALID_DELETE_SOME, + GMAP_RA_VALID_LOOKUP, + GMAP_RA_VALID_DELETE, + GMAP_RA_VALID_INSERT, + GMAP_RA_VALID_INSERT_OF_VALID, + GMAP_RA_VALID_INSERT_FRESH, GMAP_RA_SINGLETON_OP, + GMAP_RA_SINGLETON_OP_FRESH, + GMAP_RA_DECOMPOSE, + GMAP_RA_SINGLETON_OP_DELETE, + GMAP_RA_DOM_OP, GMAP_RA_VALID_SINGLETON, + gmap_lookup_included_def, GMAP_RA_INCLUDED_LOOKUP, GMAP_RA_INCLUDED_SINGLETON, + GMAP_LOOKUP_INCLUDED_EMPTY, + GMAP_LOOKUP_INCLUDED_INSERT, + GMAP_RA_INCLUDED_OF_LOOKUP, + GMAP_RA_INCLUDED_LOOKUP_IFF, + GMAP_RA_INCLUDED_DELETE, + GMAP_RA_INCLUDED_LOOKUP_SOME, + GMAP_RA_INCLUDED_DOM, GMAP_RA_UPDATE_SINGLETON, - GMAP_RA_UPDATE_SINGLETON_ND); + GMAP_RA_UPDATE_INSERT, + GMAP_RA_UPDATE_AT, + GMAP_RA_UPDATE_DELETE, + GMAP_RA_UPDATE_SINGLETON_ND, + GMAP_RA_UPDATE_INSERT_ND, + GMAP_RA_UPDATE_AT_ND); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { ENSURE_COND(!IS_NULL(audited_theorems[i]), diff --git a/theory/logic/gmap_ra.h b/theory/logic/gmap_ra.h index 397e0a9..d578591 100644 --- a/theory/logic/gmap_ra.h +++ b/theory/logic/gmap_ra.h @@ -49,6 +49,58 @@ PROOF extern thm GMAP_RA_OP_LOOKUP; */ PROOF extern thm GMAP_RA_SINGLETON_OP; +/* + * Composition distributes through insertion at the same key: + * + * ra_op + * (gmap_ra R) + * (finmap_insert key a m) + * (finmap_insert key b n) == + * finmap_insert + * key + * (ra_op R a b) + * (ra_op (gmap_ra R) m n) + */ +PROOF extern thm GMAP_RA_OP_INSERT_INSERT; + +/* + * Deleting the same key commutes with map composition: + * + * ra_op + * (gmap_ra R) + * (finmap_delete key m) + * (finmap_delete key n) == + * finmap_delete key (ra_op (gmap_ra R) m n) + */ +PROOF extern thm GMAP_RA_OP_DELETE; + +/* + * A singleton composes with a map missing its key by insertion: + * + * finmap_lookup m key == NONE ==> + * ra_op (gmap_ra R) (finmap_singleton key a) m == + * finmap_insert key a m + */ +PROOF extern thm GMAP_RA_SINGLETON_OP_FRESH; + +/* + * A present entry splits off as a singleton resource: + * + * finmap_lookup m key == SOME a ==> + * m == + * ra_op + * (gmap_ra R) + * (finmap_singleton key a) + * (finmap_delete key m) + */ +PROOF extern thm GMAP_RA_DECOMPOSE; + +/* + * `finmap_dom (ra_op (gmap_ra R) m n) == + * finmap_dom m UNION finmap_dom n`. + */ +PROOF extern thm GMAP_RA_DOM_OP; + /* ------------------------------------------------------------------------- */ /* Validity */ /* ------------------------------------------------------------------------- */ @@ -70,6 +122,61 @@ PROOF extern thm GMAP_RA_VALID; */ PROOF extern thm GMAP_RA_VALID_SINGLETON; +/* + * Validity splits exactly into the selected optional lookup and the map with + * that lookup removed: + * + * forall (R:(V)ra) (key:K) (m:(K,V)finmap). + * ra_valid (gmap_ra R) m <=> + * ra_valid (option_ra R) (finmap_lookup m key) && + * ra_valid (gmap_ra R) (finmap_delete key m) + */ +PROOF extern thm GMAP_RA_VALID_LOOKUP_DELETE; + +/* + * Payload-facing form of the same deletion split: + * + * finmap_lookup m key == SOME a ==> + * (ra_valid (gmap_ra R) m <=> + * ra_valid R a && + * ra_valid (gmap_ra R) (finmap_delete key m)) + */ +PROOF extern thm GMAP_RA_VALID_DELETE_SOME; + +/* + * A present lookup of a valid map contains a valid payload: + * + * ra_valid (gmap_ra R) m ==> + * finmap_lookup m key == SOME a ==> + * ra_valid R a + */ +PROOF extern thm GMAP_RA_VALID_LOOKUP; + +/* Deleting any key preserves validity. */ +PROOF extern thm GMAP_RA_VALID_DELETE; + +/* + * Insertion validity ignores the overwritten entry and checks exactly the + * new payload and the remaining map: + * + * ra_valid (gmap_ra R) (finmap_insert key a m) <=> + * ra_valid R a && + * ra_valid (gmap_ra R) (finmap_delete key m) + */ +PROOF extern thm GMAP_RA_VALID_INSERT; + +/* Valid payload and valid surrounding map imply valid insertion. */ +PROOF extern thm GMAP_RA_VALID_INSERT_OF_VALID; + +/* + * At a fresh key, insertion validity factors into payload and map validity: + * + * finmap_lookup m key == NONE ==> + * (ra_valid (gmap_ra R) (finmap_insert key a m) <=> + * ra_valid R a && ra_valid (gmap_ra R) m) + */ +PROOF extern thm GMAP_RA_VALID_INSERT_FRESH; + /* ------------------------------------------------------------------------- */ /* Order */ /* ------------------------------------------------------------------------- */ @@ -88,11 +195,58 @@ PROOF extern thm GMAP_RA_VALID_SINGLETON; * (finmap_lookup m k) * (finmap_lookup n k) * - * This is the sound direction available without constructing a finite map of - * pointwise witnesses. + * This direction projects a global finite-map witness to each lookup. The + * converse below reconstructs the global inclusion by finite-map induction. */ PROOF extern thm GMAP_RA_INCLUDED_LOOKUP; +/* + * Pointwise option inclusion constructs a finite-map inclusion witness: + * + * (forall k:K. + * ra_included + * (option_ra R) + * (finmap_lookup m k) + * (finmap_lookup n k)) ==> + * ra_included (gmap_ra R) m n + */ +PROOF extern thm GMAP_RA_INCLUDED_OF_LOOKUP; + +/* + * Finite-map inclusion is exactly pointwise option inclusion: + * + * ra_included (gmap_ra R) m n <=> + * forall k:K. + * ra_included + * (option_ra R) + * (finmap_lookup m k) + * (finmap_lookup n k) + */ +PROOF extern thm GMAP_RA_INCLUDED_LOOKUP_IFF; + +/* Deleting a binding produces a subresource of the original map. */ +PROOF extern thm GMAP_RA_INCLUDED_DELETE; + +/* + * Payload-facing characterization: + * + * ra_included (gmap_ra R) m n <=> + * forall (key:K) (a:V). + * finmap_lookup m key == SOME a ==> + * exists b:V. + * finmap_lookup n key == SOME b && + * ra_included R a b + */ +PROOF extern thm GMAP_RA_INCLUDED_LOOKUP_SOME; + +/* + * Inclusion grows support: + * + * ra_included (gmap_ra R) m n ==> + * finmap_dom m SUBSET finmap_dom n + */ +PROOF extern thm GMAP_RA_INCLUDED_DOM; + /* * Inclusion between singleton maps at the same key is exactly base inclusion: * @@ -127,6 +281,30 @@ PROOF extern thm GMAP_RA_INCLUDED_SINGLETON; */ PROOF extern thm GMAP_RA_UPDATE_SINGLETON; +/* + * A deterministic payload update lifts under insertion into an arbitrary + * surrounding map: + * + * ra_update R a b ==> + * ra_update + * (gmap_ra R) + * (finmap_insert key a m) + * (finmap_insert key b m) + */ +PROOF extern thm GMAP_RA_UPDATE_INSERT; + +/* + * Updating an existing entry changes only that entry: + * + * finmap_lookup m key == SOME a ==> + * ra_update R a b ==> + * ra_update (gmap_ra R) m (finmap_insert key b m) + */ +PROOF extern thm GMAP_RA_UPDATE_AT; + +/* Deleting any binding is an unconditional deterministic update. */ +PROOF extern thm GMAP_RA_UPDATE_DELETE; + /* * A nondeterministic payload update lifts to the exact singleton-map image: * @@ -143,3 +321,32 @@ PROOF extern thm GMAP_RA_UPDATE_SINGLETON; * result map has exactly the original singleton support. */ PROOF extern thm GMAP_RA_UPDATE_SINGLETON_ND; + +/* + * A nondeterministic payload update lifts under insertion into an arbitrary + * surrounding map: + * + * ra_update_nd R a P ==> + * ra_update_nd + * (gmap_ra R) + * (finmap_insert key a m) + * (\result:(K,V)finmap. + * exists b:V. + * P b && result == finmap_insert key b m) + */ +PROOF extern thm GMAP_RA_UPDATE_INSERT_ND; + +/* + * A nondeterministic update of an existing entry preserves every other + * binding of the original map: + * + * finmap_lookup m key == SOME a ==> + * ra_update_nd R a P ==> + * ra_update_nd + * (gmap_ra R) + * m + * (\result:(K,V)finmap. + * exists b:V. + * P b && result == finmap_insert key b m) + */ +PROOF extern thm GMAP_RA_UPDATE_AT_ND; -- Gitee From 8df07309956222d51a7dba65cfa24c7c592dbc77 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Sat, 8 Aug 2026 09:58:03 +0800 Subject: [PATCH 24/35] feat(gmap_ra): add infinite-key allocation laws --- test/gmap_ra_regression.c | 129 +++++++++++++++ theory/logic/finmap.c | 187 +++++++++++++++++++++ theory/logic/finmap.h | 49 ++++++ theory/logic/gmap_ra.c | 337 +++++++++++++++++++++++++++++++++++++- theory/logic/gmap_ra.h | 112 +++++++++++++ 5 files changed, 813 insertions(+), 1 deletion(-) diff --git a/test/gmap_ra_regression.c b/test/gmap_ra_regression.c index 9820fea..4c4b669 100644 --- a/test/gmap_ra_regression.c +++ b/test/gmap_ra_regression.c @@ -145,7 +145,26 @@ PROOF static int audit_gmap_regressions(void) { term a = `a:(num)excl`; term b = `b:(num)excl`; term m = `m:(num,(num)excl)finmap`; + term n = `n:(num,(num)excl)finmap`; term P = `P:(num)excl->bool`; + term candidates = `candidates:num->bool`; + term forbidden = `forbidden:num->bool`; + term payload = `payload:num->(num)excl`; + + check_gmap_theorem( + ispecl_rule( + TERM_LIST(candidates, m, n), + FINMAP_FRESH_IN_PAIR), + `INFINITE (candidates:num->bool) ==> + exists fresh:num. + fresh IN candidates && + finmap_lookup + (m:(num,(num)excl)finmap) + fresh == NONE && + finmap_lookup + (n:(num,(num)excl)finmap) + fresh == NONE`, + "FINMAP_FRESH_IN_PAIR"); check_gmap_theorem( ispecl_rule(TERM_LIST(R, key, m), GMAP_RA_VALID_LOOKUP_DELETE), @@ -317,6 +336,116 @@ PROOF static int audit_gmap_regressions(void) { P selected && result == finmap_insert key selected m)`, "GMAP_RA_UPDATE_AT_ND"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, candidates, payload, m), + GMAP_RA_ALLOC_STRONG_DEP), + `INFINITE (candidates:num->bool) ==> + (forall fresh:num. + fresh IN candidates ==> + finmap_lookup + (m:(num,(num)excl)finmap) + fresh == NONE ==> + ra_valid + (excl_ra:((num)excl)ra) + ((payload:num->(num)excl) fresh)) ==> + ra_update_nd + (gmap_ra (excl_ra:((num)excl)ra)) + m + (\result:(num,(num)excl)finmap. + exists fresh:num. + fresh IN candidates && + finmap_lookup m fresh == NONE && + result == + finmap_insert fresh (payload fresh) m)`, + "GMAP_RA_ALLOC_STRONG_DEP"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, candidates, m, a), + GMAP_RA_ALLOC_STRONG), + `INFINITE (candidates:num->bool) ==> + ra_valid + (excl_ra:((num)excl)ra) + (a:(num)excl) ==> + ra_update_nd + (gmap_ra (excl_ra:((num)excl)ra)) + m + (\result:(num,(num)excl)finmap. + exists fresh:num. + fresh IN candidates && + finmap_lookup m fresh == NONE && + result == finmap_insert fresh a m)`, + "GMAP_RA_ALLOC_STRONG"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, m, a), + GMAP_RA_ALLOC), + `INFINITE (UNIV:num->bool) ==> + ra_valid + (excl_ra:((num)excl)ra) + (a:(num)excl) ==> + ra_update_nd + (gmap_ra (excl_ra:((num)excl)ra)) + m + (\result:(num,(num)excl)finmap. + exists fresh:num. + finmap_lookup m fresh == NONE && + result == finmap_insert fresh a m)`, + "GMAP_RA_ALLOC"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, forbidden, m, a), + GMAP_RA_ALLOC_COFINITE), + `INFINITE (UNIV:num->bool) ==> + FINITE (forbidden:num->bool) ==> + ra_valid + (excl_ra:((num)excl)ra) + (a:(num)excl) ==> + ra_update_nd + (gmap_ra (excl_ra:((num)excl)ra)) + m + (\result:(num,(num)excl)finmap. + exists fresh:num. + ~(fresh IN forbidden) && + finmap_lookup m fresh == NONE && + result == finmap_insert fresh a m)`, + "GMAP_RA_ALLOC_COFINITE"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, a), + GMAP_RA_ALLOC_EMPTY), + `INFINITE (UNIV:K->bool) ==> + ra_valid + (excl_ra:((num)excl)ra) + (a:(num)excl) ==> + ra_update_nd + (gmap_ra (excl_ra:((num)excl)ra)) + (finmap_empty:(K,(num)excl)finmap) + (\result:(K,(num)excl)finmap. + exists fresh:K. + result == finmap_singleton fresh a)`, + "GMAP_RA_ALLOC_EMPTY"); + + thm concrete_alloc = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + R, + m, + `Excl (7:num)`), + GMAP_RA_ALLOC), + get_theorem_by_name("num_INFINITE")), + ispec_rule(`7:num`, EXCL_RA_VALID_OWNED)); + check_gmap_theorem( + concrete_alloc, + `ra_update_nd + (gmap_ra (excl_ra:((num)excl)ra)) + (m:(num,(num)excl)finmap) + (\result:(num,(num)excl)finmap. + exists fresh:num. + finmap_lookup m fresh == NONE && + result == finmap_insert fresh (Excl (7:num)) m)`, + "GMAP_RA_ALLOC[num]"); thm overwrite = prove_gmap_valid_overwrite_regression(); ENSURE_COND(!IS_NULL(overwrite) && vector_size(hyp(overwrite)) == 0, diff --git a/theory/logic/finmap.c b/theory/logic/finmap.c index 49dedea..7855435 100644 --- a/theory/logic/finmap.c +++ b/theory/logic/finmap.c @@ -1176,6 +1176,189 @@ PROOF static thm prove_finmap_not_in_dom(void) { PROOF thm FINMAP_NOT_IN_DOM = prove_finmap_not_in_dom(); +/* Every infinite set has an element outside a finite forbidden set. Keep + * this set-theoretic lemma private: the public interface phrases freshness + * directly in terms of finite maps. */ +PROOF static thm prove_finmap_infinite_avoid(void) { + term goal_tm = ` + forall (candidates:K->bool) (forbidden:K->bool). + INFINITE candidates ==> + FINITE forbidden ==> + exists key:K. + key IN candidates && ~(key IN forbidden) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + term remainder = `(candidates:K->bool) DIFF (forbidden:K->bool)`; + thm remainder_infinite = mp_rule( + ispecl_rule( + TERM_LIST(`candidates:K->bool`, `forbidden:K->bool`), + get_theorem_by_name("INFINITE_DIFF_FINITE")), + conj_rule( + assume_rule(`INFINITE (candidates:K->bool)`), + assume_rule(`FINITE (forbidden:K->bool)`))); + thm remainder_nonempty = mp_rule( + ispec_rule( + remainder, + get_theorem_by_name("INFINITE_NONEMPTY")), + remainder_infinite); + thm witness = eq_mp_rule( + gsym_rule(ispec_rule( + remainder, + get_theorem_by_name("MEMBER_NOT_EMPTY"))), + remainder_nonempty); + witness = rewrite_rule( + THM_LIST(get_theorem_by_name("IN_DIFF")), + witness); + ACCEPT_TAC(body, witness); + return gnode_prove(root); +} + +PROOF static thm FINMAP_INFINITE_AVOID = + prove_finmap_infinite_avoid(); + +PROOF static thm prove_finmap_fresh_in(void) { + term goal_tm = ` + forall (candidates:K->bool) (m:(K,V)finmap). + INFINITE candidates ==> + exists key:K. + key IN candidates && + finmap_lookup m key == NONE + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm fresh = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `candidates:K->bool`, + `finmap_dom (m:(K,V)finmap)`), + FINMAP_INFINITE_AVOID), + assume_rule(`INFINITE (candidates:K->bool)`)), + ispec_rule( + `m:(K,V)finmap`, + FINMAP_DOM_FINITE)); + fresh = rewrite_rule( + THM_LIST(FINMAP_NOT_IN_DOM), + fresh); + ACCEPT_TAC(body, fresh); + return gnode_prove(root); +} + +PROOF thm FINMAP_FRESH_IN = + prove_finmap_fresh_in(); + +PROOF static thm prove_finmap_fresh_in_pair(void) { + term goal_tm = ` + forall + (candidates:K->bool) + (m:(K,V)finmap) + (n:(K,W)finmap). + INFINITE candidates ==> + exists key:K. + key IN candidates && + finmap_lookup m key == NONE && + finmap_lookup n key == NONE + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + term m_dom = `finmap_dom (m:(K,V)finmap)`; + term n_dom = `finmap_dom (n:(K,W)finmap)`; + term forbidden = ` + finmap_dom (m:(K,V)finmap) UNION + finmap_dom (n:(K,W)finmap) + `; + thm forbidden_finite = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST(m_dom, n_dom), + get_theorem_by_name("FINITE_UNION"))), + conj_rule( + ispec_rule( + `m:(K,V)finmap`, + FINMAP_DOM_FINITE), + ispec_rule( + `n:(K,W)finmap`, + FINMAP_DOM_FINITE))); + thm fresh = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST(`candidates:K->bool`, forbidden), + FINMAP_INFINITE_AVOID), + assume_rule(`INFINITE (candidates:K->bool)`)), + forbidden_finite); + fresh = rewrite_rule( + THM_LIST( + get_theorem_by_name("IN_UNION"), + get_theorem_by_name("DE_MORGAN_THM"), + FINMAP_NOT_IN_DOM), + fresh); + ACCEPT_TAC(body, fresh); + return gnode_prove(root); +} + +PROOF thm FINMAP_FRESH_IN_PAIR = + prove_finmap_fresh_in_pair(); + +PROOF static thm prove_finmap_fresh(void) { + term goal_tm = ` + forall m:(K,V)finmap. + INFINITE (UNIV:K->bool) ==> + exists key:K. + finmap_lookup m key == NONE + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm fresh = mp_rule( + ispecl_rule( + TERM_LIST( + `UNIV:K->bool`, + `m:(K,V)finmap`), + FINMAP_FRESH_IN), + assume_rule(`INFINITE (UNIV:K->bool)`)); + fresh = rewrite_rule( + THM_LIST( + get_theorem_by_name("IN_UNIV"), + get_theorem_by_name("AND_CLAUSES")), + fresh); + ACCEPT_TAC(body, fresh); + return gnode_prove(root); +} + +PROOF thm FINMAP_FRESH = + prove_finmap_fresh(); + +PROOF static thm prove_finmap_fresh_pair(void) { + term goal_tm = ` + forall + (m:(K,V)finmap) + (n:(K,W)finmap). + INFINITE (UNIV:K->bool) ==> + exists key:K. + finmap_lookup m key == NONE && + finmap_lookup n key == NONE + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm fresh = mp_rule( + ispecl_rule( + TERM_LIST( + `UNIV:K->bool`, + `m:(K,V)finmap`, + `n:(K,W)finmap`), + FINMAP_FRESH_IN_PAIR), + assume_rule(`INFINITE (UNIV:K->bool)`)); + fresh = rewrite_rule( + THM_LIST( + get_theorem_by_name("IN_UNIV"), + get_theorem_by_name("AND_CLAUSES")), + fresh); + ACCEPT_TAC(body, fresh); + return gnode_prove(root); +} + +PROOF thm FINMAP_FRESH_PAIR = + prove_finmap_fresh_pair(); + PROOF static thm prove_finmap_dom_eq_empty(void) { term goal_tm = ` forall m:(K,V)finmap. @@ -1542,6 +1725,10 @@ PROOF static int audit_finmap(void) { FINMAP_IN_DOM, FINMAP_IN_DOM_SOME, FINMAP_NOT_IN_DOM, + FINMAP_FRESH_IN, + FINMAP_FRESH_IN_PAIR, + FINMAP_FRESH, + FINMAP_FRESH_PAIR, FINMAP_DOM_EQ_EMPTY, FINMAP_DOM_INSERT, FINMAP_DOM_DELETE, diff --git a/theory/logic/finmap.h b/theory/logic/finmap.h index 4a3a265..7e2808f 100644 --- a/theory/logic/finmap.h +++ b/theory/logic/finmap.h @@ -251,6 +251,55 @@ PROOF extern thm FINMAP_IN_DOM_SOME; */ PROOF extern thm FINMAP_NOT_IN_DOM; +/* + * An infinite candidate set contains a key outside any one finite map: + * + * forall (candidates:K->bool) (m:(K,V)finmap). + * INFINITE candidates ==> + * exists key:K. + * key IN candidates && + * finmap_lookup m key == NONE + */ +PROOF extern thm FINMAP_FRESH_IN; + +/* + * An infinite candidate set contains a key outside two finite maps at once: + * + * forall + * (candidates:K->bool) + * (m:(K,V)finmap) + * (n:(K,W)finmap). + * INFINITE candidates ==> + * exists key:K. + * key IN candidates && + * finmap_lookup m key == NONE && + * finmap_lookup n key == NONE + */ +PROOF extern thm FINMAP_FRESH_IN_PAIR; + +/* + * If the key type is infinite, every finite map has a fresh key: + * + * forall m:(K,V)finmap. + * INFINITE (UNIV:K->bool) ==> + * exists key:K. + * finmap_lookup m key == NONE + */ +PROOF extern thm FINMAP_FRESH; + +/* + * If the key type is infinite, two finite maps have a common fresh key: + * + * forall + * (m:(K,V)finmap) + * (n:(K,W)finmap). + * INFINITE (UNIV:K->bool) ==> + * exists key:K. + * finmap_lookup m key == NONE && + * finmap_lookup n key == NONE + */ +PROOF extern thm FINMAP_FRESH_PAIR; + /* * `finmap_dom m == {} <=> m == finmap_empty`. */ diff --git a/theory/logic/gmap_ra.c b/theory/logic/gmap_ra.c index 4e7745e..946142f 100644 --- a/theory/logic/gmap_ra.c +++ b/theory/logic/gmap_ra.c @@ -2544,6 +2544,336 @@ PROOF static thm prove_gmap_ra_update_at_nd(void) { PROOF thm GMAP_RA_UPDATE_AT_ND = prove_gmap_ra_update_at_nd(); +/* Pick the fresh key only after the hidden map frame has been introduced. + * The common-freshness theorem is precisely where infinitude is used: both + * finite domains can be avoided at once. */ +PROOF static thm prove_gmap_ra_alloc_strong_dep(void) { + term goal_tm = ` + forall + (R:(V)ra) + (candidates:K->bool) + (payload:K->V) + (m:(K,V)finmap). + INFINITE candidates ==> + (forall key:K. + key IN candidates ==> + finmap_lookup m key == NONE ==> + ra_valid R (payload key)) ==> + ra_update_nd + (gmap_ra R) + m + (\result:(K,V)finmap. + exists key:K. + key IN candidates && + finmap_lookup m key == NONE && + result == finmap_insert key (payload key) m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = AUTO_INTROS_TAC(body); + + thm source_all = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `ra_op + (gmap_ra (R:(V)ra)) + (m:(K,V)finmap) + (frame:(K,V)finmap)`), + GMAP_RA_VALID), + assume_rule(` + ra_valid + (gmap_ra (R:(V)ra)) + (ra_op + (gmap_ra R) + (m:(K,V)finmap) + (frame:(K,V)finmap)) + `)); + thm fresh = mp_rule( + ispecl_rule( + TERM_LIST( + `candidates:K->bool`, + `m:(K,V)finmap`, + `frame:(K,V)finmap`), + FINMAP_FRESH_IN_PAIR), + assume_rule(`INFINITE (candidates:K->bool)`)); + body = ASSUME_TAC(body, fresh, "Hfresh"); + body = ASMP_EXISTS_TAC(body, "Hfresh", "key"); + body = ASMP_CONJ_TAC( + body, + "Hfresh", + "Hcandidate", + "Hmap_freshness"); + body = ASMP_CONJ_TAC( + body, + "Hmap_freshness", + "Hm_fresh", + "Hframe_fresh"); + + thm payload_valid = mp_rule( + mp_rule( + spec_rule( + `key:K`, + assume_rule(` + forall query:K. + query IN (candidates:K->bool) ==> + finmap_lookup (m:(K,V)finmap) query == NONE ==> + ra_valid (R:(V)ra) ((payload:K->V) query) + `)), + assume_rule(`(key:K) IN (candidates:K->bool)`)), + assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == NONE + `)); + + body = EXISTS_TAC( + body, + `finmap_insert + (key:K) + ((payload:K->V) key) + (m:(K,V)finmap)`); + gnode_list result_parts = CONJ_TAC(body); + + gnode image = EXISTS_TAC(result_parts[0], `key:K`); + gnode_list image_parts = CONJ_TAC(image); + ACCEPT_TAC( + image_parts[0], + assume_rule(`(key:K) IN (candidates:K->bool)`)); + gnode_list fresh_and_result = CONJ_TAC(image_parts[1]); + ACCEPT_TAC( + fresh_and_result[0], + assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == NONE + `)); + ACCEPT_TAC( + fresh_and_result[1], + refl_rule(` + finmap_insert + (key:K) + ((payload:K->V) key) + (m:(K,V)finmap) + `)); + + gnode validity = CONV_TAC( + result_parts[1], + once_rewrite_conv(THM_LIST(GMAP_RA_VALID))); + validity = GEN_TAC(validity, "query"); + thm source_at = spec_rule(`query:K`, source_all); + source_at = rewrite_rule( + THM_LIST(GMAP_RA_OP_LOOKUP), + source_at); + gnode_list cases = BOOL_CASES_TAC( + validity, + `(query:K) == (key:K)`, + "Hkey"); + + thm equal_key = assume_rule(`query:K == key`); + gnode at_key = CONV_TAC( + cases[0], + rewrite_conv(THM_LIST( + equal_key, + GMAP_RA_OP_LOOKUP, + FINMAP_INSERT_LOOKUP, + assume_rule(` + finmap_lookup + (frame:(K,V)finmap) + (key:K) == NONE + `), + OPTION_RA_OP_NONE_R, + OPTION_RA_VALID_SOME))); + ACCEPT_TAC(at_key, payload_valid); + + thm unequal_key = assume_rule(`~(query:K == key)`); + gnode away = CONV_TAC( + cases[1], + rewrite_conv(THM_LIST( + unequal_key, + GMAP_RA_OP_LOOKUP, + FINMAP_INSERT_LOOKUP))); + ACCEPT_TAC(away, source_at); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_ALLOC_STRONG_DEP = + prove_gmap_ra_alloc_strong_dep(); + +PROOF static thm prove_gmap_ra_alloc_strong(void) { + term goal_tm = ` + forall + (R:(V)ra) + (candidates:K->bool) + (m:(K,V)finmap) + (a:V). + INFINITE candidates ==> + ra_valid R a ==> + ra_update_nd + (gmap_ra R) + m + (\result:(K,V)finmap. + exists key:K. + key IN candidates && + finmap_lookup m key == NONE && + result == finmap_insert key a m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm allocated = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `candidates:K->bool`, + `\key:K. a:V`, + `m:(K,V)finmap`), + GMAP_RA_ALLOC_STRONG_DEP); + allocated = beta_rule(allocated); + allocated = mp_rule( + allocated, + assume_rule(`INFINITE (candidates:K->bool)`)); + body = MATCH_MP_TAC(body, allocated); + body = GEN_TAC(body, "key"); + body = DISCH_TAC(body, "Hcandidate"); + body = DISCH_TAC(body, "Hfresh"); + ACCEPT_TAC(body, assume_rule(`ra_valid (R:(V)ra) (a:V)`)); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_ALLOC_STRONG = + prove_gmap_ra_alloc_strong(); + +PROOF static thm prove_gmap_ra_alloc(void) { + term goal_tm = ` + forall + (R:(V)ra) + (m:(K,V)finmap) + (a:V). + INFINITE (UNIV:K->bool) ==> + ra_valid R a ==> + ra_update_nd + (gmap_ra R) + m + (\result:(K,V)finmap. + exists key:K. + finmap_lookup m key == NONE && + result == finmap_insert key a m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm allocated = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `UNIV:K->bool`, + `m:(K,V)finmap`, + `a:V`), + GMAP_RA_ALLOC_STRONG), + assume_rule(`INFINITE (UNIV:K->bool)`)), + assume_rule(`ra_valid (R:(V)ra) (a:V)`)); + allocated = rewrite_rule( + THM_LIST( + get_theorem_by_name("IN_UNIV"), + get_theorem_by_name("AND_CLAUSES")), + allocated); + ACCEPT_TAC(body, allocated); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_ALLOC = + prove_gmap_ra_alloc(); + +PROOF static thm prove_gmap_ra_alloc_cofinite(void) { + term goal_tm = ` + forall + (R:(V)ra) + (forbidden:K->bool) + (m:(K,V)finmap) + (a:V). + INFINITE (UNIV:K->bool) ==> + FINITE forbidden ==> + ra_valid R a ==> + ra_update_nd + (gmap_ra R) + m + (\result:(K,V)finmap. + exists key:K. + ~(key IN forbidden) && + finmap_lookup m key == NONE && + result == finmap_insert key a m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + term candidates = `(UNIV:K->bool) DIFF (forbidden:K->bool)`; + thm candidates_infinite = mp_rule( + ispecl_rule( + TERM_LIST(`UNIV:K->bool`, `forbidden:K->bool`), + get_theorem_by_name("INFINITE_DIFF_FINITE")), + conj_rule( + assume_rule(`INFINITE (UNIV:K->bool)`), + assume_rule(`FINITE (forbidden:K->bool)`))); + thm allocated = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + candidates, + `m:(K,V)finmap`, + `a:V`), + GMAP_RA_ALLOC_STRONG), + candidates_infinite), + assume_rule(`ra_valid (R:(V)ra) (a:V)`)); + allocated = rewrite_rule( + THM_LIST( + get_theorem_by_name("IN_DIFF"), + get_theorem_by_name("IN_UNIV"), + get_theorem_by_name("AND_CLAUSES")), + allocated); + ACCEPT_TAC(body, allocated); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_ALLOC_COFINITE = + prove_gmap_ra_alloc_cofinite(); + +PROOF static thm prove_gmap_ra_alloc_empty(void) { + term goal_tm = ` + forall (R:(V)ra) (a:V). + INFINITE (UNIV:K->bool) ==> + ra_valid R a ==> + ra_update_nd + (gmap_ra R) + (finmap_empty:(K,V)finmap) + (\result:(K,V)finmap. + exists key:K. + result == finmap_singleton key a) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm allocated = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `finmap_empty:(K,V)finmap`, + `a:V`), + GMAP_RA_ALLOC), + assume_rule(`INFINITE (UNIV:K->bool)`)), + assume_rule(`ra_valid (R:(V)ra) (a:V)`)); + allocated = rewrite_rule( + THM_LIST( + FINMAP_EMPTY_LOOKUP, + FINMAP_INSERT_EMPTY, + get_theorem_by_name("AND_CLAUSES")), + allocated); + ACCEPT_TAC(body, allocated); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_ALLOC_EMPTY = + prove_gmap_ra_alloc_empty(); + PROOF static int audit_gmap_ra(void) { thm_list audited_theorems = THM_LIST( gmap_raw_op_def, @@ -2596,7 +2926,12 @@ PROOF static int audit_gmap_ra(void) { GMAP_RA_UPDATE_DELETE, GMAP_RA_UPDATE_SINGLETON_ND, GMAP_RA_UPDATE_INSERT_ND, - GMAP_RA_UPDATE_AT_ND); + GMAP_RA_UPDATE_AT_ND, + GMAP_RA_ALLOC_STRONG_DEP, + GMAP_RA_ALLOC_STRONG, + GMAP_RA_ALLOC, + GMAP_RA_ALLOC_COFINITE, + GMAP_RA_ALLOC_EMPTY); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { ENSURE_COND(!IS_NULL(audited_theorems[i]), diff --git a/theory/logic/gmap_ra.h b/theory/logic/gmap_ra.h index d578591..74d6945 100644 --- a/theory/logic/gmap_ra.h +++ b/theory/logic/gmap_ra.h @@ -350,3 +350,115 @@ PROOF extern thm GMAP_RA_UPDATE_INSERT_ND; * P b && result == finmap_insert key b m) */ PROOF extern thm GMAP_RA_UPDATE_AT_ND; + +/* ------------------------------------------------------------------------- */ +/* Fresh allocation for infinite key spaces */ +/* ------------------------------------------------------------------------- */ + +/* + * Strong dependent fresh allocation. The allocated payload may depend on + * the selected key, and allocation is restricted to an arbitrary infinite + * candidate set: + * + * forall + * (R:(V)ra) + * (candidates:K->bool) + * (payload:K->V) + * (m:(K,V)finmap). + * INFINITE candidates ==> + * (forall key:K. + * key IN candidates ==> + * finmap_lookup m key == NONE ==> + * ra_valid R (payload key)) ==> + * ra_update_nd + * (gmap_ra R) + * m + * (\result:(K,V)finmap. + * exists key:K. + * key IN candidates && + * finmap_lookup m key == NONE && + * result == finmap_insert key (payload key) m) + * + * The selected key may depend on the hidden RA frame. This quantifier order + * is essential: a key known to be absent only from `m` may still be occupied + * by that frame. + */ +PROOF extern thm GMAP_RA_ALLOC_STRONG_DEP; + +/* + * Strong fresh allocation of one fixed valid payload inside `candidates`: + * + * forall + * (R:(V)ra) + * (candidates:K->bool) + * (m:(K,V)finmap) + * (a:V). + * INFINITE candidates ==> + * ra_valid R a ==> + * ra_update_nd + * (gmap_ra R) + * m + * (\result:(K,V)finmap. + * exists key:K. + * key IN candidates && + * finmap_lookup m key == NONE && + * result == finmap_insert key a m) + */ +PROOF extern thm GMAP_RA_ALLOC_STRONG; + +/* + * Fresh allocation when the entire key type is infinite: + * + * forall + * (R:(V)ra) + * (m:(K,V)finmap) + * (a:V). + * INFINITE (UNIV:K->bool) ==> + * ra_valid R a ==> + * ra_update_nd + * (gmap_ra R) + * m + * (\result:(K,V)finmap. + * exists key:K. + * finmap_lookup m key == NONE && + * result == finmap_insert key a m) + */ +PROOF extern thm GMAP_RA_ALLOC; + +/* + * Cofinite fresh allocation: the selected key additionally avoids any + * caller-supplied finite forbidden set: + * + * forall + * (R:(V)ra) + * (forbidden:K->bool) + * (m:(K,V)finmap) + * (a:V). + * INFINITE (UNIV:K->bool) ==> + * FINITE forbidden ==> + * ra_valid R a ==> + * ra_update_nd + * (gmap_ra R) + * m + * (\result:(K,V)finmap. + * exists key:K. + * ~(key IN forbidden) && + * finmap_lookup m key == NONE && + * result == finmap_insert key a m) + */ +PROOF extern thm GMAP_RA_ALLOC_COFINITE; + +/* + * Allocate a valid payload into the empty map at some fresh key: + * + * forall (R:(V)ra) (a:V). + * INFINITE (UNIV:K->bool) ==> + * ra_valid R a ==> + * ra_update_nd + * (gmap_ra R) + * (finmap_empty:(K,V)finmap) + * (\result:(K,V)finmap. + * exists key:K. + * result == finmap_singleton key a) + */ +PROOF extern thm GMAP_RA_ALLOC_EMPTY; -- Gitee From 977d42dba968a5933177953eaf42b8f880e0c881 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Mon, 10 Aug 2026 15:46:15 +0800 Subject: [PATCH 25/35] docs: summarize RA and SL theories --- docs/RA_SL_THEORY_SUMMARY.md | 2024 ++++++++++++++++++++++++++++++++++ 1 file changed, 2024 insertions(+) create mode 100644 docs/RA_SL_THEORY_SUMMARY.md diff --git a/docs/RA_SL_THEORY_SUMMARY.md b/docs/RA_SL_THEORY_SUMMARY.md new file mode 100644 index 0000000..b5fb366 --- /dev/null +++ b/docs/RA_SL_THEORY_SUMMARY.md @@ -0,0 +1,2024 @@ +# RA 与资源语义分离逻辑（SL）理论总览 + +> 快照：`cstar_stdlib` 工作区分支 `ghost-resources-phased`，基线提交 +> `8df07309956222d51a7dba65cfa24c7c592dbc77`，并包含 2026-08-10 +> 尚未提交的工作区修改。本文描述的是**当前工作区实际加载并由 HOL Light +> 打印出的定理对象**，不是基线提交的历史状态。 + +本文先固定一套公共数学记号，再把公开理论分成三层： + +1. 离散幺半资源代数（RA）及其构造子； +2. 由 RA 解释的资源命题与分离逻辑（SL）； +3. 命名 ghost heap、C 物理内存与 `cprop`/`|--` 适配层。 + +每个定理表的 “HOL statement” 栏保留 C*/HOL 的对象语言拼写；“数学陈述” +栏使用本节统一记号。HOL 栏最外层的 `` `|- ...` `` 表示无假设定理；省略的 +类型变量由 HOL 多态推断。`==` 是 HOL 对象等号，`==>` 是右结合蕴含，`<=>` +是布尔等价。数学栏的 `=`、`⇒`、`⇔` 分别对应它们。 + +本文的数学公式统一使用 GitHub/KaTeX 兼容的 `$...$`（行内）与 `$$...$$` +（块级）分隔符；不使用部分 Markdown renderer 无法识别的 `\(...\)`、 +`\[...\]` 或自定义 LaTeX 宏。 + +## 1. 范围、层次与依赖 + +### 1.1 本文覆盖 + +| 层 | 模块 | 作用 | +|---|---|---| +| RA 核心 | `ra`, `ra_builder`, `local_update` | 抽象 RA、包含序、帧保持更新、局部更新 | +| RA 构造子 | `unit_ra`, `prod_ra`, `option_ra`, `excl_ra`, `agree_ra`, `max_nat_ra`, `frac_ra`, `auth_ra`, `gmap_ra` | 标准资源代数实例与提升定理 | +| 有限映射基础 | `finmap` | `gmap_ra`、map big-sep 与 ghost heap 的有限支撑映射 | +| SL 语义 | `resource_prop`, `big_sep`, `basic_update` | 资源命题、BI 联结词、迭代分离合取、basic update/view shift | +| ghost 资源 | `ghost_heap`, `ghost_own`, `ghost_update` | 命名资源单元、精确 ownership 与更新/分配 | +| C 实例 | `mem_ra`, `mem_own`, `c_resource`, `c_basic_update`, `c_ghost_update` | 物理内存 RA、物理×ghost 产品资源以及 C 层更新 | +| 语法适配 | `adapter/ra_sl*`, `proof_sl*` | 把某个闭合 RA 的语义运算安装成 `cprop`、`**`、`\|--` 等表面语法 | + +`c_integer`, `mem_value`, `c_memory` 和 `c_fnspec` 是上述语义的下游 C +程序逻辑；本文只在接口关系中提及，不把整数位运算、C 类型布局等非 RA/SL +定理混入核心目录。 + +上述 24 个 public headers 当前共有 576 个 `PROOF extern thm` handles。RA、 +local-update、BI、basic-update、big-sep、各 RA 构造子、ghost 与 C-resource +接口在本文逐条列出；`finmap` 中纯机械的 representation/insert/delete/domain +计算律采用“关键公式 + 其余完整名称索引”，以免有限映射实现细节淹没 RA/SL +主线。 + +第 15 节的排序索引还额外纳入 `excl_ra_internal.h` 的 5 个内部 theorem +handles 与 `proof_sl.h` 的 17 个 runtime-installed theorem globals，并把没有 +public theorem global 的 adapter/backward 文件显式标出；因此该索引总计 598 +条。 + +### 1.2 依赖关系 + +```text +ra ───────────────┬──────── unit / prod / option / excl / agree / max_nat / frac + ├──────── local_update ───── auth + └──────── finmap ─────────── gmap ───────── ghost_heap + │ +resource_prop ────┬──────── big_sep ghost_own + └──────── basic_update ───────────────────── ghost_update + +mem_ra = gmap_ra excl_ra +c_resource_ra G = prod_ra mem_ra (ghost_heap_ra G) + +resource_prop R ── ra_sl_build / ra_sl_scope ── proof_sl (`cprop`, `**`, `|--`) +``` + +这里有两个容易混淆但必须分开的层次： + +- `resource_prop` 给出 `A -> bool` 上的**语义定义和闭合 HOL 定理**； +- `proof_sl` 接受已安装的 `sl_theory`，提供定理构造函数和经验证的 backward + tactics。后者不是另一套 RA 语义。 + +## 2. 公共数学记号 ↔ HOL syntax + +### 2.1 元逻辑与类型 + +| 数学记号 | HOL syntax | 含义 | +|---|---|---| +| $A,B,K,V$ | `A`, `B`, `K`, `V` | HOL 类型变量 | +| $R : \mathrm{RA}(A)$ | `R:(A)ra` | carrier 为 `A` 的合法 RA 描述子 | +| $P,Q,S,F : \mathcal P_R$ | `P,Q,S,F:A->bool` | 资源命题；$\mathcal P_R=A\to\mathbb B$ | +| $\top,\bot$ | `T`, `F`（printer 也可能显示 `true`, `false`） | HOL 布尔真/假 | +| $x=y$ | `x == y` | HOL 对象等号 | +| $\neg p$ | `~p` | 否定 | +| $p\land q$, $p\lor q$ | `p && q`, `p \|\| q` | HOL 布尔合取/析取 | +| $p\Rightarrow q$, $p\Leftrightarrow q$ | `p ==> q`, `p <=> q` | 蕴含/布尔等价 | +| $\forall x.\,p$, $\exists x.\,p$ | `forall x. p`, `exists x. p` | 量词 | +| $\lambda x.\,t$ | `\x. t` | lambda | +| $(x,y)$, $\pi_1,\pi_2$ | `(x,y)`, `FST`, `SND` | HOL product 与投影 | +| $\mathrm{Some}(x),\mathrm{None}$ | `SOME x`, `NONE` | option 构造子 | + +### 2.2 RA + +固定 +$$ +R=(|R|,\varepsilon_R,\mathbin{\cdot_R},\checkmark_R),\qquad |R|=A. +$$ + +| 数学记号 | HOL syntax | 定义/读法 | +|---|---|---| +| $\varepsilon_R$ | `ra_unit R` | 单位元 | +| $a\cdot_R b$ | `ra_op R a b` | 资源合成 | +| $\checkmark_R(a)$ | `ra_valid R a` | `a` 有效 | +| $a\preccurlyeq_R b$ | `ra_included R a b` | 存在 frame $f$，使 $b=a\cdot_R f$ | +| $a\leadsto_R b$ | `ra_update R a b` | 确定性 frame-preserving update | +| $a\rightsquigarrow_R P$ | `ra_update_nd R a P` | 结果依赖隐藏 frame 的 ND update | +| $(a,f)\leadsto_R(b,g)$ | `ra_local_update R (a,f) (b,g)` | 保持同一隐藏 residual 的 local update | +| $\mathrm{Canc}(R)$ | `ra_cancellative R` | 有效合成上的左消去性 | +| $\mathrm{Excl}_R(a)$ | `ra_exclusive R a` | 与 `a` 相容的 frame 只能是单位元 | + +注意：$\preccurlyeq_R$ 一般只是 extension preorder，不保证反对称； +`ra_exclusive R a` 不蕴含 `ra_valid R a`，无效元素可因前提永假而 vacuous +exclusive。 + +### 2.3 资源命题与 SL + +| 数学记号 | HOL syntax | 点语义/读法 | +|---|---|---| +| $P\vdash_R Q$ | `r_entails R P Q` | 只在有效资源上观察的 entailment | +| $P\simeq_R Q$ | `r_equiv R P Q` | 双向 entailment；弱于原始函数等号 | +| $\mathsf{emp}_R$ | `r_emp R` | 精确拥有 $\varepsilon_R$ | +| $P*Q$ | `r_sep R P Q` | 资源可分成满足 `P`、`Q` 的两部分 | +| $\mathsf{own}_R(a)$ | `r_own R a` | 精确拥有 `a` | +| $\top_R,\bot_R$ | `r_top R`, `r_bottom R` | 恒真/恒假资源命题 | +| $P\land_R Q$, $P\lor_R Q$ | `r_and R P Q`, `r_or R P Q` | additive conjunction/disjunction | +| $P\Rightarrow_R Q$ | `r_impl R P Q` | 同一资源点上的蕴含 | +| $\exists_R x. P(x)$, $\forall_R x.P(x)$ | `r_exists R (\x. P x)`, `r_forall R (\x. P x)` | assertion-level 量词 | +| $\lceil\phi\rceil_R$ | `r_pure R phi` | 与资源无关的 pure 命题 | +| $\lfloor\phi\rfloor_R$ | `r_fact R phi` | $\lceil\phi\rceil_R\land\mathsf{emp}_R$；精确单位元 fact | +| $P\mathbin{-\!*}_R Q$ | `r_wand R P Q` | separating implication / magic wand | +| $\lvert\!\Rightarrow P$ | `r_bupd R P` | basic-update modality | +| $P\Rrightarrow_R Q$ | `r_viewshift R P Q` | $P\vdash_R\lvert\!\Rightarrow Q$ | +| $\mathop{\ast}_{x\in X}P(x)$ | `r_big_sep_*` | list/set/map/indexed big separation | + +原始函数等号 `P == Q` 对所有资源（包括无效资源）逐点相等； +$P\simeq_R Q$ 只要求在有效资源上互相蕴含。本文不会把二者混写。 + +### 2.4 标准构造子 + +| 构造 | HOL | 数学记号 | +|---|---|---| +| 单元 RA | `unit_ra` | $\mathbf 1$ | +| 产品 | `prod_ra R1 R2` | $R_1\times R_2$ | +| 添单位 option | `option_ra R` | $R_\bot$（`NONE` 是新单位） | +| exclusive | `excl_ra` | $\mathrm{Excl}(A)$；`ExclUnit`, `Excl a`, `ExclInvalid` | +| agreement | `agree_ra` | $\mathrm{Agree}(A)$；`AgreeUnit`, `Agree a`, `AgreeInvalid` | +| max-nat | `max_nat_ra` | $(\mathbb N,0,\max)$ | +| fractional | `frac_ra R` | $\mathrm{Frac}(R)$ | +| authoritative | `auth_ra R` | $\mathrm{Auth}(R)$；`auth_auth`, `auth_frag`, `auth_both` | +| finite-map lift | `gmap_ra R` | $K\rightharpoonup_{\mathrm{fin}}R$ | +| ghost heap | `ghost_heap_ra G` | $\mathbb N\rightharpoonup_{\mathrm{fin}}G$ | +| C resource | `c_resource_ra G` | $\mathrm{Mem}\times\mathrm{GhostHeap}(G)$ | + +## 3. RA 核心：精确定义与定理 + +源文件：[`ra.h`](../theory/logic/ra.h)、[`ra.c`](../theory/logic/ra.c)。 + +### 3.1 表示、关系与直接消去 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `ra_unit_def` | `` `\|- ra_unit R == FST (ra_rep R)` `` | $\varepsilon_R=\pi_1(\mathrm{rep}(R))$ | +| `ra_op_def` | `` `\|- ra_op R == FST (SND (ra_rep R))` `` | $(\cdot_R)=\pi_1\pi_2(\mathrm{rep}(R))$ | +| `ra_valid_def` | `` `\|- ra_valid R == SND (SND (ra_rep R))` `` | $\checkmark_R=\pi_2\pi_2(\mathrm{rep}(R))$ | +| `ra_included_def` | `` `\|- ra_included R a b <=> (exists frame. b == ra_op R a frame)` `` | $a\preccurlyeq_R b\Leftrightarrow\exists f.\ b=a\cdot_R f$ | +| `ra_update_nd_def` | `` `\|- ra_update_nd R a result <=> (forall frame. ra_valid R (ra_op R a frame) ==> (exists b. result b && ra_valid R (ra_op R b frame)))` `` | $a\rightsquigarrow_R P\Leftrightarrow\forall f.\ \checkmark(a\cdot f)\Rightarrow\exists b.\ P(b)\land\checkmark(b\cdot f)$ | +| `ra_update_def` | `` `\|- ra_update R a b <=> (forall frame. ra_valid R (ra_op R a frame) ==> ra_valid R (ra_op R b frame))` `` | $a\leadsto_R b\Leftrightarrow\forall f.\ \checkmark(a\cdot f)\Rightarrow\checkmark(b\cdot f)$ | +| `ra_cancellative_def` | `` `\|- ra_cancellative R <=> (forall frame a b. ra_valid R (ra_op R frame a) ==> ra_op R frame a == ra_op R frame b ==> a == b)` `` | $\mathrm{Canc}(R)\Leftrightarrow\forall f,a,b.\ \checkmark(f\cdot a)\land f\cdot a=f\cdot b\Rightarrow a=b$ | +| `ra_exclusive_def` | `` `\|- ra_exclusive R a <=> (forall frame. ra_valid R (ra_op R a frame) ==> frame == ra_unit R)` `` | $\mathrm{Excl}_R(a)\Leftrightarrow\forall f.\ \checkmark(a\cdot f)\Rightarrow f=\varepsilon$ | +| `RA_CANCELLATIVE_APPLY` | `` `\|- forall R frame a b. ra_cancellative R ==> ra_valid R (ra_op R frame a) ==> ra_op R frame a == ra_op R frame b ==> a == b` `` | 消去性的直接应用式 | +| `RA_EXCLUSIVE_APPLY` | `` `\|- forall R a frame. ra_exclusive R a ==> ra_valid R (ra_op R a frame) ==> frame == ra_unit R` `` | exclusive 的直接应用式 | +| `RA_UPDATE_APPLY` | `` `\|- forall R a b frame. ra_update R a b ==> ra_valid R (ra_op R a frame) ==> ra_valid R (ra_op R b frame)` `` | 确定更新保持任意相容 frame | +| `RA_UPDATE_ND_APPLY` | `` `\|- forall R a P frame. ra_update_nd R a P ==> ra_valid R (ra_op R a frame) ==> (exists b. P b && ra_valid R (ra_op R b frame))` `` | ND 更新为给定 frame 选择有效结果 | + +#### 3.1.1 Lawful descriptor 的构造边界 + +新 RA instance 先证明 raw descriptor +$(e,(\mathit{op},\mathit{valid}))$ 满足 ra_laws，再用 +ra_abs 构造 unary HOL type (A)ra： + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| ra_laws_def | |- ra_laws e op valid <=> (forall a b c. op (op a b) c == op a (op b c)) && (forall a b. op a b == op b a) && (forall a. op e a == a) && valid e && (forall a b. valid (op a b) ==> valid a) | 结合、交换、左单位、unit valid、validity downward closure | +| RA_TYPE_BIJECTION | |- (forall R. ra_abs (ra_rep R) == R) && (forall d. ra_laws (FST d) (FST (SND d)) (SND (SND d)) <=> ra_rep (ra_abs d) == d) | abstract RA type 与 lawful descriptors 的双射 | +| RA_REP_LAWS | |- forall R. ra_laws (FST (ra_rep R)) (FST (SND (ra_rep R))) (SND (SND (ra_rep R))) | 任意 abstract descriptor 的 representation lawful | +| RA_ABS_REP | |- forall e op valid. ra_laws e op valid ==> ra_rep (ra_abs (e,op,valid)) == e,op,valid | lawful descriptor 的 representation round trip | +| RA_UNIT_ABS | |- forall e op valid. ra_laws e op valid ==> ra_unit (ra_abs (e,op,valid)) == e | lawful descriptor 的 unit projection | +| RA_OP_ABS | |- forall e op valid. ra_laws e op valid ==> ra_op (ra_abs (e,op,valid)) == op | lawful descriptor 的 operation projection | +| RA_VALID_ABS | |- forall e op valid. ra_laws e op valid ==> ra_valid (ra_abs (e,op,valid)) == valid | lawful descriptor 的 validity projection | +| RA_ABS_ETA | |- forall R. ra_abs (ra_unit R,ra_op R,ra_valid R) == R | 用三个 public projections 重建同一 RA | + +ra_abs 在 HOL 中是总函数，但对不 lawful descriptor 没有对应的 +projection equation；不能省略 premise。 + +### 3.2 内在 RA 律与有效性 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `RA_LAWS` | `` `\|- forall R. ra_laws (ra_unit R) (ra_op R) (ra_valid R)` `` | 每个 `R:(A)ra` 都满足下列全部内在律 | +| `RA_ASSOC` | `` `\|- forall R a b c. ra_op R (ra_op R a b) c == ra_op R a (ra_op R b c)` `` | $(a\cdot b)\cdot c=a\cdot(b\cdot c)$ | +| `RA_COMM` | `` `\|- forall R a b. ra_op R a b == ra_op R b a` `` | $a\cdot b=b\cdot a$ | +| `RA_OP_SWAP_RIGHT` | `` `\|- forall R a b c. ra_op R (ra_op R a b) c == ra_op R (ra_op R a c) b` `` | $(a\cdot b)\cdot c=(a\cdot c)\cdot b$ | +| `RA_UNIT_L` | `` `\|- forall R a. ra_op R (ra_unit R) a == a` `` | $\varepsilon\cdot a=a$ | +| `RA_UNIT_R` | `` `\|- forall R a. ra_op R a (ra_unit R) == a` `` | $a\cdot\varepsilon=a$ | +| `RA_VALID_UNIT` | `` `\|- forall R. ra_valid R (ra_unit R)` `` | $\checkmark(\varepsilon)$ | +| `RA_VALID_OP_L` | `` `\|- forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R a` `` | $\checkmark(a\cdot b)\Rightarrow\checkmark(a)$ | +| `RA_VALID_OP_R` | `` `\|- forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R b` `` | $\checkmark(a\cdot b)\Rightarrow\checkmark(b)$ | +| `RA_VALID_OP` | `` `\|- forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R a && ra_valid R b` `` | $\checkmark(a\cdot b)\Rightarrow\checkmark(a)\land\checkmark(b)$ | + +反方向一般不成立：两个分别有效的资源未必彼此相容。 + +### 3.3 包含序 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `RA_INCLUDED_REFL` | `` `\|- forall R a. ra_included R a a` `` | $a\preccurlyeq a$ | +| `RA_INCLUDED_UNIT` | `` `\|- forall R a. ra_included R (ra_unit R) a` `` | $\varepsilon\preccurlyeq a$ | +| `RA_INCLUDED_OP_L` | `` `\|- forall R a b. ra_included R a (ra_op R a b)` `` | $a\preccurlyeq a\cdot b$ | +| `RA_INCLUDED_OP_R` | `` `\|- forall R a b. ra_included R b (ra_op R a b)` `` | $b\preccurlyeq a\cdot b$ | +| `RA_INCLUDED_TRANS` | `` `\|- forall R a b c. ra_included R a b ==> ra_included R b c ==> ra_included R a c` `` | $a\preccurlyeq b\preccurlyeq c\Rightarrow a\preccurlyeq c$ | +| `RA_INCLUDED_OP_MONO_L` | `` `\|- forall R a1 a2 b. ra_included R a1 a2 ==> ra_included R (ra_op R a1 b) (ra_op R a2 b)` `` | $a_1\preccurlyeq a_2\Rightarrow a_1\cdot b\preccurlyeq a_2\cdot b$ | +| `RA_INCLUDED_OP_MONO_R` | `` `\|- forall R a1 a2 b. ra_included R a1 a2 ==> ra_included R (ra_op R b a1) (ra_op R b a2)` `` | $a_1\preccurlyeq a_2\Rightarrow b\cdot a_1\preccurlyeq b\cdot a_2$ | +| `RA_INCLUDED_OP_MONO` | `` `\|- forall R a1 a2 b1 b2. ra_included R a1 a2 ==> ra_included R b1 b2 ==> ra_included R (ra_op R a1 b1) (ra_op R a2 b2)` `` | 两个参数上的单调性 | +| `RA_INCLUDED_VALID` | `` `\|- forall R a b. ra_included R a b ==> ra_valid R b ==> ra_valid R a` `` | $a\preccurlyeq b\land\checkmark(b)\Rightarrow\checkmark(a)$ | +| `RA_INCLUDED_VALID_FRAME` | `` `\|- forall R a b frame. ra_included R a b ==> ra_valid R (ra_op R b frame) ==> ra_valid R (ra_op R a frame)` `` | 较小资源保持较大资源的相容 frame | +| `RA_INCLUDED_CANCEL_L` | `` `\|- forall R common a b. ra_cancellative R ==> ra_valid R (ra_op R common b) ==> ra_included R (ra_op R common a) (ra_op R common b) ==> ra_included R a b` `` | 有效前提下从 $c\cdot a\preccurlyeq c\cdot b$ 消去共同前缀 | + +### 3.4 exclusive + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `RA_EXCLUSIVE_INCLUDED` | `` `\|- forall R a b. ra_exclusive R a ==> ra_valid R b ==> ra_included R a b ==> a == b` `` | exclusive 元素没有真有效扩张 | +| `RA_EXCLUSIVE_IFF_INCLUDED` | `` `\|- forall R a. ra_cancellative R ==> (ra_exclusive R a <=> forall b. ra_valid R b ==> ra_included R a b ==> a == b)` `` | 在 cancellative RA 中，exclusive 等价于有效扩张极大性 | +| `RA_INVALID_EXCLUSIVE` | `` `\|- forall R a. ~ra_valid R a ==> ra_exclusive R a` `` | 无效元素 vacuously exclusive | +| `RA_EXCLUSIVE_VALID_OP_IFF` | `` `\|- forall R a frame. ra_exclusive R a ==> (ra_valid R (ra_op R a frame) <=> ra_valid R a && frame == ra_unit R)` `` | $\mathrm{Excl}(a)\Rightarrow[\checkmark(a\cdot f)\Leftrightarrow\checkmark(a)\land f=\varepsilon]$ | + +### 3.5 nondeterministic frame-preserving update + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `RA_UPDATE_ND_SINGLETON` | `` `\|- forall R a b. ra_update_nd R a (\x. x == b) <=> ra_update R a b` `` | singleton ND update 等价于确定更新 | +| `RA_UPDATE_ND_REFL` | `` `\|- forall R a. ra_update_nd R a (\x. x == a)` `` | $a\rightsquigarrow\{a\}$ | +| `RA_UPDATE_ND_TRANS` | `` `\|- forall R a P Q. ra_update_nd R a P ==> (forall b. P b ==> ra_update_nd R b Q) ==> ra_update_nd R a Q` `` | ND Kleisli 式顺序复合 | +| `RA_UPDATE_ND_MONO` | `` `\|- forall R a P Q. ra_update_nd R a P ==> (forall b. P b ==> Q b) ==> ra_update_nd R a Q` `` | 后置谓词弱化 | +| `RA_UPDATE_ND_OF_UPDATE` | `` `\|- forall R a b P. ra_update R a b ==> P b ==> ra_update_nd R a P` `` | 确定更新嵌入 ND 更新 | +| `RA_UPDATE_ND_VALID` | `` `\|- forall R a P. ra_update_nd R a P ==> ra_valid R a ==> (exists b. P b && ra_valid R b)` `` | 有效源至少产生一个有效结果 | +| `RA_UPDATE_ND_INVALID` | `` `\|- forall R a P. ~ra_valid R a ==> ra_update_nd R a P` `` | 无效源上的更新 vacuous | +| `RA_UPDATE_ND_FRAME` | `` `\|- forall R a P. ra_update_nd R a P ==> (forall extra. ra_update_nd R (ra_op R a extra) (\x. exists b. P b && x == ra_op R b extra))` `` | 给源和每个结果加同一 `extra` | +| `RA_UPDATE_ND_OP` | `` `\|- forall R a c P Q. ra_update_nd R a P ==> ra_update_nd R c Q ==> ra_update_nd R (ra_op R a c) (\x. exists b d. P b && Q d && x == ra_op R b d)` `` | 两个独立 ND 更新按合成相乘 | +| `RA_EXCLUSIVE_UPDATE_ND_IFF` | `` `\|- forall R a P. ra_exclusive R a ==> (ra_update_nd R a P <=> ra_valid R a ==> (exists b. P b && ra_valid R b))` `` | exclusive 源把 ND 更新化为普通有效结果存在性 | + +### 3.6 deterministic frame-preserving update + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `RA_EXCLUSIVE_UPDATE` | `` `\|- forall R a b. ra_exclusive R a ==> ra_valid R b ==> ra_update R a b` `` | exclusive 源可更新到任意有效目标 | +| `RA_UPDATE_REFL` | `` `\|- forall R a. ra_update R a a` `` | $a\leadsto a$ | +| `RA_UPDATE_INVALID` | `` `\|- forall R a b. ~ra_valid R a ==> ra_update R a b` `` | 无效源上的更新 vacuous | +| `RA_UPDATE_INCLUDED` | `` `\|- forall R a b. ra_included R b a ==> ra_update R a b` `` | 可丢弃 extension | +| `RA_UPDATE_UNIT` | `` `\|- forall R a. ra_update R a (ra_unit R)` `` | 任意资源可丢弃为单位元 | +| `RA_UPDATE_TRANS` | `` `\|- forall R a b c. ra_update R a b ==> ra_update R b c ==> ra_update R a c` `` | 更新可传递复合 | +| `RA_UPDATE_TARGET_INCLUDED` | `` `\|- forall R a b c. ra_update R a b ==> ra_included R c b ==> ra_update R a c` `` | 更新目标可继续弱化到其 included 部分 | +| `RA_UPDATE_VALID` | `` `\|- forall R a b. ra_update R a b ==> ra_valid R a ==> ra_valid R b` `` | 有效源的更新目标有效 | +| `RA_EXCLUSIVE_UPDATE_IFF` | `` `\|- forall R a b. ra_exclusive R a ==> (ra_update R a b <=> ra_valid R a ==> ra_valid R b)` `` | exclusive 源上的确定更新精确刻画 | +| `RA_UPDATE_FRAME` | `` `\|- forall R a b. ra_update R a b ==> (forall extra. ra_update R (ra_op R a extra) (ra_op R b extra))` `` | 确定更新可加 frame | +| `RA_UPDATE_OP` | `` `\|- forall R a b c d. ra_update R a b ==> ra_update R c d ==> ra_update R (ra_op R a c) (ra_op R b d)` `` | 两个独立确定更新按合成相乘 | + +## 4. Local update + +源文件：[`local_update.h`](../theory/logic/local_update.h)、 +[`local_update.c`](../theory/logic/local_update.c)。令 +$(a,f)\leadsto_R(b,g)$ 表示 `ra_local_update R (a,f) (b,g)`。 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `ra_local_update_def` | `` `\|- ra_local_update R source target <=> (forall frame. ra_valid R (FST source) ==> FST source == ra_op R (SND source) frame ==> ra_valid R (FST target) && FST target == ra_op R (SND target) frame)` `` | 对每个满足 $a=f\cdot r$ 的同一 residual $r$，目标满足 $b=g\cdot r$ 且有效 | +| `RA_LOCAL_UPDATE_APPLY` | `` `\|- forall R source target frame. ra_local_update R source target ==> ra_valid R (FST source) ==> FST source == ra_op R (SND source) frame ==> ra_valid R (FST target) && FST target == ra_op R (SND target) frame` `` | 定义的直接应用式 | +| `RA_LOCAL_UPDATE_REFL` | `` `\|- forall R source. ra_local_update R source source` `` | $s\leadsto_R s$ | +| `RA_LOCAL_UPDATE_INVALID` | `` `\|- forall R a f b g. ~ra_valid R a ==> ra_local_update R (a,f) (b,g)` `` | 无效 whole 上 vacuous | +| `RA_LOCAL_UPDATE_TRANS` | `` `\|- forall R source middle target. ra_local_update R source middle ==> ra_local_update R middle target ==> ra_local_update R source target` `` | 传递复合 | +| `RA_LOCAL_UPDATE_FRAME` | `` `\|- forall R a f b g extra. ra_local_update R (a,f) (b,g) ==> ra_local_update R (a,ra_op R f extra) (b,ra_op R g extra)` `` | visible local part 两侧加同一 `extra` | +| `RA_LOCAL_UPDATE_PRESERVES_INCLUDED` | `` `\|- forall R a f b g external. ra_local_update R (a,f) (b,g) ==> ra_valid R a ==> ra_included R (ra_op R f external) a ==> ra_valid R b && ra_included R (ra_op R g external) b` `` | 保持所有外部 frame 下的 inclusion 与有效性 | +| `RA_LOCAL_UPDATE_VALID_INCLUDED` | `` `\|- forall R a f b g. ra_local_update R (a,f) (b,g) ==> ra_valid R a ==> ra_included R f a ==> ra_valid R b && ra_included R g b` `` | 上条在外部单位 frame 的特例 | +| `RA_LOCAL_UPDATE_OP` | `` `\|- forall R a f piece. (ra_valid R a ==> ra_valid R (ra_op R a piece)) ==> ra_local_update R (a,f) (ra_op R a piece,ra_op R f piece)` `` | 若扩张保持源有效性，则 whole 与 owned 同时分配 `piece` | +| `RA_LOCAL_UPDATE_ALLOC` | `` `\|- forall R a f piece. ra_valid R (ra_op R a piece) ==> ra_local_update R (a,f) (ra_op R a piece,ra_op R f piece)` `` | 直接有效性版本的同步分配 | +| `RA_LOCAL_UPDATE_EXCLUSIVE` | `` `\|- forall R a f b. ra_exclusive R f ==> ra_valid R b ==> ra_local_update R (a,f) (b,b)` `` | exclusive local part 可替换为完整拥有的任意有效 `b` | +| `RA_LOCAL_UPDATE_CANCEL` | `` `\|- forall R common a f. ra_cancellative R ==> ra_local_update R (ra_op R common a,ra_op R common f) (a,f)` `` | 从 whole 与 local part 同时消去共同前缀 | +| `RA_LOCAL_UPDATE_CANCEL_UNIT` | `` `\|- forall R common a. ra_cancellative R ==> ra_local_update R (ra_op R common a,common) (a,ra_unit R)` `` | 把共同 local part 全部消去 | +| `RA_LOCAL_UPDATE_CANCELLATIVE` | `` `\|- forall R a b common. ra_cancellative R ==> ra_valid R (ra_op R b common) ==> ra_local_update R (ra_op R a common,a) (ra_op R b common,b)` `` | cancellative RA 中保持 residual `common` 的同步替换 | + +## 5. 资源命题与 BI/SL + +源文件：[`resource_prop.h`](../theory/logic/resource_prop.h)、 +[`resource_prop.c`](../theory/logic/resource_prop.c)。以下等式定理是 assertion +函数的原始 HOL 等号，因此比 $\simeq_R$ 更强。 + +### 5.1 语义定义 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `r_entails_def` | `` `\|- r_entails R P Q <=> (forall resource. ra_valid R resource ==> P resource ==> Q resource)` `` | $P\vdash_R Q\Leftrightarrow\forall a.\ \checkmark(a)\Rightarrow P(a)\Rightarrow Q(a)$ | +| `r_equiv_def` | `` `\|- r_equiv R P Q <=> r_entails R P Q && r_entails R Q P` `` | $P\simeq_RQ\Leftrightarrow(P\vdash_RQ)\land(Q\vdash_RP)$ | +| `r_emp_def` | `` `\|- r_emp R resource <=> resource == ra_unit R` `` | $\mathsf{emp}(a)\Leftrightarrow a=\varepsilon$ | +| `r_sep_def` | `` `\|- r_sep R P Q resource <=> (exists left right. resource == ra_op R left right && P left && Q right)` `` | $(P*Q)(a)\Leftrightarrow\exists x,y.\ a=x\cdot y\land P(x)\land Q(y)$ | +| `r_own_def` | `` `\|- r_own R owned resource <=> resource == owned` `` | $\mathsf{own}(x)(a)\Leftrightarrow a=x$ | +| `r_top_def` | `` `\|- r_top R resource <=> true` `` | $\top_R(a)\Leftrightarrow\top$ | +| `r_bottom_def` | `` `\|- r_bottom R resource <=> false` `` | $\bot_R(a)\Leftrightarrow\bot$ | +| `r_and_def` | `` `\|- r_and R P Q resource <=> P resource && Q resource` `` | $(P\land_RQ)(a)\Leftrightarrow P(a)\land Q(a)$ | +| `r_or_def` | `` `\|- r_or R P Q resource <=> P resource \|\| Q resource` `` | $(P\lor_RQ)(a)\Leftrightarrow P(a)\lor Q(a)$ | +| `r_impl_def` | `` `\|- r_impl R P Q resource <=> P resource ==> Q resource` `` | $(P\Rightarrow_RQ)(a)\Leftrightarrow(P(a)\Rightarrow Q(a))$ | +| `r_exists_def` | `` `\|- r_exists R P resource <=> (exists witness. P witness resource)` `` | $(\exists_Rx.P_x)(a)\Leftrightarrow\exists x.P_x(a)$ | +| `r_forall_def` | `` `\|- r_forall R P resource <=> (forall witness. P witness resource)` `` | $(\forall_Rx.P_x)(a)\Leftrightarrow\forall x.P_x(a)$ | +| `r_pure_def` | `` `\|- r_pure R phi resource <=> phi` `` | $\lceil\phi\rceil_R(a)\Leftrightarrow\phi$ | +| `r_fact_def` | `` `\|- r_fact R phi resource <=> phi && resource == ra_unit R` `` | $\lfloor\phi\rfloor_R(a)\Leftrightarrow\phi\land a=\varepsilon$ | +| `r_wand_def` | `` `\|- r_wand R P Q resource <=> (forall frame. ra_valid R (ra_op R resource frame) ==> P frame ==> Q (ra_op R resource frame))` `` | $(P-\!*Q)(a)\Leftrightarrow\forall f.\ \checkmark(a\cdot f)\Rightarrow P(f)\Rightarrow Q(a\cdot f)$ | + +`r_wand` 显式检查 `a·frame` 的有效性；entailment 本身也只观察有效资源。这两处 +有效性条件共同保证 adjunction 与 RA 的 partial composition 语义一致。 + +### 5.2 entailment 与 equivalence + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `R_ENTAILS_REFL` | `` `\|- forall R P. r_entails R P P` `` | $P\vdash_RP$ | +| `R_ENTAILS_TRANS` | `` `\|- forall R P Q S. r_entails R P Q ==> r_entails R Q S ==> r_entails R P S` `` | entailment 传递性 | +| `R_ENTAILS_POINTWISE` | `` `\|- forall R P Q. (forall resource. P resource ==> Q resource) ==> r_entails R P Q` `` | 全载体逐点蕴含可提升为有效资源 entailment | +| `R_EQUIV_POINTWISE` | `` `\|- forall R P Q. r_equiv R P Q <=> (forall resource. ra_valid R resource ==> (P resource <=> Q resource))` `` | $P\simeq_RQ$ 恰为有效点上的逐点等价 | +| `R_EQUIV_INTRO` | `` `\|- forall R P Q. r_entails R P Q ==> r_entails R Q P ==> r_equiv R P Q` `` | 双向 entailment 引入 equivalence | +| `R_EQUIV_REFL` | `` `\|- forall R P. r_equiv R P P` `` | $P\simeq_RP$ | +| `R_EQUIV_SYM` | `` `\|- forall R P Q. r_equiv R P Q ==> r_equiv R Q P` `` | 对称性 | +| `R_EQUIV_TRANS` | `` `\|- forall R P Q S. r_equiv R P Q ==> r_equiv R Q S ==> r_equiv R P S` `` | 传递性 | + +### 5.3 separating conjunction + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `R_SEP_ASSOC` | `` `\|- forall R P Q S. r_sep R (r_sep R P Q) S == r_sep R P (r_sep R Q S)` `` | $(P*Q)*S=P*(Q*S)$ | +| `R_SEP_COMM` | `` `\|- forall R P Q. r_sep R P Q == r_sep R Q P` `` | $P*Q=Q*P$ | +| `R_SEP_EMP_L` | `` `\|- forall R P. r_sep R (r_emp R) P == P` `` | $\mathsf{emp}*P=P$ | +| `R_SEP_EMP_R` | `` `\|- forall R P. r_sep R P (r_emp R) == P` `` | $P*\mathsf{emp}=P$ | +| `R_SEP_MONO` | `` `\|- forall R P P2 Q Q2. r_entails R P P2 ==> r_entails R Q Q2 ==> r_entails R (r_sep R P Q) (r_sep R P2 Q2)` `` | $P\vdash P'\land Q\vdash Q'\Rightarrow P*Q\vdash P'*Q'$ | +| `R_SEP_FRAME_L` | `` `\|- forall R P Q frame_pred. r_entails R P Q ==> r_entails R (r_sep R P frame_pred) (r_sep R Q frame_pred)` `` | $P\vdash Q\Rightarrow P*F\vdash Q*F$ | +| `R_SEP_FRAME_R` | `` `\|- forall R P Q frame_pred. r_entails R P Q ==> r_entails R (r_sep R frame_pred P) (r_sep R frame_pred Q)` `` | $P\vdash Q\Rightarrow F*P\vdash F*Q$ | +| `R_SEP_EXISTS_L` | `` `\|- forall R P Q. r_sep R (r_exists R (\witness. P witness)) Q == r_exists R (\witness. r_sep R (P witness) Q)` `` | $(\exists_Rx.P_x)*Q=\exists_Rx.(P_x*Q)$ | +| `R_SEP_EXISTS_R` | `` `\|- forall R P Q. r_sep R P (r_exists R (\witness. Q witness)) == r_exists R (\witness. r_sep R P (Q witness))` `` | $P*(\exists_Rx.Q_x)=\exists_Rx.(P*Q_x)$ | + +`R_SEP_FRAME_L/R` 的数学栏严格按**实际 theorem conclusion** 写。当前 +`resource_prop.h` 里的两条一行注释把 `F*P` 与 `P*F` 对调了；定理本身因 +`R_SEP_COMM` 逻辑上等价，但精确语法检查时应以本表为准。 + +### 5.4 additive connectives 与量词 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `R_AND_INTRO` | `` `\|- forall R P Q S. r_entails R P Q ==> r_entails R P S ==> r_entails R P (r_and R Q S)` `` | $P\vdash Q\land P\vdash S\Rightarrow P\vdash Q\land_RS$ | +| `R_AND_ELIM_L` | `` `\|- forall R P Q. r_entails R (r_and R P Q) P` `` | $P\land_RQ\vdash P$ | +| `R_AND_ELIM_R` | `` `\|- forall R P Q. r_entails R (r_and R P Q) Q` `` | $P\land_RQ\vdash Q$ | +| `R_OR_INTRO_L` | `` `\|- forall R P Q. r_entails R P (r_or R P Q)` `` | $P\vdash P\lor_RQ$ | +| `R_OR_INTRO_R` | `` `\|- forall R P Q. r_entails R Q (r_or R P Q)` `` | $Q\vdash P\lor_RQ$ | +| `R_OR_ELIM` | `` `\|- forall R P Q S. r_entails R P S ==> r_entails R Q S ==> r_entails R (r_or R P Q) S` `` | 析取消去 | +| `R_EXISTS_INTRO` | `` `\|- forall R P witness. r_entails R (P witness) (r_exists R (\bound. P bound))` `` | $P_w\vdash\exists_Rx.P_x$ | +| `R_EXISTS_ELIM` | `` `\|- forall R P Q. (forall witness. r_entails R (P witness) Q) ==> r_entails R (r_exists R (\bound. P bound)) Q` `` | $(\forall x.P_x\vdash Q)\Rightarrow(\exists_Rx.P_x)\vdash Q$ | +| `R_EXISTS_MONO` | `` `\|- forall R P Q. (forall witness. r_entails R (P witness) (Q witness)) ==> r_entails R (r_exists R (\bound. P bound)) (r_exists R (\bound. Q bound))` `` | existential 的 pointwise 单调性 | +| `R_FORALL_INTRO` | `` `\|- forall R P Q. (forall witness. r_entails R P (Q witness)) ==> r_entails R P (r_forall R (\bound. Q bound))` `` | universal 引入 | +| `R_FORALL_ELIM` | `` `\|- forall R P Q witness. r_entails R (P witness) Q ==> r_entails R (r_forall R (\bound. P bound)) Q` `` | 以给定 witness 消去 universal | + +### 5.5 pure、exact-unit fact、ownership 与 adjunction + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `R_PURE_AND_INTRO` | `` `\|- forall R phi P Q. phi ==> r_entails R P Q ==> r_entails R P (r_and R (r_pure R phi) Q)` `` | 已知 $\phi$ 时把 pure 事实加入 additive conjunction | +| `R_PURE_AND_ELIM` | `` `\|- forall R phi P Q. (phi ==> r_entails R P Q) ==> r_entails R (r_and R (r_pure R phi) P) Q` `` | 从 pure guard 下证明即可消去它 | +| `R_FACT_AS_PURE_AND_EMP` | `` `\|- forall R phi. r_fact R phi == r_and R (r_pure R phi) (r_emp R)` `` | $\lfloor\phi\rfloor=\lceil\phi\rceil\land_R\mathsf{emp}$ | +| `R_FACT_TRUE` | `` `\|- forall R. r_fact R true == r_emp R` `` | $\lfloor\top\rfloor=\mathsf{emp}$ | +| `R_FACT_FALSE` | `` `\|- forall R. r_fact R false == r_bottom R` `` | $\lfloor\bot\rfloor=\bot_R$ | +| `R_FACT_SEP_L` | `` `\|- forall R phi P. r_sep R (r_fact R phi) P == r_and R (r_pure R phi) P` `` | $\lfloor\phi\rfloor*P=\lceil\phi\rceil\land_RP$ | +| `R_FACT_SEP_R` | `` `\|- forall R phi P. r_sep R P (r_fact R phi) == r_and R (r_pure R phi) P` `` | $P*\lfloor\phi\rfloor=\lceil\phi\rceil\land_RP$ | +| `R_FACT_INTRO` | `` `\|- forall R phi P Q. phi ==> r_entails R P Q ==> r_entails R P (r_sep R (r_fact R phi) Q)` `` | 已知 $\phi$ 时引入 exact-unit fact | +| `R_FACT_ELIM` | `` `\|- forall R phi P Q. (phi ==> r_entails R P Q) ==> r_entails R (r_sep R (r_fact R phi) P) Q` `` | fact 消去 | +| `R_FACT_DUP` | `` `\|- forall R phi. r_entails R (r_fact R phi) (r_sep R (r_fact R phi) (r_fact R phi))` `` | exact-unit fact 可复制 | +| `R_OWN_UNIT` | `` `\|- forall R. r_own R (ra_unit R) == r_emp R` `` | $\mathsf{own}(\varepsilon)=\mathsf{emp}$ | +| `R_OWN_OP` | `` `\|- forall R a b. r_own R (ra_op R a b) == r_sep R (r_own R a) (r_own R b)` `` | $\mathsf{own}(a\cdot b)=\mathsf{own}(a)*\mathsf{own}(b)$ | +| `R_OWN_VALID` | `` `\|- forall R a. r_entails R (r_own R a) (r_and R (r_pure R (ra_valid R a)) (r_own R a))` `` | ownership entail 自身有效性，同时保留 ownership | +| `R_IMPL_ADJUNCTION` | `` `\|- forall R P Q S. r_entails R (r_and R P Q) S <=> r_entails R P (r_impl R Q S)` `` | $P\land_RQ\vdash S\Leftrightarrow P\vdash(Q\Rightarrow_RS)$ | +| `R_WAND_ADJUNCTION` | `` `\|- forall R P Q S. r_entails R (r_sep R P Q) S <=> r_entails R P (r_wand R Q S)` `` | $P*Q\vdash S\Leftrightarrow P\vdash(Q-\!*_RS)$ | +| `R_SEP_AND_FORWARD_R` | `` `\|- forall R P Q S. r_entails R (r_sep R P (r_and R Q S)) (r_and R (r_sep R P Q) (r_sep R P S))` `` | $P*(Q\land_RS)\vdash(P*Q)\land_R(P*S)$ | +| `R_SEP_AND_FORWARD_L` | `` `\|- forall R P Q S. r_entails R (r_sep R (r_and R Q S) P) (r_and R (r_sep R Q P) (r_sep R S P))` `` | $(Q\land_RS)*P\vdash(Q*P)\land_R(S*P)$ | + +后两条只有 forward entailment；一般不能反推为等式，因为 additive conjunction +两侧可以采用不同的资源分解。 + +## 6. Basic update 与 view shift + +源文件：[`basic_update.h`](../theory/logic/basic_update.h)、 +[`basic_update.c`](../theory/logic/basic_update.c)。记 +$\lvert\!\Rightarrow P=\mathsf{bupd}_R(P)$， +$P\Rrightarrow_RQ=\mathsf{viewshift}_R(P,Q)$。 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `r_bupd_def` | `` `\|- r_bupd R Q owned <=> ra_update_nd R owned Q` `` | $(\lvert\!\Rightarrow Q)(a)\Leftrightarrow a\rightsquigarrow_RQ$ | +| `r_viewshift_def` | `` `\|- r_viewshift R P Q <=> r_entails R P (r_bupd R Q)` `` | $P\Rrightarrow_RQ\Leftrightarrow P\vdash_R\lvert\!\Rightarrow Q$ | +| `R_BUPD_INTRO` | `` `\|- forall R P. r_entails R P (r_bupd R P)` `` | $P\vdash\lvert\!\Rightarrow P$ | +| `R_BUPD_MONO` | `` `\|- forall R P Q. r_entails R P Q ==> r_entails R (r_bupd R P) (r_bupd R Q)` `` | $P\vdash Q\Rightarrow(\lvert\!\Rightarrow P)\vdash(\lvert\!\Rightarrow Q)$ | +| `R_BUPD_IDEM` | `` `\|- forall R P. r_entails R (r_bupd R (r_bupd R P)) (r_bupd R P)` `` | $\lvert\!\Rightarrow\lvert\!\Rightarrow P\vdash\lvert\!\Rightarrow P$ | +| `R_BUPD_FRAME` | `` `\|- forall R P frame_pred. r_entails R (r_sep R (r_bupd R P) frame_pred) (r_bupd R (r_sep R P frame_pred))` `` | $(\lvert\!\Rightarrow P)*F\vdash\lvert\!\Rightarrow(P*F)$ | +| `R_VIEWSHIFT_REFL` | `` `\|- forall R P. r_viewshift R P P` `` | $P\Rrightarrow_RP$ | +| `R_ENTAILS_TO_VIEWSHIFT` | `` `\|- forall R P Q. r_entails R P Q ==> r_viewshift R P Q` `` | $P\vdash Q\Rightarrow P\Rrightarrow_RQ$ | +| `R_VIEWSHIFT_TRANS` | `` `\|- forall R P Q S. r_viewshift R P Q ==> r_viewshift R Q S ==> r_viewshift R P S` `` | view shift 传递性 | +| `R_VIEWSHIFT_MONO` | `` `\|- forall R P2 P Q Q2. r_entails R P2 P ==> r_viewshift R P Q ==> r_entails R Q Q2 ==> r_viewshift R P2 Q2` `` | 前件逆变、后件协变 | +| `R_VIEWSHIFT_FRAME` | `` `\|- forall R P Q frame_pred. r_viewshift R P Q ==> r_viewshift R (r_sep R P frame_pred) (r_sep R Q frame_pred)` `` | $P\Rrightarrow Q\Rightarrow P*F\Rrightarrow Q*F$ | +| `R_VIEWSHIFT_SEP` | `` `\|- forall R P1 Q1 P2 Q2. r_viewshift R P1 Q1 ==> r_viewshift R P2 Q2 ==> r_viewshift R (r_sep R P1 P2) (r_sep R Q1 Q2)` `` | 两个 view shift 按 separating conjunction 组合 | +| `R_VIEWSHIFT_EXISTS_L` | `` `\|- forall R P Q. (forall witness. r_viewshift R (P witness) Q) ==> r_viewshift R (r_exists R (\bound. P bound)) Q` `` | 从 existential 前件消去 witness | +| `R_VIEWSHIFT_EXISTS_R` | `` `\|- forall R P Q witness. r_viewshift R P (Q witness) ==> r_viewshift R P (r_exists R (\bound. Q bound))` `` | 向 existential 后件引入指定 witness | +| `R_VIEWSHIFT_EXISTS` | `` `\|- forall R P Q. (forall witness. r_viewshift R (P witness) (Q witness)) ==> r_viewshift R (r_exists R (\bound. P bound)) (r_exists R (\bound. Q bound))` `` | pointwise view shift 提升过 existential | +| `R_OWN_UPDATE` | `` `\|- forall R a b. ra_update R a b ==> r_viewshift R (r_own R a) (r_own R b)` `` | RA 确定更新提升为 ownership view shift | +| `R_OWN_UPDATE_ND` | `` `\|- forall R a result_pred. ra_update_nd R a result_pred ==> r_viewshift R (r_own R a) (r_exists R (\selected. r_and R (r_pure R (result_pred selected)) (r_own R selected)))` `` | ND 更新暴露 existential 结果、后置条件与新 ownership | + +## 7. Iterated separating conjunction（big-sep） + +源文件：[`big_sep.h`](../theory/logic/big_sep.h)、 +[`big_sep.c`](../theory/logic/big_sep.c)。采用以下数学缩写： + +- $\mathop{\ast}_R[P_0,\ldots,P_n]$：`r_big_sep R Ps`； +- $\mathop{\ast}_{x\in xs}^{R}\Phi(x)$：`r_big_sep_list R Phi xs`； +- $\mathop{\ast}_{x\in s}^{R}\Phi(x)$：`r_big_sep_set R Phi s`； +- $\mathop{\ast}_{k\mapsto v\in m}^{R}\Phi(k,v)$：`r_big_sep_map R Phi m`； +- $\mathop{\ast}_{(i,x)\in xs,o}^{R}\Phi(i,x)$： + `r_big_sep_listi_from R Phi o xs`，省略 `o` 时从 `0` 开始。 + +以下所有 `==` 仍是 assertion 的原始 HOL 等号。 + +### 7.1 定义与 literal assertion list + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `r_big_sep_listi_from_def` | `` `\|- r_big_sep_listi_from R Phi offset [] == r_emp R && r_big_sep_listi_from R Phi offset (x :: xs) == r_sep R (Phi offset x) (r_big_sep_listi_from R Phi (SUC offset) xs)` `` | offset-indexed fold 的 `[]`/`::` 方程 | +| `r_big_sep_listi_def` | `` `\|- r_big_sep_listi R Phi xs == r_big_sep_listi_from R Phi 0 xs` `` | indexed fold 从 0 开始 | +| `r_big_sep_def` | `` `\|- r_big_sep R [] == r_emp R && r_big_sep R (P :: Ps) == r_sep R P (r_big_sep R Ps)` `` | 断言列表的右结合 fold | +| `r_big_sep_list_def` | `` `\|- r_big_sep_list R Phi xs == r_big_sep R (MAP Phi xs)` `` | 数据列表先 `MAP Phi` 再 fold | +| `r_big_sep_set_def` | `` `\|- r_big_sep_set R Phi s == iterate (r_sep R) s Phi` `` | 用 commutative-monoid `iterate` 折叠集合 | +| `r_big_sep_map_value_def` | `` `\|- r_big_sep_map_value m key == (@value. finmap_lookup m key == SOME value)` `` | 在 domain 内用 Hilbert choice 取该 key 的值 | +| `r_big_sep_map_def` | `` `\|- r_big_sep_map R Phi m == r_big_sep_set R (\key. Phi key (r_big_sep_map_value m key)) (finmap_dom m)` `` | map fold 是 domain 上的 set fold | +| `R_BIG_SEP_NIL` | `` `\|- forall R. r_big_sep R [] == r_emp R` `` | $\mathop{\ast}_R[]=\mathsf{emp}$ | +| `R_BIG_SEP_CONS` | `` `\|- forall R P Ps. r_big_sep R (P :: Ps) == r_sep R P (r_big_sep R Ps)` `` | $\mathop{\ast}(P::Ps)=P*\mathop{\ast}Ps$ | +| `R_BIG_SEP_SINGLETON` | `` `\|- forall R P. r_big_sep R [P] == P` `` | singleton fold | +| `R_BIG_SEP_APPEND` | `` `\|- forall R left right. r_big_sep R (left ++ right) == r_sep R (r_big_sep R left) (r_big_sep R right)` `` | append 分解为两个 fold 的 `*` | +| `R_BIG_SEP_SNOC` | `` `\|- forall R Ps P. r_big_sep R (Ps ++ [P]) == r_sep R (r_big_sep R Ps) P` `` | snoc 方程 | +| `R_BIG_SEP_REVERSE` | `` `\|- forall R Ps. r_big_sep R (REVERSE Ps) == r_big_sep R Ps` `` | reverse 不变性 | +| `R_BIG_SEP_SWAP_HEAD` | `` `\|- forall R P Q Ps. r_big_sep R (P :: Q :: Ps) == r_big_sep R (Q :: P :: Ps)` `` | 相邻头元素可交换 | + +### 7.2 Unindexed list binder + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `R_BIG_SEP_LIST_NIL` | `` `\|- forall R Phi. r_big_sep_list R Phi [] == r_emp R` `` | 空列表 | +| `R_BIG_SEP_LIST_CONS` | `` `\|- forall R Phi x xs. r_big_sep_list R Phi (x :: xs) == r_sep R (Phi x) (r_big_sep_list R Phi xs)` `` | cons | +| `R_BIG_SEP_LIST_SINGLETON` | `` `\|- forall R Phi x. r_big_sep_list R Phi [x] == Phi x` `` | singleton | +| `R_BIG_SEP_LIST_APPEND` | `` `\|- forall R Phi left right. r_big_sep_list R Phi (left ++ right) == r_sep R (r_big_sep_list R Phi left) (r_big_sep_list R Phi right)` `` | append | +| `R_BIG_SEP_LIST_REVERSE` | `` `\|- forall R Phi xs. r_big_sep_list R Phi (REVERSE xs) == r_big_sep_list R Phi xs` `` | reverse 不变性 | +| `R_BIG_SEP_LIST_SWAP_HEAD` | `` `\|- forall R Phi x y xs. r_big_sep_list R Phi (x :: y :: xs) == r_big_sep_list R Phi (y :: x :: xs)` `` | 相邻头元素交换 | +| `R_BIG_SEP_LIST_MONO` | `` `\|- forall R Phi Psi xs. (forall x. r_entails R (Phi x) (Psi x)) ==> r_entails R (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs)` `` | 全局 pointwise entailment 提升到 fold | +| `R_BIG_SEP_LIST_MONO_ON` | `` `\|- forall R Phi Psi xs. (forall x. MEM x xs ==> r_entails R (Phi x) (Psi x)) ==> r_entails R (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs)` `` | 只需对 `MEM x xs` 的元素证明单调性 | +| `R_BIG_SEP_LIST_EQUIV` | `` `\|- forall R Phi Psi xs. (forall x. r_equiv R (Phi x) (Psi x)) ==> r_equiv R (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs)` `` | pointwise $\simeq_R$ 提升 | +| `R_BIG_SEP_LIST_EQUIV_ON` | `` `\|- forall R Phi Psi xs. (forall x. MEM x xs ==> r_equiv R (Phi x) (Psi x)) ==> r_equiv R (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs)` `` | member-restricted equivalence | +| `R_BIG_SEP_LIST_MAP` | `` `\|- forall R Phi f xs. r_big_sep_list R Phi (MAP f xs) == r_big_sep_list R (\x. Phi (f x)) xs` `` | 数据 `MAP` 等价于 predicate composition | +| `R_BIG_SEP_LIST_EMP` | `` `\|- forall R xs. r_big_sep_list R (\x. r_emp R) xs == r_emp R` `` | 全 `emp` fold 为 `emp` | +| `R_BIG_SEP_LIST_SEP` | `` `\|- forall R Phi Psi xs. r_big_sep_list R (\x. r_sep R (Phi x) (Psi x)) xs == r_sep R (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs)` `` | pointwise `*` 分配过 list fold | + +### 7.3 Finite-set binder + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `R_BIG_SEP_SET_EMPTY` | `` `\|- forall R Phi. r_big_sep_set R Phi {} == r_emp R` `` | 空集 fold | +| `R_BIG_SEP_SET_INSERT` | `` `\|- forall R Phi x s. FINITE s ==> ~(x IN s) ==> r_big_sep_set R Phi (x INSERT s) == r_sep R (Phi x) (r_big_sep_set R Phi s)` `` | finite fresh insertion | +| `R_BIG_SEP_SET_SINGLETON` | `` `\|- forall R Phi x. r_big_sep_set R Phi {x} == Phi x` `` | singleton | +| `R_BIG_SEP_SET_UNION` | `` `\|- forall R Phi left right. FINITE left && FINITE right && DISJOINT left right ==> r_big_sep_set R Phi (left UNION right) == r_sep R (r_big_sep_set R Phi left) (r_big_sep_set R Phi right)` `` | 有限不交并分解 | +| `R_BIG_SEP_SET_EQ` | `` `\|- forall R Phi Psi s. (forall x. x IN s ==> Phi x == Psi x) ==> r_big_sep_set R Phi s == r_big_sep_set R Psi s` `` | 集合成员上的 pointwise 原始等号 | +| `R_BIG_SEP_SET_MONO` | `` `\|- forall R Phi Psi s. FINITE s ==> (forall x. x IN s ==> r_entails R (Phi x) (Psi x)) ==> r_entails R (r_big_sep_set R Phi s) (r_big_sep_set R Psi s)` `` | finite-set entailment 单调性 | +| `R_BIG_SEP_SET_EQUIV` | `` `\|- forall R Phi Psi s. FINITE s ==> (forall x. x IN s ==> r_equiv R (Phi x) (Psi x)) ==> r_equiv R (r_big_sep_set R Phi s) (r_big_sep_set R Psi s)` `` | finite-set equivalence | +| `R_BIG_SEP_SET_EMP` | `` `\|- forall R s. r_big_sep_set R (\x. r_emp R) s == r_emp R` `` | 全 `emp`；包括无限集合（`iterate` 的退化语义） | +| `R_BIG_SEP_SET_SEP` | `` `\|- forall R Phi Psi s. FINITE s ==> r_big_sep_set R (\x. r_sep R (Phi x) (Psi x)) s == r_sep R (r_big_sep_set R Phi s) (r_big_sep_set R Psi s)` `` | finite set 上 pointwise `*` 分配 | + +### 7.4 Finite-map binder + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `R_BIG_SEP_MAP_VALUE` | `` `\|- forall m key value. finmap_lookup m key == SOME value ==> r_big_sep_map_value m key == value` `` | 成功 lookup 唯一确定 choice value | +| `R_BIG_SEP_MAP_VALUE_LOOKUP` | `` `\|- forall m key. key IN finmap_dom m ==> finmap_lookup m key == SOME (r_big_sep_map_value m key)` `` | domain 中 key 的 choice 可查回 | +| `R_BIG_SEP_MAP_EMPTY` | `` `\|- forall R Phi. r_big_sep_map R Phi finmap_empty == r_emp R` `` | 空 map | +| `R_BIG_SEP_MAP_INSERT` | `` `\|- forall R Phi key value m. finmap_lookup m key == NONE ==> r_big_sep_map R Phi (finmap_insert key value m) == r_sep R (Phi key value) (r_big_sep_map R Phi m)` `` | fresh insert | +| `R_BIG_SEP_MAP_SINGLETON` | `` `\|- forall R Phi key value. r_big_sep_map R Phi (finmap_singleton key value) == Phi key value` `` | singleton map | +| `R_BIG_SEP_MAP_DELETE` | `` `\|- forall R Phi m key value. finmap_lookup m key == SOME value ==> r_big_sep_map R Phi m == r_sep R (Phi key value) (r_big_sep_map R Phi (finmap_delete key m))` `` | 抽出存在的 binding | +| `R_BIG_SEP_MAP_EQ` | `` `\|- forall R Phi Psi m. (forall key value. finmap_lookup m key == SOME value ==> Phi key value == Psi key value) ==> r_big_sep_map R Phi m == r_big_sep_map R Psi m` `` | present bindings 上原始等号 | +| `R_BIG_SEP_MAP_MONO` | `` `\|- forall R Phi Psi m. (forall key value. finmap_lookup m key == SOME value ==> r_entails R (Phi key value) (Psi key value)) ==> r_entails R (r_big_sep_map R Phi m) (r_big_sep_map R Psi m)` `` | present bindings 上 entailment 单调性 | +| `R_BIG_SEP_MAP_EQUIV` | `` `\|- forall R Phi Psi m. (forall key value. finmap_lookup m key == SOME value ==> r_equiv R (Phi key value) (Psi key value)) ==> r_equiv R (r_big_sep_map R Phi m) (r_big_sep_map R Psi m)` `` | present bindings 上 equivalence | +| `R_BIG_SEP_MAP_EMP` | `` `\|- forall R m. r_big_sep_map R (\key value. r_emp R) m == r_emp R` `` | 全 `emp` map fold | +| `R_BIG_SEP_MAP_SEP` | `` `\|- forall R Phi Psi m. r_big_sep_map R (\key value. r_sep R (Phi key value) (Psi key value)) m == r_sep R (r_big_sep_map R Phi m) (r_big_sep_map R Psi m)` `` | pointwise `*` 分配过 map fold | + +### 7.5 Indexed list binder + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `R_BIG_SEP_LISTI_NIL` | `` `\|- forall R Phi. r_big_sep_listi R Phi [] == r_emp R` `` | 空 indexed list | +| `R_BIG_SEP_LISTI_CONS` | `` `\|- forall R Phi x xs. r_big_sep_listi R Phi (x :: xs) == r_sep R (Phi 0 x) (r_big_sep_listi_from R Phi 1 xs)` `` | 头索引 0，尾 offset 1 | +| `R_BIG_SEP_LISTI_FROM_APPEND` | `` `\|- forall R Phi left offset right. r_big_sep_listi_from R Phi offset (left ++ right) == r_sep R (r_big_sep_listi_from R Phi offset left) (r_big_sep_listi_from R Phi (offset + LENGTH left) right)` `` | offset-aware append | +| `R_BIG_SEP_LISTI_APPEND` | `` `\|- forall R Phi left right. r_big_sep_listi R Phi (left ++ right) == r_sep R (r_big_sep_listi R Phi left) (r_big_sep_listi_from R Phi (LENGTH left) right)` `` | zero-based append | +| `R_BIG_SEP_LISTI_SINGLETON` | `` `\|- forall R Phi x. r_big_sep_listi R Phi [x] == Phi 0 x` `` | singleton | +| `R_BIG_SEP_LISTI_FROM_SHIFT` | `` `\|- forall R Phi offset xs. r_big_sep_listi_from R Phi offset xs == r_big_sep_listi R (\index x. Phi (offset + index) x) xs` `` | offset 等价于 index predicate 平移 | +| `R_BIG_SEP_LISTI_CONS_SHIFT` | `` `\|- forall R Phi x xs. r_big_sep_listi R Phi (x :: xs) == r_sep R (Phi 0 x) (r_big_sep_listi R (\index y. Phi (SUC index) y) xs)` `` | 尾 predicate 平移 1 的 cons 方程 | +| `R_BIG_SEP_LISTI_APPEND_SHIFT` | `` `\|- forall R Phi left right. r_big_sep_listi R Phi (left ++ right) == r_sep R (r_big_sep_listi R Phi left) (r_big_sep_listi R (\index x. Phi (LENGTH left + index) x) right)` `` | 右段 predicate 平移 `LENGTH left` | +| `R_BIG_SEP_LISTI_FROM_MONO` | `` `\|- forall R Phi Psi xs offset. (forall index x. r_entails R (Phi index x) (Psi index x)) ==> r_entails R (r_big_sep_listi_from R Phi offset xs) (r_big_sep_listi_from R Psi offset xs)` `` | offset fold 的 pointwise entailment | +| `R_BIG_SEP_LISTI_MONO` | `` `\|- forall R Phi Psi xs. (forall index x. r_entails R (Phi index x) (Psi index x)) ==> r_entails R (r_big_sep_listi R Phi xs) (r_big_sep_listi R Psi xs)` `` | zero-based indexed monotonicity | +| `R_BIG_SEP_LISTI_FROM_EQUIV` | `` `\|- forall R Phi Psi xs offset. (forall index x. r_equiv R (Phi index x) (Psi index x)) ==> r_equiv R (r_big_sep_listi_from R Phi offset xs) (r_big_sep_listi_from R Psi offset xs)` `` | offset fold 的 equivalence | +| `R_BIG_SEP_LISTI_EQUIV` | `` `\|- forall R Phi Psi xs. (forall index x. r_equiv R (Phi index x) (Psi index x)) ==> r_equiv R (r_big_sep_listi R Phi xs) (r_big_sep_listi R Psi xs)` `` | zero-based indexed equivalence | +| `R_BIG_SEP_LISTI_FROM_SEP` | `` `\|- forall R Phi Psi xs offset. r_big_sep_listi_from R (\index x. r_sep R (Phi index x) (Psi index x)) offset xs == r_sep R (r_big_sep_listi_from R Phi offset xs) (r_big_sep_listi_from R Psi offset xs)` `` | offset-indexed pointwise `*` 分配 | +| `R_BIG_SEP_LISTI_SEP` | `` `\|- forall R Phi Psi xs. r_big_sep_listi R (\index x. r_sep R (Phi index x) (Psi index x)) xs == r_sep R (r_big_sep_listi R Phi xs) (r_big_sep_listi R Psi xs)` `` | zero-based indexed pointwise `*` 分配 | + +## 8. RA 构造子 + +本节的 product、option、exclusive、agreement、fractional、authoritative 与 +finite-map lift 都是**新 RA 实例**；ghost heap、memory RA 与 C resource RA 则是 +这些构造子的别名或闭合特化。ND lifting 中出现的 lambda 都是精确 image +predicate；这对反向 `IFF` 定理成立至关重要。 + +### 8.1 Unit RA + +源文件：[`unit_ra.h`](../theory/logic/unit_ra.h)、 +[`unit_ra.c`](../theory/logic/unit_ra.c)。carrier 是 HOL singleton type `1`。 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `UNIT_RA_UNIT` | `` `\|- ra_unit unit_ra == one` `` | $\varepsilon_{\mathbf1}=\star$ | +| `UNIT_RA_OP` | `` `\|- forall a b. ra_op unit_ra a b == one` `` | $a\cdot b=\star$ | +| `UNIT_RA_VALID` | `` `\|- forall a. ra_valid unit_ra a` `` | 所有元素有效 | +| `UNIT_RA_INCLUDED` | `` `\|- forall a b. ra_included unit_ra a b` `` | 唯一元素间 inclusion 总成立 | +| `UNIT_RA_EXCLUSIVE` | `` `\|- forall a. ra_exclusive unit_ra a` `` | 唯一相容 frame 就是 unit | +| `UNIT_RA_CANCELLATIVE` | `` `\|- ra_cancellative unit_ra` `` | cancellative | +| `UNIT_RA_UPDATE` | `` `\|- forall a b. ra_update unit_ra a b` `` | 任意确定更新成立 | +| `UNIT_RA_UPDATE_ND_IFF` | `` `\|- forall a P. ra_update_nd unit_ra a P <=> P one` `` | ND 更新当且仅当后置谓词包含 $\star$ | +| `UNIT_RA_LOCAL_UPDATE` | `` `\|- forall source target. ra_local_update unit_ra source target` `` | 任意 local update 成立 | + +### 8.2 Product RA + +源文件：[`prod_ra.h`](../theory/logic/prod_ra.h)、 +[`prod_ra.c`](../theory/logic/prod_ra.c)。记 $R=R_1\times R_2$。 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `PROD_RA_UNIT` | `` `\|- forall R1 R2. ra_unit (prod_ra R1 R2) == ra_unit R1,ra_unit R2` `` | $\varepsilon_R=(\varepsilon_1,\varepsilon_2)$ | +| `PROD_RA_OP` | `` `\|- forall R1 R2 x y. ra_op (prod_ra R1 R2) x y == ra_op R1 (FST x) (FST y),ra_op R2 (SND x) (SND y)` `` | product operation 逐坐标计算 | +| `PROD_RA_VALID` | `` `\|- forall R1 R2 x. ra_valid (prod_ra R1 R2) x <=> ra_valid R1 (FST x) && ra_valid R2 (SND x)` `` | $\checkmark_R(x_1,x_2)\Leftrightarrow\checkmark_1(x_1)\land\checkmark_2(x_2)$ | +| `PROD_RA_INCLUDED` | `` `\|- forall R1 R2 x y. ra_included (prod_ra R1 R2) x y <=> ra_included R1 (FST x) (FST y) && ra_included R2 (SND x) (SND y)` `` | inclusion 逐坐标 | +| `PROD_RA_EXCLUSIVE` | `` `\|- forall R1 R2 x. ra_exclusive R1 (FST x) ==> ra_exclusive R2 (SND x) ==> ra_exclusive (prod_ra R1 R2) x` `` | 两坐标 exclusive 推出 product exclusive | +| `PROD_RA_EXCLUSIVE_ELIM_LEFT` | `` `\|- forall R1 R2 x. ra_valid (prod_ra R1 R2) x ==> ra_exclusive (prod_ra R1 R2) x ==> ra_exclusive R1 (FST x)` `` | 有效 product exclusive 投影到左坐标 | +| `PROD_RA_EXCLUSIVE_ELIM_RIGHT` | `` `\|- forall R1 R2 x. ra_valid (prod_ra R1 R2) x ==> ra_exclusive (prod_ra R1 R2) x ==> ra_exclusive R2 (SND x)` `` | 同上，右坐标 | +| `PROD_RA_EXCLUSIVE_IFF` | `` `\|- forall R1 R2 x. ra_valid (prod_ra R1 R2) x ==> (ra_exclusive (prod_ra R1 R2) x <=> ra_exclusive R1 (FST x) && ra_exclusive R2 (SND x))` `` | 有效源下 product exclusive 的精确刻画 | +| `PROD_RA_CANCELLATIVE` | `` `\|- forall R1 R2. ra_cancellative R1 ==> ra_cancellative R2 ==> ra_cancellative (prod_ra R1 R2)` `` | cancellation 逐坐标提升 | +| `PROD_RA_CANCELLATIVE_IFF` | `` `\|- forall R1 R2. ra_cancellative (prod_ra R1 R2) <=> ra_cancellative R1 && ra_cancellative R2` `` | product cancellative 当且仅当两分量均 cancellative | +| `PROD_RA_UPDATE_ND` | `` `\|- forall R1 R2 a1 a2 P1 P2. ra_update_nd R1 a1 P1 ==> ra_update_nd R2 a2 P2 ==> ra_update_nd (prod_ra R1 R2) (a1,a2) (\x. exists b1 b2. P1 b1 && P2 b2 && x == b1,b2)` `` | 两个 ND 更新逐坐标合成 | +| `PROD_RA_UPDATE` | `` `\|- forall R1 R2 a1 a2 b1 b2. ra_update R1 a1 b1 ==> ra_update R2 a2 b2 ==> ra_update (prod_ra R1 R2) (a1,a2) (b1,b2)` `` | 两个确定更新逐坐标合成 | +| `PROD_RA_UPDATE_ELIM_LEFT` | `` `\|- forall R1 R2 a1 a2 b1 b2. ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) ==> ra_valid R2 a2 ==> ra_update R1 a1 b1` `` | 另一源分量有效时反投影左更新 | +| `PROD_RA_UPDATE_ELIM_RIGHT` | `` `\|- forall R1 R2 a1 a2 b1 b2. ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) ==> ra_valid R1 a1 ==> ra_update R2 a2 b2` `` | 对称的右投影 | +| `PROD_RA_UPDATE_IFF` | `` `\|- forall R1 R2 a1 a2 b1 b2. ra_valid R1 a1 ==> ra_valid R2 a2 ==> (ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) <=> ra_update R1 a1 b1 && ra_update R2 a2 b2)` `` | 两源分量有效时 product update 的精确刻画 | +| `PROD_RA_UPDATE_LEFT_ND` | `` `\|- forall R1 R2 a1 a2 P. ra_update_nd R1 a1 P ==> ra_update_nd (prod_ra R1 R2) (a1,a2) (\x. exists b1. P b1 && x == b1,a2)` `` | 只更新左坐标的 ND lifting | +| `PROD_RA_UPDATE_LEFT` | `` `\|- forall R1 R2 a1 a2 b1. ra_update R1 a1 b1 ==> ra_update (prod_ra R1 R2) (a1,a2) (b1,a2)` `` | 只确定更新左坐标 | +| `PROD_RA_UPDATE_RIGHT_ND` | `` `\|- forall R1 R2 a1 a2 P. ra_update_nd R2 a2 P ==> ra_update_nd (prod_ra R1 R2) (a1,a2) (\x. exists b2. P b2 && x == a1,b2)` `` | 只更新右坐标的 ND lifting | +| `PROD_RA_UPDATE_RIGHT` | `` `\|- forall R1 R2 a1 a2 b2. ra_update R2 a2 b2 ==> ra_update (prod_ra R1 R2) (a1,a2) (a1,b2)` `` | 只确定更新右坐标 | +| `PROD_RA_LOCAL_UPDATE` | `` `\|- forall R1 R2 a1 f1 b1 g1 a2 f2 b2 g2. ra_local_update R1 (a1,f1) (b1,g1) ==> ra_local_update R2 (a2,f2) (b2,g2) ==> ra_local_update (prod_ra R1 R2) ((a1,a2),f1,f2) ((b1,b2),g1,g2)` `` | local update 逐坐标合成 | +| `PROD_RA_LOCAL_UPDATE_LEFT` | `` `\|- forall R1 R2 a1 f1 b1 g1 a2 f2. ra_local_update R1 (a1,f1) (b1,g1) ==> ra_local_update (prod_ra R1 R2) ((a1,a2),f1,f2) ((b1,a2),g1,f2)` `` | 只提升左 local update | +| `PROD_RA_LOCAL_UPDATE_RIGHT` | `` `\|- forall R1 R2 a1 f1 a2 f2 b2 g2. ra_local_update R2 (a2,f2) (b2,g2) ==> ra_local_update (prod_ra R1 R2) ((a1,a2),f1,f2) ((a1,b2),f1,g2)` `` | 只提升右 local update | + +### 8.3 Option RA + +源文件：[`option_ra.h`](../theory/logic/option_ra.h)、 +[`option_ra.c`](../theory/logic/option_ra.c)。`NONE` 是新单位元； +`SOME (ra_unit R)` 仍表示一个在场 binding，二者不相等。 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `OPTION_RA_UNIT` | `` `\|- forall R. ra_unit (option_ra R) == NONE` `` | $\varepsilon_{R_\bot}=\mathrm{None}$ | +| `OPTION_RA_OP_NONE_L` | `` `\|- forall R x. ra_op (option_ra R) NONE x == x` `` | `NONE` 左单位律 | +| `OPTION_RA_OP_NONE_R` | `` `\|- forall R x. ra_op (option_ra R) x NONE == x` `` | `NONE` 右单位律 | +| `OPTION_RA_OP_SOME_SOME` | `` `\|- forall R a b. ra_op (option_ra R) (SOME a) (SOME b) == SOME (ra_op R a b)` `` | 两个在场值按 base RA 合成 | +| `OPTION_RA_SOME_INJ` | `` `\|- forall a b. SOME a == SOME b <=> a == b` `` | `SOME` 单射 | +| `OPTION_RA_SOME_NE_NONE` | `` `\|- forall a. ~(SOME a == NONE)` `` | 在场与缺席不同 | +| `OPTION_RA_VALID_NONE` | `` `\|- forall R. ra_valid (option_ra R) NONE` `` | 新单位有效 | +| `OPTION_RA_VALID_SOME` | `` `\|- forall R a. ra_valid (option_ra R) (SOME a) <=> ra_valid R a` `` | 在场值有效性继承 base | +| `OPTION_RA_INCLUDED_NONE` | `` `\|- forall R x. ra_included (option_ra R) NONE x` `` | `NONE` 是 extension preorder 的底 | +| `OPTION_RA_INCLUDED_SOME_SOME` | `` `\|- forall R a b. ra_included (option_ra R) (SOME a) (SOME b) <=> ra_included R a b` `` | 在场值 inclusion 反映 base inclusion | +| `OPTION_RA_NOT_INCLUDED_SOME_NONE` | `` `\|- forall R a. ~ra_included (option_ra R) (SOME a) NONE` `` | 在场值不能扩张成新单位 | +| `OPTION_RA_EXCLUSIVE_SOME_IFF` | `` `\|- forall R a. ra_exclusive (option_ra R) (SOME a) <=> ~ra_valid R a` `` | `SOME a` 仅在 base `a` 无效时 vacuously exclusive | +| `OPTION_RA_NOT_EXCLUSIVE_NONE` | `` `\|- forall R. ~ra_exclusive (option_ra R) NONE` `` | 新单位总有非单位相容 frame | +| `OPTION_RA_NOT_CANCELLATIVE` | `` `\|- forall R. ~ra_cancellative (option_ra R)` `` | `NONE` 与 `SOME ε` 区分使 cancellation 失败 | +| `OPTION_RA_LOCAL_UPDATE_SOME` | `` `\|- forall R a f b g. ra_local_update R (a,f) (b,g) ==> ra_local_update (option_ra R) (SOME a,SOME f) (SOME b,SOME g)` `` | base local update 的 `SOME` lifting | +| `OPTION_RA_LOCAL_UPDATE_SOME_IFF` | `` `\|- forall R a f b g. ra_local_update (option_ra R) (SOME a,SOME f) (SOME b,SOME g) <=> ra_local_update R (a,f) (b,g)` `` | 上述 lifting 的精确 iff | +| `OPTION_RA_UPDATE` | `` `\|- forall R a b. ra_update R a b ==> ra_update (option_ra R) (SOME a) (SOME b)` `` | base update lifting | +| `OPTION_RA_UPDATE_IFF` | `` `\|- forall R a b. ra_update (option_ra R) (SOME a) (SOME b) <=> ra_update R a b` `` | 在场确定更新精确反映 base | +| `OPTION_RA_UPDATE_ND` | `` `\|- forall R a P. ra_update_nd R a P ==> ra_update_nd (option_ra R) (SOME a) (\x. exists b. P b && x == SOME b)` `` | base ND update 的精确 `SOME` image | +| `OPTION_RA_UPDATE_ND_IFF` | `` `\|- forall R a P. ra_update_nd (option_ra R) (SOME a) (\x. exists b. P b && x == SOME b) <=> ra_update_nd R a P` `` | 精确 `SOME` image 上的 iff | + +### 8.4 Exclusive RA + +源文件：[`excl_ra.h`](../theory/logic/excl_ra.h)、 +[`excl_ra.c`](../theory/logic/excl_ra.c)。carrier 为 +`ExclUnit | Excl a | ExclInvalid`。 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `EXCL_RA_UNIT` | `` `\|- ra_unit excl_ra == ExclUnit` `` | unit 是 `ExclUnit` | +| `EXCL_RA_OWNED_INJ` | `` `\|- forall a b. Excl a == Excl b <=> a == b` `` | owned constructor 单射 | +| `EXCL_RA_OWNED_NE_UNIT` | `` `\|- forall a. ~(Excl a == ExclUnit)` `` | owned 不等于 unit | +| `EXCL_RA_INVALID_NE_UNIT` | `` `\|- ~(ExclInvalid == ExclUnit)` `` | invalid 不等于 unit | +| `EXCL_RA_INVALID_NE_OWNED` | `` `\|- forall a. ~(ExclInvalid == Excl a)` `` | invalid 不等于 owned | +| `EXCL_RA_OWNED_CONFLICT` | `` `\|- forall a b. ra_op excl_ra (Excl a) (Excl b) == ExclInvalid` `` | 任意两个 owned token 冲突 | +| `EXCL_RA_VALID_UNIT` | `` `\|- ra_valid excl_ra ExclUnit` `` | unit 有效 | +| `EXCL_RA_VALID_OWNED` | `` `\|- forall a. ra_valid excl_ra (Excl a)` `` | 每个单独 owned token 有效 | +| `EXCL_RA_INVALID` | `` `\|- ~ra_valid excl_ra ExclInvalid` `` | invalid 无效 | +| `EXCL_RA_VALID_IFF` | `` `\|- forall x. ra_valid excl_ra x <=> ~(x == ExclInvalid)` `` | 有效当且仅当不是 invalid | +| `EXCL_RA_INCLUDED_OWNED` | `` `\|- forall a b. ra_included excl_ra (Excl a) (Excl b) <=> a == b` `` | owned-to-owned inclusion 恰为 payload 等号 | +| `EXCL_RA_INCLUDED_OWNED_IFF` | `` `\|- forall a x. ra_included excl_ra (Excl a) x <=> x == Excl a \|\| x == ExclInvalid` `` | owned 的全部 extension：自身或 invalid | +| `EXCL_RA_INCLUDED_INVALID_IFF` | `` `\|- forall x. ra_included excl_ra ExclInvalid x <=> x == ExclInvalid` `` | invalid 仅 included 于自身 | +| `EXCL_RA_EXCLUSIVE` | `` `\|- forall a. ra_exclusive excl_ra (Excl a)` `` | owned token exclusive | +| `EXCL_RA_EXCLUSIVE_INVALID` | `` `\|- ra_exclusive excl_ra ExclInvalid` `` | invalid vacuously exclusive | +| `EXCL_RA_CANCELLATIVE` | `` `\|- ra_cancellative excl_ra` `` | exclusive RA cancellative | +| `EXCL_RA_UPDATE` | `` `\|- forall a b. ra_update excl_ra (Excl a) (Excl b)` `` | 任意有效 owned token 可互换 | +| `EXCL_RA_UPDATE_VALID` | `` `\|- forall a x. ra_valid excl_ra x ==> ra_update excl_ra (Excl a) x` `` | owned 源可更新到任意有效目标 | +| `EXCL_RA_UPDATE_OWNED_IFF` | `` `\|- forall a x. ra_update excl_ra (Excl a) x <=> ra_valid excl_ra x` `` | 上条是必要充分条件 | +| `EXCL_RA_UPDATE_INVALID` | `` `\|- forall x. ra_update excl_ra ExclInvalid x` `` | invalid 源任意更新 | +| `EXCL_RA_LOCAL_UPDATE_VALID` | `` `\|- forall a x. ra_valid excl_ra x ==> ra_local_update excl_ra (Excl a,Excl a) (x,x)` `` | 完整 owned pair 可替换为有效完整目标 | +| `EXCL_RA_LOCAL_UPDATE_IFF` | `` `\|- forall a x. ra_local_update excl_ra (Excl a,Excl a) (x,x) <=> ra_valid excl_ra x` `` | 上述 local update 的 iff | + +内部构造接口 [`excl_ra_internal.h`](../theory/logic/excl_ra_internal.h) 另外导出 +`excl_owned_op_def`、`excl_op_def`、两个 datatype distinction theorem 与 +`EXCL_RA_OP_FN`；普通客户端不应依赖它们。 + +### 8.5 Agreement RA + +源文件：[`agree_ra.h`](../theory/logic/agree_ra.h)、 +[`agree_ra.c`](../theory/logic/agree_ra.c)。carrier 为 +`AgreeUnit | Agree a | AgreeInvalid`；同 payload token 可复制，异 payload 合成无效。 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `AGREE_RA_UNIT` | `` `\|- ra_unit agree_ra == AgreeUnit` `` | unit | +| `AGREE_RA_OWNED_OP` | `` `\|- forall a b. ra_op agree_ra (Agree a) (Agree b) == (if a == b then Agree a else AgreeInvalid)` `` | 同值幂等，异值冲突 | +| `AGREE_RA_IDEMPOTENT` | `` `\|- forall a. ra_op agree_ra (Agree a) (Agree a) == Agree a` `` | `Agree a` 可复制/合并 | +| `AGREE_RA_OWNED_INJ` | `` `\|- forall a b. Agree a == Agree b <=> a == b` `` | constructor 单射 | +| `AGREE_RA_OWNED_NE_UNIT` | `` `\|- forall a. ~(Agree a == AgreeUnit)` `` | owned 与 unit 区分 | +| `AGREE_RA_INVALID_NE_UNIT` | `` `\|- ~(AgreeInvalid == AgreeUnit)` `` | invalid 与 unit 区分 | +| `AGREE_RA_INVALID_NE_OWNED` | `` `\|- forall a. ~(AgreeInvalid == Agree a)` `` | invalid 与 owned 区分 | +| `AGREE_RA_VALID_UNIT` | `` `\|- ra_valid agree_ra AgreeUnit` `` | unit 有效 | +| `AGREE_RA_VALID_OWNED` | `` `\|- forall a. ra_valid agree_ra (Agree a)` `` | 单个 owned token 有效 | +| `AGREE_RA_INVALID` | `` `\|- ~ra_valid agree_ra AgreeInvalid` `` | invalid 无效 | +| `AGREE_RA_VALID_COMBINE_IFF` | `` `\|- forall a b. ra_valid agree_ra (ra_op agree_ra (Agree a) (Agree b)) <=> a == b` `` | 两 token 可相容当且仅当 payload 相等 | +| `AGREE_RA_INCLUDED_OWNED` | `` `\|- forall a b. ra_included agree_ra (Agree a) (Agree b) <=> a == b` `` | owned-to-owned inclusion | +| `AGREE_RA_INCLUDED_UNIT` | `` `\|- forall x. ra_included agree_ra AgreeUnit x` `` | unit included 于所有元素 | +| `AGREE_RA_NOT_INCLUDED_OWNED_UNIT` | `` `\|- forall a. ~ra_included agree_ra (Agree a) AgreeUnit` `` | owned 不能扩张成 unit | +| `AGREE_RA_INCLUDED_OWNED_INVALID` | `` `\|- forall a. ra_included agree_ra (Agree a) AgreeInvalid` `` | raw inclusion 允许 invalid extension | +| `AGREE_RA_NOT_INCLUDED_INVALID_UNIT` | `` `\|- ~ra_included agree_ra AgreeInvalid AgreeUnit` `` | invalid 不 included 于 unit | +| `AGREE_RA_NOT_INCLUDED_INVALID_OWNED` | `` `\|- forall a. ~ra_included agree_ra AgreeInvalid (Agree a)` `` | invalid 不 included 于 owned | +| `AGREE_RA_NOT_EXCLUSIVE_OWNED` | `` `\|- forall a. ~ra_exclusive agree_ra (Agree a)` `` | 幂等 token 非 exclusive | +| `AGREE_RA_EXCLUSIVE_INVALID` | `` `\|- ra_exclusive agree_ra AgreeInvalid` `` | invalid vacuously exclusive | +| `AGREE_RA_NOT_CANCELLATIVE` | `` `\|- ~ra_cancellative agree_ra` `` | 幂等性破坏 cancellation | +| `AGREE_RA_AGREEMENT` | `` `\|- forall a b. ra_valid agree_ra (ra_op agree_ra (Agree a) (Agree b)) ==> a == b` `` | 有效合成蕴含 agreement | +| `AGREE_RA_UPDATE_IFF` | `` `\|- forall a b. ra_update agree_ra (Agree a) (Agree b) <=> a == b` `` | owned token 只能更新为相同 payload | +| `AGREE_RA_LOCAL_UPDATE_OWNED_IFF` | `` `\|- forall a b. ra_local_update agree_ra (Agree a,Agree a) (Agree b,Agree b) <=> a == b` `` | 完整 local update 同样保持 payload | + +### 8.6 Max-natural RA + +源文件：[`max_nat_ra.h`](../theory/logic/max_nat_ra.h)、 +[`max_nat_ra.c`](../theory/logic/max_nat_ra.c)。这是 +$(\mathbb N,0,\max,\top)$。 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `MAX_NAT_RA_UNIT` | `` `\|- ra_unit max_nat_ra == 0` `` | unit 为 0 | +| `MAX_NAT_RA_OP` | `` `\|- forall a b. ra_op max_nat_ra a b == MAX a b` `` | operation 为 `max` | +| `MAX_NAT_RA_VALID` | `` `\|- forall n. ra_valid max_nat_ra n` `` | 全部自然数有效 | +| `MAX_NAT_RA_INCLUDED` | `` `\|- forall a b. ra_included max_nat_ra a b <=> a <= b` `` | RA inclusion 恰为数值 $\le$ | +| `MAX_NAT_RA_INCLUDED_ZERO` | `` `\|- forall n. ra_included max_nat_ra 0 n` `` | 0 是底 | +| `MAX_NAT_RA_INCLUDED_OP` | `` `\|- forall a b bound. ra_included max_nat_ra (ra_op max_nat_ra a b) bound <=> a <= bound && b <= bound` `` | $\max(a,b)\le n\Leftrightarrow a\le n\land b\le n$ | +| `MAX_NAT_RA_IDEMPOTENT` | `` `\|- forall n. ra_op max_nat_ra n n == n` `` | max 幂等 | +| `MAX_NAT_RA_OP_EQ_RIGHT` | `` `\|- forall a b. a <= b ==> ra_op max_nat_ra a b == b` `` | 右侧较大时 max 为右侧 | +| `MAX_NAT_RA_OP_EQ_LEFT` | `` `\|- forall a b. b <= a ==> ra_op max_nat_ra a b == a` `` | 对称形式 | +| `MAX_NAT_RA_NOT_EXCLUSIVE` | `` `\|- forall n. ~ra_exclusive max_nat_ra n` `` | 没有 exclusive 元素 | +| `MAX_NAT_RA_NOT_CANCELLATIVE` | `` `\|- ~ra_cancellative max_nat_ra` `` | max 非 cancellative | +| `MAX_NAT_RA_INCLUDED_MONO_RIGHT` | `` `\|- forall old new fragment. old <= new ==> ra_included max_nat_ra fragment old ==> ra_included max_nat_ra fragment new` `` | 提高上界保持 fragment inclusion | +| `MAX_NAT_RA_LOCAL_UPDATE_UNIT_IFF` | `` `\|- forall old new. ra_local_update max_nat_ra (old,0) (new,0) <=> old == new` `` | 没有 owned fragment 时 local update 不能改变 whole | +| `MAX_NAT_RA_UPDATE` | `` `\|- forall old new. ra_update max_nat_ra old new` `` | base 确定更新全成立（不能表达单调协议） | +| `MAX_NAT_RA_UPDATE_ND` | `` `\|- forall old P. (exists new. P new) ==> ra_update_nd max_nat_ra old P` `` | 非空后置谓词足够 | +| `MAX_NAT_RA_UPDATE_ND_IFF` | `` `\|- forall old P. ra_update_nd max_nat_ra old P <=> (exists new. P new)` `` | ND 更新恰为后置谓词非空 | + +### 8.7 Fractional RA + +源文件：[`frac_ra.h`](../theory/logic/frac_ra.h)、 +[`frac_ra.c`](../theory/logic/frac_ra.c)。`frac_own p a` 是 total HOL +function，但计算、单射和有效性定理通常带 `&0 < p` 前提；数学上只把正权重 +当作规范 fractional ownership。 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `FRAC_RA_UNIT` | `` `\|- forall R. ra_unit (frac_ra R) == frac_empty` `` | fractional unit 是 empty | +| `FRAC_RA_FULL` | `` `\|- forall a. frac_full a == frac_own (&1) a` `` | full share 是权重 1 | +| `FRAC_RA_OWN_OP` | `` `\|- forall R p q a b. &0 < p ==> &0 < q ==> ra_op (frac_ra R) (frac_own p a) (frac_own q b) == frac_own (p + q) (ra_op R a b)` `` | 权重相加、payload 按 base 合成 | +| `FRAC_RA_OWN_INJ` | `` `\|- forall p q a b. &0 < p ==> &0 < q ==> (frac_own p a == frac_own q b <=> p == q && a == b)` `` | 正权重 constructor 单射 | +| `FRAC_RA_OWN_NE_EMPTY` | `` `\|- forall p a. ~(frac_own p a == frac_empty)` `` | owned 与 empty 不同 | +| `FRAC_RA_FULL_INJ` | `` `\|- forall a b. frac_full a == frac_full b <=> a == b` `` | full 单射 | +| `FRAC_RA_FULL_NE_EMPTY` | `` `\|- forall a. ~(frac_full a == frac_empty)` `` | full 非 empty | +| `FRAC_RA_VALID_EMPTY` | `` `\|- forall R. ra_valid (frac_ra R) frac_empty` `` | empty 有效 | +| `FRAC_RA_VALID_OWN` | `` `\|- forall R p a. &0 < p ==> (ra_valid (frac_ra R) (frac_own p a) <=> p <= &1 && ra_valid R a)` `` | 正 share 有效 iff $p\le1$ 且 payload 有效 | +| `FRAC_RA_VALID_FULL` | `` `\|- forall R a. ra_valid (frac_ra R) (frac_full a) <=> ra_valid R a` `` | full 有效性等于 payload 有效性 | +| `FRAC_RA_INCLUDED_EMPTY` | `` `\|- forall R x. ra_included (frac_ra R) frac_empty x` `` | empty 是底 | +| `FRAC_RA_INCLUDED_OWN` | `` `\|- forall R p q a b. &0 < p ==> &0 < q ==> (ra_included (frac_ra R) (frac_own p a) (frac_own q b) <=> p == q && a == b \|\| p < q && ra_included R a b)` `` | 相等 share 需相同 payload；严格增 share 需 base inclusion | +| `FRAC_RA_NOT_INCLUDED_OWN_EMPTY` | `` `\|- forall R p a. &0 < p ==> ~ra_included (frac_ra R) (frac_own p a) frac_empty` `` | 正 share 不 included 于 empty | +| `FRAC_RA_INCLUDED_FULL` | `` `\|- forall R a b. ra_included (frac_ra R) (frac_full a) (frac_full b) <=> a == b` `` | full-to-full inclusion 恰为 payload 等号 | +| `FRAC_RA_EXCLUSIVE_FULL` | `` `\|- forall R a. ra_exclusive (frac_ra R) (frac_full a)` `` | full share exclusive（无效 payload 时可 vacuous） | +| `FRAC_RA_CANCELLATIVE` | `` `\|- forall R. ra_cancellative R ==> ra_cancellative (frac_ra R)` `` | base cancellation 提升 | +| `FRAC_RA_UPDATE_WEAKEN` | `` `\|- forall R p q a b. &0 < q ==> q <= p ==> ra_update R a b ==> ra_update (frac_ra R) (frac_own p a) (frac_own q b)` `` | 可降低 share 并执行 base update | +| `FRAC_RA_UPDATE_WEAKEN_ND` | `` `\|- forall R p q a P. &0 < q ==> q <= p ==> ra_update_nd R a P ==> ra_update_nd (frac_ra R) (frac_own p a) (\x. exists b. P b && x == frac_own q b)` `` | ND 版 share weakening | +| `FRAC_RA_UPDATE_FULL` | `` `\|- forall R a b. ra_valid R b ==> ra_update (frac_ra R) (frac_full a) (frac_full b)` `` | full share 可换成任意有效 payload | +| `FRAC_RA_UPDATE_FULL_IFF` | `` `\|- forall R a b. ra_update (frac_ra R) (frac_full a) (frac_full b) <=> ra_valid R a ==> ra_valid R b` `` | full deterministic update 的精确刻画 | +| `FRAC_RA_UPDATE_FULL_ND` | `` `\|- forall R a P. (exists b. P b && ra_valid R b) ==> ra_update_nd (frac_ra R) (frac_full a) (\x. exists b. P b && x == frac_full b)` `` | 存在有效 payload 即可进行 full ND update | +| `FRAC_RA_UPDATE_FULL_ND_IFF` | `` `\|- forall R a P. ra_update_nd (frac_ra R) (frac_full a) (\x. exists b. P b && x == frac_full b) <=> ra_valid R a ==> (exists b. P b && ra_valid R b)` `` | 考虑无效源 vacuity 的精确 iff | + +### 8.8 Finite-map carrier support + +$\texttt{(K,V)finmap}$ 是“有限 support 的总函数 +$K\to\mathrm{option}\ V$”的保守 HOL subtype；它是 gmap_ra 的 +carrier 支撑，不是 RA 或 BI connective。以下列出最常用于理解 RA 证明的边界定理。 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| finmap_finite_def | |- forall f. finmap_finite f <=> FINITE {k | ~(f k == NONE)} | representation 的非空 support 有限 | +| FINMAP_TYPE_BIJECTION | |- (forall m. finmap_abs (finmap_rep m) == m) && (forall f. finmap_finite f <=> finmap_rep (finmap_abs f) == f) | subtype abstraction/representation 双射 | +| FINMAP_EQ | |- forall m n. m == n <=> finmap_rep m == finmap_rep n | map equality 可降到 representation | +| finmap_empty_def | |- finmap_empty == finmap_abs (\k. NONE) | 空 map 处处 absent | +| finmap_lookup_def | |- forall m k. finmap_lookup m k == finmap_rep m k | lookup 是 representation observation | +| finmap_singleton_def | |- forall key v. finmap_singleton key v == finmap_abs (\k. if k == key then SOME v else NONE) | singleton 只在 key 处 present | +| finmap_insert_def | |- forall key v m. finmap_insert key v m == finmap_abs (\k. if k == key then SOME v else finmap_rep m k) | insert 覆盖 key | +| finmap_delete_def | |- forall key m. finmap_delete key m == finmap_abs (\k. if k == key then NONE else finmap_rep m k) | delete 令 key absent | +| finmap_dom_def | |- forall m. finmap_dom m == {k | ~(finmap_lookup m k == NONE)} | domain 是 present keys | +| FINMAP_SINGLETON_LOOKUP | |- forall key v k. finmap_lookup (finmap_singleton key v) k == if k == key then SOME v else NONE | singleton lookup equation | +| FINMAP_INSERT_LOOKUP | |- forall key v m k. finmap_lookup (finmap_insert key v m) k == if k == key then SOME v else finmap_lookup m k | insert lookup equation | +| FINMAP_DELETE_LOOKUP | |- forall key m k. finmap_lookup (finmap_delete key m) k == if k == key then NONE else finmap_lookup m k | delete lookup equation | +| FINMAP_EQ_LOOKUP | |- forall m n. m == n <=> (forall k. finmap_lookup m k == finmap_lookup n k) | lookup extensionality | +| FINMAP_DECOMPOSE | |- forall key v m. finmap_lookup m key == SOME v ==> finmap_insert key v (finmap_delete key m) == m | present entry 可删后重建 | +| FINMAP_DOM_FINITE | |- forall m. FINITE (finmap_dom m) | 每个 map 的 domain 有限 | +| FINMAP_FRESH_IN_PAIR | |- forall candidates m n. INFINITE candidates ==> (exists key. key IN candidates && finmap_lookup m key == NONE && finmap_lookup n key == NONE) | 任意两个有限 map 在无限候选集中有共同 fresh key | +| FINMAP_FRESH | |- forall m. INFINITE (UNIV:K->bool) ==> (exists key. finmap_lookup m key == NONE) | 无限 key type 上每个有限 map 有 fresh key | +| FINMAP_INDUCT | |- forall P. P finmap_empty ==> (forall key v m. finmap_lookup m key == NONE ==> P m ==> P (finmap_insert key v m)) ==> (forall m. P m) | 以 fresh insert 为步的有限 map 归纳 | + +其余公开定理不是隐藏公理，而是上述 representation 的派生计算律： + +- representation/lookup： + FINMAP_REP_FINITE、FINMAP_EMPTY_REP、 + FINMAP_EMPTY_LOOKUP、FINMAP_SINGLETON_SUPPORT、 + FINMAP_SINGLETON_REP、FINMAP_INSERT_SUPPORT、 + FINMAP_INSERT_REP、FINMAP_INSERT_LOOKUP_EQ、 + FINMAP_INSERT_LOOKUP_NE、FINMAP_DELETE_SUPPORT、 + FINMAP_DELETE_REP、FINMAP_DELETE_LOOKUP_EQ、 + FINMAP_DELETE_LOOKUP_NE； +- insert/delete algebra： + FINMAP_INSERT_EMPTY、FINMAP_DELETE_EMPTY、 + FINMAP_INSERT_OVERWRITE、FINMAP_INSERT_COMM、 + FINMAP_DELETE_IDEMPOTENT、FINMAP_DELETE_COMM、 + FINMAP_DELETE_INSERT、FINMAP_DELETE_INSERT_NE、 + FINMAP_INSERT_DELETE、FINMAP_INSERT_ID、 + FINMAP_DELETE_ID； +- domain/freshness： + FINMAP_DOM_EMPTY、FINMAP_DOM_SINGLETON、 + FINMAP_IN_DOM、FINMAP_IN_DOM_SOME、 + FINMAP_NOT_IN_DOM、FINMAP_FRESH_IN、 + FINMAP_FRESH_PAIR、FINMAP_DOM_EQ_EMPTY、 + FINMAP_DOM_INSERT、FINMAP_DOM_DELETE。 + +### 8.9 Finite-map RA + +$\mathrm{GMap}_K(R)=\texttt{gmap_ra R}$ 的 carrier 是有限映射 +$K\rightharpoonup A$。每个 key 在代数上按 +$\mathrm{Option}(R)$ 组合；因此 absent 是 $\texttt{NONE}$，而 +$\texttt{SOME }\varepsilon_R$ 仍然是 present。 + +#### Operation、validity 与 inclusion + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| GMAP_RA_UNIT | |- forall R. ra_unit (gmap_ra R) == finmap_empty | $\varepsilon_{\mathrm{GMap}(R)}=\varnothing$ | +| GMAP_RA_OP_LOOKUP | |- forall R m n k. finmap_lookup (ra_op (gmap_ra R) m n) k == ra_op (option_ra R) (finmap_lookup m k) (finmap_lookup n k) | $(m\cdot n)(k)=m(k)\cdot_{\mathrm{Option}(R)}n(k)$ | +| GMAP_RA_SINGLETON_OP | |- forall R key a b. ra_op (gmap_ra R) (finmap_singleton key a) (finmap_singleton key b) == finmap_singleton key (ra_op R a b) | 同 key 的 singleton 逐点组合 | +| GMAP_RA_OP_SINGLETON_AT | |- forall R key a frame m. finmap_lookup m key == SOME a ==> ra_op (gmap_ra R) m (finmap_singleton key frame) == finmap_insert key (ra_op R a frame) m | 已存在 key 与 singleton frame 的组合等价于更新该 key | +| GMAP_RA_OP_INSERT_INSERT | |- forall R key a b m n. ra_op (gmap_ra R) (finmap_insert key a m) (finmap_insert key b n) == finmap_insert key (ra_op R a b) (ra_op (gmap_ra R) m n) | 两侧同 key insert 后再组合 | +| GMAP_RA_OP_DELETE | |- forall R key m n. ra_op (gmap_ra R) (finmap_delete key m) (finmap_delete key n) == finmap_delete key (ra_op (gmap_ra R) m n) | 双侧 delete 与 map operation 交换 | +| GMAP_RA_SINGLETON_OP_FRESH | |- forall R key a m. finmap_lookup m key == NONE ==> ra_op (gmap_ra R) (finmap_singleton key a) m == finmap_insert key a m | fresh singleton 的组合就是 insert | +| GMAP_RA_DECOMPOSE | |- forall R key a m. finmap_lookup m key == SOME a ==> m == ra_op (gmap_ra R) (finmap_singleton key a) (finmap_delete key m) | existing entry 与删除后的余图分解原 map | +| GMAP_RA_SINGLETON_OP_DELETE | |- forall R key a m. ra_op (gmap_ra R) (finmap_singleton key a) (finmap_delete key m) == finmap_insert key a m | singleton 与删 key 后余图的组合 | +| GMAP_RA_DOM_OP | |- forall R m n. finmap_dom (ra_op (gmap_ra R) m n) == finmap_dom m UNION finmap_dom n | $\operatorname{dom}(m\cdot n)=\operatorname{dom}m\cup\operatorname{dom}n$ | +| GMAP_RA_VALID | |- forall R m. ra_valid (gmap_ra R) m <=> (forall k. ra_valid (option_ra R) (finmap_lookup m k)) | map validity 是逐 key 的 option-validity | +| GMAP_RA_VALID_SINGLETON | |- forall R key a. ra_valid (gmap_ra R) (finmap_singleton key a) <=> ra_valid R a | singleton valid iff payload valid | +| GMAP_RA_VALID_LOOKUP_DELETE | |- forall R key m. ra_valid (gmap_ra R) m <=> ra_valid (option_ra R) (finmap_lookup m key) && ra_valid (gmap_ra R) (finmap_delete key m) | validity 可拆成一个 lookup 和其余 map | +| GMAP_RA_VALID_DELETE_SOME | |- forall R key a m. finmap_lookup m key == SOME a ==> (ra_valid (gmap_ra R) m <=> ra_valid R a && ra_valid (gmap_ra R) (finmap_delete key m)) | present entry 下的 validity 分解 | +| GMAP_RA_VALID_LOOKUP | |- forall R key a m. ra_valid (gmap_ra R) m ==> finmap_lookup m key == SOME a ==> ra_valid R a | valid map 中每个 present payload valid | +| GMAP_RA_VALID_DELETE | |- forall R key m. ra_valid (gmap_ra R) m ==> ra_valid (gmap_ra R) (finmap_delete key m) | delete 保 validity | +| GMAP_RA_VALID_INSERT | |- forall R key a m. ra_valid (gmap_ra R) (finmap_insert key a m) <=> ra_valid R a && ra_valid (gmap_ra R) (finmap_delete key m) | insert 后 validity 的精确条件 | +| GMAP_RA_VALID_INSERT_OF_VALID | |- forall R key a m. ra_valid R a ==> ra_valid (gmap_ra R) m ==> ra_valid (gmap_ra R) (finmap_insert key a m) | valid payload 插入 valid map 后仍 valid | +| GMAP_RA_VALID_INSERT_FRESH | |- forall R key a m. finmap_lookup m key == NONE ==> (ra_valid (gmap_ra R) (finmap_insert key a m) <=> ra_valid R a && ra_valid (gmap_ra R) m) | fresh insert 的 validity 分解 | +| GMAP_RA_INCLUDED_LOOKUP | |- forall R m n. ra_included (gmap_ra R) m n ==> (forall k. ra_included (option_ra R) (finmap_lookup m k) (finmap_lookup n k)) | map inclusion 推出逐 key inclusion | +| GMAP_RA_INCLUDED_OF_LOOKUP | |- forall R m n. (forall k. ra_included (option_ra R) (finmap_lookup m k) (finmap_lookup n k)) ==> ra_included (gmap_ra R) m n | 逐 key inclusion 推出 map inclusion | +| GMAP_RA_INCLUDED_LOOKUP_IFF | |- forall R m n. ra_included (gmap_ra R) m n <=> (forall k. ra_included (option_ra R) (finmap_lookup m k) (finmap_lookup n k)) | map inclusion 的 pointwise iff | +| GMAP_RA_INCLUDED_DELETE | |- forall R key m. ra_included (gmap_ra R) (finmap_delete key m) m | 删除后的 map included 于原 map | +| GMAP_RA_INCLUDED_LOOKUP_SOME | |- forall R m n. ra_included (gmap_ra R) m n <=> (forall key a. finmap_lookup m key == SOME a ==> (exists b. finmap_lookup n key == SOME b && ra_included R a b)) | 只量化 source 中 present entries 的 characterization | +| GMAP_RA_INCLUDED_DOM | |- forall R m n. ra_included (gmap_ra R) m n ==> finmap_dom m SUBSET finmap_dom n | inclusion 单调扩大 domain | +| GMAP_RA_INCLUDED_SINGLETON | |- forall R key a b. ra_included (gmap_ra R) (finmap_singleton key a) (finmap_singleton key b) <=> ra_included R a b | 同 key singleton inclusion 回落到 base | + +#### Local、deterministic 与 nondeterministic update + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| GMAP_RA_LOCAL_UPDATE_SINGLETON | |- forall R key a f b g. ra_local_update R (a,f) (b,g) ==> ra_local_update (gmap_ra R) (finmap_singleton key a,finmap_singleton key f) (finmap_singleton key b,finmap_singleton key g) | base local update 提升到 singleton | +| GMAP_RA_LOCAL_UPDATE_SINGLETON_IFF | |- forall R key a f b g. ra_local_update (gmap_ra R) (finmap_singleton key a,finmap_singleton key f) (finmap_singleton key b,finmap_singleton key g) <=> ra_local_update R (a,f) (b,g) | singleton local update 的 iff | +| GMAP_RA_LOCAL_UPDATE_AT | |- forall R key a f b g m. finmap_lookup m key == SOME a ==> ra_local_update R (a,f) (b,g) ==> ra_local_update (gmap_ra R) (m,finmap_singleton key f) (finmap_insert key b m,finmap_singleton key g) | 对 map 中现有 key 执行 base local update | +| GMAP_RA_LOCAL_UPDATE_AT_IFF | |- forall R key a f b g m. finmap_lookup m key == SOME a ==> (ra_local_update (gmap_ra R) (m,finmap_singleton key f) (finmap_insert key b m,finmap_singleton key g) <=> ra_valid (gmap_ra R) m ==> ra_local_update R (a,f) (b,g)) | at-key local update 的 exact iff；invalid source 时真空 | +| GMAP_RA_UPDATE_SINGLETON | |- forall R key a b. ra_update R a b ==> ra_update (gmap_ra R) (finmap_singleton key a) (finmap_singleton key b) | base deterministic update 提升到 singleton | +| GMAP_RA_UPDATE_SINGLETON_IFF | |- forall R key a b. ra_update (gmap_ra R) (finmap_singleton key a) (finmap_singleton key b) <=> ra_update R a b | singleton deterministic update 的 iff | +| GMAP_RA_UPDATE_INSERT | |- forall R key a b m. ra_update R a b ==> ra_update (gmap_ra R) (finmap_insert key a m) (finmap_insert key b m) | insert payload update | +| GMAP_RA_UPDATE_AT | |- forall R key a b m. finmap_lookup m key == SOME a ==> ra_update R a b ==> ra_update (gmap_ra R) m (finmap_insert key b m) | existing key 的 deterministic update | +| GMAP_RA_UPDATE_AT_IFF | |- forall R key a b m. finmap_lookup m key == SOME a ==> (ra_update (gmap_ra R) m (finmap_insert key b m) <=> ra_valid (gmap_ra R) m ==> ra_update R a b) | existing-key update 的 iff | +| GMAP_RA_UPDATE_DELETE | |- forall R key m. ra_update (gmap_ra R) m (finmap_delete key m) | 任意 key 都可 frame-preservingly deallocate | +| GMAP_RA_UPDATE_SINGLETON_ND | |- forall R key a P. ra_update_nd R a P ==> ra_update_nd (gmap_ra R) (finmap_singleton key a) (\m. exists b. P b && m == finmap_singleton key b) | base ND update 提升到 singleton image | +| GMAP_RA_UPDATE_SINGLETON_ND_IFF | |- forall R key a P. ra_update_nd (gmap_ra R) (finmap_singleton key a) (\m. exists b. P b && m == finmap_singleton key b) <=> ra_update_nd R a P | singleton-image ND update 的 iff | +| GMAP_RA_UPDATE_INSERT_ND | |- forall R key a P m. ra_update_nd R a P ==> ra_update_nd (gmap_ra R) (finmap_insert key a m) (\result. exists b. P b && result == finmap_insert key b m) | insert payload 的 ND update | +| GMAP_RA_UPDATE_AT_ND | |- forall R key a P m. finmap_lookup m key == SOME a ==> ra_update_nd R a P ==> ra_update_nd (gmap_ra R) m (\result. exists b. P b && result == finmap_insert key b m) | existing key 的 ND update | +| GMAP_RA_UPDATE_AT_ND_IFF | |- forall R key a P m. finmap_lookup m key == SOME a ==> (ra_update_nd (gmap_ra R) m (\result. exists b. P b && result == finmap_insert key b m) <=> ra_valid (gmap_ra R) m ==> ra_update_nd R a P) | existing-key ND update 的 iff | + +#### Fresh allocation + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| GMAP_RA_ALLOC_STRONG_DEP | |- forall R candidates payload m. INFINITE candidates ==> (forall key. key IN candidates ==> finmap_lookup m key == NONE ==> ra_valid R (payload key)) ==> ra_update_nd (gmap_ra R) m (\result. exists key. key IN candidates && finmap_lookup m key == NONE && result == finmap_insert key (payload key) m) | 在无限候选集中选 fresh key；payload 可依赖所选 key | +| GMAP_RA_ALLOC_STRONG | |- forall R candidates m a. INFINITE candidates ==> ra_valid R a ==> ra_update_nd (gmap_ra R) m (\result. exists key. key IN candidates && finmap_lookup m key == NONE && result == finmap_insert key a m) | 固定 valid payload 的候选集分配 | +| GMAP_RA_ALLOC | |- forall R m a. INFINITE (:K) ==> ra_valid R a ==> ra_update_nd (gmap_ra R) m (\result. exists key. finmap_lookup m key == NONE && result == finmap_insert key a m) | 无限 key type 上分配 fresh key | +| GMAP_RA_ALLOC_COFINITE | |- forall R forbidden m a. INFINITE (:K) ==> FINITE forbidden ==> ra_valid R a ==> ra_update_nd (gmap_ra R) m (\result. exists key. ~(key IN forbidden) && finmap_lookup m key == NONE && result == finmap_insert key a m) | 分配时还能避开给定有限禁集 | +| GMAP_RA_ALLOC_EMPTY | |- forall R a. INFINITE (:K) ==> ra_valid R a ==> ra_update_nd (gmap_ra R) finmap_empty (\result. exists key. result == finmap_singleton key a) | 空 map 上分配成某个 singleton | + +这里的 existential key 位于 ND update 的结果谓词中，因此可随隐藏 frame +选择；不能把公开结论加强为“预先固定一个对所有 frame 都 fresh 的 key”。 + +### 8.10 Authoritative RA + +源文件：[`auth_ra.h`](../theory/logic/auth_ra.h)、 +[`auth_ra.c`](../theory/logic/auth_ra.c)。记 +$\bullet a=\texttt{auth_auth R a}$、 +$\circ f=\texttt{auth_frag f}$、 +$\bullet a\,\circ f=\texttt{auth_both a f}$。carrier 是 +`(A)excl # A`；operation 是 `excl_ra × R` 的 product operation，但 authority +在场时 validity 额外要求 fragment included 于 authoritative value。 + +#### 构造、计算与区分 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `AUTH_RA_UNIT` | `` `\|- forall R. ra_unit (auth_ra R) == auth_frag (ra_unit R)` `` | $\varepsilon_{\mathrm{Auth}(R)}=\circ\varepsilon_R$ | +| `AUTH_RA_AUTH_FRAG` | `` `\|- forall R a fragment. ra_op (auth_ra R) (auth_auth R a) (auth_frag fragment) == auth_both a fragment` `` | $\bullet a\cdot\circ f=\bullet a\,\circ f$ | +| `AUTH_RA_FRAG_FRAG` | `` `\|- forall R f g. ra_op (auth_ra R) (auth_frag f) (auth_frag g) == auth_frag (ra_op R f g)` `` | $\circ f\cdot\circ g=\circ(f\cdot_Rg)$ | +| `AUTH_RA_BOTH_FRAG` | `` `\|- forall R a f g. ra_op (auth_ra R) (auth_both a f) (auth_frag g) == auth_both a (ra_op R f g)` `` | combined resource 吸收额外 fragment | +| `AUTH_RA_BOTH_UNIT` | `` `\|- forall R a. auth_both a (ra_unit R) == auth_auth R a` `` | $\bullet a\,\circ\varepsilon=\bullet a$ | +| `AUTH_RA_FRAG_INJ` | `` `\|- forall f g. auth_frag f == auth_frag g <=> f == g` `` | fragment constructor 单射 | +| `AUTH_RA_BOTH_INJ` | `` `\|- forall a f b g. auth_both a f == auth_both b g <=> a == b && f == g` `` | combined constructor 双参数单射 | +| `AUTH_RA_BOTH_NE_FRAG` | `` `\|- forall a f g. ~(auth_both a f == auth_frag g)` `` | combined 与 fragment-only 区分 | +| `AUTH_RA_AUTH_INJ` | `` `\|- forall R a b. auth_auth R a == auth_auth R b <=> a == b` `` | authority-only 单射 | +| `AUTH_RA_AUTH_NE_FRAG` | `` `\|- forall R a f. ~(auth_auth R a == auth_frag f)` `` | authority-only 与 fragment-only 区分 | +| `AUTH_RA_AUTH_EQ_BOTH` | `` `\|- forall R a b f. auth_auth R a == auth_both b f <=> a == b && f == ra_unit R` `` | authority-only 恰为 unit fragment 的 combined resource | + +#### Validity、frame 与 authority conflict + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `AUTH_RA_VALID_FRAG` | `` `\|- forall R fragment. ra_valid (auth_ra R) (auth_frag fragment) <=> ra_valid R fragment` `` | fragment-only 有效性继承 base | +| `AUTH_RA_VALID_BOTH` | `` `\|- forall R a fragment. ra_valid (auth_ra R) (auth_both a fragment) <=> ra_valid R a && ra_included R fragment a` `` | $\checkmark(\bullet a\,\circ f)\Leftrightarrow\checkmark_R(a)\land f\preccurlyeq_Ra$ | +| `AUTH_RA_VALID_BOTH_INTRO` | `` `\|- forall R a f. ra_valid R a ==> ra_included R f a ==> ra_valid (auth_ra R) (auth_both a f)` `` | combined validity 引入 | +| `AUTH_RA_VALID_BOTH_ELIM_VALID` | `` `\|- forall R a f. ra_valid (auth_ra R) (auth_both a f) ==> ra_valid R a` `` | 提取 authority validity | +| `AUTH_RA_VALID_BOTH_ELIM_INCLUDED` | `` `\|- forall R a f. ra_valid (auth_ra R) (auth_both a f) ==> ra_included R f a` `` | 提取 fragment inclusion | +| `AUTH_RA_VALID_AUTH` | `` `\|- forall R a. ra_valid (auth_ra R) (auth_auth R a) <=> ra_valid R a` `` | authority-only validity | +| `AUTH_RA_VALID_AUTH_FRAG` | `` `\|- forall R a f. ra_valid (auth_ra R) (ra_op (auth_ra R) (auth_auth R a) (auth_frag f)) <=> ra_valid R a && ra_included R f a` `` | authority 与一个 fragment 相容的精确条件 | +| `AUTH_RA_VALID_BOTH_FRAG` | `` `\|- forall R a f g. ra_valid (auth_ra R) (ra_op (auth_ra R) (auth_both a f) (auth_frag g)) <=> ra_valid R a && ra_included R (ra_op R f g) a` `` | combined + external fragment 的条件 | +| `AUTH_RA_VALID_BOTH_FRAME` | `` `\|- forall R a f frame. ra_valid (auth_ra R) (ra_op (auth_ra R) (auth_both a f) frame) <=> (exists external. frame == auth_frag external && ra_valid R a && ra_included R (ra_op R f external) a)` `` | 任意相容 frame 必须是 fragment-only，并满足 base inclusion | +| `AUTH_RA_VALID_AUTH_FRAME` | `` `\|- forall R a frame. ra_valid (auth_ra R) (ra_op (auth_ra R) (auth_auth R a) frame) <=> (exists external. frame == auth_frag external && ra_valid R a && ra_included R external a)` `` | authority-only 的 frame characterization | +| `AUTH_RA_AUTH_CONFLICT` | `` `\|- forall R a b. ~ra_valid (auth_ra R) (ra_op (auth_ra R) (auth_auth R a) (auth_auth R b))` `` | 两个 authority-only 永远冲突 | +| `AUTH_RA_BOTH_CONFLICT` | `` `\|- forall R a f b g. ~ra_valid (auth_ra R) (ra_op (auth_ra R) (auth_both a f) (auth_both b g))` `` | 两个 combined authority 永远冲突 | +| `AUTH_RA_AUTH_BOTH_CONFLICT` | `` `\|- forall R a b g. ~ra_valid (auth_ra R) (ra_op (auth_ra R) (auth_auth R a) (auth_both b g))` `` | authority-only 与 combined authority 冲突 | +| `AUTH_RA_BOTH_EXCLUSIVE` | `` `\|- forall R a f. ra_exclusive R f ==> ra_exclusive (auth_ra R) (auth_both a f)` `` | exclusive local fragment 使 combined resource exclusive | + +#### Inclusion 与 cancellation + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `AUTH_RA_INCLUDED_FRAG_FRAG` | `` `\|- forall R f g. ra_included (auth_ra R) (auth_frag f) (auth_frag g) <=> ra_included R f g` `` | $\circ f\preccurlyeq\circ g\Leftrightarrow f\preccurlyeq_Rg$ | +| `AUTH_RA_INCLUDED_FRAG_AUTH` | `` `\|- forall R f a. ra_included (auth_ra R) (auth_frag f) (auth_auth R a) <=> ra_included R f (ra_unit R)` `` | fragment 到 authority-only 的特殊 unit 条件 | +| `AUTH_RA_INCLUDED_FRAG_BOTH` | `` `\|- forall R f a g. ra_included (auth_ra R) (auth_frag f) (auth_both a g) <=> ra_included R f g` `` | fragment 到 combined 只观察 fragment 分量 | +| `AUTH_RA_INCLUDED_AUTH_FRAG` | `` `\|- forall R a g. ~ra_included (auth_ra R) (auth_auth R a) (auth_frag g)` `` | authority 不能扩张成 fragment-only | +| `AUTH_RA_INCLUDED_AUTH_AUTH` | `` `\|- forall R a b. ra_included (auth_ra R) (auth_auth R a) (auth_auth R b) <=> a == b` `` | authority-only inclusion 保持 authority 值 | +| `AUTH_RA_INCLUDED_AUTH_BOTH` | `` `\|- forall R a b g. ra_included (auth_ra R) (auth_auth R a) (auth_both b g) <=> a == b` `` | authority-only 可扩张为同 authority 的 combined resource | +| `AUTH_RA_INCLUDED_BOTH_FRAG` | `` `\|- forall R a f g. ~ra_included (auth_ra R) (auth_both a f) (auth_frag g)` `` | combined 不能扩张成 fragment-only | +| `AUTH_RA_INCLUDED_BOTH_AUTH` | `` `\|- forall R a f b. ra_included (auth_ra R) (auth_both a f) (auth_auth R b) <=> a == b && ra_included R f (ra_unit R)` `` | combined 到 authority-only 还需 fragment included 于 unit | +| `AUTH_RA_INCLUDED_BOTH_BOTH` | `` `\|- forall R a f b g. ra_included (auth_ra R) (auth_both a f) (auth_both b g) <=> a == b && ra_included R f g` `` | authority 值相同且 fragment inclusion | +| `AUTH_RA_CANCELLATIVE` | `` `\|- forall R. ra_cancellative R ==> ra_cancellative (auth_ra R)` `` | base cancellation 提升 | +| `AUTH_RA_CANCELLATIVE_IFF` | `` `\|- forall R. ra_cancellative (auth_ra R) <=> ra_cancellative R` `` | auth construction 不增不减 cancellation | + +#### Frame-preserving update 与 local update lifting + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| `AUTH_RA_UPDATE_FRAMEWISE` | `` `\|- forall R a f b g. (forall external. ra_valid R a && ra_included R (ra_op R f external) a ==> ra_valid R b && ra_included R (ra_op R g external) b) ==> ra_update (auth_ra R) (auth_both a f) (auth_both b g)` `` | 若每个 source-compatible external fragment 在目标仍兼容，则 combined update 成立 | +| `AUTH_RA_UPDATE_FRAMEWISE_IFF` | `` `\|- forall R a f b g. ra_update (auth_ra R) (auth_both a f) (auth_both b g) <=> (forall external. ra_valid R a && ra_included R (ra_op R f external) a ==> ra_valid R b && ra_included R (ra_op R g external) b)` `` | 上述条件也是必要条件 | +| `AUTH_RA_UPDATE` | `` `\|- forall R a f b g. ra_local_update R (a,f) (b,g) ==> ra_update (auth_ra R) (auth_both a f) (auth_both b g)` `` | base local update 是 auth update 的主桥 | +| `AUTH_RA_UPDATE_ND` | `` `\|- forall R a f P. (forall external. ra_valid R a && ra_included R (ra_op R f external) a ==> (exists b g. P b g && ra_valid R b && ra_included R (ra_op R g external) b)) ==> ra_update_nd (auth_ra R) (auth_both a f) (\candidate. exists b g. P b g && candidate == auth_both b g)` `` | target pair 可随 external frame 选择的 ND criterion | +| `AUTH_RA_UPDATE_ND_FRAMEWISE_IFF` | `` `\|- forall R a f P. ra_update_nd (auth_ra R) (auth_both a f) (\candidate. exists b g. P b g && candidate == auth_both b g) <=> (forall external. ra_valid R a && ra_included R (ra_op R f external) a ==> (exists b g. P b g && ra_valid R b && ra_included R (ra_op R g external) b))` `` | combined-image ND criterion 的 iff | +| `AUTH_RA_UPDATE_AUTH_IFF` | `` `\|- forall R a b. ra_update (auth_ra R) (auth_auth R a) (auth_auth R b) <=> ra_valid R a ==> ra_valid R b && ra_included R a b` `` | authority-only 可更新 iff 有效源时目标有效且旧 authority included 于新 authority | +| `AUTH_RA_UPDATE_AUTH_INCLUDED` | `` `\|- forall R a b. ra_valid R b ==> ra_included R a b ==> ra_update (auth_ra R) (auth_auth R a) (auth_auth R b)` `` | 上条的 direct intro | +| `AUTH_RA_UPDATE_DROP_FRAG` | `` `\|- forall R a f. ra_update (auth_ra R) (auth_both a f) (auth_auth R a)` `` | 丢弃 local fragment | +| `AUTH_RA_UPDATE_DROP_AUTH` | `` `\|- forall R a f. ra_update (auth_ra R) (auth_both a f) (auth_frag f)` `` | 丢弃 authority | +| `AUTH_RA_UPDATE_WEAKEN_FRAG` | `` `\|- forall R a f g. ra_included R g f ==> ra_update (auth_ra R) (auth_both a f) (auth_both a g)` `` | authority 不变，fragment 向 included 部分弱化 | +| `AUTH_RA_FRAG_UPDATE_INCLUDED` | `` `\|- forall R f g. ra_included R g f ==> ra_update (auth_ra R) (auth_frag f) (auth_frag g)` `` | fragment-only 弱化 | +| `AUTH_RA_UPDATE_BOTH_INCLUDED` | `` `\|- forall R a b f. ra_valid R b ==> ra_included R a b ==> ra_update (auth_ra R) (auth_both a f) (auth_both b f)` `` | 扩大 authority、保持 local fragment | +| `AUTH_RA_UPDATE_ALLOC` | `` `\|- forall R a b g. ra_local_update R (a,ra_unit R) (b,g) ==> ra_update (auth_ra R) (auth_auth R a) (auth_both b g)` `` | 由无 local fragment 分配出 `g` | +| `AUTH_RA_UPDATE_DEALLOC` | `` `\|- forall R a f b. ra_local_update R (a,f) (b,ra_unit R) ==> ra_update (auth_ra R) (auth_both a f) (auth_auth R b)` `` | local update 消耗 fragment | +| `AUTH_RA_UPDATE_AUTH` | `` `\|- forall R a b g. ra_local_update R (a,ra_unit R) (b,g) ==> ra_update (auth_ra R) (auth_auth R a) (auth_auth R b)` `` | 执行 local update 后丢弃其 produced fragment | +| `AUTH_RA_LOCAL_UPDATE` | `` `\|- forall R a b0 b1 a_new b0_new b1_new. ra_local_update R (b0,b1) (b0_new,b1_new) ==> ra_included R b0_new a_new ==> ra_valid R a_new ==> ra_local_update (auth_ra R) (auth_both a b0,auth_both a b1) (auth_both a_new b0_new,auth_both a_new b1_new)` `` | base local update 提升为 auth local update，并显式验证目标 authority | +| `AUTH_RA_ALLOC_BOTH` | `` `\|- forall R a f piece. ra_valid R (ra_op R a piece) ==> ra_update (auth_ra R) (auth_both a f) (auth_both (ra_op R a piece) (ra_op R f piece))` `` | authority 与 local fragment 同步扩张 `piece` | +| `AUTH_RA_ALLOC` | `` `\|- forall R a piece. ra_valid R (ra_op R a piece) ==> ra_update (auth_ra R) (auth_auth R a) (auth_both (ra_op R a piece) piece)` `` | authority-only 分配新 fragment | +| `AUTH_RA_UPDATE_CANCELLATIVE` | `` `\|- forall R a b frame. ra_cancellative R ==> ra_valid R (ra_op R b frame) ==> ra_update (auth_ra R) (auth_both (ra_op R a frame) a) (auth_both (ra_op R b frame) b)` `` | cancellative base 上保持同一 residual `frame` 的同步替换 | + +## 9. Named ghost resource + +### 9.1 Ghost heap algebra + +$\mathcal G_R=\texttt{ghost_heap_ra R}=\mathrm{GMap}_{\mathbb N}(R)$。 +name 的 absence 是 NONE；已经分配且 payload 恰为 +$\varepsilon_R$ 的状态是 SOME (ra_unit R)，二者不可混淆。 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| ghost_heap_ra_def | |- forall G. ghost_heap_ra G == gmap_ra G | $\mathcal G_R=\mathrm{GMap}_{\mathbb N}(R)$ | +| GHOST_HEAP_UNIT | |- forall G. ra_unit (ghost_heap_ra G) == (finmap_empty:(num,A)finmap) | ghost heap unit 是空 map | +| GHOST_HEAP_OP_LOOKUP | |- forall G h k name. finmap_lookup (ra_op (ghost_heap_ra G) h k) name == ra_op (option_ra G) (finmap_lookup h name) (finmap_lookup k name) | operation 按 name pointwise | +| GHOST_HEAP_VALID | |- forall G h. ra_valid (ghost_heap_ra G) h <=> (forall name. ra_valid (option_ra G) (finmap_lookup h name)) | validity 按 name pointwise | +| GHOST_HEAP_SINGLETON_OP | |- forall G name a b. ra_op (ghost_heap_ra G) (finmap_singleton name a) (finmap_singleton name b) == finmap_singleton name (ra_op G a b) | 同名 payload 组合 | +| GHOST_HEAP_VALID_SINGLETON | |- forall G name a. ra_valid (ghost_heap_ra G) (finmap_singleton name a) <=> ra_valid G a | singleton valid iff payload valid | +| GHOST_HEAP_SINGLETON_UNIT_NE_EMPTY | |- forall G name. ~(finmap_singleton name (ra_unit G) == (finmap_empty:(num,A)finmap)) | 已分配 unit payload 不等于未分配 | +| GHOST_HEAP_UPDATE_SINGLETON | |- forall G name a b. ra_update G a b ==> ra_update (ghost_heap_ra G) (finmap_singleton name a) (finmap_singleton name b) | payload update 提升到固定 name | +| GHOST_HEAP_UPDATE_SINGLETON_ND | |- forall G name a P. ra_update_nd G a P ==> ra_update_nd (ghost_heap_ra G) (finmap_singleton name a) (\h. exists b. P b && h == finmap_singleton name b) | payload ND update 提升到固定 name | +| GHOST_HEAP_DEALLOC | |- forall G name a. ra_update (ghost_heap_ra G) (finmap_singleton name a) (finmap_empty:(num,A)finmap) | singleton fragment 可 deallocate | +| GHOST_HEAP_FRESH | |- forall h:(num,A)finmap. exists name:num. finmap_lookup h name == NONE | 每个 heap 有 fresh name | +| GHOST_HEAP_FRESH_PAIR | |- forall h frame. exists name:num. finmap_lookup h name == NONE && finmap_lookup frame name == NONE | 两个 heap 有共同 fresh name | +| GHOST_HEAP_ALLOC | |- forall G h a. ra_valid G a ==> ra_update_nd (ghost_heap_ra G) h (\result. exists name. finmap_lookup h name == NONE && result == ra_op (ghost_heap_ra G) h (finmap_singleton name a)) | 分配 fresh name；公开 freshness 只相对 source $h$ | +| GHOST_HEAP_ALLOC_EMPTY | |- forall G a. ra_valid G a ==> ra_update_nd (ghost_heap_ra G) (finmap_empty:(num,A)finmap) (\result. exists name. result == finmap_singleton name a) | 空 heap 分配为某个 singleton | + +GHOST_HEAP_ALLOC 的 name 可依赖隐藏 frame；不要把它强化为 +对 frame 也公开 fresh 的单一 witness。 + +### 9.2 Exact named ownership 与 generic viewshift + +记 $\mathsf{own}_n(a)=\texttt{ghost_own G name a}$。这是固定 name 的 exact +singleton ownership。 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| ghost_own_def | |- forall G name a heap. ghost_own G name a heap <=> r_own (ghost_heap_ra G) (finmap_singleton name a) heap | $\mathsf{own}_n(a)$ 精确拥有 singleton $[n\mapsto a]$ | +| GHOST_OWN_AS_R_OWN | |- forall G name a. ghost_own G name a == r_own (ghost_heap_ra G) (finmap_singleton name a) | predicate extensional equality | +| GHOST_OWN_OP | |- forall G name a b. r_sep (ghost_heap_ra G) (ghost_own G name a) (ghost_own G name b) == ghost_own G name (ra_op G a b) | $\mathsf{own}_n(a)*\mathsf{own}_n(b)=\mathsf{own}_n(a\cdot b)$ | +| GHOST_OWN_VALID | |- forall G name a. r_entails (ghost_heap_ra G) (ghost_own G name a) (r_and (ghost_heap_ra G) (r_pure (ghost_heap_ra G) (ra_valid G a)) (ghost_own G name a)) | ownership 可观察 payload validity，同时保留所有权 | +| GHOST_OWN_UPDATE | |- forall G name a b. ra_update G a b ==> r_viewshift (ghost_heap_ra G) (ghost_own G name a) (ghost_own G name b) | base update 给出 generic ghost viewshift | +| GHOST_OWN_UPDATE_ND | |- forall G name a result_pred. ra_update_nd G a result_pred ==> r_viewshift (ghost_heap_ra G) (ghost_own G name a) (r_exists (ghost_heap_ra G) (\selected. r_and (ghost_heap_ra G) (r_pure (ghost_heap_ra G) (result_pred selected)) (ghost_own G name selected))) | base ND update 给出带 witness/pure fact 的 viewshift | +| GHOST_OWN_ALLOC_EMPTY | |- forall G a. ra_valid G a ==> r_viewshift (ghost_heap_ra G) (r_emp (ghost_heap_ra G)) (r_exists (ghost_heap_ra G) (\name. ghost_own G name a)) | 从 emp 分配某个 named ghost | +| GHOST_OWN_ALLOC | |- forall G a P. ra_valid G a ==> r_viewshift (ghost_heap_ra G) P (r_exists (ghost_heap_ra G) (\name. r_sep (ghost_heap_ra G) (ghost_own G name a) P)) | 在任意 frame-preserved assertion 旁分配 | + +本节最后四条使用 generic +$\texttt{r_viewshift (ghost_heap_ra G)}$；它们还不是 C 程序逻辑的受限 +viewshift。 + +## 10. C resource 实例 + +### 10.1 Physical byte RA + +物理内存 RA 是地址到 exclusive byte-state 的 finite-map RA： +$$ +\mathcal M=\texttt{mem_ra} +=\mathrm{GMap}_{\mathbb Z}(\mathrm{Excl}(\texttt{pmem_byte_state})). +$$ + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| mem_ra_def | |- mem_ra == gmap_ra (excl_ra:((pmem_byte_state)excl)ra) | $\mathcal M=\mathrm{GMap}(\mathrm{Excl}(\text{byte-state}))$ | +| MEM_RA_UNIT | |- ra_unit mem_ra == (finmap_empty:(int,(pmem_byte_state)excl)finmap) | 空物理内存 ownership 是 unit | +| MEM_RA_OP_LOOKUP | |- forall left right address. finmap_lookup (ra_op mem_ra left right) address == ra_op (option_ra (excl_ra:((pmem_byte_state)excl)ra)) (finmap_lookup left address) (finmap_lookup right address) | 按地址 pointwise/exclusive 组合 | +| MEM_RA_VALID | |- forall memory. ra_valid mem_ra memory <=> (forall address:int. ra_valid (option_ra (excl_ra:((pmem_byte_state)excl)ra)) (finmap_lookup memory address)) | validity 按地址 pointwise | +| pmem_singleton_def | |- forall address state. pmem_singleton address state == finmap_singleton address (Excl state) | 单地址 exact byte ownership | +| pmem_uninit_def | |- forall address. pmem_uninit address == pmem_singleton address PMemUninit | 已分配但未初始化 byte | +| pmem_byte_def | |- forall address byte. pmem_byte address byte == pmem_singleton address (PMemByte byte) | 携带整数值的 initialized byte | +| PMEM_SINGLETON_VALID | |- forall address state. ra_valid mem_ra (pmem_singleton address state) | canonical singleton 总是 valid | +| PMEM_UNINIT_VALID | |- forall address. ra_valid mem_ra (pmem_uninit address) | uninitialized singleton valid | +| PMEM_BYTE_VALID | |- forall address byte. ra_valid mem_ra (pmem_byte address byte) | initialized singleton valid | +| PMEM_SINGLETON_OVERLAP_INVALID | |- forall address left right. ~ra_valid mem_ra (ra_op mem_ra (pmem_singleton address left) (pmem_singleton address right)) | 同地址两份 canonical ownership 冲突 | +| PMEM_UPDATE_UNINIT_BYTE | |- forall address byte. ra_update mem_ra (pmem_uninit address) (pmem_byte address byte) | 代数上 uninit-to-byte update | +| PMEM_UPDATE_BYTE_UNINIT | |- forall address byte. ra_update mem_ra (pmem_byte address byte) (pmem_uninit address) | 代数上 byte-to-uninit update | +| PMEM_UPDATE_BYTE_BYTE | |- forall address old_byte new_byte. ra_update mem_ra (pmem_byte address old_byte) (pmem_byte address new_byte) | 代数上可改写 owned byte | +| pmem_own_def | |- forall memory. pmem_own memory == r_own mem_ra memory | physical assertion 是 exact ownership | +| pmem_uninit_at_def | |- forall address. pmem_uninit_at address == pmem_own (pmem_uninit address) | 单地址 uninitialized assertion | +| pmem_byte_at_def | |- forall address byte. pmem_byte_at address byte == pmem_own (pmem_byte address byte) | 单地址 initialized assertion | + +最后三条 PMEM_UPDATE_* 只是 RA algebra lemma。改变物理内存必须由 +C command 的 symbolic semantics 支持，不能把它们直接暴露成程序级 viewshift。 + +### 10.2 Physical × ghost product + +令 +$$ +R_G=\texttt{c_resource_ra G} +=\mathcal M\times\mathcal G_G. +$$ +assertion 的 carrier 同时线性记录 physical 与 named ghost projection。 + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| c_resource_ra_def | |- forall G. c_resource_ra G == prod_ra mem_ra (ghost_heap_ra G) | $R_G=\mathcal M\times\mathcal G_G$ | +| C_RESOURCE_RA_UNIT | |- forall G. ra_unit (c_resource_ra G) == (ra_unit mem_ra,ra_unit (ghost_heap_ra G)) | product unit 分量化 | +| C_RESOURCE_RA_OP | |- forall G left right. ra_op (c_resource_ra G) left right == (ra_op mem_ra (FST left) (FST right),ra_op (ghost_heap_ra G) (SND left) (SND right)) | product operation 分量化 | +| C_RESOURCE_RA_VALID | |- forall G resource. ra_valid (c_resource_ra G) resource <=> ra_valid mem_ra (FST resource) && ra_valid (ghost_heap_ra G) (SND resource) | product validity 分量化 | +| c_lift_phys_def | |- forall G P resource. c_lift_phys G P resource <=> P (FST resource) && SND resource == ra_unit (ghost_heap_ra G) | exact physical lift；ghost 必须为 unit | +| C_LIFT_PHYS_EMP | |- forall G. c_lift_phys G (r_emp mem_ra) == r_emp (c_resource_ra G) | physical lift 保 emp | +| C_LIFT_PHYS_SEP | |- forall G P Q. c_lift_phys G (r_sep mem_ra P Q) == r_sep (c_resource_ra G) (c_lift_phys G P) (c_lift_phys G Q) | physical lift 保 separating conjunction | +| C_LIFT_PHYS_ENTAILS | |- forall G P Q. r_entails mem_ra P Q ==> r_entails (c_resource_ra G) (c_lift_phys G P) (c_lift_phys G Q) | physical entailment 单调提升 | +| c_ghost_own_def | |- forall G name a. c_ghost_own G name a == r_own (c_resource_ra G) (ra_unit mem_ra,finmap_singleton name a) | ghost singleton 的 physical 分量精确为 unit | +| c_pmem_uninit_at_def | |- forall G address. c_pmem_uninit_at G address == c_lift_phys G (pmem_uninit_at address) | uninitialized byte 的 exact C-resource lift | +| c_pmem_byte_at_def | |- forall G address byte. c_pmem_byte_at G address byte == c_lift_phys G (pmem_byte_at address byte) | initialized byte 的 exact C-resource lift | + +c_lift_phys 和 c_ghost_own 都是 exact lift： +另一 projection 必须是 unit；它们不是可丢弃另一侧资源的 affine embedding。 + +### 10.3 Ghost-only C basic update + +与 generic $r\_\text{viewshift}$ 不同，C modality 定义性地保留物理 +projection： + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| c_bupd_def | |- forall G Q resource. c_bupd G Q resource <=> ra_update_nd (ghost_heap_ra G) (SND resource) (\ghost'. Q (FST resource,ghost')) | $\mathop{\mathsf{bupd}}\nolimits_G Q(p,g)$ 只 ND-update $g$，结果仍用原 $p$ | +| c_viewshift_def | |- forall G P Q. c_viewshift G P Q <=> r_entails (c_resource_ra G) P (c_bupd G Q) | $P\Rightarrow_G^C Q\;\Leftrightarrow\;P\vdash_{R_G}\mathsf{bupd}_GQ$ | +| C_BUPD_INTRO | |- forall G P. r_entails (c_resource_ra G) P (c_bupd G P) | $P\vdash\mathsf{bupd}\,P$ | +| C_BUPD_MONO | |- forall G P Q. r_entails (c_resource_ra G) P Q ==> r_entails (c_resource_ra G) (c_bupd G P) (c_bupd G Q) | basic update 单调 | +| C_BUPD_IDEM | |- forall G P. r_entails (c_resource_ra G) (c_bupd G (c_bupd G P)) (c_bupd G P) | basic update 可压平 | +| C_BUPD_FRAME | |- forall G P F. r_entails (c_resource_ra G) (r_sep (c_resource_ra G) (c_bupd G P) F) (c_bupd G (r_sep (c_resource_ra G) P F)) | linear frame 被精确保留 | +| C_ENTAILS_TO_VIEWSHIFT | |- forall G P Q. r_entails (c_resource_ra G) P Q ==> c_viewshift G P Q | entailment 嵌入 C viewshift | +| C_VIEWSHIFT_REFL | |- forall G P. c_viewshift G P P | reflexivity | +| C_VIEWSHIFT_TRANS | |- forall G P Q S. c_viewshift G P Q ==> c_viewshift G Q S ==> c_viewshift G P S | transitivity | +| C_VIEWSHIFT_MONO | |- forall G P2 P Q Q2. r_entails (c_resource_ra G) P2 P ==> c_viewshift G P Q ==> r_entails (c_resource_ra G) Q Q2 ==> c_viewshift G P2 Q2 | consequence on both endpoints | +| C_VIEWSHIFT_FRAME | |- forall G P Q F. c_viewshift G P Q ==> c_viewshift G (r_sep (c_resource_ra G) P F) (r_sep (c_resource_ra G) Q F) | right frame | +| C_VIEWSHIFT_SEP | |- forall G P1 Q1 P2 Q2. c_viewshift G P1 Q1 ==> c_viewshift G P2 Q2 ==> c_viewshift G (r_sep (c_resource_ra G) P1 P2) (r_sep (c_resource_ra G) Q1 Q2) | independent viewshifts 可 separating-compose | +| C_VIEWSHIFT_FACT | |- forall G guard P Q. (guard ==> c_viewshift G P Q) ==> c_viewshift G (r_sep (c_resource_ra G) (r_fact (c_resource_ra G) guard) P) (r_sep (c_resource_ra G) (r_fact (c_resource_ra G) guard) Q) | pure guard 以 exact-unit fact 线性内化 | +| C_VIEWSHIFT_EXISTS | |- forall G P Q. (forall witness:B. c_viewshift G (P witness) (Q witness)) ==> c_viewshift G (r_exists (c_resource_ra G) (\bound:B. P bound)) (r_exists (c_resource_ra G) (\bound:B. Q bound)) | pointwise viewshift 提升过同一 existential witness | + +因此程序级关系是 +$\texttt{c_viewshift G}$，不是 +$\texttt{r_viewshift (c_resource_ra G)}$：后者允许从代数上改 physical +projection，却没有执行 C 指令。 + +### 10.4 C named-ghost API + +| theorem | HOL statement | 数学陈述 | +|---|---|---| +| C_GHOST_OWN_OP | |- forall G name a b. c_ghost_own G name (ra_op G a b) == r_sep (c_resource_ra G) (c_ghost_own G name a) (c_ghost_own G name b) | 同 name 的 C ghost ownership 按 payload operation 分解 | +| C_GHOST_OWN_VALID | |- forall G name a. r_entails (c_resource_ra G) (c_ghost_own G name a) (r_sep (c_resource_ra G) (r_fact (c_resource_ra G) (ra_valid G a)) (c_ghost_own G name a)) | 提取 payload validity fact 并保留 ownership | +| C_GHOST_OWN_UPDATE | |- forall G name a b. ra_update G a b ==> c_viewshift G (c_ghost_own G name a) (c_ghost_own G name b) | 固定 name 的 deterministic payload update | +| C_GHOST_OWN_UPDATE_ND | |- forall G name a P. ra_update_nd G a P ==> c_viewshift G (c_ghost_own G name a) (r_exists (c_resource_ra G) (\b. r_and (c_resource_ra G) (r_pure (c_resource_ra G) (P b)) (c_ghost_own G name b))) | 固定 name 的 ND payload update | +| C_GHOST_OWN_DEALLOC | |- forall G name a. c_viewshift G (c_ghost_own G name a) (r_emp (c_resource_ra G)) | 释放调用者的 singleton fragment | +| C_GHOST_OWN_ALLOC_EMPTY | |- forall G a. ra_valid G a ==> c_viewshift G (r_emp (c_resource_ra G)) (r_exists (c_resource_ra G) (\name. c_ghost_own G name a)) | 从 C emp 分配 named ghost | +| C_GHOST_OWN_ALLOC | |- forall G a P. ra_valid G a ==> c_viewshift G P (r_exists (c_resource_ra G) (\name. r_sep (c_resource_ra G) (c_ghost_own G name a) P)) | 分配并线性保留任意 C assertion | + +deallocation 只释放调用者拥有的 fragment，不能推出该 name 在所有兼容隐藏 +fragment 中都不存在；allocation 的公开 postcondition 同样没有额外 pure freshness +fact。 + +## 11. Generic SL adapter 与当前 C syntax + +这一层不添加 object-logic 公理。ra_sl_build(R,out) 只接受 +closed、monomorphic、unary 的 $R:(A)\texttt{ra}$，令 +$\mathrm{Prop}=A\to\texttt{bool}$，并把 +r_emp/r_sep/r_wand/.../r_fact 以及第 5 节的 derived +定理按 $R$ specialization 后装入 generic sl_theory。 + +ra_sl_scope_prepare 以 conservative +new_const_definition 建立 closed aliases +cstar_sl__<scope>__*，再把 primitive theorem rewrite +到 alias head；ra_sl_scope_install 只安装 theorem bundle。 +直到 ra_sl_scope_activate 才改变 parser： + +| 激活后的 surface syntax | 实际 semantic head | 数学读法 | +|---|---|---| +| emp | selected r_emp R alias | $\mathsf{emp}_R$ | +| P ** Q | selected r_sep R P Q alias | $P*Q$ | +| P -* Q | selected r_wand R P Q alias | $P-\!*Q$ | +| P && Q, P || Q | selected assertion-level r_and/r_or aliases | additive $\land,\lor$ | +| exists x. P, forall x. P | selected r_exists/r_forall aliases | assertion 量词 | +| fact(p) | selected r_fact R p alias | exact-unit fact $\lfloor p\rfloor$ | +| pure(p) | selected r_pure R p alias | resource-independent pure $\lceil p\rceil$ | +| P |-- Q | selected r_entails R P Q alias | validity-aware entailment | +| P -||- Q | selected r_equiv R P Q alias | 双向 validity-aware equivalence | +| P -|- Q | assertion type 上的 raw HOL == | 所有资源点上的函数等号 | +| P ==*=> Q | selected c_viewshift G P Q | ghost-only C viewshift | + +特别地，-|- 与 -||- 不是同一个关系。 +前者强到包含 invalid resources；后者只由 $r\_\text{entails}$ 双向定义。 + +在 c_logic_install(G) 中，实际安装顺序是： + +1. 取 combined_ra = c_resource_ra G； +2. 建立并 fold scoped aliases； +3. fold C_BUPD_*、C_VIEWSHIFT_* 与 C named-ghost API； +4. 安装 base/update theory，再激活 parser； +5. 令 cprop 成为所选 assertion carrier 的 parser type + abbreviation，并令 ==*=> 指向受限 c_viewshift。 + +所以 cprop 不是新的 HOL type，更不是旧模型的 +hprop。默认逻辑只是在同一安装过程里选 +$G=\texttt{unit_ra}$。 + +proof_sl.h 是 generic proof signature； +proof_sl.c 动态构造 derived theorem/tactic，并在安装时 exact-check +每个 primitive conclusion。它不是第二套 BI semantics。 + +## 12. 当前 protocol/client theory 的位置 + +下列 theory 显式消费上述 RA-SL，但属于实例或应用协议，不是基础公理。列出其 +selected RA 与最能说明语义的实际 theorem statement： + +| client | selected RA / HOL statement | 数学陈述 | +|---|---|---| +| allocator | G = excl_ra:((((int#int)#bool)excl)ra); source goal: |- forall allocator block. emp ==*=> exists name. own name (Excl ((allocator,block),T)) | 初始化时分配一个 exclusive phase token | +| monotonic counter | G = auth_ra max_nat_ra; |- forall current known. ra_valid G (auth_both current known) <=> known <= current | fragment 保存已知下界；authority 是当前 counter | +| monotonic counter step | |- forall current known. ra_update (auth_ra max_nat_ra) (auth_both current known) (auth_both (mc_counter_step current) (mc_counter_step known)) | authority 与本地 known fragment 同步作 saturating step | +| bit pair | G = auth_ra (prod_ra excl_ra excl_ra) | 两个 exclusive bit 分量由一个 authority 协调，左右 token 是 fragments | +| two modules | T = prod_ra (auth_ra (prod_ra excl_ra excl_ra)) (auth_ra max_nat_ra); |- forall current next known. current <= next ==> ra_update (auth_ra max_nat_ra) (auth_both current known) (auth_both next known) | product 隔离两个协议；counter authority 可单调提升 | +| fractional permissions | |- forall old next. ra_update (frac_ra (agree_ra:((A)agree)ra)) (frac_full (Agree old)) (frac_full (Agree next))（另有 FSL_FRAC_SPLIT_JOIN/VALID_COMBINE/SCALE_OP） | full share 可改写 agreed payload；并支持 split/join、总权重 validity 与 scaling | +| fixed pool | G = auth_ra (gmap_ra excl_ra) | authoritative finite map 管理 pool；属于 client model | +| wand helpers | schemas such as r_entails R (r_sep R P (r_wand R P Q)) Q | 从已安装的 wand adjunction 导出的 theorem constructors | + +这些 client 的不透明 assertion definitions 与程序 triples 应继续留在各自模型 +文档；把它们混进 foundational theorem 表会掩盖通用定理和一次实例化之间的 +边界。 + +## 13. 精确性审计、已知差异与可信边界 + +### 13.1 本文如何核对 “实际 theorem” + +本文 HOL 栏来自当前工作区加载后的 theorem object，而不是只抄注释： + +1. #require 对应 theory implementation； +2. 对每个 public handle 调用 cstr_thm(...)； +3. 由本地 cstarc verify 完整加载； +4. 对核心 aggregate dump 检查 verifier JSON 中 + verification_conditions=[]、axioms=[]； +5. 另以 proof/test/ra_core_regression.c 对根 RA theorem 做 + alpha-equivalence regression。 + +这里的 “axioms=[]” 只断言本次加载的 RA/SL theory 路径没有新增 +axiom，不应误写成“全仓库没有公理”。PROOF extern thm 只是 C +侧 theorem-handle 声明；证明来自被 require 的 implementation。 +new_fun_definition / new_const_definition 与 subtype +type-bijection theorem 是 conservative definitional extension，也不是 +new_axiom。 + +### 13.2 两处需要特别记录的接口差异 + +1. resource_prop.h 对 R_SEP_FRAME_L/R 的一行说明 + 曾把左右放置写反。当前实际 theorem object 是： + + 
+   |- r_entails R P Q ==>
+      r_entails R (r_sep R P frame) (r_sep R Q frame)   [R_SEP_FRAME_L]
+   |- r_entails R P Q ==>
+      r_entails R (r_sep R frame P) (r_sep R frame Q)   [R_SEP_FRAME_R]
+
+ + 本文第 5.3 节按实际 conclusion，而不是按那两行说明命名。 + +2. proof_sl.h 的 update primitive schema 注释列表漏写了 + struct field viewshift_fact。字段实际存在，且 + proof_sl.c 会 exact-check： + + 
+   |- forall guard P Q.
+        (guard ==> viewshift P Q) ==>
+        viewshift (fact guard ** P) (fact guard ** Q)
+
+ + 这与 C_VIEWSHIFT_FACT 的实际 theorem 完全一致；不能根据注释 + 漏项推断 update theory 不需要 fact law。 + +另有旧 proof/docs/SL_PROOF_SPEC.md 仍把 active assertion type +写成 hprop。当前形式化接口以 c_logic.h 和实际 +parser installation 为准：active type abbreviation 是 cprop。 + +### 13.3 直接 trust boundary + +核心 theory/logic 与本文列出的 C-resource theory 均做 +get_all_axioms() 前后审计，未见直接 new_axiom。 +但仓库整体保留显式的可信入口： + +- proof_backward.c 中 CHEAT_TAC 可由 goal 建 axiom； +- proof_symexec.c 为 symbolic-execution bridge 注册若干 + new_axiom 规则。 + +它们不能被描述成由 resource_prop 派生的基础 SL theorem，也不在 +本文 “core aggregate 无新 axiom” 的结论内。 + +## 14. 阅读与使用顺序 + +做精确检查时，建议沿以下顺序： + +1. 先用第 2 节确定 ==、-|-、 + -||-、|-- 与 + ==*=> 分别是哪一层关系； +2. 用第 3–4 节检查 algebra/update 前提，尤其 invalid-source 的 vacuity； +3. 用第 5–7 节检查 assertion connective 与 modality； +4. 用第 8–9 节把 constructor、key 与 hidden frame 条件展开； +5. 在 C proof 中只使用第 10 节的 ghost-only viewshift 改 ghost state； + physical mutation 必须回到 C command semantics； +6. 最后才把第 11 节 surface syntax 反解回对应 HOL head。 + +## 15. 按文件的重要性排序索引 + +本节把同一 theory pair（`.h` 声明、`.c` 定义或证明）中的 public theorem +按阅读和证明使用的重要性排序。这里的等级不是“定理真假强弱”，而是建议的 +阅读顺序： + +| 等级 | 判定标准 | +|---|---| +| **P0 — 语义入口** | 定义定理、完整 characterization、类型/安全边界；理解文件不可跳过 | +| **P1 — 主推理规则** | client proof 和 soundness argument 的主要 algebra、validity、update 或 adjunction 规则 | +| **P2 — 常用派生规则** | 常用 iff、lifting、frame、monotonicity、拆装与 consequence 规则 | +| **P3 — 机械/便利规则** | normalization、单侧投影、构造子区分、特殊 case 与实现支撑 | + +同一等级内部仍按“先语义依赖、后便捷推论”排序。某条定理被放入 P2/P3 +不表示它不可靠或不应使用；只表示首次理解该文件时可以稍后阅读。下列每个 +名字恰对应一个 public `PROOF extern thm` handle。 + +### 15.1 RA core 与构造边界 + +#### ra.{h,c}（58） + +八个基本定义和完整 characterization 优先；monoid/order/update 主规则随后， +最后是交换重写和单侧便利规则。 + +- **P0**： + ra_unit_def → ra_op_def → + ra_valid_def → ra_included_def → + ra_update_nd_def → ra_update_def → + ra_cancellative_def → ra_exclusive_def → + RA_LAWS → RA_EXCLUSIVE_VALID_OP_IFF → + RA_EXCLUSIVE_IFF_INCLUDED → + RA_EXCLUSIVE_UPDATE_ND_IFF → + RA_EXCLUSIVE_UPDATE_IFF +- **P1**： + RA_ASSOC → RA_COMM → + RA_UNIT_L → RA_VALID_UNIT → + RA_VALID_OP_L → RA_UPDATE_APPLY → + RA_UPDATE_ND_APPLY → RA_INCLUDED_REFL → + RA_INCLUDED_TRANS → RA_INCLUDED_UNIT → + RA_INCLUDED_OP_L → RA_INCLUDED_VALID → + RA_INCLUDED_VALID_FRAME → + RA_EXCLUSIVE_INCLUDED → + RA_UPDATE_ND_TRANS → RA_UPDATE_ND_FRAME → + RA_UPDATE_ND_OP → RA_EXCLUSIVE_UPDATE → + RA_UPDATE_INCLUDED → RA_UPDATE_TRANS → + RA_UPDATE_VALID → RA_UPDATE_FRAME → + RA_UPDATE_OP +- **P2**： + RA_CANCELLATIVE_APPLY → + RA_EXCLUSIVE_APPLY → + RA_INCLUDED_OP_MONO_L → + RA_INCLUDED_OP_MONO → + RA_INCLUDED_CANCEL_L → + RA_INVALID_EXCLUSIVE → + RA_UPDATE_ND_SINGLETON → + RA_UPDATE_ND_REFL → RA_UPDATE_ND_MONO → + RA_UPDATE_ND_OF_UPDATE → + RA_UPDATE_ND_VALID → + RA_UPDATE_ND_INVALID → RA_UPDATE_INVALID → + RA_UPDATE_TARGET_INCLUDED +- **P3**： + RA_OP_SWAP_RIGHT → RA_UNIT_R → + RA_VALID_OP_R → RA_VALID_OP → + RA_INCLUDED_OP_R → + RA_INCLUDED_OP_MONO_R → + RA_UPDATE_REFL → RA_UPDATE_UNIT + +#### ra_builder.{h,c}（8） + +这是新 RA 的 lawful-descriptor 构造边界；八条都属于 P0。 + +- **P0**： + ra_laws_def → RA_TYPE_BIJECTION → + RA_REP_LAWS → RA_ABS_REP → + RA_UNIT_ABS → RA_OP_ABS → + RA_VALID_ABS → RA_ABS_ETA +- **P1/P2/P3**：无。 + +#### local_update.{h,c}（14） + +定义与直接消去先行；保持同一 residual 的组合规则高于真空、消去和 +cancellative 特化。 + +- **P0**： + ra_local_update_def → + RA_LOCAL_UPDATE_APPLY +- **P1**： + RA_LOCAL_UPDATE_TRANS → + RA_LOCAL_UPDATE_FRAME → + RA_LOCAL_UPDATE_PRESERVES_INCLUDED → + RA_LOCAL_UPDATE_VALID_INCLUDED → + RA_LOCAL_UPDATE_OP → + RA_LOCAL_UPDATE_ALLOC → + RA_LOCAL_UPDATE_EXCLUSIVE +- **P2**： + RA_LOCAL_UPDATE_REFL → + RA_LOCAL_UPDATE_INVALID → + RA_LOCAL_UPDATE_CANCEL → + RA_LOCAL_UPDATE_CANCEL_UNIT → + RA_LOCAL_UPDATE_CANCELLATIVE +- **P3**：无。 + +### 15.2 基础 RA 构造子 + +#### unit_ra.{h,c}（9） + +唯一 carrier 的计算规则先于“所有 update 都成立”的退化性质。 + +- **P0**： + UNIT_RA_UNIT → UNIT_RA_OP → + UNIT_RA_VALID +- **P1**： + UNIT_RA_UPDATE → UNIT_RA_UPDATE_ND_IFF → + UNIT_RA_LOCAL_UPDATE +- **P2**： + UNIT_RA_INCLUDED → UNIT_RA_EXCLUSIVE → + UNIT_RA_CANCELLATIVE +- **P3**：无。 + +#### prod_ra.{h,c}（22） + +先读 componentwise 表示和完整 iff；再读双侧/单侧 update lifting，最后是 +投影消去与 local-update 便利规则。 + +- **P0**： + PROD_RA_UNIT → PROD_RA_OP → + PROD_RA_VALID → PROD_RA_INCLUDED → + PROD_RA_EXCLUSIVE_IFF → + PROD_RA_CANCELLATIVE_IFF → + PROD_RA_UPDATE_IFF +- **P1**： + PROD_RA_EXCLUSIVE → + PROD_RA_CANCELLATIVE → + PROD_RA_UPDATE_ND → PROD_RA_UPDATE → + PROD_RA_UPDATE_LEFT → + PROD_RA_UPDATE_RIGHT → + PROD_RA_LOCAL_UPDATE +- **P2**： + PROD_RA_EXCLUSIVE_ELIM_LEFT → + PROD_RA_EXCLUSIVE_ELIM_RIGHT → + PROD_RA_UPDATE_ELIM_LEFT → + PROD_RA_UPDATE_ELIM_RIGHT → + PROD_RA_UPDATE_LEFT_ND → + PROD_RA_UPDATE_RIGHT_ND → + PROD_RA_LOCAL_UPDATE_LEFT → + PROD_RA_LOCAL_UPDATE_RIGHT +- **P3**：无。 + +#### option_ra.{h,c}（20） + +NONE 作为新 unit 的语义最高；SOME lifting 随后， +datatype equality 与否定形状最后。 + +- **P0**： + OPTION_RA_UNIT → + OPTION_RA_OP_SOME_SOME → + OPTION_RA_VALID_NONE → + OPTION_RA_VALID_SOME → + OPTION_RA_INCLUDED_SOME_SOME → + OPTION_RA_EXCLUSIVE_SOME_IFF → + OPTION_RA_NOT_CANCELLATIVE → + OPTION_RA_LOCAL_UPDATE_SOME_IFF → + OPTION_RA_UPDATE_IFF → + OPTION_RA_UPDATE_ND_IFF +- **P1**： + OPTION_RA_OP_NONE_L → + OPTION_RA_OP_NONE_R → + OPTION_RA_INCLUDED_NONE → + OPTION_RA_LOCAL_UPDATE_SOME → + OPTION_RA_UPDATE → OPTION_RA_UPDATE_ND +- **P2**： + OPTION_RA_NOT_INCLUDED_SOME_NONE → + OPTION_RA_NOT_EXCLUSIVE_NONE +- **P3**： + OPTION_RA_SOME_INJ → + OPTION_RA_SOME_NE_NONE + +#### excl_ra.{h,c}（22） + +冲突、完整 validity/inclusion/update characterization 是安全边界；构造子 +不等式仅用于机械化简。 + +- **P0**： + EXCL_RA_UNIT → + EXCL_RA_OWNED_CONFLICT → + EXCL_RA_VALID_IFF → + EXCL_RA_INCLUDED_OWNED_IFF → + EXCL_RA_INCLUDED_INVALID_IFF → + EXCL_RA_UPDATE_OWNED_IFF → + EXCL_RA_LOCAL_UPDATE_IFF +- **P1**： + EXCL_RA_VALID_UNIT → + EXCL_RA_VALID_OWNED → EXCL_RA_INVALID → + EXCL_RA_INCLUDED_OWNED → + EXCL_RA_EXCLUSIVE → + EXCL_RA_CANCELLATIVE → EXCL_RA_UPDATE → + EXCL_RA_UPDATE_VALID → + EXCL_RA_LOCAL_UPDATE_VALID +- **P2**： + EXCL_RA_EXCLUSIVE_INVALID → + EXCL_RA_UPDATE_INVALID +- **P3**： + EXCL_RA_OWNED_INJ → + EXCL_RA_OWNED_NE_UNIT → + EXCL_RA_INVALID_NE_UNIT → + EXCL_RA_INVALID_NE_OWNED + +#### excl_ra_internal.{h,c}（5，内部构造接口） + +普通 client 不应依赖本文件；两个 operation 定义是内部 P0，其余仅服务构造 +与 normalization。 + +- **P0**： + excl_owned_op_def → excl_op_def +- **P1/P2**：无。 +- **P3**： + EXCL_RA_OP_FN → EXCL_OWNED_NE_UNIT → + EXCL_INVALID_NE_UNIT + +#### agree_ra.{h,c}（23） + +agreement operation、valid composition 与精确 update 是协议边界；构造子区分 +最后阅读。 + +- **P0**： + AGREE_RA_UNIT → AGREE_RA_OWNED_OP → + AGREE_RA_VALID_COMBINE_IFF → + AGREE_RA_INCLUDED_OWNED → + AGREE_RA_NOT_CANCELLATIVE → + AGREE_RA_UPDATE_IFF → + AGREE_RA_LOCAL_UPDATE_OWNED_IFF +- **P1**： + AGREE_RA_IDEMPOTENT → + AGREE_RA_VALID_UNIT → + AGREE_RA_VALID_OWNED → AGREE_RA_INVALID → + AGREE_RA_INCLUDED_UNIT → + AGREE_RA_AGREEMENT +- **P2**： + AGREE_RA_NOT_INCLUDED_OWNED_UNIT → + AGREE_RA_INCLUDED_OWNED_INVALID → + AGREE_RA_NOT_INCLUDED_INVALID_UNIT → + AGREE_RA_NOT_INCLUDED_INVALID_OWNED → + AGREE_RA_NOT_EXCLUSIVE_OWNED → + AGREE_RA_EXCLUSIVE_INVALID +- **P3**： + AGREE_RA_OWNED_INJ → + AGREE_RA_OWNED_NE_UNIT → + AGREE_RA_INVALID_NE_UNIT → + AGREE_RA_INVALID_NE_OWNED + +#### max_nat_ra.{h,c}（16） + +unit/max/validity、included = <= 与 update/local-update +characterization 定义其单调协议用途；max 化简其次。 + +- **P0**： + MAX_NAT_RA_UNIT → MAX_NAT_RA_OP → + MAX_NAT_RA_VALID → + MAX_NAT_RA_INCLUDED → + MAX_NAT_RA_NOT_EXCLUSIVE → + MAX_NAT_RA_NOT_CANCELLATIVE → + MAX_NAT_RA_LOCAL_UPDATE_UNIT_IFF → + MAX_NAT_RA_UPDATE_ND_IFF +- **P1**： + MAX_NAT_RA_INCLUDED_OP → + MAX_NAT_RA_INCLUDED_MONO_RIGHT → + MAX_NAT_RA_UPDATE → + MAX_NAT_RA_UPDATE_ND +- **P2**： + MAX_NAT_RA_INCLUDED_ZERO → + MAX_NAT_RA_IDEMPOTENT → + MAX_NAT_RA_OP_EQ_RIGHT → + MAX_NAT_RA_OP_EQ_LEFT +- **P3**：无。 + +#### frac_ra.{h,c}（22） + +正权重 operation、validity、inclusion 与 full-update iff 最优先；constructor +injection 和 empty 特例最后。 + +- **P0**： + FRAC_RA_UNIT → FRAC_RA_FULL → + FRAC_RA_OWN_OP → FRAC_RA_VALID_OWN → + FRAC_RA_VALID_FULL → + FRAC_RA_INCLUDED_OWN → + FRAC_RA_INCLUDED_FULL → + FRAC_RA_EXCLUSIVE_FULL → + FRAC_RA_UPDATE_FULL_IFF → + FRAC_RA_UPDATE_FULL_ND_IFF +- **P1**： + FRAC_RA_UPDATE_WEAKEN → + FRAC_RA_UPDATE_FULL → + FRAC_RA_UPDATE_FULL_ND +- **P2**： + FRAC_RA_CANCELLATIVE → + FRAC_RA_UPDATE_WEAKEN_ND +- **P3**： + FRAC_RA_OWN_INJ → + FRAC_RA_OWN_NE_EMPTY → + FRAC_RA_FULL_INJ → + FRAC_RA_FULL_NE_EMPTY → + FRAC_RA_VALID_EMPTY → + FRAC_RA_INCLUDED_EMPTY → + FRAC_RA_NOT_INCLUDED_OWN_EMPTY + +#### auth_ra.{h,c}（55） + +authority/fragment validity、冲突、九种 inclusion case 和完整 update +characterization 是协议安全中心；operation、allocation 和 specialization 随后。 + +- **P0**： + AUTH_RA_UNIT → AUTH_RA_AUTH_EQ_BOTH → + AUTH_RA_VALID_FRAG → + AUTH_RA_VALID_BOTH → + AUTH_RA_VALID_AUTH → + AUTH_RA_VALID_BOTH_FRAME → + AUTH_RA_VALID_AUTH_FRAME → + AUTH_RA_AUTH_CONFLICT → + AUTH_RA_BOTH_CONFLICT → + AUTH_RA_AUTH_BOTH_CONFLICT → + AUTH_RA_INCLUDED_FRAG_FRAG → + AUTH_RA_INCLUDED_FRAG_AUTH → + AUTH_RA_INCLUDED_FRAG_BOTH → + AUTH_RA_INCLUDED_AUTH_FRAG → + AUTH_RA_INCLUDED_AUTH_AUTH → + AUTH_RA_INCLUDED_AUTH_BOTH → + AUTH_RA_INCLUDED_BOTH_FRAG → + AUTH_RA_INCLUDED_BOTH_AUTH → + AUTH_RA_INCLUDED_BOTH_BOTH → + AUTH_RA_CANCELLATIVE_IFF → + AUTH_RA_UPDATE_FRAMEWISE_IFF → + AUTH_RA_UPDATE_ND_FRAMEWISE_IFF → + AUTH_RA_UPDATE_AUTH_IFF +- **P1**： + AUTH_RA_AUTH_FRAG → + AUTH_RA_FRAG_FRAG → + AUTH_RA_BOTH_FRAG → AUTH_RA_BOTH_UNIT → + AUTH_RA_VALID_BOTH_INTRO → + AUTH_RA_VALID_BOTH_ELIM_VALID → + AUTH_RA_VALID_BOTH_ELIM_INCLUDED → + AUTH_RA_VALID_AUTH_FRAG → + AUTH_RA_VALID_BOTH_FRAG → + AUTH_RA_BOTH_EXCLUSIVE → + AUTH_RA_CANCELLATIVE → + AUTH_RA_UPDATE_FRAMEWISE → + AUTH_RA_UPDATE → AUTH_RA_UPDATE_ND → + AUTH_RA_UPDATE_AUTH_INCLUDED → + AUTH_RA_UPDATE_BOTH_INCLUDED → + AUTH_RA_LOCAL_UPDATE → + AUTH_RA_ALLOC_BOTH → AUTH_RA_ALLOC +- **P2**： + AUTH_RA_UPDATE_DROP_FRAG → + AUTH_RA_UPDATE_DROP_AUTH → + AUTH_RA_UPDATE_WEAKEN_FRAG → + AUTH_RA_FRAG_UPDATE_INCLUDED → + AUTH_RA_UPDATE_ALLOC → + AUTH_RA_UPDATE_DEALLOC → + AUTH_RA_UPDATE_AUTH → + AUTH_RA_UPDATE_CANCELLATIVE +- **P3**： + AUTH_RA_FRAG_INJ → AUTH_RA_BOTH_INJ → + AUTH_RA_BOTH_NE_FRAG → + AUTH_RA_AUTH_INJ → + AUTH_RA_AUTH_NE_FRAG + +### 15.3 Resource proposition、update 与 big-sep + +#### resource_prop.{h,c}（60） + +有效性敏感 entailment 与 BI connective 定义先行；主证明规则居中，pointwise、 +equivalence 和 normalization 便利式随后。 + +- **P0**： + r_entails_def → r_equiv_def → + r_sep_def → r_emp_def → + r_wand_def → r_own_def → + r_pure_def → r_fact_def → + r_and_def → r_or_def → + r_impl_def → r_exists_def → + r_forall_def → r_top_def → + r_bottom_def +- **P1**： + R_ENTAILS_REFL → R_ENTAILS_TRANS → + R_EQUIV_INTRO → R_SEP_ASSOC → + R_SEP_COMM → R_SEP_EMP_L → + R_SEP_EMP_R → R_SEP_MONO → + R_SEP_FRAME_L → R_SEP_FRAME_R → + R_WAND_ADJUNCTION → R_IMPL_ADJUNCTION → + R_AND_INTRO → R_AND_ELIM_L → + R_AND_ELIM_R → R_OR_INTRO_L → + R_OR_INTRO_R → R_OR_ELIM → + R_EXISTS_INTRO → R_EXISTS_ELIM → + R_FORALL_INTRO → R_FORALL_ELIM → + R_PURE_AND_INTRO → R_PURE_AND_ELIM → + R_FACT_INTRO → R_FACT_ELIM → + R_FACT_DUP → R_OWN_OP → + R_OWN_VALID +- **P2**： + R_ENTAILS_POINTWISE → + R_EQUIV_POINTWISE → R_EQUIV_REFL → + R_EQUIV_SYM → R_EQUIV_TRANS → + R_SEP_EXISTS_L → R_SEP_EXISTS_R → + R_EXISTS_MONO → + R_FACT_AS_PURE_AND_EMP → + R_FACT_SEP_L → R_FACT_SEP_R → + R_OWN_UNIT → R_SEP_AND_FORWARD_R → + R_SEP_AND_FORWARD_L +- **P3**： + R_FACT_TRUE → R_FACT_FALSE + +#### basic_update.{h,c}（17） + +先界定 generic bupd/viewshift，再读模态闭包、frame 与 ownership bridge； +existential lifting 和独立组合随后。 + +- **P0**： + r_bupd_def → r_viewshift_def +- **P1**： + R_BUPD_INTRO → R_BUPD_MONO → + R_BUPD_FRAME → R_VIEWSHIFT_REFL → + R_ENTAILS_TO_VIEWSHIFT → + R_VIEWSHIFT_TRANS → + R_VIEWSHIFT_MONO → + R_VIEWSHIFT_FRAME → R_OWN_UPDATE → + R_OWN_UPDATE_ND +- **P2**： + R_BUPD_IDEM → R_VIEWSHIFT_SEP → + R_VIEWSHIFT_EXISTS_L → + R_VIEWSHIFT_EXISTS_R → + R_VIEWSHIFT_EXISTS +- **P3**：无。 + +#### big_sep.{h,c}（61） + +五类 binder 定义优先；各容器的递归、拆分、单调和 pointwise-sep 分配是 +主规则；映射/offset 变换与 normalization 特例随后。 + +- **P0**： + r_big_sep_def → r_big_sep_list_def → + r_big_sep_listi_from_def → + r_big_sep_listi_def → + r_big_sep_set_def → + r_big_sep_map_value_def → + r_big_sep_map_def +- **P1**： + R_BIG_SEP_NIL → R_BIG_SEP_CONS → + R_BIG_SEP_APPEND → + R_BIG_SEP_LIST_NIL → + R_BIG_SEP_LIST_CONS → + R_BIG_SEP_LIST_APPEND → + R_BIG_SEP_LIST_MONO → + R_BIG_SEP_LIST_SEP → + R_BIG_SEP_SET_EMPTY → + R_BIG_SEP_SET_INSERT → + R_BIG_SEP_SET_UNION → + R_BIG_SEP_SET_MONO → + R_BIG_SEP_SET_SEP → + R_BIG_SEP_MAP_EMPTY → + R_BIG_SEP_MAP_INSERT → + R_BIG_SEP_MAP_DELETE → + R_BIG_SEP_MAP_MONO → + R_BIG_SEP_MAP_SEP → + R_BIG_SEP_LISTI_NIL → + R_BIG_SEP_LISTI_CONS → + R_BIG_SEP_LISTI_FROM_APPEND → + R_BIG_SEP_LISTI_MONO → + R_BIG_SEP_LISTI_SEP +- **P2**： + R_BIG_SEP_LIST_MONO_ON → + R_BIG_SEP_LIST_EQUIV → + R_BIG_SEP_LIST_EQUIV_ON → + R_BIG_SEP_LIST_MAP → + R_BIG_SEP_SET_EQ → + R_BIG_SEP_SET_EQUIV → + R_BIG_SEP_MAP_EQ → + R_BIG_SEP_MAP_EQUIV → + R_BIG_SEP_LISTI_APPEND → + R_BIG_SEP_LISTI_FROM_MONO → + R_BIG_SEP_LISTI_FROM_EQUIV → + R_BIG_SEP_LISTI_EQUIV → + R_BIG_SEP_LISTI_FROM_SEP +- **P3**： + R_BIG_SEP_SINGLETON → + R_BIG_SEP_SNOC → R_BIG_SEP_REVERSE → + R_BIG_SEP_SWAP_HEAD → + R_BIG_SEP_LIST_SINGLETON → + R_BIG_SEP_LIST_REVERSE → + R_BIG_SEP_LIST_SWAP_HEAD → + R_BIG_SEP_LIST_EMP → + R_BIG_SEP_SET_SINGLETON → + R_BIG_SEP_SET_EMP → + R_BIG_SEP_MAP_VALUE → + R_BIG_SEP_MAP_VALUE_LOOKUP → + R_BIG_SEP_MAP_SINGLETON → + R_BIG_SEP_MAP_EMP → + R_BIG_SEP_LISTI_SINGLETON → + R_BIG_SEP_LISTI_FROM_SHIFT → + R_BIG_SEP_LISTI_CONS_SHIFT → + R_BIG_SEP_LISTI_APPEND_SHIFT + +### 15.4 Finite map 与 map RA + +#### finmap.{h,c}（52） + +有限 support subtype、absence/lookup/domain 是语义入口；外延、读写、分解、 +freshness 与归纳高于裸 representation/support 计算。 + +- **P0**： + finmap_finite_def → + FINMAP_TYPE_BIJECTION → + FINMAP_REP_FINITE → FINMAP_EQ → + finmap_empty_def → finmap_lookup_def → + finmap_singleton_def → finmap_insert_def → + finmap_delete_def → finmap_dom_def +- **P1**： + FINMAP_EQ_LOOKUP → + FINMAP_EMPTY_LOOKUP → + FINMAP_SINGLETON_LOOKUP → + FINMAP_INSERT_LOOKUP → + FINMAP_INSERT_LOOKUP_EQ → + FINMAP_INSERT_LOOKUP_NE → + FINMAP_DELETE_LOOKUP → + FINMAP_DELETE_LOOKUP_EQ → + FINMAP_DELETE_LOOKUP_NE → + FINMAP_INSERT_OVERWRITE → + FINMAP_INSERT_COMM → + FINMAP_DELETE_INSERT → + FINMAP_DELETE_INSERT_NE → + FINMAP_INSERT_DELETE → + FINMAP_DECOMPOSE → + FINMAP_DOM_FINITE → FINMAP_IN_DOM → + FINMAP_IN_DOM_SOME → FINMAP_NOT_IN_DOM → + FINMAP_DOM_INSERT → FINMAP_DOM_DELETE → + FINMAP_FRESH_IN → FINMAP_FRESH_IN_PAIR → + FINMAP_INDUCT +- **P2**： + FINMAP_INSERT_EMPTY → + FINMAP_DELETE_EMPTY → + FINMAP_DELETE_IDEMPOTENT → + FINMAP_DELETE_COMM → FINMAP_INSERT_ID → + FINMAP_DELETE_ID → FINMAP_DOM_EMPTY → + FINMAP_DOM_SINGLETON → + FINMAP_DOM_EQ_EMPTY → FINMAP_FRESH → + FINMAP_FRESH_PAIR +- **P3**： + FINMAP_EMPTY_REP → + FINMAP_SINGLETON_SUPPORT → + FINMAP_SINGLETON_REP → + FINMAP_INSERT_SUPPORT → + FINMAP_INSERT_REP → + FINMAP_DELETE_SUPPORT → + FINMAP_DELETE_REP + +#### gmap_ra.{h,c}（46） + +unit、pointwise operation 与 pointwise validity 是入口；拆分、inclusion、 +at-key update 和最一般 fresh allocation 是主规则；singleton/iff 桥接和 +具体计算随后。 + +- **P0**： + GMAP_RA_UNIT → GMAP_RA_OP_LOOKUP → + GMAP_RA_VALID +- **P1**： + GMAP_RA_DECOMPOSE → + GMAP_RA_OP_SINGLETON_AT → + GMAP_RA_SINGLETON_OP_FRESH → + GMAP_RA_VALID_LOOKUP_DELETE → + GMAP_RA_VALID_INSERT → + GMAP_RA_VALID_LOOKUP → + GMAP_RA_INCLUDED_LOOKUP_IFF → + GMAP_RA_INCLUDED_LOOKUP → + GMAP_RA_INCLUDED_OF_LOOKUP → + GMAP_RA_INCLUDED_LOOKUP_SOME → + GMAP_RA_INCLUDED_DELETE → + GMAP_RA_INCLUDED_DOM → + GMAP_RA_INCLUDED_SINGLETON → + GMAP_RA_LOCAL_UPDATE_AT → + GMAP_RA_UPDATE_INSERT → + GMAP_RA_UPDATE_AT → + GMAP_RA_UPDATE_DELETE → + GMAP_RA_UPDATE_INSERT_ND → + GMAP_RA_UPDATE_AT_ND → + GMAP_RA_ALLOC_STRONG_DEP +- **P2**： + GMAP_RA_SINGLETON_OP_DELETE → + GMAP_RA_VALID_DELETE_SOME → + GMAP_RA_VALID_DELETE → + GMAP_RA_VALID_INSERT_OF_VALID → + GMAP_RA_VALID_INSERT_FRESH → + GMAP_RA_LOCAL_UPDATE_SINGLETON → + GMAP_RA_LOCAL_UPDATE_SINGLETON_IFF → + GMAP_RA_LOCAL_UPDATE_AT_IFF → + GMAP_RA_UPDATE_SINGLETON → + GMAP_RA_UPDATE_SINGLETON_IFF → + GMAP_RA_UPDATE_AT_IFF → + GMAP_RA_UPDATE_SINGLETON_ND → + GMAP_RA_UPDATE_SINGLETON_ND_IFF → + GMAP_RA_UPDATE_AT_ND_IFF → + GMAP_RA_ALLOC_STRONG → GMAP_RA_ALLOC → + GMAP_RA_ALLOC_COFINITE +- **P3**： + GMAP_RA_SINGLETON_OP → + GMAP_RA_OP_INSERT_INSERT → + GMAP_RA_OP_DELETE → GMAP_RA_DOM_OP → + GMAP_RA_VALID_SINGLETON → + GMAP_RA_ALLOC_EMPTY + +### 15.5 Named ghost 与物理内存 + +#### ghost_heap.{h,c}（14） + +finite-map RA 别名、pointwise semantics 和 NONE 与 +SOME unit 的区别先行；update/allocation 随后。 + +- **P0**： + ghost_heap_ra_def → GHOST_HEAP_UNIT → + GHOST_HEAP_OP_LOOKUP → + GHOST_HEAP_VALID → + GHOST_HEAP_SINGLETON_UNIT_NE_EMPTY +- **P1**： + GHOST_HEAP_SINGLETON_OP → + GHOST_HEAP_VALID_SINGLETON → + GHOST_HEAP_UPDATE_SINGLETON → + GHOST_HEAP_UPDATE_SINGLETON_ND → + GHOST_HEAP_DEALLOC → GHOST_HEAP_ALLOC → + GHOST_HEAP_ALLOC_EMPTY +- **P2**： + GHOST_HEAP_FRESH_PAIR → + GHOST_HEAP_FRESH +- **P3**：无。 + +#### ghost_own.{h,c}（4） + +exact singleton ownership 的定义最优先；predicate equality、组合和 validity +observation 随后。 + +- **P0**：ghost_own_def +- **P1**： + GHOST_OWN_AS_R_OWN → GHOST_OWN_OP → + GHOST_OWN_VALID +- **P2/P3**：无。 + +#### ghost_update.{h,c}（4） + +本文件全部是 generic ghost-heap viewshift 的 client-facing 主规则；不承担 C +物理 projection 不变性的安全边界。 + +- **P0**：无。 +- **P1**： + GHOST_OWN_UPDATE → + GHOST_OWN_UPDATE_ND → + GHOST_OWN_ALLOC → + GHOST_OWN_ALLOC_EMPTY +- **P2/P3**：无。 + +#### mem_ra.{h,c}（14） + +physical RA、canonical byte fragments 与 overlap-invalid 是语义/安全入口； +三个 PMEM_UPDATE_* 虽是重要实现引理，却绝不是程序级 viewshift。 + +- **P0**： + mem_ra_def → MEM_RA_UNIT → + MEM_RA_OP_LOOKUP → MEM_RA_VALID → + pmem_singleton_def → pmem_uninit_def → + pmem_byte_def → + PMEM_SINGLETON_OVERLAP_INVALID +- **P1**： + PMEM_UPDATE_UNINIT_BYTE → + PMEM_UPDATE_BYTE_UNINIT → + PMEM_UPDATE_BYTE_BYTE +- **P2**： + PMEM_SINGLETON_VALID → + PMEM_UNINIT_VALID → PMEM_BYTE_VALID +- **P3**：无。 + +pmem_byte_state_type 是 public indtype handle，不是 +thm，所以不计入这 14 条。 + +#### mem_own.{h,c}（3） + +exact physical ownership 是入口，两个 byte-state assertion 是专门化。 + +- **P0**：pmem_own_def +- **P1**： + pmem_byte_at_def → pmem_uninit_at_def +- **P2/P3**：无。 + +### 15.6 C resource 与受限 update + +这一组的最高优先级安全边界是： +c_bupd_def 只更新 SND resource，并始终以原 +FST resource 评价结果；所以 generic +r_viewshift (c_resource_ra G) 不能替代 C viewshift。 + +#### c_resource.{h,c}（11） + +product carrier、componentwise semantics 与两个 exact lift 是 P0；lift 的 +BI-preservation 和 byte specialization 随后。 + +- **P0**： + c_resource_ra_def → + C_RESOURCE_RA_UNIT → + C_RESOURCE_RA_OP → + C_RESOURCE_RA_VALID → c_lift_phys_def → + c_ghost_own_def +- **P1**： + C_LIFT_PHYS_SEP → + C_LIFT_PHYS_ENTAILS → + C_LIFT_PHYS_EMP +- **P2**： + c_pmem_byte_at_def → + c_pmem_uninit_at_def +- **P3**：无。 + +#### c_basic_update.{h,c}（14） + +ghost-only modality/viewshift 的定义绝对优先；linear frame、composition 与 +consequence 是主规则；pure/existential lifting 属于二级结构规则。 + +- **P0**： + c_bupd_def → c_viewshift_def +- **P1**： + C_BUPD_FRAME → C_VIEWSHIFT_FRAME → + C_VIEWSHIFT_TRANS → C_VIEWSHIFT_SEP → + C_BUPD_INTRO +- **P2**： + C_BUPD_MONO → C_BUPD_IDEM → + C_VIEWSHIFT_MONO → + C_ENTAILS_TO_VIEWSHIFT → + C_VIEWSHIFT_REFL → + C_VIEWSHIFT_FACT → + C_VIEWSHIFT_EXISTS +- **P3**：无。 + +#### c_ghost_update.{h,c}（7） + +固定 name update、deallocation 与 allocation 是 C proof 的主 API；ownership +algebra 与 validity observation 是支持规则。 + +- **P0**：无；安全性继承自上一文件的 ghost-only viewshift 定义。 +- **P1**： + C_GHOST_OWN_UPDATE → + C_GHOST_OWN_UPDATE_ND → + C_GHOST_OWN_DEALLOC → + C_GHOST_OWN_ALLOC → + C_GHOST_OWN_ALLOC_EMPTY +- **P2**： + C_GHOST_OWN_OP → + C_GHOST_OWN_VALID +- **P3**：无。 + +### 15.7 Adapter 与 generic proof layer + +#### proof_sl.{h,c}（17 个 runtime-installed theorem globals） + +这些 handle 只有在 sl_install_theory 成功后才发布；它们是当前 +active SL signature 的派生 proof schemas，不是 RA/C 语义定义。 + +- **P0**：无。 +- **P1**： + sl_ent_sym_left → sl_ent_restate → + sl_ent_frame_left → + sl_ent_frame_right → + sl_sep_combine → sl_ac_rule → + sl_undisch +- **P2**： + sl_frame_restate → + sl_ent_subst_frame → + sl_or_elim_frame → sl_disj_mono → + sl_conj1 → sl_conj2 → + sl_exists_elim_frame → sl_exists_wit +- **P3**： + sl_disj1_mono → sl_disj2_mono + +#### 没有 public theorem globals 的相关文件 + +- adapter/ra_sl.{h,c}：0 个 PROOF extern thm； + ra_sl_build 构造按 closed monomorphic RA 专化的 + sl_theory bundle。 +- adapter/ra_sl_scope.{h,c}：0 个；theorem 存在于运行时 + scope struct fields 中，随后被安装，不是独立 extern globals。 +- proof_backward_sl.{h,c}：0 个；提供 generic backward tactics。 + +### 15.8 完整性核对 + +本索引覆盖： + +- 24 个 foundational theory headers 的 576 个 public theorem handles； +- excl_ra_internal.h 的 5 个内部 theorem handles； +- proof_sl.h 的 17 个 runtime-installed theorem globals。 + +合计 **598 条**。每条在本节 P0–P3 列表中恰好出现一次；无 theorem-global +的 adapter/backward 文件也已显式列出，避免把运行时 struct field 误当成 +静态 theorem。 -- Gitee From a76b88539e50a6dcce24f7178c7c108dfa8d9ca5 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Mon, 10 Aug 2026 15:52:01 +0800 Subject: [PATCH 26/35] theory: expand resource algebra library --- test/auth_ra_regression.c | 721 ++++++++ test/auth_ra_structure_regression.c | 250 +++ test/basic_ra_constructors_regression.c | 265 +++ test/gmap_ra_regression.c | 184 ++ test/ra_core_regression.c | 123 ++ test/value_ra_constructors_regression.c | 307 ++++ theory/logic/agree_ra.c | 456 ++++- theory/logic/agree_ra.h | 78 +- theory/logic/auth_ra.c | 2119 ++++++++++++++++++++--- theory/logic/auth_ra.h | 501 +++++- theory/logic/excl_ra.c | 492 +++++- theory/logic/excl_ra.h | 104 +- theory/logic/finmap.c | 38 + theory/logic/finmap.h | 247 ++- theory/logic/frac_ra.c | 602 ++++++- theory/logic/frac_ra.h | 115 ++ theory/logic/gmap_ra.c | 1679 ++++++++++++++++-- theory/logic/gmap_ra.h | 469 ++++- theory/logic/local_update.c | 670 +++++++ theory/logic/local_update.h | 196 +++ theory/logic/max_nat_ra.c | 213 ++- theory/logic/max_nat_ra.h | 52 +- theory/logic/option_ra.c | 643 ++++++- theory/logic/option_ra.h | 90 +- theory/logic/prod_ra.c | 1148 +++++++++++- theory/logic/prod_ra.h | 212 ++- theory/logic/ra.c | 624 ++++++- theory/logic/ra.h | 363 +++- theory/logic/unit_ra.c | 151 +- theory/logic/unit_ra.h | 42 +- 30 files changed, 12438 insertions(+), 716 deletions(-) create mode 100644 test/auth_ra_regression.c create mode 100644 test/auth_ra_structure_regression.c create mode 100644 test/basic_ra_constructors_regression.c create mode 100644 test/ra_core_regression.c create mode 100644 test/value_ra_constructors_regression.c create mode 100644 theory/logic/local_update.c create mode 100644 theory/logic/local_update.h diff --git a/test/auth_ra_regression.c b/test/auth_ra_regression.c new file mode 100644 index 0000000..78a0cfc --- /dev/null +++ b/test/auth_ra_regression.c @@ -0,0 +1,721 @@ +#include "proof/theory/logic/auth_ra.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/auth_ra.c" + +PROOF static void check_auth_theorem( + const thm theorem, + const term expected, + const char *label) { + ENSURE_COND(!IS_NULL(theorem), "%s is empty", label); + ENSURE_COND(vector_size(hyp(theorem)) == 0, + "%s unexpectedly has hypotheses", label); + ENSURE_COND(alpha_compare(concl(theorem), expected) == 0, + "%s has the wrong conclusion", label); + return; +err: + ERR_FUN_PUTS("check_auth_theorem", label); +} + +PROOF static int audit_auth_ra_regressions(void) { + term R = `excl_ra:((num)excl)ra`; + term a = `a:(num)excl`; + term f = `f:(num)excl`; + term b = `b:(num)excl`; + term g = `g:(num)excl`; + term c = `c:(num)excl`; + term h = `h:(num)excl`; + term extra = `extra:(num)excl`; + term external = `external:(num)excl`; + term piece = `piece:(num)excl`; + term common = `common:(num)excl`; + term P = `P:(num)excl->(num)excl->bool`; + term source = `((a:(num)excl),(f:(num)excl))`; + term middle = `((b:(num)excl),(g:(num)excl))`; + term target = `((c:(num)excl),(h:(num)excl))`; + + check_auth_theorem( + ra_local_update_def, + `ra_local_update + (R:(A)ra) + (source:A#A) + (target:A#A) <=> + forall frame:A. + ra_valid R (FST source) ==> + FST source == ra_op R (SND source) frame ==> + ra_valid R (FST target) && + FST target == ra_op R (SND target) frame`, + "ra_local_update_def"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, source, middle, external), + RA_LOCAL_UPDATE_APPLY), + `ra_local_update + (excl_ra:((num)excl)ra) + ((a:(num)excl),(f:(num)excl)) + ((b:(num)excl),(g:(num)excl)) ==> + ra_valid + (excl_ra:((num)excl)ra) + (FST (((a:(num)excl),(f:(num)excl)))) ==> + FST (((a:(num)excl),(f:(num)excl))) == + ra_op + (excl_ra:((num)excl)ra) + (SND (((a:(num)excl),(f:(num)excl)))) + (external:(num)excl) ==> + ra_valid + (excl_ra:((num)excl)ra) + (FST (((b:(num)excl),(g:(num)excl)))) && + FST (((b:(num)excl),(g:(num)excl))) == + ra_op + (excl_ra:((num)excl)ra) + (SND (((b:(num)excl),(g:(num)excl)))) + external`, + "RA_LOCAL_UPDATE_APPLY"); + + check_auth_theorem( + ispecl_rule(TERM_LIST(R, source), RA_LOCAL_UPDATE_REFL), + `ra_local_update + (excl_ra:((num)excl)ra) + ((a:(num)excl),(f:(num)excl)) + ((a:(num)excl),(f:(num)excl))`, + "RA_LOCAL_UPDATE_REFL"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f, b, g), + RA_LOCAL_UPDATE_INVALID), + `~(ra_valid + (excl_ra:((num)excl)ra) + (a:(num)excl)) ==> + ra_local_update + (excl_ra:((num)excl)ra) + ((a:(num)excl),(f:(num)excl)) + ((b:(num)excl),(g:(num)excl))`, + "RA_LOCAL_UPDATE_INVALID"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, source, middle, target), + RA_LOCAL_UPDATE_TRANS), + `ra_local_update + (excl_ra:((num)excl)ra) + ((a:(num)excl),(f:(num)excl)) + ((b:(num)excl),(g:(num)excl)) ==> + ra_local_update + (excl_ra:((num)excl)ra) + ((b:(num)excl),(g:(num)excl)) + ((c:(num)excl),(h:(num)excl)) ==> + ra_local_update + (excl_ra:((num)excl)ra) + ((a:(num)excl),(f:(num)excl)) + ((c:(num)excl),(h:(num)excl))`, + "RA_LOCAL_UPDATE_TRANS"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f, b, g, extra), + RA_LOCAL_UPDATE_FRAME), + `ra_local_update + (excl_ra:((num)excl)ra) + ((a:(num)excl),(f:(num)excl)) + ((b:(num)excl),(g:(num)excl)) ==> + ra_local_update + (excl_ra:((num)excl)ra) + (a,ra_op (excl_ra:((num)excl)ra) f (extra:(num)excl)) + (b,ra_op (excl_ra:((num)excl)ra) g extra)`, + "RA_LOCAL_UPDATE_FRAME"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f, b, g, external), + RA_LOCAL_UPDATE_PRESERVES_INCLUDED), + `ra_local_update + (excl_ra:((num)excl)ra) + ((a:(num)excl),(f:(num)excl)) + ((b:(num)excl),(g:(num)excl)) ==> + ra_valid (excl_ra:((num)excl)ra) a ==> + ra_included + (excl_ra:((num)excl)ra) + (ra_op + (excl_ra:((num)excl)ra) + f + (external:(num)excl)) + a ==> + ra_valid (excl_ra:((num)excl)ra) b && + ra_included + (excl_ra:((num)excl)ra) + (ra_op (excl_ra:((num)excl)ra) g external) + b`, + "RA_LOCAL_UPDATE_PRESERVES_INCLUDED"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f, b, g), + RA_LOCAL_UPDATE_VALID_INCLUDED), + `ra_local_update + (excl_ra:((num)excl)ra) + ((a:(num)excl),(f:(num)excl)) + ((b:(num)excl),(g:(num)excl)) ==> + ra_valid + (excl_ra:((num)excl)ra) + (a:(num)excl) ==> + ra_included + (excl_ra:((num)excl)ra) + (f:(num)excl) + a ==> + ra_valid + (excl_ra:((num)excl)ra) + (b:(num)excl) && + ra_included + (excl_ra:((num)excl)ra) + (g:(num)excl) + b`, + "RA_LOCAL_UPDATE_VALID_INCLUDED"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f, piece), + RA_LOCAL_UPDATE_OP), + `(ra_valid + (excl_ra:((num)excl)ra) + (a:(num)excl) ==> + ra_valid + (excl_ra:((num)excl)ra) + (ra_op + (excl_ra:((num)excl)ra) + a + (piece:(num)excl))) ==> + ra_local_update + (excl_ra:((num)excl)ra) + (a,(f:(num)excl)) + (ra_op (excl_ra:((num)excl)ra) a piece, + ra_op (excl_ra:((num)excl)ra) f piece)`, + "RA_LOCAL_UPDATE_OP"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f, piece), + RA_LOCAL_UPDATE_ALLOC), + `ra_valid + (excl_ra:((num)excl)ra) + (ra_op + (excl_ra:((num)excl)ra) + (a:(num)excl) + (piece:(num)excl)) ==> + ra_local_update + (excl_ra:((num)excl)ra) + (a,(f:(num)excl)) + (ra_op (excl_ra:((num)excl)ra) a piece, + ra_op (excl_ra:((num)excl)ra) f piece)`, + "RA_LOCAL_UPDATE_ALLOC"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f, b), + RA_LOCAL_UPDATE_EXCLUSIVE), + `ra_exclusive + (excl_ra:((num)excl)ra) + (f:(num)excl) ==> + ra_valid + (excl_ra:((num)excl)ra) + (b:(num)excl) ==> + ra_local_update + (excl_ra:((num)excl)ra) + ((a:(num)excl),f) + (b,b)`, + "RA_LOCAL_UPDATE_EXCLUSIVE"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, common, a, f), + RA_LOCAL_UPDATE_CANCEL), + `ra_cancellative (excl_ra:((num)excl)ra) ==> + ra_local_update + (excl_ra:((num)excl)ra) + (ra_op + (excl_ra:((num)excl)ra) + (common:(num)excl) + (a:(num)excl), + ra_op (excl_ra:((num)excl)ra) common (f:(num)excl)) + (a,f)`, + "RA_LOCAL_UPDATE_CANCEL"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, common, a), + RA_LOCAL_UPDATE_CANCEL_UNIT), + `ra_cancellative (excl_ra:((num)excl)ra) ==> + ra_local_update + (excl_ra:((num)excl)ra) + (ra_op + (excl_ra:((num)excl)ra) + (common:(num)excl) + (a:(num)excl), + common) + (a,ra_unit (excl_ra:((num)excl)ra))`, + "RA_LOCAL_UPDATE_CANCEL_UNIT"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, b, common), + RA_LOCAL_UPDATE_CANCELLATIVE), + `ra_cancellative (excl_ra:((num)excl)ra) ==> + ra_valid + (excl_ra:((num)excl)ra) + (ra_op + (excl_ra:((num)excl)ra) + (b:(num)excl) + (common:(num)excl)) ==> + ra_local_update + (excl_ra:((num)excl)ra) + (ra_op (excl_ra:((num)excl)ra) (a:(num)excl) common,a) + (ra_op (excl_ra:((num)excl)ra) b common,b)`, + "RA_LOCAL_UPDATE_CANCELLATIVE"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f, b, g), + AUTH_RA_UPDATE_FRAMEWISE), + `(forall external:(num)excl. + ra_valid (excl_ra:((num)excl)ra) (a:(num)excl) && + ra_included + (excl_ra:((num)excl)ra) + (ra_op + (excl_ra:((num)excl)ra) + (f:(num)excl) + external) + a ==> + ra_valid (excl_ra:((num)excl)ra) (b:(num)excl) && + ra_included + (excl_ra:((num)excl)ra) + (ra_op (excl_ra:((num)excl)ra) (g:(num)excl) external) + b) ==> + ra_update + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl)) + (auth_both (b:(num)excl) (g:(num)excl))`, + "AUTH_RA_UPDATE_FRAMEWISE"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f, b, g), + AUTH_RA_UPDATE), + `ra_local_update + (excl_ra:((num)excl)ra) + ((a:(num)excl),(f:(num)excl)) + ((b:(num)excl),(g:(num)excl)) ==> + ra_update + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl)) + (auth_both (b:(num)excl) (g:(num)excl))`, + "AUTH_RA_UPDATE"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, b, g), + AUTH_RA_UPDATE_ALLOC), + `ra_local_update + (excl_ra:((num)excl)ra) + ((a:(num)excl),ra_unit (excl_ra:((num)excl)ra)) + ((b:(num)excl),(g:(num)excl)) ==> + ra_update + (auth_ra (excl_ra:((num)excl)ra)) + (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) + (auth_both (b:(num)excl) (g:(num)excl))`, + "AUTH_RA_UPDATE_ALLOC"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f, b), + AUTH_RA_UPDATE_DEALLOC), + `ra_local_update + (excl_ra:((num)excl)ra) + ((a:(num)excl),(f:(num)excl)) + ((b:(num)excl),ra_unit (excl_ra:((num)excl)ra)) ==> + ra_update + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl)) + (auth_auth (excl_ra:((num)excl)ra) (b:(num)excl))`, + "AUTH_RA_UPDATE_DEALLOC"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, b, g), + AUTH_RA_UPDATE_AUTH), + `ra_local_update + (excl_ra:((num)excl)ra) + ((a:(num)excl),ra_unit (excl_ra:((num)excl)ra)) + ((b:(num)excl),(g:(num)excl)) ==> + ra_update + (auth_ra (excl_ra:((num)excl)ra)) + (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) + (auth_auth (excl_ra:((num)excl)ra) (b:(num)excl))`, + "AUTH_RA_UPDATE_AUTH"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f, piece), + AUTH_RA_ALLOC_BOTH), + `ra_valid + (excl_ra:((num)excl)ra) + (ra_op + (excl_ra:((num)excl)ra) + (a:(num)excl) + (piece:(num)excl)) ==> + ra_update + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl)) + (auth_both + (ra_op (excl_ra:((num)excl)ra) a piece) + (ra_op (excl_ra:((num)excl)ra) f piece))`, + "AUTH_RA_ALLOC_BOTH"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, b, common), + AUTH_RA_UPDATE_CANCELLATIVE), + `ra_cancellative (excl_ra:((num)excl)ra) ==> + ra_valid + (excl_ra:((num)excl)ra) + (ra_op + (excl_ra:((num)excl)ra) + (b:(num)excl) + (common:(num)excl)) ==> + ra_update + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both + (ra_op (excl_ra:((num)excl)ra) (a:(num)excl) common) + a) + (auth_both + (ra_op (excl_ra:((num)excl)ra) b common) + b)`, + "AUTH_RA_UPDATE_CANCELLATIVE"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f), + AUTH_RA_VALID_BOTH_INTRO), + `ra_valid + (excl_ra:((num)excl)ra) + (a:(num)excl) ==> + ra_included + (excl_ra:((num)excl)ra) + (f:(num)excl) + a ==> + ra_valid + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl))`, + "AUTH_RA_VALID_BOTH_INTRO"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f), + AUTH_RA_VALID_BOTH_ELIM_VALID), + `ra_valid + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl)) ==> + ra_valid + (excl_ra:((num)excl)ra) + (a:(num)excl)`, + "AUTH_RA_VALID_BOTH_ELIM_VALID"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f), + AUTH_RA_VALID_BOTH_ELIM_INCLUDED), + `ra_valid + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl)) ==> + ra_included + (excl_ra:((num)excl)ra) + (f:(num)excl) + (a:(num)excl)`, + "AUTH_RA_VALID_BOTH_ELIM_INCLUDED"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f), + AUTH_RA_VALID_AUTH_FRAG), + `ra_valid + (auth_ra (excl_ra:((num)excl)ra)) + (ra_op + (auth_ra (excl_ra:((num)excl)ra)) + (auth_auth + (excl_ra:((num)excl)ra) + (a:(num)excl)) + (auth_frag (f:(num)excl))) <=> + ra_valid + (excl_ra:((num)excl)ra) + (a:(num)excl) && + ra_included + (excl_ra:((num)excl)ra) + (f:(num)excl) + a`, + "AUTH_RA_VALID_AUTH_FRAG"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f, g), + AUTH_RA_VALID_BOTH_FRAG), + `ra_valid + (auth_ra (excl_ra:((num)excl)ra)) + (ra_op + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl)) + (auth_frag (g:(num)excl))) <=> + ra_valid + (excl_ra:((num)excl)ra) + (a:(num)excl) && + ra_included + (excl_ra:((num)excl)ra) + (ra_op + (excl_ra:((num)excl)ra) + (f:(num)excl) + (g:(num)excl)) + a`, + "AUTH_RA_VALID_BOTH_FRAG"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, b, g), + AUTH_RA_AUTH_BOTH_CONFLICT), + `~(ra_valid + (auth_ra (excl_ra:((num)excl)ra)) + (ra_op + (auth_ra (excl_ra:((num)excl)ra)) + (auth_auth + (excl_ra:((num)excl)ra) + (a:(num)excl)) + (auth_both (b:(num)excl) (g:(num)excl))))`, + "AUTH_RA_AUTH_BOTH_CONFLICT"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f), + AUTH_RA_BOTH_EXCLUSIVE), + `ra_exclusive + (excl_ra:((num)excl)ra) + (f:(num)excl) ==> + ra_exclusive + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl))`, + "AUTH_RA_BOTH_EXCLUSIVE"); + + check_auth_theorem( + ispec_rule(R, AUTH_RA_CANCELLATIVE_IFF), + `ra_cancellative + (auth_ra (excl_ra:((num)excl)ra)) <=> + ra_cancellative (excl_ra:((num)excl)ra)`, + "AUTH_RA_CANCELLATIVE_IFF"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f, b, g), + AUTH_RA_UPDATE_FRAMEWISE_IFF), + `ra_update + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl)) + (auth_both (b:(num)excl) (g:(num)excl)) <=> + forall external:(num)excl. + ra_valid + (excl_ra:((num)excl)ra) + (a:(num)excl) && + ra_included + (excl_ra:((num)excl)ra) + (ra_op + (excl_ra:((num)excl)ra) + (f:(num)excl) + external) + a ==> + ra_valid + (excl_ra:((num)excl)ra) + (b:(num)excl) && + ra_included + (excl_ra:((num)excl)ra) + (ra_op + (excl_ra:((num)excl)ra) + (g:(num)excl) + external) + b`, + "AUTH_RA_UPDATE_FRAMEWISE_IFF"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f, P), + AUTH_RA_UPDATE_ND_FRAMEWISE_IFF), + `ra_update_nd + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl)) + (\candidate:((num)excl)excl#(num)excl. + exists (b:(num)excl) (g:(num)excl). + (P:(num)excl->(num)excl->bool) b g && + candidate == auth_both b g) <=> + forall external:(num)excl. + ra_valid + (excl_ra:((num)excl)ra) + (a:(num)excl) && + ra_included + (excl_ra:((num)excl)ra) + (ra_op + (excl_ra:((num)excl)ra) + (f:(num)excl) + external) + a ==> + exists (b:(num)excl) (g:(num)excl). + P b g && + ra_valid + (excl_ra:((num)excl)ra) + b && + ra_included + (excl_ra:((num)excl)ra) + (ra_op + (excl_ra:((num)excl)ra) + g + external) + b`, + "AUTH_RA_UPDATE_ND_FRAMEWISE_IFF"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, b), + AUTH_RA_UPDATE_AUTH_IFF), + `ra_update + (auth_ra (excl_ra:((num)excl)ra)) + (auth_auth + (excl_ra:((num)excl)ra) + (a:(num)excl)) + (auth_auth + (excl_ra:((num)excl)ra) + (b:(num)excl)) <=> + (ra_valid + (excl_ra:((num)excl)ra) + (a:(num)excl) ==> + ra_valid + (excl_ra:((num)excl)ra) + (b:(num)excl) && + ra_included + (excl_ra:((num)excl)ra) + a + b)`, + "AUTH_RA_UPDATE_AUTH_IFF"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, b), + AUTH_RA_UPDATE_AUTH_INCLUDED), + `ra_valid + (excl_ra:((num)excl)ra) + (b:(num)excl) ==> + ra_included + (excl_ra:((num)excl)ra) + (a:(num)excl) + b ==> + ra_update + (auth_ra (excl_ra:((num)excl)ra)) + (auth_auth + (excl_ra:((num)excl)ra) + a) + (auth_auth + (excl_ra:((num)excl)ra) + b)`, + "AUTH_RA_UPDATE_AUTH_INCLUDED"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f), + AUTH_RA_UPDATE_DROP_FRAG), + `ra_update + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl)) + (auth_auth + (excl_ra:((num)excl)ra) + a)`, + "AUTH_RA_UPDATE_DROP_FRAG"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f), + AUTH_RA_UPDATE_DROP_AUTH), + `ra_update + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl)) + (auth_frag (f:(num)excl))`, + "AUTH_RA_UPDATE_DROP_AUTH"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f, g), + AUTH_RA_UPDATE_WEAKEN_FRAG), + `ra_included + (excl_ra:((num)excl)ra) + (g:(num)excl) + (f:(num)excl) ==> + ra_update + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) f) + (auth_both a g)`, + "AUTH_RA_UPDATE_WEAKEN_FRAG"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, f, g), + AUTH_RA_FRAG_UPDATE_INCLUDED), + `ra_included + (excl_ra:((num)excl)ra) + (g:(num)excl) + (f:(num)excl) ==> + ra_update + (auth_ra (excl_ra:((num)excl)ra)) + (auth_frag (f:(num)excl)) + (auth_frag g)`, + "AUTH_RA_FRAG_UPDATE_INCLUDED"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, b, f), + AUTH_RA_UPDATE_BOTH_INCLUDED), + `ra_valid + (excl_ra:((num)excl)ra) + (b:(num)excl) ==> + ra_included + (excl_ra:((num)excl)ra) + (a:(num)excl) + b ==> + ra_update + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both a (f:(num)excl)) + (auth_both b f)`, + "AUTH_RA_UPDATE_BOTH_INCLUDED"); + + check_auth_theorem( + ispecl_rule( + TERM_LIST(R, a, f, g, b, c, h), + AUTH_RA_LOCAL_UPDATE), + `ra_local_update + (excl_ra:((num)excl)ra) + ((f:(num)excl),(g:(num)excl)) + ((c:(num)excl),(h:(num)excl)) ==> + ra_included + (excl_ra:((num)excl)ra) + c + (b:(num)excl) ==> + ra_valid + (excl_ra:((num)excl)ra) + b ==> + ra_local_update + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) f, + auth_both a g) + (auth_both b c, + auth_both b h)`, + "AUTH_RA_LOCAL_UPDATE"); + + return 0; +err: + ERR_FUN_PUTS("audit_auth_ra_regressions"); + return -1; +} + +PROOF static int _AUTH_RA_REGRESSION = audit_auth_ra_regressions(); diff --git a/test/auth_ra_structure_regression.c b/test/auth_ra_structure_regression.c new file mode 100644 index 0000000..1da81fa --- /dev/null +++ b/test/auth_ra_structure_regression.c @@ -0,0 +1,250 @@ +#include "proof/theory/logic/auth_ra.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/auth_ra.c" + +/* Public-interface regression coverage for the constructor-level structure + * of auth_ra. In addition to checking the exact specialized conclusion, the + * common checker rejects leaked proof hypotheses. */ +PROOF static void check_auth_structure_theorem( + const thm theorem, + const term expected, + const char *label) { + ENSURE_COND(!IS_NULL(theorem), "%s is empty", label); + ENSURE_COND(vector_size(hyp(theorem)) == 0, + "%s unexpectedly has hypotheses", label); + ENSURE_COND(alpha_compare(concl(theorem), expected) == 0, + "%s has the wrong conclusion", label); + return; +err: + ERR_FUN_PUTS("check_auth_structure_theorem", label); +} + +PROOF static int audit_auth_ra_structure_regressions(void) { + term R = `excl_ra:((num)excl)ra`; + term a = `a:(num)excl`; + term f = `f:(num)excl`; + term b = `b:(num)excl`; + term g = `g:(num)excl`; + term frame = `frame:((num)excl)excl#(num)excl`; + + /* Constructor equality and distinction. */ + check_auth_structure_theorem( + ispecl_rule(TERM_LIST(f, g), AUTH_RA_FRAG_INJ), + `((auth_frag (f:(num)excl)):((num)excl)excl#(num)excl) == + auth_frag (g:(num)excl) <=> + f == g`, + "AUTH_RA_FRAG_INJ"); + + check_auth_structure_theorem( + ispecl_rule(TERM_LIST(a, f, b, g), AUTH_RA_BOTH_INJ), + `((auth_both (a:(num)excl) (f:(num)excl)): + ((num)excl)excl#(num)excl) == + auth_both (b:(num)excl) (g:(num)excl) <=> + a == b && f == g`, + "AUTH_RA_BOTH_INJ"); + + check_auth_structure_theorem( + ispecl_rule(TERM_LIST(a, f, g), AUTH_RA_BOTH_NE_FRAG), + `~(((auth_both (a:(num)excl) (f:(num)excl)): + ((num)excl)excl#(num)excl) == + auth_frag (g:(num)excl))`, + "AUTH_RA_BOTH_NE_FRAG"); + + check_auth_structure_theorem( + ispecl_rule(TERM_LIST(R, a, b), AUTH_RA_AUTH_INJ), + `auth_auth (excl_ra:((num)excl)ra) (a:(num)excl) == + auth_auth (excl_ra:((num)excl)ra) (b:(num)excl) <=> + a == b`, + "AUTH_RA_AUTH_INJ"); + + check_auth_structure_theorem( + ispecl_rule(TERM_LIST(R, a, f), AUTH_RA_AUTH_NE_FRAG), + `~(auth_auth (excl_ra:((num)excl)ra) (a:(num)excl) == + auth_frag (f:(num)excl))`, + "AUTH_RA_AUTH_NE_FRAG"); + + check_auth_structure_theorem( + ispecl_rule(TERM_LIST(R, a, b, f), AUTH_RA_AUTH_EQ_BOTH), + `auth_auth (excl_ra:((num)excl)ra) (a:(num)excl) == + auth_both (b:(num)excl) (f:(num)excl) <=> + a == b && f == ra_unit (excl_ra:((num)excl)ra)`, + "AUTH_RA_AUTH_EQ_BOTH"); + + /* The public frame characterizations used by update clients. */ + check_auth_structure_theorem( + ispecl_rule( + TERM_LIST(R, a, f, frame), + AUTH_RA_VALID_BOTH_FRAME), + `ra_valid + (auth_ra (excl_ra:((num)excl)ra)) + (ra_op + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl)) + (frame:((num)excl)excl#(num)excl)) <=> + exists external:(num)excl. + frame == auth_frag external && + ra_valid (excl_ra:((num)excl)ra) a && + ra_included + (excl_ra:((num)excl)ra) + (ra_op (excl_ra:((num)excl)ra) f external) + a`, + "AUTH_RA_VALID_BOTH_FRAME"); + + check_auth_structure_theorem( + ispecl_rule( + TERM_LIST(R, a, frame), + AUTH_RA_VALID_AUTH_FRAME), + `ra_valid + (auth_ra (excl_ra:((num)excl)ra)) + (ra_op + (auth_ra (excl_ra:((num)excl)ra)) + (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) + (frame:((num)excl)excl#(num)excl)) <=> + exists external:(num)excl. + frame == auth_frag external && + ra_valid (excl_ra:((num)excl)ra) a && + ra_included (excl_ra:((num)excl)ra) external a`, + "AUTH_RA_VALID_AUTH_FRAME"); + + /* All nine source/target constructor forms for inclusion. */ + check_auth_structure_theorem( + ispecl_rule( + TERM_LIST(R, f, g), + AUTH_RA_INCLUDED_FRAG_FRAG), + `ra_included + (auth_ra (excl_ra:((num)excl)ra)) + (auth_frag (f:(num)excl)) + (auth_frag (g:(num)excl)) <=> + ra_included (excl_ra:((num)excl)ra) f g`, + "AUTH_RA_INCLUDED_FRAG_FRAG"); + + check_auth_structure_theorem( + ispecl_rule( + TERM_LIST(R, f, a), + AUTH_RA_INCLUDED_FRAG_AUTH), + `ra_included + (auth_ra (excl_ra:((num)excl)ra)) + (auth_frag (f:(num)excl)) + (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) <=> + ra_included + (excl_ra:((num)excl)ra) + f + (ra_unit (excl_ra:((num)excl)ra))`, + "AUTH_RA_INCLUDED_FRAG_AUTH"); + + check_auth_structure_theorem( + ispecl_rule( + TERM_LIST(R, f, a, g), + AUTH_RA_INCLUDED_FRAG_BOTH), + `ra_included + (auth_ra (excl_ra:((num)excl)ra)) + (auth_frag (f:(num)excl)) + (auth_both (a:(num)excl) (g:(num)excl)) <=> + ra_included (excl_ra:((num)excl)ra) f g`, + "AUTH_RA_INCLUDED_FRAG_BOTH"); + + check_auth_structure_theorem( + ispecl_rule( + TERM_LIST(R, a, g), + AUTH_RA_INCLUDED_AUTH_FRAG), + `~(ra_included + (auth_ra (excl_ra:((num)excl)ra)) + (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) + (auth_frag (g:(num)excl)))`, + "AUTH_RA_INCLUDED_AUTH_FRAG"); + + check_auth_structure_theorem( + ispecl_rule( + TERM_LIST(R, a, b), + AUTH_RA_INCLUDED_AUTH_AUTH), + `ra_included + (auth_ra (excl_ra:((num)excl)ra)) + (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) + (auth_auth (excl_ra:((num)excl)ra) (b:(num)excl)) <=> + a == b`, + "AUTH_RA_INCLUDED_AUTH_AUTH"); + + check_auth_structure_theorem( + ispecl_rule( + TERM_LIST(R, a, b, g), + AUTH_RA_INCLUDED_AUTH_BOTH), + `ra_included + (auth_ra (excl_ra:((num)excl)ra)) + (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) + (auth_both (b:(num)excl) (g:(num)excl)) <=> + a == b`, + "AUTH_RA_INCLUDED_AUTH_BOTH"); + + check_auth_structure_theorem( + ispecl_rule( + TERM_LIST(R, a, f, g), + AUTH_RA_INCLUDED_BOTH_FRAG), + `~(ra_included + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl)) + (auth_frag (g:(num)excl)))`, + "AUTH_RA_INCLUDED_BOTH_FRAG"); + + check_auth_structure_theorem( + ispecl_rule( + TERM_LIST(R, a, f, b), + AUTH_RA_INCLUDED_BOTH_AUTH), + `ra_included + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl)) + (auth_auth (excl_ra:((num)excl)ra) (b:(num)excl)) <=> + a == b && + ra_included + (excl_ra:((num)excl)ra) + f + (ra_unit (excl_ra:((num)excl)ra))`, + "AUTH_RA_INCLUDED_BOTH_AUTH"); + + check_auth_structure_theorem( + ispecl_rule( + TERM_LIST(R, a, f, b, g), + AUTH_RA_INCLUDED_BOTH_BOTH), + `ra_included + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl)) + (auth_both (b:(num)excl) (g:(num)excl)) <=> + a == b && ra_included (excl_ra:((num)excl)ra) f g`, + "AUTH_RA_INCLUDED_BOTH_BOTH"); + + /* Existing public constructor validity remains stable alongside the new + * frame rules. */ + check_auth_structure_theorem( + ispecl_rule(TERM_LIST(R, a), AUTH_RA_VALID_AUTH), + `ra_valid + (auth_ra (excl_ra:((num)excl)ra)) + (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) <=> + ra_valid (excl_ra:((num)excl)ra) a`, + "AUTH_RA_VALID_AUTH"); + + check_auth_structure_theorem( + ispecl_rule(TERM_LIST(R, f), AUTH_RA_VALID_FRAG), + `ra_valid + (auth_ra (excl_ra:((num)excl)ra)) + (auth_frag (f:(num)excl)) <=> + ra_valid (excl_ra:((num)excl)ra) f`, + "AUTH_RA_VALID_FRAG"); + + check_auth_structure_theorem( + ispecl_rule(TERM_LIST(R, a, f), AUTH_RA_VALID_BOTH), + `ra_valid + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl)) <=> + ra_valid (excl_ra:((num)excl)ra) a && + ra_included (excl_ra:((num)excl)ra) f a`, + "AUTH_RA_VALID_BOTH"); + + return 0; +err: + ERR_FUN_PUTS("audit_auth_ra_structure_regressions"); + return -1; +} + +PROOF static int _AUTH_RA_STRUCTURE_REGRESSION = + audit_auth_ra_structure_regressions(); diff --git a/test/basic_ra_constructors_regression.c b/test/basic_ra_constructors_regression.c new file mode 100644 index 0000000..ee01a96 --- /dev/null +++ b/test/basic_ra_constructors_regression.c @@ -0,0 +1,265 @@ +#include "proof/theory/logic/excl_ra.h" +#include "proof/theory/logic/prod_ra.h" +#include "proof/theory/logic/unit_ra.h" + +#require "proof/theory/logic/excl_ra.c" +#require "proof/theory/logic/prod_ra.c" +#require "proof/theory/logic/unit_ra.c" + +/* Exact public-interface regression for the three foundational RA + * constructors. Each check also rejects empty theorems and leaked proof + * hypotheses, so weakening a contract cannot silently pass this test. */ +PROOF static void check_basic_ra_theorem( + const thm theorem, + const term expected, + const char *label) { + ENSURE_COND(!IS_NULL(theorem), "%s is empty", label); + ENSURE_COND(vector_size(hyp(theorem)) == 0, + "%s unexpectedly has hypotheses", label); + ENSURE_COND(alpha_compare(concl(theorem), expected) == 0, + "%s has the wrong conclusion", label); + return; +err: + ERR_FUN_PUTS("check_basic_ra_theorem", label); +} + +PROOF static int audit_basic_ra_constructor_regressions(void) { + /* Unit RA: complete order and update behavior. */ + check_basic_ra_theorem( + UNIT_RA_INCLUDED, + `forall a b:1. ra_included unit_ra a b`, + "UNIT_RA_INCLUDED"); + check_basic_ra_theorem( + UNIT_RA_UPDATE, + `forall a b:1. ra_update unit_ra a b`, + "UNIT_RA_UPDATE"); + check_basic_ra_theorem( + UNIT_RA_UPDATE_ND_IFF, + `forall (a:1) (P:1->bool). + ra_update_nd unit_ra a P <=> P one`, + "UNIT_RA_UPDATE_ND_IFF"); + check_basic_ra_theorem( + UNIT_RA_LOCAL_UPDATE, + `forall source target:1#1. + ra_local_update unit_ra source target`, + "UNIT_RA_LOCAL_UPDATE"); + + term a = `a:num`; + term b = `b:num`; + term x = `x:(num)excl`; + + /* Exclusive RA: constructors, validity, inclusion, and exact updates. */ + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(a, b), EXCL_RA_OWNED_INJ), + `((Excl (a:num):(num)excl) == Excl (b:num)) <=> a == b`, + "EXCL_RA_OWNED_INJ"); + check_basic_ra_theorem( + ispec_rule(a, EXCL_RA_OWNED_NE_UNIT), + `~((Excl (a:num):(num)excl) == ExclUnit)`, + "EXCL_RA_OWNED_NE_UNIT"); + check_basic_ra_theorem( + EXCL_RA_INVALID_NE_UNIT, + `~((ExclInvalid:(A)excl) == ExclUnit)`, + "EXCL_RA_INVALID_NE_UNIT"); + check_basic_ra_theorem( + ispec_rule(a, EXCL_RA_INVALID_NE_OWNED), + `~((ExclInvalid:(num)excl) == Excl (a:num))`, + "EXCL_RA_INVALID_NE_OWNED"); + check_basic_ra_theorem( + ispec_rule(x, EXCL_RA_VALID_IFF), + `ra_valid (excl_ra:((num)excl)ra) (x:(num)excl) <=> + ~(x == ExclInvalid)`, + "EXCL_RA_VALID_IFF"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(a, x), EXCL_RA_INCLUDED_OWNED_IFF), + `ra_included + (excl_ra:((num)excl)ra) + (Excl (a:num)) + (x:(num)excl) <=> + x == Excl a \/ x == ExclInvalid`, + "EXCL_RA_INCLUDED_OWNED_IFF"); + check_basic_ra_theorem( + ispec_rule(x, EXCL_RA_INCLUDED_INVALID_IFF), + `ra_included + (excl_ra:((num)excl)ra) + ExclInvalid + (x:(num)excl) <=> + x == ExclInvalid`, + "EXCL_RA_INCLUDED_INVALID_IFF"); + check_basic_ra_theorem( + EXCL_RA_EXCLUSIVE_INVALID, + `ra_exclusive + (excl_ra:((A)excl)ra) + (ExclInvalid:(A)excl)`, + "EXCL_RA_EXCLUSIVE_INVALID"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(a, x), EXCL_RA_UPDATE_VALID), + `ra_valid (excl_ra:((num)excl)ra) (x:(num)excl) ==> + ra_update excl_ra (Excl (a:num)) x`, + "EXCL_RA_UPDATE_VALID"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(a, x), EXCL_RA_UPDATE_OWNED_IFF), + `ra_update + (excl_ra:((num)excl)ra) + (Excl (a:num)) + (x:(num)excl) <=> + ra_valid excl_ra x`, + "EXCL_RA_UPDATE_OWNED_IFF"); + check_basic_ra_theorem( + ispec_rule(x, EXCL_RA_UPDATE_INVALID), + `ra_update + (excl_ra:((num)excl)ra) + ExclInvalid + (x:(num)excl)`, + "EXCL_RA_UPDATE_INVALID"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(a, x), EXCL_RA_LOCAL_UPDATE_VALID), + `ra_valid (excl_ra:((num)excl)ra) (x:(num)excl) ==> + ra_local_update + excl_ra + (Excl (a:num),Excl a) + (x,x)`, + "EXCL_RA_LOCAL_UPDATE_VALID"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(a, x), EXCL_RA_LOCAL_UPDATE_IFF), + `ra_local_update + (excl_ra:((num)excl)ra) + (Excl (a:num),Excl a) + ((x:(num)excl),x) <=> + ra_valid excl_ra x`, + "EXCL_RA_LOCAL_UPDATE_IFF"); + + term R1 = `unit_ra`; + term R2 = `excl_ra:((num)excl)ra`; + term p = `p:1#(num)excl`; + term a1 = `a1:1`; + term b1 = `b1:1`; + term a2 = `a2:(num)excl`; + term b2 = `b2:(num)excl`; + term f1 = `f1:1`; + term g1 = `g1:1`; + term f2 = `f2:(num)excl`; + term g2 = `g2:(num)excl`; + + /* Product exclusivity and optional laws. */ + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(R1, R2, p), PROD_RA_EXCLUSIVE), + `ra_exclusive unit_ra (FST (p:1#(num)excl)) ==> + ra_exclusive (excl_ra:((num)excl)ra) (SND p) ==> + ra_exclusive (prod_ra unit_ra excl_ra) p`, + "PROD_RA_EXCLUSIVE"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(R1, R2, p), PROD_RA_EXCLUSIVE_ELIM_LEFT), + `ra_valid (prod_ra unit_ra (excl_ra:((num)excl)ra)) + (p:1#(num)excl) ==> + ra_exclusive (prod_ra unit_ra excl_ra) p ==> + ra_exclusive unit_ra (FST p)`, + "PROD_RA_EXCLUSIVE_ELIM_LEFT"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(R1, R2, p), PROD_RA_EXCLUSIVE_ELIM_RIGHT), + `ra_valid (prod_ra unit_ra (excl_ra:((num)excl)ra)) + (p:1#(num)excl) ==> + ra_exclusive (prod_ra unit_ra excl_ra) p ==> + ra_exclusive excl_ra (SND p)`, + "PROD_RA_EXCLUSIVE_ELIM_RIGHT"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(R1, R2, p), PROD_RA_EXCLUSIVE_IFF), + `ra_valid (prod_ra unit_ra (excl_ra:((num)excl)ra)) + (p:1#(num)excl) ==> + (ra_exclusive (prod_ra unit_ra excl_ra) p <=> + ra_exclusive unit_ra (FST p) && + ra_exclusive excl_ra (SND p))`, + "PROD_RA_EXCLUSIVE_IFF"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(R1, R2), PROD_RA_CANCELLATIVE_IFF), + `ra_cancellative + (prod_ra unit_ra (excl_ra:((num)excl)ra)) <=> + ra_cancellative unit_ra && + ra_cancellative (excl_ra:((num)excl)ra)`, + "PROD_RA_CANCELLATIVE_IFF"); + + /* Product deterministic update projections and exact characterization. */ + check_basic_ra_theorem( + ispecl_rule( + TERM_LIST(R1, R2, a1, a2, b1, b2), + PROD_RA_UPDATE_ELIM_LEFT), + `ra_update + (prod_ra unit_ra (excl_ra:((num)excl)ra)) + ((a1:1),(a2:(num)excl)) + ((b1:1),(b2:(num)excl)) ==> + ra_valid excl_ra a2 ==> + ra_update unit_ra a1 b1`, + "PROD_RA_UPDATE_ELIM_LEFT"); + check_basic_ra_theorem( + ispecl_rule( + TERM_LIST(R1, R2, a1, a2, b1, b2), + PROD_RA_UPDATE_ELIM_RIGHT), + `ra_update + (prod_ra unit_ra (excl_ra:((num)excl)ra)) + ((a1:1),(a2:(num)excl)) + ((b1:1),(b2:(num)excl)) ==> + ra_valid unit_ra a1 ==> + ra_update excl_ra a2 b2`, + "PROD_RA_UPDATE_ELIM_RIGHT"); + check_basic_ra_theorem( + ispecl_rule( + TERM_LIST(R1, R2, a1, a2, b1, b2), + PROD_RA_UPDATE_IFF), + `ra_valid unit_ra (a1:1) ==> + ra_valid (excl_ra:((num)excl)ra) (a2:(num)excl) ==> + (ra_update + (prod_ra unit_ra excl_ra) + (a1,a2) + ((b1:1),(b2:(num)excl)) <=> + ra_update unit_ra a1 b1 && ra_update excl_ra a2 b2)`, + "PROD_RA_UPDATE_IFF"); + + /* Product local-update lifting, including both one-sided forms. */ + check_basic_ra_theorem( + ispecl_rule( + TERM_LIST( + R1, R2, + a1, f1, b1, g1, + a2, f2, b2, g2), + PROD_RA_LOCAL_UPDATE), + `ra_local_update unit_ra ((a1:1),(f1:1)) ((b1:1),(g1:1)) ==> + ra_local_update + (excl_ra:((num)excl)ra) + ((a2:(num)excl),(f2:(num)excl)) + ((b2:(num)excl),(g2:(num)excl)) ==> + ra_local_update + (prod_ra unit_ra excl_ra) + ((a1,a2),(f1,f2)) + ((b1,b2),(g1,g2))`, + "PROD_RA_LOCAL_UPDATE"); + check_basic_ra_theorem( + ispecl_rule( + TERM_LIST(R1, R2, a1, f1, b1, g1, a2, f2), + PROD_RA_LOCAL_UPDATE_LEFT), + `ra_local_update unit_ra ((a1:1),(f1:1)) ((b1:1),(g1:1)) ==> + ra_local_update + (prod_ra unit_ra (excl_ra:((num)excl)ra)) + ((a1,(a2:(num)excl)),(f1,(f2:(num)excl))) + ((b1,a2),(g1,f2))`, + "PROD_RA_LOCAL_UPDATE_LEFT"); + check_basic_ra_theorem( + ispecl_rule( + TERM_LIST(R1, R2, a1, f1, a2, f2, b2, g2), + PROD_RA_LOCAL_UPDATE_RIGHT), + `ra_local_update + (excl_ra:((num)excl)ra) + ((a2:(num)excl),(f2:(num)excl)) + ((b2:(num)excl),(g2:(num)excl)) ==> + ra_local_update + (prod_ra unit_ra excl_ra) + (((a1:1),a2),((f1:1),f2)) + ((a1,b2),(f1,g2))`, + "PROD_RA_LOCAL_UPDATE_RIGHT"); + return 0; +err: + ERR_FUN_PUTS("audit_basic_ra_constructor_regressions"); + return -1; +} + +PROOF static int _BASIC_RA_CONSTRUCTORS_REGRESSION = + audit_basic_ra_constructor_regressions(); diff --git a/test/gmap_ra_regression.c b/test/gmap_ra_regression.c index 4c4b669..461225b 100644 --- a/test/gmap_ra_regression.c +++ b/test/gmap_ra_regression.c @@ -142,8 +142,11 @@ PROOF static thm prove_gmap_invalid_old_entry_regression(void) { PROOF static int audit_gmap_regressions(void) { term R = `excl_ra:((num)excl)ra`; term key = `key:num`; + term other = `other:num`; term a = `a:(num)excl`; + term f = `f:(num)excl`; term b = `b:(num)excl`; + term g = `g:(num)excl`; term m = `m:(num,(num)excl)finmap`; term n = `n:(num,(num)excl)finmap`; term P = `P:(num)excl->bool`; @@ -166,6 +169,51 @@ PROOF static int audit_gmap_regressions(void) { fresh == NONE`, "FINMAP_FRESH_IN_PAIR"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(other, key, a, m), + FINMAP_DELETE_INSERT_NE), + `~((other:num) == (key:num)) ==> + finmap_delete + other + (finmap_insert + key + (a:(num)excl) + (m:(num,(num)excl)finmap)) == + finmap_insert key a (finmap_delete other m)`, + "FINMAP_DELETE_INSERT_NE"); + + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, key, a, m), + GMAP_RA_SINGLETON_OP_DELETE), + `ra_op + (gmap_ra (excl_ra:((num)excl)ra)) + (finmap_singleton (key:num) (a:(num)excl)) + (finmap_delete key (m:(num,(num)excl)finmap)) == + finmap_insert key a m`, + "GMAP_RA_SINGLETON_OP_DELETE"); + + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, key, a, f, m), + GMAP_RA_OP_SINGLETON_AT), + `finmap_lookup + (m:(num,(num)excl)finmap) + (key:num) == SOME (a:(num)excl) ==> + ra_op + (gmap_ra (excl_ra:((num)excl)ra)) + m + (finmap_singleton key (f:(num)excl)) == + finmap_insert + key + (ra_op + (excl_ra:((num)excl)ra) + a + f) + m`, + "GMAP_RA_OP_SINGLETON_AT"); + check_gmap_theorem( ispecl_rule(TERM_LIST(R, key, m), GMAP_RA_VALID_LOOKUP_DELETE), `ra_valid @@ -275,6 +323,85 @@ PROOF static int audit_gmap_regressions(void) { (m:(num,(num)excl)finmap)) (finmap_insert key b m)`, "GMAP_RA_UPDATE_INSERT"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, key, a, f, b, g), + GMAP_RA_LOCAL_UPDATE_SINGLETON), + `ra_local_update + (excl_ra:((num)excl)ra) + ((a:(num)excl),(f:(num)excl)) + ((b:(num)excl),(g:(num)excl)) ==> + ra_local_update + (gmap_ra (excl_ra:((num)excl)ra)) + (finmap_singleton (key:num) a, + finmap_singleton key f) + (finmap_singleton key b, + finmap_singleton key g)`, + "GMAP_RA_LOCAL_UPDATE_SINGLETON"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, key, a, f, b, g), + GMAP_RA_LOCAL_UPDATE_SINGLETON_IFF), + `ra_local_update + (gmap_ra (excl_ra:((num)excl)ra)) + (finmap_singleton (key:num) (a:(num)excl), + finmap_singleton key (f:(num)excl)) + (finmap_singleton key (b:(num)excl), + finmap_singleton key (g:(num)excl)) <=> + ra_local_update + (excl_ra:((num)excl)ra) + (a,f) + (b,g)`, + "GMAP_RA_LOCAL_UPDATE_SINGLETON_IFF"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, key, a, f, b, g, m), + GMAP_RA_LOCAL_UPDATE_AT), + `finmap_lookup + (m:(num,(num)excl)finmap) + (key:num) == SOME (a:(num)excl) ==> + ra_local_update + (excl_ra:((num)excl)ra) + ((a:(num)excl),(f:(num)excl)) + ((b:(num)excl),(g:(num)excl)) ==> + ra_local_update + (gmap_ra (excl_ra:((num)excl)ra)) + (m,finmap_singleton key f) + (finmap_insert key b m,finmap_singleton key g)`, + "GMAP_RA_LOCAL_UPDATE_AT"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, key, a, f, b, g, m), + GMAP_RA_LOCAL_UPDATE_AT_IFF), + `finmap_lookup + (m:(num,(num)excl)finmap) + (key:num) == SOME (a:(num)excl) ==> + (ra_local_update + (gmap_ra (excl_ra:((num)excl)ra)) + (m,finmap_singleton key (f:(num)excl)) + (finmap_insert key (b:(num)excl) m, + finmap_singleton key (g:(num)excl)) <=> + (ra_valid + (gmap_ra (excl_ra:((num)excl)ra)) + m ==> + ra_local_update + (excl_ra:((num)excl)ra) + (a,f) + (b,g)))`, + "GMAP_RA_LOCAL_UPDATE_AT_IFF"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, key, a, b), + GMAP_RA_UPDATE_SINGLETON_IFF), + `ra_update + (gmap_ra (excl_ra:((num)excl)ra)) + (finmap_singleton (key:num) (a:(num)excl)) + (finmap_singleton key (b:(num)excl)) <=> + ra_update + (excl_ra:((num)excl)ra) + a + b`, + "GMAP_RA_UPDATE_SINGLETON_IFF"); check_gmap_theorem( ispecl_rule( TERM_LIST(R, key, a, b, m), @@ -291,6 +418,25 @@ PROOF static int audit_gmap_regressions(void) { m (finmap_insert key b m)`, "GMAP_RA_UPDATE_AT"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, key, a, b, m), + GMAP_RA_UPDATE_AT_IFF), + `finmap_lookup + (m:(num,(num)excl)finmap) + (key:num) == SOME (a:(num)excl) ==> + (ra_update + (gmap_ra (excl_ra:((num)excl)ra)) + m + (finmap_insert key (b:(num)excl) m) <=> + (ra_valid + (gmap_ra (excl_ra:((num)excl)ra)) + m ==> + ra_update + (excl_ra:((num)excl)ra) + a + b))`, + "GMAP_RA_UPDATE_AT_IFF"); check_gmap_theorem( ispecl_rule(TERM_LIST(R, key, m), GMAP_RA_UPDATE_DELETE), `ra_update @@ -317,6 +463,22 @@ PROOF static int audit_gmap_regressions(void) { P selected && result == finmap_insert key selected m)`, "GMAP_RA_UPDATE_INSERT_ND"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, key, a, P), + GMAP_RA_UPDATE_SINGLETON_ND_IFF), + `ra_update_nd + (gmap_ra (excl_ra:((num)excl)ra)) + (finmap_singleton (key:num) (a:(num)excl)) + (\result:(num,(num)excl)finmap. + exists selected:(num)excl. + P selected && + result == finmap_singleton key selected) <=> + ra_update_nd + (excl_ra:((num)excl)ra) + a + (P:(num)excl->bool)`, + "GMAP_RA_UPDATE_SINGLETON_ND_IFF"); check_gmap_theorem( ispecl_rule( TERM_LIST(R, key, a, P, m), @@ -336,6 +498,28 @@ PROOF static int audit_gmap_regressions(void) { P selected && result == finmap_insert key selected m)`, "GMAP_RA_UPDATE_AT_ND"); + check_gmap_theorem( + ispecl_rule( + TERM_LIST(R, key, a, P, m), + GMAP_RA_UPDATE_AT_ND_IFF), + `finmap_lookup + (m:(num,(num)excl)finmap) + (key:num) == SOME (a:(num)excl) ==> + (ra_update_nd + (gmap_ra (excl_ra:((num)excl)ra)) + m + (\result:(num,(num)excl)finmap. + exists selected:(num)excl. + P selected && + result == finmap_insert key selected m) <=> + (ra_valid + (gmap_ra (excl_ra:((num)excl)ra)) + m ==> + ra_update_nd + (excl_ra:((num)excl)ra) + a + (P:(num)excl->bool)))`, + "GMAP_RA_UPDATE_AT_ND_IFF"); check_gmap_theorem( ispecl_rule( TERM_LIST(R, candidates, payload, m), diff --git a/test/ra_core_regression.c b/test/ra_core_regression.c new file mode 100644 index 0000000..9c389d3 --- /dev/null +++ b/test/ra_core_regression.c @@ -0,0 +1,123 @@ +#include "proof/theory/logic/ra.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/ra.c" + +/* Exact-contract coverage for the core rules whose shape is especially + * important to goal-directed automation and constructor proofs. */ +PROOF static void check_ra_core_theorem( + const thm theorem, + const term expected, + const char *label) { + ENSURE_COND(!IS_NULL(theorem), "%s is empty", label); + ENSURE_COND(vector_size(hyp(theorem)) == 0, + "%s unexpectedly has hypotheses", label); + ENSURE_COND(alpha_compare(concl(theorem), expected) == 0, + "%s has the wrong conclusion", label); + return; +err: + ERR_FUN_PUTS("check_ra_core_theorem", label); +} + +PROOF static int audit_ra_core_regressions(void) { + term R = `R:(num)ra`; + term a = `a:num`; + term b = `b:num`; + term c = `c:num`; + term frame = `frame:num`; + term P = `P:num->bool`; + + check_ra_core_theorem( + ispecl_rule(TERM_LIST(R, a, frame), RA_EXCLUSIVE_APPLY), + `ra_exclusive (R:(num)ra) (a:num) ==> + ra_valid R (ra_op R a (frame:num)) ==> + frame == ra_unit R`, + "RA_EXCLUSIVE_APPLY"); + + check_ra_core_theorem( + ispecl_rule(TERM_LIST(R, a, b, frame), RA_UPDATE_APPLY), + `ra_update (R:(num)ra) (a:num) (b:num) ==> + ra_valid R (ra_op R a (frame:num)) ==> + ra_valid R (ra_op R b frame)`, + "RA_UPDATE_APPLY"); + + check_ra_core_theorem( + ispecl_rule(TERM_LIST(R, a, P, frame), RA_UPDATE_ND_APPLY), + `ra_update_nd (R:(num)ra) (a:num) (P:num->bool) ==> + ra_valid R (ra_op R a (frame:num)) ==> + exists b:num. P b && ra_valid R (ra_op R b frame)`, + "RA_UPDATE_ND_APPLY"); + + check_ra_core_theorem( + ispecl_rule( + TERM_LIST(R, frame, a, b), + RA_INCLUDED_CANCEL_L), + `ra_cancellative (R:(num)ra) ==> + ra_valid R (ra_op R (frame:num) (b:num)) ==> + ra_included + R + (ra_op R frame (a:num)) + (ra_op R frame b) ==> + ra_included R a b`, + "RA_INCLUDED_CANCEL_L"); + + check_ra_core_theorem( + ispecl_rule(TERM_LIST(R, a), RA_INVALID_EXCLUSIVE), + `~(ra_valid (R:(num)ra) (a:num)) ==> + ra_exclusive R a`, + "RA_INVALID_EXCLUSIVE"); + + check_ra_core_theorem( + ispecl_rule( + TERM_LIST(R, a, frame), + RA_EXCLUSIVE_VALID_OP_IFF), + `ra_exclusive (R:(num)ra) (a:num) ==> + (ra_valid R (ra_op R a (frame:num)) <=> + ra_valid R a && frame == ra_unit R)`, + "RA_EXCLUSIVE_VALID_OP_IFF"); + + check_ra_core_theorem( + ispecl_rule(TERM_LIST(R, a, P), RA_UPDATE_ND_INVALID), + `~(ra_valid (R:(num)ra) (a:num)) ==> + ra_update_nd R a (P:num->bool)`, + "RA_UPDATE_ND_INVALID"); + + check_ra_core_theorem( + ispecl_rule( + TERM_LIST(R, a, P), + RA_EXCLUSIVE_UPDATE_ND_IFF), + `ra_exclusive (R:(num)ra) (a:num) ==> + (ra_update_nd R a (P:num->bool) <=> + (ra_valid R a ==> + exists b:num. P b && ra_valid R b))`, + "RA_EXCLUSIVE_UPDATE_ND_IFF"); + + check_ra_core_theorem( + ispecl_rule(TERM_LIST(R, a, b), RA_UPDATE_INVALID), + `~(ra_valid (R:(num)ra) (a:num)) ==> + ra_update R a (b:num)`, + "RA_UPDATE_INVALID"); + + check_ra_core_theorem( + ispecl_rule( + TERM_LIST(R, a, b, c), + RA_UPDATE_TARGET_INCLUDED), + `ra_update (R:(num)ra) (a:num) (b:num) ==> + ra_included R (c:num) b ==> + ra_update R a c`, + "RA_UPDATE_TARGET_INCLUDED"); + + check_ra_core_theorem( + ispecl_rule( + TERM_LIST(R, a, b), + RA_EXCLUSIVE_UPDATE_IFF), + `ra_exclusive (R:(num)ra) (a:num) ==> + (ra_update R a (b:num) <=> + (ra_valid R a ==> ra_valid R b))`, + "RA_EXCLUSIVE_UPDATE_IFF"); + return 0; +} + +PROOF static int _RA_CORE_REGRESSION = + audit_ra_core_regressions(); diff --git a/test/value_ra_constructors_regression.c b/test/value_ra_constructors_regression.c new file mode 100644 index 0000000..8f58454 --- /dev/null +++ b/test/value_ra_constructors_regression.c @@ -0,0 +1,307 @@ +#include "proof/theory/logic/agree_ra.h" +#include "proof/theory/logic/frac_ra.h" +#include "proof/theory/logic/max_nat_ra.h" +#include "proof/theory/logic/option_ra.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/agree_ra.c" +#require "proof/theory/logic/frac_ra.c" +#require "proof/theory/logic/max_nat_ra.c" +#require "proof/theory/logic/option_ra.c" + +PROOF static void check_value_ra_theorem( + const thm theorem, + const term expected, + const char *label) { + ENSURE_COND(!IS_NULL(theorem), "%s is empty", label); + ENSURE_COND(vector_size(hyp(theorem)) == 0, + "%s unexpectedly has hypotheses", label); + ENSURE_COND(alpha_compare(concl(theorem), expected) == 0, + "%s has the wrong conclusion", label); + return; +err: + ERR_FUN_PUTS("check_value_ra_theorem", label); +} + +PROOF static thm value_ra_at_num(thm theorem) { + type_list variables = term_tyvars(concl(theorem)); + ENSURE_COND(vector_size(variables) == 1, + "expected exactly one carrier type variable"); + type_pair_list types = (type_pair_list)vector_create(); + vector_add(&types, ((type_pair){`:num`, variables[0]})); + return inst_type_rule(types, theorem); +err: + ERR_FUN_PUTS("value_ra_at_num"); + return empty_theorem; +} + +PROOF static int audit_agree_constructor_regressions(void) { + check_value_ra_theorem( + AGREE_RA_OWNED_INJ, + `forall (a:A) (b:A). + (Agree a:(A)agree) == Agree b <=> a == b`, + "AGREE_RA_OWNED_INJ"); + check_value_ra_theorem( + AGREE_RA_OWNED_NE_UNIT, + `forall a:A. ~((Agree a:(A)agree) == AgreeUnit)`, + "AGREE_RA_OWNED_NE_UNIT"); + check_value_ra_theorem( + AGREE_RA_INVALID_NE_UNIT, + `~((AgreeInvalid:(A)agree) == AgreeUnit)`, + "AGREE_RA_INVALID_NE_UNIT"); + check_value_ra_theorem( + AGREE_RA_INVALID_NE_OWNED, + `forall a:A. ~((AgreeInvalid:(A)agree) == Agree a)`, + "AGREE_RA_INVALID_NE_OWNED"); + check_value_ra_theorem( + AGREE_RA_VALID_UNIT, + `ra_valid agree_ra (AgreeUnit:(A)agree)`, + "AGREE_RA_VALID_UNIT"); + check_value_ra_theorem( + AGREE_RA_INCLUDED_UNIT, + `forall x:(A)agree. + ra_included agree_ra AgreeUnit x`, + "AGREE_RA_INCLUDED_UNIT"); + check_value_ra_theorem( + AGREE_RA_NOT_INCLUDED_OWNED_UNIT, + `forall a:A. + ~(ra_included agree_ra (Agree a) AgreeUnit)`, + "AGREE_RA_NOT_INCLUDED_OWNED_UNIT"); + check_value_ra_theorem( + AGREE_RA_INCLUDED_OWNED_INVALID, + `forall a:A. + ra_included agree_ra (Agree a) AgreeInvalid`, + "AGREE_RA_INCLUDED_OWNED_INVALID"); + check_value_ra_theorem( + value_ra_at_num(AGREE_RA_NOT_INCLUDED_INVALID_UNIT), + `~(ra_included + (agree_ra:((num)agree)ra) + (AgreeInvalid:(num)agree) + (AgreeUnit:(num)agree))`, + "AGREE_RA_NOT_INCLUDED_INVALID_UNIT"); + check_value_ra_theorem( + AGREE_RA_NOT_INCLUDED_INVALID_OWNED, + `forall a:A. + ~(ra_included agree_ra AgreeInvalid (Agree a))`, + "AGREE_RA_NOT_INCLUDED_INVALID_OWNED"); + check_value_ra_theorem( + AGREE_RA_NOT_EXCLUSIVE_OWNED, + `forall a:A. + ~(ra_exclusive agree_ra (Agree a))`, + "AGREE_RA_NOT_EXCLUSIVE_OWNED"); + check_value_ra_theorem( + AGREE_RA_EXCLUSIVE_INVALID, + `ra_exclusive agree_ra (AgreeInvalid:(A)agree)`, + "AGREE_RA_EXCLUSIVE_INVALID"); + check_value_ra_theorem( + AGREE_RA_NOT_CANCELLATIVE, + `~(ra_cancellative (agree_ra:((A)agree)ra))`, + "AGREE_RA_NOT_CANCELLATIVE"); + check_value_ra_theorem( + AGREE_RA_LOCAL_UPDATE_OWNED_IFF, + `forall a b:A. + ra_local_update + agree_ra + (Agree a,Agree a) + (Agree b,Agree b) <=> + a == b`, + "AGREE_RA_LOCAL_UPDATE_OWNED_IFF"); + return 0; +} + +PROOF static int audit_frac_constructor_regressions(void) { + check_value_ra_theorem( + FRAC_RA_OWN_INJ, + `forall (p:real) (q:real) (a:A) (b:A). + &0 < p ==> + &0 < q ==> + (frac_own p a == frac_own q b <=> + p == q && a == b)`, + "FRAC_RA_OWN_INJ"); + check_value_ra_theorem( + FRAC_RA_OWN_NE_EMPTY, + `forall (p:real) (a:A). + ~(frac_own p a == (frac_empty:(A)frac))`, + "FRAC_RA_OWN_NE_EMPTY"); + check_value_ra_theorem( + FRAC_RA_FULL_INJ, + `forall (a:A) (b:A). + frac_full a == frac_full b <=> a == b`, + "FRAC_RA_FULL_INJ"); + check_value_ra_theorem( + FRAC_RA_FULL_NE_EMPTY, + `forall a:A. + ~(frac_full a == (frac_empty:(A)frac))`, + "FRAC_RA_FULL_NE_EMPTY"); + check_value_ra_theorem( + FRAC_RA_INCLUDED_EMPTY, + `forall (R:(A)ra) (x:(A)frac). + ra_included (frac_ra R) frac_empty x`, + "FRAC_RA_INCLUDED_EMPTY"); + check_value_ra_theorem( + FRAC_RA_INCLUDED_OWN, + `forall + (R:(A)ra) + (p:real) + (q:real) + (a:A) + (b:A). + &0 < p ==> + &0 < q ==> + (ra_included + (frac_ra R) + (frac_own p a) + (frac_own q b) <=> + (p == q && a == b) || + (p < q && ra_included R a b))`, + "FRAC_RA_INCLUDED_OWN"); + check_value_ra_theorem( + FRAC_RA_NOT_INCLUDED_OWN_EMPTY, + `forall (R:(A)ra) (p:real) (a:A). + &0 < p ==> + ~(ra_included + (frac_ra R) + (frac_own p a) + frac_empty)`, + "FRAC_RA_NOT_INCLUDED_OWN_EMPTY"); + check_value_ra_theorem( + FRAC_RA_INCLUDED_FULL, + `forall (R:(A)ra) (a:A) (b:A). + ra_included + (frac_ra R) + (frac_full a) + (frac_full b) <=> + a == b`, + "FRAC_RA_INCLUDED_FULL"); + check_value_ra_theorem( + FRAC_RA_UPDATE_FULL_IFF, + `forall (R:(A)ra) (a:A) (b:A). + (ra_update + (frac_ra R) + (frac_full a) + (frac_full b) <=> + (ra_valid R a ==> ra_valid R b))`, + "FRAC_RA_UPDATE_FULL_IFF"); + check_value_ra_theorem( + FRAC_RA_UPDATE_FULL_ND_IFF, + `forall (R:(A)ra) (a:A) (P:A->bool). + (ra_update_nd + (frac_ra R) + (frac_full a) + (\x:(A)frac. + exists b:A. + P b && x == frac_full b) <=> + (ra_valid R a ==> + exists b:A. P b && ra_valid R b))`, + "FRAC_RA_UPDATE_FULL_ND_IFF"); + return 0; +} + +PROOF static int audit_option_constructor_regressions(void) { + check_value_ra_theorem( + OPTION_RA_SOME_INJ, + `forall (a:A) (b:A). + (SOME a:A option) == SOME b <=> a == b`, + "OPTION_RA_SOME_INJ"); + check_value_ra_theorem( + OPTION_RA_SOME_NE_NONE, + `forall a:A. ~((SOME a:A option) == NONE)`, + "OPTION_RA_SOME_NE_NONE"); + check_value_ra_theorem( + OPTION_RA_EXCLUSIVE_SOME_IFF, + `forall (R:(A)ra) (a:A). + ra_exclusive (option_ra R) (SOME a) <=> + ~(ra_valid R a)`, + "OPTION_RA_EXCLUSIVE_SOME_IFF"); + check_value_ra_theorem( + OPTION_RA_NOT_EXCLUSIVE_NONE, + `forall R:(A)ra. + ~(ra_exclusive (option_ra R) (NONE:A option))`, + "OPTION_RA_NOT_EXCLUSIVE_NONE"); + check_value_ra_theorem( + OPTION_RA_NOT_CANCELLATIVE, + `forall R:(A)ra. + ~(ra_cancellative (option_ra R))`, + "OPTION_RA_NOT_CANCELLATIVE"); + check_value_ra_theorem( + OPTION_RA_LOCAL_UPDATE_SOME, + `forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + ra_local_update R (a,f) (b,g) ==> + ra_local_update + (option_ra R) + (SOME a,SOME f) + (SOME b,SOME g)`, + "OPTION_RA_LOCAL_UPDATE_SOME"); + check_value_ra_theorem( + OPTION_RA_LOCAL_UPDATE_SOME_IFF, + `forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + ra_local_update + (option_ra R) + (SOME a,SOME f) + (SOME b,SOME g) <=> + ra_local_update R (a,f) (b,g)`, + "OPTION_RA_LOCAL_UPDATE_SOME_IFF"); + check_value_ra_theorem( + OPTION_RA_UPDATE_IFF, + `forall (R:(A)ra) (a:A) (b:A). + ra_update + (option_ra R) + (SOME a) + (SOME b) <=> + ra_update R a b`, + "OPTION_RA_UPDATE_IFF"); + check_value_ra_theorem( + OPTION_RA_UPDATE_ND_IFF, + `forall (R:(A)ra) (a:A) (P:A->bool). + (ra_update_nd + (option_ra R) + (SOME a) + (\x:A option. + exists b:A. P b && x == SOME b) <=> + ra_update_nd R a P)`, + "OPTION_RA_UPDATE_ND_IFF"); + return 0; +} + +PROOF static int audit_max_nat_constructor_regressions(void) { + check_value_ra_theorem( + MAX_NAT_RA_NOT_EXCLUSIVE, + `forall n:num. ~(ra_exclusive max_nat_ra n)`, + "MAX_NAT_RA_NOT_EXCLUSIVE"); + check_value_ra_theorem( + MAX_NAT_RA_NOT_CANCELLATIVE, + `~(ra_cancellative max_nat_ra)`, + "MAX_NAT_RA_NOT_CANCELLATIVE"); + check_value_ra_theorem( + MAX_NAT_RA_LOCAL_UPDATE_UNIT_IFF, + `forall old new:num. + ra_local_update max_nat_ra (old,0) (new,0) <=> + old == new`, + "MAX_NAT_RA_LOCAL_UPDATE_UNIT_IFF"); + check_value_ra_theorem( + MAX_NAT_RA_UPDATE_ND_IFF, + `forall (old:num) (P:num->bool). + ra_update_nd max_nat_ra old P <=> + exists new:num. P new`, + "MAX_NAT_RA_UPDATE_ND_IFF"); + return 0; +} + +PROOF static int audit_value_ra_constructor_regressions(void) { + ENSURE_COND(audit_agree_constructor_regressions() == 0, + "agreement constructor regressions failed"); + ENSURE_COND(audit_frac_constructor_regressions() == 0, + "fractional constructor regressions failed"); + ENSURE_COND(audit_option_constructor_regressions() == 0, + "option constructor regressions failed"); + ENSURE_COND(audit_max_nat_constructor_regressions() == 0, + "max-nat constructor regressions failed"); + return 0; +err: + ERR_FUN_PUTS("audit_value_ra_constructor_regressions"); + return -1; +} + +PROOF static int _VALUE_RA_CONSTRUCTORS_REGRESSION = + audit_value_ra_constructor_regressions(); diff --git a/theory/logic/agree_ra.c b/theory/logic/agree_ra.c index d738af5..6997f09 100644 --- a/theory/logic/agree_ra.c +++ b/theory/logic/agree_ra.c @@ -4,6 +4,7 @@ #include "proof/proof_backward.h" #require "proof/proof_backward.c" #require "proof/theory/logic/ra.c" +#require "proof/theory/logic/local_update.c" PROOF static size_t AGREE_RA_AXIOMS_BEFORE = vector_size(get_all_axioms()); @@ -352,6 +353,81 @@ PROOF static thm prove_agree_ra_idempotent(void) { PROOF thm AGREE_RA_IDEMPOTENT = prove_agree_ra_idempotent(); +PROOF static thm prove_agree_ra_owned_inj(void) { + term goal_tm = ` + forall (a:A) (b:A). + (Agree a:(A)agree) == Agree b <=> a == b + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + get_datatype_injectivity("agree")))); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_OWNED_INJ = + prove_agree_ra_owned_inj(); + +PROOF static thm prove_agree_ra_owned_ne_unit(void) { + term goal_tm = ` + forall a:A. ~((Agree a:(A)agree) == AgreeUnit) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + get_datatype_distinctness("agree")))); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_OWNED_NE_UNIT = + prove_agree_ra_owned_ne_unit(); + +PROOF static thm prove_agree_ra_invalid_ne_unit(void) { + term goal_tm = ` + ~((AgreeInvalid:(A)agree) == AgreeUnit) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + get_datatype_distinctness("agree")))); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_INVALID_NE_UNIT = + prove_agree_ra_invalid_ne_unit(); + +PROOF static thm prove_agree_ra_invalid_ne_owned(void) { + term goal_tm = ` + forall a:A. ~((AgreeInvalid:(A)agree) == Agree a) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + get_datatype_distinctness("agree")))); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_INVALID_NE_OWNED = + prove_agree_ra_invalid_ne_owned(); + +PROOF static thm prove_agree_ra_valid_unit_public(void) { + term goal_tm = `ra_valid agree_ra (AgreeUnit:(A)agree)`; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + AGREE_RA_VALID_FN, + agree_valid_def))); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_VALID_UNIT = + prove_agree_ra_valid_unit_public(); + PROOF static thm prove_agree_ra_valid_owned(void) { term goal_tm = ` forall a:A. @@ -499,6 +575,88 @@ PROOF static thm prove_agree_ra_update_iff(void) { PROOF thm AGREE_RA_UPDATE_IFF = prove_agree_ra_update_iff(); +PROOF static thm prove_agree_ra_local_update_owned_iff(void) { + term goal_tm = ` + forall a b:A. + ra_local_update + agree_ra + (Agree a,Agree a) + (Agree b,Agree b) <=> + a == b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC( + directions[0], "Hlocal"); + thm updated = ispecl_rule( + TERM_LIST( + `agree_ra:((A)agree)ra`, + `((Agree (a:A)),(Agree (a:A)))`, + `((Agree (b:A)),(Agree (b:A)))`, + `Agree (a:A):(A)agree`), + RA_LOCAL_UPDATE_APPLY); + updated = rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + updated); + updated = mp_rule( + updated, + assume_rule(` + ra_local_update + agree_ra + ((Agree (a:A)),(Agree (a:A))) + ((Agree (b:A)),(Agree (b:A))) + `)); + updated = mp_rule( + updated, + ispec_rule(`a:A`, AGREE_RA_VALID_OWNED)); + updated = mp_rule( + updated, + gsym_rule(ispec_rule(`a:A`, AGREE_RA_IDEMPOTENT))); + thm target_valid = conjunct1_rule(updated); + thm target_decomposition = conjunct2_rule(updated); + thm target_op_valid = eq_mp_rule( + ap_term_rule( + `ra_valid agree_ra:(A)agree->bool`, + target_decomposition), + target_valid); + thm payload_eq = mp_rule( + ispecl_rule( + TERM_LIST(`b:A`, `a:A`), + AGREE_RA_AGREEMENT), + target_op_valid); + ACCEPT_TAC(forward, sym_rule(payload_eq)); + + gnode reverse = DISCH_TAC( + directions[1], "Heq"); + thm pair_eq = beta_rule(ap_term_rule( + `\x:A. + ((Agree x),(Agree x))`, + assume_rule(`(a:A) == (b:A)`))); + thm target_transport = beta_rule(ap_term_rule( + `\target:(A)agree#(A)agree. + ra_local_update + agree_ra + ((Agree (a:A)),(Agree (a:A))) + target`, + pair_eq)); + thm reflexive = ispecl_rule( + TERM_LIST( + `agree_ra:((A)agree)ra`, + `((Agree (a:A)),(Agree (a:A)))`), + RA_LOCAL_UPDATE_REFL); + ACCEPT_TAC( + reverse, + eq_mp_rule(target_transport, reflexive)); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_LOCAL_UPDATE_OWNED_IFF = + prove_agree_ra_local_update_owned_iff(); + /* ------------------------------------------------------------------------- */ /* Order */ /* ------------------------------------------------------------------------- */ @@ -564,6 +722,286 @@ PROOF static thm prove_agree_ra_included_owned(void) { PROOF thm AGREE_RA_INCLUDED_OWNED = prove_agree_ra_included_owned(); +PROOF static thm prove_agree_ra_included_unit(void) { + term goal_tm = ` + forall x:(A)agree. + ra_included agree_ra AgreeUnit x + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "x"); + thm included = ispecl_rule( + TERM_LIST( + `agree_ra:((A)agree)ra`, + `x:(A)agree`), + RA_INCLUDED_UNIT); + included = rewrite_rule( + THM_LIST(AGREE_RA_UNIT), + included); + ACCEPT_TAC(body, included); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_INCLUDED_UNIT = + prove_agree_ra_included_unit(); + +PROOF static thm prove_agree_unit_ne_owned_result(void) { + term goal_tm = ` + forall a b:A. + ~((AgreeUnit:(A)agree) == + (if a == b + then Agree a + else AgreeInvalid)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "a"); + body = GEN_TAC(body, "b"); + gnode_list cases = BOOL_CASES_TAC( + body, `(a:A) == (b:A)`, "Heq"); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST(get_datatype_distinctness("agree"))); + } + return gnode_prove(root); +} + +PROOF static thm AGREE_UNIT_NE_OWNED_RESULT = + prove_agree_unit_ne_owned_result(); + +PROOF static thm prove_agree_ra_unit_ne_owned_op(void) { + term goal_tm = ` + forall (a:A) (frame:(A)agree). + ~((AgreeUnit:(A)agree) == + ra_op agree_ra (Agree a) frame) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "a"); + body = GEN_TAC(body, "frame"); + gnode_list frame_cases = CASES_TAC( + body, `frame:(A)agree`, "Hframe"); + for (size_t i = 0; i < vector_size(frame_cases); ++i) { + CONV_WITH_ASMP_TAC( + frame_cases[i], + rewrite_conv, + THM_LIST( + AGREE_RA_OP_FN, + agree_op_def, + agree_owned_op_def, + AGREE_UNIT_NE_OWNED_RESULT, + get_datatype_distinctness("agree"))); + } + return gnode_prove(root); +} + +PROOF static thm AGREE_RA_UNIT_NE_OWNED_OP = + prove_agree_ra_unit_ne_owned_op(); + +PROOF static thm prove_agree_ra_not_included_owned_unit(void) { + term goal_tm = ` + forall a:A. + ~(ra_included agree_ra (Agree a) AgreeUnit) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "a"); + body = DISCH_TAC(body, "Hincluded"); + thm included = rewrite_rule( + THM_LIST(ra_included_def), + assume_rule(` + ra_included + agree_ra + (Agree (a:A)) + (AgreeUnit:(A)agree) + `)); + body = ASSUME_TAC(body, included, "Hextension"); + body = ASMP_EXISTS_TAC(body, "Hextension", "frame"); + thm contradiction = not_elim_rule( + ispecl_rule( + TERM_LIST(`a:A`, `frame:(A)agree`), + AGREE_RA_UNIT_NE_OWNED_OP), + assume_rule(` + (AgreeUnit:(A)agree) == + ra_op + agree_ra + (Agree (a:A)) + (frame:(A)agree) + `)); + CONTR_TAC(body, contradiction); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_NOT_INCLUDED_OWNED_UNIT = + prove_agree_ra_not_included_owned_unit(); + +PROOF static thm prove_agree_ra_included_owned_invalid(void) { + term goal_tm = ` + forall a:A. + ra_included agree_ra (Agree a) AgreeInvalid + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "a"); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_included_def))); + body = EXISTS_TAC(body, `AgreeInvalid:(A)agree`); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + AGREE_RA_OP_FN, + agree_op_def, + agree_owned_op_def))); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_INCLUDED_OWNED_INVALID = + prove_agree_ra_included_owned_invalid(); + +PROOF static thm prove_agree_ra_not_included_invalid_unit(void) { + term goal_tm = ` + ~(ra_included agree_ra AgreeInvalid AgreeUnit) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + ra_included_def, + AGREE_RA_OP_FN, + agree_op_def, + get_datatype_distinctness("agree")))); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_NOT_INCLUDED_INVALID_UNIT = + prove_agree_ra_not_included_invalid_unit(); + +PROOF static thm prove_agree_ra_not_included_invalid_owned(void) { + term goal_tm = ` + forall a:A. + ~(ra_included agree_ra AgreeInvalid (Agree a)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + ra_included_def, + AGREE_RA_OP_FN, + agree_op_def, + get_datatype_distinctness("agree")))); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_NOT_INCLUDED_INVALID_OWNED = + prove_agree_ra_not_included_invalid_owned(); + +PROOF static thm prove_agree_ra_not_exclusive_owned(void) { + term goal_tm = ` + forall a:A. ~(ra_exclusive agree_ra (Agree a)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "a"); + body = DISCH_TAC(body, "Hexclusive"); + thm exclusive = rewrite_rule( + THM_LIST(ra_exclusive_def), + assume_rule(`ra_exclusive agree_ra (Agree (a:A))`)); + thm combined_valid = eq_mp_rule( + gsym_rule(ap_term_rule( + `ra_valid agree_ra:(A)agree->bool`, + ispec_rule(`a:A`, AGREE_RA_IDEMPOTENT))), + ispec_rule(`a:A`, AGREE_RA_VALID_OWNED)); + thm frame_is_unit = mp_rule( + spec_rule(`Agree (a:A):(A)agree`, exclusive), + combined_valid); + frame_is_unit = rewrite_rule( + THM_LIST(AGREE_RA_UNIT), + frame_is_unit); + thm contradiction = not_elim_rule( + ispec_rule(`a:A`, AGREE_RA_OWNED_NE_UNIT), + frame_is_unit); + CONTR_TAC(body, contradiction); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_NOT_EXCLUSIVE_OWNED = + prove_agree_ra_not_exclusive_owned(); + +PROOF static thm prove_agree_ra_exclusive_invalid(void) { + term goal_tm = ` + ra_exclusive agree_ra (AgreeInvalid:(A)agree) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_exclusive_def))); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hcombined"); + thm invalid_valid = mp_rule( + ispecl_rule( + TERM_LIST( + `agree_ra:((A)agree)ra`, + `AgreeInvalid:(A)agree`, + `frame:(A)agree`), + RA_VALID_OP_L), + assume_rule(` + ra_valid + agree_ra + (ra_op + agree_ra + (AgreeInvalid:(A)agree) + (frame:(A)agree)) + `)); + thm contradiction = not_elim_rule( + AGREE_RA_INVALID, + invalid_valid); + CONTR_TAC(body, contradiction); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_EXCLUSIVE_INVALID = + prove_agree_ra_exclusive_invalid(); + +PROOF static thm prove_agree_ra_not_cancellative(void) { + term goal_tm = `~(ra_cancellative (agree_ra:((A)agree)ra))`; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = DISCH_TAC(root, "Hcancellative"); + term owned = `Agree (a:A):(A)agree`; + thm source_op = ispecl_rule( + TERM_LIST( + `agree_ra:((A)agree)ra`, + owned), + RA_UNIT_R); + source_op = rewrite_rule( + THM_LIST(AGREE_RA_UNIT), + source_op); + thm source_valid = eq_mp_rule( + gsym_rule(ap_term_rule( + `ra_valid agree_ra:(A)agree->bool`, + source_op)), + ispec_rule(`a:A`, AGREE_RA_VALID_OWNED)); + thm right_op = ispec_rule(`a:A`, AGREE_RA_IDEMPOTENT); + thm forced_equal = ispecl_rule( + TERM_LIST( + `agree_ra:((A)agree)ra`, + owned, + `AgreeUnit:(A)agree`, + owned), + RA_CANCELLATIVE_APPLY); + forced_equal = mp_rule( + forced_equal, + assume_rule(`ra_cancellative (agree_ra:((A)agree)ra)`)); + forced_equal = mp_rule(forced_equal, source_valid); + forced_equal = mp_rule( + forced_equal, + trans_rule(source_op, gsym_rule(right_op))); + thm contradiction = not_elim_rule( + ispec_rule(`a:A`, AGREE_RA_OWNED_NE_UNIT), + gsym_rule(forced_equal)); + CONTR_TAC(body, contradiction); + return gnode_prove(root); +} + +PROOF thm AGREE_RA_NOT_CANCELLATIVE = + prove_agree_ra_not_cancellative(); + PROOF static int audit_agree_ra(void) { thm_list audited_theorems = THM_LIST( agree_type.ind, @@ -578,12 +1016,28 @@ PROOF static int audit_agree_ra(void) { AGREE_RA_VALID_FN, AGREE_RA_OWNED_OP, AGREE_RA_IDEMPOTENT, + AGREE_RA_OWNED_INJ, + AGREE_RA_OWNED_NE_UNIT, + AGREE_RA_INVALID_NE_UNIT, + AGREE_RA_INVALID_NE_OWNED, + AGREE_RA_VALID_UNIT, AGREE_RA_VALID_OWNED, AGREE_RA_INVALID, AGREE_RA_VALID_COMBINE_IFF, AGREE_RA_INCLUDED_OWNED, + AGREE_RA_INCLUDED_UNIT, + AGREE_UNIT_NE_OWNED_RESULT, + AGREE_RA_UNIT_NE_OWNED_OP, + AGREE_RA_NOT_INCLUDED_OWNED_UNIT, + AGREE_RA_INCLUDED_OWNED_INVALID, + AGREE_RA_NOT_INCLUDED_INVALID_UNIT, + AGREE_RA_NOT_INCLUDED_INVALID_OWNED, + AGREE_RA_NOT_EXCLUSIVE_OWNED, + AGREE_RA_EXCLUSIVE_INVALID, + AGREE_RA_NOT_CANCELLATIVE, AGREE_RA_AGREEMENT, - AGREE_RA_UPDATE_IFF); + AGREE_RA_UPDATE_IFF, + AGREE_RA_LOCAL_UPDATE_OWNED_IFF); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { ENSURE_COND(!IS_NULL(audited_theorems[i]), diff --git a/theory/logic/agree_ra.h b/theory/logic/agree_ra.h index 738466f..2661ff2 100644 --- a/theory/logic/agree_ra.h +++ b/theory/logic/agree_ra.h @@ -13,7 +13,7 @@ * laws, and `ra_abs` projection equations are private to `agree_ra.c`. */ -#include "proof/theory/logic/ra.h" +#include "proof/theory/logic/local_update.h" /* ------------------------------------------------------------------------- */ /* Core representation */ @@ -39,10 +39,32 @@ PROOF extern thm AGREE_RA_OWNED_OP; */ PROOF extern thm AGREE_RA_IDEMPOTENT; +/* ------------------------------------------------------------------------- */ +/* Constructor equality and distinction */ +/* ------------------------------------------------------------------------- */ + +/* + * forall (a:A) (b:A). + * (Agree a:(A)agree) == Agree b <=> a == b + */ +PROOF extern thm AGREE_RA_OWNED_INJ; + +/* `forall a:A. ~((Agree a:(A)agree) == AgreeUnit)`. */ +PROOF extern thm AGREE_RA_OWNED_NE_UNIT; + +/* `~((AgreeInvalid:(A)agree) == AgreeUnit)`. */ +PROOF extern thm AGREE_RA_INVALID_NE_UNIT; + +/* `forall a:A. ~((AgreeInvalid:(A)agree) == Agree a)`. */ +PROOF extern thm AGREE_RA_INVALID_NE_OWNED; + /* ------------------------------------------------------------------------- */ /* Validity */ /* ------------------------------------------------------------------------- */ +/* `ra_valid agree_ra (AgreeUnit:(A)agree)`. */ +PROOF extern thm AGREE_RA_VALID_UNIT; + /* `forall a:A. ra_valid agree_ra (Agree a)`. */ PROOF extern thm AGREE_RA_VALID_OWNED; @@ -74,6 +96,45 @@ PROOF extern thm AGREE_RA_VALID_COMBINE_IFF; */ PROOF extern thm AGREE_RA_INCLUDED_OWNED; +/* `forall x:(A)agree. ra_included agree_ra AgreeUnit x`. */ +PROOF extern thm AGREE_RA_INCLUDED_UNIT; + +/* + * `forall a:A. + * ~(ra_included agree_ra (Agree a) AgreeUnit)` + */ +PROOF extern thm AGREE_RA_NOT_INCLUDED_OWNED_UNIT; + +/* + * Invalid extensions remain visible in the raw inclusion preorder: + * + * `forall a:A. + * ra_included agree_ra (Agree a) AgreeInvalid` + */ +PROOF extern thm AGREE_RA_INCLUDED_OWNED_INVALID; + +/* `~(ra_included agree_ra AgreeInvalid AgreeUnit)`. */ +PROOF extern thm AGREE_RA_NOT_INCLUDED_INVALID_UNIT; + +/* + * `forall a:A. + * ~(ra_included agree_ra AgreeInvalid (Agree a))` + */ +PROOF extern thm AGREE_RA_NOT_INCLUDED_INVALID_OWNED; + +/* ------------------------------------------------------------------------- */ +/* Exclusive and cancellative laws */ +/* ------------------------------------------------------------------------- */ + +/* `forall a:A. ~(ra_exclusive agree_ra (Agree a))`. */ +PROOF extern thm AGREE_RA_NOT_EXCLUSIVE_OWNED; + +/* `ra_exclusive agree_ra (AgreeInvalid:(A)agree)`. */ +PROOF extern thm AGREE_RA_EXCLUSIVE_INVALID; + +/* `~(ra_cancellative (agree_ra:((A)agree)ra))`. */ +PROOF extern thm AGREE_RA_NOT_CANCELLATIVE; + /* ------------------------------------------------------------------------- */ /* Agreement */ /* ------------------------------------------------------------------------- */ @@ -102,3 +163,18 @@ PROOF extern thm AGREE_RA_AGREEMENT; * token to `AgreeUnit` remains possible through `RA_UPDATE_INCLUDED`. */ PROOF extern thm AGREE_RA_UPDATE_IFF; + +/* + * A synchronized local update between fully owned agreement pairs cannot + * change the payload: + * + * `forall a b:A. + * ra_local_update + * agree_ra + * (Agree a,Agree a) + * (Agree b,Agree b) <=> + * a == b` + * + * Necessity exposes `Agree a` as a residual of the idempotent source. + */ +PROOF extern thm AGREE_RA_LOCAL_UPDATE_OWNED_IFF; diff --git a/theory/logic/auth_ra.c b/theory/logic/auth_ra.c index e14f87c..94c5283 100644 --- a/theory/logic/auth_ra.c +++ b/theory/logic/auth_ra.c @@ -6,6 +6,7 @@ #include "proof/proof_backward.h" #require "proof/proof_backward.c" #require "proof/theory/logic/excl_ra.c" +#require "proof/theory/logic/local_update.c" #require "proof/theory/logic/prod_ra.c" PROOF static size_t AUTH_RA_AXIOMS_BEFORE = @@ -436,6 +437,59 @@ PROOF static thm prove_auth_ra_op_as_product(void) { PROOF static thm AUTH_RA_OP_AS_PRODUCT = prove_auth_ra_op_as_product(); +/* Inclusion depends only on the carrier operation, so authoritative + * inclusion is exactly inclusion in the product used by the construction. */ +PROOF static thm prove_auth_ra_included_as_product(void) { + term goal_tm = ` + forall + (R:(A)ra) + (x:(A)excl#A) + (y:(A)excl#A). + ra_included (auth_ra R) x y <=> + ra_included + (prod_ra (excl_ra:((A)excl)ra) R) + x + y + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + ra_included_def, + AUTH_RA_OP_AS_PRODUCT))); + return gnode_prove(root); +} + +PROOF static thm AUTH_RA_INCLUDED_AS_PRODUCT = + prove_auth_ra_included_as_product(); + +/* Private representation bridge used to derive the constructor-level public + * inclusion API below. */ +PROOF static thm prove_auth_ra_included_components(void) { + term goal_tm = ` + forall + (R:(A)ra) + (x:(A)excl#A) + (y:(A)excl#A). + ra_included (auth_ra R) x y <=> + ra_included + (excl_ra:((A)excl)ra) + (FST x) + (FST y) && + ra_included R (SND x) (SND y) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + AUTH_RA_INCLUDED_AS_PRODUCT, + PROD_RA_INCLUDED))); + return gnode_prove(root); +} + +PROOF static thm AUTH_RA_INCLUDED_COMPONENTS = + prove_auth_ra_included_components(); + /* Authoritative validity is stronger than validity in the carrier product. * In the owned case, fragment validity follows by downward closure from its * inclusion in the valid authoritative value. */ @@ -621,6 +675,167 @@ PROOF static thm prove_auth_ra_both_unit(void) { PROOF thm AUTH_RA_BOTH_UNIT = prove_auth_ra_both_unit(); +/* The excl implementation keeps its raw constructor-injectivity theorem + * private. Recover the same fact through the public owned-inclusion + * characterization so auth constructor proofs do not enlarge that API. */ +PROOF static thm prove_auth_excl_owned_inj(void) { + term goal_tm = ` + forall a b:A. + ((Excl a:(A)excl) == Excl b) <=> a == b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Heq"); + thm included_refl = ispecl_rule( + TERM_LIST( + `excl_ra:((A)excl)ra`, + `Excl (a:A):(A)excl`), + RA_INCLUDED_REFL); + thm replace_target = beta_rule(ap_term_rule( + `\x:(A)excl. + ra_included + (excl_ra:((A)excl)ra) + (Excl (a:A)) + x`, + assume_rule(`(Excl (a:A):(A)excl) == Excl (b:A)`))); + thm included = eq_mp_rule(replace_target, included_refl); + thm payloads_equal = eq_mp_rule( + ispecl_rule( + TERM_LIST(`a:A`, `b:A`), + EXCL_RA_INCLUDED_OWNED), + included); + ACCEPT_TAC(forward, payloads_equal); + + gnode reverse = DISCH_TAC(directions[1], "Heq"); + ACCEPT_TAC( + reverse, + ap_term_rule( + `Excl:A->(A)excl`, + assume_rule(`(a:A) == (b:A)`))); + return gnode_prove(root); +} + +PROOF static thm AUTH_EXCL_OWNED_INJ = + prove_auth_excl_owned_inj(); + +PROOF static thm prove_auth_ra_frag_inj(void) { + term goal_tm = ` + forall (f:A) (g:A). + (auth_frag f:(A)excl#A) == auth_frag g <=> f == g + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + auth_frag_def, + get_theorem_by_name("PAIR_EQ")))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_FRAG_INJ = + prove_auth_ra_frag_inj(); + +PROOF static thm prove_auth_ra_both_inj(void) { + term goal_tm = ` + forall (a:A) (f:A) (b:A) (g:A). + (auth_both a f:(A)excl#A) == auth_both b g <=> + a == b && f == g + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + auth_both_def, + get_theorem_by_name("PAIR_EQ"), + AUTH_EXCL_OWNED_INJ))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_BOTH_INJ = + prove_auth_ra_both_inj(); + +PROOF static thm prove_auth_ra_both_ne_frag(void) { + term goal_tm = ` + forall (a:A) (f:A) (g:A). + ~((auth_both a f:(A)excl#A) == auth_frag g) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + auth_both_def, + auth_frag_def, + get_theorem_by_name("PAIR_EQ"), + EXCL_OWNED_NE_UNIT))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_BOTH_NE_FRAG = + prove_auth_ra_both_ne_frag(); + +PROOF static thm prove_auth_ra_auth_inj(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + auth_auth R a == auth_auth R b <=> a == b + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + auth_auth_def, + get_theorem_by_name("PAIR_EQ"), + AUTH_EXCL_OWNED_INJ))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_AUTH_INJ = + prove_auth_ra_auth_inj(); + +PROOF static thm prove_auth_ra_auth_ne_frag(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A). + ~(auth_auth R a == auth_frag f) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + auth_auth_def, + auth_frag_def, + get_theorem_by_name("PAIR_EQ"), + EXCL_OWNED_NE_UNIT))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_AUTH_NE_FRAG = + prove_auth_ra_auth_ne_frag(); + +PROOF static thm prove_auth_ra_auth_eq_both(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A) (f:A). + auth_auth R a == auth_both b f <=> + a == b && f == ra_unit R + `; + gnode root = gnode_new_with_ccl(goal_tm); + thm unit_symmetry = ispecl_rule( + TERM_LIST(`ra_unit (R:(A)ra)`, `f:A`), + get_theorem_by_name("EQ_SYM_EQ")); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + auth_auth_def, + auth_both_def, + get_theorem_by_name("PAIR_EQ"), + AUTH_EXCL_OWNED_INJ, + unit_symmetry))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_AUTH_EQ_BOTH = + prove_auth_ra_auth_eq_both(); + PROOF static thm prove_auth_ra_valid_frag(void) { term goal_tm = ` forall (R:(A)ra) (fragment:A). @@ -664,6 +879,76 @@ PROOF static thm prove_auth_ra_valid_both(void) { PROOF thm AUTH_RA_VALID_BOTH = prove_auth_ra_valid_both(); +PROOF static thm prove_auth_ra_valid_both_intro(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A). + ra_valid R a ==> + ra_included R f a ==> + ra_valid (auth_ra R) (auth_both a f) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm details = conj_rule( + assume_rule(`ra_valid (R:(A)ra) (a:A)`), + assume_rule(`ra_included (R:(A)ra) (f:A) (a:A)`)); + thm characterization = ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `f:A`), + AUTH_RA_VALID_BOTH); + ACCEPT_TAC(body, eq_mp_rule(gsym_rule(characterization), details)); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_VALID_BOTH_INTRO = + prove_auth_ra_valid_both_intro(); + +PROOF static thm prove_auth_ra_valid_both_elim_valid(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A). + ra_valid (auth_ra R) (auth_both a f) ==> + ra_valid R a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm details = eq_mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `f:A`), + AUTH_RA_VALID_BOTH), + assume_rule(` + ra_valid + (auth_ra (R:(A)ra)) + (auth_both (a:A) (f:A)) + `)); + ACCEPT_TAC(body, conjunct1_rule(details)); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_VALID_BOTH_ELIM_VALID = + prove_auth_ra_valid_both_elim_valid(); + +PROOF static thm prove_auth_ra_valid_both_elim_included(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A). + ra_valid (auth_ra R) (auth_both a f) ==> + ra_included R f a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm details = eq_mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `f:A`), + AUTH_RA_VALID_BOTH), + assume_rule(` + ra_valid + (auth_ra (R:(A)ra)) + (auth_both (a:A) (f:A)) + `)); + ACCEPT_TAC(body, conjunct2_rule(details)); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_VALID_BOTH_ELIM_INCLUDED = + prove_auth_ra_valid_both_elim_included(); + PROOF static thm prove_auth_ra_valid_auth(void) { term goal_tm = ` forall (R:(A)ra) (a:A). @@ -689,6 +974,53 @@ PROOF static thm prove_auth_ra_valid_auth(void) { PROOF thm AUTH_RA_VALID_AUTH = prove_auth_ra_valid_auth(); +PROOF static thm prove_auth_ra_valid_auth_frag(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A). + ra_valid + (auth_ra R) + (ra_op + (auth_ra R) + (auth_auth R a) + (auth_frag f)) <=> + ra_valid R a && ra_included R f a + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + AUTH_RA_AUTH_FRAG, + AUTH_RA_VALID_BOTH))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_VALID_AUTH_FRAG = + prove_auth_ra_valid_auth_frag(); + +PROOF static thm prove_auth_ra_valid_both_frag(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A) (g:A). + ra_valid + (auth_ra R) + (ra_op + (auth_ra R) + (auth_both a f) + (auth_frag g)) <=> + ra_valid R a && + ra_included R (ra_op R f g) a + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + AUTH_RA_BOTH_FRAG, + AUTH_RA_VALID_BOTH))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_VALID_BOTH_FRAG = + prove_auth_ra_valid_both_frag(); + PROOF static thm prove_auth_ra_auth_conflict(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (b:A). @@ -720,7 +1052,7 @@ PROOF thm AUTH_RA_AUTH_CONFLICT = /* A valid frame for an authoritative owner cannot itself contain authority. * The remaining SND component is exactly the external fragment observed by * the general update rules below. */ -PROOF static thm prove_auth_ra_valid_both_frame(void) { +PROOF static thm prove_auth_ra_valid_both_frame_components(void) { term goal_tm = ` forall (R:(A)ra) @@ -757,9 +1089,144 @@ PROOF static thm prove_auth_ra_valid_both_frame(void) { return gnode_prove(root); } -PROOF static thm AUTH_RA_VALID_BOTH_FRAME = +PROOF static thm AUTH_RA_VALID_BOTH_FRAME_COMPONENTS = + prove_auth_ra_valid_both_frame_components(); + +/* Constructor-level form of the frame characterization. This is the public + * abstraction boundary: a compatible frame is exactly a fragment-only auth + * resource, without exposing carrier projections to clients. */ +PROOF static thm prove_auth_ra_valid_both_frame(void) { + term goal_tm = ` + forall + (R:(A)ra) + (a:A) + (f:A) + (frame:(A)excl#A). + ra_valid + (auth_ra R) + (ra_op + (auth_ra R) + (auth_both a f) + frame) <=> + exists external:A. + frame == auth_frag external && + ra_valid R a && + ra_included R (ra_op R f external) a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hvalid"); + thm frame_components = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `f:A`, + `frame:(A)excl#A`), + AUTH_RA_VALID_BOTH_FRAME_COMPONENTS), + assume_rule(` + ra_valid + (auth_ra (R:(A)ra)) + (ra_op + (auth_ra R) + (auth_both (a:A) (f:A)) + (frame:(A)excl#A)) + `)); + forward = EXISTS_TAC(forward, `SND (frame:(A)excl#A)`); + gnode_list forward_parts = CONJ_TAC(forward); + + thm frame_eta = gsym_rule(ispec_rule( + `frame:(A)excl#A`, + get_theorem_by_name("PAIR"))); + thm replace_tag = beta_rule(ap_term_rule( + `\tag:(A)excl. (tag,SND (frame:(A)excl#A))`, + conjunct1_rule(frame_components))); + thm fragment_definition = inst_rule( + TERM_PAIR_LIST( + (term_pair){ + `SND (frame:(A)excl#A)`, + `fragment:A`}), + auth_frag_def); + thm frame_is_fragment = trans_rule( + frame_eta, + trans_rule(replace_tag, gsym_rule(fragment_definition))); + ACCEPT_TAC(forward_parts[0], frame_is_fragment); + ACCEPT_TAC(forward_parts[1], conjunct2_rule(frame_components)); + + gnode reverse = DISCH_TAC(directions[1], "Hdetails"); + reverse = ASMP_EXISTS_TAC(reverse, "Hdetails", "external"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hdetails", + "Hframe", + "Hsource"); + + thm frame_eq = assume_rule(` + (frame:(A)excl#A) == auth_frag (external:A) + `); + thm frame_fst = ap_term_rule( + `FST:((A)excl#A)->(A)excl`, + frame_eq); + frame_fst = rewrite_rule( + THM_LIST( + auth_frag_def, + get_theorem_by_name("FST")), + frame_fst); + thm frame_snd = ap_term_rule( + `SND:((A)excl#A)->A`, + frame_eq); + frame_snd = rewrite_rule( + THM_LIST( + auth_frag_def, + get_theorem_by_name("SND")), + frame_snd); + thm source_components = pure_once_rewrite_rule( + THM_LIST(gsym_rule(frame_snd)), + assume_rule(` + ra_valid (R:(A)ra) (a:A) && + ra_included R (ra_op R (f:A) (external:A)) a + `)); + thm raw_components = conj_rule(frame_fst, source_components); + thm raw_characterization = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `f:A`, + `frame:(A)excl#A`), + AUTH_RA_VALID_BOTH_FRAME_COMPONENTS); + ACCEPT_TAC( + reverse, + eq_mp_rule(gsym_rule(raw_characterization), raw_components)); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_VALID_BOTH_FRAME = prove_auth_ra_valid_both_frame(); +/* Authority-only is the unit-fragment specialization of the public combined + * frame theorem. */ +PROOF static thm prove_auth_ra_valid_auth_frame(void) { + term R = `R:(A)ra`; + term a = `a:A`; + term frame = `frame:(A)excl#A`; + thm result = ispecl_rule( + TERM_LIST(R, a, `ra_unit (R:(A)ra)`, frame), + AUTH_RA_VALID_BOTH_FRAME); + result = rewrite_rule( + THM_LIST( + AUTH_RA_BOTH_UNIT, + RA_UNIT_L), + result); + result = gen_rule(frame, result); + result = gen_rule(a, result); + return gen_rule(R, result); +} + +PROOF thm AUTH_RA_VALID_AUTH_FRAME = + prove_auth_ra_valid_auth_frame(); + /* Any two combined resources carry two exclusive authoritative owners. The * exact valid-frame characterization exposes that impossible first component * without unfolding the public constructors in the resulting theorem. */ @@ -788,7 +1255,7 @@ PROOF static thm prove_auth_ra_both_conflict(void) { `a:A`, `f:A`, `auth_both (b:A) (g:A)`), - AUTH_RA_VALID_BOTH_FRAME), + AUTH_RA_VALID_BOTH_FRAME_COMPONENTS), assume_rule(` ra_valid (auth_ra (R:(A)ra)) @@ -813,17 +1280,338 @@ PROOF static thm prove_auth_ra_both_conflict(void) { PROOF thm AUTH_RA_BOTH_CONFLICT = prove_auth_ra_both_conflict(); -/* Cancellativity follows from the carrier product. Auth validity supplies - * the stronger source premise needed by that product, while the operation - * bridge normalizes both sides without exposing the raw descriptor. */ -PROOF static thm prove_auth_ra_cancellative(void) { +PROOF static thm prove_auth_ra_auth_both_conflict(void) { + term R = `R:(A)ra`; + term a = `a:A`; + term b = `b:A`; + term g = `g:A`; + thm result = ispecl_rule( + TERM_LIST(R, a, `ra_unit (R:(A)ra)`, b, g), + AUTH_RA_BOTH_CONFLICT); + result = pure_once_rewrite_rule( + THM_LIST(AUTH_RA_BOTH_UNIT), + result); + result = gen_rule(g, result); + result = gen_rule(b, result); + result = gen_rule(a, result); + return gen_rule(R, result); +} + +PROOF thm AUTH_RA_AUTH_BOTH_CONFLICT = + prove_auth_ra_auth_both_conflict(); + +PROOF static thm prove_auth_ra_both_exclusive(void) { term goal_tm = ` - forall R:(A)ra. - ra_cancellative R ==> - ra_cancellative (auth_ra R) + forall (R:(A)ra) (a:A) (f:A). + ra_exclusive R f ==> + ra_exclusive (auth_ra R) (auth_both a f) `; gnode root = gnode_new_with_ccl(goal_tm); - gnode body = GEN_TAC(root, "R"); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_exclusive_def))); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hvalid_frame"); + + thm frame_details = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `f:A`, + `frame:(A)excl#A`), + AUTH_RA_VALID_BOTH_FRAME), + assume_rule(` + ra_valid + (auth_ra (R:(A)ra)) + (ra_op + (auth_ra R) + (auth_both (a:A) (f:A)) + (frame:(A)excl#A)) + `)); + body = ASSUME_TAC(body, frame_details, "Hframe_details"); + body = ASMP_EXISTS_TAC(body, "Hframe_details", "external"); + body = ASMP_CONJ_TAC( + body, + "Hframe_details", + "Hframe", + "Hsource"); + + thm source_valid = match_mp_rule( + match_mp_rule( + RA_INCLUDED_VALID, + conjunct2_rule(assume_rule(` + ra_valid (R:(A)ra) (a:A) && + ra_included + R + (ra_op R (f:A) (external:A)) + a + `))), + conjunct1_rule(assume_rule(` + ra_valid (R:(A)ra) (a:A) && + ra_included + R + (ra_op R (f:A) (external:A)) + a + `))); + thm exclusive = rewrite_rule( + THM_LIST(ra_exclusive_def), + assume_rule(`ra_exclusive (R:(A)ra) (f:A)`)); + thm external_is_unit = mp_rule( + spec_rule(`external:A`, exclusive), + source_valid); + + thm replace_external = ap_term_rule( + `auth_frag:A->(A)excl#A`, + external_is_unit); + thm unit_equation = ispec_rule(`R:(A)ra`, AUTH_RA_UNIT); + thm result = trans_rule( + assume_rule(` + (frame:(A)excl#A) == auth_frag (external:A) + `), + trans_rule(replace_external, gsym_rule(unit_equation))); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_BOTH_EXCLUSIVE = + prove_auth_ra_both_exclusive(); + +/* ExclUnit is the exclusive RA unit and is therefore included in every + * exclusive carrier element. */ +PROOF static thm prove_auth_excl_unit_included(void) { + thm result = ispec_rule( + `excl_ra:((A)excl)ra`, + RA_INCLUDED_UNIT); + return pure_rewrite_rule( + THM_LIST(EXCL_RA_UNIT), + result); +} + +PROOF static thm AUTH_EXCL_UNIT_INCLUDED = + prove_auth_excl_unit_included(); + +/* An owned exclusive element cannot extend to ExclUnit. Deriving this from + * semantic exclusivity avoids unfolding the raw exclusive operation. */ +PROOF static thm prove_auth_excl_owned_not_included_unit(void) { + term goal_tm = ` + forall a:A. + ~(ra_included + (excl_ra:((A)excl)ra) + (Excl a) + (ExclUnit:(A)excl)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "a"); + body = DISCH_TAC(body, "Hincluded"); + thm forced_equal = ispecl_rule( + TERM_LIST( + `excl_ra:((A)excl)ra`, + `Excl (a:A):(A)excl`, + `ExclUnit:(A)excl`), + RA_EXCLUSIVE_INCLUDED); + forced_equal = mp_rule( + forced_equal, + ispec_rule(`a:A`, EXCL_RA_EXCLUSIVE)); + forced_equal = mp_rule( + forced_equal, + EXCL_RA_VALID_UNIT); + forced_equal = mp_rule( + forced_equal, + assume_rule(` + ra_included + (excl_ra:((A)excl)ra) + (Excl (a:A)) + (ExclUnit:(A)excl) + `)); + thm contradiction = not_elim_rule( + ispec_rule(`a:A`, EXCL_OWNED_NE_UNIT), + forced_equal); + CONTR_TAC(body, contradiction); + return gnode_prove(root); +} + +PROOF static thm AUTH_EXCL_OWNED_NOT_INCLUDED_UNIT = + prove_auth_excl_owned_not_included_unit(); + +/* Shared reduction for the complete constructor-inclusion table. */ +PROOF static conv auth_included_reduce_conv(void) { + return rewrite_conv(THM_LIST( + AUTH_RA_INCLUDED_COMPONENTS, + auth_auth_def, + auth_frag_def, + auth_both_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + AUTH_EXCL_UNIT_INCLUDED, + AUTH_EXCL_OWNED_NOT_INCLUDED_UNIT, + EXCL_RA_INCLUDED_OWNED, + RA_INCLUDED_UNIT)); +} + +PROOF static thm prove_auth_ra_included_frag_frag(void) { + term goal_tm = ` + forall (R:(A)ra) (f:A) (g:A). + ra_included + (auth_ra R) + (auth_frag f) + (auth_frag g) <=> + ra_included R f g + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC(root, auth_included_reduce_conv()); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_INCLUDED_FRAG_FRAG = + prove_auth_ra_included_frag_frag(); + +PROOF static thm prove_auth_ra_included_frag_auth(void) { + term goal_tm = ` + forall (R:(A)ra) (f:A) (a:A). + ra_included + (auth_ra R) + (auth_frag f) + (auth_auth R a) <=> + ra_included R f (ra_unit R) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC(root, auth_included_reduce_conv()); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_INCLUDED_FRAG_AUTH = + prove_auth_ra_included_frag_auth(); + +PROOF static thm prove_auth_ra_included_frag_both(void) { + term goal_tm = ` + forall (R:(A)ra) (f:A) (a:A) (g:A). + ra_included + (auth_ra R) + (auth_frag f) + (auth_both a g) <=> + ra_included R f g + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC(root, auth_included_reduce_conv()); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_INCLUDED_FRAG_BOTH = + prove_auth_ra_included_frag_both(); + +PROOF static thm prove_auth_ra_included_auth_frag(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (g:A). + ~(ra_included + (auth_ra R) + (auth_auth R a) + (auth_frag g)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC(root, auth_included_reduce_conv()); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_INCLUDED_AUTH_FRAG = + prove_auth_ra_included_auth_frag(); + +PROOF static thm prove_auth_ra_included_auth_auth(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_included + (auth_ra R) + (auth_auth R a) + (auth_auth R b) <=> + a == b + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC(root, auth_included_reduce_conv()); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_INCLUDED_AUTH_AUTH = + prove_auth_ra_included_auth_auth(); + +PROOF static thm prove_auth_ra_included_auth_both(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A) (g:A). + ra_included + (auth_ra R) + (auth_auth R a) + (auth_both b g) <=> + a == b + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC(root, auth_included_reduce_conv()); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_INCLUDED_AUTH_BOTH = + prove_auth_ra_included_auth_both(); + +PROOF static thm prove_auth_ra_included_both_frag(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A) (g:A). + ~(ra_included + (auth_ra R) + (auth_both a f) + (auth_frag g)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC(root, auth_included_reduce_conv()); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_INCLUDED_BOTH_FRAG = + prove_auth_ra_included_both_frag(); + +PROOF static thm prove_auth_ra_included_both_auth(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A) (b:A). + ra_included + (auth_ra R) + (auth_both a f) + (auth_auth R b) <=> + a == b && ra_included R f (ra_unit R) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC(root, auth_included_reduce_conv()); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_INCLUDED_BOTH_AUTH = + prove_auth_ra_included_both_auth(); + +PROOF static thm prove_auth_ra_included_both_both(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + ra_included + (auth_ra R) + (auth_both a f) + (auth_both b g) <=> + a == b && ra_included R f g + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC(root, auth_included_reduce_conv()); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_INCLUDED_BOTH_BOTH = + prove_auth_ra_included_both_both(); + +/* Cancellativity follows from the carrier product. Auth validity supplies + * the stronger source premise needed by that product, while the operation + * bridge normalizes both sides without exposing the raw descriptor. */ +PROOF static thm prove_auth_ra_cancellative(void) { + term goal_tm = ` + forall R:(A)ra. + ra_cancellative R ==> + ra_cancellative (auth_ra R) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); body = DISCH_TAC(body, "Hbase_cancellative"); body = CONV_TAC( body, @@ -919,42 +1707,98 @@ PROOF static thm prove_auth_ra_cancellative(void) { PROOF thm AUTH_RA_CANCELLATIVE = prove_auth_ra_cancellative(); -/* Swap the final two factors while retaining a stable left prefix. Keeping - * this small AC fact explicit makes allocation proofs independent of global - * rewrite ordering. */ -PROOF static thm prove_auth_ra_op_swap_right(void) { - term R = `R:(A)ra`; - term a = `a:A`; - term b = `b:A`; - term c = `c:A`; - thm associated_left = ispecl_rule( - TERM_LIST(R, a, b, c), - RA_ASSOC); - thm commute_inner = beta_rule(ap_term_rule( - `\x:A. ra_op (R:(A)ra) (a:A) x`, +PROOF static thm prove_auth_ra_cancellative_iff(void) { + term goal_tm = ` + forall R:(A)ra. + ra_cancellative (auth_ra R) <=> ra_cancellative R + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC( + directions[0], + "Hauth_cancellative"); + forward = CONV_TAC( + forward, + once_rewrite_conv(THM_LIST(ra_cancellative_def))); + forward = GEN_TAC(forward, "frame"); + forward = GEN_TAC(forward, "a"); + forward = GEN_TAC(forward, "b"); + forward = DISCH_TAC(forward, "Hsource_valid"); + forward = DISCH_TAC(forward, "Hops_equal"); + + term source = `ra_op (R:(A)ra) (frame:A) (a:A)`; + thm lifted_source_valid = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, source), + AUTH_RA_VALID_FRAG)), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (frame:A) (a:A)) + `)); + thm left_op = ispecl_rule( + TERM_LIST(`R:(A)ra`, `frame:A`, `a:A`), + AUTH_RA_FRAG_FRAG); + thm lifted_source_eq = ap_term_rule( + `ra_valid (auth_ra (R:(A)ra))`, + left_op); + lifted_source_valid = eq_mp_rule( + gsym_rule(lifted_source_eq), + lifted_source_valid); + + thm lifted_base_eq = ap_term_rule( + `auth_frag:A->(A)excl#A`, + assume_rule(` + ra_op (R:(A)ra) (frame:A) (a:A) == + ra_op R frame (b:A) + `)); + thm right_op = ispecl_rule( + TERM_LIST(`R:(A)ra`, `frame:A`, `b:A`), + AUTH_RA_FRAG_FRAG); + thm lifted_ops_equal = trans_rule( + left_op, + trans_rule(lifted_base_eq, gsym_rule(right_op))); + + thm fragment_equality = ispecl_rule( + TERM_LIST( + `auth_ra (R:(A)ra)`, + `auth_frag (frame:A)`, + `auth_frag (a:A)`, + `auth_frag (b:A)`), + RA_CANCELLATIVE_APPLY); + fragment_equality = mp_rule( + fragment_equality, + assume_rule(`ra_cancellative (auth_ra (R:(A)ra))`)); + fragment_equality = mp_rule(fragment_equality, lifted_source_valid); + fragment_equality = mp_rule(fragment_equality, lifted_ops_equal); + thm payload_equality = eq_mp_rule( ispecl_rule( - TERM_LIST(R, b, c), - RA_COMM))); - thm associated_right = gsym_rule(ispecl_rule( - TERM_LIST(R, a, c, b), - RA_ASSOC)); - thm result = trans_rule( - associated_left, - trans_rule(commute_inner, associated_right)); - result = gen_rule(c, result); - result = gen_rule(b, result); - result = gen_rule(a, result); - return gen_rule(R, result); + TERM_LIST(`a:A`, `b:A`), + AUTH_RA_FRAG_INJ), + fragment_equality); + ACCEPT_TAC(forward, payload_equality); + + gnode reverse = DISCH_TAC( + directions[1], + "Hbase_cancellative"); + ACCEPT_TAC( + reverse, + mp_rule( + ispec_rule(`R:(A)ra`, AUTH_RA_CANCELLATIVE), + assume_rule(`ra_cancellative (R:(A)ra)`))); + return gnode_prove(root); } -PROOF static thm AUTH_RA_OP_SWAP_RIGHT = - prove_auth_ra_op_swap_right(); +PROOF thm AUTH_RA_CANCELLATIVE_IFF = + prove_auth_ra_cancellative_iff(); /* ------------------------------------------------------------------------- */ /* General frame-preserving updates */ /* ------------------------------------------------------------------------- */ -PROOF static thm prove_auth_ra_update(void) { +PROOF static thm prove_auth_ra_update_framewise(void) { term goal_tm = ` forall (R:(A)ra) @@ -984,7 +1828,7 @@ PROOF static thm prove_auth_ra_update(void) { `a:A`, `f:A`, `frame:(A)excl#A`), - AUTH_RA_VALID_BOTH_FRAME); + AUTH_RA_VALID_BOTH_FRAME_COMPONENTS); thm source_details = eq_mp_rule( source_characterization, assume_rule(` @@ -1018,81 +1862,235 @@ PROOF static thm prove_auth_ra_update(void) { `b:A`, `g:A`, `frame:(A)excl#A`), - AUTH_RA_VALID_BOTH_FRAME); + AUTH_RA_VALID_BOTH_FRAME_COMPONENTS); ACCEPT_TAC( body, eq_mp_rule(gsym_rule(target_characterization), target_details)); return gnode_prove(root); } -PROOF thm AUTH_RA_UPDATE = - prove_auth_ra_update(); +PROOF thm AUTH_RA_UPDATE_FRAMEWISE = + prove_auth_ra_update_framewise(); -PROOF static thm prove_auth_ra_update_nd(void) { +PROOF static thm prove_auth_ra_update_framewise_iff(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (f:A) - (P:A->A->bool). - (forall external:A. - ra_valid R a && - ra_included R (ra_op R f external) a ==> - exists (b:A) (g:A). - P b g && - ra_valid R b && - ra_included R (ra_op R g external) b) ==> - ra_update_nd + (b:A) + (g:A). + ra_update (auth_ra R) (auth_both a f) - (\candidate:(A)excl#A. - exists (b:A) (g:A). - P b g && - candidate == auth_both b g) + (auth_both b g) <=> + forall external:A. + ra_valid R a && + ra_included R (ra_op R f external) a ==> + ra_valid R b && + ra_included R (ra_op R g external) b `; gnode root = gnode_new_with_ccl(goal_tm); - gnode body = CONV_TAC( - root, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); - body = CONV_TAC( - body, - depth_conv(get_conversion_by_name("BETA_CONV"))); - body = AUTO_INTROS_TAC(body); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); - thm source_characterization = ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `a:A`, - `f:A`, - `frame:(A)excl#A`), - AUTH_RA_VALID_BOTH_FRAME); - thm source_details = eq_mp_rule( - source_characterization, + gnode forward = DISCH_TAC(directions[0], "Hupdate"); + forward = GEN_TAC(forward, "external"); + forward = DISCH_TAC(forward, "Hsource"); + thm source_valid = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `f:A`, + `external:A`), + AUTH_RA_VALID_BOTH_FRAG)), assume_rule(` - ra_valid + ra_valid (R:(A)ra) (a:A) && + ra_included + R + (ra_op R (f:A) (external:A)) + a + `)); + thm update_rule = rewrite_rule( + THM_LIST(ra_update_def), + assume_rule(` + ra_update (auth_ra (R:(A)ra)) - (ra_op - (auth_ra R) - (auth_both (a:A) (f:A)) - (frame:(A)excl#A)) + (auth_both (a:A) (f:A)) + (auth_both (b:A) (g:A)) `)); - thm selected = mp_rule( - spec_rule( - `SND (frame:(A)excl#A)`, + thm target_valid = mp_rule( + spec_rule(`auth_frag (external:A)`, update_rule), + source_valid); + thm target_details = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `b:A`, + `g:A`, + `external:A`), + AUTH_RA_VALID_BOTH_FRAG), + target_valid); + ACCEPT_TAC(forward, target_details); + + gnode reverse = DISCH_TAC(directions[1], "Hframewise"); + ACCEPT_TAC( + reverse, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `f:A`, + `b:A`, + `g:A`), + AUTH_RA_UPDATE_FRAMEWISE), assume_rule(` forall external:A. ra_valid (R:(A)ra) (a:A) && ra_included R (ra_op R (f:A) external) a ==> - exists (b:A) (g:A). - (P:A->A->bool) b g && - ra_valid R b && - ra_included R (ra_op R g external) b - `)), - conjunct2_rule(source_details)); - body = ASSUME_TAC(body, selected, "Hselected"); - body = ASMP_EXISTS_TAC(body, "Hselected", "b"); - body = ASMP_EXISTS_TAC(body, "Hselected", "g"); - body = ASMP_CONJ_TAC( + ra_valid R (b:A) && + ra_included R (ra_op R (g:A) external) b + `))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_UPDATE_FRAMEWISE_IFF = + prove_auth_ra_update_framewise_iff(); + +/* Iris-style auth update. A local update preserves the exact residual + * witness behind any source inclusion; the framewise auth criterion then + * turns that base fact into a frame-preserving update of authoritative + * resources. */ +PROOF static thm prove_auth_ra_update(void) { + term goal_tm = ` + forall + (R:(A)ra) + (a:A) + (f:A) + (b:A) + (g:A). + ra_local_update R (a,f) (b,g) ==> + ra_update + (auth_ra R) + (auth_both a f) + (auth_both b g) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = MATCH_MP_TAC( + body, + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `f:A`, + `b:A`, + `g:A`), + AUTH_RA_UPDATE_FRAMEWISE)); + body = GEN_TAC(body, "external"); + body = DISCH_TAC(body, "Hsource"); + body = ASMP_CONJ_TAC( + body, + "Hsource", + "Hauthoritative_valid", + "Hincluded"); + thm preserved = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `f:A`, + `b:A`, + `g:A`, + `external:A`), + RA_LOCAL_UPDATE_PRESERVES_INCLUDED); + preserved = mp_rule( + preserved, + assume_rule(`ra_local_update (R:(A)ra) (a,f) (b,g)`)); + preserved = mp_rule( + preserved, + assume_rule(`ra_valid (R:(A)ra) (a:A)`)); + preserved = mp_rule( + preserved, + assume_rule(` + ra_included + (R:(A)ra) + (ra_op R (f:A) (external:A)) + (a:A) + `)); + ACCEPT_TAC(body, preserved); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_UPDATE = + prove_auth_ra_update(); + +PROOF static thm prove_auth_ra_update_nd(void) { + term goal_tm = ` + forall + (R:(A)ra) + (a:A) + (f:A) + (P:A->A->bool). + (forall external:A. + ra_valid R a && + ra_included R (ra_op R f external) a ==> + exists (b:A) (g:A). + P b g && + ra_valid R b && + ra_included R (ra_op R g external) b) ==> + ra_update_nd + (auth_ra R) + (auth_both a f) + (\candidate:(A)excl#A. + exists (b:A) (g:A). + P b g && + candidate == auth_both b g) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = AUTO_INTROS_TAC(body); + + thm source_characterization = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `f:A`, + `frame:(A)excl#A`), + AUTH_RA_VALID_BOTH_FRAME_COMPONENTS); + thm source_details = eq_mp_rule( + source_characterization, + assume_rule(` + ra_valid + (auth_ra (R:(A)ra)) + (ra_op + (auth_ra R) + (auth_both (a:A) (f:A)) + (frame:(A)excl#A)) + `)); + thm selected = mp_rule( + spec_rule( + `SND (frame:(A)excl#A)`, + assume_rule(` + forall external:A. + ra_valid (R:(A)ra) (a:A) && + ra_included R (ra_op R (f:A) external) a ==> + exists (b:A) (g:A). + (P:A->A->bool) b g && + ra_valid R b && + ra_included R (ra_op R g external) b + `)), + conjunct2_rule(source_details)); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "b"); + body = ASMP_EXISTS_TAC(body, "Hselected", "g"); + body = ASMP_CONJ_TAC( body, "Hselected", "HP", @@ -1126,7 +2124,7 @@ PROOF static thm prove_auth_ra_update_nd(void) { `b:A`, `g:A`, `frame:(A)excl#A`), - AUTH_RA_VALID_BOTH_FRAME); + AUTH_RA_VALID_BOTH_FRAME_COMPONENTS); ACCEPT_TAC( result[1], eq_mp_rule(gsym_rule(target_characterization), target_details)); @@ -1136,6 +2134,742 @@ PROOF static thm prove_auth_ra_update_nd(void) { PROOF thm AUTH_RA_UPDATE_ND = prove_auth_ra_update_nd(); +PROOF static thm prove_auth_ra_update_nd_framewise_iff(void) { + term goal_tm = ` + forall + (R:(A)ra) + (a:A) + (f:A) + (P:A->A->bool). + ra_update_nd + (auth_ra R) + (auth_both a f) + (\candidate:(A)excl#A. + exists (b:A) (g:A). + P b g && + candidate == auth_both b g) <=> + forall external:A. + ra_valid R a && + ra_included R (ra_op R f external) a ==> + exists (b:A) (g:A). + P b g && + ra_valid R b && + ra_included R (ra_op R g external) b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hupdate_nd"); + forward = GEN_TAC(forward, "external"); + forward = DISCH_TAC(forward, "Hsource"); + thm source_valid = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `f:A`, + `external:A`), + AUTH_RA_VALID_BOTH_FRAG)), + assume_rule(` + ra_valid (R:(A)ra) (a:A) && + ra_included + R + (ra_op R (f:A) (external:A)) + a + `)); + thm update_rule = rewrite_rule( + THM_LIST(ra_update_nd_def), + assume_rule(` + ra_update_nd + (auth_ra (R:(A)ra)) + (auth_both (a:A) (f:A)) + (\candidate:(A)excl#A. + exists (b:A) (g:A). + (P:A->A->bool) b g && + candidate == auth_both b g) + `)); + thm selected = mp_rule( + spec_rule(`auth_frag (external:A)`, update_rule), + source_valid); + selected = conv_rule( + depth_conv(get_conversion_by_name("BETA_CONV")), + selected); + forward = ASSUME_TAC(forward, selected, "Hselected"); + forward = ASMP_EXISTS_TAC(forward, "Hselected", "candidate"); + forward = ASMP_CONJ_TAC( + forward, + "Hselected", + "Hpredicate", + "Htarget_valid"); + forward = ASMP_EXISTS_TAC(forward, "Hpredicate", "b"); + forward = ASMP_EXISTS_TAC(forward, "Hpredicate", "g"); + forward = ASMP_CONJ_TAC( + forward, + "Hpredicate", + "HP", + "Hcandidate"); + + thm replace_candidate = beta_rule(ap_term_rule( + `\x:(A)excl#A. + ra_valid + (auth_ra (R:(A)ra)) + (ra_op + (auth_ra R) + x + (auth_frag (external:A)))`, + assume_rule(` + (candidate:(A)excl#A) == + auth_both (b:A) (g:A) + `))); + thm target_valid = eq_mp_rule( + replace_candidate, + assume_rule(` + ra_valid + (auth_ra (R:(A)ra)) + (ra_op + (auth_ra R) + (candidate:(A)excl#A) + (auth_frag (external:A))) + `)); + thm target_details = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `b:A`, + `g:A`, + `external:A`), + AUTH_RA_VALID_BOTH_FRAG), + target_valid); + + forward = EXISTS_TAC(forward, `b:A`); + forward = EXISTS_TAC(forward, `g:A`); + gnode_list result = CONJ_TAC(forward); + ACCEPT_TAC( + result[0], + assume_rule(`(P:A->A->bool) (b:A) (g:A)`)); + ACCEPT_TAC(result[1], target_details); + + gnode reverse = DISCH_TAC(directions[1], "Hframewise"); + ACCEPT_TAC( + reverse, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `f:A`, + `P:A->A->bool`), + AUTH_RA_UPDATE_ND), + assume_rule(` + forall external:A. + ra_valid (R:(A)ra) (a:A) && + ra_included R (ra_op R (f:A) external) a ==> + exists (b:A) (g:A). + (P:A->A->bool) b g && + ra_valid R b && + ra_included R (ra_op R g external) b + `))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_UPDATE_ND_FRAMEWISE_IFF = + prove_auth_ra_update_nd_framewise_iff(); + +/* ------------------------------------------------------------------------- */ +/* Exact authority and weakening updates */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_auth_ra_update_auth_iff(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_update + (auth_ra R) + (auth_auth R a) + (auth_auth R b) <=> + (ra_valid R a ==> + ra_valid R b && ra_included R a b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + thm framewise_characterization = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `ra_unit (R:(A)ra)`, + `b:A`, + `ra_unit (R:(A)ra)`), + AUTH_RA_UPDATE_FRAMEWISE_IFF); + framewise_characterization = rewrite_rule( + THM_LIST( + AUTH_RA_BOTH_UNIT, + RA_UNIT_L), + framewise_characterization); + + gnode forward = DISCH_TAC(directions[0], "Hupdate"); + forward = DISCH_TAC(forward, "Hsource_valid"); + thm framewise = eq_mp_rule( + framewise_characterization, + assume_rule(` + ra_update + (auth_ra (R:(A)ra)) + (auth_auth R (a:A)) + (auth_auth R (b:A)) + `)); + thm source_at_self = conj_rule( + assume_rule(`ra_valid (R:(A)ra) (a:A)`), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + RA_INCLUDED_REFL)); + thm target_at_self = mp_rule( + spec_rule(`a:A`, framewise), + source_at_self); + ACCEPT_TAC(forward, target_at_self); + + gnode reverse = DISCH_TAC(directions[1], "Hcondition"); + thm update_rule = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `ra_unit (R:(A)ra)`, + `b:A`, + `ra_unit (R:(A)ra)`), + AUTH_RA_UPDATE_FRAMEWISE); + update_rule = rewrite_rule( + THM_LIST( + AUTH_RA_BOTH_UNIT, + RA_UNIT_L), + update_rule); + reverse = MATCH_MP_TAC(reverse, update_rule); + reverse = GEN_TAC(reverse, "external"); + reverse = DISCH_TAC(reverse, "Hsource"); + thm target_base = mp_rule( + assume_rule(` + ra_valid (R:(A)ra) (a:A) ==> + ra_valid R (b:A) && ra_included R a b + `), + conjunct1_rule(assume_rule(` + ra_valid (R:(A)ra) (a:A) && + ra_included R (external:A) a + `))); + thm target_included = match_mp_rule( + match_mp_rule( + RA_INCLUDED_TRANS, + conjunct2_rule(assume_rule(` + ra_valid (R:(A)ra) (a:A) && + ra_included R (external:A) a + `))), + conjunct2_rule(target_base)); + ACCEPT_TAC( + reverse, + conj_rule(conjunct1_rule(target_base), target_included)); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_UPDATE_AUTH_IFF = + prove_auth_ra_update_auth_iff(); + +PROOF static thm prove_auth_ra_update_auth_included(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_valid R b ==> + ra_included R a b ==> + ra_update + (auth_ra R) + (auth_auth R a) + (auth_auth R b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(AUTH_RA_UPDATE_AUTH_IFF))); + body = DISCH_TAC(body, "Hsource_valid"); + ACCEPT_TAC( + body, + conj_rule( + assume_rule(`ra_valid (R:(A)ra) (b:A)`), + assume_rule(`ra_included (R:(A)ra) (a:A) (b:A)`))); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_UPDATE_AUTH_INCLUDED = + prove_auth_ra_update_auth_included(); + +PROOF static thm prove_auth_ra_update_drop_frag(void) { + term R = `R:(A)ra`; + term a = `a:A`; + term f = `f:A`; + term auth = `auth_ra (R:(A)ra)`; + term authority = `auth_auth (R:(A)ra) (a:A)`; + term fragment = `auth_frag (f:A)`; + term combined = `auth_both (a:A) (f:A)`; + thm included = ispecl_rule( + TERM_LIST(auth, authority, fragment), + RA_INCLUDED_OP_L); + included = rewrite_rule( + THM_LIST(AUTH_RA_AUTH_FRAG), + included); + thm result = mp_rule( + ispecl_rule( + TERM_LIST(auth, combined, authority), + RA_UPDATE_INCLUDED), + included); + result = gen_rule(f, result); + result = gen_rule(a, result); + return gen_rule(R, result); +} + +PROOF thm AUTH_RA_UPDATE_DROP_FRAG = + prove_auth_ra_update_drop_frag(); + +PROOF static thm prove_auth_ra_update_drop_auth(void) { + term R = `R:(A)ra`; + term a = `a:A`; + term f = `f:A`; + term auth = `auth_ra (R:(A)ra)`; + term authority = `auth_auth (R:(A)ra) (a:A)`; + term fragment = `auth_frag (f:A)`; + term combined = `auth_both (a:A) (f:A)`; + thm included = ispecl_rule( + TERM_LIST(auth, authority, fragment), + RA_INCLUDED_OP_R); + included = rewrite_rule( + THM_LIST(AUTH_RA_AUTH_FRAG), + included); + thm result = mp_rule( + ispecl_rule( + TERM_LIST(auth, combined, fragment), + RA_UPDATE_INCLUDED), + included); + result = gen_rule(f, result); + result = gen_rule(a, result); + return gen_rule(R, result); +} + +PROOF thm AUTH_RA_UPDATE_DROP_AUTH = + prove_auth_ra_update_drop_auth(); + +PROOF static thm prove_auth_ra_update_weaken_frag(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A) (g:A). + ra_included R g f ==> + ra_update + (auth_ra R) + (auth_both a f) + (auth_both a g) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm details = conj_rule( + refl_rule(`a:A`), + assume_rule(`ra_included (R:(A)ra) (g:A) (f:A)`)); + thm included = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `g:A`, + `a:A`, + `f:A`), + AUTH_RA_INCLUDED_BOTH_BOTH)), + details); + thm updated = mp_rule( + ispecl_rule( + TERM_LIST( + `auth_ra (R:(A)ra)`, + `auth_both (a:A) (f:A)`, + `auth_both (a:A) (g:A)`), + RA_UPDATE_INCLUDED), + included); + ACCEPT_TAC(body, updated); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_UPDATE_WEAKEN_FRAG = + prove_auth_ra_update_weaken_frag(); + +PROOF static thm prove_auth_ra_frag_update_included(void) { + term goal_tm = ` + forall (R:(A)ra) (f:A) (g:A). + ra_included R g f ==> + ra_update + (auth_ra R) + (auth_frag f) + (auth_frag g) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm included = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `g:A`, `f:A`), + AUTH_RA_INCLUDED_FRAG_FRAG)), + assume_rule(`ra_included (R:(A)ra) (g:A) (f:A)`)); + thm updated = mp_rule( + ispecl_rule( + TERM_LIST( + `auth_ra (R:(A)ra)`, + `auth_frag (f:A)`, + `auth_frag (g:A)`), + RA_UPDATE_INCLUDED), + included); + ACCEPT_TAC(body, updated); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_FRAG_UPDATE_INCLUDED = + prove_auth_ra_frag_update_included(); + +PROOF static thm prove_auth_ra_update_both_included(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A) (f:A). + ra_valid R b ==> + ra_included R a b ==> + ra_update + (auth_ra R) + (auth_both a f) + (auth_both b f) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm authority_update = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `b:A`), + AUTH_RA_UPDATE_AUTH_INCLUDED), + assume_rule(`ra_valid (R:(A)ra) (b:A)`)), + assume_rule(`ra_included (R:(A)ra) (a:A) (b:A)`)); + thm framed = mp_rule( + ispecl_rule( + TERM_LIST( + `auth_ra (R:(A)ra)`, + `auth_auth (R:(A)ra) (a:A)`, + `auth_auth (R:(A)ra) (b:A)`), + RA_UPDATE_FRAME), + authority_update); + framed = spec_rule(`auth_frag (f:A)`, framed); + framed = rewrite_rule( + THM_LIST(AUTH_RA_AUTH_FRAG), + framed); + ACCEPT_TAC(body, framed); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_UPDATE_BOTH_INCLUDED = + prove_auth_ra_update_both_included(); + +/* Iris `auth_update_alloc`: authority-only is the unit-fragment instance of + * the general local-update lifting rule. */ +PROOF static thm prove_auth_ra_update_alloc(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A) (g:A). + ra_local_update R (a,ra_unit R) (b,g) ==> + ra_update + (auth_ra R) + (auth_auth R a) + (auth_both b g) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm updated = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `ra_unit (R:(A)ra)`, + `b:A`, + `g:A`), + AUTH_RA_UPDATE), + assume_rule(` + ra_local_update + (R:(A)ra) + ((a:A),ra_unit R) + ((b:A),(g:A)) + `)); + updated = rewrite_rule( + THM_LIST(AUTH_RA_BOTH_UNIT), + updated); + ACCEPT_TAC(body, updated); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_UPDATE_ALLOC = + prove_auth_ra_update_alloc(); + +/* Iris `auth_update_dealloc`: a unit target fragment is exactly the public + * authority-only constructor. */ +PROOF static thm prove_auth_ra_update_dealloc(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A) (b:A). + ra_local_update R (a,f) (b,ra_unit R) ==> + ra_update + (auth_ra R) + (auth_both a f) + (auth_auth R b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm updated = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `f:A`, + `b:A`, + `ra_unit (R:(A)ra)`), + AUTH_RA_UPDATE), + assume_rule(` + ra_local_update + (R:(A)ra) + ((a:A),(f:A)) + ((b:A),ra_unit R) + `)); + updated = rewrite_rule( + THM_LIST(AUTH_RA_BOTH_UNIT), + updated); + ACCEPT_TAC(body, updated); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_UPDATE_DEALLOC = + prove_auth_ra_update_dealloc(); + +/* Iris `auth_update_auth`: first expose the fragment produced by the local + * update, then apply the public fragment-dropping rule. */ +PROOF static thm prove_auth_ra_update_auth(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A) (g:A). + ra_local_update R (a,ra_unit R) (b,g) ==> + ra_update + (auth_ra R) + (auth_auth R a) + (auth_auth R b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm allocated = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `b:A`, + `g:A`), + AUTH_RA_UPDATE_ALLOC), + assume_rule(` + ra_local_update + (R:(A)ra) + ((a:A),ra_unit R) + ((b:A),(g:A)) + `)); + + thm discard_fragment = ispecl_rule( + TERM_LIST(`R:(A)ra`, `b:A`, `g:A`), + AUTH_RA_UPDATE_DROP_FRAG); + thm result = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `auth_ra (R:(A)ra)`, + `auth_auth (R:(A)ra) (a:A)`, + `auth_both (b:A) (g:A)`, + `auth_auth (R:(A)ra) (b:A)`), + RA_UPDATE_TRANS), + allocated), + discard_fragment); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_UPDATE_AUTH = + prove_auth_ra_update_auth(); + +PROOF static thm prove_auth_ra_local_update(void) { + term goal_tm = ` + forall + (R:(A)ra) + (a:A) + (b0:A) + (b1:A) + (a_new:A) + (b0_new:A) + (b1_new:A). + ra_local_update R (b0,b1) (b0_new,b1_new) ==> + ra_included R b0_new a_new ==> + ra_valid R a_new ==> + ra_local_update + (auth_ra R) + (auth_both a b0,auth_both a b1) + (auth_both a_new b0_new,auth_both a_new b1_new) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_local_update_def))); + body = CONV_TAC( + body, + rewrite_conv(THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + body = AUTO_INTROS_TAC(body); + + thm source_validity_eq = beta_rule(ap_term_rule( + `\x:(A)excl#A. + ra_valid (auth_ra (R:(A)ra)) x`, + assume_rule(` + auth_both (a:A) (b0:A) == + ra_op + (auth_ra (R:(A)ra)) + (auth_both a (b1:A)) + (frame:(A)excl#A) + `))); + thm source_owned_frame_valid = eq_mp_rule( + source_validity_eq, + assume_rule(` + ra_valid + (auth_ra (R:(A)ra)) + (auth_both (a:A) (b0:A)) + `)); + thm frame_details = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `b1:A`, + `frame:(A)excl#A`), + AUTH_RA_VALID_BOTH_FRAME), + source_owned_frame_valid); + body = ASSUME_TAC(body, frame_details, "Hframe_details"); + body = ASMP_EXISTS_TAC(body, "Hframe_details", "external"); + body = ASMP_CONJ_TAC( + body, + "Hframe_details", + "Hframe", + "Hsource_details"); + + thm source_authority_valid = mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `b0:A`), + AUTH_RA_VALID_BOTH_ELIM_VALID), + assume_rule(` + ra_valid + (auth_ra (R:(A)ra)) + (auth_both (a:A) (b0:A)) + `)); + thm source_fragment_included = mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `b0:A`), + AUTH_RA_VALID_BOTH_ELIM_INCLUDED), + assume_rule(` + ra_valid + (auth_ra (R:(A)ra)) + (auth_both (a:A) (b0:A)) + `)); + thm source_fragment_valid = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `b0:A`, `a:A`), + RA_INCLUDED_VALID), + source_fragment_included), + source_authority_valid); + + thm normalized_source_eq = rewrite_rule( + THM_LIST( + assume_rule(` + (frame:(A)excl#A) == auth_frag (external:A) + `), + AUTH_RA_BOTH_FRAG), + assume_rule(` + auth_both (a:A) (b0:A) == + ra_op + (auth_ra (R:(A)ra)) + (auth_both a (b1:A)) + (frame:(A)excl#A) + `)); + thm source_components = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `a:A`, + `b0:A`, + `a:A`, + `ra_op (R:(A)ra) (b1:A) (external:A)`), + AUTH_RA_BOTH_INJ), + normalized_source_eq); + thm source_base_eq = conjunct2_rule(source_components); + + thm base_apply = rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `((b0:A),(b1:A))`, + `((b0_new:A),(b1_new:A))`, + `external:A`), + RA_LOCAL_UPDATE_APPLY)); + thm base_result = mp_rule( + mp_rule( + mp_rule( + base_apply, + assume_rule(` + ra_local_update + (R:(A)ra) + ((b0:A),(b1:A)) + ((b0_new:A),(b1_new:A)) + `)), + source_fragment_valid), + source_base_eq); + + thm target_valid = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a_new:A`, + `b0_new:A`), + AUTH_RA_VALID_BOTH_INTRO), + assume_rule(`ra_valid (R:(A)ra) (a_new:A)`)), + assume_rule(` + ra_included (R:(A)ra) (b0_new:A) (a_new:A) + `)); + + thm target_fragment_eq = beta_rule(ap_term_rule( + `\x:A. auth_both (a_new:A) x`, + conjunct2_rule(base_result))); + thm target_fragment_op = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a_new:A`, + `b1_new:A`, + `external:A`), + AUTH_RA_BOTH_FRAG); + thm replace_target_frame = beta_rule(ap_term_rule( + `\fr:(A)excl#A. + ra_op + (auth_ra (R:(A)ra)) + (auth_both (a_new:A) (b1_new:A)) + fr`, + assume_rule(` + (frame:(A)excl#A) == auth_frag (external:A) + `))); + thm target_eq = trans_rule( + target_fragment_eq, + trans_rule( + gsym_rule(target_fragment_op), + gsym_rule(replace_target_frame))); + + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC(result[0], target_valid); + ACCEPT_TAC(result[1], target_eq); + return gnode_prove(root); +} + +PROOF thm AUTH_RA_LOCAL_UPDATE = + prove_auth_ra_local_update(); + /* ------------------------------------------------------------------------- */ /* Allocation and cancellative specializations */ /* ------------------------------------------------------------------------- */ @@ -1157,70 +2891,30 @@ PROOF static thm prove_auth_ra_alloc_both(void) { `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); - body = MATCH_MP_TAC( - body, + thm local = mp_rule( ispecl_rule( TERM_LIST( `R:(A)ra`, `a:A`, `f:A`, - `ra_op (R:(A)ra) (a:A) (piece:A)`, - `ra_op (R:(A)ra) (f:A) (piece:A)`), - AUTH_RA_UPDATE)); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(ra_included_def))); - body = GEN_TAC(body, "external"); - body = DISCH_TAC(body, "Hsource"); - body = ASMP_CONJ_TAC( - body, - "Hsource", - "Hvalid_source", - "Hincluded_source"); - body = ASMP_EXISTS_TAC( - body, - "Hincluded_source", - "slack"); - gnode_list result = CONJ_TAC(body); - ACCEPT_TAC( - result[0], + `piece:A`), + RA_LOCAL_UPDATE_ALLOC), assume_rule(` ra_valid (R:(A)ra) (ra_op R (a:A) (piece:A)) `)); - - gnode included = EXISTS_TAC(result[1], `slack:A`); - thm extend_source = beta_rule(ap_term_rule( - `\x:A. ra_op (R:(A)ra) x (piece:A)`, - assume_rule(` - (a:A) == - ra_op - (R:(A)ra) - (ra_op R (f:A) (external:A)) - (slack:A) - `))); - thm swap_outer = ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `ra_op (R:(A)ra) (f:A) (external:A)`, - `slack:A`, - `piece:A`), - AUTH_RA_OP_SWAP_RIGHT); - thm swap_inner = beta_rule(ap_term_rule( - `\x:A. ra_op (R:(A)ra) x (slack:A)`, + thm updated = mp_rule( ispecl_rule( TERM_LIST( `R:(A)ra`, + `a:A`, `f:A`, - `external:A`, - `piece:A`), - AUTH_RA_OP_SWAP_RIGHT))); - ACCEPT_TAC( - included, - trans_rule( - extend_source, - trans_rule(swap_outer, swap_inner))); + `ra_op (R:(A)ra) (a:A) (piece:A)`, + `ra_op (R:(A)ra) (f:A) (piece:A)`), + AUTH_RA_UPDATE), + local); + ACCEPT_TAC(body, updated); return gnode_prove(root); } @@ -1252,10 +2946,8 @@ PROOF static thm prove_auth_ra_alloc(void) { (ra_op R (a:A) (piece:A)) `)); thm_list reductions = THM_LIST( - auth_auth_def, - auth_both_def, + AUTH_RA_BOTH_UNIT, RA_UNIT_L); - body = CONV_TAC(body, rewrite_conv(reductions)); ACCEPT_TAC(body, rewrite_rule(reductions, allocated)); return gnode_prove(root); } @@ -1279,88 +2971,32 @@ PROOF static thm prove_auth_ra_update_cancellative(void) { `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); - body = MATCH_MP_TAC( - body, - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `ra_op (R:(A)ra) (a:A) (frame:A)`, - `a:A`, - `ra_op (R:(A)ra) (b:A) (frame:A)`, - `b:A`), - AUTH_RA_UPDATE)); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(ra_included_def))); - body = GEN_TAC(body, "external"); - body = DISCH_TAC(body, "Hsource"); - body = ASMP_CONJ_TAC( - body, - "Hsource", - "Hvalid_source", - "Hincluded_source"); - body = ASMP_EXISTS_TAC( - body, - "Hincluded_source", - "slack"); - gnode_list result = CONJ_TAC(body); - ACCEPT_TAC( - result[0], + thm local = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `b:A`, + `frame:A`), + RA_LOCAL_UPDATE_CANCELLATIVE), + assume_rule(`ra_cancellative (R:(A)ra)`)), assume_rule(` ra_valid (R:(A)ra) (ra_op R (b:A) (frame:A)) `)); - - thm normalized_source = trans_rule( - assume_rule(` - ra_op (R:(A)ra) (a:A) (frame:A) == - ra_op R - (ra_op R (a:A) (external:A)) - (slack:A) - `), + thm updated = mp_rule( ispecl_rule( TERM_LIST( `R:(A)ra`, + `ra_op (R:(A)ra) (a:A) (frame:A)`, `a:A`, - `external:A`, - `slack:A`), - RA_ASSOC)); - thm residual_eq = mp_rule( - mp_rule( - mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `a:A`, - `frame:A`, - `ra_op - (R:(A)ra) - (external:A) - (slack:A)`), - RA_CANCELLATIVE_APPLY), - assume_rule(`ra_cancellative (R:(A)ra)`)), - assume_rule(` - ra_valid - (R:(A)ra) - (ra_op R (a:A) (frame:A)) - `)), - normalized_source); - - gnode included = EXISTS_TAC(result[1], `slack:A`); - thm lift_residual = beta_rule(ap_term_rule( - `\x:A. ra_op (R:(A)ra) (b:A) x`, - residual_eq)); - thm reassociate = gsym_rule(ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `b:A`, - `external:A`, - `slack:A`), - RA_ASSOC)); - ACCEPT_TAC( - included, - trans_rule(lift_residual, reassociate)); + `ra_op (R:(A)ra) (b:A) (frame:A)`, + `b:A`), + AUTH_RA_UPDATE), + local); + ACCEPT_TAC(body, updated); return gnode_prove(root); } @@ -1382,22 +3018,65 @@ PROOF static int audit_auth_ra(void) { AUTH_RA_OP_COMPONENTS, AUTH_RA_VALID_COMPONENTS, AUTH_RA_OP_AS_PRODUCT, + AUTH_RA_INCLUDED_AS_PRODUCT, + AUTH_RA_INCLUDED_COMPONENTS, AUTH_RA_VALID_IMP_PRODUCT_VALID, AUTH_RA_UNIT, AUTH_RA_AUTH_FRAG, AUTH_RA_FRAG_FRAG, AUTH_RA_BOTH_FRAG, AUTH_RA_BOTH_UNIT, + AUTH_EXCL_OWNED_INJ, + AUTH_RA_FRAG_INJ, + AUTH_RA_BOTH_INJ, + AUTH_RA_BOTH_NE_FRAG, + AUTH_RA_AUTH_INJ, + AUTH_RA_AUTH_NE_FRAG, + AUTH_RA_AUTH_EQ_BOTH, AUTH_RA_VALID_FRAG, AUTH_RA_VALID_BOTH, + AUTH_RA_VALID_BOTH_INTRO, + AUTH_RA_VALID_BOTH_ELIM_VALID, + AUTH_RA_VALID_BOTH_ELIM_INCLUDED, AUTH_RA_VALID_AUTH, + AUTH_RA_VALID_AUTH_FRAG, + AUTH_RA_VALID_BOTH_FRAG, AUTH_RA_AUTH_CONFLICT, + AUTH_RA_VALID_BOTH_FRAME_COMPONENTS, + AUTH_RA_VALID_BOTH_FRAME, + AUTH_RA_VALID_AUTH_FRAME, AUTH_RA_BOTH_CONFLICT, + AUTH_RA_AUTH_BOTH_CONFLICT, + AUTH_RA_BOTH_EXCLUSIVE, + AUTH_EXCL_UNIT_INCLUDED, + AUTH_EXCL_OWNED_NOT_INCLUDED_UNIT, + AUTH_RA_INCLUDED_FRAG_FRAG, + AUTH_RA_INCLUDED_FRAG_AUTH, + AUTH_RA_INCLUDED_FRAG_BOTH, + AUTH_RA_INCLUDED_AUTH_FRAG, + AUTH_RA_INCLUDED_AUTH_AUTH, + AUTH_RA_INCLUDED_AUTH_BOTH, + AUTH_RA_INCLUDED_BOTH_FRAG, + AUTH_RA_INCLUDED_BOTH_AUTH, + AUTH_RA_INCLUDED_BOTH_BOTH, AUTH_RA_CANCELLATIVE, - AUTH_RA_VALID_BOTH_FRAME, - AUTH_RA_OP_SWAP_RIGHT, + AUTH_RA_CANCELLATIVE_IFF, + AUTH_RA_UPDATE_FRAMEWISE, + AUTH_RA_UPDATE_FRAMEWISE_IFF, AUTH_RA_UPDATE, AUTH_RA_UPDATE_ND, + AUTH_RA_UPDATE_ND_FRAMEWISE_IFF, + AUTH_RA_UPDATE_AUTH_IFF, + AUTH_RA_UPDATE_AUTH_INCLUDED, + AUTH_RA_UPDATE_DROP_FRAG, + AUTH_RA_UPDATE_DROP_AUTH, + AUTH_RA_UPDATE_WEAKEN_FRAG, + AUTH_RA_FRAG_UPDATE_INCLUDED, + AUTH_RA_UPDATE_BOTH_INCLUDED, + AUTH_RA_UPDATE_ALLOC, + AUTH_RA_UPDATE_DEALLOC, + AUTH_RA_UPDATE_AUTH, + AUTH_RA_LOCAL_UPDATE, AUTH_RA_ALLOC_BOTH, AUTH_RA_ALLOC, AUTH_RA_UPDATE_CANCELLATIVE); diff --git a/theory/logic/auth_ra.h b/theory/logic/auth_ra.h index 595e707..636c1b0 100644 --- a/theory/logic/auth_ra.h +++ b/theory/logic/auth_ra.h @@ -23,6 +23,7 @@ */ #include "proof/theory/logic/excl_ra.h" +#include "proof/theory/logic/local_update.h" /* ------------------------------------------------------------------------- */ /* Core representation and constructors */ @@ -73,7 +74,61 @@ PROOF extern thm AUTH_RA_BOTH_FRAG; PROOF extern thm AUTH_RA_BOTH_UNIT; /* ------------------------------------------------------------------------- */ -/* Validity and exclusivity */ +/* Constructor equality and distinction */ +/* ------------------------------------------------------------------------- */ + +/* + * Fragment-only construction is injective: + * + * forall (f:A) (g:A). + * (auth_frag f:(A)excl#A) == auth_frag g <=> f == g + */ +PROOF extern thm AUTH_RA_FRAG_INJ; + +/* + * Combined construction is injective in both components: + * + * forall (a:A) (f:A) (b:A) (g:A). + * (auth_both a f:(A)excl#A) == auth_both b g <=> + * a == b && f == g + */ +PROOF extern thm AUTH_RA_BOTH_INJ; + +/* + * A combined authoritative resource is never fragment-only: + * + * forall (a:A) (f:A) (g:A). + * ~((auth_both a f:(A)excl#A) == auth_frag g) + */ +PROOF extern thm AUTH_RA_BOTH_NE_FRAG; + +/* + * Authority-only construction is injective for a fixed base RA: + * + * forall (R:(A)ra) (a:A) (b:A). + * auth_auth R a == auth_auth R b <=> a == b + */ +PROOF extern thm AUTH_RA_AUTH_INJ; + +/* + * An authority-only resource is never fragment-only: + * + * forall (R:(A)ra) (a:A) (f:A). + * ~(auth_auth R a == auth_frag f) + */ +PROOF extern thm AUTH_RA_AUTH_NE_FRAG; + +/* + * Authority-only is exactly combined ownership with the base unit fragment: + * + * forall (R:(A)ra) (a:A) (b:A) (f:A). + * auth_auth R a == auth_both b f <=> + * a == b && f == ra_unit R + */ +PROOF extern thm AUTH_RA_AUTH_EQ_BOTH; + +/* ------------------------------------------------------------------------- */ +/* Validity and authority conflict */ /* ------------------------------------------------------------------------- */ /* @@ -91,12 +146,107 @@ PROOF extern thm AUTH_RA_VALID_FRAG; */ PROOF extern thm AUTH_RA_VALID_BOTH; +/* + * Direct introduction form of combined validity: + * + * forall (R:(A)ra) (a:A) (f:A). + * ra_valid R a ==> + * ra_included R f a ==> + * ra_valid (auth_ra R) (auth_both a f) + */ +PROOF extern thm AUTH_RA_VALID_BOTH_INTRO; + +/* + * forall (R:(A)ra) (a:A) (f:A). + * ra_valid (auth_ra R) (auth_both a f) ==> + * ra_valid R a + */ +PROOF extern thm AUTH_RA_VALID_BOTH_ELIM_VALID; + +/* + * forall (R:(A)ra) (a:A) (f:A). + * ra_valid (auth_ra R) (auth_both a f) ==> + * ra_included R f a + */ +PROOF extern thm AUTH_RA_VALID_BOTH_ELIM_INCLUDED; + /* * forall (R:(A)ra) (a:A). * ra_valid (auth_ra R) (auth_auth R a) <=> ra_valid R a */ PROOF extern thm AUTH_RA_VALID_AUTH; +/* + * Validity of authority composed with one fragment: + * + * forall (R:(A)ra) (a:A) (f:A). + * ra_valid + * (auth_ra R) + * (ra_op + * (auth_ra R) + * (auth_auth R a) + * (auth_frag f)) <=> + * ra_valid R a && ra_included R f a + */ +PROOF extern thm AUTH_RA_VALID_AUTH_FRAG; + +/* + * Validity after framing combined ownership by another fragment: + * + * forall (R:(A)ra) (a:A) (f:A) (g:A). + * ra_valid + * (auth_ra R) + * (ra_op + * (auth_ra R) + * (auth_both a f) + * (auth_frag g)) <=> + * ra_valid R a && + * ra_included R (ra_op R f g) a + */ +PROOF extern thm AUTH_RA_VALID_BOTH_FRAG; + +/* + * Exact constructor-level characterization of every frame compatible with + * combined authoritative ownership: + * + * forall + * (R:(A)ra) + * (a:A) + * (f:A) + * (frame:(A)excl#A). + * ra_valid + * (auth_ra R) + * (ra_op + * (auth_ra R) + * (auth_both a f) + * frame) <=> + * exists external:A. + * frame == auth_frag external && + * ra_valid R a && + * ra_included R (ra_op R f external) a + */ +PROOF extern thm AUTH_RA_VALID_BOTH_FRAME; + +/* + * Authority-only specialization of `AUTH_RA_VALID_BOTH_FRAME`: + * + * forall + * (R:(A)ra) + * (a:A) + * (frame:(A)excl#A). + * ra_valid + * (auth_ra R) + * (ra_op + * (auth_ra R) + * (auth_auth R a) + * frame) <=> + * exists external:A. + * frame == auth_frag external && + * ra_valid R a && + * ra_included R external a + */ +PROOF extern thm AUTH_RA_VALID_AUTH_FRAME; + /* * forall (R:(A)ra) (a:A) (b:A). * ~(ra_valid @@ -121,6 +271,131 @@ PROOF extern thm AUTH_RA_AUTH_CONFLICT; */ PROOF extern thm AUTH_RA_BOTH_CONFLICT; +/* + * Authority-only and combined ownership always conflict: + * + * forall (R:(A)ra) (a:A) (b:A) (g:A). + * ~(ra_valid + * (auth_ra R) + * (ra_op + * (auth_ra R) + * (auth_auth R a) + * (auth_both b g))) + */ +PROOF extern thm AUTH_RA_AUTH_BOTH_CONFLICT; + +/* + * An exclusive locally owned fragment makes combined ownership exclusive: + * + * forall (R:(A)ra) (a:A) (f:A). + * ra_exclusive R f ==> + * ra_exclusive (auth_ra R) (auth_both a f) + */ +PROOF extern thm AUTH_RA_BOTH_EXCLUSIVE; + +/* ------------------------------------------------------------------------- */ +/* Constructor inclusion */ +/* ------------------------------------------------------------------------- */ + +/* + * forall (R:(A)ra) (f:A) (g:A). + * ra_included + * (auth_ra R) + * (auth_frag f) + * (auth_frag g) <=> + * ra_included R f g + */ +PROOF extern thm AUTH_RA_INCLUDED_FRAG_FRAG; + +/* + * A fragment can extend to authority-only exactly when it extends to the + * base unit. No positivity assumption is made on the base RA. + * + * forall (R:(A)ra) (f:A) (a:A). + * ra_included + * (auth_ra R) + * (auth_frag f) + * (auth_auth R a) <=> + * ra_included R f (ra_unit R) + */ +PROOF extern thm AUTH_RA_INCLUDED_FRAG_AUTH; + +/* + * forall (R:(A)ra) (f:A) (a:A) (g:A). + * ra_included + * (auth_ra R) + * (auth_frag f) + * (auth_both a g) <=> + * ra_included R f g + */ +PROOF extern thm AUTH_RA_INCLUDED_FRAG_BOTH; + +/* + * Authority cannot extend to a fragment-only resource: + * + * forall (R:(A)ra) (a:A) (g:A). + * ~(ra_included + * (auth_ra R) + * (auth_auth R a) + * (auth_frag g)) + */ +PROOF extern thm AUTH_RA_INCLUDED_AUTH_FRAG; + +/* + * forall (R:(A)ra) (a:A) (b:A). + * ra_included + * (auth_ra R) + * (auth_auth R a) + * (auth_auth R b) <=> + * a == b + */ +PROOF extern thm AUTH_RA_INCLUDED_AUTH_AUTH; + +/* + * forall (R:(A)ra) (a:A) (b:A) (g:A). + * ra_included + * (auth_ra R) + * (auth_auth R a) + * (auth_both b g) <=> + * a == b + */ +PROOF extern thm AUTH_RA_INCLUDED_AUTH_BOTH; + +/* + * Combined authoritative ownership cannot extend to a fragment-only + * resource: + * + * forall (R:(A)ra) (a:A) (f:A) (g:A). + * ~(ra_included + * (auth_ra R) + * (auth_both a f) + * (auth_frag g)) + */ +PROOF extern thm AUTH_RA_INCLUDED_BOTH_FRAG; + +/* + * The `ra_included R f (ra_unit R)` conjunct cannot in general be replaced + * by `f == ra_unit R`, even when the base RA is cancellative. + * + * forall (R:(A)ra) (a:A) (f:A) (b:A). + * ra_included + * (auth_ra R) + * (auth_both a f) + * (auth_auth R b) <=> + * a == b && ra_included R f (ra_unit R) + */ +PROOF extern thm AUTH_RA_INCLUDED_BOTH_AUTH; + +/* + * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + * ra_included + * (auth_ra R) + * (auth_both a f) + * (auth_both b g) <=> + * a == b && ra_included R f g + */ +PROOF extern thm AUTH_RA_INCLUDED_BOTH_BOTH; + /* ------------------------------------------------------------------------- */ /* Laws: optional algebraic properties */ /* ------------------------------------------------------------------------- */ @@ -134,12 +409,20 @@ PROOF extern thm AUTH_RA_BOTH_CONFLICT; */ PROOF extern thm AUTH_RA_CANCELLATIVE; +/* + * The authoritative construction neither gains nor loses cancellativity: + * + * forall R:(A)ra. + * ra_cancellative (auth_ra R) <=> ra_cancellative R + */ +PROOF extern thm AUTH_RA_CANCELLATIVE_IFF; + /* ------------------------------------------------------------------------- */ /* Updates: general frame-preserving rules */ /* ------------------------------------------------------------------------- */ /* - * Exact deterministic authoritative update rule. + * Direct framewise deterministic authoritative update criterion. * * To update `auth_both a f` to `auth_both b g`, it is sufficient to show * that every external fragment compatible with the source remains compatible @@ -158,11 +441,46 @@ PROOF extern thm AUTH_RA_CANCELLATIVE; * (auth_both a f) * (auth_both b g) */ +PROOF extern thm AUTH_RA_UPDATE_FRAMEWISE; + +/* + * Exact deterministic framewise characterization: + * + * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + * ra_update + * (auth_ra R) + * (auth_both a f) + * (auth_both b g) <=> + * forall external:A. + * ra_valid R a && + * ra_included R (ra_op R f external) a ==> + * ra_valid R b && + * ra_included R (ra_op R g external) b + */ +PROOF extern thm AUTH_RA_UPDATE_FRAMEWISE_IFF; + +/* + * Iris-style lifting of a base local update to the authoritative RA: + * + * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + * ra_local_update R (a,f) (b,g) ==> + * ra_update + * (auth_ra R) + * (auth_both a f) + * (auth_both b g) + * + * A local update preserves the same residual base frame exactly. This is + * stronger than the framewise criterion above, and consequently supplies + * that criterion by preserving an inclusion witness. + */ PROOF extern thm AUTH_RA_UPDATE; /* * Predicate-valued authoritative update. The selected `(b,g)` may depend on * the hidden external fragment, matching the semantics of `ra_update_nd`. + * This theorem deliberately retains the general framewise premise: the + * fixed-target `ra_local_update` relation cannot express a target selected + * separately for each hidden frame. * * forall (R:(A)ra) (a:A) (f:A) (P:A->A->bool). * (forall external:A. @@ -181,6 +499,183 @@ PROOF extern thm AUTH_RA_UPDATE; */ PROOF extern thm AUTH_RA_UPDATE_ND; +/* + * Exact ND framewise characterization for results restricted to combined + * authoritative ownership: + * + * forall (R:(A)ra) (a:A) (f:A) (P:A->A->bool). + * ra_update_nd + * (auth_ra R) + * (auth_both a f) + * (\candidate:(A)excl#A. + * exists (b:A) (g:A). + * P b g && candidate == auth_both b g) <=> + * forall external:A. + * ra_valid R a && + * ra_included R (ra_op R f external) a ==> + * exists (b:A) (g:A). + * P b g && + * ra_valid R b && + * ra_included R (ra_op R g external) b + */ +PROOF extern thm AUTH_RA_UPDATE_ND_FRAMEWISE_IFF; + +/* ------------------------------------------------------------------------- */ +/* Updates: exact authority and weakening rules */ +/* ------------------------------------------------------------------------- */ + +/* + * Exact authority-only deterministic update characterization. The source + * validity guard is essential because updates from an invalid authority are + * vacuous. + * + * forall (R:(A)ra) (a:A) (b:A). + * ra_update + * (auth_ra R) + * (auth_auth R a) + * (auth_auth R b) <=> + * (ra_valid R a ==> + * ra_valid R b && ra_included R a b) + */ +PROOF extern thm AUTH_RA_UPDATE_AUTH_IFF; + +/* + * forall (R:(A)ra) (a:A) (b:A). + * ra_valid R b ==> + * ra_included R a b ==> + * ra_update + * (auth_ra R) + * (auth_auth R a) + * (auth_auth R b) + */ +PROOF extern thm AUTH_RA_UPDATE_AUTH_INCLUDED; + +/* + * Discard the locally owned fragment while retaining authority: + * + * forall (R:(A)ra) (a:A) (f:A). + * ra_update + * (auth_ra R) + * (auth_both a f) + * (auth_auth R a) + */ +PROOF extern thm AUTH_RA_UPDATE_DROP_FRAG; + +/* + * Discard authority while retaining the locally owned fragment: + * + * forall (R:(A)ra) (a:A) (f:A). + * ra_update + * (auth_ra R) + * (auth_both a f) + * (auth_frag f) + */ +PROOF extern thm AUTH_RA_UPDATE_DROP_AUTH; + +/* + * Weaken the locally owned fragment beneath unchanged authority: + * + * forall (R:(A)ra) (a:A) (f:A) (g:A). + * ra_included R g f ==> + * ra_update + * (auth_ra R) + * (auth_both a f) + * (auth_both a g) + */ +PROOF extern thm AUTH_RA_UPDATE_WEAKEN_FRAG; + +/* + * Base inclusion lifts to a fragment-only authoritative update: + * + * forall (R:(A)ra) (f:A) (g:A). + * ra_included R g f ==> + * ra_update + * (auth_ra R) + * (auth_frag f) + * (auth_frag g) + */ +PROOF extern thm AUTH_RA_FRAG_UPDATE_INCLUDED; + +/* + * Grow an authoritative value while preserving the same local fragment: + * + * forall (R:(A)ra) (a:A) (b:A) (f:A). + * ra_valid R b ==> + * ra_included R a b ==> + * ra_update + * (auth_ra R) + * (auth_both a f) + * (auth_both b f) + */ +PROOF extern thm AUTH_RA_UPDATE_BOTH_INCLUDED; + +/* ------------------------------------------------------------------------- */ +/* Updates: Iris-style constructor specializations */ +/* ------------------------------------------------------------------------- */ + +/* + * Allocate a local fragment while changing the authoritative value: + * + * forall (R:(A)ra) (a:A) (b:A) (g:A). + * ra_local_update R (a,ra_unit R) (b,g) ==> + * ra_update + * (auth_ra R) + * (auth_auth R a) + * (auth_both b g) + */ +PROOF extern thm AUTH_RA_UPDATE_ALLOC; + +/* + * Consume the locally owned fragment as part of a local update: + * + * forall (R:(A)ra) (a:A) (f:A) (b:A). + * ra_local_update R (a,f) (b,ra_unit R) ==> + * ra_update + * (auth_ra R) + * (auth_both a f) + * (auth_auth R b) + */ +PROOF extern thm AUTH_RA_UPDATE_DEALLOC; + +/* + * Change authority using a local update and discard its produced fragment: + * + * forall (R:(A)ra) (a:A) (b:A) (g:A). + * ra_local_update R (a,ra_unit R) (b,g) ==> + * ra_update + * (auth_ra R) + * (auth_auth R a) + * (auth_auth R b) + */ +PROOF extern thm AUTH_RA_UPDATE_AUTH; + +/* ------------------------------------------------------------------------- */ +/* Local updates of authoritative resources */ +/* ------------------------------------------------------------------------- */ + +/* + * Lift a base local update to a local update between authoritative pairs: + * + * forall + * (R:(A)ra) + * (a:A) + * (b0:A) (b1:A) + * (a':A) + * (b0':A) (b1':A). + * ra_local_update R (b0,b1) (b0',b1') ==> + * ra_included R b0' a' ==> + * ra_valid R a' ==> + * ra_local_update + * (auth_ra R) + * (auth_both a b0,auth_both a b1) + * (auth_both a' b0',auth_both a' b1') + * + * A compatible hidden auth frame must be `auth_frag external`; the base + * local update preserves that exact `external`. The two target premises are + * precisely the validity condition for `auth_both a' b0'`. + */ +PROOF extern thm AUTH_RA_LOCAL_UPDATE; + /* ------------------------------------------------------------------------- */ /* Updates: allocation and cancellative specializations */ /* ------------------------------------------------------------------------- */ @@ -212,7 +707,7 @@ PROOF extern thm AUTH_RA_ALLOC_BOTH; PROOF extern thm AUTH_RA_ALLOC; /* - * Dasheng-style synchronized update for cancellative base RAs: + * Synchronized residual replacement for cancellative base RAs: * * forall (R:(A)ra) (a:A) (b:A) (frame:A). * ra_cancellative R ==> diff --git a/theory/logic/excl_ra.c b/theory/logic/excl_ra.c index ee358ea..89483e0 100644 --- a/theory/logic/excl_ra.c +++ b/theory/logic/excl_ra.c @@ -3,6 +3,7 @@ #include "proof/proof_backward.h" #require "proof/proof_backward.c" +#require "proof/theory/logic/local_update.c" #require "proof/theory/logic/ra.c" PROOF static size_t EXCL_RA_AXIOMS_BEFORE = vector_size(get_all_axioms()); @@ -32,7 +33,7 @@ PROOF thm excl_op_def = new_rec_definition( excl_op (ExclInvalid:(A)excl) (y:(A)excl) = ExclInvalid `); -PROOF thm excl_valid_def = new_rec_definition( +PROOF static thm excl_valid_def = new_rec_definition( excl_type.rec, ` (excl_valid (ExclUnit:(A)excl) <=> T) && @@ -127,14 +128,14 @@ PROOF static thm prove_excl_owned_injective(void) { ap_term_rule(`Excl:A->(A)excl`, assume_rule(`(a:A) == (b:A)`))); thm proved = gnode_prove(root); ENSURE_COND(equals_term(concl(proved), goal_tm), - "EXCL_OWNED_INJECTIVE has the wrong conclusion"); + "EXCL_RA_OWNED_INJ has the wrong conclusion"); return proved; err: ERR_FUN_PUTS("prove_excl_owned_injective"); return empty_theorem; } -PROOF static thm EXCL_OWNED_INJECTIVE = +PROOF thm EXCL_RA_OWNED_INJ = prove_excl_owned_injective(); PROOF static thm prove_excl_invalid_ne_owned(void) { @@ -163,6 +164,28 @@ err: PROOF static thm EXCL_INVALID_NE_OWNED = prove_excl_invalid_ne_owned(); +/* Public constructor facts preserve the smaller internal ABI used by auth. */ +PROOF static thm expose_excl_owned_ne_unit(void) { + return EXCL_OWNED_NE_UNIT; +} + +PROOF thm EXCL_RA_OWNED_NE_UNIT = + expose_excl_owned_ne_unit(); + +PROOF static thm expose_excl_invalid_ne_unit(void) { + return EXCL_INVALID_NE_UNIT; +} + +PROOF thm EXCL_RA_INVALID_NE_UNIT = + expose_excl_invalid_ne_unit(); + +PROOF static thm expose_excl_invalid_ne_owned(void) { + return EXCL_INVALID_NE_OWNED; +} + +PROOF thm EXCL_RA_INVALID_NE_OWNED = + expose_excl_invalid_ne_owned(); + PROOF static conv excl_reduce_conv(void) { return rewrite_conv(THM_LIST( excl_op_def, @@ -264,9 +287,9 @@ PROOF static thm prove_excl_ra_laws(void) { return gnode_prove(root); } -PROOF thm EXCL_RA_LAWS = prove_excl_ra_laws(); +PROOF static thm EXCL_RA_LAWS = prove_excl_ra_laws(); -PROOF thm excl_ra_def = new_fun_definition(` +PROOF static thm excl_ra_def = new_fun_definition(` excl_ra : ((A)excl)ra = ra_abs ((ExclUnit:(A)excl),(excl_op,excl_valid)) @@ -318,7 +341,7 @@ PROOF static thm prove_excl_ra_valid_fn(void) { computed); } -PROOF thm EXCL_RA_VALID_FN = prove_excl_ra_valid_fn(); +PROOF static thm EXCL_RA_VALID_FN = prove_excl_ra_valid_fn(); PROOF static thm prove_excl_ra_owned_conflict(void) { term goal_tm = ` @@ -383,6 +406,63 @@ PROOF static thm prove_excl_ra_invalid(void) { PROOF thm EXCL_RA_INVALID = prove_excl_ra_invalid(); +/* Exactly the distinguished invalid constructor is invalid. */ +PROOF static thm prove_excl_ra_valid_iff(void) { + term goal_tm = ` + forall x:(A)excl. + ra_valid (excl_ra:((A)excl)ra) x <=> + ~(x == (ExclInvalid:(A)excl)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "x"); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hvalid"); + forward = DISCH_TAC(forward, "Heq"); + thm validity_eq = ap_term_rule( + `ra_valid (excl_ra:((A)excl)ra):(A)excl->bool`, + assume_rule(`(x:(A)excl) == ExclInvalid`)); + thm invalid_valid = eq_mp_rule( + validity_eq, + assume_rule(`ra_valid (excl_ra:((A)excl)ra) (x:(A)excl)`)); + CONTR_TAC( + forward, + not_elim_rule(EXCL_RA_INVALID, invalid_valid)); + + gnode reverse = DISCH_TAC(directions[1], "Hnot_invalid"); + gnode_list cases = CASES_TAC( + reverse, `x:(A)excl`, "Hx"); + thm unit_eq = assume_rule(gnode_get_asmps( + cases[0], CONST_STRING_LIST("Hx"))[0]); + ACCEPT_TAC( + cases[0], + pure_rewrite_rule( + THM_LIST(gsym_rule(unit_eq)), + EXCL_RA_VALID_UNIT)); + + thm owned_eq = assume_rule(gnode_get_asmps( + cases[1], CONST_STRING_LIST("Hx"))[0]); + thm owned_valid = ispec_rule( + `a:A`, + EXCL_RA_VALID_OWNED); + ACCEPT_TAC( + cases[1], + pure_rewrite_rule( + THM_LIST(gsym_rule(owned_eq)), + owned_valid)); + + thm invalid_eq = assume_rule(gnode_get_asmps( + cases[2], CONST_STRING_LIST("Hx"))[0]); + thm contradiction = not_elim_rule( + assume_rule(`~((x:(A)excl) == ExclInvalid)`), + invalid_eq); + CONTR_TAC(cases[2], contradiction); + return gnode_prove(root); +} + +PROOF thm EXCL_RA_VALID_IFF = + prove_excl_ra_valid_iff(); + /* * An owned exclusive element is compatible only with ExclUnit. Owned and * invalid frames both reduce the composition to ExclInvalid, contradicting @@ -458,7 +538,7 @@ PROOF static thm prove_excl_ra_included_owned(void) { (Excl (a:A)) (frame:(A)excl)`)); thm unit_payloads = eq_mp_rule( - ispecl_rule(TERM_LIST(`b:A`, `a:A`), EXCL_OWNED_INJECTIVE), + ispecl_rule(TERM_LIST(`b:A`, `a:A`), EXCL_RA_OWNED_INJ), unit_extension); ACCEPT_TAC(frame_cases[0], gsym_rule(unit_payloads)); @@ -509,6 +589,201 @@ err: PROOF thm EXCL_RA_INCLUDED_OWNED = prove_excl_ra_included_owned(); +/* Owned values extend either trivially or to the inconsistent element. */ +PROOF static thm prove_excl_ra_included_owned_iff(void) { + term goal_tm = ` + forall (a:A) (x:(A)excl). + ra_included + (excl_ra:((A)excl)ra) + (Excl a) + x <=> + x == Excl a \/ x == (ExclInvalid:(A)excl) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hincluded"); + gnode_list cases = CASES_TAC( + forward, `x:(A)excl`, "Hx"); + + thm source_eq_unit = ispecl_rule( + TERM_LIST( + `excl_ra:((A)excl)ra`, + `Excl (a:A):(A)excl`, + `x:(A)excl`), + RA_EXCLUSIVE_INCLUDED); + source_eq_unit = mp_rule( + source_eq_unit, + ispec_rule(`a:A`, EXCL_RA_EXCLUSIVE)); + thm case_unit_eq = assume_rule(gnode_get_asmps( + cases[0], CONST_STRING_LIST("Hx"))[0]); + thm case_unit_valid = pure_rewrite_rule( + THM_LIST(gsym_rule(case_unit_eq)), + EXCL_RA_VALID_UNIT); + source_eq_unit = mp_rule(source_eq_unit, case_unit_valid); + source_eq_unit = mp_rule( + source_eq_unit, + assume_rule(` + ra_included + (excl_ra:((A)excl)ra) + (Excl (a:A)) + (x:(A)excl) + `)); + thm owned_eq_unit = trans_rule(source_eq_unit, case_unit_eq); + CONTR_TAC( + cases[0], + not_elim_rule( + ispec_rule(`a:A`, EXCL_RA_OWNED_NE_UNIT), + owned_eq_unit)); + + thm source_eq_owned = ispecl_rule( + TERM_LIST( + `excl_ra:((A)excl)ra`, + `Excl (a:A):(A)excl`, + `x:(A)excl`), + RA_EXCLUSIVE_INCLUDED); + source_eq_owned = mp_rule( + source_eq_owned, + ispec_rule(`a:A`, EXCL_RA_EXCLUSIVE)); + thm case_owned_eq = assume_rule(gnode_get_asmps( + cases[1], CONST_STRING_LIST("Hx"))[0]); + term case_owned_payload = dest_comb( + dest_eq(concl(case_owned_eq)).tm2).tm2; + thm case_owned_valid = eq_mp_rule( + ap_term_rule( + `ra_valid (excl_ra:((A)excl)ra):(A)excl->bool`, + gsym_rule(case_owned_eq)), + ispec_rule(case_owned_payload, EXCL_RA_VALID_OWNED)); + source_eq_owned = mp_rule(source_eq_owned, case_owned_valid); + source_eq_owned = mp_rule( + source_eq_owned, + assume_rule(` + ra_included + (excl_ra:((A)excl)ra) + (Excl (a:A)) + (x:(A)excl) + `)); + gnode left = DISJ1_TAC(cases[1]); + ACCEPT_TAC(left, gsym_rule(source_eq_owned)); + + gnode right = DISJ2_TAC(cases[2]); + ACCEPT_TAC( + right, + assume_rule(gnode_get_asmps( + cases[2], CONST_STRING_LIST("Hx"))[0])); + + gnode reverse = DISCH_TAC(directions[1], "Htarget"); + gnode_list target_cases = ASMP_DISJ_TAC( + reverse, + "Htarget", + "Howned", + "Hinvalid"); + thm target_owned = assume_rule(` + (x:(A)excl) == Excl (a:A) + `); + thm reflexive = ispecl_rule( + TERM_LIST( + `excl_ra:((A)excl)ra`, + `Excl (a:A):(A)excl`), + RA_INCLUDED_REFL); + ACCEPT_TAC( + target_cases[0], + eq_mp_rule( + beta_rule(ap_term_rule( + `\target:(A)excl. + ra_included + (excl_ra:((A)excl)ra) + (Excl (a:A)) + target`, + gsym_rule(target_owned))), + reflexive)); + + gnode invalid_target = CONV_TAC( + target_cases[1], + once_rewrite_conv(THM_LIST(ra_included_def))); + invalid_target = EXISTS_TAC(invalid_target, `Excl (a:A):(A)excl`); + thm target_invalid = assume_rule(` + (x:(A)excl) == (ExclInvalid:(A)excl) + `); + thm conflict = ispecl_rule( + TERM_LIST(`a:A`, `a:A`), + EXCL_RA_OWNED_CONFLICT); + ACCEPT_TAC( + invalid_target, + trans_rule(target_invalid, gsym_rule(conflict))); + return gnode_prove(root); +} + +PROOF thm EXCL_RA_INCLUDED_OWNED_IFF = + prove_excl_ra_included_owned_iff(); + +/* Invalid is absorbing, so it includes only itself. */ +PROOF static thm prove_excl_ra_included_invalid_iff(void) { + term goal_tm = ` + forall x:(A)excl. + ra_included + (excl_ra:((A)excl)ra) + (ExclInvalid:(A)excl) + x <=> + x == ExclInvalid + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "x"); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_included_def))); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hincluded"); + forward = ASMP_EXISTS_TAC(forward, "Hincluded", "frame"); + thm extension = assume_rule(` + (x:(A)excl) == + ra_op + (excl_ra:((A)excl)ra) + ExclInvalid + (frame:(A)excl) + `); + extension = rewrite_rule( + THM_LIST(EXCL_RA_OP_FN, excl_op_def), + extension); + ACCEPT_TAC(forward, extension); + + gnode reverse = DISCH_TAC(directions[1], "Heq"); + reverse = EXISTS_TAC(reverse, `ExclUnit:(A)excl`); + thm target_eq = assume_rule(` + (x:(A)excl) == (ExclInvalid:(A)excl) + `); + thm unit_extension = pure_once_rewrite_rule( + THM_LIST(EXCL_RA_UNIT), + ispecl_rule( + TERM_LIST( + `excl_ra:((A)excl)ra`, + `ExclInvalid:(A)excl`), + RA_UNIT_R)); + ACCEPT_TAC( + reverse, + trans_rule(target_eq, gsym_rule(unit_extension))); + return gnode_prove(root); +} + +PROOF thm EXCL_RA_INCLUDED_INVALID_IFF = + prove_excl_ra_included_invalid_iff(); + +/* Invalid sources have no compatible frame, hence are exclusive vacuously. */ +PROOF static thm prove_excl_ra_exclusive_invalid(void) { + return mp_rule( + ispecl_rule( + TERM_LIST( + `excl_ra:((A)excl)ra`, + `ExclInvalid:(A)excl`), + RA_INVALID_EXCLUSIVE), + EXCL_RA_INVALID); +} + +PROOF thm EXCL_RA_EXCLUSIVE_INVALID = + prove_excl_ra_exclusive_invalid(); + /* Exclusive composition is cancellative on valid sources. Explicit cases * keep the proof local: an owned common frame admits only ExclUnit on the * source side, while an invalid common frame admits no valid source at all. */ @@ -626,6 +901,193 @@ PROOF static thm prove_excl_ra_update(void) { PROOF thm EXCL_RA_UPDATE = prove_excl_ra_update(); +/* Generic exclusive replacement, with an arbitrary valid target. */ +PROOF static thm prove_excl_ra_update_valid(void) { + term goal_tm = ` + forall (a:A) (x:(A)excl). + ra_valid (excl_ra:((A)excl)ra) x ==> + ra_update excl_ra (Excl a) x + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm result = ispecl_rule( + TERM_LIST( + `excl_ra:((A)excl)ra`, + `Excl (a:A):(A)excl`, + `x:(A)excl`), + RA_EXCLUSIVE_UPDATE); + result = mp_rule( + result, + ispec_rule(`a:A`, EXCL_RA_EXCLUSIVE)); + result = mp_rule( + result, + assume_rule(`ra_valid (excl_ra:((A)excl)ra) (x:(A)excl)`)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm EXCL_RA_UPDATE_VALID = + prove_excl_ra_update_valid(); + +/* Unit framing makes target validity necessary as well as sufficient. */ +PROOF static thm prove_excl_ra_update_owned_iff(void) { + term goal_tm = ` + forall (a:A) (x:(A)excl). + ra_update + (excl_ra:((A)excl)ra) + (Excl a) + x <=> + ra_valid excl_ra x + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hupdate"); + thm preserved = ispecl_rule( + TERM_LIST( + `excl_ra:((A)excl)ra`, + `Excl (a:A):(A)excl`, + `x:(A)excl`), + RA_UPDATE_VALID); + preserved = mp_rule( + preserved, + assume_rule(` + ra_update + (excl_ra:((A)excl)ra) + (Excl (a:A)) + (x:(A)excl) + `)); + preserved = mp_rule( + preserved, + ispec_rule(`a:A`, EXCL_RA_VALID_OWNED)); + ACCEPT_TAC(forward, preserved); + + gnode reverse = DISCH_TAC(directions[1], "Hvalid"); + thm result = ispecl_rule( + TERM_LIST(`a:A`, `x:(A)excl`), + EXCL_RA_UPDATE_VALID); + ACCEPT_TAC( + reverse, + mp_rule( + result, + assume_rule(`ra_valid (excl_ra:((A)excl)ra) (x:(A)excl)`))); + return gnode_prove(root); +} + +PROOF thm EXCL_RA_UPDATE_OWNED_IFF = + prove_excl_ra_update_owned_iff(); + +/* Every update from the invalid source is vacuous. */ +PROOF static thm prove_excl_ra_update_invalid(void) { + term x = `x:(A)excl`; + thm result = ispecl_rule( + TERM_LIST( + `excl_ra:((A)excl)ra`, + `ExclInvalid:(A)excl`, + x), + RA_UPDATE_INVALID); + result = mp_rule(result, EXCL_RA_INVALID); + return gen_rule(x, result); +} + +PROOF thm EXCL_RA_UPDATE_INVALID = + prove_excl_ra_update_invalid(); + +/* The generic exclusive local update gives full owned replacement directly. */ +PROOF static thm prove_excl_ra_local_update_valid(void) { + term goal_tm = ` + forall (a:A) (x:(A)excl). + ra_valid (excl_ra:((A)excl)ra) x ==> + ra_local_update + excl_ra + (Excl a,Excl a) + (x,x) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm result = ispecl_rule( + TERM_LIST( + `excl_ra:((A)excl)ra`, + `Excl (a:A):(A)excl`, + `Excl (a:A):(A)excl`, + `x:(A)excl`), + RA_LOCAL_UPDATE_EXCLUSIVE); + result = mp_rule( + result, + ispec_rule(`a:A`, EXCL_RA_EXCLUSIVE)); + result = mp_rule( + result, + assume_rule(`ra_valid (excl_ra:((A)excl)ra) (x:(A)excl)`)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm EXCL_RA_LOCAL_UPDATE_VALID = + prove_excl_ra_local_update_valid(); + +/* Unit residual exposes target validity, making the local rule exact. */ +PROOF static thm prove_excl_ra_local_update_iff(void) { + term goal_tm = ` + forall (a:A) (x:(A)excl). + ra_local_update + (excl_ra:((A)excl)ra) + (Excl a,Excl a) + (x,x) <=> + ra_valid excl_ra x + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hupdate"); + thm applied = ispecl_rule( + TERM_LIST( + `excl_ra:((A)excl)ra`, + `((Excl (a:A):(A)excl),(Excl (a:A):(A)excl))`, + `((x:(A)excl),(x:(A)excl))`, + `ExclUnit:(A)excl`), + RA_LOCAL_UPDATE_APPLY); + applied = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + applied); + applied = mp_rule( + applied, + assume_rule(` + ra_local_update + (excl_ra:((A)excl)ra) + ((Excl (a:A):(A)excl),(Excl (a:A):(A)excl)) + ((x:(A)excl),(x:(A)excl)) + `)); + applied = mp_rule( + applied, + ispec_rule(`a:A`, EXCL_RA_VALID_OWNED)); + thm source_unit = pure_once_rewrite_rule( + THM_LIST(EXCL_RA_UNIT), + ispecl_rule( + TERM_LIST( + `excl_ra:((A)excl)ra`, + `Excl (a:A):(A)excl`), + RA_UNIT_R)); + applied = mp_rule(applied, gsym_rule(source_unit)); + ACCEPT_TAC(forward, conjunct1_rule(applied)); + + gnode reverse = DISCH_TAC(directions[1], "Hvalid"); + ACCEPT_TAC( + reverse, + mp_rule( + ispecl_rule( + TERM_LIST(`a:A`, `x:(A)excl`), + EXCL_RA_LOCAL_UPDATE_VALID), + assume_rule(`ra_valid (excl_ra:((A)excl)ra) (x:(A)excl)`))); + return gnode_prove(root); +} + +PROOF thm EXCL_RA_LOCAL_UPDATE_IFF = + prove_excl_ra_local_update_iff(); + PROOF static int audit_excl_ra(void) { thm_list audited_theorems = THM_LIST( excl_type.ind, @@ -637,8 +1099,11 @@ PROOF static int audit_excl_ra(void) { excl_matches_def, EXCL_OWNED_NE_UNIT, EXCL_INVALID_NE_UNIT, - EXCL_OWNED_INJECTIVE, + EXCL_RA_OWNED_INJ, EXCL_INVALID_NE_OWNED, + EXCL_RA_OWNED_NE_UNIT, + EXCL_RA_INVALID_NE_UNIT, + EXCL_RA_INVALID_NE_OWNED, EXCL_RA_LAWS, excl_ra_def, EXCL_RA_UNIT, @@ -648,10 +1113,19 @@ PROOF static int audit_excl_ra(void) { EXCL_RA_VALID_UNIT, EXCL_RA_VALID_OWNED, EXCL_RA_INVALID, + EXCL_RA_VALID_IFF, EXCL_RA_EXCLUSIVE, EXCL_RA_INCLUDED_OWNED, + EXCL_RA_INCLUDED_OWNED_IFF, + EXCL_RA_INCLUDED_INVALID_IFF, + EXCL_RA_EXCLUSIVE_INVALID, EXCL_RA_CANCELLATIVE, - EXCL_RA_UPDATE); + EXCL_RA_UPDATE, + EXCL_RA_UPDATE_VALID, + EXCL_RA_UPDATE_OWNED_IFF, + EXCL_RA_UPDATE_INVALID, + EXCL_RA_LOCAL_UPDATE_VALID, + EXCL_RA_LOCAL_UPDATE_IFF); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { ENSURE_COND(!IS_NULL(audited_theorems[i]), diff --git a/theory/logic/excl_ra.h b/theory/logic/excl_ra.h index a78340a..32e61ab 100644 --- a/theory/logic/excl_ra.h +++ b/theory/logic/excl_ra.h @@ -12,7 +12,7 @@ * constructions such as `auth_ra`. */ -#include "proof/theory/logic/ra.h" +#include "proof/theory/logic/local_update.h" /* ------------------------------------------------------------------------- */ /* Core representation */ @@ -21,6 +21,23 @@ /* `ra_unit excl_ra == (ExclUnit:(A)excl)`. */ PROOF extern thm EXCL_RA_UNIT; +/* + * Owned constructor injectivity: + * + * forall a b:A. + * ((Excl a:(A)excl) == Excl b) <=> a == b + */ +PROOF extern thm EXCL_RA_OWNED_INJ; + +/* `forall a:A. ~((Excl a:(A)excl) == ExclUnit)`. */ +PROOF extern thm EXCL_RA_OWNED_NE_UNIT; + +/* `~((ExclInvalid:(A)excl) == ExclUnit)`. */ +PROOF extern thm EXCL_RA_INVALID_NE_UNIT; + +/* `forall a:A. ~((ExclInvalid:(A)excl) == Excl a)`. */ +PROOF extern thm EXCL_RA_INVALID_NE_OWNED; + /* * `forall a b:A. * ra_op excl_ra (Excl a) (Excl b) == @@ -41,6 +58,14 @@ PROOF extern thm EXCL_RA_VALID_OWNED; /* `~(ra_valid excl_ra (ExclInvalid:(A)excl))`. */ PROOF extern thm EXCL_RA_INVALID; +/* + * Complete validity characterization: + * + * forall x:(A)excl. + * ra_valid excl_ra x <=> ~(x == ExclInvalid) + */ +PROOF extern thm EXCL_RA_VALID_IFF; + /* ------------------------------------------------------------------------- */ /* Laws */ /* ------------------------------------------------------------------------- */ @@ -62,6 +87,27 @@ PROOF extern thm EXCL_RA_INVALID; */ PROOF extern thm EXCL_RA_INCLUDED_OWNED; +/* + * Complete target characterization for an owned source: + * + * forall (a:A) (x:(A)excl). + * ra_included excl_ra (Excl a) x <=> + * x == Excl a \/ x == ExclInvalid + * + * Inclusion is an algebraic extension relation and does not require the + * target to be valid; composing with another owned value explains the + * `ExclInvalid` branch. + */ +PROOF extern thm EXCL_RA_INCLUDED_OWNED_IFF; + +/* + * Complete target characterization for the invalid source: + * + * forall x:(A)excl. + * ra_included excl_ra ExclInvalid x <=> x == ExclInvalid + */ +PROOF extern thm EXCL_RA_INCLUDED_INVALID_IFF; + /* ------------------------------------------------------------------------- */ /* Exclusive elements */ /* ------------------------------------------------------------------------- */ @@ -69,6 +115,16 @@ PROOF extern thm EXCL_RA_INCLUDED_OWNED; /* `forall a:A. ra_exclusive excl_ra (Excl a)`. */ PROOF extern thm EXCL_RA_EXCLUSIVE; +/* + * The invalid element is exclusive vacuously: + * + * ra_exclusive excl_ra (ExclInvalid:(A)excl) + * + * `ra_exclusive` constrains compatible frames but does not imply source + * validity. Clients that need a usable resource must carry validity too. + */ +PROOF extern thm EXCL_RA_EXCLUSIVE_INVALID; + /* ------------------------------------------------------------------------- */ /* Laws: optional algebraic properties */ /* ------------------------------------------------------------------------- */ @@ -87,3 +143,49 @@ PROOF extern thm EXCL_RA_CANCELLATIVE; * source and a valid owned target. */ PROOF extern thm EXCL_RA_UPDATE; + +/* + * An owned source may be replaced by any valid target: + * + * forall (a:A) (x:(A)excl). + * ra_valid excl_ra x ==> + * ra_update excl_ra (Excl a) x + */ +PROOF extern thm EXCL_RA_UPDATE_VALID; + +/* + * The validity premise above is exact: + * + * forall (a:A) (x:(A)excl). + * ra_update excl_ra (Excl a) x <=> ra_valid excl_ra x + */ +PROOF extern thm EXCL_RA_UPDATE_OWNED_IFF; + +/* + * An invalid source admits every update vacuously: + * + * forall x:(A)excl. + * ra_update excl_ra ExclInvalid x + */ +PROOF extern thm EXCL_RA_UPDATE_INVALID; + +/* + * Full ownership of an owned value supports replacement by any valid target: + * + * forall (a:A) (x:(A)excl). + * ra_valid excl_ra x ==> + * ra_local_update excl_ra (Excl a,Excl a) (x,x) + */ +PROOF extern thm EXCL_RA_LOCAL_UPDATE_VALID; + +/* + * The validity premise is also necessary for full owned replacement: + * + * forall (a:A) (x:(A)excl). + * ra_local_update excl_ra (Excl a,Excl a) (x,x) <=> + * ra_valid excl_ra x + * + * Necessity follows by selecting the unit residual in the local-update + * definition; sufficiency is `EXCL_RA_LOCAL_UPDATE_VALID`. + */ +PROOF extern thm EXCL_RA_LOCAL_UPDATE_IFF; diff --git a/theory/logic/finmap.c b/theory/logic/finmap.c index 7855435..ba85191 100644 --- a/theory/logic/finmap.c +++ b/theory/logic/finmap.c @@ -869,6 +869,43 @@ PROOF static thm prove_finmap_delete_insert(void) { PROOF thm FINMAP_DELETE_INSERT = prove_finmap_delete_insert(); +PROOF static thm prove_finmap_delete_insert_ne(void) { + term goal_tm = ` + forall + (deleted:K) + (inserted:K) + (v:V) + (m:(K,V)finmap). + ~(deleted == inserted) ==> + finmap_delete deleted (finmap_insert inserted v m) == + finmap_insert inserted v (finmap_delete deleted m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "query"); + gnode_list deleted_cases = BOOL_CASES_TAC( + body, `(query:K) == (deleted:K)`, NULL); + for (size_t i = 0; i < vector_size(deleted_cases); ++i) { + gnode_list inserted_cases = BOOL_CASES_TAC( + deleted_cases[i], `(query:K) == (inserted:K)`, NULL); + for (size_t j = 0; j < vector_size(inserted_cases); ++j) { + CONV_WITH_ASMP_TAC( + inserted_cases[j], + rewrite_conv, + THM_LIST( + FINMAP_DELETE_LOOKUP, + FINMAP_INSERT_LOOKUP)); + } + } + return gnode_prove(root); +} + +PROOF thm FINMAP_DELETE_INSERT_NE = + prove_finmap_delete_insert_ne(); + PROOF static thm prove_finmap_insert_delete(void) { term goal_tm = ` forall @@ -1715,6 +1752,7 @@ PROOF static int audit_finmap(void) { FINMAP_DELETE_IDEMPOTENT, FINMAP_DELETE_COMM, FINMAP_DELETE_INSERT, + FINMAP_DELETE_INSERT_NE, FINMAP_INSERT_DELETE, FINMAP_INSERT_ID, FINMAP_DELETE_ID, diff --git a/theory/logic/finmap.h b/theory/logic/finmap.h index 7e2808f..620fec1 100644 --- a/theory/logic/finmap.h +++ b/theory/logic/finmap.h @@ -6,7 +6,8 @@ * `(K,V)finmap` is the conservative HOL subtype of total functions * `K->V option` satisfying * - * finmap_finite f <=> FINITE {k | ~(f k == NONE)}. + * forall f:K->V option. + * finmap_finite f <=> FINITE {k:K | ~(f k == NONE)}. * * `NONE` is absence; a `SOME v` entry remains present for every payload `v`. * The abstraction/representation functions are public theorem terms because @@ -22,7 +23,10 @@ /* Core representation */ /* ------------------------------------------------------------------------- */ -/* `finmap_finite f <=> FINITE {k | ~(f k == NONE)}`. */ +/* + * forall f:K->V option. + * finmap_finite f <=> FINITE {k:K | ~(f k == NONE)} + */ PROOF extern thm finmap_finite_def; /* @@ -30,16 +34,21 @@ PROOF extern thm finmap_finite_def; * `finmap_abs:(K->V option)->(K,V)finmap` and * `finmap_rep:(K,V)finmap->K->V option`: * - * (forall m. finmap_abs (finmap_rep m) == m) /\ - * (forall f. finmap_finite f <=> - * finmap_rep (finmap_abs f) == f). + * (forall m:(K,V)finmap. + * finmap_abs (finmap_rep m) == m) && + * (forall f:K->V option. + * finmap_finite f <=> + * finmap_rep (finmap_abs f) == f) */ PROOF extern thm FINMAP_TYPE_BIJECTION; /* `forall m:(K,V)finmap. finmap_finite (finmap_rep m)`. */ PROOF extern thm FINMAP_REP_FINITE; -/* `m == n <=> finmap_rep m == finmap_rep n`. */ +/* + * forall (m:(K,V)finmap) (n:(K,V)finmap). + * m == n <=> finmap_rep m == finmap_rep n + */ PROOF extern thm FINMAP_EQ; /* ------------------------------------------------------------------------- */ @@ -49,30 +58,42 @@ PROOF extern thm FINMAP_EQ; /* `finmap_empty:(K,V)finmap == finmap_abs (\k:K. NONE)`. */ PROOF extern thm finmap_empty_def; -/* `finmap_lookup m k == finmap_rep m k`. */ +/* + * forall (m:(K,V)finmap) (k:K). + * finmap_lookup m k == finmap_rep m k + */ PROOF extern thm finmap_lookup_def; /* - * `finmap_singleton key v == - * finmap_abs (\k. if k == key then SOME v else NONE)`. + * forall (key:K) (v:V). + * finmap_singleton key v == + * finmap_abs + * (\k:K. if k == key then SOME v else NONE) */ PROOF extern thm finmap_singleton_def; /* - * `finmap_insert key v m == - * finmap_abs - * (\k. if k == key then SOME v else finmap_rep m k)`. + * forall (key:K) (v:V) (m:(K,V)finmap). + * finmap_insert key v m == + * finmap_abs + * (\k:K. + * if k == key then SOME v else finmap_rep m k) */ PROOF extern thm finmap_insert_def; /* - * `finmap_delete key m == - * finmap_abs - * (\k. if k == key then NONE else finmap_rep m k)`. + * forall (key:K) (m:(K,V)finmap). + * finmap_delete key m == + * finmap_abs + * (\k:K. + * if k == key then NONE else finmap_rep m k) */ PROOF extern thm finmap_delete_def; -/* `finmap_dom m == {k | ~(finmap_lookup m k == NONE)}`. */ +/* + * forall m:(K,V)finmap. + * finmap_dom m == {k:K | ~(finmap_lookup m k == NONE)} + */ PROOF extern thm finmap_dom_def; /* ------------------------------------------------------------------------- */ @@ -86,79 +107,107 @@ PROOF extern thm FINMAP_EMPTY_REP; PROOF extern thm FINMAP_EMPTY_LOOKUP; /* - * `{k:K | ~((if k == key then SOME v else NONE) == NONE)} == {key}`. + * forall (key:K) (v:V). + * {k:K | ~((if k == key then SOME v else NONE) == NONE)} == + * {key} */ PROOF extern thm FINMAP_SINGLETON_SUPPORT; /* - * `finmap_rep (finmap_singleton key v) == - * (\k:K. if k == key then SOME v else NONE)`. + * forall (key:K) (v:V). + * finmap_rep (finmap_singleton key v) == + * (\k:K. if k == key then SOME v else NONE) */ PROOF extern thm FINMAP_SINGLETON_REP; /* - * `finmap_lookup (finmap_singleton key v) k == - * if k == key then SOME v else NONE`. + * forall (key:K) (v:V) (k:K). + * finmap_lookup (finmap_singleton key v) k == + * if k == key then SOME v else NONE */ PROOF extern thm FINMAP_SINGLETON_LOOKUP; /* - * `{k | ~((if k == key then SOME v else f k) == NONE)} == - * key INSERT {k | ~(f k == NONE)}`. + * forall (key:K) (v:V) (f:K->V option). + * {k:K | ~((if k == key then SOME v else f k) == NONE)} == + * key INSERT {k:K | ~(f k == NONE)} */ PROOF extern thm FINMAP_INSERT_SUPPORT; /* - * `finmap_rep (finmap_insert key v m) == - * (\k. if k == key then SOME v else finmap_rep m k)`. + * forall (key:K) (v:V) (m:(K,V)finmap). + * finmap_rep (finmap_insert key v m) == + * (\k:K. + * if k == key then SOME v else finmap_rep m k) */ PROOF extern thm FINMAP_INSERT_REP; /* - * `finmap_lookup (finmap_insert key v m) k == - * if k == key then SOME v else finmap_lookup m k`. + * forall + * (key:K) + * (v:V) + * (m:(K,V)finmap) + * (k:K). + * finmap_lookup (finmap_insert key v m) k == + * if k == key then SOME v else finmap_lookup m k */ PROOF extern thm FINMAP_INSERT_LOOKUP; -/* `finmap_lookup (finmap_insert key v m) key == SOME v`. */ +/* + * forall (key:K) (v:V) (m:(K,V)finmap). + * finmap_lookup (finmap_insert key v m) key == SOME v + */ PROOF extern thm FINMAP_INSERT_LOOKUP_EQ; /* - * `~(k == key) ==> - * finmap_lookup (finmap_insert key v m) k == finmap_lookup m k`. + * forall + * (key:K) + * (v:V) + * (m:(K,V)finmap) + * (k:K). + * ~(k == key) ==> + * finmap_lookup (finmap_insert key v m) k == finmap_lookup m k */ PROOF extern thm FINMAP_INSERT_LOOKUP_NE; /* - * `{k | ~((if k == key then NONE else f k) == NONE)} == - * {k | ~(f k == NONE)} DELETE key`. + * forall (key:K) (f:K->V option). + * {k:K | ~((if k == key then NONE else f k) == NONE)} == + * {k:K | ~(f k == NONE)} DELETE key */ PROOF extern thm FINMAP_DELETE_SUPPORT; /* - * `finmap_rep (finmap_delete key m) == - * (\k. if k == key then NONE else finmap_rep m k)`. + * forall (key:K) (m:(K,V)finmap). + * finmap_rep (finmap_delete key m) == + * (\k:K. if k == key then NONE else finmap_rep m k) */ PROOF extern thm FINMAP_DELETE_REP; /* - * `finmap_lookup (finmap_delete key m) k == - * if k == key then NONE else finmap_lookup m k`. + * forall (key:K) (m:(K,V)finmap) (k:K). + * finmap_lookup (finmap_delete key m) k == + * if k == key then NONE else finmap_lookup m k */ PROOF extern thm FINMAP_DELETE_LOOKUP; -/* `finmap_lookup (finmap_delete key m) key == NONE`. */ +/* + * forall (key:K) (m:(K,V)finmap). + * finmap_lookup (finmap_delete key m) key == NONE + */ PROOF extern thm FINMAP_DELETE_LOOKUP_EQ; /* - * `~(k == key) ==> - * finmap_lookup (finmap_delete key m) k == finmap_lookup m k`. + * forall (key:K) (m:(K,V)finmap) (k:K). + * ~(k == key) ==> + * finmap_lookup (finmap_delete key m) k == finmap_lookup m k */ PROOF extern thm FINMAP_DELETE_LOOKUP_NE; /* - * `m == n <=> - * forall k:K. finmap_lookup m k == finmap_lookup n k`. + * forall (m:(K,V)finmap) (n:(K,V)finmap). + * m == n <=> + * forall k:K. finmap_lookup m k == finmap_lookup n k */ PROOF extern thm FINMAP_EQ_LOOKUP; @@ -166,59 +215,101 @@ PROOF extern thm FINMAP_EQ_LOOKUP; /* Laws: insertion and deletion */ /* ------------------------------------------------------------------------- */ -/* `finmap_insert key v finmap_empty == finmap_singleton key v`. */ +/* + * forall (key:K) (v:V). + * finmap_insert key v (finmap_empty:(K,V)finmap) == + * finmap_singleton key v + */ PROOF extern thm FINMAP_INSERT_EMPTY; -/* `finmap_delete key finmap_empty == finmap_empty`. */ +/* + * forall key:K. + * finmap_delete key (finmap_empty:(K,V)finmap) == finmap_empty + */ PROOF extern thm FINMAP_DELETE_EMPTY; /* - * `finmap_insert key v (finmap_insert key w m) == - * finmap_insert key v m`. + * forall + * (key:K) + * (v:V) + * (w:V) + * (m:(K,V)finmap). + * finmap_insert key v (finmap_insert key w m) == + * finmap_insert key v m */ PROOF extern thm FINMAP_INSERT_OVERWRITE; /* - * `~(key1 == key2) ==> - * finmap_insert key1 v1 (finmap_insert key2 v2 m) == - * finmap_insert key2 v2 (finmap_insert key1 v1 m)`. + * forall + * (key1:K) + * (v1:V) + * (key2:K) + * (v2:V) + * (m:(K,V)finmap). + * ~(key1 == key2) ==> + * finmap_insert key1 v1 (finmap_insert key2 v2 m) == + * finmap_insert key2 v2 (finmap_insert key1 v1 m) */ PROOF extern thm FINMAP_INSERT_COMM; /* - * `finmap_delete key (finmap_delete key m) == finmap_delete key m`. + * forall (key:K) (m:(K,V)finmap). + * finmap_delete key (finmap_delete key m) == finmap_delete key m */ PROOF extern thm FINMAP_DELETE_IDEMPOTENT; /* - * `finmap_delete key1 (finmap_delete key2 m) == - * finmap_delete key2 (finmap_delete key1 m)`. + * forall (key1:K) (key2:K) (m:(K,V)finmap). + * finmap_delete key1 (finmap_delete key2 m) == + * finmap_delete key2 (finmap_delete key1 m) */ PROOF extern thm FINMAP_DELETE_COMM; /* - * `finmap_delete key (finmap_insert key v m) == finmap_delete key m`. + * forall (key:K) (v:V) (m:(K,V)finmap). + * finmap_delete key (finmap_insert key v m) == finmap_delete key m */ PROOF extern thm FINMAP_DELETE_INSERT; /* - * `finmap_insert key v (finmap_delete key m) == finmap_insert key v m`. + * Deletion commutes with insertion at a different key: + * + * forall + * (deleted:K) + * (inserted:K) + * (v:V) + * (m:(K,V)finmap). + * ~(deleted == inserted) ==> + * finmap_delete deleted (finmap_insert inserted v m) == + * finmap_insert inserted v (finmap_delete deleted m) + */ +PROOF extern thm FINMAP_DELETE_INSERT_NE; + +/* + * forall (key:K) (v:V) (m:(K,V)finmap). + * finmap_insert key v (finmap_delete key m) == + * finmap_insert key v m */ PROOF extern thm FINMAP_INSERT_DELETE; /* - * `finmap_lookup m key == SOME v ==> finmap_insert key v m == m`. + * forall (key:K) (v:V) (m:(K,V)finmap). + * finmap_lookup m key == SOME v ==> + * finmap_insert key v m == m */ PROOF extern thm FINMAP_INSERT_ID; /* - * `finmap_lookup m key == NONE ==> finmap_delete key m == m`. + * forall (key:K) (m:(K,V)finmap). + * finmap_lookup m key == NONE ==> + * finmap_delete key m == m */ PROOF extern thm FINMAP_DELETE_ID; /* - * `finmap_lookup m key == SOME v ==> - * finmap_insert key v (finmap_delete key m) == m`. + * forall (key:K) (v:V) (m:(K,V)finmap). + * finmap_lookup m key == SOME v ==> + * finmap_insert key v (finmap_delete key m) == m */ PROOF extern thm FINMAP_DECOMPOSE; @@ -232,22 +323,28 @@ PROOF extern thm FINMAP_DOM_FINITE; /* `finmap_dom (finmap_empty:(K,V)finmap) == {}`. */ PROOF extern thm FINMAP_DOM_EMPTY; -/* `forall key v. finmap_dom (finmap_singleton key v) == {key}`. */ +/* + * forall (key:K) (v:V). + * finmap_dom (finmap_singleton key v) == {key} + */ PROOF extern thm FINMAP_DOM_SINGLETON; /* - * `key IN finmap_dom m <=> ~(finmap_lookup m key == NONE)`. + * forall (key:K) (m:(K,V)finmap). + * key IN finmap_dom m <=> ~(finmap_lookup m key == NONE) */ PROOF extern thm FINMAP_IN_DOM; /* - * `key IN finmap_dom m <=> - * exists v. finmap_lookup m key == SOME v`. + * forall (key:K) (m:(K,V)finmap). + * key IN finmap_dom m <=> + * exists v:V. finmap_lookup m key == SOME v */ PROOF extern thm FINMAP_IN_DOM_SOME; /* - * `~(key IN finmap_dom m) <=> finmap_lookup m key == NONE`. + * forall (key:K) (m:(K,V)finmap). + * ~(key IN finmap_dom m) <=> finmap_lookup m key == NONE */ PROOF extern thm FINMAP_NOT_IN_DOM; @@ -301,17 +398,21 @@ PROOF extern thm FINMAP_FRESH; PROOF extern thm FINMAP_FRESH_PAIR; /* - * `finmap_dom m == {} <=> m == finmap_empty`. + * forall m:(K,V)finmap. + * finmap_dom m == {} <=> m == finmap_empty */ PROOF extern thm FINMAP_DOM_EQ_EMPTY; /* - * `finmap_dom (finmap_insert key v m) == key INSERT finmap_dom m`. + * forall (key:K) (v:V) (m:(K,V)finmap). + * finmap_dom (finmap_insert key v m) == + * key INSERT finmap_dom m */ PROOF extern thm FINMAP_DOM_INSERT; /* - * `finmap_dom (finmap_delete key m) == finmap_dom m DELETE key`. + * forall (key:K) (m:(K,V)finmap). + * finmap_dom (finmap_delete key m) == finmap_dom m DELETE key */ PROOF extern thm FINMAP_DOM_DELETE; @@ -322,11 +423,15 @@ PROOF extern thm FINMAP_DOM_DELETE; /* * Fresh-key induction: * - * P finmap_empty ==> - * (forall key v m. - * finmap_lookup m key == NONE ==> - * P m ==> - * P (finmap_insert key v m)) ==> - * forall m:(K,V)finmap. P m. + * forall P:((K,V)finmap)->bool. + * P finmap_empty ==> + * (forall + * (key:K) + * (v:V) + * (m:(K,V)finmap). + * finmap_lookup m key == NONE ==> + * P m ==> + * P (finmap_insert key v m)) ==> + * forall m:(K,V)finmap. P m */ PROOF extern thm FINMAP_INDUCT; diff --git a/theory/logic/frac_ra.c b/theory/logic/frac_ra.c index 812c16b..d79df6b 100644 --- a/theory/logic/frac_ra.c +++ b/theory/logic/frac_ra.c @@ -746,6 +746,96 @@ PROOF static thm prove_frac_ra_own_op(void) { PROOF thm FRAC_RA_OWN_OP = prove_frac_ra_own_op(); +PROOF static thm prove_frac_ra_own_inj(void) { + term goal_tm = ` + forall (p:real) (q:real) (a:A) (b:A). + &0 < (p:real) ==> + &0 < (q:real) ==> + (frac_own (p:real) (a:A) == + frac_own (q:real) (b:A) <=> + (p:real) == (q:real) && (a:A) == (b:A)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm p_value = mp_rule( + ispec_rule(`p:real`, FRAC_WEIGHT_OF_REAL_VALUE), + assume_rule(`&0 < (p:real)`)); + thm q_value = mp_rule( + ispec_rule(`q:real`, FRAC_WEIGHT_OF_REAL_VALUE), + assume_rule(`&0 < (q:real)`)); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + frac_own_def, + get_datatype_injectivity("frac"), + FRAC_WEIGHT_EQ, + p_value, + q_value))); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_OWN_INJ = + prove_frac_ra_own_inj(); + +PROOF static thm prove_frac_ra_own_ne_empty(void) { + term goal_tm = ` + forall (p:real) (a:A). + ~(frac_own p a == (frac_empty:(A)frac)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + frac_own_def, + frac_empty_def, + get_datatype_distinctness("frac")))); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_OWN_NE_EMPTY = + prove_frac_ra_own_ne_empty(); + +PROOF static thm prove_frac_ra_full_inj(void) { + term goal_tm = ` + forall (a:A) (b:A). + frac_full a == frac_full b <=> a == b + `; + thm one_inj = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST(`&1:real`, `&1:real`, `a:A`, `b:A`), + FRAC_RA_OWN_INJ), + get_theorem_by_name("REAL_LT_01")), + get_theorem_by_name("REAL_LT_01")); + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + frac_full_def, + one_inj))); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_FULL_INJ = + prove_frac_ra_full_inj(); + +PROOF static thm prove_frac_ra_full_ne_empty(void) { + term goal_tm = ` + forall a:A. + ~(frac_full a == (frac_empty:(A)frac)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + frac_full_def, + FRAC_RA_OWN_NE_EMPTY))); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_FULL_NE_EMPTY = + prove_frac_ra_full_ne_empty(); + PROOF static thm prove_frac_ra_valid_empty(void) { term goal_tm = ` forall R:(A)ra. @@ -841,6 +931,352 @@ PROOF static thm prove_frac_ra_valid_full(void) { PROOF thm FRAC_RA_VALID_FULL = prove_frac_ra_valid_full(); +/* ------------------------------------------------------------------------- */ +/* Inclusion */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_frac_ra_included_empty(void) { + term goal_tm = ` + forall (R:(A)ra) (x:(A)frac). + ra_included (frac_ra R) frac_empty x + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm included = ispecl_rule( + TERM_LIST( + `frac_ra (R:(A)ra)`, + `x:(A)frac`), + RA_INCLUDED_UNIT); + ACCEPT_TAC( + body, + pure_once_rewrite_rule( + THM_LIST(ispec_rule(`R:(A)ra`, FRAC_RA_UNIT)), + included)); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_INCLUDED_EMPTY = + prove_frac_ra_included_empty(); + +PROOF static thm prove_frac_ra_included_own(void) { + term goal_tm = ` + forall + (R:(A)ra) + (p:real) + (q:real) + (a:A) + (b:A). + &0 < p ==> + &0 < q ==> + (ra_included + (frac_ra R) + (frac_own p a) + (frac_own q b) <=> + (p == q && a == b) || + (p < q && ra_included R a b)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm p_value = mp_rule( + ispec_rule(`p:real`, FRAC_WEIGHT_OF_REAL_VALUE), + assume_rule(`&0 < (p:real)`)); + thm q_value = mp_rule( + ispec_rule(`q:real`, FRAC_WEIGHT_OF_REAL_VALUE), + assume_rule(`&0 < (q:real)`)); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hincluded"); + thm included = pure_once_rewrite_rule( + THM_LIST(ra_included_def), + assume_rule(` + ra_included + (frac_ra (R:(A)ra)) + (frac_own (p:real) (a:A)) + (frac_own (q:real) (b:A)) + `)); + forward = ASSUME_TAC(forward, included, "Hextension"); + forward = ASMP_EXISTS_TAC( + forward, "Hextension", "frame"); + gnode_list frame_cases = CASES_TAC( + forward, `frame:(A)frac`, "Hframe"); + + term unit_frame_eq_tm = gnode_get_asmps( + frame_cases[0], + CONST_STRING_LIST("Hframe"))[0]; + thm unit_extension = rewrite_rule( + THM_LIST( + assume_rule(unit_frame_eq_tm), + FRAC_RA_OP_FN, + frac_op_def, + frac_token_op_def, + frac_own_def), + assume_rule(` + frac_own (q:real) (b:A) == + ra_op + (frac_ra (R:(A)ra)) + (frac_own (p:real) (a:A)) + (frame:(A)frac) + `)); + thm unit_components = rewrite_rule( + THM_LIST( + get_datatype_injectivity("frac"), + FRAC_WEIGHT_EQ, + p_value, + q_value), + unit_extension); + gnode unit_result = DISJ1_TAC(frame_cases[0]); + gnode_list unit_parts = CONJ_TAC(unit_result); + ACCEPT_TAC( + unit_parts[0], + sym_rule(conjunct1_rule(unit_components))); + ACCEPT_TAC( + unit_parts[1], + sym_rule(conjunct2_rule(unit_components))); + + term owned_frame_eq_tm = gnode_get_asmps( + frame_cases[1], + CONST_STRING_LIST("Hframe"))[0]; + thm owned_components = rewrite_rule( + THM_LIST( + assume_rule(owned_frame_eq_tm), + FRAC_RA_OP_FN, + frac_op_def, + frac_token_op_def, + frac_own_def, + get_datatype_injectivity("frac")), + assume_rule(` + frac_own (q:real) (b:A) == + ra_op + (frac_ra (R:(A)ra)) + (frac_own (p:real) (a:A)) + (frame:(A)frac) + `)); + thm owned_weight_value_eq = ap_term_rule( + `frac_weight_value:frac_weight->real`, + conjunct1_rule(owned_components)); + owned_weight_value_eq = pure_rewrite_rule( + THM_LIST( + FRAC_WEIGHT_ADD_VALUE, + p_value, + q_value), + owned_weight_value_eq); + thm strict_weight = mp_rule( + mp_rule( + real_arith_rule(` + &0 < frac_weight_value (a0:frac_weight) ==> + (q:real) == + p + frac_weight_value a0 ==> + p < q + `), + ispec_rule( + `a0:frac_weight`, + FRAC_WEIGHT_VALUE_POS)), + owned_weight_value_eq); + gnode owned_result = DISJ2_TAC(frame_cases[1]); + gnode_list owned_parts = CONJ_TAC(owned_result); + ACCEPT_TAC(owned_parts[0], strict_weight); + gnode base_included = CONV_TAC( + owned_parts[1], + once_rewrite_conv(THM_LIST(ra_included_def))); + base_included = EXISTS_TAC(base_included, `a1:A`); + ACCEPT_TAC( + base_included, + conjunct2_rule(owned_components)); + + gnode reverse = DISCH_TAC(directions[1], "Hcases"); + gnode_list cases = ASMP_DISJ_TAC( + reverse, + "Hcases", + "Hequal", + "Hstrict"); + + gnode equal_case = ASMP_CONJ_TAC( + cases[0], + "Hequal", + "Hweight_eq", + "Hpayload_eq"); + thm equal_components = conj_rule( + assume_rule(`(p:real) == (q:real)`), + assume_rule(`(a:A) == (b:A)`)); + thm token_eq = eq_mp_rule( + sym_rule(mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `p:real`, `q:real`, `a:A`, `b:A`), + FRAC_RA_OWN_INJ), + assume_rule(`&0 < (p:real)`)), + assume_rule(`&0 < (q:real)`))), + equal_components); + thm equal_refl = ispecl_rule( + TERM_LIST( + `frac_ra (R:(A)ra)`, + `frac_own (p:real) (a:A)`), + RA_INCLUDED_REFL); + thm equal_transport = beta_rule(ap_term_rule( + `\x:(A)frac. + ra_included + (frac_ra (R:(A)ra)) + (frac_own (p:real) (a:A)) + x`, + token_eq)); + ACCEPT_TAC( + equal_case, + eq_mp_rule(equal_transport, equal_refl)); + + gnode strict_case = ASMP_CONJ_TAC( + cases[1], + "Hstrict", + "Hweight_lt", + "Hbase_included"); + thm base_extension = pure_once_rewrite_rule( + THM_LIST(ra_included_def), + assume_rule(` + ra_included (R:(A)ra) (a:A) (b:A) + `)); + strict_case = ASSUME_TAC( + strict_case, base_extension, "Hbase_extension"); + strict_case = ASMP_EXISTS_TAC( + strict_case, "Hbase_extension", "base_frame"); + gnode frac_extension = CONV_TAC( + strict_case, + once_rewrite_conv(THM_LIST(ra_included_def))); + frac_extension = EXISTS_TAC( + frac_extension, + `frac_own ((q:real) - p) (base_frame:A)`); + thm delta_pos = mp_rule( + real_arith_rule(` + (p:real) < q ==> &0 < q - p + `), + assume_rule(`(p:real) < (q:real)`)); + thm composition = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `p:real`, + `(q:real) - p`, + `a:A`, + `base_frame:A`), + FRAC_RA_OWN_OP), + assume_rule(`&0 < (p:real)`)), + delta_pos); + thm payload_lift = beta_rule(ap_term_rule( + `\x:A. frac_own (q:real) x`, + assume_rule(` + (b:A) == + ra_op (R:(A)ra) (a:A) (base_frame:A) + `))); + thm weight_eq = mp_rule( + real_arith_rule(` + (p:real) < q ==> q == p + (q - p) + `), + assume_rule(`(p:real) < (q:real)`)); + thm weight_lift = beta_rule(ap_term_rule( + `\r:real. + frac_own + r + (ra_op (R:(A)ra) (a:A) (base_frame:A))`, + weight_eq)); + ACCEPT_TAC( + frac_extension, + trans_rule( + payload_lift, + trans_rule( + weight_lift, + sym_rule(composition)))); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_INCLUDED_OWN = + prove_frac_ra_included_own(); + +PROOF static thm prove_frac_ra_not_included_own_empty(void) { + term goal_tm = ` + forall (R:(A)ra) (p:real) (a:A). + &0 < p ==> + ~(ra_included + (frac_ra R) + (frac_own p a) + frac_empty) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm included = pure_once_rewrite_rule( + THM_LIST(ra_included_def), + assume_rule(` + ra_included + (frac_ra (R:(A)ra)) + (frac_own (p:real) (a:A)) + frac_empty + `)); + body = ASSUME_TAC(body, included, "Hextension"); + body = ASMP_EXISTS_TAC(body, "Hextension", "frame"); + gnode_list frame_cases = CASES_TAC( + body, `frame:(A)frac`, "Hframe"); + for (size_t i = 0; i < vector_size(frame_cases); ++i) { + term frame_eq_tm = gnode_get_asmps( + frame_cases[i], + CONST_STRING_LIST("Hframe"))[0]; + thm contradiction = rewrite_rule( + THM_LIST( + assume_rule(frame_eq_tm), + FRAC_RA_OP_FN, + frac_op_def, + frac_token_op_def, + frac_empty_def, + frac_own_def, + get_datatype_distinctness("frac")), + assume_rule(` + (frac_empty:(A)frac) == + ra_op + (frac_ra (R:(A)ra)) + (frac_own (p:real) (a:A)) + (frame:(A)frac) + `)); + CONTR_TAC(frame_cases[i], contradiction); + } + return gnode_prove(root); +} + +PROOF thm FRAC_RA_NOT_INCLUDED_OWN_EMPTY = + prove_frac_ra_not_included_own_empty(); + +PROOF static thm prove_frac_ra_included_full(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_included + (frac_ra R) + (frac_full a) + (frac_full b) <=> + a == b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm included = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `&1:real`, + `&1:real`, + `a:A`, + `b:A`), + FRAC_RA_INCLUDED_OWN), + get_theorem_by_name("REAL_LT_01")), + get_theorem_by_name("REAL_LT_01")); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + frac_full_def, + included, + real_arith_rule(`~((&1:real) < &1)`)))); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_INCLUDED_FULL = + prove_frac_ra_included_full(); + /* ------------------------------------------------------------------------- */ /* Exclusive elements */ /* ------------------------------------------------------------------------- */ @@ -1731,6 +2167,37 @@ PROOF static thm prove_frac_ra_update_full(void) { PROOF thm FRAC_RA_UPDATE_FULL = prove_frac_ra_update_full(); +PROOF static thm prove_frac_ra_update_full_iff(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + (ra_update + (frac_ra R) + (frac_full a) + (frac_full b) <=> + (ra_valid R a ==> ra_valid R b)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm exact = mp_rule( + ispecl_rule( + TERM_LIST( + `frac_ra (R:(A)ra)`, + `frac_full (a:A)`, + `frac_full (b:A)`), + RA_EXCLUSIVE_UPDATE_IFF), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + FRAC_RA_EXCLUSIVE_FULL)); + exact = rewrite_rule( + THM_LIST(FRAC_RA_VALID_FULL), + exact); + ACCEPT_TAC(body, exact); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_UPDATE_FULL_IFF = + prove_frac_ra_update_full_iff(); + PROOF static thm prove_frac_ra_update_full_nd(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (P:A->bool). @@ -1817,6 +2284,128 @@ PROOF static thm prove_frac_ra_update_full_nd(void) { PROOF thm FRAC_RA_UPDATE_FULL_ND = prove_frac_ra_update_full_nd(); +PROOF static thm prove_frac_ra_full_image_valid_iff(void) { + term goal_tm = ` + forall (R:(A)ra) (P:A->bool). + ((exists x:(A)frac. + (exists b:A. + P b && x == frac_full b) && + ra_valid (frac_ra R) x) <=> + (exists b:A. P b && ra_valid R b)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC( + directions[0], "Hresult"); + forward = ASMP_EXISTS_TAC( + forward, "Hresult", "x"); + forward = ASMP_CONJ_TAC( + forward, + "Hresult", + "Himage", + "Hvalid"); + forward = ASMP_EXISTS_TAC( + forward, "Himage", "b"); + forward = ASMP_CONJ_TAC( + forward, + "Himage", + "HP_b", + "Hx"); + forward = EXISTS_TAC(forward, `b:A`); + gnode_list forward_parts = CONJ_TAC(forward); + ACCEPT_TAC( + forward_parts[0], + assume_rule(`(P:A->bool) (b:A)`)); + thm base_valid = rewrite_rule( + THM_LIST( + assume_rule(`(x:(A)frac) == frac_full (b:A)`), + FRAC_RA_VALID_FULL), + assume_rule(` + ra_valid + (frac_ra (R:(A)ra)) + (x:(A)frac) + `)); + ACCEPT_TAC(forward_parts[1], base_valid); + + gnode reverse = DISCH_TAC( + directions[1], "Hresult"); + reverse = ASMP_EXISTS_TAC( + reverse, "Hresult", "b"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hresult", + "HP_b", + "Hvalid_b"); + reverse = EXISTS_TAC( + reverse, `frac_full (b:A)`); + gnode_list reverse_parts = CONJ_TAC(reverse); + gnode image = EXISTS_TAC( + reverse_parts[0], `b:A`); + gnode_list image_parts = CONJ_TAC(image); + ACCEPT_TAC( + image_parts[0], + assume_rule(`(P:A->bool) (b:A)`)); + ACCEPT_TAC( + image_parts[1], + refl_rule(`frac_full (b:A)`)); + thm full_valid = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `b:A`), + FRAC_RA_VALID_FULL)), + assume_rule(`ra_valid (R:(A)ra) (b:A)`)); + ACCEPT_TAC(reverse_parts[1], full_valid); + return gnode_prove(root); +} + +PROOF static thm FRAC_RA_FULL_IMAGE_VALID_IFF = + prove_frac_ra_full_image_valid_iff(); + +PROOF static thm prove_frac_ra_update_full_nd_iff(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (P:A->bool). + (ra_update_nd + (frac_ra R) + (frac_full a) + (\x:(A)frac. + exists b:A. + P b && x == frac_full b) <=> + (ra_valid R a ==> + exists b:A. P b && ra_valid R b)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + term image = ` + \x:(A)frac. + exists b:A. + (P:A->bool) b && x == frac_full b + `; + thm exact = mp_rule( + ispecl_rule( + TERM_LIST( + `frac_ra (R:(A)ra)`, + `frac_full (a:A)`, + image), + RA_EXCLUSIVE_UPDATE_ND_IFF), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + FRAC_RA_EXCLUSIVE_FULL)); + exact = conv_rule( + depth_conv(get_conversion_by_name("BETA_CONV")), + exact); + exact = rewrite_rule( + THM_LIST( + FRAC_RA_VALID_FULL, + FRAC_RA_FULL_IMAGE_VALID_IFF), + exact); + ACCEPT_TAC(body, exact); + return gnode_prove(root); +} + +PROOF thm FRAC_RA_UPDATE_FULL_ND_IFF = + prove_frac_ra_update_full_nd_iff(); + PROOF static int audit_frac_ra(void) { thm_list audited_theorems = THM_LIST( FRAC_WEIGHT_REP_EXISTS, @@ -1852,15 +2441,26 @@ PROOF static int audit_frac_ra(void) { FRAC_RA_UNIT, FRAC_RA_FULL, FRAC_RA_OWN_OP, + FRAC_RA_OWN_INJ, + FRAC_RA_OWN_NE_EMPTY, + FRAC_RA_FULL_INJ, + FRAC_RA_FULL_NE_EMPTY, FRAC_RA_VALID_EMPTY, FRAC_RA_VALID_OWN, FRAC_RA_VALID_FULL, + FRAC_RA_INCLUDED_EMPTY, + FRAC_RA_INCLUDED_OWN, + FRAC_RA_NOT_INCLUDED_OWN_EMPTY, + FRAC_RA_INCLUDED_FULL, FRAC_RA_EXCLUSIVE_FULL, FRAC_RA_CANCELLATIVE, FRAC_RA_UPDATE_WEAKEN, FRAC_RA_UPDATE_WEAKEN_ND, FRAC_RA_UPDATE_FULL, - FRAC_RA_UPDATE_FULL_ND); + FRAC_RA_UPDATE_FULL_IFF, + FRAC_RA_UPDATE_FULL_ND, + FRAC_RA_FULL_IMAGE_VALID_IFF, + FRAC_RA_UPDATE_FULL_ND_IFF); for (size_t i = 0; i < vector_size(audited_theorems); diff --git a/theory/logic/frac_ra.h b/theory/logic/frac_ra.h index a207cf1..aa5af21 100644 --- a/theory/logic/frac_ra.h +++ b/theory/logic/frac_ra.h @@ -50,6 +50,40 @@ PROOF extern thm FRAC_RA_FULL; */ PROOF extern thm FRAC_RA_OWN_OP; +/* + * Positive smart constructors are injective in both their weight and payload: + * + * `forall (p:real) (q:real) (a:A) (b:A). + * &0 < p ==> + * &0 < q ==> + * (frac_own p a == frac_own q b <=> + * p == q && a == b)` + * + * The positivity premises are essential: outside the intended smart- + * constructor domain, `frac_weight_abs` need not represent its argument. + */ +PROOF extern thm FRAC_RA_OWN_INJ; + +/* + * Owned and empty constructors are distinct, even for a nonpositive argument: + * + * `forall (p:real) (a:A). + * ~(frac_own p a == (frac_empty:(A)frac))` + */ +PROOF extern thm FRAC_RA_OWN_NE_EMPTY; + +/* + * `forall (a:A) (b:A). + * frac_full a == frac_full b <=> a == b` + */ +PROOF extern thm FRAC_RA_FULL_INJ; + +/* + * `forall a:A. + * ~(frac_full a == (frac_empty:(A)frac))` + */ +PROOF extern thm FRAC_RA_FULL_NE_EMPTY; + /* ------------------------------------------------------------------------- */ /* Validity */ /* ------------------------------------------------------------------------- */ @@ -80,6 +114,60 @@ PROOF extern thm FRAC_RA_VALID_OWN; */ PROOF extern thm FRAC_RA_VALID_FULL; +/* ------------------------------------------------------------------------- */ +/* Inclusion */ +/* ------------------------------------------------------------------------- */ + +/* + * The empty token is the unit and hence is included in every token: + * + * `forall (R:(A)ra) (x:(A)frac). + * ra_included (frac_ra R) frac_empty x` + */ +PROOF extern thm FRAC_RA_INCLUDED_EMPTY; + +/* + * Exact inclusion between positive owned tokens: + * + * `forall (R:(A)ra) (p:real) (q:real) (a:A) (b:A). + * &0 < p ==> + * &0 < q ==> + * (ra_included + * (frac_ra R) + * (frac_own p a) + * (frac_own q b) <=> + * (p == q && a == b) || + * (p < q && ra_included R a b))` + * + * Equal weights leave only the empty frame. A nonempty frame contributes a + * strictly positive weight, producing the strict second alternative. + */ +PROOF extern thm FRAC_RA_INCLUDED_OWN; + +/* + * A positive owned token cannot be extended to the empty token: + * + * `forall (R:(A)ra) (p:real) (a:A). + * &0 < p ==> + * ~(ra_included + * (frac_ra R) + * (frac_own p a) + * frac_empty)` + */ +PROOF extern thm FRAC_RA_NOT_INCLUDED_OWN_EMPTY; + +/* + * Full-token inclusion collapses to payload equality: + * + * `forall (R:(A)ra) (a:A) (b:A). + * ra_included + * (frac_ra R) + * (frac_full a) + * (frac_full b) <=> + * a == b` + */ +PROOF extern thm FRAC_RA_INCLUDED_FULL; + /* ------------------------------------------------------------------------- */ /* Exclusive elements */ /* ------------------------------------------------------------------------- */ @@ -179,6 +267,19 @@ PROOF extern thm FRAC_RA_UPDATE_WEAKEN_ND; */ PROOF extern thm FRAC_RA_UPDATE_FULL; +/* + * Exact deterministic full-update characterization, including the vacuous + * invalid-source boundary: + * + * `forall (R:(A)ra) (a:A) (b:A). + * (ra_update + * (frac_ra R) + * (frac_full a) + * (frac_full b) <=> + * (ra_valid R a ==> ra_valid R b))` + */ +PROOF extern thm FRAC_RA_UPDATE_FULL_IFF; + /* * Exact-image nondeterministic full update: * @@ -194,3 +295,17 @@ PROOF extern thm FRAC_RA_UPDATE_FULL; * `P`; it does not admit arbitrary fractional resources. */ PROOF extern thm FRAC_RA_UPDATE_FULL_ND; + +/* + * Exact-image nondeterministic full update, with the source-validity guard: + * + * `forall (R:(A)ra) (a:A) (P:A->bool). + * (ra_update_nd + * (frac_ra R) + * (frac_full a) + * (\x:(A)frac. + * exists b:A. P b && x == frac_full b) <=> + * (ra_valid R a ==> + * exists b:A. P b && ra_valid R b))` + */ +PROOF extern thm FRAC_RA_UPDATE_FULL_ND_IFF; diff --git a/theory/logic/gmap_ra.c b/theory/logic/gmap_ra.c index 946142f..e5b105e 100644 --- a/theory/logic/gmap_ra.c +++ b/theory/logic/gmap_ra.c @@ -977,6 +977,47 @@ PROOF static thm prove_gmap_ra_singleton_op(void) { PROOF thm GMAP_RA_SINGLETON_OP = prove_gmap_ra_singleton_op(); +/* An existing binding composes with a singleton frame only at that key. */ +PROOF static thm prove_gmap_ra_op_singleton_at(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (frame:V) + (m:(K,V)finmap). + finmap_lookup m key == SOME a ==> + ra_op + (gmap_ra R) + m + (finmap_singleton key frame) == + finmap_insert key (ra_op R a frame) m + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "query"); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, "Hkey"); + for (size_t i = 0; i < vector_size(cases); ++i) { + CONV_WITH_ASMP_TAC( + cases[i], + rewrite_conv, + THM_LIST( + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP, + FINMAP_INSERT_LOOKUP, + OPTION_RA_OP_NONE_R, + OPTION_RA_OP_SOME_SOME)); + } + return gnode_prove(root); +} + +PROOF thm GMAP_RA_OP_SINGLETON_AT = + prove_gmap_ra_op_singleton_at(); + PROOF static thm prove_gmap_ra_singleton_op_fresh(void) { term goal_tm = ` forall @@ -1108,7 +1149,7 @@ PROOF static thm prove_gmap_ra_singleton_op_delete(void) { return gnode_prove(root); } -PROOF static thm GMAP_RA_SINGLETON_OP_DELETE = +PROOF thm GMAP_RA_SINGLETON_OP_DELETE = prove_gmap_ra_singleton_op_delete(); PROOF static thm prove_gmap_ra_dom_op(void) { @@ -1944,212 +1985,1209 @@ PROOF static thm prove_gmap_ra_included_dom(void) { PROOF thm GMAP_RA_INCLUDED_DOM = prove_gmap_ra_included_dom(); -/* - * Lift a deterministic base update through SOME at the selected key. At all - * other keys both source and target singletons contribute NONE, so the source - * pointwise validity is reused unchanged. - */ -PROOF static thm prove_gmap_ra_update_singleton(void) { +PROOF static thm prove_gmap_ra_local_update_singleton(void) { term goal_tm = ` - forall (R:(V)ra) (key:K) (a:V) (b:V). - ra_update R a b ==> - ra_update + forall + (R:(V)ra) + (key:K) + (a:V) + (f:V) + (b:V) + (g:V). + ra_local_update R (a,f) (b,g) ==> + ra_local_update (gmap_ra R) - (finmap_singleton key a) - (finmap_singleton key b) + (finmap_singleton key a,finmap_singleton key f) + (finmap_singleton key b,finmap_singleton key g) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(ra_update_def))); + once_rewrite_conv(THM_LIST(ra_local_update_def))); + body = CONV_TAC( + body, + rewrite_conv(THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); body = AUTO_INTROS_TAC(body); - thm source_valid_rule = ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `ra_op - (gmap_ra (R:(V)ra)) - (finmap_singleton (key:K) (a:V)) - (frame:(K,V)finmap)`), - GMAP_RA_VALID); thm source_all = eq_mp_rule( - source_valid_rule, + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `finmap_singleton (key:K) (a:V)`), + GMAP_RA_VALID), assume_rule(` ra_valid - (gmap_ra (R:(V)ra)) - (ra_op - (gmap_ra R) - (finmap_singleton (key:K) (a:V)) - (frame:(K,V)finmap)) + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (finmap_singleton (key:K) (a:V)) `)); + thm source_key_valid = rewrite_rule( + THM_LIST(FINMAP_SINGLETON_LOOKUP), + spec_rule(`key:K`, source_all)); - thm option_update = mp_rule( + thm source_key_eq = beta_rule(ap_term_rule( + `\m:(K,V)finmap. finmap_lookup m (key:K)`, + assume_rule(` + (finmap_singleton (key:K) (a:V)) == + ra_op + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (finmap_singleton key (f:V)) + (frame:(K,V)finmap) + `))); + source_key_eq = rewrite_rule( + THM_LIST( + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP), + source_key_eq); + + thm option_local = mp_rule( ispecl_rule( TERM_LIST( `R:(V)ra`, `a:V`, - `b:V`), - OPTION_RA_UPDATE), - assume_rule(`ra_update (R:(V)ra) (a:V) (b:V)`)); - option_update = pure_once_rewrite_rule( - THM_LIST(ra_update_def), - option_update); - - body = CONV_TAC( + `f:V`, + `b:V`, + `g:V`), + OPTION_RA_LOCAL_UPDATE_SOME), + assume_rule(` + ra_local_update + (R:(V)ra) + ((a:V),(f:V)) + ((b:V),(g:V)) + `)); + thm option_apply = rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + ispecl_rule( + TERM_LIST( + `option_ra (R:(V)ra)`, + `(SOME (a:V),SOME (f:V))`, + `(SOME (b:V),SOME (g:V))`, + `finmap_lookup + (frame:(K,V)finmap) + (key:K)`), + RA_LOCAL_UPDATE_APPLY)); + thm option_result = mp_rule( + mp_rule( + mp_rule( + option_apply, + option_local), + source_key_valid), + source_key_eq); + body = ASSUME_TAC( body, + conjunct1_rule(option_result), + "Htarget_key_valid"); + body = ASSUME_TAC( + body, + conjunct2_rule(option_result), + "Htarget_key_eq"); + + gnode_list result = CONJ_TAC(body); + + gnode target_valid = CONV_TAC( + result[0], once_rewrite_conv(THM_LIST(GMAP_RA_VALID))); - body = GEN_TAC(body, "query"); - thm source_at = spec_rule(`query:K`, source_all); - gnode_list cases = BOOL_CASES_TAC( - body, `(query:K) == (key:K)`, "Hkey"); - for (size_t i = 0; i < vector_size(cases); ++i) { + target_valid = GEN_TAC(target_valid, "query"); + gnode_list valid_cases = BOOL_CASES_TAC( + target_valid, `(query:K) == (key:K)`, "Hkey"); + for (size_t i = 0; i < vector_size(valid_cases); ++i) { thm branch = i == 0 - ? assume_rule(`query:K == key`) - : assume_rule(`~(query:K == key)`); - thm normalized_source = rewrite_rule( - THM_LIST( + ? assume_rule(`(query:K) == (key:K)`) + : assume_rule(`~((query:K) == (key:K))`); + gnode reduced = CONV_TAC( + valid_cases[i], + rewrite_conv(THM_LIST( branch, - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP, - OPTION_RA_OP_NONE_L), - source_at); - gnode reduced_goal = CONV_TAC( - cases[i], + FINMAP_SINGLETON_LOOKUP))); + if (i == 0) { + ACCEPT_TAC( + reduced, + assume_rule(` + ra_valid + (option_ra (R:(V)ra)) + (SOME (b:V)) + `)); + } else { + ACCEPT_TAC( + reduced, + ispec_rule(`R:(V)ra`, OPTION_RA_VALID_NONE)); + } + } + + gnode target_eq = CONV_TAC( + result[1], + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + target_eq = GEN_TAC(target_eq, "query"); + gnode_list eq_cases = BOOL_CASES_TAC( + target_eq, `(query:K) == (key:K)`, "Hkey"); + for (size_t i = 0; i < vector_size(eq_cases); ++i) { + thm branch = i == 0 + ? assume_rule(`(query:K) == (key:K)`) + : assume_rule(`~((query:K) == (key:K))`); + gnode reduced = CONV_TAC( + eq_cases[i], rewrite_conv(THM_LIST( branch, GMAP_RA_OP_LOOKUP, FINMAP_SINGLETON_LOOKUP, OPTION_RA_OP_NONE_L))); if (i == 0) { - thm updated = mp_rule( - spec_rule( - `finmap_lookup - (frame:(K,V)finmap) - (key:K)`, - option_update), - normalized_source); - ACCEPT_TAC(reduced_goal, updated); + thm target_key_eq = rewrite_rule( + THM_LIST(branch), + assume_rule(` + SOME (b:V) == + ra_op + (option_ra (R:(V)ra)) + (SOME (g:V)) + (finmap_lookup + (frame:(K,V)finmap) + (key:K)) + `)); + ACCEPT_TAC(reduced, target_key_eq); } else { - ACCEPT_TAC(reduced_goal, normalized_source); + thm source_at = beta_rule(ap_term_rule( + `\m:(K,V)finmap. finmap_lookup m (query:K)`, + assume_rule(` + (finmap_singleton (key:K) (a:V)) == + ra_op + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (finmap_singleton key (f:V)) + (frame:(K,V)finmap) + `))); + source_at = rewrite_rule( + THM_LIST( + branch, + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_OP_NONE_L), + source_at); + ACCEPT_TAC(reduced, source_at); } } return gnode_prove(root); } -PROOF thm GMAP_RA_UPDATE_SINGLETON = - prove_gmap_ra_update_singleton(); +PROOF thm GMAP_RA_LOCAL_UPDATE_SINGLETON = + prove_gmap_ra_local_update_singleton(); -/* Factor an inserted map into a singleton and the deleted remainder, frame - * the singleton update, and normalize both factorizations back to inserts. */ -PROOF static thm prove_gmap_ra_update_insert(void) { +PROOF static thm prove_gmap_ra_local_update_singleton_iff(void) { term goal_tm = ` forall (R:(V)ra) (key:K) (a:V) + (f:V) (b:V) - (m:(K,V)finmap). - ra_update R a b ==> - ra_update + (g:V). + ra_local_update (gmap_ra R) - (finmap_insert key a m) - (finmap_insert key b m) + (finmap_singleton key a,finmap_singleton key f) + (finmap_singleton key b,finmap_singleton key g) <=> + ra_local_update R (a,f) (b,g) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); - thm singleton_update = mp_rule( + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hmap_local"); + forward = CONV_TAC( + forward, + once_rewrite_conv(THM_LIST(ra_local_update_def))); + forward = CONV_TAC( + forward, + rewrite_conv(THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + forward = AUTO_INTROS_TAC(forward); + + thm source_map_valid = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST(`R:(V)ra`, `key:K`, `a:V`), + GMAP_RA_VALID_SINGLETON)), + assume_rule(`ra_valid (R:(V)ra) (a:V)`)); + thm source_singleton_eq = beta_rule(ap_term_rule( + `\x:V. finmap_singleton (key:K) x`, + assume_rule(` + (a:V) == ra_op (R:(V)ra) (f:V) (frame:V) + `))); + thm source_op = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `f:V`, + `frame:V`), + GMAP_RA_SINGLETON_OP); + thm source_map_eq = trans_rule( + source_singleton_eq, + gsym_rule(source_op)); + + thm map_apply = rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), ispecl_rule( TERM_LIST( - `R:(V)ra`, - `key:K`, - `a:V`, - `b:V`), - GMAP_RA_UPDATE_SINGLETON), - assume_rule(`ra_update (R:(V)ra) (a:V) (b:V)`)); - thm framed_update = mp_rule( + `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, + `(finmap_singleton (key:K) (a:V), + finmap_singleton key (f:V))`, + `(finmap_singleton (key:K) (b:V), + finmap_singleton key (g:V))`, + `finmap_singleton (key:K) (frame:V)`), + RA_LOCAL_UPDATE_APPLY)); + thm map_result = mp_rule( + mp_rule( + mp_rule( + map_apply, + assume_rule(` + ra_local_update + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (finmap_singleton (key:K) (a:V), + finmap_singleton key (f:V)) + (finmap_singleton key (b:V), + finmap_singleton key (g:V)) + `)), + source_map_valid), + source_map_eq); + + thm target_base_valid = eq_mp_rule( + ispecl_rule( + TERM_LIST(`R:(V)ra`, `key:K`, `b:V`), + GMAP_RA_VALID_SINGLETON), + conjunct1_rule(map_result)); + thm target_lookup_eq = beta_rule(ap_term_rule( + `\m:(K,V)finmap. finmap_lookup m (key:K)`, + conjunct2_rule(map_result))); + target_lookup_eq = rewrite_rule( + THM_LIST( + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_OP_SOME_SOME), + target_lookup_eq); + thm target_base_eq = eq_mp_rule( ispecl_rule( TERM_LIST( - `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, - `finmap_singleton (key:K) (a:V)`, - `finmap_singleton (key:K) (b:V)`), - RA_UPDATE_FRAME), - singleton_update); - framed_update = spec_rule( - `finmap_delete (key:K) (m:(K,V)finmap)`, - framed_update); - thm source_factorization = ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `a:V`, - `m:(K,V)finmap`), - GMAP_RA_SINGLETON_OP_DELETE); - thm target_factorization = ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `b:V`, - `m:(K,V)finmap`), - GMAP_RA_SINGLETON_OP_DELETE); + `b:V`, + `ra_op (R:(V)ra) (g:V) (frame:V)`), + OPTION_RA_SOME_INJ), + target_lookup_eq); ACCEPT_TAC( - body, - rewrite_rule( - THM_LIST( - source_factorization, - target_factorization), - framed_update)); + forward, + conj_rule(target_base_valid, target_base_eq)); + + gnode reverse = DISCH_TAC(directions[1], "Hbase_local"); + ACCEPT_TAC( + reverse, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `f:V`, + `b:V`, + `g:V`), + GMAP_RA_LOCAL_UPDATE_SINGLETON), + assume_rule(` + ra_local_update + (R:(V)ra) + ((a:V),(f:V)) + ((b:V),(g:V)) + `))); return gnode_prove(root); } -PROOF thm GMAP_RA_UPDATE_INSERT = - prove_gmap_ra_update_insert(); +PROOF thm GMAP_RA_LOCAL_UPDATE_SINGLETON_IFF = + prove_gmap_ra_local_update_singleton_iff(); -PROOF static thm prove_gmap_ra_update_at(void) { +/* Lift an existing-key base local update while retaining the original map at + * every other key. The proof applies the option local update to the selected + * lookup and reuses the source decomposition pointwise elsewhere. */ +PROOF static thm prove_gmap_ra_local_update_at(void) { term goal_tm = ` forall (R:(V)ra) (key:K) - (a:V) - (b:V) + (a:V) (f:V) + (b:V) (g:V) (m:(K,V)finmap). finmap_lookup m key == SOME a ==> - ra_update R a b ==> - ra_update + ra_local_update R (a,f) (b,g) ==> + ra_local_update (gmap_ra R) - m - (finmap_insert key b m) + (m,finmap_singleton key f) + (finmap_insert key b m,finmap_singleton key g) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); - thm inserted_update = mp_rule( - ispecl_rule( - TERM_LIST( + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_local_update_def))); + body = CONV_TAC( + body, + rewrite_conv(THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + body = AUTO_INTROS_TAC(body); + + thm source_all = eq_mp_rule( + ispecl_rule( + TERM_LIST(`R:(V)ra`, `m:(K,V)finmap`), + GMAP_RA_VALID), + assume_rule(` + ra_valid + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (m:(K,V)finmap) + `)); + thm source_key_valid = rewrite_rule( + THM_LIST(assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) + `)), + spec_rule(`key:K`, source_all)); + + thm source_key_eq = beta_rule(ap_term_rule( + `\whole:(K,V)finmap. finmap_lookup whole (key:K)`, + assume_rule(` + (m:(K,V)finmap) == + ra_op + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (finmap_singleton (key:K) (f:V)) + (frame:(K,V)finmap) + `))); + source_key_eq = rewrite_rule( + THM_LIST( + assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) + `), + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP), + source_key_eq); + + thm option_local = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `a:V`, + `f:V`, + `b:V`, + `g:V`), + OPTION_RA_LOCAL_UPDATE_SOME), + assume_rule(` + ra_local_update + (R:(V)ra) + ((a:V),(f:V)) + ((b:V),(g:V)) + `)); + thm option_apply = rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + ispecl_rule( + TERM_LIST( + `option_ra (R:(V)ra)`, + `(SOME (a:V),SOME (f:V))`, + `(SOME (b:V),SOME (g:V))`, + `finmap_lookup + (frame:(K,V)finmap) + (key:K)`), + RA_LOCAL_UPDATE_APPLY)); + thm option_result = mp_rule( + mp_rule( + mp_rule(option_apply, option_local), + source_key_valid), + source_key_eq); + + gnode_list result = CONJ_TAC(body); + + thm target_payload_valid = eq_mp_rule( + ispecl_rule( + TERM_LIST(`R:(V)ra`, `b:V`), + OPTION_RA_VALID_SOME), + conjunct1_rule(option_result)); + thm source_delete_valid = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `m:(K,V)finmap`), + GMAP_RA_VALID_DELETE), + assume_rule(` + ra_valid + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (m:(K,V)finmap) + `)); + thm target_valid = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `b:V`, + `m:(K,V)finmap`), + GMAP_RA_VALID_INSERT)), + conj_rule(target_payload_valid, source_delete_valid)); + ACCEPT_TAC(result[0], target_valid); + + gnode target_eq = CONV_TAC( + result[1], + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + target_eq = GEN_TAC(target_eq, "query"); + gnode_list query_cases = BOOL_CASES_TAC( + target_eq, `(query:K) == (key:K)`, "Hkey"); + for (size_t i = 0; i < vector_size(query_cases); ++i) { + thm branch = i == 0 + ? assume_rule(`(query:K) == (key:K)`) + : assume_rule(`~((query:K) == (key:K))`); + gnode reduced = CONV_TAC( + query_cases[i], + rewrite_conv(THM_LIST( + branch, + FINMAP_INSERT_LOOKUP, + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_OP_NONE_L))); + if (i == 0) { + thm target_key_eq = rewrite_rule( + THM_LIST(branch), + conjunct2_rule(option_result)); + ACCEPT_TAC(reduced, target_key_eq); + } else { + thm source_at = beta_rule(ap_term_rule( + `\whole:(K,V)finmap. finmap_lookup whole (query:K)`, + assume_rule(` + (m:(K,V)finmap) == + ra_op + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (finmap_singleton (key:K) (f:V)) + (frame:(K,V)finmap) + `))); + source_at = rewrite_rule( + THM_LIST( + branch, + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_OP_NONE_L), + source_at); + ACCEPT_TAC(reduced, source_at); + } + } + return gnode_prove(root); +} + +PROOF thm GMAP_RA_LOCAL_UPDATE_AT = + prove_gmap_ra_local_update_at(); + +/* Reify one arbitrary base residual as a map residual: it occupies the + * selected key, while the deleted source map supplies every other lookup. */ +PROOF static thm prove_gmap_ra_local_source_frame(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) (f:V) + (m:(K,V)finmap) + (frame:V). + finmap_lookup m key == SOME a ==> + a == ra_op R f frame ==> + m == + ra_op + (gmap_ra R) + (finmap_singleton key f) + (finmap_insert key frame (finmap_delete key m)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + body = GEN_TAC(body, "query"); + gnode_list query_cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, "Hkey"); + for (size_t i = 0; i < vector_size(query_cases); ++i) { + thm branch = i == 0 + ? assume_rule(`(query:K) == (key:K)`) + : assume_rule(`~((query:K) == (key:K))`); + CONV_WITH_ASMP_TAC( + query_cases[i], + rewrite_conv, + THM_LIST( + branch, + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP, + FINMAP_INSERT_LOOKUP, + FINMAP_DELETE_LOOKUP, + OPTION_RA_OP_NONE_L, + OPTION_RA_OP_SOME_SOME)); + } + return gnode_prove(root); +} + +PROOF static thm GMAP_RA_LOCAL_SOURCE_FRAME = + prove_gmap_ra_local_source_frame(); + +/* The converse exposes the validity boundary of local updates. For a valid + * map source, every base residual can be embedded as the selected lookup of a + * map residual. For an invalid source, the map local update is vacuous. */ +PROOF static thm prove_gmap_ra_local_update_at_iff(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) (f:V) + (b:V) (g:V) + (m:(K,V)finmap). + finmap_lookup m key == SOME a ==> + (ra_local_update + (gmap_ra R) + (m,finmap_singleton key f) + (finmap_insert key b m,finmap_singleton key g) <=> + (ra_valid (gmap_ra R) m ==> + ra_local_update R (a,f) (b,g))) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hmap_local"); + forward = DISCH_TAC(forward, "Hvalid_map"); + forward = CONV_TAC( + forward, + once_rewrite_conv(THM_LIST(ra_local_update_def))); + forward = CONV_TAC( + forward, + rewrite_conv(THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + forward = AUTO_INTROS_TAC(forward); + + term map_frame = ` + finmap_insert + (key:K) + (frame:V) + (finmap_delete key (m:(K,V)finmap)) + `; + thm source_map_eq = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `f:V`, + `m:(K,V)finmap`, + `frame:V`), + GMAP_RA_LOCAL_SOURCE_FRAME); + source_map_eq = mp_rule( + source_map_eq, + assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) + `)); + source_map_eq = mp_rule( + source_map_eq, + assume_rule(` + (a:V) == ra_op (R:(V)ra) (f:V) (frame:V) + `)); + + thm map_apply = rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + ispecl_rule( + TERM_LIST( + `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, + `((m:(K,V)finmap),finmap_singleton (key:K) (f:V))`, + `(finmap_insert (key:K) (b:V) (m:(K,V)finmap), + finmap_singleton key (g:V))`, + map_frame), + RA_LOCAL_UPDATE_APPLY)); + thm map_result = mp_rule( + mp_rule( + mp_rule( + map_apply, + assume_rule(` + ra_local_update + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + ((m:(K,V)finmap),finmap_singleton (key:K) (f:V)) + (finmap_insert key (b:V) m, + finmap_singleton key (g:V)) + `)), + assume_rule(` + ra_valid + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (m:(K,V)finmap) + `)), + source_map_eq); + + thm target_base_valid = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `b:V`, + `finmap_insert (key:K) (b:V) (m:(K,V)finmap)`), + GMAP_RA_VALID_LOOKUP); + target_base_valid = mp_rule( + target_base_valid, + conjunct1_rule(map_result)); + target_base_valid = mp_rule( + target_base_valid, + ispecl_rule( + TERM_LIST(`key:K`, `b:V`, `m:(K,V)finmap`), + FINMAP_INSERT_LOOKUP_EQ)); + + thm target_lookup_eq = beta_rule(ap_term_rule( + `\whole:(K,V)finmap. finmap_lookup whole (key:K)`, + conjunct2_rule(map_result))); + target_lookup_eq = rewrite_rule( + THM_LIST( + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP, + FINMAP_INSERT_LOOKUP, + OPTION_RA_OP_SOME_SOME), + target_lookup_eq); + thm target_base_eq = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `b:V`, + `ra_op (R:(V)ra) (g:V) (frame:V)`), + OPTION_RA_SOME_INJ), + target_lookup_eq); + ACCEPT_TAC( + forward, + conj_rule(target_base_valid, target_base_eq)); + + gnode reverse = DISCH_TAC(directions[1], "Hbase_guard"); + gnode_list validity_cases = BOOL_CASES_TAC( + reverse, + `ra_valid + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (m:(K,V)finmap)`, + "Hvalid_map"); + + thm base_local = mp_rule( + assume_rule(` + ra_valid + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (m:(K,V)finmap) ==> + ra_local_update + (R:(V)ra) + ((a:V),(f:V)) + ((b:V),(g:V)) + `), + assume_rule(` + ra_valid + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (m:(K,V)finmap) + `)); + thm lifted = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `f:V`, + `b:V`, + `g:V`, + `m:(K,V)finmap`), + GMAP_RA_LOCAL_UPDATE_AT); + lifted = mp_rule( + lifted, + assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) + `)); + lifted = mp_rule(lifted, base_local); + ACCEPT_TAC(validity_cases[0], lifted); + + thm invalid_local = ispecl_rule( + TERM_LIST( + `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, + `m:(K,V)finmap`, + `finmap_singleton (key:K) (f:V)`, + `finmap_insert (key:K) (b:V) (m:(K,V)finmap)`, + `finmap_singleton (key:K) (g:V)`), + RA_LOCAL_UPDATE_INVALID); + invalid_local = mp_rule( + invalid_local, + assume_rule(` + ~(ra_valid + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (m:(K,V)finmap)) + `)); + ACCEPT_TAC(validity_cases[1], invalid_local); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_LOCAL_UPDATE_AT_IFF = + prove_gmap_ra_local_update_at_iff(); + +/* + * Lift a deterministic base update through SOME at the selected key. At all + * other keys both source and target singletons contribute NONE, so the source + * pointwise validity is reused unchanged. + */ +PROOF static thm prove_gmap_ra_update_singleton(void) { + term goal_tm = ` + forall (R:(V)ra) (key:K) (a:V) (b:V). + ra_update R a b ==> + ra_update + (gmap_ra R) + (finmap_singleton key a) + (finmap_singleton key b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_def))); + body = AUTO_INTROS_TAC(body); + + thm source_valid_rule = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `ra_op + (gmap_ra (R:(V)ra)) + (finmap_singleton (key:K) (a:V)) + (frame:(K,V)finmap)`), + GMAP_RA_VALID); + thm source_all = eq_mp_rule( + source_valid_rule, + assume_rule(` + ra_valid + (gmap_ra (R:(V)ra)) + (ra_op + (gmap_ra R) + (finmap_singleton (key:K) (a:V)) + (frame:(K,V)finmap)) + `)); + + thm option_update = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `a:V`, + `b:V`), + OPTION_RA_UPDATE), + assume_rule(`ra_update (R:(V)ra) (a:V) (b:V)`)); + option_update = pure_once_rewrite_rule( + THM_LIST(ra_update_def), + option_update); + + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(GMAP_RA_VALID))); + body = GEN_TAC(body, "query"); + thm source_at = spec_rule(`query:K`, source_all); + gnode_list cases = BOOL_CASES_TAC( + body, `(query:K) == (key:K)`, "Hkey"); + for (size_t i = 0; i < vector_size(cases); ++i) { + thm branch = i == 0 + ? assume_rule(`query:K == key`) + : assume_rule(`~(query:K == key)`); + thm normalized_source = rewrite_rule( + THM_LIST( + branch, + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_OP_NONE_L), + source_at); + gnode reduced_goal = CONV_TAC( + cases[i], + rewrite_conv(THM_LIST( + branch, + GMAP_RA_OP_LOOKUP, + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_OP_NONE_L))); + if (i == 0) { + thm updated = mp_rule( + spec_rule( + `finmap_lookup + (frame:(K,V)finmap) + (key:K)`, + option_update), + normalized_source); + ACCEPT_TAC(reduced_goal, updated); + } else { + ACCEPT_TAC(reduced_goal, normalized_source); + } + } + return gnode_prove(root); +} + +PROOF thm GMAP_RA_UPDATE_SINGLETON = + prove_gmap_ra_update_singleton(); + +PROOF static thm prove_gmap_ra_update_singleton_iff(void) { + term goal_tm = ` + forall (R:(V)ra) (key:K) (a:V) (b:V). + ra_update + (gmap_ra R) + (finmap_singleton key a) + (finmap_singleton key b) <=> + ra_update R a b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hmap_update"); + forward = CONV_TAC( + forward, + once_rewrite_conv(THM_LIST(ra_update_def))); + forward = AUTO_INTROS_TAC(forward); + + thm source_singleton_valid = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `ra_op (R:(V)ra) (a:V) (frame:V)`), + GMAP_RA_VALID_SINGLETON)), + assume_rule(` + ra_valid + (R:(V)ra) + (ra_op R (a:V) (frame:V)) + `)); + thm source_op = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `frame:V`), + GMAP_RA_SINGLETON_OP); + thm source_validity_eq = beta_rule(ap_term_rule( + `\m:(K,V)finmap. + ra_valid + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + m`, + source_op)); + thm source_map_valid = eq_mp_rule( + gsym_rule(source_validity_eq), + source_singleton_valid); + + thm map_update = rewrite_rule( + THM_LIST(ra_update_def), + assume_rule(` + ra_update + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (finmap_singleton (key:K) (a:V)) + (finmap_singleton key (b:V)) + `)); + thm target_map_valid = mp_rule( + spec_rule( + `finmap_singleton (key:K) (frame:V)`, + map_update), + source_map_valid); + thm target_base_valid = rewrite_rule( + THM_LIST( + GMAP_RA_SINGLETON_OP, + GMAP_RA_VALID_SINGLETON), + target_map_valid); + ACCEPT_TAC(forward, target_base_valid); + + gnode reverse = DISCH_TAC(directions[1], "Hbase_update"); + ACCEPT_TAC( + reverse, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `b:V`), + GMAP_RA_UPDATE_SINGLETON), + assume_rule(`ra_update (R:(V)ra) (a:V) (b:V)`))); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_UPDATE_SINGLETON_IFF = + prove_gmap_ra_update_singleton_iff(); + +/* Factor an inserted map into a singleton and the deleted remainder, frame + * the singleton update, and normalize both factorizations back to inserts. */ +PROOF static thm prove_gmap_ra_update_insert(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (b:V) + (m:(K,V)finmap). + ra_update R a b ==> + ra_update + (gmap_ra R) + (finmap_insert key a m) + (finmap_insert key b m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm singleton_update = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `b:V`), + GMAP_RA_UPDATE_SINGLETON), + assume_rule(`ra_update (R:(V)ra) (a:V) (b:V)`)); + thm framed_update = mp_rule( + ispecl_rule( + TERM_LIST( + `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, + `finmap_singleton (key:K) (a:V)`, + `finmap_singleton (key:K) (b:V)`), + RA_UPDATE_FRAME), + singleton_update); + framed_update = spec_rule( + `finmap_delete (key:K) (m:(K,V)finmap)`, + framed_update); + thm source_factorization = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `m:(K,V)finmap`), + GMAP_RA_SINGLETON_OP_DELETE); + thm target_factorization = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `b:V`, + `m:(K,V)finmap`), + GMAP_RA_SINGLETON_OP_DELETE); + ACCEPT_TAC( + body, + rewrite_rule( + THM_LIST( + source_factorization, + target_factorization), + framed_update)); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_UPDATE_INSERT = + prove_gmap_ra_update_insert(); + +PROOF static thm prove_gmap_ra_update_at(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (b:V) + (m:(K,V)finmap). + finmap_lookup m key == SOME a ==> + ra_update R a b ==> + ra_update + (gmap_ra R) + m + (finmap_insert key b m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm inserted_update = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `b:V`, + `m:(K,V)finmap`), + GMAP_RA_UPDATE_INSERT), + assume_rule(`ra_update (R:(V)ra) (a:V) (b:V)`)); + thm source_identity = mp_rule( + ispecl_rule( + TERM_LIST( + `key:K`, + `a:V`, + `m:(K,V)finmap`), + FINMAP_INSERT_ID), + assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) + `)); + ACCEPT_TAC( + body, + rewrite_rule(THM_LIST(source_identity), inserted_update)); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_UPDATE_AT = + prove_gmap_ra_update_at(); + +/* A singleton hidden frame observes exactly the base frame at the selected + * key. Valid surrounding bindings are supplied by deleting that key from + * the valid source map. */ +PROOF static thm prove_gmap_ra_update_at_iff(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (b:V) + (m:(K,V)finmap). + finmap_lookup m key == SOME a ==> + (ra_update + (gmap_ra R) + m + (finmap_insert key b m) <=> + (ra_valid (gmap_ra R) m ==> + ra_update R a b)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hmap_update"); + forward = DISCH_TAC(forward, "Hvalid_map"); + forward = CONV_TAC( + forward, + once_rewrite_conv(THM_LIST(ra_update_def))); + forward = AUTO_INTROS_TAC(forward); + + thm deleted_valid = mp_rule( + ispecl_rule( + TERM_LIST( `R:(V)ra`, `key:K`, - `a:V`, - `b:V`, `m:(K,V)finmap`), - GMAP_RA_UPDATE_INSERT), - assume_rule(`ra_update (R:(V)ra) (a:V) (b:V)`)); - thm source_identity = mp_rule( + GMAP_RA_VALID_DELETE), + assume_rule(` + ra_valid + (gmap_ra (R:(V)ra)) + (m:(K,V)finmap) + `)); + thm inserted_source_valid = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `ra_op (R:(V)ra) (a:V) (frame:V)`, + `m:(K,V)finmap`), + GMAP_RA_VALID_INSERT)), + conj_rule( + assume_rule(` + ra_valid + (R:(V)ra) + (ra_op R (a:V) (frame:V)) + `), + deleted_valid)); + thm source_op = mp_rule( ispecl_rule( TERM_LIST( + `R:(V)ra`, `key:K`, `a:V`, + `frame:V`, `m:(K,V)finmap`), - FINMAP_INSERT_ID), + GMAP_RA_OP_SINGLETON_AT), assume_rule(` finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) `)); - ACCEPT_TAC( - body, - rewrite_rule(THM_LIST(source_identity), inserted_update)); + thm source_map_valid = eq_mp_rule( + ap_term_rule( + `ra_valid + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra)`, + gsym_rule(source_op)), + inserted_source_valid); + + term map_frame = `finmap_singleton (key:K) (frame:V)`; + term target_map = `finmap_insert (key:K) (b:V) (m:(K,V)finmap)`; + thm target_map_valid = ispecl_rule( + TERM_LIST( + `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, + `m:(K,V)finmap`, + target_map, + map_frame), + RA_UPDATE_APPLY); + target_map_valid = mp_rule( + target_map_valid, + assume_rule(` + ra_update + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (m:(K,V)finmap) + (finmap_insert (key:K) (b:V) m) + `)); + target_map_valid = mp_rule(target_map_valid, source_map_valid); + + thm target_lookup = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + target_map, + map_frame, + `key:K`), + GMAP_RA_OP_LOOKUP); + target_lookup = rewrite_rule( + THM_LIST( + FINMAP_INSERT_LOOKUP_EQ, + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_OP_SOME_SOME), + target_lookup); + thm target_base_valid = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `ra_op (R:(V)ra) (b:V) (frame:V)`, + `ra_op + (gmap_ra (R:(V)ra)) + (finmap_insert (key:K) (b:V) (m:(K,V)finmap)) + (finmap_singleton key (frame:V))`), + GMAP_RA_VALID_LOOKUP); + target_base_valid = mp_rule(target_base_valid, target_map_valid); + target_base_valid = mp_rule(target_base_valid, target_lookup); + ACCEPT_TAC(forward, target_base_valid); + + gnode reverse = DISCH_TAC(directions[1], "Hbase_guard"); + gnode_list validity_cases = BOOL_CASES_TAC( + reverse, + `ra_valid + (gmap_ra (R:(V)ra)) + (m:(K,V)finmap)`, + "Hvalid_map"); + + thm base_update = mp_rule( + assume_rule(` + ra_valid + (gmap_ra (R:(V)ra)) + (m:(K,V)finmap) ==> + ra_update (R:(V)ra) (a:V) (b:V) + `), + assume_rule(` + ra_valid + (gmap_ra (R:(V)ra)) + (m:(K,V)finmap) + `)); + thm lifted = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `b:V`, + `m:(K,V)finmap`), + GMAP_RA_UPDATE_AT); + lifted = mp_rule( + lifted, + assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) + `)); + lifted = mp_rule(lifted, base_update); + ACCEPT_TAC(validity_cases[0], lifted); + + thm invalid_update = ispecl_rule( + TERM_LIST( + `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, + `m:(K,V)finmap`, + `finmap_insert (key:K) (b:V) (m:(K,V)finmap)`), + RA_UPDATE_INVALID); + invalid_update = mp_rule( + invalid_update, + assume_rule(` + ~(ra_valid + (gmap_ra (R:(V)ra)) + (m:(K,V)finmap)) + `)); + ACCEPT_TAC(validity_cases[1], invalid_update); return gnode_prove(root); } -PROOF thm GMAP_RA_UPDATE_AT = - prove_gmap_ra_update_at(); +PROOF thm GMAP_RA_UPDATE_AT_IFF = + prove_gmap_ra_update_at_iff(); PROOF static thm prove_gmap_ra_update_delete(void) { term goal_tm = ` @@ -2351,6 +3389,133 @@ PROOF static thm prove_gmap_ra_update_singleton_nd(void) { PROOF thm GMAP_RA_UPDATE_SINGLETON_ND = prove_gmap_ra_update_singleton_nd(); +PROOF static thm prove_gmap_ra_update_singleton_nd_iff(void) { + term goal_tm = ` + forall (R:(V)ra) (key:K) (a:V) (P:V->bool). + ra_update_nd + (gmap_ra R) + (finmap_singleton key a) + (\m:(K,V)finmap. + exists b:V. + P b && m == finmap_singleton key b) <=> + ra_update_nd R a P + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hmap_update"); + forward = CONV_TAC( + forward, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + forward = AUTO_INTROS_TAC(forward); + + thm source_singleton_valid = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `ra_op (R:(V)ra) (a:V) (frame:V)`), + GMAP_RA_VALID_SINGLETON)), + assume_rule(` + ra_valid + (R:(V)ra) + (ra_op R (a:V) (frame:V)) + `)); + thm source_op = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `frame:V`), + GMAP_RA_SINGLETON_OP); + thm source_validity_eq = beta_rule(ap_term_rule( + `\m:(K,V)finmap. + ra_valid + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + m`, + source_op)); + thm source_map_valid = eq_mp_rule( + gsym_rule(source_validity_eq), + source_singleton_valid); + + thm map_update = rewrite_rule( + THM_LIST(ra_update_nd_def), + assume_rule(` + ra_update_nd + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (finmap_singleton (key:K) (a:V)) + (\m:(K,V)finmap. + exists b:V. + (P:V->bool) b && + m == finmap_singleton key b) + `)); + thm selected = mp_rule( + spec_rule( + `finmap_singleton (key:K) (frame:V)`, + map_update), + source_map_valid); + selected = beta_rule(selected); + forward = ASSUME_TAC(forward, selected, "Hselected"); + forward = ASMP_EXISTS_TAC(forward, "Hselected", "result"); + forward = ASMP_CONJ_TAC( + forward, + "Hselected", + "Hresult_image", + "Hresult_valid"); + forward = ASMP_EXISTS_TAC(forward, "Hresult_image", "b"); + forward = ASMP_CONJ_TAC( + forward, + "Hresult_image", + "HP_b", + "Hresult_singleton"); + + thm target_base_valid = rewrite_rule( + THM_LIST( + assume_rule(` + (result:(K,V)finmap) == + finmap_singleton (key:K) (b:V) + `), + GMAP_RA_SINGLETON_OP, + GMAP_RA_VALID_SINGLETON), + assume_rule(` + ra_valid + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (ra_op + (gmap_ra R) + (result:(K,V)finmap) + (finmap_singleton (key:K) (frame:V))) + `)); + forward = EXISTS_TAC(forward, `b:V`); + gnode_list result_parts = CONJ_TAC(forward); + ACCEPT_TAC( + result_parts[0], + assume_rule(`(P:V->bool) (b:V)`)); + ACCEPT_TAC(result_parts[1], target_base_valid); + + gnode reverse = DISCH_TAC(directions[1], "Hbase_update"); + ACCEPT_TAC( + reverse, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `P:V->bool`), + GMAP_RA_UPDATE_SINGLETON_ND), + assume_rule(` + ra_update_nd + (R:(V)ra) + (a:V) + (P:V->bool) + `))); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_UPDATE_SINGLETON_ND_IFF = + prove_gmap_ra_update_singleton_nd_iff(); + /* Frame the exact singleton image by the deleted remainder. ND * monotonicity then normalizes each selected singleton back to an insertion; * the selected payload remains free to depend on the hidden frame. */ @@ -2544,6 +3709,252 @@ PROOF static thm prove_gmap_ra_update_at_nd(void) { PROOF thm GMAP_RA_UPDATE_AT_ND = prove_gmap_ra_update_at_nd(); +/* The exact insertion image lets a selected map result be projected back to + * its payload at `key`. As in the deterministic characterization, source + * validity is needed only for this reverse projection; an invalid map admits + * every ND update vacuously. */ +PROOF static thm prove_gmap_ra_update_at_nd_iff(void) { + term goal_tm = ` + forall + (R:(V)ra) + (key:K) + (a:V) + (P:V->bool) + (m:(K,V)finmap). + finmap_lookup m key == SOME a ==> + (ra_update_nd + (gmap_ra R) + m + (\result:(K,V)finmap. + exists b:V. + P b && result == finmap_insert key b m) <=> + (ra_valid (gmap_ra R) m ==> + ra_update_nd R a P)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hmap_update"); + forward = DISCH_TAC(forward, "Hvalid_map"); + forward = CONV_TAC( + forward, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + forward = AUTO_INTROS_TAC(forward); + + thm deleted_valid = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `m:(K,V)finmap`), + GMAP_RA_VALID_DELETE), + assume_rule(` + ra_valid + (gmap_ra (R:(V)ra)) + (m:(K,V)finmap) + `)); + thm inserted_source_valid = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `ra_op (R:(V)ra) (a:V) (frame:V)`, + `m:(K,V)finmap`), + GMAP_RA_VALID_INSERT)), + conj_rule( + assume_rule(` + ra_valid + (R:(V)ra) + (ra_op R (a:V) (frame:V)) + `), + deleted_valid)); + thm source_op = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `frame:V`, + `m:(K,V)finmap`), + GMAP_RA_OP_SINGLETON_AT), + assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) + `)); + thm source_map_valid = eq_mp_rule( + ap_term_rule( + `ra_valid + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra)`, + gsym_rule(source_op)), + inserted_source_valid); + + term map_image = ` + \result:(K,V)finmap. + exists b:V. + (P:V->bool) b && + result == + finmap_insert + (key:K) + b + (m:(K,V)finmap) + `; + term map_frame = `finmap_singleton (key:K) (frame:V)`; + thm selected_map = ispecl_rule( + TERM_LIST( + `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, + `m:(K,V)finmap`, + map_image, + map_frame), + RA_UPDATE_ND_APPLY); + selected_map = mp_rule( + selected_map, + assume_rule(` + ra_update_nd + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (m:(K,V)finmap) + (\result:(K,V)finmap. + exists b:V. + (P:V->bool) b && + result == + finmap_insert + (key:K) + b + (m:(K,V)finmap)) + `)); + selected_map = mp_rule(selected_map, source_map_valid); + selected_map = beta_rule(selected_map); + forward = ASSUME_TAC(forward, selected_map, "Hselected_map"); + forward = ASMP_EXISTS_TAC( + forward, "Hselected_map", "result"); + forward = ASMP_CONJ_TAC( + forward, + "Hselected_map", + "Hresult_image", + "Hresult_valid"); + forward = ASMP_EXISTS_TAC( + forward, "Hresult_image", "selected"); + forward = ASMP_CONJ_TAC( + forward, + "Hresult_image", + "HP_selected", + "Hresult_insert"); + forward = EXISTS_TAC(forward, `selected:V`); + gnode_list selected_parts = CONJ_TAC(forward); + ACCEPT_TAC( + selected_parts[0], + assume_rule(`(P:V->bool) (selected:V)`)); + + thm target_map_valid = rewrite_rule( + THM_LIST(assume_rule(` + (result:(K,V)finmap) == + finmap_insert + (key:K) + (selected:V) + (m:(K,V)finmap) + `)), + assume_rule(` + ra_valid + ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) + (ra_op + (gmap_ra R) + (result:(K,V)finmap) + (finmap_singleton (key:K) (frame:V))) + `)); + term target_map = ` + finmap_insert + (key:K) + (selected:V) + (m:(K,V)finmap) + `; + thm target_lookup = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + target_map, + map_frame, + `key:K`), + GMAP_RA_OP_LOOKUP); + target_lookup = rewrite_rule( + THM_LIST( + FINMAP_INSERT_LOOKUP_EQ, + FINMAP_SINGLETON_LOOKUP, + OPTION_RA_OP_SOME_SOME), + target_lookup); + thm target_base_valid = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `ra_op (R:(V)ra) (selected:V) (frame:V)`, + `ra_op + (gmap_ra (R:(V)ra)) + (finmap_insert + (key:K) + (selected:V) + (m:(K,V)finmap)) + (finmap_singleton key (frame:V))`), + GMAP_RA_VALID_LOOKUP); + target_base_valid = mp_rule(target_base_valid, target_map_valid); + target_base_valid = mp_rule(target_base_valid, target_lookup); + ACCEPT_TAC(selected_parts[1], target_base_valid); + + gnode reverse = DISCH_TAC(directions[1], "Hbase_guard"); + gnode_list validity_cases = BOOL_CASES_TAC( + reverse, + `ra_valid + (gmap_ra (R:(V)ra)) + (m:(K,V)finmap)`, + "Hvalid_map"); + + thm base_update = mp_rule( + assume_rule(` + ra_valid + (gmap_ra (R:(V)ra)) + (m:(K,V)finmap) ==> + ra_update_nd + (R:(V)ra) + (a:V) + (P:V->bool) + `), + assume_rule(` + ra_valid + (gmap_ra (R:(V)ra)) + (m:(K,V)finmap) + `)); + thm lifted = ispecl_rule( + TERM_LIST( + `R:(V)ra`, + `key:K`, + `a:V`, + `P:V->bool`, + `m:(K,V)finmap`), + GMAP_RA_UPDATE_AT_ND); + lifted = mp_rule( + lifted, + assume_rule(` + finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) + `)); + lifted = mp_rule(lifted, base_update); + ACCEPT_TAC(validity_cases[0], lifted); + + thm invalid_update = ispecl_rule( + TERM_LIST( + `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, + `m:(K,V)finmap`, + map_image), + RA_UPDATE_ND_INVALID); + invalid_update = mp_rule( + invalid_update, + assume_rule(` + ~(ra_valid + (gmap_ra (R:(V)ra)) + (m:(K,V)finmap)) + `)); + ACCEPT_TAC(validity_cases[1], invalid_update); + return gnode_prove(root); +} + +PROOF thm GMAP_RA_UPDATE_AT_ND_IFF = + prove_gmap_ra_update_at_nd_iff(); + /* Pick the fresh key only after the hidden map frame has been introduced. * The common-freshness theorem is precisely where infinitude is used: both * finite domains can be avoided at once. */ @@ -2894,6 +4305,7 @@ PROOF static int audit_gmap_ra(void) { GMAP_RA_OP_FN, GMAP_RA_VALID_FN, GMAP_RA_OP_LOOKUP, + GMAP_RA_OP_SINGLETON_AT, GMAP_RA_OP_INSERT_INSERT, GMAP_RA_OP_DELETE, GMAP_RA_VALID, @@ -2920,13 +4332,22 @@ PROOF static int audit_gmap_ra(void) { GMAP_RA_INCLUDED_DELETE, GMAP_RA_INCLUDED_LOOKUP_SOME, GMAP_RA_INCLUDED_DOM, + GMAP_RA_LOCAL_UPDATE_SINGLETON, + GMAP_RA_LOCAL_UPDATE_SINGLETON_IFF, + GMAP_RA_LOCAL_UPDATE_AT, + GMAP_RA_LOCAL_SOURCE_FRAME, + GMAP_RA_LOCAL_UPDATE_AT_IFF, GMAP_RA_UPDATE_SINGLETON, + GMAP_RA_UPDATE_SINGLETON_IFF, GMAP_RA_UPDATE_INSERT, GMAP_RA_UPDATE_AT, + GMAP_RA_UPDATE_AT_IFF, GMAP_RA_UPDATE_DELETE, GMAP_RA_UPDATE_SINGLETON_ND, + GMAP_RA_UPDATE_SINGLETON_ND_IFF, GMAP_RA_UPDATE_INSERT_ND, GMAP_RA_UPDATE_AT_ND, + GMAP_RA_UPDATE_AT_ND_IFF, GMAP_RA_ALLOC_STRONG_DEP, GMAP_RA_ALLOC_STRONG, GMAP_RA_ALLOC, diff --git a/theory/logic/gmap_ra.h b/theory/logic/gmap_ra.h index 74d6945..a2451f9 100644 --- a/theory/logic/gmap_ra.h +++ b/theory/logic/gmap_ra.h @@ -49,55 +49,119 @@ PROOF extern thm GMAP_RA_OP_LOOKUP; */ PROOF extern thm GMAP_RA_SINGLETON_OP; +/* + * Composition with a singleton frame updates an existing binding pointwise: + * + * forall + * (R:(V)ra) + * (key:K) + * (a:V) + * (frame:V) + * (m:(K,V)finmap). + * finmap_lookup m key == SOME a ==> + * ra_op + * (gmap_ra R) + * m + * (finmap_singleton key frame) == + * finmap_insert key (ra_op R a frame) m + * + * Away from `key`, the singleton contributes `NONE`; at `key`, option + * composition reduces to `SOME (a · frame)`. + */ +PROOF extern thm GMAP_RA_OP_SINGLETON_AT; + /* * Composition distributes through insertion at the same key: * - * ra_op - * (gmap_ra R) - * (finmap_insert key a m) - * (finmap_insert key b n) == - * finmap_insert - * key - * (ra_op R a b) - * (ra_op (gmap_ra R) m n) + * forall + * (R:(V)ra) + * (key:K) + * (a:V) + * (b:V) + * (m:(K,V)finmap) + * (n:(K,V)finmap). + * ra_op + * (gmap_ra R) + * (finmap_insert key a m) + * (finmap_insert key b n) == + * finmap_insert + * key + * (ra_op R a b) + * (ra_op (gmap_ra R) m n) */ PROOF extern thm GMAP_RA_OP_INSERT_INSERT; /* * Deleting the same key commutes with map composition: * - * ra_op - * (gmap_ra R) - * (finmap_delete key m) - * (finmap_delete key n) == - * finmap_delete key (ra_op (gmap_ra R) m n) + * forall + * (R:(V)ra) + * (key:K) + * (m:(K,V)finmap) + * (n:(K,V)finmap). + * ra_op + * (gmap_ra R) + * (finmap_delete key m) + * (finmap_delete key n) == + * finmap_delete key (ra_op (gmap_ra R) m n) */ PROOF extern thm GMAP_RA_OP_DELETE; /* * A singleton composes with a map missing its key by insertion: * - * finmap_lookup m key == NONE ==> - * ra_op (gmap_ra R) (finmap_singleton key a) m == - * finmap_insert key a m + * forall + * (R:(V)ra) + * (key:K) + * (a:V) + * (m:(K,V)finmap). + * finmap_lookup m key == NONE ==> + * ra_op (gmap_ra R) (finmap_singleton key a) m == + * finmap_insert key a m */ PROOF extern thm GMAP_RA_SINGLETON_OP_FRESH; /* * A present entry splits off as a singleton resource: * - * finmap_lookup m key == SOME a ==> - * m == - * ra_op - * (gmap_ra R) - * (finmap_singleton key a) - * (finmap_delete key m) + * forall + * (R:(V)ra) + * (key:K) + * (a:V) + * (m:(K,V)finmap). + * finmap_lookup m key == SOME a ==> + * m == + * ra_op + * (gmap_ra R) + * (finmap_singleton key a) + * (finmap_delete key m) */ PROOF extern thm GMAP_RA_DECOMPOSE; /* - * `finmap_dom (ra_op (gmap_ra R) m n) == - * finmap_dom m UNION finmap_dom n`. + * Inserting a payload is exactly composition of its singleton resource with + * the map from which that key has been removed: + * + * forall + * (R:(V)ra) + * (key:K) + * (a:V) + * (m:(K,V)finmap). + * ra_op + * (gmap_ra R) + * (finmap_singleton key a) + * (finmap_delete key m) == + * finmap_insert key a m + */ +PROOF extern thm GMAP_RA_SINGLETON_OP_DELETE; + +/* + * forall + * (R:(V)ra) + * (m:(K,V)finmap) + * (n:(K,V)finmap). + * finmap_dom (ra_op (gmap_ra R) m n) == + * finmap_dom m UNION finmap_dom n */ PROOF extern thm GMAP_RA_DOM_OP; @@ -136,44 +200,69 @@ PROOF extern thm GMAP_RA_VALID_LOOKUP_DELETE; /* * Payload-facing form of the same deletion split: * - * finmap_lookup m key == SOME a ==> - * (ra_valid (gmap_ra R) m <=> - * ra_valid R a && - * ra_valid (gmap_ra R) (finmap_delete key m)) + * forall + * (R:(V)ra) + * (key:K) + * (a:V) + * (m:(K,V)finmap). + * finmap_lookup m key == SOME a ==> + * (ra_valid (gmap_ra R) m <=> + * ra_valid R a && + * ra_valid (gmap_ra R) (finmap_delete key m)) */ PROOF extern thm GMAP_RA_VALID_DELETE_SOME; /* * A present lookup of a valid map contains a valid payload: * - * ra_valid (gmap_ra R) m ==> - * finmap_lookup m key == SOME a ==> - * ra_valid R a + * forall + * (R:(V)ra) + * (key:K) + * (a:V) + * (m:(K,V)finmap). + * ra_valid (gmap_ra R) m ==> + * finmap_lookup m key == SOME a ==> + * ra_valid R a */ PROOF extern thm GMAP_RA_VALID_LOOKUP; -/* Deleting any key preserves validity. */ +/* + * Deleting any key preserves validity: + * + * forall (R:(V)ra) (key:K) (m:(K,V)finmap). + * ra_valid (gmap_ra R) m ==> + * ra_valid (gmap_ra R) (finmap_delete key m) + */ PROOF extern thm GMAP_RA_VALID_DELETE; /* * Insertion validity ignores the overwritten entry and checks exactly the * new payload and the remaining map: * - * ra_valid (gmap_ra R) (finmap_insert key a m) <=> - * ra_valid R a && - * ra_valid (gmap_ra R) (finmap_delete key m) + * forall (R:(V)ra) (key:K) (a:V) (m:(K,V)finmap). + * ra_valid (gmap_ra R) (finmap_insert key a m) <=> + * ra_valid R a && + * ra_valid (gmap_ra R) (finmap_delete key m) */ PROOF extern thm GMAP_RA_VALID_INSERT; -/* Valid payload and valid surrounding map imply valid insertion. */ +/* + * Valid payload and valid surrounding map imply valid insertion: + * + * forall (R:(V)ra) (key:K) (a:V) (m:(K,V)finmap). + * ra_valid R a ==> + * ra_valid (gmap_ra R) m ==> + * ra_valid (gmap_ra R) (finmap_insert key a m) + */ PROOF extern thm GMAP_RA_VALID_INSERT_OF_VALID; /* * At a fresh key, insertion validity factors into payload and map validity: * - * finmap_lookup m key == NONE ==> - * (ra_valid (gmap_ra R) (finmap_insert key a m) <=> - * ra_valid R a && ra_valid (gmap_ra R) m) + * forall (R:(V)ra) (key:K) (a:V) (m:(K,V)finmap). + * finmap_lookup m key == NONE ==> + * (ra_valid (gmap_ra R) (finmap_insert key a m) <=> + * ra_valid R a && ra_valid (gmap_ra R) m) */ PROOF extern thm GMAP_RA_VALID_INSERT_FRESH; @@ -203,47 +292,71 @@ PROOF extern thm GMAP_RA_INCLUDED_LOOKUP; /* * Pointwise option inclusion constructs a finite-map inclusion witness: * - * (forall k:K. - * ra_included - * (option_ra R) - * (finmap_lookup m k) - * (finmap_lookup n k)) ==> - * ra_included (gmap_ra R) m n + * forall + * (R:(V)ra) + * (m:(K,V)finmap) + * (n:(K,V)finmap). + * (forall k:K. + * ra_included + * (option_ra R) + * (finmap_lookup m k) + * (finmap_lookup n k)) ==> + * ra_included (gmap_ra R) m n */ PROOF extern thm GMAP_RA_INCLUDED_OF_LOOKUP; /* * Finite-map inclusion is exactly pointwise option inclusion: * - * ra_included (gmap_ra R) m n <=> - * forall k:K. - * ra_included - * (option_ra R) - * (finmap_lookup m k) - * (finmap_lookup n k) + * forall + * (R:(V)ra) + * (m:(K,V)finmap) + * (n:(K,V)finmap). + * ra_included (gmap_ra R) m n <=> + * forall k:K. + * ra_included + * (option_ra R) + * (finmap_lookup m k) + * (finmap_lookup n k) */ PROOF extern thm GMAP_RA_INCLUDED_LOOKUP_IFF; -/* Deleting a binding produces a subresource of the original map. */ +/* + * Deleting a binding produces a subresource of the original map: + * + * forall (R:(V)ra) (key:K) (m:(K,V)finmap). + * ra_included + * (gmap_ra R) + * (finmap_delete key m) + * m + */ PROOF extern thm GMAP_RA_INCLUDED_DELETE; /* * Payload-facing characterization: * - * ra_included (gmap_ra R) m n <=> - * forall (key:K) (a:V). - * finmap_lookup m key == SOME a ==> - * exists b:V. - * finmap_lookup n key == SOME b && - * ra_included R a b + * forall + * (R:(V)ra) + * (m:(K,V)finmap) + * (n:(K,V)finmap). + * ra_included (gmap_ra R) m n <=> + * forall (key:K) (a:V). + * finmap_lookup m key == SOME a ==> + * exists b:V. + * finmap_lookup n key == SOME b && + * ra_included R a b */ PROOF extern thm GMAP_RA_INCLUDED_LOOKUP_SOME; /* * Inclusion grows support: * - * ra_included (gmap_ra R) m n ==> - * finmap_dom m SUBSET finmap_dom n + * forall + * (R:(V)ra) + * (m:(K,V)finmap) + * (n:(K,V)finmap). + * ra_included (gmap_ra R) m n ==> + * finmap_dom m SUBSET finmap_dom n */ PROOF extern thm GMAP_RA_INCLUDED_DOM; @@ -269,6 +382,87 @@ PROOF extern thm GMAP_RA_INCLUDED_SINGLETON; /* Updates */ /* ------------------------------------------------------------------------- */ +/* + * A base local update lifts pointwise to singleton maps at a fixed key: + * + * forall + * (R:(V)ra) + * (key:K) + * (a:V) (f:V) + * (b:V) (g:V). + * ra_local_update R (a,f) (b,g) ==> + * ra_local_update + * (gmap_ra R) + * (finmap_singleton key a,finmap_singleton key f) + * (finmap_singleton key b,finmap_singleton key g) + * + * The hidden map residual may contain no entries away from `key`, because it + * must reconstruct the singleton source whole. At `key`, the proof is + * exactly `OPTION_RA_LOCAL_UPDATE_SOME`. + */ +PROOF extern thm GMAP_RA_LOCAL_UPDATE_SINGLETON; + +/* + * Singleton-map local updates are exactly base local updates: + * + * forall + * (R:(V)ra) + * (key:K) + * (a:V) (f:V) + * (b:V) (g:V). + * ra_local_update + * (gmap_ra R) + * (finmap_singleton key a,finmap_singleton key f) + * (finmap_singleton key b,finmap_singleton key g) <=> + * ra_local_update R (a,f) (b,g) + */ +PROOF extern thm GMAP_RA_LOCAL_UPDATE_SINGLETON_IFF; + +/* + * Lift a local update at an existing binding while preserving every other + * binding of the whole map: + * + * forall + * (R:(V)ra) + * (key:K) + * (a:V) (f:V) + * (b:V) (g:V) + * (m:(K,V)finmap). + * finmap_lookup m key == SOME a ==> + * ra_local_update R (a,f) (b,g) ==> + * ra_local_update + * (gmap_ra R) + * (m,finmap_singleton key f) + * (finmap_insert key b m,finmap_singleton key g) + * + * The hidden map residual is preserved pointwise. At `key` the obligation + * is the supplied base local update; away from `key` both singleton-owned + * maps contribute `NONE`, so the original bindings are unchanged. + */ +PROOF extern thm GMAP_RA_LOCAL_UPDATE_AT; + +/* + * Exact characterization of an existing-binding local update: + * + * forall + * (R:(V)ra) + * (key:K) + * (a:V) (f:V) + * (b:V) (g:V) + * (m:(K,V)finmap). + * finmap_lookup m key == SOME a ==> + * (ra_local_update + * (gmap_ra R) + * (m,finmap_singleton key f) + * (finmap_insert key b m,finmap_singleton key g) <=> + * (ra_valid (gmap_ra R) m ==> + * ra_local_update R (a,f) (b,g))) + * + * The validity guard is essential: `ra_local_update` is vacuous when its + * source whole is invalid, including when invalidity occurs at another key. + */ +PROOF extern thm GMAP_RA_LOCAL_UPDATE_AT_IFF; + /* * A deterministic payload update lifts at a fixed singleton key: * @@ -281,28 +475,82 @@ PROOF extern thm GMAP_RA_INCLUDED_SINGLETON; */ PROOF extern thm GMAP_RA_UPDATE_SINGLETON; +/* + * Singleton-map deterministic updates are exactly base updates: + * + * forall (R:(V)ra) (key:K) (a:V) (b:V). + * ra_update + * (gmap_ra R) + * (finmap_singleton key a) + * (finmap_singleton key b) <=> + * ra_update R a b + */ +PROOF extern thm GMAP_RA_UPDATE_SINGLETON_IFF; + /* * A deterministic payload update lifts under insertion into an arbitrary * surrounding map: * - * ra_update R a b ==> - * ra_update - * (gmap_ra R) - * (finmap_insert key a m) - * (finmap_insert key b m) + * forall + * (R:(V)ra) + * (key:K) + * (a:V) + * (b:V) + * (m:(K,V)finmap). + * ra_update R a b ==> + * ra_update + * (gmap_ra R) + * (finmap_insert key a m) + * (finmap_insert key b m) */ PROOF extern thm GMAP_RA_UPDATE_INSERT; /* * Updating an existing entry changes only that entry: * - * finmap_lookup m key == SOME a ==> - * ra_update R a b ==> - * ra_update (gmap_ra R) m (finmap_insert key b m) + * forall + * (R:(V)ra) + * (key:K) + * (a:V) + * (b:V) + * (m:(K,V)finmap). + * finmap_lookup m key == SOME a ==> + * ra_update R a b ==> + * ra_update (gmap_ra R) m (finmap_insert key b m) */ PROOF extern thm GMAP_RA_UPDATE_AT; -/* Deleting any binding is an unconditional deterministic update. */ +/* + * Exact deterministic characterization at an existing binding: + * + * forall + * (R:(V)ra) + * (key:K) + * (a:V) + * (b:V) + * (m:(K,V)finmap). + * finmap_lookup m key == SOME a ==> + * (ra_update + * (gmap_ra R) + * m + * (finmap_insert key b m) <=> + * (ra_valid (gmap_ra R) m ==> + * ra_update R a b)) + * + * The guard is necessary: every update from an invalid source map is + * vacuous, even when `a ~~> b` does not hold in the base RA. + */ +PROOF extern thm GMAP_RA_UPDATE_AT_IFF; + +/* + * Deleting any binding is an unconditional deterministic update: + * + * forall (R:(V)ra) (key:K) (m:(K,V)finmap). + * ra_update + * (gmap_ra R) + * m + * (finmap_delete key m) + */ PROOF extern thm GMAP_RA_UPDATE_DELETE; /* @@ -322,17 +570,38 @@ PROOF extern thm GMAP_RA_UPDATE_DELETE; */ PROOF extern thm GMAP_RA_UPDATE_SINGLETON_ND; +/* + * Exact ND characterization for results restricted to singleton maps at the + * same key: + * + * forall (R:(V)ra) (key:K) (a:V) (P:V->bool). + * ra_update_nd + * (gmap_ra R) + * (finmap_singleton key a) + * (\m:(K,V)finmap. + * exists b:V. + * P b && m == finmap_singleton key b) <=> + * ra_update_nd R a P + */ +PROOF extern thm GMAP_RA_UPDATE_SINGLETON_ND_IFF; + /* * A nondeterministic payload update lifts under insertion into an arbitrary * surrounding map: * - * ra_update_nd R a P ==> - * ra_update_nd - * (gmap_ra R) - * (finmap_insert key a m) - * (\result:(K,V)finmap. - * exists b:V. - * P b && result == finmap_insert key b m) + * forall + * (R:(V)ra) + * (key:K) + * (a:V) + * (P:V->bool) + * (m:(K,V)finmap). + * ra_update_nd R a P ==> + * ra_update_nd + * (gmap_ra R) + * (finmap_insert key a m) + * (\result:(K,V)finmap. + * exists b:V. + * P b && result == finmap_insert key b m) */ PROOF extern thm GMAP_RA_UPDATE_INSERT_ND; @@ -340,17 +609,49 @@ PROOF extern thm GMAP_RA_UPDATE_INSERT_ND; * A nondeterministic update of an existing entry preserves every other * binding of the original map: * - * finmap_lookup m key == SOME a ==> - * ra_update_nd R a P ==> - * ra_update_nd - * (gmap_ra R) - * m - * (\result:(K,V)finmap. - * exists b:V. - * P b && result == finmap_insert key b m) + * forall + * (R:(V)ra) + * (key:K) + * (a:V) + * (P:V->bool) + * (m:(K,V)finmap). + * finmap_lookup m key == SOME a ==> + * ra_update_nd R a P ==> + * ra_update_nd + * (gmap_ra R) + * m + * (\result:(K,V)finmap. + * exists b:V. + * P b && result == finmap_insert key b m) */ PROOF extern thm GMAP_RA_UPDATE_AT_ND; +/* + * Exact ND characterization for the insertion image at an existing binding: + * + * forall + * (R:(V)ra) + * (key:K) + * (a:V) + * (P:V->bool) + * (m:(K,V)finmap). + * finmap_lookup m key == SOME a ==> + * (ra_update_nd + * (gmap_ra R) + * m + * (\result:(K,V)finmap. + * exists b:V. + * P b && result == finmap_insert key b m) <=> + * (ra_valid (gmap_ra R) m ==> + * ra_update_nd R a P)) + * + * The result predicate is deliberately the exact insertion image. Arbitrary + * map predicates cannot in general be projected to a base payload predicate. + * The validity guard is essential because every ND update from an invalid + * source map holds vacuously. + */ +PROOF extern thm GMAP_RA_UPDATE_AT_ND_IFF; + /* ------------------------------------------------------------------------- */ /* Fresh allocation for infinite key spaces */ /* ------------------------------------------------------------------------- */ diff --git a/theory/logic/local_update.c b/theory/logic/local_update.c new file mode 100644 index 0000000..9cdb6cf --- /dev/null +++ b/theory/logic/local_update.c @@ -0,0 +1,670 @@ +#include "proof/theory/logic/local_update.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/ra.c" + +PROOF static size_t LOCAL_UPDATE_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF thm ra_local_update_def = new_fun_definition(` + ra_local_update + (R:(A)ra) + (source:A#A) + (target:A#A) <=> + forall frame:A. + ra_valid R (FST source) ==> + FST source == ra_op R (SND source) frame ==> + ra_valid R (FST target) && + FST target == ra_op R (SND target) frame +`); + +/* The public eliminator avoids unfolding the relation at each call site. */ +PROOF static thm prove_ra_local_update_apply(void) { + term goal_tm = ` + forall + (R:(A)ra) + (source:A#A) + (target:A#A) + (frame:A). + ra_local_update R source target ==> + ra_valid R (FST source) ==> + FST source == ra_op R (SND source) frame ==> + ra_valid R (FST target) && + FST target == ra_op R (SND target) frame + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_once_rewrite_conv(THM_LIST(ra_local_update_def))); + body = AUTO_INTROS_TAC(body); + thm result = mp_rule( + mp_rule( + spec_rule( + `frame:A`, + assume_rule(` + forall frame:A. + ra_valid (R:(A)ra) (FST (source:A#A)) ==> + FST source == ra_op R (SND source) frame ==> + ra_valid R (FST (target:A#A)) && + FST target == ra_op R (SND target) frame + `)), + assume_rule(` + ra_valid (R:(A)ra) (FST (source:A#A)) + `)), + assume_rule(` + FST (source:A#A) == + ra_op (R:(A)ra) (SND source) (frame:A) + `)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm RA_LOCAL_UPDATE_APPLY = + prove_ra_local_update_apply(); + +PROOF static thm prove_ra_local_update_refl(void) { + term goal_tm = ` + forall (R:(A)ra) (source:A#A). + ra_local_update R source source + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_once_rewrite_conv(THM_LIST(ra_local_update_def))); + body = AUTO_INTROS_TAC(body); + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC( + result[0], + assume_rule(`ra_valid (R:(A)ra) (FST (source:A#A))`)); + ACCEPT_TAC( + result[1], + assume_rule(` + FST (source:A#A) == + ra_op (R:(A)ra) (SND source) (frame:A) + `)); + return gnode_prove(root); +} + +PROOF thm RA_LOCAL_UPDATE_REFL = + prove_ra_local_update_refl(); + +/* The source-validity guard in the definition makes an invalid whole admit + * every local update, independently of either owned component. */ +PROOF static thm prove_ra_local_update_invalid(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + ~(ra_valid R a) ==> + ra_local_update R (a,f) (b,g) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_local_update_def))); + body = CONV_TAC( + body, + rewrite_conv(THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + body = AUTO_INTROS_TAC(body); + thm contradiction = not_elim_rule( + assume_rule(`~(ra_valid (R:(A)ra) (a:A))`), + assume_rule(`ra_valid (R:(A)ra) (a:A)`)); + CONTR_TAC(body, contradiction); + return gnode_prove(root); +} + +PROOF thm RA_LOCAL_UPDATE_INVALID = + prove_ra_local_update_invalid(); + +PROOF static thm prove_ra_local_update_trans(void) { + term goal_tm = ` + forall + (R:(A)ra) + (source:A#A) + (middle:A#A) + (target:A#A). + ra_local_update R source middle ==> + ra_local_update R middle target ==> + ra_local_update R source target + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(ra_local_update_def))); + body = AUTO_INTROS_TAC(body); + + thm middle_result = mp_rule( + mp_rule( + spec_rule( + `frame:A`, + assume_rule(` + forall frame:A. + ra_valid (R:(A)ra) (FST (source:A#A)) ==> + FST source == ra_op R (SND source) frame ==> + ra_valid R (FST (middle:A#A)) && + FST middle == ra_op R (SND middle) frame + `)), + assume_rule(` + ra_valid (R:(A)ra) (FST (source:A#A)) + `)), + assume_rule(` + FST (source:A#A) == + ra_op (R:(A)ra) (SND source) (frame:A) + `)); + thm target_result = mp_rule( + mp_rule( + spec_rule( + `frame:A`, + assume_rule(` + forall frame:A. + ra_valid (R:(A)ra) (FST (middle:A#A)) ==> + FST middle == ra_op R (SND middle) frame ==> + ra_valid R (FST (target:A#A)) && + FST target == ra_op R (SND target) frame + `)), + conjunct1_rule(middle_result)), + conjunct2_rule(middle_result)); + ACCEPT_TAC(body, target_result); + return gnode_prove(root); +} + +PROOF thm RA_LOCAL_UPDATE_TRANS = + prove_ra_local_update_trans(); + +PROOF static thm prove_ra_local_update_frame(void) { + term goal_tm = ` + forall + (R:(A)ra) + (a:A) (f:A) + (b:A) (g:A) + (extra:A). + ra_local_update R (a,f) (b,g) ==> + ra_local_update + R + (a,ra_op R f extra) + (b,ra_op R g extra) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + ra_local_update_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + body = AUTO_INTROS_TAC(body); + + thm source_reassociated = trans_rule( + assume_rule(` + (a:A) == + ra_op + (R:(A)ra) + (ra_op R (f:A) (extra:A)) + (frame:A) + `), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `f:A`, `extra:A`, `frame:A`), + RA_ASSOC)); + thm updated = mp_rule( + mp_rule( + spec_rule( + `ra_op (R:(A)ra) (extra:A) (frame:A)`, + assume_rule(` + forall frame:A. + ra_valid (R:(A)ra) (a:A) ==> + a == ra_op R (f:A) frame ==> + ra_valid R (b:A) && + b == ra_op R (g:A) frame + `)), + assume_rule(`ra_valid (R:(A)ra) (a:A)`)), + source_reassociated); + + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC(result[0], conjunct1_rule(updated)); + thm target_reassociated = trans_rule( + conjunct2_rule(updated), + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `g:A`, `extra:A`, `frame:A`), + RA_ASSOC))); + ACCEPT_TAC(result[1], target_reassociated); + return gnode_prove(root); +} + +PROOF thm RA_LOCAL_UPDATE_FRAME = + prove_ra_local_update_frame(); + +PROOF static thm prove_ra_local_update_preserves_included(void) { + term goal_tm = ` + forall + (R:(A)ra) + (a:A) (f:A) + (b:A) (g:A) + (external:A). + ra_local_update R (a,f) (b,g) ==> + ra_valid R a ==> + ra_included R (ra_op R f external) a ==> + ra_valid R b && + ra_included R (ra_op R g external) b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + thm included = rewrite_rule( + THM_LIST(ra_included_def), + assume_rule(` + ra_included + (R:(A)ra) + (ra_op R (f:A) (external:A)) + (a:A) + `)); + body = ASSUME_TAC(body, included, "Hincluded_witness"); + body = ASMP_EXISTS_TAC(body, "Hincluded_witness", "slack"); + + thm source_reassociated = trans_rule( + assume_rule(` + (a:A) == + ra_op + (R:(A)ra) + (ra_op R (f:A) (external:A)) + (slack:A) + `), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `f:A`, `external:A`, `slack:A`), + RA_ASSOC)); + thm local_at_residual = rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `((a:A),(f:A))`, + `((b:A),(g:A))`, + `ra_op (R:(A)ra) (external:A) (slack:A)`), + RA_LOCAL_UPDATE_APPLY)); + thm updated = mp_rule( + mp_rule( + mp_rule( + local_at_residual, + assume_rule(` + ra_local_update + (R:(A)ra) + ((a:A),(f:A)) + ((b:A),(g:A)) + `)), + assume_rule(`ra_valid (R:(A)ra) (a:A)`)), + source_reassociated); + + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC(result[0], conjunct1_rule(updated)); + gnode included_target = CONV_TAC( + result[1], + pure_once_rewrite_conv(THM_LIST(ra_included_def))); + included_target = EXISTS_TAC(included_target, `slack:A`); + ACCEPT_TAC( + included_target, + trans_rule( + conjunct2_rule(updated), + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `g:A`, `external:A`, `slack:A`), + RA_ASSOC)))); + return gnode_prove(root); +} + +PROOF thm RA_LOCAL_UPDATE_PRESERVES_INCLUDED = + prove_ra_local_update_preserves_included(); + +/* Choose the base unit as the explicit external resource. Unit + * normalization turns the framed inclusion result back into g <= b. */ +PROOF static thm prove_ra_local_update_valid_included(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + ra_local_update R (a,f) (b,g) ==> + ra_valid R a ==> + ra_included R f a ==> + ra_valid R b && ra_included R g b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm unit_rule = rewrite_rule( + THM_LIST(RA_UNIT_R), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `f:A`, + `b:A`, + `g:A`, + `ra_unit (R:(A)ra)`), + RA_LOCAL_UPDATE_PRESERVES_INCLUDED)); + thm preserved = mp_rule( + mp_rule( + mp_rule( + unit_rule, + assume_rule(` + ra_local_update + (R:(A)ra) + ((a:A),(f:A)) + ((b:A),(g:A)) + `)), + assume_rule(`ra_valid (R:(A)ra) (a:A)`)), + assume_rule(`ra_included (R:(A)ra) (f:A) (a:A)`)); + ACCEPT_TAC(body, preserved); + return gnode_prove(root); +} + +PROOF thm RA_LOCAL_UPDATE_VALID_INCLUDED = + prove_ra_local_update_valid_included(); + +PROOF static thm prove_ra_local_update_op(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A) (piece:A). + (ra_valid R a ==> + ra_valid R (ra_op R a piece)) ==> + ra_local_update + R + (a,f) + (ra_op R a piece,ra_op R f piece) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + ra_local_update_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + body = AUTO_INTROS_TAC(body); + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC( + result[0], + mp_rule( + assume_rule(` + ra_valid (R:(A)ra) (a:A) ==> + ra_valid R (ra_op R a (piece:A)) + `), + assume_rule(`ra_valid (R:(A)ra) (a:A)`))); + + thm lifted_source = beta_rule(ap_term_rule( + `\x:A. ra_op (R:(A)ra) x (piece:A)`, + assume_rule(` + (a:A) == + ra_op (R:(A)ra) (f:A) (frame:A) + `))); + thm swapped = ispecl_rule( + TERM_LIST(`R:(A)ra`, `f:A`, `frame:A`, `piece:A`), + RA_OP_SWAP_RIGHT); + ACCEPT_TAC(result[1], trans_rule(lifted_source, swapped)); + return gnode_prove(root); +} + +PROOF thm RA_LOCAL_UPDATE_OP = + prove_ra_local_update_op(); + +PROOF static thm prove_ra_local_update_alloc(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A) (piece:A). + ra_valid R (ra_op R a piece) ==> + ra_local_update + R + (a,f) + (ra_op R a piece,ra_op R f piece) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = MATCH_MP_TAC( + body, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `f:A`, `piece:A`), + RA_LOCAL_UPDATE_OP)); + body = DISCH_TAC(body, "Hvalid_source"); + ACCEPT_TAC( + body, + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (a:A) (piece:A)) + `)); + return gnode_prove(root); +} + +PROOF thm RA_LOCAL_UPDATE_ALLOC = + prove_ra_local_update_alloc(); + +PROOF static thm prove_ra_local_update_exclusive(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A) (b:A). + ra_exclusive R f ==> + ra_valid R b ==> + ra_local_update R (a,f) (b,b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + ra_local_update_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + body = AUTO_INTROS_TAC(body); + + thm source_valid = eq_mp_rule( + ap_term_rule( + `ra_valid (R:(A)ra)`, + assume_rule(` + (a:A) == + ra_op (R:(A)ra) (f:A) (frame:A) + `)), + assume_rule(`ra_valid (R:(A)ra) (a:A)`)); + thm exclusive = rewrite_rule( + THM_LIST(ra_exclusive_def), + assume_rule(`ra_exclusive (R:(A)ra) (f:A)`)); + thm frame_is_unit = mp_rule( + spec_rule(`frame:A`, exclusive), + source_valid); + + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC(result[0], assume_rule(`ra_valid (R:(A)ra) (b:A)`)); + thm replace_frame = beta_rule(ap_term_rule( + `\x:A. ra_op (R:(A)ra) (b:A) x`, + frame_is_unit)); + ACCEPT_TAC( + result[1], + trans_rule( + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `b:A`), + RA_UNIT_R)), + gsym_rule(replace_frame))); + return gnode_prove(root); +} + +PROOF thm RA_LOCAL_UPDATE_EXCLUSIVE = + prove_ra_local_update_exclusive(); + +PROOF static thm prove_ra_local_update_cancel(void) { + term goal_tm = ` + forall (R:(A)ra) (common:A) (a:A) (f:A). + ra_cancellative R ==> + ra_local_update + R + (ra_op R common a,ra_op R common f) + (a,f) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + ra_local_update_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + body = AUTO_INTROS_TAC(body); + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC( + result[0], + mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `common:A`, `a:A`), + RA_VALID_OP_R), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (common:A) (a:A)) + `))); + + thm normalized_source = trans_rule( + assume_rule(` + ra_op (R:(A)ra) (common:A) (a:A) == + ra_op R + (ra_op R common (f:A)) + (frame:A) + `), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `common:A`, `f:A`, `frame:A`), + RA_ASSOC)); + thm cancelled = mp_rule( + mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `common:A`, + `a:A`, + `ra_op (R:(A)ra) (f:A) (frame:A)`), + RA_CANCELLATIVE_APPLY), + assume_rule(`ra_cancellative (R:(A)ra)`)), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (common:A) (a:A)) + `)), + normalized_source); + ACCEPT_TAC(result[1], cancelled); + return gnode_prove(root); +} + +PROOF thm RA_LOCAL_UPDATE_CANCEL = + prove_ra_local_update_cancel(); + +PROOF static thm prove_ra_local_update_cancel_unit(void) { + term goal_tm = ` + forall (R:(A)ra) (common:A) (a:A). + ra_cancellative R ==> + ra_local_update + R + (ra_op R common a,common) + (a,ra_unit R) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm result = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `common:A`, + `a:A`, + `ra_unit (R:(A)ra)`), + RA_LOCAL_UPDATE_CANCEL); + result = mp_rule(result, assume_rule(`ra_cancellative (R:(A)ra)`)); + result = rewrite_rule( + THM_LIST(ispecl_rule( + TERM_LIST(`R:(A)ra`, `common:A`), + RA_UNIT_R)), + result); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm RA_LOCAL_UPDATE_CANCEL_UNIT = + prove_ra_local_update_cancel_unit(); + +PROOF static thm prove_ra_local_update_cancellative(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A) (common:A). + ra_cancellative R ==> + ra_valid R (ra_op R b common) ==> + ra_local_update + R + (ra_op R a common,a) + (ra_op R b common,b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + + thm cancelled = mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `common:A`), + RA_LOCAL_UPDATE_CANCEL_UNIT), + assume_rule(`ra_cancellative (R:(A)ra)`)); + thm allocated = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `common:A`, + `ra_unit (R:(A)ra)`, + `b:A`), + RA_LOCAL_UPDATE_ALLOC), + eq_mp_rule( + ap_term_rule( + `ra_valid (R:(A)ra)`, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `b:A`, `common:A`), + RA_COMM)), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (b:A) (common:A)) + `))); + thm composed = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `((ra_op (R:(A)ra) (a:A) (common:A)),(a:A))`, + `((common:A),(ra_unit (R:(A)ra)))`, + `((ra_op (R:(A)ra) (common:A) (b:A)), + (ra_op R (ra_unit R) b))`), + RA_LOCAL_UPDATE_TRANS), + cancelled), + allocated); + thm normalized = rewrite_rule( + THM_LIST( + ispecl_rule(TERM_LIST(`R:(A)ra`, `common:A`, `b:A`), RA_COMM), + ispecl_rule(TERM_LIST(`R:(A)ra`, `b:A`), RA_UNIT_L)), + composed); + ACCEPT_TAC(body, normalized); + return gnode_prove(root); +} + +PROOF thm RA_LOCAL_UPDATE_CANCELLATIVE = + prove_ra_local_update_cancellative(); + +PROOF static int audit_local_update(void) { + thm_list public_theorems = THM_LIST( + ra_local_update_def, + RA_LOCAL_UPDATE_APPLY, + RA_LOCAL_UPDATE_REFL, + RA_LOCAL_UPDATE_INVALID, + RA_LOCAL_UPDATE_TRANS, + RA_LOCAL_UPDATE_FRAME, + RA_LOCAL_UPDATE_PRESERVES_INCLUDED, + RA_LOCAL_UPDATE_VALID_INCLUDED, + RA_LOCAL_UPDATE_OP, + RA_LOCAL_UPDATE_ALLOC, + RA_LOCAL_UPDATE_EXCLUSIVE, + RA_LOCAL_UPDATE_CANCEL, + RA_LOCAL_UPDATE_CANCEL_UNIT, + RA_LOCAL_UPDATE_CANCELLATIVE); + + for (size_t i = 0; i < vector_size(public_theorems); ++i) { + ENSURE_COND(!IS_NULL(public_theorems[i]), + "local-update theorem %zu is empty", i); + ENSURE_COND(vector_size(hyp(public_theorems[i])) == 0, + "local-update theorem %zu has hypotheses", i); + } + ENSURE_COND(vector_size(get_all_axioms()) == LOCAL_UPDATE_AXIOMS_BEFORE, + "local-update theory introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_local_update"); + return -1; +} + +PROOF static int _LOCAL_UPDATE_AUDIT = + audit_local_update(); diff --git a/theory/logic/local_update.h b/theory/logic/local_update.h new file mode 100644 index 0000000..46f6f47 --- /dev/null +++ b/theory/logic/local_update.h @@ -0,0 +1,196 @@ +#pragma once + +/* + * Iris-style local updates for discrete unital resource algebras. + * + * A pair `(whole, owned)` describes a resource together with the part owned + * locally. A hidden residual `frame` completes the local part to the whole: + * + * whole == ra_op R owned frame. + * + * A local update changes both visible components while preserving that same + * hidden residual. Unlike `ra_update`, this relation is intended primarily + * as the algebraic premise of constructor-specific update rules (notably the + * authoritative RA). + */ + +#include "proof/theory/logic/ra.h" + +/* ------------------------------------------------------------------------- */ +/* Definition and direct application */ +/* ------------------------------------------------------------------------- */ + +/* + * forall (R:(A)ra) (source:A#A) (target:A#A). + * ra_local_update R source target <=> + * forall frame:A. + * ra_valid R (FST source) ==> + * FST source == ra_op R (SND source) frame ==> + * ra_valid R (FST target) && + * FST target == ra_op R (SND target) frame + */ +PROOF extern thm ra_local_update_def; + +/* + * forall + * (R:(A)ra) + * (source:A#A) + * (target:A#A) + * (frame:A). + * ra_local_update R source target ==> + * ra_valid R (FST source) ==> + * FST source == ra_op R (SND source) frame ==> + * ra_valid R (FST target) && + * FST target == ra_op R (SND target) frame + */ +PROOF extern thm RA_LOCAL_UPDATE_APPLY; + +/* ------------------------------------------------------------------------- */ +/* Structural laws */ +/* ------------------------------------------------------------------------- */ + +/* + * forall (R:(A)ra) (source:A#A). + * ra_local_update R source source + */ +PROOF extern thm RA_LOCAL_UPDATE_REFL; + +/* + * A local update from an invalid whole is vacuous: + * + * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + * ~(ra_valid R a) ==> + * ra_local_update R (a,f) (b,g) + */ +PROOF extern thm RA_LOCAL_UPDATE_INVALID; + +/* + * forall (R:(A)ra) (source:A#A) (middle:A#A) (target:A#A). + * ra_local_update R source middle ==> + * ra_local_update R middle target ==> + * ra_local_update R source target + */ +PROOF extern thm RA_LOCAL_UPDATE_TRANS; + +/* + * Add the same visible frame to the local component on both sides: + * + * forall + * (R:(A)ra) + * (a:A) (f:A) + * (b:A) (g:A) + * (extra:A). + * ra_local_update R (a,f) (b,g) ==> + * ra_local_update + * R + * (a,ra_op R f extra) + * (b,ra_op R g extra) + */ +PROOF extern thm RA_LOCAL_UPDATE_FRAME; + +/* + * A local update preserves every externally framed inclusion: + * + * forall + * (R:(A)ra) + * (a:A) (f:A) + * (b:A) (g:A) + * (external:A). + * ra_local_update R (a,f) (b,g) ==> + * ra_valid R a ==> + * ra_included R (ra_op R f external) a ==> + * ra_valid R b && + * ra_included R (ra_op R g external) b + */ +PROOF extern thm RA_LOCAL_UPDATE_PRESERVES_INCLUDED; + +/* + * Preserve validity and ownership inclusion without exposing a residual: + * + * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + * ra_local_update R (a,f) (b,g) ==> + * ra_valid R a ==> + * ra_included R f a ==> + * ra_valid R b && ra_included R g b + * + * This is `RA_LOCAL_UPDATE_PRESERVES_INCLUDED` at the unit external frame. + */ +PROOF extern thm RA_LOCAL_UPDATE_VALID_INCLUDED; + +/* ------------------------------------------------------------------------- */ +/* Allocation and cancellation */ +/* ------------------------------------------------------------------------- */ + +/* + * Extend the whole and the locally owned part by the same piece, provided + * the extension preserves validity whenever the source whole is valid: + * + * forall (R:(A)ra) (a:A) (f:A) (piece:A). + * (ra_valid R a ==> + * ra_valid R (ra_op R a piece)) ==> + * ra_local_update + * R + * (a,f) + * (ra_op R a piece,ra_op R f piece) + */ +PROOF extern thm RA_LOCAL_UPDATE_OP; + +/* + * Extend the whole and the locally owned part by the same piece: + * + * forall (R:(A)ra) (a:A) (f:A) (piece:A). + * ra_valid R (ra_op R a piece) ==> + * ra_local_update + * R + * (a,f) + * (ra_op R a piece,ra_op R f piece) + */ +PROOF extern thm RA_LOCAL_UPDATE_ALLOC; + +/* + * An exclusive local component leaves only the unit as hidden residual, so + * it permits replacement by any valid whole owned in full: + * + * forall (R:(A)ra) (a:A) (f:A) (b:A). + * ra_exclusive R f ==> + * ra_valid R b ==> + * ra_local_update R (a,f) (b,b) + */ +PROOF extern thm RA_LOCAL_UPDATE_EXCLUSIVE; + +/* + * Cancel a common prefix from the whole and local components: + * + * forall (R:(A)ra) (common:A) (a:A) (f:A). + * ra_cancellative R ==> + * ra_local_update + * R + * (ra_op R common a,ra_op R common f) + * (a,f) + */ +PROOF extern thm RA_LOCAL_UPDATE_CANCEL; + +/* + * Cancel the entire common local component: + * + * forall (R:(A)ra) (common:A) (a:A). + * ra_cancellative R ==> + * ra_local_update + * R + * (ra_op R common a,common) + * (a,ra_unit R) + */ +PROOF extern thm RA_LOCAL_UPDATE_CANCEL_UNIT; + +/* + * Synchronized replacement in a cancellative RA: + * + * forall (R:(A)ra) (a:A) (b:A) (common:A). + * ra_cancellative R ==> + * ra_valid R (ra_op R b common) ==> + * ra_local_update + * R + * (ra_op R a common,a) + * (ra_op R b common,b) + */ +PROOF extern thm RA_LOCAL_UPDATE_CANCELLATIVE; diff --git a/theory/logic/max_nat_ra.c b/theory/logic/max_nat_ra.c index 2985a66..12ca846 100644 --- a/theory/logic/max_nat_ra.c +++ b/theory/logic/max_nat_ra.c @@ -3,6 +3,7 @@ #include "proof/proof_backward.h" #require "proof/proof_backward.c" +#require "proof/theory/logic/local_update.c" #require "proof/theory/logic/ra.c" PROOF static size_t MAX_NAT_RA_AXIOMS_BEFORE = @@ -474,6 +475,76 @@ PROOF static thm prove_max_nat_ra_op_eq_left(void) { PROOF thm MAX_NAT_RA_OP_EQ_LEFT = prove_max_nat_ra_op_eq_left(); +/* All frames are compatible because validity is total; choosing frame one + * refutes exclusivity for every source. */ +PROOF static thm prove_max_nat_ra_not_exclusive(void) { + term goal_tm = ` + forall n:num. ~(ra_exclusive max_nat_ra n) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "n"); + body = DISCH_TAC(body, "Hexclusive"); + thm exclusive = rewrite_rule( + THM_LIST(ra_exclusive_def), + assume_rule(`ra_exclusive max_nat_ra (n:num)`)); + thm frame_is_unit = mp_rule( + spec_rule(`1`, exclusive), + ispec_rule( + `ra_op max_nat_ra (n:num) 1`, + MAX_NAT_RA_VALID)); + frame_is_unit = rewrite_rule( + THM_LIST(MAX_NAT_RA_UNIT), + frame_is_unit); + thm contradiction = not_elim_rule( + arith_rule(`~((1:num) == 0)`), + frame_is_unit); + CONTR_TAC(body, contradiction); + return gnode_prove(root); +} + +PROOF thm MAX_NAT_RA_NOT_EXCLUSIVE = + prove_max_nat_ra_not_exclusive(); + +/* The common frame one absorbs both zero and one, witnessing failure of + * cancellativity. */ +PROOF static thm prove_max_nat_ra_not_cancellative(void) { + term goal_tm = `~(ra_cancellative max_nat_ra)`; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = DISCH_TAC(root, "Hcancellative"); + thm left_op = mp_rule( + ispecl_rule( + TERM_LIST(`1`, `0`), + MAX_NAT_RA_OP_EQ_LEFT), + spec_rule(`1`, get_theorem_by_name("LE_0"))); + thm right_op = ispec_rule(`1`, MAX_NAT_RA_IDEMPOTENT); + thm forced_equal = ispecl_rule( + TERM_LIST( + `max_nat_ra`, + `1`, + `0`, + `1`), + RA_CANCELLATIVE_APPLY); + forced_equal = mp_rule( + forced_equal, + assume_rule(`ra_cancellative max_nat_ra`)); + forced_equal = mp_rule( + forced_equal, + ispec_rule( + `ra_op max_nat_ra 1 0`, + MAX_NAT_RA_VALID)); + forced_equal = mp_rule( + forced_equal, + trans_rule(left_op, gsym_rule(right_op))); + thm contradiction = not_elim_rule( + arith_rule(`~((0:num) == 1)`), + forced_equal); + CONTR_TAC(body, contradiction); + return gnode_prove(root); +} + +PROOF thm MAX_NAT_RA_NOT_CANCELLATIVE = + prove_max_nat_ra_not_cancellative(); + PROOF static thm prove_max_nat_ra_included_mono_right(void) { term goal_tm = ` forall old new fragment:num. @@ -522,6 +593,84 @@ PROOF thm MAX_NAT_RA_INCLUDED_MONO_RIGHT = /* Frame-preserving updates */ /* ------------------------------------------------------------------------- */ +/* Preserving an empty local component exposes the source whole itself as a + * residual, forcing the target whole to be unchanged. */ +PROOF static thm prove_max_nat_ra_local_update_unit_iff(void) { + term goal_tm = ` + forall old new:num. + ra_local_update max_nat_ra (old,0) (new,0) <=> + old == new + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hlocal"); + thm applied = ispecl_rule( + TERM_LIST( + `max_nat_ra`, + `((old:num),0)`, + `((new:num),0)`, + `old:num`), + RA_LOCAL_UPDATE_APPLY); + applied = rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + applied); + applied = mp_rule( + applied, + assume_rule(` + ra_local_update + max_nat_ra + ((old:num),0) + ((new:num),0) + `)); + applied = mp_rule( + applied, + ispec_rule(`old:num`, MAX_NAT_RA_VALID)); + thm source_unit = ispecl_rule( + TERM_LIST(`max_nat_ra`, `old:num`), + RA_UNIT_L); + source_unit = rewrite_rule( + THM_LIST(MAX_NAT_RA_UNIT), + source_unit); + applied = mp_rule(applied, gsym_rule(source_unit)); + thm target_unit = ispecl_rule( + TERM_LIST(`max_nat_ra`, `old:num`), + RA_UNIT_L); + target_unit = rewrite_rule( + THM_LIST(MAX_NAT_RA_UNIT), + target_unit); + ACCEPT_TAC( + forward, + gsym_rule(trans_rule( + conjunct2_rule(applied), + target_unit))); + + gnode reverse = DISCH_TAC(directions[1], "Heq"); + thm target_pair_eq = ap_term_rule( + `\x:num. (x,0)`, + assume_rule(`(old:num) == (new:num)`)); + thm target_transport = beta_rule(ap_term_rule( + `\target:num#num. + ra_local_update + max_nat_ra + ((old:num),0) + target`, + target_pair_eq)); + thm reflexive = ispecl_rule( + TERM_LIST( + `max_nat_ra`, + `((old:num),0)`), + RA_LOCAL_UPDATE_REFL); + ACCEPT_TAC(reverse, eq_mp_rule(target_transport, reflexive)); + return gnode_prove(root); +} + +PROOF thm MAX_NAT_RA_LOCAL_UPDATE_UNIT_IFF = + prove_max_nat_ra_local_update_unit_iff(); + PROOF static thm prove_max_nat_ra_update(void) { term goal_tm = ` forall old new:num. @@ -581,6 +730,64 @@ PROOF static thm prove_max_nat_ra_update_nd(void) { PROOF thm MAX_NAT_RA_UPDATE_ND = prove_max_nat_ra_update_nd(); +PROOF static thm prove_max_nat_ra_update_nd_iff(void) { + term goal_tm = ` + forall (old:num) (P:num->bool). + ra_update_nd max_nat_ra old P <=> + exists new:num. P new + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC( + directions[0], "Hupdate"); + thm selected = ispecl_rule( + TERM_LIST( + `max_nat_ra:(num)ra`, + `old:num`, + `P:num->bool`), + RA_UPDATE_ND_VALID); + selected = mp_rule( + selected, + assume_rule(` + ra_update_nd + max_nat_ra + (old:num) + (P:num->bool) + `)); + selected = mp_rule( + selected, + ispec_rule(`old:num`, MAX_NAT_RA_VALID)); + forward = ASSUME_TAC( + forward, selected, "Hselected"); + forward = ASMP_EXISTS_TAC( + forward, "Hselected", "new"); + forward = ASMP_CONJ_TAC( + forward, + "Hselected", + "HP_new", + "Hvalid_new"); + forward = EXISTS_TAC(forward, `new:num`); + ACCEPT_TAC( + forward, + assume_rule(`(P:num->bool) (new:num)`)); + + gnode reverse = DISCH_TAC( + directions[1], "Hinhabited"); + ACCEPT_TAC( + reverse, + mp_rule( + ispecl_rule( + TERM_LIST(`old:num`, `P:num->bool`), + MAX_NAT_RA_UPDATE_ND), + assume_rule(`exists new:num. (P:num->bool) new`))); + return gnode_prove(root); +} + +PROOF thm MAX_NAT_RA_UPDATE_ND_IFF = + prove_max_nat_ra_update_nd_iff(); + /* ------------------------------------------------------------------------- */ /* Construction audit */ /* ------------------------------------------------------------------------- */ @@ -608,9 +815,13 @@ PROOF static int audit_max_nat_ra(void) { MAX_NAT_RA_IDEMPOTENT, MAX_NAT_RA_OP_EQ_RIGHT, MAX_NAT_RA_OP_EQ_LEFT, + MAX_NAT_RA_NOT_EXCLUSIVE, + MAX_NAT_RA_NOT_CANCELLATIVE, MAX_NAT_RA_INCLUDED_MONO_RIGHT, + MAX_NAT_RA_LOCAL_UPDATE_UNIT_IFF, MAX_NAT_RA_UPDATE, - MAX_NAT_RA_UPDATE_ND); + MAX_NAT_RA_UPDATE_ND, + MAX_NAT_RA_UPDATE_ND_IFF); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { ENSURE_COND(!IS_NULL(audited_theorems[i]), diff --git a/theory/logic/max_nat_ra.h b/theory/logic/max_nat_ra.h index 6a2d83a..0eaa3aa 100644 --- a/theory/logic/max_nat_ra.h +++ b/theory/logic/max_nat_ra.h @@ -20,7 +20,7 @@ * remain private to `max_nat_ra.c`. */ -#include "proof/theory/logic/ra.h" +#include "proof/theory/logic/local_update.h" /* ------------------------------------------------------------------------- */ /* Core representation */ @@ -73,6 +73,24 @@ PROOF extern thm MAX_NAT_RA_OP_EQ_RIGHT; */ PROOF extern thm MAX_NAT_RA_OP_EQ_LEFT; +/* ------------------------------------------------------------------------- */ +/* Negative optional laws */ +/* ------------------------------------------------------------------------- */ + +/* + * Every max-nat element admits the compatible non-unit frame `1`: + * + * forall n:num. ~(ra_exclusive max_nat_ra n) + */ +PROOF extern thm MAX_NAT_RA_NOT_EXCLUSIVE; + +/* + * Idempotence prevents cancellation: + * + * ~(ra_cancellative max_nat_ra) + */ +PROOF extern thm MAX_NAT_RA_NOT_CANCELLATIVE; + /* ------------------------------------------------------------------------- */ /* Order: authority-ready monotonicity */ /* ------------------------------------------------------------------------- */ @@ -85,10 +103,13 @@ PROOF extern thm MAX_NAT_RA_OP_EQ_LEFT; * ra_included max_nat_ra fragment old ==> * ra_included max_nat_ra fragment new` * - * After reducing an empty-fragment `AUTH_RA_UPDATE` premise with the generic - * unit law, this is precisely the remaining compatibility obligation. The - * theorem deliberately mentions no `auth_ra`, keeping this base construction - * independent of the authoritative construction. + * `AUTH_RA_UPDATE_BOTH_INCLUDED` packages this fact when the locally owned + * fragment is unchanged. It remains the basic compatibility step in a direct + * `AUTH_RA_UPDATE_FRAMEWISE` proof when authority and fragment change + * together. Raising a max-nat authority is generally not a base + * `ra_local_update` with an unchanged local fragment. The theorem mentions + * no `auth_ra`, keeping this base construction independent of the + * authoritative construction. */ PROOF extern thm MAX_NAT_RA_INCLUDED_MONO_RIGHT; @@ -96,6 +117,18 @@ PROOF extern thm MAX_NAT_RA_INCLUDED_MONO_RIGHT; /* Updates */ /* ------------------------------------------------------------------------- */ +/* + * With an unchanged unit-owned component, max-nat local update admits no + * authority growth: + * + * forall old new:num. + * ra_local_update max_nat_ra (old,0) (new,0) <=> old == new + * + * This is the precise mismatch between universal base `ra_update` below and + * the stricter residual-preserving relation used by `auth_ra`. + */ +PROOF extern thm MAX_NAT_RA_LOCAL_UPDATE_UNIT_IFF; + /* * All deterministic base updates are frame preserving: * @@ -116,3 +149,12 @@ PROOF extern thm MAX_NAT_RA_UPDATE; * ra_update_nd max_nat_ra old P` */ PROOF extern thm MAX_NAT_RA_UPDATE_ND; + +/* + * Exact nondeterministic update characterization: + * + * `forall (old:num) (P:num->bool). + * ra_update_nd max_nat_ra old P <=> + * exists new:num. P new` + */ +PROOF extern thm MAX_NAT_RA_UPDATE_ND_IFF; diff --git a/theory/logic/option_ra.c b/theory/logic/option_ra.c index 523a363..0547f9c 100644 --- a/theory/logic/option_ra.c +++ b/theory/logic/option_ra.c @@ -3,6 +3,7 @@ #include "proof/proof_backward.h" #require "proof/proof_backward.c" +#require "proof/theory/logic/local_update.c" #require "proof/theory/logic/ra.c" PROOF static size_t OPTION_RA_AXIOMS_BEFORE = @@ -364,6 +365,37 @@ PROOF static thm prove_option_ra_op_some_some(void) { PROOF thm OPTION_RA_OP_SOME_SOME = prove_option_ra_op_some_some(); +PROOF static thm prove_option_ra_some_inj(void) { + term goal_tm = ` + forall (a:A) (b:A). + (SOME a:A option) == SOME b <=> a == b + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + get_theorem_by_name("option_INJ")))); + return gnode_prove(root); +} + +PROOF thm OPTION_RA_SOME_INJ = + prove_option_ra_some_inj(); + +PROOF static thm prove_option_ra_some_ne_none(void) { + term goal_tm = ` + forall a:A. ~((SOME a:A option) == NONE) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + get_theorem_by_name("option_DISTINCT")))); + return gnode_prove(root); +} + +PROOF thm OPTION_RA_SOME_NE_NONE = + prove_option_ra_some_ne_none(); + PROOF static thm prove_option_ra_valid_none(void) { term goal_tm = ` forall R:(A)ra. @@ -600,10 +632,414 @@ PROOF static thm prove_option_ra_not_included_some_none(void) { PROOF thm OPTION_RA_NOT_INCLUDED_SOME_NONE = prove_option_ra_not_included_some_none(); +/* A valid SOME payload always admits the non-unit frame SOME(unit), so it is + * not exclusive. An invalid payload has no compatible frame at all. */ +PROOF static thm prove_option_ra_exclusive_some_iff(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A). + ra_exclusive (option_ra R) (SOME a) <=> + ~(ra_valid R a) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hexclusive"); + forward = DISCH_TAC(forward, "Hvalid"); + thm valid_some = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + OPTION_RA_VALID_SOME)), + assume_rule(`ra_valid (R:(A)ra) (a:A)`)); + thm framed_eq = trans_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `ra_unit (R:(A)ra)`), + OPTION_RA_OP_SOME_SOME), + ap_term_rule( + `SOME:A->A option`, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + RA_UNIT_R))); + thm framed_valid = eq_mp_rule( + gsym_rule(ap_term_rule( + `ra_valid (option_ra (R:(A)ra)):A option->bool`, + framed_eq)), + valid_some); + thm exclusive = rewrite_rule( + THM_LIST(ra_exclusive_def), + assume_rule(` + ra_exclusive + (option_ra (R:(A)ra)) + (SOME (a:A)) + `)); + thm frame_is_unit = mp_rule( + spec_rule(`SOME (ra_unit (R:(A)ra))`, exclusive), + framed_valid); + frame_is_unit = rewrite_rule( + THM_LIST(OPTION_RA_UNIT), + frame_is_unit); + thm contradiction = not_elim_rule( + ispec_rule(`ra_unit (R:(A)ra)`, OPTION_RA_SOME_NE_NONE), + frame_is_unit); + CONTR_TAC(forward, contradiction); + + gnode reverse = DISCH_TAC(directions[1], "Hinvalid"); + reverse = CONV_TAC( + reverse, + once_rewrite_conv(THM_LIST(ra_exclusive_def))); + reverse = GEN_TAC(reverse, "frame"); + reverse = DISCH_TAC(reverse, "Hcombined"); + thm source_valid = mp_rule( + ispecl_rule( + TERM_LIST( + `option_ra (R:(A)ra)`, + `SOME (a:A)`, + `frame:A option`), + RA_VALID_OP_L), + assume_rule(` + ra_valid + (option_ra (R:(A)ra)) + (ra_op + (option_ra R) + (SOME (a:A)) + (frame:A option)) + `)); + thm base_valid = eq_mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + OPTION_RA_VALID_SOME), + source_valid); + thm contradiction2 = not_elim_rule( + assume_rule(`~(ra_valid (R:(A)ra) (a:A))`), + base_valid); + CONTR_TAC(reverse, contradiction2); + return gnode_prove(root); +} + +PROOF thm OPTION_RA_EXCLUSIVE_SOME_IFF = + prove_option_ra_exclusive_some_iff(); + +PROOF static thm prove_option_ra_not_exclusive_none(void) { + term goal_tm = ` + forall R:(A)ra. + ~(ra_exclusive (option_ra R) (NONE:A option)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + body = DISCH_TAC(body, "Hexclusive"); + thm exclusive = rewrite_rule( + THM_LIST(ra_exclusive_def), + assume_rule(` + ra_exclusive + (option_ra (R:(A)ra)) + (NONE:A option) + `)); + thm frame_valid = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `ra_unit (R:(A)ra)`), + OPTION_RA_VALID_SOME)), + ispec_rule(`R:(A)ra`, RA_VALID_UNIT)); + thm combined_valid = pure_once_rewrite_rule( + THM_LIST(gsym_rule(ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `SOME (ra_unit (R:(A)ra))`), + OPTION_RA_OP_NONE_L))), + frame_valid); + thm frame_is_unit = mp_rule( + spec_rule(`SOME (ra_unit (R:(A)ra))`, exclusive), + combined_valid); + frame_is_unit = rewrite_rule( + THM_LIST(OPTION_RA_UNIT), + frame_is_unit); + thm contradiction = not_elim_rule( + ispec_rule(`ra_unit (R:(A)ra)`, OPTION_RA_SOME_NE_NONE), + frame_is_unit); + CONTR_TAC(body, contradiction); + return gnode_prove(root); +} + +PROOF thm OPTION_RA_NOT_EXCLUSIVE_NONE = + prove_option_ra_not_exclusive_none(); + +PROOF static thm prove_option_ra_not_cancellative(void) { + term goal_tm = ` + forall R:(A)ra. ~(ra_cancellative (option_ra R)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "R"); + body = DISCH_TAC(body, "Hcancellative"); + + term some_unit = `SOME (ra_unit (R:(A)ra))`; + thm source_valid = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `ra_unit (R:(A)ra)`), + OPTION_RA_VALID_SOME)), + ispec_rule(`R:(A)ra`, RA_VALID_UNIT)); + thm source_op = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + some_unit), + OPTION_RA_OP_NONE_R); + thm framed_source_valid = eq_mp_rule( + gsym_rule(ap_term_rule( + `ra_valid (option_ra (R:(A)ra)):A option->bool`, + source_op)), + source_valid); + + thm right_op = trans_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `ra_unit (R:(A)ra)`, + `ra_unit (R:(A)ra)`), + OPTION_RA_OP_SOME_SOME), + ap_term_rule( + `SOME:A->A option`, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `ra_unit (R:(A)ra)`), + RA_UNIT_L))); + thm ops_equal = trans_rule(source_op, gsym_rule(right_op)); + thm forced_equal = ispecl_rule( + TERM_LIST( + `option_ra (R:(A)ra)`, + some_unit, + `NONE:A option`, + some_unit), + RA_CANCELLATIVE_APPLY); + forced_equal = mp_rule( + forced_equal, + assume_rule(`ra_cancellative (option_ra (R:(A)ra))`)); + forced_equal = mp_rule(forced_equal, framed_source_valid); + forced_equal = mp_rule(forced_equal, ops_equal); + thm contradiction = not_elim_rule( + ispec_rule(`ra_unit (R:(A)ra)`, OPTION_RA_SOME_NE_NONE), + gsym_rule(forced_equal)); + CONTR_TAC(body, contradiction); + return gnode_prove(root); +} + +PROOF thm OPTION_RA_NOT_CANCELLATIVE = + prove_option_ra_not_cancellative(); + /* ------------------------------------------------------------------------- */ /* Frame-preserving updates */ /* ------------------------------------------------------------------------- */ +/* A residual option frame is either NONE, corresponding to the base unit, or + * SOME of the exact base residual. In both cases the base local update + * preserves the residual without changing its option shape. */ +PROOF static thm prove_option_ra_local_update_some(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + ra_local_update R (a,f) (b,g) ==> + ra_local_update + (option_ra R) + (SOME a,SOME f) + (SOME b,SOME g) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_local_update_def))); + body = AUTO_INTROS_TAC(body); + gnode_list frame_cases = CASES_TAC( + body, `frame:A option`, "Hframe"); + + for (size_t i = 0; i < vector_size(frame_cases); ++i) { + term frame_eq_tm = gnode_get_asmps( + frame_cases[i], + CONST_STRING_LIST("Hframe"))[0]; + thm frame_eq = assume_rule(frame_eq_tm); + thm source_valid = rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + OPTION_RA_VALID_SOME), + assume_rule(` + ra_valid + (option_ra (R:(A)ra)) + (FST ((SOME (a:A)),(SOME (f:A)))) + `)); + thm source_decomposition = rewrite_rule( + THM_LIST( + frame_eq, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + OPTION_RA_OP_NONE_R, + OPTION_RA_OP_SOME_SOME, + get_theorem_by_name("option_INJ")), + assume_rule(` + FST ((SOME (a:A)),(SOME (f:A))) == + ra_op + (option_ra (R:(A)ra)) + (SND ((SOME (a:A)),(SOME (f:A)))) + (frame:A option) + `)); + + term residual = i == 0 + ? `ra_unit (R:(A)ra)` + : dest_comb(dest_eq(frame_eq_tm).tm2).tm2; + if (i == 0) { + source_decomposition = trans_rule( + source_decomposition, + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `f:A`), + RA_UNIT_R))); + } + + thm updated = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `((a:A),(f:A))`, + `((b:A),(g:A))`, + residual), + RA_LOCAL_UPDATE_APPLY); + updated = rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + updated); + updated = mp_rule( + updated, + assume_rule(` + ra_local_update + (R:(A)ra) + ((a:A),(f:A)) + ((b:A),(g:A)) + `)); + updated = mp_rule(updated, source_valid); + updated = mp_rule(updated, source_decomposition); + updated = rewrite_rule( + THM_LIST(RA_UNIT_R), + updated); + + gnode target = CONV_WITH_ASMP_TAC( + frame_cases[i], + rewrite_conv, + THM_LIST( + frame_eq, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + OPTION_RA_OP_NONE_R, + OPTION_RA_OP_SOME_SOME, + OPTION_RA_VALID_SOME, + get_theorem_by_name("option_INJ"), + RA_UNIT_R)); + ACCEPT_TAC(target, updated); + } + return gnode_prove(root); +} + +PROOF thm OPTION_RA_LOCAL_UPDATE_SOME = + prove_option_ra_local_update_some(); + +PROOF static thm prove_option_ra_local_update_some_iff(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + ra_local_update + (option_ra R) + (SOME a,SOME f) + (SOME b,SOME g) <=> + ra_local_update R (a,f) (b,g) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC( + directions[0], "Hoption_local"); + forward = CONV_TAC( + forward, + once_rewrite_conv(THM_LIST(ra_local_update_def))); + forward = CONV_TAC( + forward, + rewrite_conv(THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + forward = AUTO_INTROS_TAC(forward); + + thm source_valid = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + OPTION_RA_VALID_SOME)), + assume_rule(`ra_valid (R:(A)ra) (a:A)`)); + thm base_decomposition = assume_rule(` + (a:A) == + ra_op (R:(A)ra) (f:A) (frame:A) + `); + thm lifted_decomposition = beta_rule(ap_term_rule( + `\x:A. SOME x`, + base_decomposition)); + lifted_decomposition = trans_rule( + lifted_decomposition, + gsym_rule(ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `f:A`, + `frame:A`), + OPTION_RA_OP_SOME_SOME))); + + thm updated = ispecl_rule( + TERM_LIST( + `option_ra (R:(A)ra)`, + `((SOME (a:A)),(SOME (f:A)))`, + `((SOME (b:A)),(SOME (g:A)))`, + `SOME (frame:A)`), + RA_LOCAL_UPDATE_APPLY); + updated = rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + updated); + updated = mp_rule( + updated, + assume_rule(` + ra_local_update + (option_ra (R:(A)ra)) + ((SOME (a:A)),(SOME (f:A))) + ((SOME (b:A)),(SOME (g:A))) + `)); + updated = mp_rule(updated, source_valid); + updated = mp_rule(updated, lifted_decomposition); + updated = rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + OPTION_RA_VALID_SOME, + OPTION_RA_OP_SOME_SOME, + get_theorem_by_name("option_INJ")), + updated); + ACCEPT_TAC(forward, updated); + + gnode reverse = DISCH_TAC( + directions[1], "Hbase_local"); + ACCEPT_TAC( + reverse, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `f:A`, + `b:A`, + `g:A`), + OPTION_RA_LOCAL_UPDATE_SOME), + assume_rule(` + ra_local_update + (R:(A)ra) + ((a:A),(f:A)) + ((b:A),(g:A)) + `))); + return gnode_prove(root); +} + +PROOF thm OPTION_RA_LOCAL_UPDATE_SOME_IFF = + prove_option_ra_local_update_some_iff(); + /* * A base update lifts through SOME. The option frame is inspected * explicitly: NONE reduces to ordinary validity preservation, while a SOME @@ -696,6 +1132,84 @@ PROOF static thm prove_option_ra_update(void) { PROOF thm OPTION_RA_UPDATE = prove_option_ra_update(); +PROOF static thm prove_option_ra_update_iff(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_update + (option_ra R) + (SOME a) + (SOME b) <=> + ra_update R a b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC( + directions[0], "Hoption_update"); + forward = CONV_TAC( + forward, + once_rewrite_conv(THM_LIST(ra_update_def))); + forward = AUTO_INTROS_TAC(forward); + thm source_valid = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `ra_op (R:(A)ra) (a:A) (frame:A)`), + OPTION_RA_VALID_SOME)), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (a:A) (frame:A)) + `)); + source_valid = eq_mp_rule( + gsym_rule(ap_term_rule( + `ra_valid (option_ra (R:(A)ra)):A option->bool`, + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `frame:A`), + OPTION_RA_OP_SOME_SOME))), + source_valid); + thm option_update = pure_once_rewrite_rule( + THM_LIST(ra_update_def), + assume_rule(` + ra_update + (option_ra (R:(A)ra)) + (SOME (a:A)) + (SOME (b:A)) + `)); + thm target_valid = mp_rule( + spec_rule(`SOME (frame:A)`, option_update), + source_valid); + target_valid = rewrite_rule( + THM_LIST( + OPTION_RA_OP_SOME_SOME, + OPTION_RA_VALID_SOME), + target_valid); + ACCEPT_TAC(forward, target_valid); + + gnode reverse = DISCH_TAC( + directions[1], "Hbase_update"); + ACCEPT_TAC( + reverse, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `b:A`), + OPTION_RA_UPDATE), + assume_rule(` + ra_update (R:(A)ra) (a:A) (b:A) + `))); + return gnode_prove(root); +} + +PROOF thm OPTION_RA_UPDATE_IFF = + prove_option_ra_update_iff(); + /* * The nondeterministic rule keeps the base result witness and embeds it with * SOME. Its result predicate is the exact image of P, rather than an @@ -816,6 +1330,124 @@ PROOF static thm prove_option_ra_update_nd(void) { PROOF thm OPTION_RA_UPDATE_ND = prove_option_ra_update_nd(); +PROOF static thm prove_option_ra_update_nd_iff(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (P:A->bool). + (ra_update_nd + (option_ra R) + (SOME a) + (\x:A option. + exists b:A. P b && x == SOME b) <=> + ra_update_nd R a P) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC( + directions[0], "Hoption_update"); + forward = CONV_TAC( + forward, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + forward = AUTO_INTROS_TAC(forward); + + thm source_valid = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `ra_op (R:(A)ra) (a:A) (frame:A)`), + OPTION_RA_VALID_SOME)), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (a:A) (frame:A)) + `)); + source_valid = eq_mp_rule( + gsym_rule(ap_term_rule( + `ra_valid (option_ra (R:(A)ra)):A option->bool`, + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `frame:A`), + OPTION_RA_OP_SOME_SOME))), + source_valid); + + thm option_update = pure_once_rewrite_rule( + THM_LIST(ra_update_nd_def), + assume_rule(` + ra_update_nd + (option_ra (R:(A)ra)) + (SOME (a:A)) + (\x:A option. + exists b:A. + (P:A->bool) b && x == SOME b) + `)); + option_update = conv_rule( + depth_conv(get_conversion_by_name("BETA_CONV")), + option_update); + thm selected = mp_rule( + spec_rule(`SOME (frame:A)`, option_update), + source_valid); + forward = ASSUME_TAC( + forward, selected, "Hselected"); + forward = ASMP_EXISTS_TAC( + forward, "Hselected", "x"); + forward = ASMP_CONJ_TAC( + forward, + "Hselected", + "Himage", + "Htarget_valid"); + forward = ASMP_EXISTS_TAC( + forward, "Himage", "b"); + forward = ASMP_CONJ_TAC( + forward, + "Himage", + "HP_b", + "Hx"); + forward = EXISTS_TAC(forward, `b:A`); + gnode_list result = CONJ_TAC(forward); + ACCEPT_TAC( + result[0], + assume_rule(`(P:A->bool) (b:A)`)); + thm target_valid = rewrite_rule( + THM_LIST( + assume_rule(`(x:A option) == SOME (b:A)`), + OPTION_RA_OP_SOME_SOME, + OPTION_RA_VALID_SOME), + assume_rule(` + ra_valid + (option_ra (R:(A)ra)) + (ra_op + (option_ra R) + (x:A option) + (SOME (frame:A))) + `)); + ACCEPT_TAC(result[1], target_valid); + + gnode reverse = DISCH_TAC( + directions[1], "Hbase_update"); + ACCEPT_TAC( + reverse, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `P:A->bool`), + OPTION_RA_UPDATE_ND), + assume_rule(` + ra_update_nd + (R:(A)ra) + (a:A) + (P:A->bool) + `))); + return gnode_prove(root); +} + +PROOF thm OPTION_RA_UPDATE_ND_IFF = + prove_option_ra_update_nd_iff(); + PROOF static int audit_option_ra(void) { thm_list audited_theorems = THM_LIST( option_ra_some_op_def, @@ -834,13 +1466,22 @@ PROOF static int audit_option_ra(void) { OPTION_RA_OP_NONE_L, OPTION_RA_OP_NONE_R, OPTION_RA_OP_SOME_SOME, + OPTION_RA_SOME_INJ, + OPTION_RA_SOME_NE_NONE, OPTION_RA_VALID_NONE, OPTION_RA_VALID_SOME, OPTION_RA_INCLUDED_NONE, OPTION_RA_INCLUDED_SOME_SOME, OPTION_RA_NOT_INCLUDED_SOME_NONE, + OPTION_RA_EXCLUSIVE_SOME_IFF, + OPTION_RA_NOT_EXCLUSIVE_NONE, + OPTION_RA_NOT_CANCELLATIVE, + OPTION_RA_LOCAL_UPDATE_SOME, + OPTION_RA_LOCAL_UPDATE_SOME_IFF, OPTION_RA_UPDATE, - OPTION_RA_UPDATE_ND); + OPTION_RA_UPDATE_IFF, + OPTION_RA_UPDATE_ND, + OPTION_RA_UPDATE_ND_IFF); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { ENSURE_COND(!IS_NULL(audited_theorems[i]), diff --git a/theory/logic/option_ra.h b/theory/logic/option_ra.h index 8958ee2..e8980bc 100644 --- a/theory/logic/option_ra.h +++ b/theory/logic/option_ra.h @@ -11,7 +11,7 @@ * `ra_abs` projection equations remain private to `option_ra.c`. */ -#include "proof/theory/logic/ra.h" +#include "proof/theory/logic/local_update.h" /* ------------------------------------------------------------------------- */ /* Core representation */ @@ -39,6 +39,19 @@ PROOF extern thm OPTION_RA_OP_NONE_R; */ PROOF extern thm OPTION_RA_OP_SOME_SOME; +/* ------------------------------------------------------------------------- */ +/* Constructor equality and distinction */ +/* ------------------------------------------------------------------------- */ + +/* + * forall (a:A) (b:A). + * (SOME a:A option) == SOME b <=> a == b + */ +PROOF extern thm OPTION_RA_SOME_INJ; + +/* `forall a:A. ~((SOME a:A option) == NONE)`. */ +PROOF extern thm OPTION_RA_SOME_NE_NONE; + /* ------------------------------------------------------------------------- */ /* Validity */ /* ------------------------------------------------------------------------- */ @@ -81,6 +94,30 @@ PROOF extern thm OPTION_RA_INCLUDED_SOME_SOME; */ PROOF extern thm OPTION_RA_NOT_INCLUDED_SOME_NONE; +/* ------------------------------------------------------------------------- */ +/* Exclusive and cancellative laws */ +/* ------------------------------------------------------------------------- */ + +/* + * A present option resource is exclusive exactly when its base payload is + * invalid (and hence exclusivity is vacuous): + * + * forall (R:(A)ra) (a:A). + * ra_exclusive (option_ra R) (SOME a) <=> ~(ra_valid R a) + */ +PROOF extern thm OPTION_RA_EXCLUSIVE_SOME_IFF; + +/* `forall R:(A)ra. ~(ra_exclusive (option_ra R) (NONE:A option))`. */ +PROOF extern thm OPTION_RA_NOT_EXCLUSIVE_NONE; + +/* + * Adjoining a fresh unit destroys cancellativity, independently of the base + * RA: `NONE` and `SOME (ra_unit R)` become equal after framing by the latter. + * + * forall R:(A)ra. ~(ra_cancellative (option_ra R)) + */ +PROOF extern thm OPTION_RA_NOT_CANCELLATIVE; + /* ------------------------------------------------------------------------- */ /* Laws */ /* ------------------------------------------------------------------------- */ @@ -94,6 +131,36 @@ PROOF extern thm OPTION_RA_NOT_INCLUDED_SOME_NONE; /* Updates */ /* ------------------------------------------------------------------------- */ +/* + * Base local updates lift pointwise through `SOME`: + * + * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + * ra_local_update R (a,f) (b,g) ==> + * ra_local_update + * (option_ra R) + * (SOME a,SOME f) + * (SOME b,SOME g) + * + * The `NONE` residual case corresponds to the base residual `ra_unit R`; + * a `SOME frame` residual corresponds directly to `frame`. + */ +PROOF extern thm OPTION_RA_LOCAL_UPDATE_SOME; + +/* + * Local updates between present pairs are exactly base local updates: + * + * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + * ra_local_update + * (option_ra R) + * (SOME a,SOME f) + * (SOME b,SOME g) <=> + * ra_local_update R (a,f) (b,g) + * + * For the reverse projection, the option residual `SOME frame` exposes every + * base residual `frame`. + */ +PROOF extern thm OPTION_RA_LOCAL_UPDATE_SOME_IFF; + /* * Deterministic base update lifting: * @@ -103,6 +170,15 @@ PROOF extern thm OPTION_RA_NOT_INCLUDED_SOME_NONE; */ PROOF extern thm OPTION_RA_UPDATE; +/* + * Deterministic updates between present values are exactly base updates: + * + * forall (R:(A)ra) (a:A) (b:A). + * ra_update (option_ra R) (SOME a) (SOME b) <=> + * ra_update R a b + */ +PROOF extern thm OPTION_RA_UPDATE_IFF; + /* * Nondeterministic base update lifting to the exact SOME image: * @@ -114,3 +190,15 @@ PROOF extern thm OPTION_RA_UPDATE; * (\x:A option. exists b:A. P b && x == SOME b) */ PROOF extern thm OPTION_RA_UPDATE_ND; + +/* + * Exact-SOME-image nondeterministic updates are exactly base ND updates: + * + * forall (R:(A)ra) (a:A) (P:A->bool). + * (ra_update_nd + * (option_ra R) + * (SOME a) + * (\x:A option. exists b:A. P b && x == SOME b) <=> + * ra_update_nd R a P) + */ +PROOF extern thm OPTION_RA_UPDATE_ND_IFF; diff --git a/theory/logic/prod_ra.c b/theory/logic/prod_ra.c index b386316..6b4e640 100644 --- a/theory/logic/prod_ra.c +++ b/theory/logic/prod_ra.c @@ -3,6 +3,7 @@ #include "proof/proof_backward.h" #require "proof/proof_backward.c" +#require "proof/theory/logic/local_update.c" #require "proof/theory/logic/ra.c" PROOF static size_t PROD_RA_AXIOMS_BEFORE = vector_size(get_all_axioms()); @@ -390,6 +391,349 @@ PROOF static thm prove_prod_ra_included(void) { PROOF thm PROD_RA_INCLUDED = prove_prod_ra_included(); +/* Compatible frames are units componentwise when both projections are + * exclusive. This is deliberately stronger than Iris's one-sided product + * `Exclusive` instance because the two libraries use different predicates. */ +PROOF static thm prove_prod_ra_exclusive(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) (x:A#B). + ra_exclusive R1 (FST x) ==> + ra_exclusive R2 (SND x) ==> + ra_exclusive (prod_ra R1 R2) x + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_exclusive_def))); + body = AUTO_INTROS_TAC(body); + + thm product_validity = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `ra_op + (prod_ra (R1:(A)ra) (R2:(B)ra)) + (x:A#B) + (frame:A#B)`), + PROD_RA_VALID); + thm components = eq_mp_rule( + product_validity, + assume_rule(` + ra_valid + (prod_ra (R1:(A)ra) (R2:(B)ra)) + (ra_op + (prod_ra R1 R2) + (x:A#B) + (frame:A#B)) + `)); + components = pure_rewrite_rule( + THM_LIST( + PROD_RA_OP, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + components); + + thm left_frame = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `FST (x:A#B)`, + `FST (frame:A#B)`), + RA_EXCLUSIVE_APPLY); + left_frame = mp_rule( + left_frame, + assume_rule(`ra_exclusive (R1:(A)ra) (FST (x:A#B))`)); + left_frame = mp_rule(left_frame, conjunct1_rule(components)); + + thm right_frame = ispecl_rule( + TERM_LIST( + `R2:(B)ra`, + `SND (x:A#B)`, + `SND (frame:A#B)`), + RA_EXCLUSIVE_APPLY); + right_frame = mp_rule( + right_frame, + assume_rule(`ra_exclusive (R2:(B)ra) (SND (x:A#B))`)); + right_frame = mp_rule(right_frame, conjunct2_rule(components)); + + thm pair_components = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `FST (frame:A#B)`, + `SND (frame:A#B)`, + `ra_unit (R1:(A)ra)`, + `ra_unit (R2:(B)ra)`), + get_theorem_by_name("PAIR_EQ"))), + conj_rule(left_frame, right_frame)); + thm frame_eta = ispec_rule( + `frame:A#B`, + get_theorem_by_name("PAIR")); + thm product_unit = ispecl_rule( + TERM_LIST(`R1:(A)ra`, `R2:(B)ra`), + PROD_RA_UNIT); + ACCEPT_TAC( + body, + trans_rule( + gsym_rule(frame_eta), + trans_rule(pair_components, gsym_rule(product_unit)))); + return gnode_prove(root); +} + +PROOF thm PROD_RA_EXCLUSIVE = + prove_prod_ra_exclusive(); + +/* Embed a left frame together with the right unit. Validity of the source + * product supplies the compatible right component needed for the embedding. */ +PROOF static thm prove_prod_ra_exclusive_elim_left(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) (x:A#B). + ra_valid (prod_ra R1 R2) x ==> + ra_exclusive (prod_ra R1 R2) x ==> + ra_exclusive R1 (FST x) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_exclusive_def))); + body = AUTO_INTROS_TAC(body); + + thm source_components = eq_mp_rule( + ispecl_rule( + TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), + PROD_RA_VALID), + assume_rule(`ra_valid (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + thm right_unit = ispecl_rule( + TERM_LIST(`R2:(B)ra`, `SND (x:A#B)`), + RA_UNIT_R); + thm right_compatible = eq_mp_rule( + ap_term_rule( + `ra_valid (R2:(B)ra):B->bool`, + gsym_rule(right_unit)), + conjunct2_rule(source_components)); + thm framed_components = conj_rule( + assume_rule(` + ra_valid + (R1:(A)ra) + (ra_op R1 (FST (x:A#B)) (frame:A)) + `), + right_compatible); + + term product_frame = `((frame:A),ra_unit (R2:(B)ra))`; + term framed_source = ` + ra_op + (prod_ra (R1:(A)ra) (R2:(B)ra)) + (x:A#B) + ((frame:A),ra_unit R2) + `; + thm framed_validity = ispecl_rule( + TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, framed_source), + PROD_RA_VALID); + framed_validity = pure_rewrite_rule( + THM_LIST( + PROD_RA_OP, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + framed_validity); + thm framed_pair_valid = eq_mp_rule( + gsym_rule(framed_validity), + framed_components); + thm framed_op = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `x:A#B`, + product_frame), + PROD_RA_OP); + framed_op = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + framed_op); + thm framed_valid = eq_mp_rule( + ap_term_rule( + `ra_valid (prod_ra (R1:(A)ra) (R2:(B)ra)):A#B->bool`, + gsym_rule(framed_op)), + framed_pair_valid); + + thm unit_frame = ispecl_rule( + TERM_LIST( + `prod_ra (R1:(A)ra) (R2:(B)ra)`, + `x:A#B`, + product_frame), + RA_EXCLUSIVE_APPLY); + unit_frame = mp_rule( + unit_frame, + assume_rule(`ra_exclusive (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + unit_frame = mp_rule(unit_frame, framed_valid); + thm projected = ap_term_rule(`FST:(A#B)->A`, unit_frame); + projected = pure_rewrite_rule( + THM_LIST( + PROD_RA_UNIT, + get_theorem_by_name("FST")), + projected); + ACCEPT_TAC(body, projected); + return gnode_prove(root); +} + +PROOF thm PROD_RA_EXCLUSIVE_ELIM_LEFT = + prove_prod_ra_exclusive_elim_left(); + +/* Symmetric embedding of a right frame with the left unit. */ +PROOF static thm prove_prod_ra_exclusive_elim_right(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) (x:A#B). + ra_valid (prod_ra R1 R2) x ==> + ra_exclusive (prod_ra R1 R2) x ==> + ra_exclusive R2 (SND x) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_exclusive_def))); + body = AUTO_INTROS_TAC(body); + + thm source_components = eq_mp_rule( + ispecl_rule( + TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), + PROD_RA_VALID), + assume_rule(`ra_valid (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + thm left_unit = ispecl_rule( + TERM_LIST(`R1:(A)ra`, `FST (x:A#B)`), + RA_UNIT_R); + thm left_compatible = eq_mp_rule( + ap_term_rule( + `ra_valid (R1:(A)ra):A->bool`, + gsym_rule(left_unit)), + conjunct1_rule(source_components)); + thm framed_components = conj_rule( + left_compatible, + assume_rule(` + ra_valid + (R2:(B)ra) + (ra_op R2 (SND (x:A#B)) (frame:B)) + `)); + + term product_frame = `(ra_unit (R1:(A)ra),(frame:B))`; + term framed_source = ` + ra_op + (prod_ra (R1:(A)ra) (R2:(B)ra)) + (x:A#B) + (ra_unit R1,(frame:B)) + `; + thm framed_validity = ispecl_rule( + TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, framed_source), + PROD_RA_VALID); + framed_validity = pure_rewrite_rule( + THM_LIST( + PROD_RA_OP, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + framed_validity); + thm framed_pair_valid = eq_mp_rule( + gsym_rule(framed_validity), + framed_components); + thm framed_op = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `x:A#B`, + product_frame), + PROD_RA_OP); + framed_op = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + framed_op); + thm framed_valid = eq_mp_rule( + ap_term_rule( + `ra_valid (prod_ra (R1:(A)ra) (R2:(B)ra)):A#B->bool`, + gsym_rule(framed_op)), + framed_pair_valid); + + thm unit_frame = ispecl_rule( + TERM_LIST( + `prod_ra (R1:(A)ra) (R2:(B)ra)`, + `x:A#B`, + product_frame), + RA_EXCLUSIVE_APPLY); + unit_frame = mp_rule( + unit_frame, + assume_rule(`ra_exclusive (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + unit_frame = mp_rule(unit_frame, framed_valid); + thm projected = ap_term_rule(`SND:(A#B)->B`, unit_frame); + projected = pure_rewrite_rule( + THM_LIST( + PROD_RA_UNIT, + get_theorem_by_name("SND")), + projected); + ACCEPT_TAC(body, projected); + return gnode_prove(root); +} + +PROOF thm PROD_RA_EXCLUSIVE_ELIM_RIGHT = + prove_prod_ra_exclusive_elim_right(); + +PROOF static thm prove_prod_ra_exclusive_iff(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) (x:A#B). + ra_valid (prod_ra R1 R2) x ==> + (ra_exclusive (prod_ra R1 R2) x <=> + ra_exclusive R1 (FST x) && + ra_exclusive R2 (SND x)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hexclusive"); + gnode_list components = CONJ_TAC(forward); + thm left = ispecl_rule( + TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), + PROD_RA_EXCLUSIVE_ELIM_LEFT); + left = mp_rule( + left, + assume_rule(`ra_valid (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + left = mp_rule( + left, + assume_rule(`ra_exclusive (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + ACCEPT_TAC(components[0], left); + + thm right = ispecl_rule( + TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), + PROD_RA_EXCLUSIVE_ELIM_RIGHT); + right = mp_rule( + right, + assume_rule(`ra_valid (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + right = mp_rule( + right, + assume_rule(`ra_exclusive (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + ACCEPT_TAC(components[1], right); + + gnode reverse = DISCH_TAC(directions[1], "Hcomponents"); + thm result = ispecl_rule( + TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), + PROD_RA_EXCLUSIVE); + result = mp_rule( + result, + conjunct1_rule(assume_rule(` + ra_exclusive (R1:(A)ra) (FST (x:A#B)) && + ra_exclusive (R2:(B)ra) (SND x) + `))); + result = mp_rule( + result, + conjunct2_rule(assume_rule(` + ra_exclusive (R1:(A)ra) (FST (x:A#B)) && + ra_exclusive (R2:(B)ra) (SND x) + `))); + ACCEPT_TAC(reverse, result); + return gnode_prove(root); +} + +PROOF thm PROD_RA_EXCLUSIVE_IFF = + prove_prod_ra_exclusive_iff(); + /* * Component cancellativity lifts to products. Product validity is * specialized at the source composition, and product equality is first @@ -539,6 +883,275 @@ PROOF static thm prove_prod_ra_cancellative(void) { PROOF thm PROD_RA_CANCELLATIVE = prove_prod_ra_cancellative(); +/* Recover left cancellation by embedding the right component at its unit. */ +PROOF static thm prove_prod_ra_cancellative_elim_left(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra). + ra_cancellative (prod_ra R1 R2) ==> + ra_cancellative R1 + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_cancellative_def))); + body = AUTO_INTROS_TAC(body); + + term product_frame = `((frame:A),ra_unit (R2:(B)ra))`; + term product_a = `((a:A),ra_unit (R2:(B)ra))`; + term product_b = `((b:A),ra_unit (R2:(B)ra))`; + thm right_unit_valid = RA_VALID_UNIT; + right_unit_valid = ispec_rule(`R2:(B)ra`, right_unit_valid); + thm right_unit_op = ispecl_rule( + TERM_LIST(`R2:(B)ra`, `ra_unit (R2:(B)ra)`), + RA_UNIT_L); + thm right_composition_valid = eq_mp_rule( + ap_term_rule( + `ra_valid (R2:(B)ra):B->bool`, + gsym_rule(right_unit_op)), + right_unit_valid); + thm explicit_source_validity = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `(ra_op (R1:(A)ra) (frame:A) (a:A), + ra_op (R2:(B)ra) (ra_unit R2) (ra_unit R2))`), + PROD_RA_VALID); + explicit_source_validity = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + explicit_source_validity); + thm explicit_source_valid = eq_mp_rule( + gsym_rule(explicit_source_validity), + conj_rule( + assume_rule(` + ra_valid + (R1:(A)ra) + (ra_op R1 (frame:A) (a:A)) + `), + right_composition_valid)); + thm source_op = ispecl_rule( + TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, product_frame, product_a), + PROD_RA_OP); + source_op = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + source_op); + thm source_valid = eq_mp_rule( + ap_term_rule( + `ra_valid (prod_ra (R1:(A)ra) (R2:(B)ra)):A#B->bool`, + gsym_rule(source_op)), + explicit_source_valid); + + thm explicit_ops_equal = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `ra_op (R1:(A)ra) (frame:A) (a:A)`, + `ra_op (R2:(B)ra) (ra_unit R2) (ra_unit R2)`, + `ra_op (R1:(A)ra) (frame:A) (b:A)`, + `ra_op (R2:(B)ra) (ra_unit R2) (ra_unit R2)`), + get_theorem_by_name("PAIR_EQ"))), + conj_rule( + assume_rule(` + ra_op (R1:(A)ra) (frame:A) (a:A) == + ra_op R1 frame (b:A) + `), + refl_rule(`ra_op (R2:(B)ra) (ra_unit R2) (ra_unit R2)`))); + thm target_op = ispecl_rule( + TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, product_frame, product_b), + PROD_RA_OP); + target_op = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + target_op); + thm product_ops_equal = trans_rule( + source_op, + trans_rule(explicit_ops_equal, gsym_rule(target_op))); + + thm cancelled = ispecl_rule( + TERM_LIST( + `prod_ra (R1:(A)ra) (R2:(B)ra)`, + product_frame, + product_a, + product_b), + RA_CANCELLATIVE_APPLY); + cancelled = mp_rule( + cancelled, + assume_rule(`ra_cancellative (prod_ra (R1:(A)ra) (R2:(B)ra))`)); + cancelled = mp_rule(cancelled, source_valid); + cancelled = mp_rule(cancelled, product_ops_equal); + thm projected = ap_term_rule(`FST:(A#B)->A`, cancelled); + projected = pure_rewrite_rule( + THM_LIST(get_theorem_by_name("FST")), + projected); + ACCEPT_TAC(body, projected); + return gnode_prove(root); +} + +PROOF static thm PROD_RA_CANCELLATIVE_ELIM_LEFT = + prove_prod_ra_cancellative_elim_left(); + +/* Symmetric embedding at the valid left unit. */ +PROOF static thm prove_prod_ra_cancellative_elim_right(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra). + ra_cancellative (prod_ra R1 R2) ==> + ra_cancellative R2 + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_cancellative_def))); + body = AUTO_INTROS_TAC(body); + + term product_frame = `(ra_unit (R1:(A)ra),(frame:B))`; + term product_a = `(ra_unit (R1:(A)ra),(a:B))`; + term product_b = `(ra_unit (R1:(A)ra),(b:B))`; + thm left_unit_valid = ispec_rule(`R1:(A)ra`, RA_VALID_UNIT); + thm left_unit_op = ispecl_rule( + TERM_LIST(`R1:(A)ra`, `ra_unit (R1:(A)ra)`), + RA_UNIT_L); + thm left_composition_valid = eq_mp_rule( + ap_term_rule( + `ra_valid (R1:(A)ra):A->bool`, + gsym_rule(left_unit_op)), + left_unit_valid); + thm explicit_source_validity = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `(ra_op (R1:(A)ra) (ra_unit R1) (ra_unit R1), + ra_op (R2:(B)ra) (frame:B) (a:B))`), + PROD_RA_VALID); + explicit_source_validity = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + explicit_source_validity); + thm explicit_source_valid = eq_mp_rule( + gsym_rule(explicit_source_validity), + conj_rule( + left_composition_valid, + assume_rule(` + ra_valid + (R2:(B)ra) + (ra_op R2 (frame:B) (a:B)) + `))); + thm source_op = ispecl_rule( + TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, product_frame, product_a), + PROD_RA_OP); + source_op = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + source_op); + thm source_valid = eq_mp_rule( + ap_term_rule( + `ra_valid (prod_ra (R1:(A)ra) (R2:(B)ra)):A#B->bool`, + gsym_rule(source_op)), + explicit_source_valid); + + thm explicit_ops_equal = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `ra_op (R1:(A)ra) (ra_unit R1) (ra_unit R1)`, + `ra_op (R2:(B)ra) (frame:B) (a:B)`, + `ra_op (R1:(A)ra) (ra_unit R1) (ra_unit R1)`, + `ra_op (R2:(B)ra) (frame:B) (b:B)`), + get_theorem_by_name("PAIR_EQ"))), + conj_rule( + refl_rule(`ra_op (R1:(A)ra) (ra_unit R1) (ra_unit R1)`), + assume_rule(` + ra_op (R2:(B)ra) (frame:B) (a:B) == + ra_op R2 frame (b:B) + `))); + thm target_op = ispecl_rule( + TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, product_frame, product_b), + PROD_RA_OP); + target_op = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + target_op); + thm product_ops_equal = trans_rule( + source_op, + trans_rule(explicit_ops_equal, gsym_rule(target_op))); + + thm cancelled = ispecl_rule( + TERM_LIST( + `prod_ra (R1:(A)ra) (R2:(B)ra)`, + product_frame, + product_a, + product_b), + RA_CANCELLATIVE_APPLY); + cancelled = mp_rule( + cancelled, + assume_rule(`ra_cancellative (prod_ra (R1:(A)ra) (R2:(B)ra))`)); + cancelled = mp_rule(cancelled, source_valid); + cancelled = mp_rule(cancelled, product_ops_equal); + thm projected = ap_term_rule(`SND:(A#B)->B`, cancelled); + projected = pure_rewrite_rule( + THM_LIST(get_theorem_by_name("SND")), + projected); + ACCEPT_TAC(body, projected); + return gnode_prove(root); +} + +PROOF static thm PROD_RA_CANCELLATIVE_ELIM_RIGHT = + prove_prod_ra_cancellative_elim_right(); + +PROOF static thm prove_prod_ra_cancellative_iff(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra). + ra_cancellative (prod_ra R1 R2) <=> + ra_cancellative R1 && ra_cancellative R2 + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hproduct"); + gnode_list components = CONJ_TAC(forward); + ACCEPT_TAC( + components[0], + mp_rule( + ispecl_rule( + TERM_LIST(`R1:(A)ra`, `R2:(B)ra`), + PROD_RA_CANCELLATIVE_ELIM_LEFT), + assume_rule(`ra_cancellative (prod_ra (R1:(A)ra) (R2:(B)ra))`))); + ACCEPT_TAC( + components[1], + mp_rule( + ispecl_rule( + TERM_LIST(`R1:(A)ra`, `R2:(B)ra`), + PROD_RA_CANCELLATIVE_ELIM_RIGHT), + assume_rule(`ra_cancellative (prod_ra (R1:(A)ra) (R2:(B)ra))`))); + + gnode reverse = DISCH_TAC(directions[1], "Hcomponents"); + thm result = ispecl_rule( + TERM_LIST(`R1:(A)ra`, `R2:(B)ra`), + PROD_RA_CANCELLATIVE); + result = mp_rule( + result, + conjunct1_rule(assume_rule(` + ra_cancellative (R1:(A)ra) && ra_cancellative (R2:(B)ra) + `))); + result = mp_rule( + result, + conjunct2_rule(assume_rule(` + ra_cancellative (R1:(A)ra) && ra_cancellative (R2:(B)ra) + `))); + ACCEPT_TAC(reverse, result); + return gnode_prove(root); +} + +PROOF thm PROD_RA_CANCELLATIVE_IFF = + prove_prod_ra_cancellative_iff(); + /* * Select one result from each component update at the corresponding * component of an arbitrary product frame. The result predicate is kept as @@ -823,6 +1436,281 @@ PROOF static thm prove_prod_ra_update(void) { PROOF thm PROD_RA_UPDATE = prove_prod_ra_update(); +/* Observe a product update through a frame in one component and the valid + * unit frame in the other. The other source component must itself be valid + * or the product update may be vacuous. */ +PROOF static thm prove_prod_ra_update_elim_left(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) + (a1:A) (a2:B) (b1:A) (b2:B). + ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) ==> + ra_valid R2 a2 ==> + ra_update R1 a1 b1 + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_def))); + body = AUTO_INTROS_TAC(body); + + thm right_unit = ispecl_rule( + TERM_LIST(`R2:(B)ra`, `a2:B`), + RA_UNIT_R); + thm right_valid = eq_mp_rule( + ap_term_rule( + `ra_valid (R2:(B)ra):B->bool`, + gsym_rule(right_unit)), + assume_rule(`ra_valid (R2:(B)ra) (a2:B)`)); + thm source_pair_valid = conj_rule( + assume_rule(`ra_valid (R1:(A)ra) (ra_op R1 (a1:A) (frame:A))`), + right_valid); + + term product_frame = `((frame:A),ra_unit (R2:(B)ra))`; + thm source_validity = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `(ra_op (R1:(A)ra) (a1:A) (frame:A), + ra_op (R2:(B)ra) (a2:B) (ra_unit R2))`), + PROD_RA_VALID); + source_validity = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + source_validity); + thm source_explicit_valid = eq_mp_rule( + gsym_rule(source_validity), + source_pair_valid); + thm source_op = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `((a1:A),(a2:B))`, + product_frame), + PROD_RA_OP); + source_op = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + source_op); + thm source_valid = eq_mp_rule( + ap_term_rule( + `ra_valid (prod_ra (R1:(A)ra) (R2:(B)ra)):A#B->bool`, + gsym_rule(source_op)), + source_explicit_valid); + + thm target_valid = ispecl_rule( + TERM_LIST( + `prod_ra (R1:(A)ra) (R2:(B)ra)`, + `((a1:A),(a2:B))`, + `((b1:A),(b2:B))`, + product_frame), + RA_UPDATE_APPLY); + target_valid = mp_rule( + target_valid, + assume_rule(` + ra_update + (prod_ra (R1:(A)ra) (R2:(B)ra)) + ((a1:A),(a2:B)) + ((b1:A),(b2:B)) + `)); + target_valid = mp_rule(target_valid, source_valid); + + thm target_components = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `ra_op + (prod_ra (R1:(A)ra) (R2:(B)ra)) + ((b1:A),(b2:B)) + ((frame:A),ra_unit R2)`), + PROD_RA_VALID), + target_valid); + target_components = pure_rewrite_rule( + THM_LIST( + PROD_RA_OP, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + target_components); + ACCEPT_TAC(body, conjunct1_rule(target_components)); + return gnode_prove(root); +} + +PROOF thm PROD_RA_UPDATE_ELIM_LEFT = + prove_prod_ra_update_elim_left(); + +PROOF static thm prove_prod_ra_update_elim_right(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) + (a1:A) (a2:B) (b1:A) (b2:B). + ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) ==> + ra_valid R1 a1 ==> + ra_update R2 a2 b2 + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_def))); + body = AUTO_INTROS_TAC(body); + + thm left_unit = ispecl_rule( + TERM_LIST(`R1:(A)ra`, `a1:A`), + RA_UNIT_R); + thm left_valid = eq_mp_rule( + ap_term_rule( + `ra_valid (R1:(A)ra):A->bool`, + gsym_rule(left_unit)), + assume_rule(`ra_valid (R1:(A)ra) (a1:A)`)); + thm source_pair_valid = conj_rule( + left_valid, + assume_rule(`ra_valid (R2:(B)ra) (ra_op R2 (a2:B) (frame:B))`)); + + term product_frame = `(ra_unit (R1:(A)ra),(frame:B))`; + thm source_validity = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `(ra_op (R1:(A)ra) (a1:A) (ra_unit R1), + ra_op (R2:(B)ra) (a2:B) (frame:B))`), + PROD_RA_VALID); + source_validity = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + source_validity); + thm source_explicit_valid = eq_mp_rule( + gsym_rule(source_validity), + source_pair_valid); + thm source_op = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `((a1:A),(a2:B))`, + product_frame), + PROD_RA_OP); + source_op = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + source_op); + thm source_valid = eq_mp_rule( + ap_term_rule( + `ra_valid (prod_ra (R1:(A)ra) (R2:(B)ra)):A#B->bool`, + gsym_rule(source_op)), + source_explicit_valid); + + thm target_valid = ispecl_rule( + TERM_LIST( + `prod_ra (R1:(A)ra) (R2:(B)ra)`, + `((a1:A),(a2:B))`, + `((b1:A),(b2:B))`, + product_frame), + RA_UPDATE_APPLY); + target_valid = mp_rule( + target_valid, + assume_rule(` + ra_update + (prod_ra (R1:(A)ra) (R2:(B)ra)) + ((a1:A),(a2:B)) + ((b1:A),(b2:B)) + `)); + target_valid = mp_rule(target_valid, source_valid); + + thm target_components = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `ra_op + (prod_ra (R1:(A)ra) (R2:(B)ra)) + ((b1:A),(b2:B)) + (ra_unit R1,(frame:B))`), + PROD_RA_VALID), + target_valid); + target_components = pure_rewrite_rule( + THM_LIST( + PROD_RA_OP, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + target_components); + ACCEPT_TAC(body, conjunct2_rule(target_components)); + return gnode_prove(root); +} + +PROOF thm PROD_RA_UPDATE_ELIM_RIGHT = + prove_prod_ra_update_elim_right(); + +PROOF static thm prove_prod_ra_update_iff(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) + (a1:A) (a2:B) (b1:A) (b2:B). + ra_valid R1 a1 ==> + ra_valid R2 a2 ==> + (ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) <=> + ra_update R1 a1 b1 && ra_update R2 a2 b2) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hupdate"); + gnode_list components = CONJ_TAC(forward); + thm left = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, `R2:(B)ra`, + `a1:A`, `a2:B`, `b1:A`, `b2:B`), + PROD_RA_UPDATE_ELIM_LEFT); + left = mp_rule(left, assume_rule(` + ra_update + (prod_ra (R1:(A)ra) (R2:(B)ra)) + ((a1:A),(a2:B)) + ((b1:A),(b2:B)) + `)); + left = mp_rule(left, assume_rule(`ra_valid (R2:(B)ra) (a2:B)`)); + ACCEPT_TAC(components[0], left); + + thm right = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, `R2:(B)ra`, + `a1:A`, `a2:B`, `b1:A`, `b2:B`), + PROD_RA_UPDATE_ELIM_RIGHT); + right = mp_rule(right, assume_rule(` + ra_update + (prod_ra (R1:(A)ra) (R2:(B)ra)) + ((a1:A),(a2:B)) + ((b1:A),(b2:B)) + `)); + right = mp_rule(right, assume_rule(`ra_valid (R1:(A)ra) (a1:A)`)); + ACCEPT_TAC(components[1], right); + + gnode reverse = DISCH_TAC(directions[1], "Hcomponents"); + thm result = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, `R2:(B)ra`, + `a1:A`, `a2:B`, `b1:A`, `b2:B`), + PROD_RA_UPDATE); + result = mp_rule( + result, + conjunct1_rule(assume_rule(` + ra_update (R1:(A)ra) (a1:A) (b1:A) && + ra_update (R2:(B)ra) (a2:B) (b2:B) + `))); + result = mp_rule( + result, + conjunct2_rule(assume_rule(` + ra_update (R1:(A)ra) (a1:A) (b1:A) && + ra_update (R2:(B)ra) (a2:B) (b2:B) + `))); + ACCEPT_TAC(reverse, result); + return gnode_prove(root); +} + +PROOF thm PROD_RA_UPDATE_IFF = + prove_prod_ra_update_iff(); + /* * Pure predicate normalization used after combining a left update with ND * reflexivity on the right. The equality-selected right result is @@ -1120,6 +2008,251 @@ PROOF static thm prove_prod_ra_update_right(void) { PROOF thm PROD_RA_UPDATE_RIGHT = prove_prod_ra_update_right(); +/* Iris's product local update specializes directly to the discrete unital + * relation used here: project validity and the shared residual frame, run the + * two component updates, then pair their exact residual equations again. */ +PROOF static thm prove_prod_ra_local_update(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) + (a1:A) (f1:A) (b1:A) (g1:A) + (a2:B) (f2:B) (b2:B) (g2:B). + ra_local_update R1 (a1,f1) (b1,g1) ==> + ra_local_update R2 (a2,f2) (b2,g2) ==> + ra_local_update + (prod_ra R1 R2) + ((a1,a2),(f1,f2)) + ((b1,b2),(g1,g2)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_local_update_def))); + body = CONV_TAC( + body, + rewrite_conv(THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + body = AUTO_INTROS_TAC(body); + + thm source_validity = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `((a1:A),(a2:B))`), + PROD_RA_VALID); + source_validity = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + source_validity); + thm source_components = eq_mp_rule( + source_validity, + assume_rule(` + ra_valid + (prod_ra (R1:(A)ra) (R2:(B)ra)) + ((a1:A),(a2:B)) + `)); + + thm source_extension = assume_rule(` + ((a1:A),(a2:B)) == + ra_op + (prod_ra (R1:(A)ra) (R2:(B)ra)) + ((f1:A),(f2:B)) + (frame:A#B) + `); + thm left_extension = ap_term_rule(`FST:(A#B)->A`, source_extension); + left_extension = pure_rewrite_rule( + THM_LIST( + PROD_RA_OP, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + left_extension); + thm right_extension = ap_term_rule(`SND:(A#B)->B`, source_extension); + right_extension = pure_rewrite_rule( + THM_LIST( + PROD_RA_OP, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + right_extension); + + thm left_result = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `((a1:A),(f1:A))`, + `((b1:A),(g1:A))`, + `FST (frame:A#B)`), + RA_LOCAL_UPDATE_APPLY); + left_result = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + left_result); + left_result = mp_rule( + left_result, + assume_rule(` + ra_local_update + (R1:(A)ra) + ((a1:A),(f1:A)) + ((b1:A),(g1:A)) + `)); + left_result = mp_rule(left_result, conjunct1_rule(source_components)); + left_result = mp_rule(left_result, left_extension); + + thm right_result = ispecl_rule( + TERM_LIST( + `R2:(B)ra`, + `((a2:B),(f2:B))`, + `((b2:B),(g2:B))`, + `SND (frame:A#B)`), + RA_LOCAL_UPDATE_APPLY); + right_result = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + right_result); + right_result = mp_rule( + right_result, + assume_rule(` + ra_local_update + (R2:(B)ra) + ((a2:B),(f2:B)) + ((b2:B),(g2:B)) + `)); + right_result = mp_rule(right_result, conjunct2_rule(source_components)); + right_result = mp_rule(right_result, right_extension); + + gnode_list target = CONJ_TAC(body); + thm target_validity = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `((b1:A),(b2:B))`), + PROD_RA_VALID); + target_validity = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + target_validity); + ACCEPT_TAC( + target[0], + eq_mp_rule( + gsym_rule(target_validity), + conj_rule( + conjunct1_rule(left_result), + conjunct1_rule(right_result)))); + + thm paired_extensions = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `b1:A`, + `b2:B`, + `ra_op (R1:(A)ra) (g1:A) (FST (frame:A#B))`, + `ra_op (R2:(B)ra) (g2:B) (SND (frame:A#B))`), + get_theorem_by_name("PAIR_EQ"))), + conj_rule( + conjunct2_rule(left_result), + conjunct2_rule(right_result))); + thm target_op = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `R2:(B)ra`, + `((g1:A),(g2:B))`, + `frame:A#B`), + PROD_RA_OP); + target_op = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + target_op); + ACCEPT_TAC( + target[1], + trans_rule(paired_extensions, gsym_rule(target_op))); + return gnode_prove(root); +} + +PROOF thm PROD_RA_LOCAL_UPDATE = + prove_prod_ra_local_update(); + +/* One-sided rules are the product rule plus local-update reflexivity. */ +PROOF static thm prove_prod_ra_local_update_left(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) + (a1:A) (f1:A) (b1:A) (g1:A) + (a2:B) (f2:B). + ra_local_update R1 (a1,f1) (b1,g1) ==> + ra_local_update + (prod_ra R1 R2) + ((a1,a2),(f1,f2)) + ((b1,a2),(g1,f2)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm result = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, `R2:(B)ra`, + `a1:A`, `f1:A`, `b1:A`, `g1:A`, + `a2:B`, `f2:B`, `a2:B`, `f2:B`), + PROD_RA_LOCAL_UPDATE); + result = mp_rule( + result, + assume_rule(` + ra_local_update + (R1:(A)ra) + ((a1:A),(f1:A)) + ((b1:A),(g1:A)) + `)); + result = mp_rule( + result, + ispecl_rule( + TERM_LIST(`R2:(B)ra`, `((a2:B),(f2:B))`), + RA_LOCAL_UPDATE_REFL)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm PROD_RA_LOCAL_UPDATE_LEFT = + prove_prod_ra_local_update_left(); + +PROOF static thm prove_prod_ra_local_update_right(void) { + term goal_tm = ` + forall (R1:(A)ra) (R2:(B)ra) + (a1:A) (f1:A) + (a2:B) (f2:B) (b2:B) (g2:B). + ra_local_update R2 (a2,f2) (b2,g2) ==> + ra_local_update + (prod_ra R1 R2) + ((a1,a2),(f1,f2)) + ((a1,b2),(f1,g2)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm result = ispecl_rule( + TERM_LIST( + `R1:(A)ra`, `R2:(B)ra`, + `a1:A`, `f1:A`, `a1:A`, `f1:A`, + `a2:B`, `f2:B`, `b2:B`, `g2:B`), + PROD_RA_LOCAL_UPDATE); + result = mp_rule( + result, + ispecl_rule( + TERM_LIST(`R1:(A)ra`, `((a1:A),(f1:A))`), + RA_LOCAL_UPDATE_REFL)); + result = mp_rule( + result, + assume_rule(` + ra_local_update + (R2:(B)ra) + ((a2:B),(f2:B)) + ((b2:B),(g2:B)) + `)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm PROD_RA_LOCAL_UPDATE_RIGHT = + prove_prod_ra_local_update_right(); + PROOF static int audit_prod_ra(void) { thm_list source_theorems = THM_LIST( prod_ra_op_def, @@ -1132,15 +2265,28 @@ PROOF static int audit_prod_ra(void) { PROD_RA_OP, PROD_RA_VALID, PROD_RA_INCLUDED, + PROD_RA_EXCLUSIVE, + PROD_RA_EXCLUSIVE_ELIM_LEFT, + PROD_RA_EXCLUSIVE_ELIM_RIGHT, + PROD_RA_EXCLUSIVE_IFF, PROD_RA_CANCELLATIVE, + PROD_RA_CANCELLATIVE_ELIM_LEFT, + PROD_RA_CANCELLATIVE_ELIM_RIGHT, + PROD_RA_CANCELLATIVE_IFF, PROD_RA_UPDATE_ND, PROD_RA_UPDATE, + PROD_RA_UPDATE_ELIM_LEFT, + PROD_RA_UPDATE_ELIM_RIGHT, + PROD_RA_UPDATE_IFF, PROD_RA_LEFT_IMAGE_IMP, PROD_RA_UPDATE_LEFT_ND, PROD_RA_UPDATE_LEFT, PROD_RA_RIGHT_IMAGE_IMP, PROD_RA_UPDATE_RIGHT_ND, - PROD_RA_UPDATE_RIGHT); + PROD_RA_UPDATE_RIGHT, + PROD_RA_LOCAL_UPDATE, + PROD_RA_LOCAL_UPDATE_LEFT, + PROD_RA_LOCAL_UPDATE_RIGHT); for (size_t i = 0; i < vector_size(source_theorems); ++i) { ENSURE_COND(!IS_NULL(source_theorems[i]), diff --git a/theory/logic/prod_ra.h b/theory/logic/prod_ra.h index 7234741..d390540 100644 --- a/theory/logic/prod_ra.h +++ b/theory/logic/prod_ra.h @@ -12,7 +12,7 @@ * are implementation details. Clients should use only the direct rules below. */ -#include "proof/theory/logic/ra.h" +#include "proof/theory/logic/local_update.h" /* ------------------------------------------------------------------------- */ /* Core representation */ @@ -21,23 +21,26 @@ /* * Product unit: * - * ra_unit (prod_ra R1 R2) == (ra_unit R1, ra_unit R2) + * forall (R1:(A)ra) (R2:(B)ra). + * ra_unit (prod_ra R1 R2) == (ra_unit R1,ra_unit R2) */ PROOF extern thm PROD_RA_UNIT; /* * Pointwise composition: * - * ra_op (prod_ra R1 R2) x y == - * (ra_op R1 (FST x) (FST y), - * ra_op R2 (SND x) (SND y)) + * forall (R1:(A)ra) (R2:(B)ra) (x:A#B) (y:A#B). + * ra_op (prod_ra R1 R2) x y == + * (ra_op R1 (FST x) (FST y), + * ra_op R2 (SND x) (SND y)) */ PROOF extern thm PROD_RA_OP; /* * Componentwise validity: * - * ra_valid (prod_ra R1 R2) x <=> + * forall (R1:(A)ra) (R2:(B)ra) (x:A#B). + * ra_valid (prod_ra R1 R2) x <=> * ra_valid R1 (FST x) && ra_valid R2 (SND x) */ PROOF extern thm PROD_RA_VALID; @@ -60,6 +63,54 @@ PROOF extern thm PROD_RA_VALID; */ PROOF extern thm PROD_RA_INCLUDED; +/* + * Compatible-frame exclusivity lifts when both components are exclusive: + * + * forall (R1:(A)ra) (R2:(B)ra) (x:A#B). + * ra_exclusive R1 (FST x) ==> + * ra_exclusive R2 (SND x) ==> + * ra_exclusive (prod_ra R1 R2) x + * + * Requiring both sides is essential for this library's `ra_exclusive`, which + * permits the unit frame. Iris's class named `Exclusive` instead rules out + * every valid frame, so its product instance can be obtained from one side; + * that is a different predicate. + */ +PROOF extern thm PROD_RA_EXCLUSIVE; + +/* + * A valid exclusive product has an exclusive left projection: + * + * forall (R1:(A)ra) (R2:(B)ra) (x:A#B). + * ra_valid (prod_ra R1 R2) x ==> + * ra_exclusive (prod_ra R1 R2) x ==> + * ra_exclusive R1 (FST x) + * + * Source validity is necessary: an invalid component can otherwise make the + * whole product exclusive vacuously. + */ +PROOF extern thm PROD_RA_EXCLUSIVE_ELIM_LEFT; + +/* + * A valid exclusive product has an exclusive right projection: + * + * forall (R1:(A)ra) (R2:(B)ra) (x:A#B). + * ra_valid (prod_ra R1 R2) x ==> + * ra_exclusive (prod_ra R1 R2) x ==> + * ra_exclusive R2 (SND x) + */ +PROOF extern thm PROD_RA_EXCLUSIVE_ELIM_RIGHT; + +/* + * Exact characterization for valid products: + * + * forall (R1:(A)ra) (R2:(B)ra) (x:A#B). + * ra_valid (prod_ra R1 R2) x ==> + * (ra_exclusive (prod_ra R1 R2) x <=> + * ra_exclusive R1 (FST x) && ra_exclusive R2 (SND x)) + */ +PROOF extern thm PROD_RA_EXCLUSIVE_IFF; + /* * Cancellativity lifts componentwise: * @@ -73,6 +124,18 @@ PROOF extern thm PROD_RA_INCLUDED; */ PROOF extern thm PROD_RA_CANCELLATIVE; +/* + * Product cancellativity is exact: + * + * forall (R1:(A)ra) (R2:(B)ra). + * ra_cancellative (prod_ra R1 R2) <=> + * ra_cancellative R1 && ra_cancellative R2 + * + * The reverse direction is `PROD_RA_CANCELLATIVE`; each forward projection + * embeds the other component at its valid unit. + */ +PROOF extern thm PROD_RA_CANCELLATIVE_IFF; + /* ------------------------------------------------------------------------- */ /* Product updates */ /* ------------------------------------------------------------------------- */ @@ -80,11 +143,15 @@ PROOF extern thm PROD_RA_CANCELLATIVE; /* * Independent nondeterministic updates combine: * - * ra_update_nd R1 a1 P1 ==> - * ra_update_nd R2 a2 P2 ==> - * ra_update_nd (prod_ra R1 R2) (a1,a2) - * (\x. exists b1 b2. - * P1 b1 && P2 b2 && x == (b1,b2)) + * forall (R1:(A)ra) (R2:(B)ra) + * (a1:A) (a2:B) (P1:A->bool) (P2:B->bool). + * ra_update_nd R1 a1 P1 ==> + * ra_update_nd R2 a2 P2 ==> + * ra_update_nd + * (prod_ra R1 R2) + * (a1,a2) + * (\x:A#B. exists b1:A. exists b2:B. + * P1 b1 && P2 b2 && x == (b1,b2)) * * The existential predicate describes exactly the pairs selected by the two * component updates; it does not admit unrelated product values. @@ -94,42 +161,139 @@ PROOF extern thm PROD_RA_UPDATE_ND; /* * Independent deterministic updates combine: * - * ra_update R1 a1 b1 ==> - * ra_update R2 a2 b2 ==> - * ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) + * forall (R1:(A)ra) (R2:(B)ra) + * (a1:A) (a2:B) (b1:A) (b2:B). + * ra_update R1 a1 b1 ==> + * ra_update R2 a2 b2 ==> + * ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) */ PROOF extern thm PROD_RA_UPDATE; +/* + * A product update induces its left component update when the unchanged + * source context on the right is valid: + * + * forall (R1:(A)ra) (R2:(B)ra) + * (a1:A) (a2:B) (b1:A) (b2:B). + * ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) ==> + * ra_valid R2 a2 ==> + * ra_update R1 a1 b1 + */ +PROOF extern thm PROD_RA_UPDATE_ELIM_LEFT; + +/* + * A product update induces its right component update when the left source + * component is valid: + * + * forall (R1:(A)ra) (R2:(B)ra) + * (a1:A) (a2:B) (b1:A) (b2:B). + * ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) ==> + * ra_valid R1 a1 ==> + * ra_update R2 a2 b2 + */ +PROOF extern thm PROD_RA_UPDATE_ELIM_RIGHT; + +/* + * Exact deterministic update characterization for a valid source: + * + * forall (R1:(A)ra) (R2:(B)ra) + * (a1:A) (a2:B) (b1:A) (b2:B). + * ra_valid R1 a1 ==> + * ra_valid R2 a2 ==> + * (ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) <=> + * ra_update R1 a1 b1 && ra_update R2 a2 b2) + */ +PROOF extern thm PROD_RA_UPDATE_IFF; + /* * A nondeterministic update of the left component preserves the right one: * - * ra_update_nd R1 a1 P ==> - * ra_update_nd (prod_ra R1 R2) (a1,a2) - * (\x. exists b1. P b1 && x == (b1,a2)) + * forall (R1:(A)ra) (R2:(B)ra) + * (a1:A) (a2:B) (P:A->bool). + * ra_update_nd R1 a1 P ==> + * ra_update_nd + * (prod_ra R1 R2) + * (a1,a2) + * (\x:A#B. exists b1:A. P b1 && x == (b1,a2)) */ PROOF extern thm PROD_RA_UPDATE_LEFT_ND; /* * A deterministic update of the left component preserves the right one: * - * ra_update R1 a1 b1 ==> - * ra_update (prod_ra R1 R2) (a1,a2) (b1,a2) + * forall (R1:(A)ra) (R2:(B)ra) + * (a1:A) (a2:B) (b1:A). + * ra_update R1 a1 b1 ==> + * ra_update (prod_ra R1 R2) (a1,a2) (b1,a2) */ PROOF extern thm PROD_RA_UPDATE_LEFT; /* * A nondeterministic update of the right component preserves the left one: * - * ra_update_nd R2 a2 P ==> - * ra_update_nd (prod_ra R1 R2) (a1,a2) - * (\x. exists b2. P b2 && x == (a1,b2)) + * forall (R1:(A)ra) (R2:(B)ra) + * (a1:A) (a2:B) (P:B->bool). + * ra_update_nd R2 a2 P ==> + * ra_update_nd + * (prod_ra R1 R2) + * (a1,a2) + * (\x:A#B. exists b2:B. P b2 && x == (a1,b2)) */ PROOF extern thm PROD_RA_UPDATE_RIGHT_ND; /* * A deterministic update of the right component preserves the left one: * - * ra_update R2 a2 b2 ==> - * ra_update (prod_ra R1 R2) (a1,a2) (a1,b2) + * forall (R1:(A)ra) (R2:(B)ra) + * (a1:A) (a2:B) (b2:B). + * ra_update R2 a2 b2 ==> + * ra_update (prod_ra R1 R2) (a1,a2) (a1,b2) */ PROOF extern thm PROD_RA_UPDATE_RIGHT; + +/* ------------------------------------------------------------------------- */ +/* Product local updates */ +/* ------------------------------------------------------------------------- */ + +/* + * Independent component local updates combine pointwise: + * + * forall (R1:(A)ra) (R2:(B)ra) + * (a1:A) (f1:A) (b1:A) (g1:A) + * (a2:B) (f2:B) (b2:B) (g2:B). + * ra_local_update R1 (a1,f1) (b1,g1) ==> + * ra_local_update R2 (a2,f2) (b2,g2) ==> + * ra_local_update + * (prod_ra R1 R2) + * ((a1,a2),(f1,f2)) + * ((b1,b2),(g1,g2)) + */ +PROOF extern thm PROD_RA_LOCAL_UPDATE; + +/* + * A left local update preserves both visible components on the right: + * + * forall (R1:(A)ra) (R2:(B)ra) + * (a1:A) (f1:A) (b1:A) (g1:A) + * (a2:B) (f2:B). + * ra_local_update R1 (a1,f1) (b1,g1) ==> + * ra_local_update + * (prod_ra R1 R2) + * ((a1,a2),(f1,f2)) + * ((b1,a2),(g1,f2)) + */ +PROOF extern thm PROD_RA_LOCAL_UPDATE_LEFT; + +/* + * A right local update preserves both visible components on the left: + * + * forall (R1:(A)ra) (R2:(B)ra) + * (a1:A) (f1:A) + * (a2:B) (f2:B) (b2:B) (g2:B). + * ra_local_update R2 (a2,f2) (b2,g2) ==> + * ra_local_update + * (prod_ra R1 R2) + * ((a1,a2),(f1,f2)) + * ((a1,b2),(f1,g2)) + */ +PROOF extern thm PROD_RA_LOCAL_UPDATE_RIGHT; diff --git a/theory/logic/ra.c b/theory/logic/ra.c index 76bab2b..92402a6 100644 --- a/theory/logic/ra.c +++ b/theory/logic/ra.c @@ -539,6 +539,86 @@ PROOF static thm prove_ra_cancellative_apply(void) { PROOF thm RA_CANCELLATIVE_APPLY = prove_ra_cancellative_apply(); +/* Direct eliminators keep goal-directed proofs from unfolding quantified + * property definitions at every use site. */ +PROOF static thm prove_ra_exclusive_apply(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (frame:A). + ra_exclusive R a ==> + ra_valid R (ra_op R a frame) ==> + frame == ra_unit R + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm exclusive = rewrite_rule( + THM_LIST(ra_exclusive_def), + assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); + thm result = mp_rule( + spec_rule(`frame:A`, exclusive), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (a:A) (frame:A)) + `)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm RA_EXCLUSIVE_APPLY = + prove_ra_exclusive_apply(); + +PROOF static thm prove_ra_update_apply(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A) (frame:A). + ra_update R a b ==> + ra_valid R (ra_op R a frame) ==> + ra_valid R (ra_op R b frame) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm update = rewrite_rule( + THM_LIST(ra_update_def), + assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); + thm result = mp_rule( + spec_rule(`frame:A`, update), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (a:A) (frame:A)) + `)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_APPLY = + prove_ra_update_apply(); + +PROOF static thm prove_ra_update_nd_apply(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (P:A->bool) (frame:A). + ra_update_nd R a P ==> + ra_valid R (ra_op R a frame) ==> + exists b:A. P b && ra_valid R (ra_op R b frame) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm update = rewrite_rule( + THM_LIST(ra_update_nd_def), + assume_rule(`ra_update_nd (R:(A)ra) (a:A) (P:A->bool)`)); + thm result = mp_rule( + spec_rule(`frame:A`, update), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (a:A) (frame:A)) + `)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_ND_APPLY = + prove_ra_update_nd_apply(); + /* * Inclusion is reflexive: choose the unit as the missing frame. */ @@ -911,6 +991,73 @@ PROOF static thm prove_ra_included_valid_frame(void) { PROOF thm RA_INCLUDED_VALID_FRAME = prove_ra_included_valid_frame(); +/* Unpack the inclusion witness, reassociate it behind the common prefix, + * cancel that prefix, and reuse the same witness for the base inclusion. */ +PROOF static thm prove_ra_included_cancel_l(void) { + term goal_tm = ` + forall (R:(A)ra) (common:A) (a:A) (b:A). + ra_cancellative R ==> + ra_valid R (ra_op R common b) ==> + ra_included + R + (ra_op R common a) + (ra_op R common b) ==> + ra_included R a b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm framed_inclusion = rewrite_rule( + THM_LIST(ra_included_def), + assume_rule(` + ra_included + (R:(A)ra) + (ra_op R (common:A) (a:A)) + (ra_op R common (b:A)) + `)); + body = ASSUME_TAC( + body, + framed_inclusion, + "Hframed_inclusion"); + body = ASMP_EXISTS_TAC( + body, + "Hframed_inclusion", + "extension"); + + thm framed_eq = rewrite_rule( + THM_LIST(RA_ASSOC), + assume_rule(` + ra_op (R:(A)ra) (common:A) (b:A) == + ra_op R (ra_op R common (a:A)) (extension:A) + `)); + thm cancelled = mp_rule( + mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `common:A`, + `b:A`, + `ra_op (R:(A)ra) (a:A) (extension:A)`), + RA_CANCELLATIVE_APPLY), + assume_rule(`ra_cancellative (R:(A)ra)`)), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (common:A) (b:A)) + `)), + framed_eq); + + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_included_def))); + body = EXISTS_TAC(body, `extension:A`); + ACCEPT_TAC(body, cancelled); + return gnode_prove(root); +} + +PROOF thm RA_INCLUDED_CANCEL_L = + prove_ra_included_cancel_l(); + /* * Exclusive elements are maximal among valid extensions. Unpack the * inclusion witness, use validity of the extension to show that witness is @@ -1068,6 +1215,98 @@ PROOF static thm prove_ra_exclusive_iff_included(void) { PROOF thm RA_EXCLUSIVE_IFF_INCLUDED = prove_ra_exclusive_iff_included(); +/* Invalidity rules out every compatible frame by downward validity, hence + * exclusivity holds vacuously. */ +PROOF static thm prove_ra_invalid_exclusive(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A). + ~(ra_valid R a) ==> ra_exclusive R a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_exclusive_def))); + body = AUTO_INTROS_TAC(body); + thm valid_source = mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `frame:A`), + RA_VALID_OP_L), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (a:A) (frame:A)) + `)); + thm contradiction = not_elim_rule( + assume_rule(`~(ra_valid (R:(A)ra) (a:A))`), + valid_source); + CONTR_TAC(body, contradiction); + return gnode_prove(root); +} + +PROOF thm RA_INVALID_EXCLUSIVE = + prove_ra_invalid_exclusive(); + +/* For an exclusive source, compatibility is exactly ordinary source + * validity together with the unit frame. */ +PROOF static thm prove_ra_exclusive_valid_op_iff(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (frame:A). + ra_exclusive R a ==> + (ra_valid R (ra_op R a frame) <=> + ra_valid R a && frame == ra_unit R) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hcompatible"); + gnode_list components = CONJ_TAC(forward); + thm compatible = assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (a:A) (frame:A)) + `); + ACCEPT_TAC( + components[0], + mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `frame:A`), + RA_VALID_OP_L), + compatible)); + thm frame_is_unit = ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `frame:A`), + RA_EXCLUSIVE_APPLY); + frame_is_unit = mp_rule( + frame_is_unit, + assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); + frame_is_unit = mp_rule(frame_is_unit, compatible); + ACCEPT_TAC(components[1], frame_is_unit); + + gnode reverse = DISCH_TAC(directions[1], "Hcomponents"); + reverse = ASMP_CONJ_TAC( + reverse, + "Hcomponents", + "Hvalid_source", + "Hframe_unit"); + thm framed_eq = trans_rule( + beta_rule(ap_term_rule( + `\x:A. ra_op (R:(A)ra) (a:A) x`, + assume_rule(`(frame:A) == ra_unit (R:(A)ra)`))), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + RA_UNIT_R)); + thm valid_eq = ap_term_rule(`ra_valid (R:(A)ra)`, framed_eq); + ACCEPT_TAC( + reverse, + eq_mp_rule( + gsym_rule(valid_eq), + assume_rule(`ra_valid (R:(A)ra) (a:A)`))); + return gnode_prove(root); +} + +PROOF thm RA_EXCLUSIVE_VALID_OP_IFF = + prove_ra_exclusive_valid_op_iff(); + /* * A predicate-valued update to a singleton is equivalent to the deterministic * update relation. Both directions are kept explicit so this bridge remains @@ -1179,21 +1418,20 @@ PROOF static thm prove_ra_update_nd_trans(void) { ra_update_nd R a Q `; gnode root = gnode_new_with_ccl(goal_tm); - gnode body = CONV_TAC( - root, - pure_rewrite_conv(THM_LIST(ra_update_nd_def))); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); body = AUTO_INTROS_TAC(body); - thm intermediate = mp_rule( - spec_rule( - `frame:A`, - assume_rule(` - forall frame:A. - ra_valid (R:(A)ra) (ra_op R (a:A) frame) ==> - exists b:A. - (P:A->bool) b && - ra_valid R (ra_op R b frame) - `)), + thm intermediate = ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `P:A->bool`, `frame:A`), + RA_UPDATE_ND_APPLY); + intermediate = mp_rule( + intermediate, + assume_rule(`ra_update_nd (R:(A)ra) (a:A) (P:A->bool)`)); + intermediate = mp_rule( + intermediate, assume_rule(` ra_valid (R:(A)ra) (ra_op R (a:A) (frame:A)) `)); @@ -1208,15 +1446,15 @@ PROOF static thm prove_ra_update_nd_trans(void) { assume_rule(` forall b:A. (P:A->bool) b ==> - forall frame:A. - ra_valid (R:(A)ra) (ra_op R b frame) ==> - exists result:A. - (Q:A->bool) result && - ra_valid R (ra_op R result frame) + ra_update_nd (R:(A)ra) b (Q:A->bool) `)), assume_rule(`(P:A->bool) (middle:A)`)); - thm result = mp_rule( - spec_rule(`frame:A`, middle_update), + thm result = ispecl_rule( + TERM_LIST(`R:(A)ra`, `middle:A`, `Q:A->bool`, `frame:A`), + RA_UPDATE_ND_APPLY); + result = mp_rule(result, middle_update); + result = mp_rule( + result, assume_rule(` ra_valid (R:(A)ra) (ra_op R (middle:A) (frame:A)) `)); @@ -1346,10 +1584,7 @@ PROOF static thm prove_ra_update_nd_valid(void) { exists b:A. P b && ra_valid R b `; gnode root = gnode_new_with_ccl(goal_tm); - gnode body = CONV_TAC( - root, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); - body = AUTO_INTROS_TAC(body); + gnode body = AUTO_INTROS_TAC(root); thm source_unit_eq = gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), @@ -1360,17 +1595,17 @@ PROOF static thm prove_ra_update_nd_valid(void) { thm source_with_unit = eq_mp_rule( source_valid_eq, assume_rule(`ra_valid (R:(A)ra) (a:A)`)); - thm selected = mp_rule( - spec_rule( - `ra_unit (R:(A)ra)`, - assume_rule(` - forall frame:A. - ra_valid (R:(A)ra) (ra_op R (a:A) frame) ==> - exists b:A. - (P:A->bool) b && - ra_valid R (ra_op R b frame) - `)), - source_with_unit); + thm selected = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `P:A->bool`, + `ra_unit (R:(A)ra)`), + RA_UPDATE_ND_APPLY); + selected = mp_rule( + selected, + assume_rule(`ra_update_nd (R:(A)ra) (a:A) (P:A->bool)`)); + selected = mp_rule(selected, source_with_unit); body = ASSUME_TAC(body, selected, "Hselected"); body = ASMP_EXISTS_TAC(body, "Hselected", "selected"); body = ASMP_CONJ_TAC( @@ -1404,6 +1639,38 @@ PROOF static thm prove_ra_update_nd_valid(void) { PROOF thm RA_UPDATE_ND_VALID = prove_ra_update_nd_valid(); +/* If the source is invalid then no source/frame composition can be valid, + * so the quantified ND obligation has no cases. */ +PROOF static thm prove_ra_update_nd_invalid(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (P:A->bool). + ~(ra_valid R a) ==> ra_update_nd R a P + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + body = AUTO_INTROS_TAC(body); + thm valid_source = mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `frame:A`), + RA_VALID_OP_L), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (a:A) (frame:A)) + `)); + CONTR_TAC( + body, + not_elim_rule( + assume_rule(`~(ra_valid (R:(A)ra) (a:A))`), + valid_source)); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_ND_INVALID = + prove_ra_update_nd_invalid(); + /* * General exclusive update: a source-compatible frame is the unit, so a * valid target remains valid with that same frame. @@ -1427,11 +1694,14 @@ PROOF static thm prove_ra_exclusive_update(void) { body = GEN_TAC(body, "frame"); body = DISCH_TAC(body, "Hsource_valid"); - thm exclusive = rewrite_rule( - THM_LIST(ra_exclusive_def), + thm frame_is_unit = ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `frame:A`), + RA_EXCLUSIVE_APPLY); + frame_is_unit = mp_rule( + frame_is_unit, assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); - thm frame_is_unit = mp_rule( - spec_rule(`frame:A`, exclusive), + frame_is_unit = mp_rule( + frame_is_unit, assume_rule(` ra_valid (R:(A)ra) @@ -1480,6 +1750,38 @@ PROOF static thm prove_ra_update_refl(void) { PROOF thm RA_UPDATE_REFL = prove_ra_update_refl(); +/* Deterministic updates have the same vacuous-invalid-source boundary as ND + * updates. A valid composition would contradict downward validity. */ +PROOF static thm prove_ra_update_invalid(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ~(ra_valid R a) ==> ra_update R a b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_update_def))); + body = AUTO_INTROS_TAC(body); + thm valid_source = mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `frame:A`), + RA_VALID_OP_L), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (a:A) (frame:A)) + `)); + CONTR_TAC( + body, + not_elim_rule( + assume_rule(`~(ra_valid (R:(A)ra) (a:A))`), + valid_source)); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_INVALID = + prove_ra_update_invalid(); + /* * A larger resource may always update to one of its included parts: every * frame compatible with the larger source is compatible with the smaller @@ -1547,37 +1849,66 @@ PROOF static thm prove_ra_update_trans(void) { ra_update R a c `; gnode root = gnode_new_with_ccl(goal_tm); - gnode body = CONV_TAC( - root, - pure_rewrite_conv(THM_LIST(ra_update_def))); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_def))); body = AUTO_INTROS_TAC(body); - thm b_valid = mp_rule( - spec_rule( - `frame:A`, - assume_rule(` - forall frame:A. - ra_valid (R:(A)ra) (ra_op R (a:A) frame) ==> - ra_valid R (ra_op R (b:A) frame) - `)), + thm b_valid = ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `b:A`, `frame:A`), + RA_UPDATE_APPLY); + b_valid = mp_rule( + b_valid, + assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); + b_valid = mp_rule( + b_valid, assume_rule(` ra_valid (R:(A)ra) (ra_op R (a:A) (frame:A)) `)); - thm c_valid = mp_rule( - spec_rule( - `frame:A`, - assume_rule(` - forall frame:A. - ra_valid (R:(A)ra) (ra_op R (b:A) frame) ==> - ra_valid R (ra_op R (c:A) frame) - `)), - b_valid); + thm c_valid = ispecl_rule( + TERM_LIST(`R:(A)ra`, `b:A`, `c:A`, `frame:A`), + RA_UPDATE_APPLY); + c_valid = mp_rule( + c_valid, + assume_rule(`ra_update (R:(A)ra) (b:A) (c:A)`)); + c_valid = mp_rule(c_valid, b_valid); ACCEPT_TAC(body, c_valid); return gnode_prove(root); } PROOF thm RA_UPDATE_TRANS = prove_ra_update_trans(); +/* Weaken the selected target by composing the original update with the + * generic discard-to-an-included-part update. */ +PROOF static thm prove_ra_update_target_included(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A) (c:A). + ra_update R a b ==> + ra_included R c b ==> + ra_update R a c + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm discard = mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `b:A`, `c:A`), + RA_UPDATE_INCLUDED), + assume_rule(`ra_included (R:(A)ra) (c:A) (b:A)`)); + thm result = ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `b:A`, `c:A`), + RA_UPDATE_TRANS); + result = mp_rule( + result, + assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); + result = mp_rule(result, discard); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm RA_UPDATE_TARGET_INCLUDED = + prove_ra_update_target_included(); + /* * A deterministic update maps a valid source to a valid result. As for the * ND rule above, the unit is the frame witnessing ordinary validity. @@ -1590,10 +1921,7 @@ PROOF static thm prove_ra_update_valid(void) { ra_valid R b `; gnode root = gnode_new_with_ccl(goal_tm); - gnode body = CONV_TAC( - root, - once_rewrite_conv(THM_LIST(ra_update_def))); - body = AUTO_INTROS_TAC(body); + gnode body = AUTO_INTROS_TAC(root); thm source_unit_eq = gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), @@ -1604,15 +1932,17 @@ PROOF static thm prove_ra_update_valid(void) { thm source_with_unit = eq_mp_rule( source_valid_eq, assume_rule(`ra_valid (R:(A)ra) (a:A)`)); - thm result_with_unit = mp_rule( - spec_rule( - `ra_unit (R:(A)ra)`, - assume_rule(` - forall frame:A. - ra_valid (R:(A)ra) (ra_op R (a:A) frame) ==> - ra_valid R (ra_op R (b:A) frame) - `)), - source_with_unit); + thm result_with_unit = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `b:A`, + `ra_unit (R:(A)ra)`), + RA_UPDATE_APPLY); + result_with_unit = mp_rule( + result_with_unit, + assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); + result_with_unit = mp_rule(result_with_unit, source_with_unit); thm result_unit_eq = ispecl_rule( TERM_LIST(`R:(A)ra`, `b:A`), RA_UNIT_R); @@ -1629,6 +1959,65 @@ PROOF static thm prove_ra_update_valid(void) { PROOF thm RA_UPDATE_VALID = prove_ra_update_valid(); +/* Exclusive sources admit exactly the validity-preserving deterministic + * updates. The validity guard accounts for the vacuous invalid-source case. */ +PROOF static thm prove_ra_exclusive_update_iff(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_exclusive R a ==> + (ra_update R a b <=> + (ra_valid R a ==> ra_valid R b)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hupdate"); + forward = DISCH_TAC(forward, "Hvalid_source"); + thm valid_target = ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `b:A`), + RA_UPDATE_VALID); + valid_target = mp_rule( + valid_target, + assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); + valid_target = mp_rule( + valid_target, + assume_rule(`ra_valid (R:(A)ra) (a:A)`)); + ACCEPT_TAC(forward, valid_target); + + gnode reverse = DISCH_TAC(directions[1], "Hvalidity_guard"); + gnode_list validity_cases = BOOL_CASES_TAC( + reverse, + `ra_valid (R:(A)ra) (a:A)`, + "Hvalid_source"); + + thm target_valid = mp_rule( + assume_rule(` + ra_valid (R:(A)ra) (a:A) ==> + ra_valid R (b:A) + `), + assume_rule(`ra_valid (R:(A)ra) (a:A)`)); + thm exclusive_update = ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `b:A`), + RA_EXCLUSIVE_UPDATE); + exclusive_update = mp_rule( + exclusive_update, + assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); + exclusive_update = mp_rule(exclusive_update, target_valid); + ACCEPT_TAC(validity_cases[0], exclusive_update); + + thm invalid_update = mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `b:A`), + RA_UPDATE_INVALID), + assume_rule(`~(ra_valid (R:(A)ra) (a:A))`)); + ACCEPT_TAC(validity_cases[1], invalid_update); + return gnode_prove(root); +} + +PROOF thm RA_EXCLUSIVE_UPDATE_IFF = + prove_ra_exclusive_update_iff(); + /* * A deterministic update remains valid after appending the same resource to * both sides. The only algebraic fact used here is associativity. @@ -2017,6 +2406,86 @@ PROOF static thm prove_ra_update_nd_op(void) { PROOF thm RA_UPDATE_ND_OP = prove_ra_update_nd_op(); +/* The ND analogue of RA_EXCLUSIVE_UPDATE_IFF: for a valid exclusive source, + * choosing one valid postcondition witness is necessary and sufficient. */ +PROOF static thm prove_ra_exclusive_update_nd_iff(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (P:A->bool). + ra_exclusive R a ==> + (ra_update_nd R a P <=> + (ra_valid R a ==> + exists b:A. P b && ra_valid R b)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hupdate"); + forward = DISCH_TAC(forward, "Hvalid_source"); + thm selected = ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `P:A->bool`), + RA_UPDATE_ND_VALID); + selected = mp_rule( + selected, + assume_rule(`ra_update_nd (R:(A)ra) (a:A) (P:A->bool)`)); + selected = mp_rule( + selected, + assume_rule(`ra_valid (R:(A)ra) (a:A)`)); + ACCEPT_TAC(forward, selected); + + gnode reverse = DISCH_TAC(directions[1], "Hvalidity_guard"); + gnode_list validity_cases = BOOL_CASES_TAC( + reverse, + `ra_valid (R:(A)ra) (a:A)`, + "Hvalid_source"); + + thm candidates = mp_rule( + assume_rule(` + ra_valid (R:(A)ra) (a:A) ==> + exists b:A. (P:A->bool) b && ra_valid R b + `), + assume_rule(`ra_valid (R:(A)ra) (a:A)`)); + gnode valid_case = ASSUME_TAC( + validity_cases[0], + candidates, + "Hcandidate"); + valid_case = ASMP_EXISTS_TAC(valid_case, "Hcandidate", "candidate"); + valid_case = ASMP_CONJ_TAC( + valid_case, + "Hcandidate", + "HP_candidate", + "Hvalid_candidate"); + + thm replacement = ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `candidate:A`), + RA_EXCLUSIVE_UPDATE); + replacement = mp_rule( + replacement, + assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); + replacement = mp_rule( + replacement, + assume_rule(`ra_valid (R:(A)ra) (candidate:A)`)); + thm nd_replacement = ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `candidate:A`, `P:A->bool`), + RA_UPDATE_ND_OF_UPDATE); + nd_replacement = mp_rule(nd_replacement, replacement); + nd_replacement = mp_rule( + nd_replacement, + assume_rule(`(P:A->bool) (candidate:A)`)); + ACCEPT_TAC(valid_case, nd_replacement); + + thm invalid_update = mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `P:A->bool`), + RA_UPDATE_ND_INVALID), + assume_rule(`~(ra_valid (R:(A)ra) (a:A))`)); + ACCEPT_TAC(validity_cases[1], invalid_update); + return gnode_prove(root); +} + +PROOF thm RA_EXCLUSIVE_UPDATE_ND_IFF = + prove_ra_exclusive_update_nd_iff(); + /* * Abstraction computes to the supplied descriptor only when that descriptor * satisfies the laws. For an ill-formed raw descriptor `ra_abs` still @@ -2165,6 +2634,9 @@ PROOF static int audit_ra_core(void) { RA_VALID_OP_R, RA_VALID_OP, RA_CANCELLATIVE_APPLY, + RA_EXCLUSIVE_APPLY, + RA_UPDATE_APPLY, + RA_UPDATE_ND_APPLY, RA_INCLUDED_REFL, RA_INCLUDED_UNIT, RA_INCLUDED_OP_L, @@ -2175,22 +2647,30 @@ PROOF static int audit_ra_core(void) { RA_INCLUDED_OP_MONO, RA_INCLUDED_VALID, RA_INCLUDED_VALID_FRAME, + RA_INCLUDED_CANCEL_L, RA_EXCLUSIVE_INCLUDED, RA_EXCLUSIVE_IFF_INCLUDED, + RA_INVALID_EXCLUSIVE, + RA_EXCLUSIVE_VALID_OP_IFF, RA_UPDATE_ND_SINGLETON, RA_UPDATE_ND_REFL, RA_UPDATE_ND_TRANS, RA_UPDATE_ND_MONO, RA_UPDATE_ND_OF_UPDATE, RA_UPDATE_ND_VALID, + RA_UPDATE_ND_INVALID, RA_UPDATE_ND_FRAME, RA_UPDATE_ND_OP, + RA_EXCLUSIVE_UPDATE_ND_IFF, RA_EXCLUSIVE_UPDATE, RA_UPDATE_REFL, + RA_UPDATE_INVALID, RA_UPDATE_INCLUDED, RA_UPDATE_UNIT, RA_UPDATE_TRANS, + RA_UPDATE_TARGET_INCLUDED, RA_UPDATE_VALID, + RA_EXCLUSIVE_UPDATE_IFF, RA_UPDATE_FRAME, RA_UPDATE_OP); thm_list builder_theorems = THM_LIST( diff --git a/theory/logic/ra.h b/theory/logic/ra.h index 0dc59cb..8166748 100644 --- a/theory/logic/ra.h +++ b/theory/logic/ra.h @@ -68,10 +68,14 @@ PROOF extern thm ra_valid_def; /* * Inclusion / extension order (`a ≼ b`): * - * ra_included R a b <=> - * exists frame. b == ra_op R a frame + * forall (R:(A)ra) (a:A) (b:A). + * ra_included R a b <=> + * exists frame:A. b == ra_op R a frame * * Thus `a` is included in `b` when `b` can be obtained by framing `a`. + * This is an extension preorder, not in general a partial order: group-like + * commutative monoids can make distinct elements mutually included. Neither + * unitality nor `ra_cancellative R` alone supplies antisymmetry. */ PROOF extern thm ra_included_def; @@ -82,10 +86,11 @@ PROOF extern thm ra_included_def; /* * Nondeterministic frame-preserving update: * - * ra_update_nd R a P <=> - * forall frame. + * forall (R:(A)ra) (a:A) (P:A->bool). + * ra_update_nd R a P <=> + * forall frame:A. * ra_valid R (ra_op R a frame) ==> - * exists b. P b && ra_valid R (ra_op R b frame) + * exists b:A. P b && ra_valid R (ra_op R b frame) * * A result may depend on the frame, but must satisfy `P` and remain valid * with that same frame. @@ -95,8 +100,9 @@ PROOF extern thm ra_update_nd_def; /* * Deterministic frame-preserving update: * - * ra_update R a b <=> - * forall frame. + * forall (R:(A)ra) (a:A) (b:A). + * ra_update R a b <=> + * forall frame:A. * ra_valid R (ra_op R a frame) ==> * ra_valid R (ra_op R b frame) * @@ -113,8 +119,9 @@ PROOF extern thm ra_update_def; /* * Left cancellativity on valid compositions: * - * ra_cancellative R <=> - * forall frame a b. + * forall R:(A)ra. + * ra_cancellative R <=> + * forall (frame:A) (a:A) (b:A). * ra_valid R (ra_op R frame a) ==> * ra_op R frame a == ra_op R frame b ==> * a == b @@ -128,8 +135,9 @@ PROOF extern thm ra_cancellative_def; /* * Compatible-frame exclusivity: * - * ra_exclusive R a <=> - * forall frame. + * forall (R:(A)ra) (a:A). + * ra_exclusive R a <=> + * forall frame:A. * ra_valid R (ra_op R a frame) ==> * frame == ra_unit R * @@ -144,16 +152,51 @@ PROOF extern thm ra_exclusive_def; /* * Direct cancellativity application rule: * - * ra_cancellative R ==> - * ra_valid R (ra_op R frame a) ==> - * ra_op R frame a == ra_op R frame b ==> - * a == b + * forall (R:(A)ra) (frame:A) (a:A) (b:A). + * ra_cancellative R ==> + * ra_valid R (ra_op R frame a) ==> + * ra_op R frame a == ra_op R frame b ==> + * a == b * * All operands are explicit so backward proofs can specialize this rule * without unfolding the property definition. */ PROOF extern thm RA_CANCELLATIVE_APPLY; +/* + * Direct compatible-frame exclusivity elimination: + * + * forall (R:(A)ra) (a:A) (frame:A). + * ra_exclusive R a ==> + * ra_valid R (ra_op R a frame) ==> + * frame == ra_unit R + */ +PROOF extern thm RA_EXCLUSIVE_APPLY; + +/* ------------------------------------------------------------------------- */ +/* Direct update elimination */ +/* ------------------------------------------------------------------------- */ + +/* + * Direct deterministic-update elimination: + * + * forall (R:(A)ra) (a:A) (b:A) (frame:A). + * ra_update R a b ==> + * ra_valid R (ra_op R a frame) ==> + * ra_valid R (ra_op R b frame) + */ +PROOF extern thm RA_UPDATE_APPLY; + +/* + * Direct nondeterministic-update elimination: + * + * forall (R:(A)ra) (a:A) (P:A->bool) (frame:A). + * ra_update_nd R a P ==> + * ra_valid R (ra_op R a frame) ==> + * exists b:A. P b && ra_valid R (ra_op R b frame) + */ +PROOF extern thm RA_UPDATE_ND_APPLY; + /* ------------------------------------------------------------------------- */ /* Laws and validity */ /* ------------------------------------------------------------------------- */ @@ -161,7 +204,7 @@ PROOF extern thm RA_CANCELLATIVE_APPLY; /* * The bundled descriptor satisfies the complete raw law predicate: * - * forall R. ra_laws (ra_unit R) (ra_op R) (ra_valid R) + * forall R:(A)ra. ra_laws (ra_unit R) (ra_op R) (ra_valid R) * * Ordinary clients should prefer the projected rules below. `RA_LAWS` * exists as the compact interface theorem and as a bridge for generic @@ -169,40 +212,58 @@ PROOF extern thm RA_CANCELLATIVE_APPLY; */ PROOF extern thm RA_LAWS; -/* `ra_op R (ra_op R a b) c == ra_op R a (ra_op R b c)`. */ +/* + * forall (R:(A)ra) (a:A) (b:A) (c:A). + * ra_op R (ra_op R a b) c == ra_op R a (ra_op R b c) + */ PROOF extern thm RA_ASSOC; -/* `ra_op R a b == ra_op R b a`. */ +/* + * forall (R:(A)ra) (a:A) (b:A). + * ra_op R a b == ra_op R b a + */ PROOF extern thm RA_COMM; /* * Swap the final two factors while retaining a stable left prefix: * - * ra_op R (ra_op R a b) c == - * ra_op R (ra_op R a c) b + * forall (R:(A)ra) (a:A) (b:A) (c:A). + * ra_op R (ra_op R a b) c == + * ra_op R (ra_op R a c) b */ PROOF extern thm RA_OP_SWAP_RIGHT; -/* `ra_op R (ra_unit R) a == a`. */ +/* + * forall (R:(A)ra) (a:A). ra_op R (ra_unit R) a == a + */ PROOF extern thm RA_UNIT_L; -/* `ra_op R a (ra_unit R) == a`. */ +/* + * forall (R:(A)ra) (a:A). ra_op R a (ra_unit R) == a + */ PROOF extern thm RA_UNIT_R; -/* `ra_valid R (ra_unit R)`. */ +/* `forall R:(A)ra. ra_valid R (ra_unit R)`. */ PROOF extern thm RA_VALID_UNIT; -/* `ra_valid R (ra_op R a b) ==> ra_valid R a`. */ +/* + * forall (R:(A)ra) (a:A) (b:A). + * ra_valid R (ra_op R a b) ==> ra_valid R a + */ PROOF extern thm RA_VALID_OP_L; -/* `ra_valid R (ra_op R a b) ==> ra_valid R b`. */ +/* + * forall (R:(A)ra) (a:A) (b:A). + * ra_valid R (ra_op R a b) ==> ra_valid R b + */ PROOF extern thm RA_VALID_OP_R; /* * Both components of a valid composition are valid: * - * ra_valid R (ra_op R a b) ==> - * ra_valid R a && ra_valid R b + * forall (R:(A)ra) (a:A) (b:A). + * ra_valid R (ra_op R a b) ==> + * ra_valid R a && ra_valid R b * * The converse is not valid for a general RA: individually valid resources * need not be compatible with one another. @@ -213,56 +274,70 @@ PROOF extern thm RA_VALID_OP; /* Order laws */ /* ------------------------------------------------------------------------- */ -/* Reflexivity: `ra_included R a a`. */ +/* `forall (R:(A)ra) (a:A). ra_included R a a`. */ PROOF extern thm RA_INCLUDED_REFL; -/* The unit is included in every resource: `ra_included R (ra_unit R) a`. */ +/* + * Unit minimum: + * `forall (R:(A)ra) (a:A). ra_included R (ra_unit R) a`. + */ PROOF extern thm RA_INCLUDED_UNIT; -/* Left injection: `ra_included R a (ra_op R a b)`. */ +/* + * Left injection: + * `forall (R:(A)ra) (a:A) (b:A). ra_included R a (ra_op R a b)`. + */ PROOF extern thm RA_INCLUDED_OP_L; -/* Right injection: `ra_included R b (ra_op R a b)`. */ +/* + * Right injection: + * `forall (R:(A)ra) (a:A) (b:A). ra_included R b (ra_op R a b)`. + */ PROOF extern thm RA_INCLUDED_OP_R; /* * Transitivity: * - * ra_included R a b ==> - * ra_included R b c ==> - * ra_included R a c + * forall (R:(A)ra) (a:A) (b:A) (c:A). + * ra_included R a b ==> + * ra_included R b c ==> + * ra_included R a c */ PROOF extern thm RA_INCLUDED_TRANS; /* * Inclusion is monotone under composition in the left operand: * - * ra_included R a1 a2 ==> - * ra_included R (ra_op R a1 b) (ra_op R a2 b) + * forall (R:(A)ra) (a1:A) (a2:A) (b:A). + * ra_included R a1 a2 ==> + * ra_included R (ra_op R a1 b) (ra_op R a2 b) */ PROOF extern thm RA_INCLUDED_OP_MONO_L; /* * Inclusion is monotone under composition in the right operand: * - * ra_included R a1 a2 ==> - * ra_included R (ra_op R b a1) (ra_op R b a2) + * forall (R:(A)ra) (a1:A) (a2:A) (b:A). + * ra_included R a1 a2 ==> + * ra_included R (ra_op R b a1) (ra_op R b a2) */ PROOF extern thm RA_INCLUDED_OP_MONO_R; /* * Inclusion is monotone in both operands: * - * ra_included R a1 a2 ==> - * ra_included R b1 b2 ==> - * ra_included R (ra_op R a1 b1) (ra_op R a2 b2) + * forall (R:(A)ra) (a1:A) (a2:A) (b1:A) (b2:A). + * ra_included R a1 a2 ==> + * ra_included R b1 b2 ==> + * ra_included R (ra_op R a1 b1) (ra_op R a2 b2) */ PROOF extern thm RA_INCLUDED_OP_MONO; /* * Validity is downward closed under inclusion: * - * ra_included R a b ==> ra_valid R b ==> ra_valid R a + * forall (R:(A)ra) (a:A) (b:A). + * ra_included R a b ==> ra_valid R b ==> ra_valid R a */ PROOF extern thm RA_INCLUDED_VALID; @@ -270,12 +345,31 @@ PROOF extern thm RA_INCLUDED_VALID; * Every frame compatible with a larger resource is compatible with an * included resource: * - * ra_included R a b ==> - * ra_valid R (ra_op R b frame) ==> - * ra_valid R (ra_op R a frame) + * forall (R:(A)ra) (a:A) (b:A) (frame:A). + * ra_included R a b ==> + * ra_valid R (ra_op R b frame) ==> + * ra_valid R (ra_op R a frame) */ PROOF extern thm RA_INCLUDED_VALID_FRAME; +/* + * Cancel a common prefix from an inclusion between valid compositions: + * + * forall (R:(A)ra) (common:A) (a:A) (b:A). + * ra_cancellative R ==> + * ra_valid R (ra_op R common b) ==> + * ra_included + * R + * (ra_op R common a) + * (ra_op R common b) ==> + * ra_included R a b + * + * The validity premise is the one required by `ra_cancellative`; raw + * inclusion may otherwise pass through invalid extensions. Commutativity + * makes a separate right-cancellation theorem unnecessary. + */ +PROOF extern thm RA_INCLUDED_CANCEL_L; + /* ------------------------------------------------------------------------- */ /* Exclusive elements */ /* ------------------------------------------------------------------------- */ @@ -283,10 +377,11 @@ PROOF extern thm RA_INCLUDED_VALID_FRAME; /* * An exclusive element has no proper valid extension: * - * ra_exclusive R a ==> - * ra_valid R b ==> - * ra_included R a b ==> - * a == b + * forall (R:(A)ra) (a:A) (b:A). + * ra_exclusive R a ==> + * ra_valid R b ==> + * ra_included R a b ==> + * a == b * * The validity premise is essential because inclusion itself permits invalid * extensions. For example, an owned element of `excl_ra` is included in @@ -298,18 +393,41 @@ PROOF extern thm RA_EXCLUSIVE_INCLUDED; * In a cancellative RA, compatible-frame exclusivity is equivalent to * maximality among valid extensions: * - * ra_cancellative R ==> - * (ra_exclusive R a <=> - * forall b. - * ra_valid R b ==> - * ra_included R a b ==> - * a == b) + * forall (R:(A)ra) (a:A). + * ra_cancellative R ==> + * (ra_exclusive R a <=> + * forall b:A. + * ra_valid R b ==> + * ra_included R a b ==> + * a == b) * * Without cancellativity, maximality alone need not force the witnessing * frame to equal the unit: a non-unit frame may be absorbed by `a`. */ PROOF extern thm RA_EXCLUSIVE_IFF_INCLUDED; +/* + * Invalid elements are exclusive vacuously because validity is downward + * closed through composition: + * + * forall (R:(A)ra) (a:A). + * ~(ra_valid R a) ==> ra_exclusive R a + */ +PROOF extern thm RA_INVALID_EXCLUSIVE; + +/* + * Exact compatibility characterization for an exclusive element: + * + * forall (R:(A)ra) (a:A) (frame:A). + * ra_exclusive R a ==> + * (ra_valid R (ra_op R a frame) <=> + * ra_valid R a && frame == ra_unit R) + * + * This theorem makes the deliberate vacuity of `ra_exclusive` explicit: + * if `a` is invalid, both sides are false for every frame. + */ +PROOF extern thm RA_EXCLUSIVE_VALID_OP_IFF; + /* ------------------------------------------------------------------------- */ /* Nondeterministic frame-preserving update rules */ /* ------------------------------------------------------------------------- */ @@ -317,28 +435,34 @@ PROOF extern thm RA_EXCLUSIVE_IFF_INCLUDED; /* * Singleton bridge: * - * ra_update_nd R a (\x. x == b) <=> ra_update R a b + * forall (R:(A)ra) (a:A) (b:A). + * ra_update_nd R a (\x:A. x == b) <=> ra_update R a b */ PROOF extern thm RA_UPDATE_ND_SINGLETON; -/* ND reflexivity: `ra_update_nd R a (\x. x == a)`. */ +/* + * ND reflexivity: + * `forall (R:(A)ra) (a:A). ra_update_nd R a (\x:A. x == a)`. + */ PROOF extern thm RA_UPDATE_ND_REFL; /* * ND sequencing: * - * ra_update_nd R a P ==> - * (forall b. P b ==> ra_update_nd R b Q) ==> - * ra_update_nd R a Q + * forall (R:(A)ra) (a:A) (P:A->bool) (Q:A->bool). + * ra_update_nd R a P ==> + * (forall b:A. P b ==> ra_update_nd R b Q) ==> + * ra_update_nd R a Q */ PROOF extern thm RA_UPDATE_ND_TRANS; /* * Result-predicate weakening: * - * ra_update_nd R a P ==> - * (forall b. P b ==> Q b) ==> - * ra_update_nd R a Q + * forall (R:(A)ra) (a:A) (P:A->bool) (Q:A->bool). + * ra_update_nd R a P ==> + * (forall b:A. P b ==> Q b) ==> + * ra_update_nd R a Q */ PROOF extern thm RA_UPDATE_ND_MONO; @@ -346,38 +470,65 @@ PROOF extern thm RA_UPDATE_ND_MONO; * Embed a deterministic update into any result predicate containing its * target: * - * ra_update R a b ==> P b ==> ra_update_nd R a P + * forall (R:(A)ra) (a:A) (b:A) (P:A->bool). + * ra_update R a b ==> P b ==> ra_update_nd R a P */ PROOF extern thm RA_UPDATE_ND_OF_UPDATE; /* * An ND update of a valid source selects a valid result: * - * ra_update_nd R a P ==> ra_valid R a ==> - * exists b. P b && ra_valid R b + * forall (R:(A)ra) (a:A) (P:A->bool). + * ra_update_nd R a P ==> ra_valid R a ==> + * exists b:A. P b && ra_valid R b */ PROOF extern thm RA_UPDATE_ND_VALID; +/* + * Every ND update from an invalid source holds vacuously: + * + * forall (R:(A)ra) (a:A) (P:A->bool). + * ~(ra_valid R a) ==> ra_update_nd R a P + */ +PROOF extern thm RA_UPDATE_ND_INVALID; + /* * Framing an ND update: * - * ra_update_nd R a P ==> - * forall extra. - * ra_update_nd R (ra_op R a extra) - * (\x. exists b. P b && x == ra_op R b extra) + * forall (R:(A)ra) (a:A) (P:A->bool). + * ra_update_nd R a P ==> + * forall extra:A. + * ra_update_nd R (ra_op R a extra) + * (\x:A. exists b:A. P b && x == ra_op R b extra) */ PROOF extern thm RA_UPDATE_ND_FRAME; /* * Compose two independent nondeterministic updates: * - * ra_update_nd R a P ==> - * ra_update_nd R c Q ==> - * ra_update_nd R (ra_op R a c) - * (\x. exists b d. P b && Q d && x == ra_op R b d) + * forall + * (R:(A)ra) + * (a:A) (c:A) + * (P:A->bool) (Q:A->bool). + * ra_update_nd R a P ==> + * ra_update_nd R c Q ==> + * ra_update_nd R (ra_op R a c) + * (\x:A. exists b d:A. P b && Q d && x == ra_op R b d) */ PROOF extern thm RA_UPDATE_ND_OP; +/* + * For an exclusive source, ND update reduces exactly to finding an ordinary + * valid result satisfying the postcondition (guarded by source validity): + * + * forall (R:(A)ra) (a:A) (P:A->bool). + * ra_exclusive R a ==> + * (ra_update_nd R a P <=> + * (ra_valid R a ==> + * exists b:A. P b && ra_valid R b)) + */ +PROOF extern thm RA_EXCLUSIVE_UPDATE_ND_IFF; + /* ------------------------------------------------------------------------- */ /* Deterministic frame-preserving update rules */ /* ------------------------------------------------------------------------- */ @@ -385,22 +536,32 @@ PROOF extern thm RA_UPDATE_ND_OP; /* * General exclusive update law: * - * ra_exclusive R a ==> - * ra_valid R b ==> - * ra_update R a b + * forall (R:(A)ra) (a:A) (b:A). + * ra_exclusive R a ==> + * ra_valid R b ==> + * ra_update R a b * * Every frame compatible with `a` is the unit, so ordinary validity of `b` * suffices for validity of the framed target. */ PROOF extern thm RA_EXCLUSIVE_UPDATE; -/* Reflexivity: `ra_update R a a`. */ +/* `forall (R:(A)ra) (a:A). ra_update R a a`. */ PROOF extern thm RA_UPDATE_REFL; +/* + * Every deterministic update from an invalid source holds vacuously: + * + * forall (R:(A)ra) (a:A) (b:A). + * ~(ra_valid R a) ==> ra_update R a b + */ +PROOF extern thm RA_UPDATE_INVALID; + /* * Discard an extension while preserving every compatible frame: * - * ra_included R b a ==> ra_update R a b + * forall (R:(A)ra) (a:A) (b:A). + * ra_included R b a ==> ra_update R a b */ PROOF extern thm RA_UPDATE_INCLUDED; @@ -415,30 +576,58 @@ PROOF extern thm RA_UPDATE_INCLUDED; */ PROOF extern thm RA_UPDATE_UNIT; -/* Transitivity: `ra_update R a b ==> ra_update R b c ==> ra_update R a c`. */ +/* + * forall (R:(A)ra) (a:A) (b:A) (c:A). + * ra_update R a b ==> ra_update R b c ==> ra_update R a c + */ PROOF extern thm RA_UPDATE_TRANS; +/* + * A deterministic result may be weakened to any included part: + * + * forall (R:(A)ra) (a:A) (b:A) (c:A). + * ra_update R a b ==> + * ra_included R c b ==> + * ra_update R a c + */ +PROOF extern thm RA_UPDATE_TARGET_INCLUDED; + /* * Updating a valid source preserves validity: * - * ra_update R a b ==> ra_valid R a ==> ra_valid R b + * forall (R:(A)ra) (a:A) (b:A). + * ra_update R a b ==> ra_valid R a ==> ra_valid R b */ PROOF extern thm RA_UPDATE_VALID; +/* + * Exact deterministic update criterion for an exclusive source: + * + * forall (R:(A)ra) (a:A) (b:A). + * ra_exclusive R a ==> + * (ra_update R a b <=> + * (ra_valid R a ==> ra_valid R b)) + * + * The guard is essential: updates from invalid sources are vacuous. + */ +PROOF extern thm RA_EXCLUSIVE_UPDATE_IFF; + /* * Framing a deterministic update: * - * ra_update R a b ==> - * forall extra. - * ra_update R (ra_op R a extra) (ra_op R b extra) + * forall (R:(A)ra) (a:A) (b:A). + * ra_update R a b ==> + * forall extra:A. + * ra_update R (ra_op R a extra) (ra_op R b extra) */ PROOF extern thm RA_UPDATE_FRAME; /* * Compose two independent deterministic updates: * - * ra_update R a b ==> - * ra_update R c d ==> - * ra_update R (ra_op R a c) (ra_op R b d) + * forall (R:(A)ra) (a:A) (b:A) (c:A) (d:A). + * ra_update R a b ==> + * ra_update R c d ==> + * ra_update R (ra_op R a c) (ra_op R b d) */ PROOF extern thm RA_UPDATE_OP; diff --git a/theory/logic/unit_ra.c b/theory/logic/unit_ra.c index b664e7b..8d27093 100644 --- a/theory/logic/unit_ra.c +++ b/theory/logic/unit_ra.c @@ -3,6 +3,7 @@ #include "proof/proof_backward.h" #require "proof/proof_backward.c" +#require "proof/theory/logic/local_update.c" #require "proof/theory/logic/ra.c" PROOF static size_t UNIT_RA_AXIOMS_BEFORE = vector_size(get_all_axioms()); @@ -142,6 +143,31 @@ PROOF static thm prove_unit_ra_valid(void) { PROOF thm UNIT_RA_VALID = prove_unit_ra_valid(); +/* The unique carrier value extends to the unique carrier value. */ +PROOF static thm prove_unit_ra_included(void) { + term goal_tm = ` + forall a b:1. ra_included unit_ra a b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_included_def))); + body = AUTO_INTROS_TAC(body); + body = EXISTS_TAC(body, `one:1`); + thm b_is_one = spec_rule( + `b:1`, + get_theorem_by_name("one")); + thm extension_is_one = ispecl_rule( + TERM_LIST(`a:1`, `one:1`), + UNIT_RA_OP); + ACCEPT_TAC( + body, + trans_rule(b_is_one, gsym_rule(extension_is_one))); + return gnode_prove(root); +} + +PROOF thm UNIT_RA_INCLUDED = prove_unit_ra_included(); + /* Every frame in the singleton carrier is the RA unit. */ PROOF static thm prove_unit_ra_exclusive(void) { term goal_tm = ` @@ -191,6 +217,125 @@ PROOF static thm prove_unit_ra_cancellative(void) { PROOF thm UNIT_RA_CANCELLATIVE = prove_unit_ra_cancellative(); +/* All deterministic singleton updates are reflexive up to carrier equality. */ +PROOF static thm prove_unit_ra_update(void) { + term goal_tm = ` + forall a b:1. ra_update unit_ra a b + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm a_is_one = spec_rule( + `a:1`, + get_theorem_by_name("one")); + thm b_is_one = spec_rule( + `b:1`, + get_theorem_by_name("one")); + thm equal = trans_rule(a_is_one, gsym_rule(b_is_one)); + thm result = ispecl_rule( + TERM_LIST(`unit_ra`, `a:1`), + RA_UPDATE_REFL); + ACCEPT_TAC( + body, + eq_mp_rule( + beta_rule(ap_term_rule( + `\target:1. ra_update unit_ra (a:1) target`, + equal)), + result)); + return gnode_prove(root); +} + +PROOF thm UNIT_RA_UPDATE = prove_unit_ra_update(); + +/* ND update has exactly one possible result, namely `one`. */ +PROOF static thm prove_unit_ra_update_nd_iff(void) { + term goal_tm = ` + forall (a:1) (P:1->bool). + ra_update_nd unit_ra a P <=> P one + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_update_nd_def))); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hupdate"); + thm selected = spec_rule( + `one:1`, + assume_rule(` + forall frame:1. + ra_valid unit_ra (ra_op unit_ra (a:1) frame) ==> + exists b:1. + (P:1->bool) b && + ra_valid unit_ra (ra_op unit_ra b frame) + `)); + selected = mp_rule( + selected, + ispec_rule( + `ra_op unit_ra (a:1) (one:1)`, + UNIT_RA_VALID)); + forward = ASSUME_TAC(forward, selected, "Hselected"); + forward = ASMP_EXISTS_TAC(forward, "Hselected", "b"); + thm predicate = conjunct1_rule(assume_rule(` + (P:1->bool) (b:1) && + ra_valid unit_ra (ra_op unit_ra b one) + `)); + thm b_is_one = spec_rule( + `b:1`, + get_theorem_by_name("one")); + ACCEPT_TAC( + forward, + eq_mp_rule( + ap_term_rule(`P:1->bool`, b_is_one), + predicate)); + + gnode reverse = DISCH_TAC(directions[1], "Hresult"); + reverse = GEN_TAC(reverse, "frame"); + reverse = DISCH_TAC(reverse, "Hcompatible"); + reverse = EXISTS_TAC(reverse, `one:1`); + gnode_list result = CONJ_TAC(reverse); + ACCEPT_TAC(result[0], assume_rule(`(P:1->bool) one`)); + ACCEPT_TAC( + result[1], + ispec_rule( + `ra_op unit_ra (one:1) (frame:1)`, + UNIT_RA_VALID)); + return gnode_prove(root); +} + +PROOF thm UNIT_RA_UPDATE_ND_IFF = + prove_unit_ra_update_nd_iff(); + +/* Local-update obligations normalize completely in the singleton carrier. */ +PROOF static thm prove_unit_ra_local_update(void) { + term goal_tm = ` + forall source target:1#1. + ra_local_update unit_ra source target + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(ra_local_update_def))); + body = AUTO_INTROS_TAC(body); + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC( + result[0], + ispec_rule(`FST (target:1#1)`, UNIT_RA_VALID)); + thm target_is_one = spec_rule( + `FST (target:1#1)`, + get_theorem_by_name("one")); + thm extension_is_one = ispecl_rule( + TERM_LIST(`SND (target:1#1)`, `frame:1`), + UNIT_RA_OP); + ACCEPT_TAC( + result[1], + trans_rule(target_is_one, gsym_rule(extension_is_one))); + return gnode_prove(root); +} + +PROOF thm UNIT_RA_LOCAL_UPDATE = + prove_unit_ra_local_update(); + PROOF static int audit_unit_ra(void) { thm_list audited_theorems = THM_LIST( unit_ra_op_def, @@ -202,8 +347,12 @@ PROOF static int audit_unit_ra(void) { UNIT_RA_VALID_FN, UNIT_RA_OP, UNIT_RA_VALID, + UNIT_RA_INCLUDED, UNIT_RA_EXCLUSIVE, - UNIT_RA_CANCELLATIVE); + UNIT_RA_CANCELLATIVE, + UNIT_RA_UPDATE, + UNIT_RA_UPDATE_ND_IFF, + UNIT_RA_LOCAL_UPDATE); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { ENSURE_COND(!IS_NULL(audited_theorems[i]), diff --git a/theory/logic/unit_ra.h b/theory/logic/unit_ra.h index 837151a..3a27805 100644 --- a/theory/logic/unit_ra.h +++ b/theory/logic/unit_ra.h @@ -10,7 +10,7 @@ * intentionally private to `unit_ra.c`. */ -#include "proof/theory/logic/ra.h" +#include "proof/theory/logic/local_update.h" /* ------------------------------------------------------------------------- */ /* Core representation */ @@ -29,6 +29,20 @@ PROOF extern thm UNIT_RA_OP; /* `forall a:1. ra_valid unit_ra a`. */ PROOF extern thm UNIT_RA_VALID; +/* ------------------------------------------------------------------------- */ +/* Order */ +/* ------------------------------------------------------------------------- */ + +/* + * Every singleton value includes every other singleton value: + * + * forall a b:1. ra_included unit_ra a b + * + * This is stronger than generic reflexivity only syntactically: every value + * of the carrier is equal to `one`. + */ +PROOF extern thm UNIT_RA_INCLUDED; + /* ------------------------------------------------------------------------- */ /* Exclusive elements */ /* ------------------------------------------------------------------------- */ @@ -60,6 +74,28 @@ PROOF extern thm UNIT_RA_CANCELLATIVE; /* ------------------------------------------------------------------------- */ /* - * Unit-resource updates are discharged by the generic update rules in - * `ra.h`; no raw representation theorem is exposed here. + * Every deterministic update is possible: + * + * forall a b:1. ra_update unit_ra a b + */ +PROOF extern thm UNIT_RA_UPDATE; + +/* + * An ND update is possible exactly when its predicate contains the unique + * result: + * + * forall (a:1) (P:1->bool). + * ra_update_nd unit_ra a P <=> P one + */ +PROOF extern thm UNIT_RA_UPDATE_ND_IFF; + +/* + * Every local update between singleton pairs is possible: + * + * forall source target:1#1. + * ra_local_update unit_ra source target + * + * Both pairs are necessarily the same pair `(one,one)`, so this is the + * generic reflexive local update after singleton elimination. */ +PROOF extern thm UNIT_RA_LOCAL_UPDATE; -- Gitee From 16bf3e7df2c361e6ac0e9fbea3a2c97c7cb41177 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Mon, 10 Aug 2026 15:55:41 +0800 Subject: [PATCH 27/35] theory: add iterated separating conjunctions --- theory/logic/big_sep.c | 2964 ++++++++++++++++++++++++++++++++++++++++ theory/logic/big_sep.h | 372 +++++ 2 files changed, 3336 insertions(+) create mode 100644 theory/logic/big_sep.c create mode 100644 theory/logic/big_sep.h diff --git a/theory/logic/big_sep.c b/theory/logic/big_sep.c new file mode 100644 index 0000000..8bf46f8 --- /dev/null +++ b/theory/logic/big_sep.c @@ -0,0 +1,2964 @@ +#include "proof/theory/logic/big_sep.h" + +#include "proof/proof_backward.h" +#include "proof/theory/data/list.h" +#require "proof/proof_backward.c" +#require "proof/theory/data/list.c" +#require "proof/theory/logic/finmap.c" +#require "proof/theory/logic/resource_prop.c" + +PROOF static size_t BIG_SEP_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF static thm prove_reflexive_equality_goal(term goal_tm) { + ENSURE_COND(is_eq(goal_tm), "big-sep goal is not an equality"); + struct dest_eq_results equality = dest_eq(goal_tm); + ENSURE_COND( + alpha_compare(equality.tm1, equality.tm2) == 0, + "big-sep equality is not reflexive"); + return refl_rule(equality.tm1); +err: + ERR_FUN_PUTS( + "prove_reflexive_equality_goal", + cstr_term(goal_tm)); + return empty_theorem; +} + +/* Canonical AC package expected by the kernel's `ac_rule`. */ +PROOF static thm prove_r_sep_ac(void) { + term R = `R:(A)ra`; + term P = `P:A->bool`; + term Q = `Q:A->bool`; + term S = `S:A->bool`; + + thm commute = ispecl_rule( + TERM_LIST(R, P, Q), + R_SEP_COMM); + thm associate = ispecl_rule( + TERM_LIST(R, P, Q, S), + R_SEP_ASSOC); + thm expose_pair = gsym_rule(associate); + thm swap_pair = beta_rule(ap_term_rule( + `\pair:A->bool. + r_sep (R:(A)ra) pair (S:A->bool)`, + commute)); + thm regroup = ispecl_rule( + TERM_LIST(R, Q, P, S), + R_SEP_ASSOC); + thm left_commute = trans_rule( + expose_pair, + trans_rule(swap_pair, regroup)); + return conj_rule( + commute, + conj_rule(associate, left_commute)); +} + +PROOF static thm R_SEP_AC = + prove_r_sep_ac(); + +/* + * HOL's iteration theorems conventionally use type variable `A` for their + * index. Resource propositions also use `A` for the RA carrier, so first + * alpha-rename the theorem's index type to keep later specialization from + * accidentally identifying the two roles. + */ +PROOF static thm freshen_iterate_index_type(thm theorem) { + type_pair_list types = (type_pair_list)vector_create(); + vector_add(&types, ((type_pair){`:D`, `:A`})); + return inst_type_rule(types, theorem); +} + +PROOF thm r_big_sep_listi_from_def = new_rec_definition( + get_theorem_by_name("list_RECURSION"), + ` + (r_big_sep_listi_from + (R:(A)ra) + (Phi:num->B->A->bool) + (offset:num) + ([]:(B)list) = + r_emp R) && + (r_big_sep_listi_from + R + Phi + offset + ((x:B) :: (xs:(B)list)) = + r_sep + R + (Phi offset x) + (r_big_sep_listi_from R Phi (SUC offset) xs)) + `); + +PROOF thm r_big_sep_listi_def = new_fun_definition(` + r_big_sep_listi + (R:(A)ra) + (Phi:num->B->A->bool) + (xs:(B)list) = + r_big_sep_listi_from R Phi 0 xs +`); + +PROOF thm r_big_sep_def = new_rec_definition( + get_theorem_by_name("list_RECURSION"), + ` + (r_big_sep + (R:(A)ra) + ([]:(A->bool)list) = + r_emp R) && + (r_big_sep + R + ((P:A->bool) :: (Ps:(A->bool)list)) = + r_sep R P (r_big_sep R Ps)) + `); + +PROOF thm r_big_sep_list_def = new_fun_definition(` + r_big_sep_list + (R:(A)ra) + (Phi:B->A->bool) + (xs:(B)list) = + r_big_sep R (MAP Phi xs) +`); + +PROOF thm r_big_sep_set_def = new_fun_definition(` + r_big_sep_set + (R:(A)ra) + (Phi:B->A->bool) + (s:B->bool) = + iterate (r_sep R) s Phi +`); + +PROOF thm r_big_sep_map_value_def = new_fun_definition(` + r_big_sep_map_value + (m:(K,V)finmap) + (key:K) = + (@value:V. finmap_lookup m key == SOME value) +`); + +PROOF thm r_big_sep_map_def = new_fun_definition(` + r_big_sep_map + (R:(A)ra) + (Phi:K->V->A->bool) + (m:(K,V)finmap) = + r_big_sep_set + R + (\key:K. Phi key (r_big_sep_map_value m key)) + (finmap_dom m) +`); + +PROOF static thm prove_r_big_sep_nil(void) { + gnode root = gnode_new_with_ccl(` + forall R:(A)ra. + r_big_sep R ([]:(A->bool)list) == r_emp R + `); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + r_big_sep_def, + conjunct1_rule(r_big_sep_def)))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_NIL = + prove_r_big_sep_nil(); + +PROOF static thm prove_r_big_sep_cons(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (P:A->bool) + (Ps:(A->bool)list). + r_big_sep R (P :: Ps) == + r_sep R P (r_big_sep R Ps) + `); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + r_big_sep_def))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_CONS = + prove_r_big_sep_cons(); + +PROOF static thm prove_r_big_sep_singleton(void) { + term R = `R:(A)ra`; + term P = `P:A->bool`; + thm unfold = ispecl_rule( + TERM_LIST(R, P, `[]:(A->bool)list`), + R_BIG_SEP_CONS); + thm empty_tail = beta_rule(ap_term_rule( + `\Q:A->bool. r_sep (R:(A)ra) (P:A->bool) Q`, + ispec_rule(R, R_BIG_SEP_NIL))); + thm result = trans_rule( + unfold, + trans_rule( + empty_tail, + ispecl_rule(TERM_LIST(R, P), R_SEP_EMP_R))); + result = gen_rule(P, result); + return gen_rule(R, result); +} + +PROOF thm R_BIG_SEP_SINGLETON = + prove_r_big_sep_singleton(); + +PROOF static thm prove_r_big_sep_append(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (left:(A->bool)list) + (right:(A->bool)list). + r_big_sep R (APPEND left right) == + r_sep R (r_big_sep R left) (r_big_sep R right) + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "left"); + gnode_list cases = INDUCT_TAC(body, `left:(A->bool)list`); + + gnode base = AUTO_INTROS_TAC(cases[0]); + base = CONV_TAC( + base, + pure_rewrite_conv(THM_LIST( + HOL_APPEND, + R_BIG_SEP_NIL, + R_SEP_EMP_L))); + RULE_TAC(base, prove_reflexive_equality_goal); + + gnode step = AUTO_INTROS_TAC(cases[1]); + step = CONV_WITH_ASMP_TAC( + step, + pure_rewrite_conv, + THM_LIST( + HOL_APPEND, + R_BIG_SEP_CONS, + R_SEP_ASSOC)); + RULE_TAC(step, prove_reflexive_equality_goal); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_APPEND = + prove_r_big_sep_append(); + +PROOF static thm prove_r_big_sep_snoc(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Ps:(A->bool)list) + (P:A->bool). + r_big_sep R (APPEND Ps (P :: [])) == + r_sep R (r_big_sep R Ps) P + `); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + R_BIG_SEP_APPEND, + R_BIG_SEP_SINGLETON))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_SNOC = + prove_r_big_sep_snoc(); + +PROOF static thm prove_r_big_sep_reverse(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (Ps:(A->bool)list). + r_big_sep R (REVERSE Ps) == r_big_sep R Ps + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Ps"); + gnode_list cases = INDUCT_TAC(body, `Ps:(A->bool)list`); + + CONV_TAC( + cases[0], + rewrite_conv(THM_LIST( + HOL_REVERSE, + R_BIG_SEP_NIL))); + + gnode step = AUTO_INTROS_TAC(cases[1]); + CONV_WITH_ASMP_TAC( + step, + rewrite_conv, + THM_LIST( + HOL_REVERSE, + R_BIG_SEP_SNOC, + R_BIG_SEP_CONS, + R_SEP_COMM)); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_REVERSE = + prove_r_big_sep_reverse(); + +PROOF static thm prove_r_big_sep_swap_head(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (P:A->bool) + (Q:A->bool) + (Ps:(A->bool)list). + r_big_sep R (P :: Q :: Ps) == + r_big_sep R (Q :: P :: Ps) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(R_BIG_SEP_CONS))); + ACCEPT_TAC( + body, + ac_rule(R_SEP_AC, goal_ccl(body->g))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_SWAP_HEAD = + prove_r_big_sep_swap_head(); + +PROOF static thm prove_r_big_sep_list_nil(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (Phi:B->A->bool). + r_big_sep_list R Phi ([]:(B)list) == r_emp R + `); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + r_big_sep_list_def, + get_theorem_by_name("MAP"), + R_BIG_SEP_NIL))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LIST_NIL = + prove_r_big_sep_list_nil(); + +PROOF static thm prove_r_big_sep_list_cons(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:B->A->bool) + (x:B) + (xs:(B)list). + r_big_sep_list R Phi (x :: xs) == + r_sep R (Phi x) (r_big_sep_list R Phi xs) + `); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + r_big_sep_list_def, + get_theorem_by_name("MAP"), + R_BIG_SEP_CONS))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LIST_CONS = + prove_r_big_sep_list_cons(); + +PROOF static thm prove_r_big_sep_list_singleton(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (Phi:B->A->bool) (x:B). + r_big_sep_list R Phi (x :: []) == Phi x + `); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + R_BIG_SEP_LIST_CONS, + R_BIG_SEP_LIST_NIL, + R_SEP_EMP_R))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LIST_SINGLETON = + prove_r_big_sep_list_singleton(); + +PROOF static thm prove_r_big_sep_list_append(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:B->A->bool) + (left:(B)list) + (right:(B)list). + r_big_sep_list R Phi (APPEND left right) == + r_sep + R + (r_big_sep_list R Phi left) + (r_big_sep_list R Phi right) + `); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + r_big_sep_list_def, + get_theorem_by_name("MAP_APPEND"), + R_BIG_SEP_APPEND))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LIST_APPEND = + prove_r_big_sep_list_append(); + +PROOF static thm prove_r_big_sep_list_reverse(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (Phi:B->A->bool) (xs:(B)list). + r_big_sep_list R Phi (REVERSE xs) == + r_big_sep_list R Phi xs + `); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + r_big_sep_list_def, + gsym_rule(get_theorem_by_name("MAP_REVERSE")), + R_BIG_SEP_REVERSE))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LIST_REVERSE = + prove_r_big_sep_list_reverse(); + +PROOF static thm prove_r_big_sep_list_swap_head(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:B->A->bool) + (x:B) + (y:B) + (xs:(B)list). + r_big_sep_list R Phi (x :: y :: xs) == + r_big_sep_list R Phi (y :: x :: xs) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(R_BIG_SEP_LIST_CONS))); + ACCEPT_TAC( + body, + ac_rule(R_SEP_AC, goal_ccl(body->g))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LIST_SWAP_HEAD = + prove_r_big_sep_list_swap_head(); + +PROOF static thm prove_r_big_sep_list_mono(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:B->A->bool) + (Psi:B->A->bool) + (xs:(B)list). + (forall x:B. + r_entails R (Phi x) (Psi x)) ==> + r_entails + R + (r_big_sep_list R Phi xs) + (r_big_sep_list R Psi xs) + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "Psi"); + body = GEN_TAC(body, "xs"); + gnode_list cases = INDUCT_TAC(body, `xs:(B)list`); + + gnode base = DISCH_TAC(cases[0], "Hpointwise"); + base = CONV_TAC( + base, + pure_rewrite_conv(THM_LIST(R_BIG_SEP_LIST_NIL))); + ACCEPT_TAC( + base, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `r_emp (R:(A)ra)`), + R_ENTAILS_REFL)); + + gnode step = DISCH_TAC(cases[1], "Hpointwise"); + step = CONV_TAC( + step, + pure_rewrite_conv(THM_LIST(R_BIG_SEP_LIST_CONS))); + thm head_entails = spec_rule( + `a0:B`, + assume_rule(` + forall x:B. + r_entails + (R:(A)ra) + ((Phi:B->A->bool) x) + ((Psi:B->A->bool) x) + `)); + thm tail_entails = mp_rule( + assume_rule(` + (forall x:B. + r_entails + (R:(A)ra) + ((Phi:B->A->bool) x) + ((Psi:B->A->bool) x)) ==> + r_entails + R + (r_big_sep_list R Phi (a1:(B)list)) + (r_big_sep_list R Psi a1) + `), + assume_rule(` + forall x:B. + r_entails + (R:(A)ra) + ((Phi:B->A->bool) x) + ((Psi:B->A->bool) x) + `)); + thm result = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `(Phi:B->A->bool) (a0:B)`, + `(Psi:B->A->bool) (a0:B)`, + `r_big_sep_list + (R:(A)ra) + (Phi:B->A->bool) + (a1:(B)list)`, + `r_big_sep_list + (R:(A)ra) + (Psi:B->A->bool) + (a1:(B)list)`), + R_SEP_MONO), + head_entails), + tail_entails); + ACCEPT_TAC(step, result); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LIST_MONO = + prove_r_big_sep_list_mono(); + +PROOF static thm prove_r_big_sep_list_mono_on(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:B->A->bool) + (Psi:B->A->bool) + (xs:(B)list). + (forall x:B. + MEM x xs ==> + r_entails R (Phi x) (Psi x)) ==> + r_entails + R + (r_big_sep_list R Phi xs) + (r_big_sep_list R Psi xs) + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "Psi"); + body = GEN_TAC(body, "xs"); + gnode_list cases = INDUCT_TAC(body, `xs:(B)list`); + + gnode base = DISCH_TAC(cases[0], "Hpointwise"); + base = CONV_TAC( + base, + pure_rewrite_conv(THM_LIST(R_BIG_SEP_LIST_NIL))); + ACCEPT_TAC( + base, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `r_emp (R:(A)ra)`), + R_ENTAILS_REFL)); + + gnode step = DISCH_TAC(cases[1], "Hpointwise"); + step = CONV_TAC( + step, + pure_rewrite_conv(THM_LIST(R_BIG_SEP_LIST_CONS))); + thm pointwise = assume_rule(` + forall x:B. + MEM x ((a0:B) :: (a1:(B)list)) ==> + r_entails + (R:(A)ra) + ((Phi:B->A->bool) x) + ((Psi:B->A->bool) x) + `); + thm mem_head_equiv = apply_conversion( + pure_rewrite_conv(THM_LIST(get_theorem_by_name("MEM"))), + `MEM (a0:B) ((a0:B) :: (a1:(B)list))`); + thm mem_head_disjunction = disj1_rule( + refl_rule(`a0:B`), + `MEM (a0:B) (a1:(B)list)`); + thm mem_head = eq_mp_rule( + gsym_rule(mem_head_equiv), + mem_head_disjunction); + thm head_entails = mp_rule( + spec_rule(`a0:B`, pointwise), + mem_head); + + term x = `x:B`; + term mem_tail_tm = `MEM (x:B) (a1:(B)list)`; + thm mem_tail = assume_rule(mem_tail_tm); + thm mem_tail_equiv = apply_conversion( + pure_rewrite_conv(THM_LIST(get_theorem_by_name("MEM"))), + `MEM (x:B) ((a0:B) :: (a1:(B)list))`); + thm mem_whole = eq_mp_rule( + gsym_rule(mem_tail_equiv), + disj2_rule(`(x:B) == (a0:B)`, mem_tail)); + thm entails_at_x = mp_rule( + spec_rule(x, pointwise), + mem_whole); + thm tail_pointwise = gen_rule( + x, + disch_rule(mem_tail_tm, entails_at_x)); + thm tail_entails = mp_rule( + assume_rule(` + (forall x:B. + MEM x (a1:(B)list) ==> + r_entails + (R:(A)ra) + ((Phi:B->A->bool) x) + ((Psi:B->A->bool) x)) ==> + r_entails + R + (r_big_sep_list R Phi a1) + (r_big_sep_list R Psi a1) + `), + tail_pointwise); + thm result = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `(Phi:B->A->bool) (a0:B)`, + `(Psi:B->A->bool) (a0:B)`, + `r_big_sep_list + (R:(A)ra) + (Phi:B->A->bool) + (a1:(B)list)`, + `r_big_sep_list + (R:(A)ra) + (Psi:B->A->bool) + (a1:(B)list)`), + R_SEP_MONO), + head_entails), + tail_entails); + ACCEPT_TAC(step, result); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LIST_MONO_ON = + prove_r_big_sep_list_mono_on(); + +PROOF static thm prove_r_big_sep_list_equiv(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:B->A->bool) + (Psi:B->A->bool) + (xs:(B)list). + (forall x:B. + r_equiv R (Phi x) (Psi x)) ==> + r_equiv + R + (r_big_sep_list R Phi xs) + (r_big_sep_list R Psi xs) + `); + gnode body = AUTO_INTROS_TAC(root); + thm pointwise_equiv = assume_rule(` + forall x:B. + r_equiv + (R:(A)ra) + ((Phi:B->A->bool) x) + ((Psi:B->A->bool) x) + `); + + term x = `x:B`; + thm at_x = spec_rule(x, pointwise_equiv); + thm both_at_x = rewrite_rule( + THM_LIST(r_equiv_def), + at_x); + thm forward_pointwise = gen_rule( + x, + conjunct1_rule(both_at_x)); + thm reverse_pointwise = gen_rule( + x, + conjunct2_rule(both_at_x)); + + thm forward = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Phi:B->A->bool`, + `Psi:B->A->bool`, + `xs:(B)list`), + R_BIG_SEP_LIST_MONO), + forward_pointwise); + thm reverse = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Psi:B->A->bool`, + `Phi:B->A->bool`, + `xs:(B)list`), + R_BIG_SEP_LIST_MONO), + reverse_pointwise); + thm result = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_big_sep_list + (R:(A)ra) + (Phi:B->A->bool) + (xs:(B)list)`, + `r_big_sep_list + (R:(A)ra) + (Psi:B->A->bool) + (xs:(B)list)`), + R_EQUIV_INTRO), + forward), + reverse); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LIST_EQUIV = + prove_r_big_sep_list_equiv(); + +PROOF static thm prove_r_big_sep_list_equiv_on(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:B->A->bool) + (Psi:B->A->bool) + (xs:(B)list). + (forall x:B. + MEM x xs ==> + r_equiv R (Phi x) (Psi x)) ==> + r_equiv + R + (r_big_sep_list R Phi xs) + (r_big_sep_list R Psi xs) + `); + gnode body = AUTO_INTROS_TAC(root); + thm pointwise_equiv = assume_rule(` + forall x:B. + MEM x (xs:(B)list) ==> + r_equiv + (R:(A)ra) + ((Phi:B->A->bool) x) + ((Psi:B->A->bool) x) + `); + term x = `x:B`; + term member_tm = `MEM (x:B) (xs:(B)list)`; + thm member = assume_rule(member_tm); + thm at_x = mp_rule( + spec_rule(x, pointwise_equiv), + member); + thm both_at_x = rewrite_rule( + THM_LIST(r_equiv_def), + at_x); + thm forward_pointwise = gen_rule( + x, + disch_rule(member_tm, conjunct1_rule(both_at_x))); + thm reverse_pointwise = gen_rule( + x, + disch_rule(member_tm, conjunct2_rule(both_at_x))); + thm forward = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Phi:B->A->bool`, + `Psi:B->A->bool`, + `xs:(B)list`), + R_BIG_SEP_LIST_MONO_ON), + forward_pointwise); + thm reverse = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Psi:B->A->bool`, + `Phi:B->A->bool`, + `xs:(B)list`), + R_BIG_SEP_LIST_MONO_ON), + reverse_pointwise); + thm result = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_big_sep_list + (R:(A)ra) + (Phi:B->A->bool) + (xs:(B)list)`, + `r_big_sep_list + (R:(A)ra) + (Psi:B->A->bool) + (xs:(B)list)`), + R_EQUIV_INTRO), + forward), + reverse); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LIST_EQUIV_ON = + prove_r_big_sep_list_equiv_on(); + +PROOF static thm prove_r_big_sep_list_map(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:B->A->bool) + (f:C->B) + (xs:(C)list). + r_big_sep_list R Phi (MAP f xs) == + r_big_sep_list R (\x:C. Phi (f x)) xs + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "f"); + body = GEN_TAC(body, "xs"); + gnode_list cases = INDUCT_TAC(body, `xs:(C)list`); + + CONV_TAC( + cases[0], + rewrite_conv(THM_LIST( + get_theorem_by_name("MAP"), + R_BIG_SEP_LIST_NIL))); + gnode step = CONV_WITH_ASMP_TAC( + cases[1], + rewrite_conv, + THM_LIST( + get_theorem_by_name("MAP"), + R_BIG_SEP_LIST_CONS)); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LIST_MAP = + prove_r_big_sep_list_map(); + +PROOF static thm prove_r_big_sep_list_emp(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (xs:(B)list). + r_big_sep_list R (\x:B. r_emp R) xs == r_emp R + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "xs"); + gnode_list cases = INDUCT_TAC(body, `xs:(B)list`); + + CONV_TAC( + cases[0], + rewrite_conv(THM_LIST(R_BIG_SEP_LIST_NIL))); + gnode step = CONV_WITH_ASMP_TAC( + cases[1], + rewrite_conv, + THM_LIST( + R_BIG_SEP_LIST_CONS, + R_SEP_EMP_L)); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LIST_EMP = + prove_r_big_sep_list_emp(); + +PROOF static thm prove_r_big_sep_list_sep(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:B->A->bool) + (Psi:B->A->bool) + (xs:(B)list). + r_big_sep_list + R + (\x:B. r_sep R (Phi x) (Psi x)) + xs == + r_sep + R + (r_big_sep_list R Phi xs) + (r_big_sep_list R Psi xs) + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "Psi"); + body = GEN_TAC(body, "xs"); + gnode_list cases = INDUCT_TAC(body, `xs:(B)list`); + + CONV_TAC( + cases[0], + rewrite_conv(THM_LIST( + R_BIG_SEP_LIST_NIL, + R_SEP_EMP_L))); + + gnode step = CONV_WITH_ASMP_TAC( + cases[1], + pure_rewrite_conv, + THM_LIST(R_BIG_SEP_LIST_CONS)); + step = CONV_TAC( + step, + depth_conv(get_conversion_by_name("BETA_CONV"))); + ACCEPT_TAC( + step, + ac_rule(R_SEP_AC, goal_ccl(step->g))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LIST_SEP = + prove_r_big_sep_list_sep(); + +/* ------------------------------------------------------------------------- */ +/* Finite-set binders */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_r_sep_neutral_for_big_sep(void) { + gnode root = gnode_new_with_ccl(` + forall R:(A)ra. + neutral (r_sep R) == r_emp R + `); + gnode body = GEN_TAC(root, "R"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST( + get_theorem_by_name("neutral")))); + body = MATCH_MP_TAC( + body, + get_theorem_by_name("SELECT_UNIQUE")); + body = GEN_TAC(body, "P"); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hunit"); + thm unit_at_emp = spec_rule( + `r_emp (R:(A)ra)`, + beta_rule(assume_rule(gnode_get_asmps( + forward, + CONST_STRING_LIST("Hunit"))[0]))); + thm sep_p_emp_is_emp = conjunct1_rule(unit_at_emp); + thm sep_p_emp_is_p = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `P:A->bool`), + R_SEP_EMP_R); + ACCEPT_TAC( + forward, + trans_rule( + gsym_rule(sep_p_emp_is_p), + sep_p_emp_is_emp)); + + gnode reverse = DISCH_TAC(directions[1], "Heq"); + reverse = CONV_TAC( + reverse, + depth_conv(get_conversion_by_name("BETA_CONV"))); + reverse = GEN_TAC(reverse, "Q"); + CONV_WITH_ASMP_TAC( + reverse, + rewrite_conv, + THM_LIST( + R_SEP_EMP_L, + R_SEP_EMP_R)); + return gnode_prove(root); +} + +PROOF static thm R_SEP_NEUTRAL_FOR_BIG_SEP = + prove_r_sep_neutral_for_big_sep(); + +PROOF static thm prove_r_sep_monoidal_for_big_sep(void) { + gnode root = gnode_new_with_ccl(` + forall R:(A)ra. + monoidal (r_sep R) + `); + gnode body = GEN_TAC(root, "R"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST( + get_theorem_by_name("monoidal"), + R_SEP_NEUTRAL_FOR_BIG_SEP))); + gnode_list outer = CONJ_TAC(body); + ACCEPT_TAC( + outer[0], + ispec_rule(`R:(A)ra`, R_SEP_COMM)); + + gnode_list inner = CONJ_TAC(outer[1]); + term P = `P:A->bool`; + term Q = `Q:A->bool`; + term S = `S:A->bool`; + thm associate = gsym_rule(ispecl_rule( + TERM_LIST( + `R:(A)ra`, + P, + Q, + S), + R_SEP_ASSOC)); + associate = gen_rule(S, associate); + associate = gen_rule(Q, associate); + associate = gen_rule(P, associate); + ACCEPT_TAC(inner[0], associate); + ACCEPT_TAC( + inner[1], + ispec_rule(`R:(A)ra`, R_SEP_EMP_L)); + return gnode_prove(root); +} + +PROOF static thm R_SEP_MONOIDAL_FOR_BIG_SEP = + prove_r_sep_monoidal_for_big_sep(); + +PROOF static thm prove_r_big_sep_set_empty(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (Phi:B->A->bool). + r_big_sep_set R Phi ({}:B->bool) == r_emp R + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(r_big_sep_set_def))); + thm clauses = mp_rule( + ispec_rule( + `r_sep (R:(A)ra)`, + freshen_iterate_index_type( + get_theorem_by_name("ITERATE_CLAUSES"))), + ispec_rule( + `R:(A)ra`, + R_SEP_MONOIDAL_FOR_BIG_SEP)); + thm empty = ispec_rule( + `Phi:B->A->bool`, + conjunct1_rule(clauses)); + ACCEPT_TAC( + body, + trans_rule( + empty, + ispec_rule( + `R:(A)ra`, + R_SEP_NEUTRAL_FOR_BIG_SEP))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_SET_EMPTY = + prove_r_big_sep_set_empty(); + +PROOF static thm prove_r_big_sep_set_insert(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:B->A->bool) + (x:B) + (s:B->bool). + FINITE s ==> + ~(x IN s) ==> + r_big_sep_set R Phi (x INSERT s) == + r_sep R (Phi x) (r_big_sep_set R Phi s) + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "x"); + body = GEN_TAC(body, "s"); + body = DISCH_TAC(body, "Hfinite"); + body = DISCH_TAC(body, "Hfresh"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(r_big_sep_set_def))); + thm clauses = mp_rule( + ispec_rule( + `r_sep (R:(A)ra)`, + freshen_iterate_index_type( + get_theorem_by_name("ITERATE_CLAUSES"))), + ispec_rule( + `R:(A)ra`, + R_SEP_MONOIDAL_FOR_BIG_SEP)); + thm inserted = ispecl_rule( + TERM_LIST( + `Phi:B->A->bool`, + `x:B`, + `s:B->bool`), + conjunct2_rule(clauses)); + inserted = mp_rule( + inserted, + assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Hfinite"))[0])); + inserted = rewrite_rule( + THM_LIST(assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Hfresh"))[0])), + inserted); + ACCEPT_TAC(body, inserted); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_SET_INSERT = + prove_r_big_sep_set_insert(); + +PROOF static thm prove_r_big_sep_set_singleton(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (Phi:B->A->bool) (x:B). + r_big_sep_set R Phi {x} == Phi x + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "x"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(r_big_sep_set_def))); + thm singleton = mp_rule( + ispec_rule( + `r_sep (R:(A)ra)`, + freshen_iterate_index_type( + get_theorem_by_name("ITERATE_SING"))), + ispec_rule( + `R:(A)ra`, + R_SEP_MONOIDAL_FOR_BIG_SEP)); + singleton = ispecl_rule( + TERM_LIST( + `Phi:B->A->bool`, + `x:B`), + singleton); + ACCEPT_TAC(body, singleton); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_SET_SINGLETON = + prove_r_big_sep_set_singleton(); + +PROOF static thm prove_r_big_sep_set_union(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:B->A->bool) + (left:B->bool) + (right:B->bool). + FINITE left /\ FINITE right /\ DISJOINT left right ==> + r_big_sep_set R Phi (left UNION right) == + r_sep + R + (r_big_sep_set R Phi left) + (r_big_sep_set R Phi right) + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "left"); + body = GEN_TAC(body, "right"); + body = DISCH_TAC(body, "Hsets"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(r_big_sep_set_def))); + thm union_fold = mp_rule( + ispec_rule( + `r_sep (R:(A)ra)`, + freshen_iterate_index_type( + get_theorem_by_name("ITERATE_UNION"))), + ispec_rule( + `R:(A)ra`, + R_SEP_MONOIDAL_FOR_BIG_SEP)); + union_fold = ispecl_rule( + TERM_LIST( + `Phi:B->A->bool`, + `left:B->bool`, + `right:B->bool`), + union_fold); + ACCEPT_TAC( + body, + mp_rule( + union_fold, + assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Hsets"))[0]))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_SET_UNION = + prove_r_big_sep_set_union(); + +PROOF static thm prove_r_big_sep_set_eq(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:B->A->bool) + (Psi:B->A->bool) + (s:B->bool). + (forall x:B. x IN s ==> Phi x == Psi x) ==> + r_big_sep_set R Phi s == r_big_sep_set R Psi s + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(r_big_sep_set_def))); + thm iterate_eq = mp_rule( + ispec_rule( + `r_sep (R:(A)ra)`, + freshen_iterate_index_type( + get_theorem_by_name("ITERATE_EQ"))), + ispec_rule( + `R:(A)ra`, + R_SEP_MONOIDAL_FOR_BIG_SEP)); + iterate_eq = ispecl_rule( + TERM_LIST( + `Phi:B->A->bool`, + `Psi:B->A->bool`, + `s:B->bool`), + iterate_eq); + ACCEPT_TAC( + body, + mp_rule( + iterate_eq, + assume_rule(` + forall x:B. + x IN (s:B->bool) ==> + (Phi:B->A->bool) x == (Psi:B->A->bool) x + `))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_SET_EQ = + prove_r_big_sep_set_eq(); + +PROOF static thm prove_r_entails_iterate_related(void) { + gnode root = gnode_new_with_ccl(` + forall R:(A)ra. + r_entails + R + (neutral (r_sep R)) + (neutral (r_sep R)) /\ + (forall + (P1:A->bool) + (Q1:A->bool) + (P2:A->bool) + (Q2:A->bool). + r_entails R P1 P2 /\ r_entails R Q1 Q2 ==> + r_entails + R + (r_sep R P1 Q1) + (r_sep R P2 Q2)) + `); + gnode body = GEN_TAC(root, "R"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST( + R_SEP_NEUTRAL_FOR_BIG_SEP))); + gnode_list laws = CONJ_TAC(body); + ACCEPT_TAC( + laws[0], + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_emp (R:(A)ra)`), + R_ENTAILS_REFL)); + + gnode closure = GEN_TAC(laws[1], "P1"); + closure = GEN_TAC(closure, "Q1"); + closure = GEN_TAC(closure, "P2"); + closure = GEN_TAC(closure, "Q2"); + closure = DISCH_TAC(closure, "Hboth"); + closure = ASMP_CONJ_TAC( + closure, + "Hboth", + "Hleft", + "Hright"); + thm monotone = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `P1:A->bool`, + `P2:A->bool`, + `Q1:A->bool`, + `Q2:A->bool`), + R_SEP_MONO); + monotone = mp_rule( + monotone, + assume_rule(gnode_get_asmps( + closure, + CONST_STRING_LIST("Hleft"))[0])); + monotone = mp_rule( + monotone, + assume_rule(gnode_get_asmps( + closure, + CONST_STRING_LIST("Hright"))[0])); + ACCEPT_TAC(closure, monotone); + return gnode_prove(root); +} + +PROOF static thm R_ENTAILS_ITERATE_RELATED = + prove_r_entails_iterate_related(); + +PROOF static thm prove_r_big_sep_set_mono(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:B->A->bool) + (Psi:B->A->bool) + (s:B->bool). + FINITE s ==> + (forall x:B. + x IN s ==> + r_entails R (Phi x) (Psi x)) ==> + r_entails + R + (r_big_sep_set R Phi s) + (r_big_sep_set R Psi s) + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "Psi"); + body = GEN_TAC(body, "s"); + body = DISCH_TAC(body, "Hfinite"); + body = DISCH_TAC(body, "Hpointwise"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(r_big_sep_set_def))); + + thm related = mp_rule( + ispec_rule( + `r_sep (R:(A)ra)`, + freshen_iterate_index_type( + get_theorem_by_name("ITERATE_RELATED"))), + ispec_rule( + `R:(A)ra`, + R_SEP_MONOIDAL_FOR_BIG_SEP)); + related = ispec_rule( + `r_entails (R:(A)ra)`, + related); + related = mp_rule( + related, + ispec_rule( + `R:(A)ra`, + R_ENTAILS_ITERATE_RELATED)); + related = ispecl_rule( + TERM_LIST( + `Phi:B->A->bool`, + `Psi:B->A->bool`, + `s:B->bool`), + related); + thm premises = conj_rule( + assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Hfinite"))[0]), + assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Hpointwise"))[0])); + ACCEPT_TAC(body, mp_rule(related, premises)); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_SET_MONO = + prove_r_big_sep_set_mono(); + +PROOF static thm prove_r_big_sep_set_equiv(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:B->A->bool) + (Psi:B->A->bool) + (s:B->bool). + FINITE s ==> + (forall x:B. + x IN s ==> + r_equiv R (Phi x) (Psi x)) ==> + r_equiv + R + (r_big_sep_set R Phi s) + (r_big_sep_set R Psi s) + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "Psi"); + body = GEN_TAC(body, "s"); + body = DISCH_TAC(body, "Hfinite"); + body = DISCH_TAC(body, "Hpointwise"); + + thm pointwise_equiv = assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Hpointwise"))[0]); + term x = `x:B`; + term member_tm = `x IN (s:B->bool)`; + thm member = assume_rule(member_tm); + thm at_x = mp_rule( + spec_rule(x, pointwise_equiv), + member); + thm both_at_x = rewrite_rule( + THM_LIST(r_equiv_def), + at_x); + thm forward_pointwise = gen_rule( + x, + disch_rule( + member_tm, + conjunct1_rule(both_at_x))); + thm reverse_pointwise = gen_rule( + x, + disch_rule( + member_tm, + conjunct2_rule(both_at_x))); + thm finite = assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Hfinite"))[0]); + + thm forward = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Phi:B->A->bool`, + `Psi:B->A->bool`, + `s:B->bool`), + R_BIG_SEP_SET_MONO); + forward = mp_rule(mp_rule(forward, finite), forward_pointwise); + thm reverse = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Psi:B->A->bool`, + `Phi:B->A->bool`, + `s:B->bool`), + R_BIG_SEP_SET_MONO); + reverse = mp_rule(mp_rule(reverse, finite), reverse_pointwise); + thm result = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_big_sep_set + (R:(A)ra) + (Phi:B->A->bool) + (s:B->bool)`, + `r_big_sep_set + (R:(A)ra) + (Psi:B->A->bool) + (s:B->bool)`), + R_EQUIV_INTRO); + result = mp_rule(mp_rule(result, forward), reverse); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_SET_EQUIV = + prove_r_big_sep_set_equiv(); + +PROOF static thm prove_r_big_sep_set_emp(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (s:B->bool). + r_big_sep_set R (\x:B. r_emp R) s == r_emp R + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "s"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(r_big_sep_set_def))); + thm neutral = ispec_rule( + `R:(A)ra`, + R_SEP_NEUTRAL_FOR_BIG_SEP); + term x = `x:B`; + term member = `x IN (s:B->bool)`; + thm all_neutral = gen_rule( + x, + disch_rule( + member, + gsym_rule(neutral))); + thm all_emp = mp_rule( + ispec_rule( + `r_sep (R:(A)ra)`, + freshen_iterate_index_type( + get_theorem_by_name("ITERATE_EQ_NEUTRAL"))), + ispec_rule( + `R:(A)ra`, + R_SEP_MONOIDAL_FOR_BIG_SEP)); + all_emp = ispecl_rule( + TERM_LIST( + `\x:B. r_emp (R:(A)ra)`, + `s:B->bool`), + all_emp); + all_emp = beta_rule(all_emp); + ACCEPT_TAC( + body, + trans_rule( + mp_rule(all_emp, all_neutral), + neutral)); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_SET_EMP = + prove_r_big_sep_set_emp(); + +PROOF static thm prove_r_big_sep_set_sep(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:B->A->bool) + (Psi:B->A->bool) + (s:B->bool). + FINITE s ==> + r_big_sep_set + R + (\x:B. r_sep R (Phi x) (Psi x)) + s == + r_sep + R + (r_big_sep_set R Phi s) + (r_big_sep_set R Psi s) + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "Psi"); + body = GEN_TAC(body, "s"); + body = DISCH_TAC(body, "Hfinite"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(r_big_sep_set_def))); + thm distribute = mp_rule( + ispec_rule( + `r_sep (R:(A)ra)`, + freshen_iterate_index_type( + get_theorem_by_name("ITERATE_OP"))), + ispec_rule( + `R:(A)ra`, + R_SEP_MONOIDAL_FOR_BIG_SEP)); + distribute = ispecl_rule( + TERM_LIST( + `Phi:B->A->bool`, + `Psi:B->A->bool`, + `s:B->bool`), + distribute); + ACCEPT_TAC( + body, + mp_rule( + distribute, + assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Hfinite"))[0]))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_SET_SEP = + prove_r_big_sep_set_sep(); + +/* ------------------------------------------------------------------------- */ +/* Finite-map binders */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_r_big_sep_map_value(void) { + gnode root = gnode_new_with_ccl(` + forall + (m:(K,V)finmap) + (key:K) + (value:V). + finmap_lookup m key == SOME value ==> + r_big_sep_map_value m key == value + `); + gnode body = GEN_TAC(root, "m"); + body = GEN_TAC(body, "key"); + body = GEN_TAC(body, "value"); + body = DISCH_TAC(body, "Hlookup"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST( + r_big_sep_map_value_def))); + + term predicate = ` + \candidate:V. + finmap_lookup (m:(K,V)finmap) (key:K) == SOME candidate + `; + thm selected = ispecl_rule( + TERM_LIST( + predicate, + `value:V`), + get_theorem_by_name("SELECT_AX")); + selected = beta_rule(selected); + selected = mp_rule( + selected, + assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Hlookup"))[0])); + thm selected_some = trans_rule( + gsym_rule(selected), + assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Hlookup"))[0])); + thm selected_value = rewrite_rule( + THM_LIST(get_theorem_by_name("option_INJ")), + selected_some); + ACCEPT_TAC(body, selected_value); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_MAP_VALUE = + prove_r_big_sep_map_value(); + +PROOF static thm prove_r_big_sep_map_value_lookup(void) { + gnode root = gnode_new_with_ccl(` + forall (m:(K,V)finmap) (key:K). + key IN finmap_dom m ==> + finmap_lookup m key == + SOME (r_big_sep_map_value m key) + `); + gnode body = GEN_TAC(root, "m"); + body = GEN_TAC(body, "key"); + body = DISCH_TAC(body, "Hdom"); + thm payload_exists = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `key:K`, + `m:(K,V)finmap`), + FINMAP_IN_DOM_SOME), + assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Hdom"))[0])); + body = ASSUME_TAC(body, payload_exists, "Hpayload"); + body = ASMP_EXISTS_TAC(body, "Hpayload", "value"); + + thm lookup = assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Hpayload"))[0]); + thm picked = mp_rule( + ispecl_rule( + TERM_LIST( + `m:(K,V)finmap`, + `key:K`, + `value:V`), + R_BIG_SEP_MAP_VALUE), + lookup); + thm picked_some = ap_term_rule( + `SOME:V->V option`, + picked); + ACCEPT_TAC( + body, + trans_rule( + lookup, + gsym_rule(picked_some))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_MAP_VALUE_LOOKUP = + prove_r_big_sep_map_value_lookup(); + +PROOF static thm prove_r_big_sep_map_empty(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (Phi:K->V->A->bool). + r_big_sep_map + R + Phi + (finmap_empty:(K,V)finmap) == + r_emp R + `); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + r_big_sep_map_def, + FINMAP_DOM_EMPTY, + R_BIG_SEP_SET_EMPTY))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_MAP_EMPTY = + prove_r_big_sep_map_empty(); + +PROOF static thm prove_not_equal_of_member_not_member(void) { + gnode root = gnode_new_with_ccl(` + forall (s:K->bool) (absent:K) (present:K). + ~(absent IN s) ==> + present IN s ==> + ~(present == absent) + `); + gnode body = GEN_TAC(root, "s"); + body = GEN_TAC(body, "absent"); + body = GEN_TAC(body, "present"); + body = DISCH_TAC(body, "Habsent"); + body = DISCH_TAC(body, "Hpresent"); + body = DISCH_TAC(body, "Heq"); + thm member_eq = ap_term_rule( + `\key:K. key IN (s:K->bool)`, + assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Heq"))[0])); + member_eq = beta_rule(member_eq); + thm absent_member = eq_mp_rule( + member_eq, + assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Hpresent"))[0])); + thm contradiction = not_elim_rule( + assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Habsent"))[0]), + absent_member); + CONTR_TAC(body, contradiction); + return gnode_prove(root); +} + +PROOF static thm NOT_EQUAL_OF_MEMBER_NOT_MEMBER = + prove_not_equal_of_member_not_member(); + +PROOF static thm prove_r_big_sep_map_insert(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:K->V->A->bool) + (key:K) + (value:V) + (m:(K,V)finmap). + finmap_lookup m key == NONE ==> + r_big_sep_map R Phi (finmap_insert key value m) == + r_sep + R + (Phi key value) + (r_big_sep_map R Phi m) + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "key"); + body = GEN_TAC(body, "value"); + body = GEN_TAC(body, "m"); + body = DISCH_TAC(body, "Hfresh_lookup"); + + thm fresh_lookup = assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Hfresh_lookup"))[0]); + thm fresh_key = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `key:K`, + `m:(K,V)finmap`), + FINMAP_NOT_IN_DOM)), + fresh_lookup); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST( + r_big_sep_map_def, + FINMAP_DOM_INSERT))); + + term inserted_family = ` + \current:K. + (Phi:K->V->A->bool) + current + (r_big_sep_map_value + (finmap_insert + (key:K) + (value:V) + (m:(K,V)finmap)) + current) + `; + term old_family = ` + \current:K. + (Phi:K->V->A->bool) + current + (r_big_sep_map_value (m:(K,V)finmap) current) + `; + thm insert_fold = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + inserted_family, + `key:K`, + `finmap_dom (m:(K,V)finmap)`), + R_BIG_SEP_SET_INSERT); + insert_fold = mp_rule( + insert_fold, + ispec_rule( + `m:(K,V)finmap`, + FINMAP_DOM_FINITE)); + insert_fold = mp_rule(insert_fold, fresh_key); + insert_fold = beta_rule(insert_fold); + + thm inserted_at_key = ispecl_rule( + TERM_LIST( + `key:K`, + `value:V`, + `m:(K,V)finmap`), + FINMAP_INSERT_LOOKUP_EQ); + thm head_value = mp_rule( + ispecl_rule( + TERM_LIST( + `finmap_insert + (key:K) + (value:V) + (m:(K,V)finmap)`, + `key:K`, + `value:V`), + R_BIG_SEP_MAP_VALUE), + inserted_at_key); + + term current = `current:K`; + term current_member_tm = ` + current IN finmap_dom (m:(K,V)finmap) + `; + thm current_member = assume_rule(current_member_tm); + thm current_ne_key = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `finmap_dom (m:(K,V)finmap)`, + `key:K`, + current), + NOT_EQUAL_OF_MEMBER_NOT_MEMBER), + fresh_key), + current_member); + thm same_lookup = mp_rule( + ispecl_rule( + TERM_LIST( + `key:K`, + `value:V`, + `m:(K,V)finmap`, + current), + FINMAP_INSERT_LOOKUP_NE), + current_ne_key); + thm old_selected_lookup = mp_rule( + ispecl_rule( + TERM_LIST( + `m:(K,V)finmap`, + current), + R_BIG_SEP_MAP_VALUE_LOOKUP), + current_member); + thm inserted_selected_lookup = trans_rule( + same_lookup, + old_selected_lookup); + thm same_value = mp_rule( + ispecl_rule( + TERM_LIST( + `finmap_insert + (key:K) + (value:V) + (m:(K,V)finmap)`, + current, + `r_big_sep_map_value + (m:(K,V)finmap) + (current:K)`), + R_BIG_SEP_MAP_VALUE), + inserted_selected_lookup); + thm same_assertion = ap_term_rule( + `\selected:V. + (Phi:K->V->A->bool) (current:K) selected`, + same_value); + same_assertion = beta_rule(same_assertion); + thm tail_pointwise = gen_rule( + current, + disch_rule( + current_member_tm, + same_assertion)); + thm tail_lift = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + inserted_family, + old_family, + `finmap_dom (m:(K,V)finmap)`), + R_BIG_SEP_SET_EQ); + tail_lift = beta_rule(tail_lift); + thm tail_fold = mp_rule( + tail_lift, + tail_pointwise); + tail_fold = beta_rule(tail_fold); + + thm result = rewrite_rule( + THM_LIST( + head_value, + tail_fold), + insert_fold); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_MAP_INSERT = + prove_r_big_sep_map_insert(); + +PROOF static thm prove_r_big_sep_map_singleton(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:K->V->A->bool) + (key:K) + (value:V). + r_big_sep_map R Phi (finmap_singleton key value) == + Phi key value + `); + gnode body = AUTO_INTROS_TAC(root); + thm singleton = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Phi:K->V->A->bool`, + `key:K`, + `value:V`, + `finmap_empty:(K,V)finmap`), + R_BIG_SEP_MAP_INSERT), + ispec_rule( + `key:K`, + FINMAP_EMPTY_LOOKUP)); + singleton = rewrite_rule( + THM_LIST( + FINMAP_INSERT_EMPTY, + R_BIG_SEP_MAP_EMPTY, + R_SEP_EMP_R), + singleton); + ACCEPT_TAC(body, singleton); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_MAP_SINGLETON = + prove_r_big_sep_map_singleton(); + +PROOF static thm prove_r_big_sep_map_delete(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:K->V->A->bool) + (m:(K,V)finmap) + (key:K) + (value:V). + finmap_lookup m key == SOME value ==> + r_big_sep_map R Phi m == + r_sep + R + (Phi key value) + (r_big_sep_map R Phi (finmap_delete key m)) + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "m"); + body = GEN_TAC(body, "key"); + body = GEN_TAC(body, "value"); + body = DISCH_TAC(body, "Hlookup"); + thm lookup = assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Hlookup"))[0]); + thm extracted = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Phi:K->V->A->bool`, + `key:K`, + `value:V`, + `finmap_delete (key:K) (m:(K,V)finmap)`), + R_BIG_SEP_MAP_INSERT), + ispecl_rule( + TERM_LIST( + `key:K`, + `m:(K,V)finmap`), + FINMAP_DELETE_LOOKUP_EQ)); + thm decomposed = mp_rule( + ispecl_rule( + TERM_LIST( + `key:K`, + `value:V`, + `m:(K,V)finmap`), + FINMAP_DECOMPOSE), + lookup); + thm same_fold = ap_term_rule( + `\map:(K,V)finmap. + r_big_sep_map + (R:(A)ra) + (Phi:K->V->A->bool) + map`, + decomposed); + same_fold = beta_rule(same_fold); + ACCEPT_TAC( + body, + trans_rule( + gsym_rule(same_fold), + extracted)); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_MAP_DELETE = + prove_r_big_sep_map_delete(); + +PROOF static thm prove_r_big_sep_map_eq(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:K->V->A->bool) + (Psi:K->V->A->bool) + (m:(K,V)finmap). + (forall (key:K) (value:V). + finmap_lookup m key == SOME value ==> + Phi key value == Psi key value) ==> + r_big_sep_map R Phi m == r_big_sep_map R Psi m + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "Psi"); + body = GEN_TAC(body, "m"); + body = DISCH_TAC(body, "Hpointwise"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(r_big_sep_map_def))); + + thm pointwise = assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Hpointwise"))[0]); + term key = `key:K`; + term member_tm = `key IN finmap_dom (m:(K,V)finmap)`; + thm member = assume_rule(member_tm); + thm selected_lookup = mp_rule( + ispecl_rule( + TERM_LIST( + `m:(K,V)finmap`, + key), + R_BIG_SEP_MAP_VALUE_LOOKUP), + member); + thm at_key = spec_rule(key, pointwise); + at_key = spec_rule( + `r_big_sep_map_value (m:(K,V)finmap) (key:K)`, + at_key); + at_key = mp_rule(at_key, selected_lookup); + thm on_domain = gen_rule( + key, + disch_rule(member_tm, at_key)); + + term phi_family = ` + \key:K. + (Phi:K->V->A->bool) + key + (r_big_sep_map_value (m:(K,V)finmap) key) + `; + term psi_family = ` + \key:K. + (Psi:K->V->A->bool) + key + (r_big_sep_map_value (m:(K,V)finmap) key) + `; + thm lift = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + phi_family, + psi_family, + `finmap_dom (m:(K,V)finmap)`), + R_BIG_SEP_SET_EQ); + lift = beta_rule(lift); + ACCEPT_TAC(body, mp_rule(lift, on_domain)); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_MAP_EQ = + prove_r_big_sep_map_eq(); + +PROOF static thm prove_r_big_sep_map_mono(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:K->V->A->bool) + (Psi:K->V->A->bool) + (m:(K,V)finmap). + (forall (key:K) (value:V). + finmap_lookup m key == SOME value ==> + r_entails R (Phi key value) (Psi key value)) ==> + r_entails + R + (r_big_sep_map R Phi m) + (r_big_sep_map R Psi m) + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "Psi"); + body = GEN_TAC(body, "m"); + body = DISCH_TAC(body, "Hpointwise"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(r_big_sep_map_def))); + + thm pointwise = assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Hpointwise"))[0]); + term key = `key:K`; + term member_tm = `key IN finmap_dom (m:(K,V)finmap)`; + thm member = assume_rule(member_tm); + thm selected_lookup = mp_rule( + ispecl_rule( + TERM_LIST( + `m:(K,V)finmap`, + key), + R_BIG_SEP_MAP_VALUE_LOOKUP), + member); + thm at_key = spec_rule(key, pointwise); + at_key = spec_rule( + `r_big_sep_map_value (m:(K,V)finmap) (key:K)`, + at_key); + at_key = mp_rule(at_key, selected_lookup); + thm on_domain = gen_rule( + key, + disch_rule(member_tm, at_key)); + + term phi_family = ` + \key:K. + (Phi:K->V->A->bool) + key + (r_big_sep_map_value (m:(K,V)finmap) key) + `; + term psi_family = ` + \key:K. + (Psi:K->V->A->bool) + key + (r_big_sep_map_value (m:(K,V)finmap) key) + `; + thm lift = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + phi_family, + psi_family, + `finmap_dom (m:(K,V)finmap)`), + R_BIG_SEP_SET_MONO); + lift = beta_rule(lift); + lift = mp_rule( + lift, + ispec_rule( + `m:(K,V)finmap`, + FINMAP_DOM_FINITE)); + ACCEPT_TAC(body, mp_rule(lift, on_domain)); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_MAP_MONO = + prove_r_big_sep_map_mono(); + +PROOF static thm prove_r_big_sep_map_equiv(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:K->V->A->bool) + (Psi:K->V->A->bool) + (m:(K,V)finmap). + (forall (key:K) (value:V). + finmap_lookup m key == SOME value ==> + r_equiv R (Phi key value) (Psi key value)) ==> + r_equiv + R + (r_big_sep_map R Phi m) + (r_big_sep_map R Psi m) + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "Psi"); + body = GEN_TAC(body, "m"); + body = DISCH_TAC(body, "Hpointwise"); + + thm pointwise_equiv = assume_rule(gnode_get_asmps( + body, + CONST_STRING_LIST("Hpointwise"))[0]); + term key = `key:K`; + term value = `value:V`; + term lookup_tm = ` + finmap_lookup (m:(K,V)finmap) (key:K) == SOME (value:V) + `; + thm lookup = assume_rule(lookup_tm); + thm at_binding = spec_rule(key, pointwise_equiv); + at_binding = spec_rule(value, at_binding); + at_binding = mp_rule(at_binding, lookup); + thm both_at_binding = rewrite_rule( + THM_LIST(r_equiv_def), + at_binding); + thm forward_binding = gen_rule( + key, + gen_rule( + value, + disch_rule( + lookup_tm, + conjunct1_rule(both_at_binding)))); + thm reverse_binding = gen_rule( + key, + gen_rule( + value, + disch_rule( + lookup_tm, + conjunct2_rule(both_at_binding)))); + + thm forward = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Phi:K->V->A->bool`, + `Psi:K->V->A->bool`, + `m:(K,V)finmap`), + R_BIG_SEP_MAP_MONO), + forward_binding); + thm reverse = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Psi:K->V->A->bool`, + `Phi:K->V->A->bool`, + `m:(K,V)finmap`), + R_BIG_SEP_MAP_MONO), + reverse_binding); + thm result = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_big_sep_map + (R:(A)ra) + (Phi:K->V->A->bool) + (m:(K,V)finmap)`, + `r_big_sep_map + (R:(A)ra) + (Psi:K->V->A->bool) + (m:(K,V)finmap)`), + R_EQUIV_INTRO); + result = mp_rule(mp_rule(result, forward), reverse); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_MAP_EQUIV = + prove_r_big_sep_map_equiv(); + +PROOF static thm prove_r_big_sep_map_emp(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (m:(K,V)finmap). + r_big_sep_map R (\key:K. \value:V. r_emp R) m == + r_emp R + `); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + r_big_sep_map_def, + R_BIG_SEP_SET_EMP))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_MAP_EMP = + prove_r_big_sep_map_emp(); + +PROOF static thm prove_r_big_sep_map_sep(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:K->V->A->bool) + (Psi:K->V->A->bool) + (m:(K,V)finmap). + r_big_sep_map + R + (\key:K. \value:V. + r_sep R (Phi key value) (Psi key value)) + m == + r_sep + R + (r_big_sep_map R Phi m) + (r_big_sep_map R Psi m) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(r_big_sep_map_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + term phi_family = ` + \key:K. + (Phi:K->V->A->bool) + key + (r_big_sep_map_value (m:(K,V)finmap) key) + `; + term psi_family = ` + \key:K. + (Psi:K->V->A->bool) + key + (r_big_sep_map_value (m:(K,V)finmap) key) + `; + thm distribute = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + phi_family, + psi_family, + `finmap_dom (m:(K,V)finmap)`), + R_BIG_SEP_SET_SEP); + distribute = beta_rule(distribute); + distribute = mp_rule( + distribute, + ispec_rule( + `m:(K,V)finmap`, + FINMAP_DOM_FINITE)); + ACCEPT_TAC(body, distribute); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_MAP_SEP = + prove_r_big_sep_map_sep(); + +PROOF static thm prove_r_big_sep_listi_nil(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (Phi:num->B->A->bool). + r_big_sep_listi R Phi ([]:(B)list) == r_emp R + `); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + r_big_sep_listi_def, + conjunct1_rule(r_big_sep_listi_from_def)))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LISTI_NIL = + prove_r_big_sep_listi_nil(); + +PROOF static thm prove_r_big_sep_listi_cons(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:num->B->A->bool) + (x:B) + (xs:(B)list). + r_big_sep_listi R Phi (x :: xs) == + r_sep + R + (Phi 0 x) + (r_big_sep_listi_from R Phi 1 xs) + `); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + r_big_sep_listi_def, + r_big_sep_listi_from_def, + get_theorem_by_name("ONE")))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LISTI_CONS = + prove_r_big_sep_listi_cons(); + +PROOF static thm prove_r_big_sep_listi_from_append(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:num->B->A->bool) + (left:(B)list) + (offset:num) + (right:(B)list). + r_big_sep_listi_from R Phi offset (APPEND left right) == + r_sep + R + (r_big_sep_listi_from R Phi offset left) + (r_big_sep_listi_from + R + Phi + (offset + LENGTH left) + right) + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "left"); + gnode_list cases = INDUCT_TAC(body, `left:(B)list`); + + gnode base = AUTO_INTROS_TAC(cases[0]); + CONV_TAC( + base, + rewrite_conv(THM_LIST( + HOL_APPEND, + HOL_LENGTH, + r_big_sep_listi_from_def, + get_theorem_by_name("ADD_CLAUSES"), + R_SEP_EMP_L))); + + gnode step = AUTO_INTROS_TAC(cases[1]); + CONV_WITH_ASMP_TAC( + step, + rewrite_conv, + THM_LIST( + HOL_APPEND, + HOL_LENGTH, + r_big_sep_listi_from_def, + get_theorem_by_name("ADD_CLAUSES"), + R_SEP_ASSOC)); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LISTI_FROM_APPEND = + prove_r_big_sep_listi_from_append(); + +PROOF static thm prove_r_big_sep_listi_append(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:num->B->A->bool) + (left:(B)list) + (right:(B)list). + r_big_sep_listi R Phi (APPEND left right) == + r_sep + R + (r_big_sep_listi R Phi left) + (r_big_sep_listi_from R Phi (LENGTH left) right) + `); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + r_big_sep_listi_def, + R_BIG_SEP_LISTI_FROM_APPEND, + get_theorem_by_name("ADD_CLAUSES")))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LISTI_APPEND = + prove_r_big_sep_listi_append(); + +PROOF static thm prove_r_big_sep_listi_singleton(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (Phi:num->B->A->bool) (x:B). + r_big_sep_listi R Phi (x :: []) == Phi 0 x + `); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + R_BIG_SEP_LISTI_CONS, + r_big_sep_listi_from_def, + R_SEP_EMP_R))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LISTI_SINGLETON = + prove_r_big_sep_listi_singleton(); + +/* A private two-offset form makes the public shift law an immediate + * specialization at the second offset `0`. */ +PROOF static thm prove_r_big_sep_listi_from_compose(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:num->B->A->bool) + (xs:(B)list) + (base:num) + (offset:num). + r_big_sep_listi_from R Phi (base + offset) xs == + r_big_sep_listi_from + R + (\index:num. \x:B. Phi (base + index) x) + offset + xs + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "xs"); + gnode_list cases = INDUCT_TAC(body, `xs:(B)list`); + + gnode base_case = AUTO_INTROS_TAC(cases[0]); + base_case = CONV_TAC( + base_case, + pure_rewrite_conv(THM_LIST(r_big_sep_listi_from_def))); + RULE_TAC(base_case, prove_reflexive_equality_goal); + + gnode step = AUTO_INTROS_TAC(cases[1]); + step = CONV_TAC( + step, + pure_rewrite_conv(THM_LIST(r_big_sep_listi_from_def))); + step = CONV_TAC( + step, + depth_conv(get_conversion_by_name("BETA_CONV"))); + + thm add_suc = ispecl_rule( + TERM_LIST(`base:num`, `offset:num`), + conjunct2_rule(conjunct2_rule(conjunct2_rule( + get_theorem_by_name("ADD_CLAUSES"))))); + thm align_offset = beta_rule(ap_term_rule( + `\index:num. + r_big_sep_listi_from + (R:(A)ra) + (Phi:num->B->A->bool) + index + (a1:(B)list)`, + gsym_rule(add_suc))); + thm induction_at_successor = spec_rule( + `SUC (offset:num)`, + spec_rule( + `base:num`, + assume_rule(` + forall base offset. + r_big_sep_listi_from + (R:(A)ra) + (Phi:num->B->A->bool) + (base + offset) + (a1:(B)list) == + r_big_sep_listi_from + R + (\index:num. \x:B. Phi (base + index) x) + offset + a1 + `))); + thm tail_equality = trans_rule( + align_offset, + induction_at_successor); + thm result = beta_rule(ap_term_rule( + `\tail:A->bool. + r_sep + (R:(A)ra) + ((Phi:num->B->A->bool) + ((base:num) + (offset:num)) + (a0:B)) + tail`, + tail_equality)); + ACCEPT_TAC(step, result); + return gnode_prove(root); +} + +PROOF static thm R_BIG_SEP_LISTI_FROM_COMPOSE = + prove_r_big_sep_listi_from_compose(); + +PROOF static thm prove_r_big_sep_listi_from_shift(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:num->B->A->bool) + (offset:num) + (xs:(B)list). + r_big_sep_listi_from R Phi offset xs == + r_big_sep_listi + R + (\index:num. \x:B. Phi (offset + index) x) + xs + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(r_big_sep_listi_def))); + thm result = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Phi:num->B->A->bool`, + `xs:(B)list`, + `offset:num`, + `0`), + R_BIG_SEP_LISTI_FROM_COMPOSE); + result = rewrite_rule( + THM_LIST(get_theorem_by_name("ADD_CLAUSES")), + result); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LISTI_FROM_SHIFT = + prove_r_big_sep_listi_from_shift(); + +PROOF static thm prove_r_big_sep_listi_cons_shift(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:num->B->A->bool) + (x:B) + (xs:(B)list). + r_big_sep_listi R Phi (x :: xs) == + r_sep + R + (Phi 0 x) + (r_big_sep_listi + R + (\index:num. \y:B. Phi (SUC index) y) + xs) + `); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + R_BIG_SEP_LISTI_CONS, + R_BIG_SEP_LISTI_FROM_SHIFT, + get_theorem_by_name("ONE"), + get_theorem_by_name("ADD_CLAUSES")))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LISTI_CONS_SHIFT = + prove_r_big_sep_listi_cons_shift(); + +PROOF static thm prove_r_big_sep_listi_append_shift(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:num->B->A->bool) + (left:(B)list) + (right:(B)list). + r_big_sep_listi R Phi (APPEND left right) == + r_sep + R + (r_big_sep_listi R Phi left) + (r_big_sep_listi + R + (\index:num. \x:B. + Phi (LENGTH left + index) x) + right) + `); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + R_BIG_SEP_LISTI_APPEND, + R_BIG_SEP_LISTI_FROM_SHIFT))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LISTI_APPEND_SHIFT = + prove_r_big_sep_listi_append_shift(); + +PROOF static thm prove_r_big_sep_listi_from_mono(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:num->B->A->bool) + (Psi:num->B->A->bool) + (xs:(B)list) + (offset:num). + (forall index:num. forall x:B. + r_entails R (Phi index x) (Psi index x)) ==> + r_entails + R + (r_big_sep_listi_from R Phi offset xs) + (r_big_sep_listi_from R Psi offset xs) + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "Psi"); + body = GEN_TAC(body, "xs"); + gnode_list cases = INDUCT_TAC(body, `xs:(B)list`); + + gnode base_case = GEN_TAC(cases[0], "offset"); + base_case = DISCH_TAC(base_case, "Hpointwise"); + base_case = CONV_TAC( + base_case, + pure_rewrite_conv(THM_LIST(r_big_sep_listi_from_def))); + ACCEPT_TAC( + base_case, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `r_emp (R:(A)ra)`), + R_ENTAILS_REFL)); + + gnode step = GEN_TAC(cases[1], "offset"); + step = DISCH_TAC(step, "Hpointwise"); + step = CONV_TAC( + step, + pure_rewrite_conv(THM_LIST(r_big_sep_listi_from_def))); + thm pointwise = assume_rule(` + forall index:num. forall x:B. + r_entails + (R:(A)ra) + ((Phi:num->B->A->bool) index x) + ((Psi:num->B->A->bool) index x) + `); + thm head_entails = spec_rule( + `a0:B`, + spec_rule(`offset:num`, pointwise)); + thm tail_entails = mp_rule( + spec_rule( + `SUC (offset:num)`, + assume_rule(` + forall offset:num. + (forall index:num. forall x:B. + r_entails + (R:(A)ra) + ((Phi:num->B->A->bool) index x) + ((Psi:num->B->A->bool) index x)) ==> + r_entails + R + (r_big_sep_listi_from R Phi offset (a1:(B)list)) + (r_big_sep_listi_from R Psi offset a1) + `)), + pointwise); + thm result = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `(Phi:num->B->A->bool) (offset:num) (a0:B)`, + `(Psi:num->B->A->bool) (offset:num) (a0:B)`, + `r_big_sep_listi_from + (R:(A)ra) + (Phi:num->B->A->bool) + (SUC (offset:num)) + (a1:(B)list)`, + `r_big_sep_listi_from + (R:(A)ra) + (Psi:num->B->A->bool) + (SUC (offset:num)) + (a1:(B)list)`), + R_SEP_MONO), + head_entails), + tail_entails); + ACCEPT_TAC(step, result); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LISTI_FROM_MONO = + prove_r_big_sep_listi_from_mono(); + +PROOF static thm prove_r_big_sep_listi_mono(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:num->B->A->bool) + (Psi:num->B->A->bool) + (xs:(B)list). + (forall index:num. forall x:B. + r_entails R (Phi index x) (Psi index x)) ==> + r_entails + R + (r_big_sep_listi R Phi xs) + (r_big_sep_listi R Psi xs) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(r_big_sep_listi_def))); + thm result = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Phi:num->B->A->bool`, + `Psi:num->B->A->bool`, + `xs:(B)list`, + `0`), + R_BIG_SEP_LISTI_FROM_MONO), + assume_rule(` + forall index:num. forall x:B. + r_entails + (R:(A)ra) + ((Phi:num->B->A->bool) index x) + ((Psi:num->B->A->bool) index x) + `)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LISTI_MONO = + prove_r_big_sep_listi_mono(); + +PROOF static thm prove_r_big_sep_listi_from_equiv(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:num->B->A->bool) + (Psi:num->B->A->bool) + (xs:(B)list) + (offset:num). + (forall index:num. forall x:B. + r_equiv R (Phi index x) (Psi index x)) ==> + r_equiv + R + (r_big_sep_listi_from R Phi offset xs) + (r_big_sep_listi_from R Psi offset xs) + `); + gnode body = AUTO_INTROS_TAC(root); + thm pointwise_equiv = assume_rule(` + forall index:num. forall x:B. + r_equiv + (R:(A)ra) + ((Phi:num->B->A->bool) index x) + ((Psi:num->B->A->bool) index x) + `); + term index = `index:num`; + term x = `x:B`; + thm at_x = spec_rule( + x, + spec_rule(index, pointwise_equiv)); + thm both_at_x = rewrite_rule( + THM_LIST(r_equiv_def), + at_x); + thm forward_pointwise = gen_rule( + index, + gen_rule(x, conjunct1_rule(both_at_x))); + thm reverse_pointwise = gen_rule( + index, + gen_rule(x, conjunct2_rule(both_at_x))); + thm forward = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Phi:num->B->A->bool`, + `Psi:num->B->A->bool`, + `xs:(B)list`, + `offset:num`), + R_BIG_SEP_LISTI_FROM_MONO), + forward_pointwise); + thm reverse = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Psi:num->B->A->bool`, + `Phi:num->B->A->bool`, + `xs:(B)list`, + `offset:num`), + R_BIG_SEP_LISTI_FROM_MONO), + reverse_pointwise); + thm result = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_big_sep_listi_from + (R:(A)ra) + (Phi:num->B->A->bool) + (offset:num) + (xs:(B)list)`, + `r_big_sep_listi_from + (R:(A)ra) + (Psi:num->B->A->bool) + (offset:num) + (xs:(B)list)`), + R_EQUIV_INTRO), + forward), + reverse); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LISTI_FROM_EQUIV = + prove_r_big_sep_listi_from_equiv(); + +PROOF static thm prove_r_big_sep_listi_equiv(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:num->B->A->bool) + (Psi:num->B->A->bool) + (xs:(B)list). + (forall index:num. forall x:B. + r_equiv R (Phi index x) (Psi index x)) ==> + r_equiv + R + (r_big_sep_listi R Phi xs) + (r_big_sep_listi R Psi xs) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(r_big_sep_listi_def))); + thm result = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Phi:num->B->A->bool`, + `Psi:num->B->A->bool`, + `xs:(B)list`, + `0`), + R_BIG_SEP_LISTI_FROM_EQUIV), + assume_rule(` + forall index:num. forall x:B. + r_equiv + (R:(A)ra) + ((Phi:num->B->A->bool) index x) + ((Psi:num->B->A->bool) index x) + `)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LISTI_EQUIV = + prove_r_big_sep_listi_equiv(); + +PROOF static thm prove_r_big_sep_listi_from_sep(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:num->B->A->bool) + (Psi:num->B->A->bool) + (xs:(B)list) + (offset:num). + r_big_sep_listi_from + R + (\index:num. \x:B. + r_sep R (Phi index x) (Psi index x)) + offset + xs == + r_sep + R + (r_big_sep_listi_from R Phi offset xs) + (r_big_sep_listi_from R Psi offset xs) + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "Psi"); + body = GEN_TAC(body, "xs"); + gnode_list cases = INDUCT_TAC(body, `xs:(B)list`); + + gnode base_case = GEN_TAC(cases[0], "offset"); + CONV_TAC( + base_case, + rewrite_conv(THM_LIST( + r_big_sep_listi_from_def, + R_SEP_EMP_L))); + + gnode step = GEN_TAC(cases[1], "offset"); + step = CONV_WITH_ASMP_TAC( + step, + pure_rewrite_conv, + THM_LIST(r_big_sep_listi_from_def)); + step = CONV_TAC( + step, + depth_conv(get_conversion_by_name("BETA_CONV"))); + ACCEPT_TAC( + step, + ac_rule(R_SEP_AC, goal_ccl(step->g))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LISTI_FROM_SEP = + prove_r_big_sep_listi_from_sep(); + +PROOF static thm prove_r_big_sep_listi_sep(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (Phi:num->B->A->bool) + (Psi:num->B->A->bool) + (xs:(B)list). + r_big_sep_listi + R + (\index:num. \x:B. + r_sep R (Phi index x) (Psi index x)) + xs == + r_sep + R + (r_big_sep_listi R Phi xs) + (r_big_sep_listi R Psi xs) + `); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + r_big_sep_listi_def, + R_BIG_SEP_LISTI_FROM_SEP))); + return gnode_prove(root); +} + +PROOF thm R_BIG_SEP_LISTI_SEP = + prove_r_big_sep_listi_sep(); + +PROOF static int audit_big_sep(void) { + thm_list public_theorems = THM_LIST( + r_big_sep_listi_from_def, + r_big_sep_listi_def, + r_big_sep_list_def, + r_big_sep_set_def, + r_big_sep_map_value_def, + r_big_sep_map_def, + r_big_sep_def, + R_BIG_SEP_NIL, + R_BIG_SEP_CONS, + R_BIG_SEP_SINGLETON, + R_BIG_SEP_APPEND, + R_BIG_SEP_SNOC, + R_BIG_SEP_REVERSE, + R_BIG_SEP_SWAP_HEAD, + R_BIG_SEP_LIST_NIL, + R_BIG_SEP_LIST_CONS, + R_BIG_SEP_LIST_SINGLETON, + R_BIG_SEP_LIST_APPEND, + R_BIG_SEP_LIST_REVERSE, + R_BIG_SEP_LIST_SWAP_HEAD, + R_BIG_SEP_LIST_MONO, + R_BIG_SEP_LIST_MONO_ON, + R_BIG_SEP_LIST_EQUIV, + R_BIG_SEP_LIST_EQUIV_ON, + R_BIG_SEP_LIST_MAP, + R_BIG_SEP_LIST_EMP, + R_BIG_SEP_LIST_SEP, + R_BIG_SEP_SET_EMPTY, + R_BIG_SEP_SET_INSERT, + R_BIG_SEP_SET_SINGLETON, + R_BIG_SEP_SET_UNION, + R_BIG_SEP_SET_EQ, + R_BIG_SEP_SET_MONO, + R_BIG_SEP_SET_EQUIV, + R_BIG_SEP_SET_EMP, + R_BIG_SEP_SET_SEP, + R_BIG_SEP_MAP_VALUE, + R_BIG_SEP_MAP_VALUE_LOOKUP, + R_BIG_SEP_MAP_EMPTY, + R_BIG_SEP_MAP_INSERT, + R_BIG_SEP_MAP_SINGLETON, + R_BIG_SEP_MAP_DELETE, + R_BIG_SEP_MAP_EQ, + R_BIG_SEP_MAP_MONO, + R_BIG_SEP_MAP_EQUIV, + R_BIG_SEP_MAP_EMP, + R_BIG_SEP_MAP_SEP, + R_BIG_SEP_LISTI_NIL, + R_BIG_SEP_LISTI_CONS, + R_BIG_SEP_LISTI_FROM_APPEND, + R_BIG_SEP_LISTI_APPEND, + R_BIG_SEP_LISTI_SINGLETON, + R_BIG_SEP_LISTI_FROM_SHIFT, + R_BIG_SEP_LISTI_CONS_SHIFT, + R_BIG_SEP_LISTI_APPEND_SHIFT, + R_BIG_SEP_LISTI_FROM_MONO, + R_BIG_SEP_LISTI_MONO, + R_BIG_SEP_LISTI_FROM_EQUIV, + R_BIG_SEP_LISTI_EQUIV, + R_BIG_SEP_LISTI_FROM_SEP, + R_BIG_SEP_LISTI_SEP); + + for (size_t i = 0; i < vector_size(public_theorems); ++i) { + ENSURE_COND( + !IS_NULL(public_theorems[i]), + "big-sep theorem %zu is null", + i); + ENSURE_COND( + vector_size(hyp(public_theorems[i])) == 0, + "big-sep theorem %zu has hypotheses", + i); + } + ENSURE_COND( + vector_size(get_all_axioms()) == BIG_SEP_AXIOMS_BEFORE, + "big-sep theory introduced axioms"); + return 0; +err: + ERR_FUN_PUTS("audit_big_sep"); + return -1; +} + +PROOF static int _BIG_SEP_AUDIT = + audit_big_sep(); diff --git a/theory/logic/big_sep.h b/theory/logic/big_sep.h new file mode 100644 index 0000000..5a2bf1b --- /dev/null +++ b/theory/logic/big_sep.h @@ -0,0 +1,372 @@ +#pragma once + +/* + * Iterated separating conjunction for resource propositions. + * + * There are five public views of the construction: + * + * r_big_sep R Ps + * folds a list of assertions `Ps:(A->bool)list` with `r_sep R`, using + * `r_emp R` for the empty list; + * + * r_big_sep_list R Phi xs + * folds the assertions `Phi x` for `x` in `xs`; + * + * r_big_sep_listi R Phi xs + * is the Iris-style indexed variant and folds `Phi i x`, where `i` + * is the zero-based position of `x` in `xs`. + * + * r_big_sep_set R Phi s + * folds `Phi x` over a finite set `s`. This view uses HOL's generic + * commutative-monoid iteration, so it is independent of any enumeration + * of the set. + * + * r_big_sep_map R Phi m + * folds `Phi key value` over the bindings of a finite map `m`. + * + * The unindexed fold is kept primitive so that its `NIL` and `CONS` equations + * are definitional. `r_big_sep_listi_from` is the offset form used to state + * composition laws + * without hiding index arithmetic. Thus + * + * r_big_sep_listi R Phi xs = r_big_sep_listi_from R Phi 0 xs. + * + * As in `resource_prop.h`, all equalities below are extensional equality of + * assertions. They are consequently stronger than `r_equiv`. + */ + +#include "proof/theory/logic/finmap.h" +#include "proof/theory/logic/resource_prop.h" + +/* ------------------------------------------------------------------------- */ +/* Definitions */ +/* ------------------------------------------------------------------------- */ + +/* + * r_big_sep_listi_from R Phi offset [] = r_emp R + * + * r_big_sep_listi_from R Phi offset (x :: xs) = + * r_sep R + * (Phi offset x) + * (r_big_sep_listi_from R Phi (SUC offset) xs) + */ +PROOF extern thm r_big_sep_listi_from_def; + +/* `r_big_sep_listi R Phi xs = r_big_sep_listi_from R Phi 0 xs`. */ +PROOF extern thm r_big_sep_listi_def; + +/* + * r_big_sep R [] = r_emp R + * + * r_big_sep R (P :: Ps) = r_sep R P (r_big_sep R Ps) + */ +PROOF extern thm r_big_sep_def; + +/* `r_big_sep_list R Phi xs = r_big_sep R (MAP Phi xs)`. */ +PROOF extern thm r_big_sep_list_def; + +/* `r_big_sep_set R Phi s = iterate (r_sep R) s Phi`. */ +PROOF extern thm r_big_sep_set_def; + +/* + * A total value selector used only at keys in `finmap_dom m`. + * Outside the domain its result is deliberately unspecified. + */ +PROOF extern thm r_big_sep_map_value_def; + +/* + * `r_big_sep_map R Phi m` is the finite-set fold of + * `Phi key (r_big_sep_map_value m key)` over `finmap_dom m`. + */ +PROOF extern thm r_big_sep_map_def; + +/* ------------------------------------------------------------------------- */ +/* Literal lists of assertions */ +/* ------------------------------------------------------------------------- */ + +/* `r_big_sep R [] == r_emp R`. */ +PROOF extern thm R_BIG_SEP_NIL; + +/* `r_big_sep R (P :: Ps) == r_sep R P (r_big_sep R Ps)`. */ +PROOF extern thm R_BIG_SEP_CONS; + +/* `r_big_sep R [P] == P`. */ +PROOF extern thm R_BIG_SEP_SINGLETON; + +/* + * `r_big_sep R (left ++ right) == + * r_sep R (r_big_sep R left) (r_big_sep R right)`. + */ +PROOF extern thm R_BIG_SEP_APPEND; + +/* `r_big_sep R (Ps ++ [P]) == r_sep R (r_big_sep R Ps) P`. */ +PROOF extern thm R_BIG_SEP_SNOC; + +/* `r_big_sep R (REVERSE Ps) == r_big_sep R Ps`. */ +PROOF extern thm R_BIG_SEP_REVERSE; + +/* + * Adjacent assertions may be swapped: + * `r_big_sep R (P :: Q :: Ps) == r_big_sep R (Q :: P :: Ps)`. + * Together with congruence under a common prefix, this is the generator for + * permutation invariance of the unindexed fold. + */ +PROOF extern thm R_BIG_SEP_SWAP_HEAD; + +/* ------------------------------------------------------------------------- */ +/* Unindexed list binders */ +/* ------------------------------------------------------------------------- */ + +/* `r_big_sep_list R Phi [] == r_emp R`. */ +PROOF extern thm R_BIG_SEP_LIST_NIL; + +/* + * `r_big_sep_list R Phi (x :: xs) == + * r_sep R (Phi x) (r_big_sep_list R Phi xs)`. + */ +PROOF extern thm R_BIG_SEP_LIST_CONS; + +/* `r_big_sep_list R Phi [x] == Phi x`. */ +PROOF extern thm R_BIG_SEP_LIST_SINGLETON; + +/* + * `r_big_sep_list R Phi (left ++ right) == + * r_sep R + * (r_big_sep_list R Phi left) + * (r_big_sep_list R Phi right)`. + */ +PROOF extern thm R_BIG_SEP_LIST_APPEND; + +/* + * `r_big_sep_list R Phi (REVERSE xs) == + * r_big_sep_list R Phi xs`. + */ +PROOF extern thm R_BIG_SEP_LIST_REVERSE; + +/* + * `r_big_sep_list R Phi (x :: y :: xs) == + * r_big_sep_list R Phi (y :: x :: xs)`. + */ +PROOF extern thm R_BIG_SEP_LIST_SWAP_HEAD; + +/* ------------------------------------------------------------------------- */ +/* Logical laws for unindexed list binders */ +/* ------------------------------------------------------------------------- */ + +/* + * Pointwise entailment lifts through big separation: + * + * (forall x. Phi x |-R Psi x) ==> + * r_big_sep_list R Phi xs |-R r_big_sep_list R Psi xs. + */ +PROOF extern thm R_BIG_SEP_LIST_MONO; + +/* + * Member-restricted monotonicity. Unlike the global rule above, no proof is + * required for values that do not occur in `xs`: + * + * (forall x. MEM x xs ==> Phi x |-R Psi x) ==> + * bigsep[x in xs] Phi x |-R bigsep[x in xs] Psi x. + */ +PROOF extern thm R_BIG_SEP_LIST_MONO_ON; + +/* + * Pointwise resource-proposition equivalence lifts through big separation: + * + * (forall x. Phi x =R= Psi x) ==> + * r_big_sep_list R Phi xs =R= r_big_sep_list R Psi xs. + */ +PROOF extern thm R_BIG_SEP_LIST_EQUIV; + +/* Member-restricted pointwise equivalence lifts through big separation. */ +PROOF extern thm R_BIG_SEP_LIST_EQUIV_ON; + +/* + * Mapping the data list is the same as composing the assertion family: + * + * bigsep[y in MAP f xs] Phi y == bigsep[x in xs] Phi (f x). + */ +PROOF extern thm R_BIG_SEP_LIST_MAP; + +/* `bigsep[x in xs] emp == emp`. */ +PROOF extern thm R_BIG_SEP_LIST_EMP; + +/* + * Iteration distributes over pointwise separating conjunction: + * + * bigsep[x in xs] (Phi x * Psi x) == + * (bigsep[x in xs] Phi x) * (bigsep[x in xs] Psi x). + */ +PROOF extern thm R_BIG_SEP_LIST_SEP; + +/* ------------------------------------------------------------------------- */ +/* Finite-set binders */ +/* ------------------------------------------------------------------------- */ + +/* `r_big_sep_set R Phi {} == r_emp R`. */ +PROOF extern thm R_BIG_SEP_SET_EMPTY; + +/* + * Fresh insertion: + * + * FINITE s ==> ~(x IN s) ==> + * bigsep[x in x INSERT s] Phi x == + * Phi x * bigsep[y in s] Phi y. + */ +PROOF extern thm R_BIG_SEP_SET_INSERT; + +/* `r_big_sep_set R Phi {x} == Phi x`. */ +PROOF extern thm R_BIG_SEP_SET_SINGLETON; + +/* + * A disjoint union factors into separating conjunction: + * + * FINITE left /\ FINITE right /\ DISJOINT left right ==> + * bigsep[x in left UNION right] Phi x == + * bigsep[x in left] Phi x * bigsep[x in right] Phi x. + */ +PROOF extern thm R_BIG_SEP_SET_UNION; + +/* Pointwise equality on the set gives equality of the two folds. */ +PROOF extern thm R_BIG_SEP_SET_EQ; + +/* + * Member-restricted pointwise entailment lifts through a finite-set fold. + */ +PROOF extern thm R_BIG_SEP_SET_MONO; + +/* + * Member-restricted pointwise resource-proposition equivalence lifts through + * a finite-set fold. + */ +PROOF extern thm R_BIG_SEP_SET_EQUIV; + +/* `bigsep[x in s] emp == emp`, including for infinite `s`. */ +PROOF extern thm R_BIG_SEP_SET_EMP; + +/* + * On a finite set, iteration distributes over pointwise separating + * conjunction. + */ +PROOF extern thm R_BIG_SEP_SET_SEP; + +/* ------------------------------------------------------------------------- */ +/* Finite-map binders */ +/* ------------------------------------------------------------------------- */ + +/* A successful lookup determines the selected value. */ +PROOF extern thm R_BIG_SEP_MAP_VALUE; + +/* Every key in the domain looks up to its selected value. */ +PROOF extern thm R_BIG_SEP_MAP_VALUE_LOOKUP; + +/* `r_big_sep_map R Phi finmap_empty == r_emp R`. */ +PROOF extern thm R_BIG_SEP_MAP_EMPTY; + +/* + * Fresh insertion: + * + * finmap_lookup m key == NONE ==> + * bigsep[map] (finmap_insert key value m) Phi == + * Phi key value * bigsep[map] m Phi. + */ +PROOF extern thm R_BIG_SEP_MAP_INSERT; + +/* `r_big_sep_map R Phi (finmap_singleton key value) == Phi key value`. */ +PROOF extern thm R_BIG_SEP_MAP_SINGLETON; + +/* + * Extract a present binding and fold the remaining map: + * + * finmap_lookup m key == SOME value ==> + * bigsep[map] m Phi == + * Phi key value * bigsep[map] (finmap_delete key m) Phi. + */ +PROOF extern thm R_BIG_SEP_MAP_DELETE; + +/* Pointwise equality on present bindings gives equality of map folds. */ +PROOF extern thm R_BIG_SEP_MAP_EQ; + +/* Pointwise entailment on present bindings lifts through a map fold. */ +PROOF extern thm R_BIG_SEP_MAP_MONO; + +/* Pointwise equivalence on present bindings lifts through a map fold. */ +PROOF extern thm R_BIG_SEP_MAP_EQUIV; + +/* `bigsep[key |-> value in m] emp == emp`. */ +PROOF extern thm R_BIG_SEP_MAP_EMP; + +/* Map iteration distributes over pointwise separating conjunction. */ +PROOF extern thm R_BIG_SEP_MAP_SEP; + +/* ------------------------------------------------------------------------- */ +/* Indexed list binders */ +/* ------------------------------------------------------------------------- */ + +/* `r_big_sep_listi R Phi [] == r_emp R`. */ +PROOF extern thm R_BIG_SEP_LISTI_NIL; + +/* + * `r_big_sep_listi R Phi (x :: xs) == + * r_sep R + * (Phi 0 x) + * (r_big_sep_listi_from R Phi 1 xs)`. + */ +PROOF extern thm R_BIG_SEP_LISTI_CONS; + +/* + * Offset-aware append law: + * + * r_big_sep_listi_from R Phi offset (left ++ right) == + * r_sep R + * (r_big_sep_listi_from R Phi offset left) + * (r_big_sep_listi_from R Phi (offset + LENGTH left) right). + */ +PROOF extern thm R_BIG_SEP_LISTI_FROM_APPEND; + +/* + * Zero-based append law. The right segment starts at `LENGTH left`: + * + * r_big_sep_listi R Phi (left ++ right) == + * r_sep R + * (r_big_sep_listi R Phi left) + * (r_big_sep_listi_from R Phi (LENGTH left) right). + */ +PROOF extern thm R_BIG_SEP_LISTI_APPEND; + +/* `r_big_sep_listi R Phi [x] == Phi 0 x`. */ +PROOF extern thm R_BIG_SEP_LISTI_SINGLETON; + +/* + * Starting at an offset is the same as shifting the index predicate: + * + * r_big_sep_listi_from R Phi offset xs == + * r_big_sep_listi R (\index x. Phi (offset + index) x) xs. + */ +PROOF extern thm R_BIG_SEP_LISTI_FROM_SHIFT; + +/* Iris-style `CONS` equation with the tail predicate shifted by one. */ +PROOF extern thm R_BIG_SEP_LISTI_CONS_SHIFT; + +/* Iris-style append equation with the right predicate shifted by length. */ +PROOF extern thm R_BIG_SEP_LISTI_APPEND_SHIFT; + +/* + * Pointwise entailment at every index lifts through an offset big separation. + */ +PROOF extern thm R_BIG_SEP_LISTI_FROM_MONO; + +/* Pointwise indexed entailment lifts through zero-based big separation. */ +PROOF extern thm R_BIG_SEP_LISTI_MONO; + +/* Pointwise indexed equivalence lifts through an offset big separation. */ +PROOF extern thm R_BIG_SEP_LISTI_FROM_EQUIV; + +/* Pointwise indexed equivalence lifts through zero-based big separation. */ +PROOF extern thm R_BIG_SEP_LISTI_EQUIV; + +/* Offset-indexed iteration distributes over pointwise `r_sep`. */ +PROOF extern thm R_BIG_SEP_LISTI_FROM_SEP; + +/* Zero-based indexed iteration distributes over pointwise `r_sep`. */ +PROOF extern thm R_BIG_SEP_LISTI_SEP; -- Gitee From 94ebc3b30fdbbff51678d47827f725b4b6636063 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Mon, 10 Aug 2026 15:55:54 +0800 Subject: [PATCH 28/35] proof: add Lithium entailment automation --- docs/LITHIUM_AUTOMATION.md | 237 +++++++++ proof.h | 8 +- proof_backward_sl.c | 46 +- proof_backward_sl.h | 15 + proof_lithium.c | 890 ++++++++++++++++++++++++++++++++ proof_lithium.h | 224 ++++++++ proof_sl.c | 33 ++ proof_sl.h | 17 + test/proof_lithium_regression.c | 547 ++++++++++++++++++++ 9 files changed, 2014 insertions(+), 3 deletions(-) create mode 100644 docs/LITHIUM_AUTOMATION.md create mode 100644 proof_lithium.c create mode 100644 proof_lithium.h create mode 100644 test/proof_lithium_regression.c diff --git a/docs/LITHIUM_AUTOMATION.md b/docs/LITHIUM_AUTOMATION.md new file mode 100644 index 0000000..421ae50 --- /dev/null +++ b/docs/LITHIUM_AUTOMATION.md @@ -0,0 +1,237 @@ +# Lithium-inspired entailment automation + +`proof_lithium` is a proof-producing, rule-extensible interpreter for the +currently installed C* separation-logic theory. It deliberately implements the +goal-directed and committed-choice core of +[RefinedC Lithium](https://gitlab.mpi-sws.org/iris/refinedc/-/tree/master/theories/lithium), +not a claim that C* already has all of Lithium's open judgments, persistent +contexts, modalities, or existential-evar machinery. + +The design keeps three ideas from Lithium: + +- fixed connective interpretation surrounds an extensible rule phase; +- proved rules are ordered by priority and source order; and +- after a rule head is selected, failure of its recursive entailment does not + backtrack to a different rule. + +## Soundness boundary + +The interpreter is not a primitive inference rule. Every successful step is +one of: + +- an existing validated `proof_backward_sl` tactic; +- `LITHIUM_AND_SLTAC`, whose validator calls `conj_slrule`; +- `LITHIUM_FORALL_SLTAC`, whose validator calls `forall_slrule`; or +- a custom callback that must itself expand a validated proof tree. + +A theorem entry is an already-proved SL equality or entailment. Matching only +chooses and specializes it. Consequent-rule preflight checks the complete RHS +modulo spatial ACU and verifies that every specialized HOL theorem premise is +already in the ordinary context before committing. At completion, +`gnode_prove` runs the entire validator tree bottom-up. An invalid match, +unavailable premise, duplicated linear resource, or malformed callback cannot +yield an accepted theorem. + +Custom callbacks remain part of tactic code, not the kernel. Their returned +vector must be exactly the callback subtree's complete unresolved frontier; +null, missing, or extra leaves are rejected. A callback can still explicitly +invoke an unsafe API such as `CHEAT_TAC`, so the safe extension path is a +theorem rule. + +## Rule categories + +`LITHIUM_GOAL_RULE` is the identity-modality local counterpart of Lithium's +`lemma_to_li_entails`. Given `E : P |-- Q`, a whole consequent matching `Qθ` +modulo spatial ACU becomes `Pθ`; the left spatial context is unchanged. The +interpreter does not implicitly lift `E` to `P ** F |-- Q ** F`. A proved +binary endpoint may explicitly quantify a frame parameter, for example +`forall F. P ** F |-- Q ** F`; this pattern is matched and regression-tested. + +`LITHIUM_HYP_RULE` applies `E` forward to matching linear antecedent resources +and retains their unmatched frame. It is useful, but is only a binary rewrite. +It is considered applicable only if that one rewrite immediately increases the +greedy direct-frame score or reduces the number of spatial resources. It is not +the same judgment as Lithium's continuation-aware `SimplifyHyp` or `Subsume`, +and rewrites useful only after additional intermediate steps may be skipped. + +`LITHIUM_ENTAIL_RULE` is a C* convenience enabling both interpretations of one +binary theorem. It is therefore broader than `lemma_to_li_entails`, not a +one-to-one translation of an official Lithium class. + +`LITHIUM_CUSTOM_RULE` provides a leading matcher/tactic hook. Independent +modules can publish caller-owned bundles and combine them with +`lithium_rule_set_append`. The registry intentionally has no process-global +mutable state; lookup is currently a stable linear scan rather than Lithium's +discriminated typeclass/hint indexing. + +## Selection and scheduling + +Phase precedence is stronger than numeric priority: leading custom/GOAL rules +always precede the later HYP phase. Within one registered phase, rules are +sorted by `(priority, registration order)`, with smaller numeric priorities +first. Equal-priority entries preserve registration order, including across +appended bundles. For `LITHIUM_ENTAIL_RULE`, the GOAL interpretation is thus +always considered before its HYP interpretation. Applicability is probed on a +private node. Once a rule commits, its recursive leaves are scheduled and a +later stuck leaf does not reconsider another entry. + +This is analogous to Lithium's `LiEntailsShelve`: typeclass search selects the +outer rule while the recursive entailment premise is shelved until after that +choice point is gone. “No backtracking” here means no backtracking over a +committed rule because recursive proof search failed. A matcher can still scan +several local candidates before it reports applicability, just as Lithium's +`FindInContext` may try multiple finder instances. + +For one SL leaf, the local phase order is: + +1. leading custom rules and exact consequent (`GOAL`) theorem rules; +2. expose separating paths to `fact` resources and move those facts to the + duplicable ordinary context; +3. direct linear cancellation and `emp` closure; +4. left wand, separating conjunction, disjunction, existential, unit, and + additive-conjunction interpretation; +5. relevant forward (`HYP`) theorem rules; and +6. right update, fact, pulled existential, additive conjunction/disjunction, + wand, existential, and universal interpretation. + +Delaying forward rules until after direct cancellation prevents a theorem such +as `P |-- Q` from destroying a resource that already closes `P |-- P`. +Conversely, custom and goal rules lead the phase order so they can override +ordinary connective interpretation, corresponding most closely to Lithium's +leading `liTactic` entry. C* has no separate analogue of Lithium's +continuation-judgment-to-`iProp_to_Prop` `liExtensible` bridge yet. + +Pure HOL leaves introduce quantifiers and implications, close from an +assumption, `T`, or reflexive equality, split conjunction, and make a stable +disjunction choice. Only custom rules apply to a general HOL leaf. + +The context remains linear. Without an explicit theorem, the interpreter does +not prove `P ** Q |-- P` or `P |-- P ** P`. Spatial `fact` is the sole built-in +exception: it is moved to the ordinary context using the proved fact-elimination +law, after which it may be discarded or used repeatedly. + +## API example + +```c +lithium_rule_set module_rules = lithium_rule_set_new(); +lithium_rule_set_add_theorem( + &module_rules, "my-atom-rule", 10, + LITHIUM_GOAL_RULE, MY_PROVED_RULE); + +lithium_rule_set rules = lithium_rule_set_new(); +lithium_rule_set_append(&rules, &module_rules); + +gnode root = gnode_new_with_ccl(`source |-- target`); +lithium_options options = lithium_options_default(&rules); +gnode_list unresolved = LITHIUM_SLTAC(root, options); +if (vector_size(unresolved) == 0) { + thm result = gnode_prove(root); +} +``` + +`lithium_options.trace` observes only committed steps. Both public interpreter +entry points must run outside `proof_try`, because private theorem and witness +probes use that process-global mechanism internally. `LITHIUM_SLTAC` can resume +a partially expanded proof tree from its existing leaves; one-step +`LITHIUM_STEP_SLTAC` requires an open leaf. + +## Comparison with RefinedC's default instances + +The official +[`instances.v`](https://gitlab.mpi-sws.org/iris/refinedc/-/blob/master/theories/lithium/instances.v) +contains several different extensible judgments. Their current C* status is: + +| RefinedC instance family | C* status | +| --- | --- | +| `find_in_context_direct` | Direct occurrence-sensitive cancellation is built in and regression-tested, but the finder itself is not yet an open indexed judgment. | +| `simplify_hyp_id` | Identity is represented by doing no forward rewrite; non-identity binary forward theorems are supported. The general continuation-producing judgment is missing. | +| `simplify_goal_id` | Identity falls through to ordinary structural solving; exact non-identity RHS reduction is implemented by `LITHIUM_GOAL_RULE`. | +| `subsume_id` | Direct cancellation covers the unit/no-extra-output case. Dependent result witnesses and a returned continuation are not represented by the binary rule record. | +| `subsume_simplify` | Only a restricted scheduling analogue exists. C* does not yet compare separate `SimplifyHyp`/`SimplifyGoal` `option N` costs or construct Lithium's dependent continuation. | +| `find_sep_list` and the five `subsume_sep_list_*` rules | Not copied literally. `sep_list`, its ignored-index protocol, list insertion, and `list_subequiv` are RefinedC typing infrastructure, not part of C*'s current generic SL interface. | + +Lithium's `li_vm_compute_tac` side-condition hook likewise has no generic C* +entry yet; a module can currently use a validated custom callback or a proved +HOL conversion. Thus the regression suite reproduces the locally meaningful +entailment behavior and selection discipline, not the typeclass records of all +RefinedC-specific `sep_list` instances. + +## Deliberate semantic differences and remaining work + +### Pure assertions + +Iris BI pure propositions have the laws needed to discharge a pure condition +without consuming spatial resources. C* permits arbitrary, possibly +non-monotone predicates `A -> bool`, so the pointwise definition +`r_pure R p a <=> p` does not by itself validate the corresponding separating +laws. + +The adapter therefore maps Lithium-style pure side conditions to `r_fact`, +using `R_FACT_INTRO`, `R_FACT_ELIM`, `R_FACT_DUP`, and the fact/separation laws. +Treating `r_pure` as an interchangeable zero-resource fact would be unsound. + +### Persistence and modalities + +The current resource-proposition layer has no Iris `Persistent`/`□` connective, +no split persistent/spatial environment, and no general `limodal`. Only +`r_fact` is duplicated by a proved law. Basic-update introduction and +monotonicity are supported when an update theory is installed, but this does +not reproduce Lithium's general `liModal`, `liPersistent`, or `liAccu` steps. + +### Existential variables + +C* has no analogue of Lithium's protected existential tuples, unification +evars, `SimplExist`, or `li_done_evar` sharing across branches. The interpreter +infers a witness by one-way matching a witness-dependent goal component against +a spatial assertion or ordinary fact. If no witness is determined, the goal +stays unresolved; the interpreter never invents one by recursive backtracking. + +### Continuation-aware judgments + +Lithium's `SimplifyGoal`, `SimplifyHyp`, and `Subsume` carry a modality and a +continuation; `Subsume` can additionally return dependent witnesses and extra +resources. C* theorem entries currently store only binary `P |-- Q` relations. +Those endpoints can quantify explicit assertion or frame parameters, and HYP +application preserves unmatched input resources, so several common rules are +expressible. The registry still has no first-class continuation judgment, +modality, result index, +cost arbitration, or protected dependent witness, and therefore cannot expose +the full judgment +`P1 -* M (exists x. P2 x ** T x)`. This is the largest semantic step needed for +a literal port of `subsume_simplify` and the `sep_list` rules. + +### Object-logic surface + +The generic `sl_theory` adapter does not expose `r_top`, `r_bottom`, `r_impl`, +`r_pure`, persistence, or an iterated-separation operator. A theorem about a +hidden connective can be registered atomically, but the interpreter cannot +structurally inspect it. The local structural handling of resource +disjunction is an extra C* feature; general Lithium `liStep` does not have an +equivalent BI-disjunction case. + +`ra_sl_build` also requires a closed monomorphic RA, so the solver targets an +installed concrete assertion type rather than proving generic theorems with +an open `R : (A)ra` parameter. + +## Regression coverage + +`test/proof_lithium_regression.c` checks: + +- exact direct lookup, ACU multiplicity, and negative weakening/duplication; +- `fact` discard and duplication, false elimination, and HOL-to-fact goals; +- separating/additive connectives, ambiguous branch scoring, wand, + existential opening/witness inference, and dependent universal introduction; +- basic-update introduction and monotonicity; +- quantified entailment, explicit frame-parameter, equality, and dual + `ENTAIL` theorem registrations; +- positive and unavailable theorem guards; +- custom override, custom miss, malformed-frontier rejection, and pre-step + trace snapshots; +- priority ordering independent of registration order, equal-priority source + order across bundles, phase-before-numeric precedence, HYP relevance, + bundle composition, and committed recursive failure; +- exact fuel/no-match boundary behavior; and +- explicit unresolved unknown atoms and unknown existential witnesses. + +Every successful regression is reconstructed with zero admitted axioms and +zero remaining verification conditions. diff --git a/proof.h b/proof.h index f5e36f6..15f5d60 100644 --- a/proof.h +++ b/proof.h @@ -11,13 +11,16 @@ * * proof_sl + proof_backward * ├─ proof_backward_sl SL backward tactics + * ├─ proof_lithium extensible committed SL search * └─ proof_symexec trusted QCP bridge * ``` * * `proof_backward` is independent of any object logic; both SL consumers * explicitly depend on it and `proof_sl`. Except for the explicitly unsafe * `CHEAT_TAC`, `proof_backward` and `proof_backward_sl` reconstruct theorems - * bottom-up through validators. + * bottom-up through validators. `proof_lithium` adds only rule selection and + * committed goal scheduling on top of those validators; registered theorem + * rules do not enlarge the trust base. * `CHEAT_TAC` calls `new_axiom` for its goal. `proof_symexec` is also a * deliberate trust boundary: its documented QCP bridge and fact-purification * equations use private axioms. These APIs must be counted in the verification @@ -75,5 +78,8 @@ #include "proof/proof_backward_sl.h" #require "proof/proof_backward_sl.c" +#include "proof/proof_lithium.h" +#require "proof/proof_lithium.c" + #include "proof/proof_symexec.h" #require "proof/proof_symexec.c" diff --git a/proof_backward_sl.c b/proof_backward_sl.c index e8922be..8ea49d6 100644 --- a/proof_backward_sl.c +++ b/proof_backward_sl.c @@ -1260,13 +1260,23 @@ PROOF static thm hcon_apply_sltac_valid(thm* ths, gnode gn) { PROOF gnode HCON_APPLY_SLTAC(const gnode gn, const thm relation) { sl_goal_view view = dest_sl_goal(gn->g); sl_apply_match_env match = sl_apply_match_env_new(view, relation); + ENSURE_OK("Could not initialize consequent theorem matching"); term template_hcon = dest_sl_ent(concl(match.template_relation)).tm2; + term_list patterns = strip_sl_resources(template_hcon); + term_list candidates = strip_sl_resources(view.hcon); + ENSURE_COND(vector_size(patterns) == vector_size(candidates), + "The theorem consequent and current consequent have different " + "resource multiplicities"); ENSURE_COND(sl_apply_match_greedy( - &match, strip_sl_resources(template_hcon), - strip_sl_resources(view.hcon), true, NULL), + &match, patterns, candidates, true, NULL), "The theorem consequent does not match the current consequent"); thm consequent_ent = sl_apply_finish_match(&match); + ENSURE_COND(!IS_NULL(consequent_ent), + "Could not specialize the consequent theorem"); consequent_ent = rehcon_slrule(consequent_ent, view.hcon); + ENSURE_COND(!IS_NULL(consequent_ent), + "The specialized theorem consequent is not ACU-equivalent to " + "the current consequent"); term replacement = dest_sl_ent(concl(consequent_ent)).tm1; goal new_g = sl_goal_new(view.lasmps, view.lhants, replacement); @@ -1278,6 +1288,38 @@ err: return empty_gnode; } +PROOF bool HCON_APPLY_SLTAC_APPLICABLE(const gnode gn, + const thm relation) { + ENSURE_COND(!proof_is_in_try(), + "HCON_APPLY_SLTAC_APPLICABLE cannot run inside proof_try"); + ENSURE_COND(gn != NULL && goal_is_sl(gn->g), + "Consequent applicability requires an SL goal"); + + gnode probe = gnode_new(gn->g); + proof_try_begin(); + gnode child = HCON_APPLY_SLTAC(probe, relation); + bool failed = NOT_OK || child == NULL; + if (failed) SET_OK(); + proof_try_end(); + if (failed) { + proof_clear_errors(); + return false; + } + + hcon_apply_sltac_env* env = + (hcon_apply_sltac_env*)probe->env; + ENSURE_COND(env != NULL && !IS_NULL(env->relation), + "Consequent probe did not retain its specialized relation"); + term_list assumptions = + labeled_term_list_to_term_list(goal_lasmps(gn->g)); + return term_list_is_subset(hyp(env->relation), assumptions); +err: + ERR_FUN_PUTS("HCON_APPLY_SLTAC_APPLICABLE", + gn == NULL ? GC_STRDUP("") : cstr_gnode(gn), + cstr_thm(relation)); + return false; +} + PROOF gnode_list SEP_SLTAC(const gnode gn, const const_cstr_list lbs) { sl_goal_view view = dest_sl_goal(gn->g); labeled_term_list lasmps = view.lasmps; diff --git a/proof_backward_sl.h b/proof_backward_sl.h index 23e5c61..8a86f4d 100644 --- a/proof_backward_sl.h +++ b/proof_backward_sl.h @@ -504,6 +504,21 @@ PROOF gnode HANT_CONV_SLTAC(const gnode gn, const conv cv, const const_cstr_list */ PROOF gnode HCON_APPLY_SLTAC(const gnode gn, const thm relation); +/** + * Test whether `HCON_APPLY_SLTAC(gn, relation)` has an exact consequent match + * whose specialized ordinary theorem assumptions are already present in + * `gn`'s ordinary context. + * + * The test expands only a private probe node and never mutates `gn`. Ordinary + * matching failure returns false without leaving prover error status set. + * Unlike `HCON_APPLY_SLTAC` itself, this preflight includes the theorem- + * assumption check normally deferred to bottom-up `gnode_accept`; it is meant + * for committed-choice interpreters that must distinguish an inapplicable + * guarded rule before selecting it. It must not be called inside `proof_try`. + */ +PROOF bool HCON_APPLY_SLTAC_APPLICABLE(const gnode gn, + const thm relation); + /** * Split a separating consequent and partition antecedents linearly. * diff --git a/proof_lithium.c b/proof_lithium.c new file mode 100644 index 0000000..603eb66 --- /dev/null +++ b/proof_lithium.c @@ -0,0 +1,890 @@ +#include "proof/proof_lithium.h" + +/* ------------------------------------------------------------------------- */ +/* Rule sets */ +/* ------------------------------------------------------------------------- */ + +PROOF static bool lithium_rule_set_current(const lithium_rule_set* rules) { + if (rules == NULL) return true; + return rules->entries != NULL && + rules->theory_generation == sl_theory_generation(); +err: + ERR_FUN_PUTS("lithium_rule_set_current"); + return false; +} + +PROOF lithium_rule_set lithium_rule_set_new(void) { + ENSURE_COND(sl_theory_is_installed(), + "A Lithium rule set requires an active SL theory"); + return (lithium_rule_set){ + (lithium_rule*)vector_create(), 0, sl_theory_generation()}; +err: + ERR_FUN_PUTS("lithium_rule_set_new"); + return (lithium_rule_set){NULL, 0, 0}; +} + +PROOF static void lithium_insert_rule(lithium_rule_set* rules, + const lithium_rule entry) { + vector_add(&rules->entries, entry); + size_t i = vector_size(rules->entries) - 1; + while (i > 0) { + lithium_rule previous = rules->entries[i - 1]; + bool before = entry.priority < previous.priority || + (entry.priority == previous.priority && + entry.order < previous.order); + if (!before) break; + rules->entries[i] = previous; + --i; + } + rules->entries[i] = entry; +} + +PROOF static bool lithium_is_relation_theorem(const thm theorem) { + thm opened = spec_all_rule(theorem); + thm relation = undisch_all_rule(opened); + term ccl = concl(relation); + return is_sl_ent(ccl) || is_sl_eq(ccl); +err: + ERR_FUN_PUTS("lithium_is_relation_theorem", cstr_thm(theorem)); + return false; +} + +PROOF int lithium_rule_set_add_theorem(lithium_rule_set* rules, + const char* name, size_t priority, + lithium_rule_kind kind, + const thm theorem) { + ENSURE_COND(rules != NULL && rules->entries != NULL, + "Lithium rule set is null or uninitialized"); + ENSURE_COND(lithium_rule_set_current(rules), + "Lithium rule set belongs to a stale SL theory generation"); + ENSURE_COND(name != NULL && name[0] != '\0', + "Lithium rule name must not be empty"); + ENSURE_COND(kind == LITHIUM_ENTAIL_RULE || kind == LITHIUM_GOAL_RULE || + kind == LITHIUM_HYP_RULE, + "Theorem registration requires an entailment rule kind"); + ENSURE_COND(!IS_NULL(theorem), "Lithium theorem rule is empty"); + ENSURE_COND(lithium_is_relation_theorem(theorem), + "Lithium theorem must conclude an SL entailment or equality"); + + lithium_rule entry = { + GC_STRDUP(name), priority, rules->next_order++, kind, theorem, + NULL, NULL, NULL}; + lithium_insert_rule(rules, entry); + return 0; +err: + ERR_FUN_PUTS("lithium_rule_set_add_theorem", cstr_string(name), + cstr_thm(theorem)); + return -1; +} + +PROOF int lithium_rule_set_add_custom(lithium_rule_set* rules, + const char* name, size_t priority, + lithium_rule_matcher matches, + lithium_rule_tactic apply, + const void* data) { + ENSURE_COND(rules != NULL && rules->entries != NULL, + "Lithium rule set is null or uninitialized"); + ENSURE_COND(lithium_rule_set_current(rules), + "Lithium rule set belongs to a stale SL theory generation"); + ENSURE_COND(name != NULL && name[0] != '\0', + "Lithium rule name must not be empty"); + ENSURE_COND(matches != NULL && apply != NULL, + "Lithium custom rule callbacks must not be null"); + + lithium_rule entry = { + GC_STRDUP(name), priority, rules->next_order++, LITHIUM_CUSTOM_RULE, + empty_theorem, matches, apply, data}; + lithium_insert_rule(rules, entry); + return 0; +err: + ERR_FUN_PUTS("lithium_rule_set_add_custom", cstr_string(name)); + return -1; +} + +PROOF int lithium_rule_set_append(lithium_rule_set* destination, + const lithium_rule_set* source) { + ENSURE_COND(destination != NULL && destination->entries != NULL, + "Lithium destination rule set is null or uninitialized"); + ENSURE_COND(source != NULL && source->entries != NULL, + "Lithium source rule set is null or uninitialized"); + ENSURE_COND(destination != source, + "A Lithium rule set cannot be appended to itself"); + ENSURE_COND(destination->entries != source->entries, + "Aliased Lithium rule sets cannot be appended"); + ENSURE_COND(lithium_rule_set_current(destination) && + lithium_rule_set_current(source), + "Lithium rule-set append encountered a stale theory generation"); + + for (size_t i = 0; i < vector_size(source->entries); ++i) { + lithium_rule entry = source->entries[i]; + entry.name = GC_STRDUP(entry.name); + entry.order = destination->next_order++; + lithium_insert_rule(destination, entry); + } + return 0; +err: + ERR_FUN_PUTS("lithium_rule_set_append"); + return -1; +} + +PROOF size_t lithium_rule_set_size(const lithium_rule_set* rules) { + if (rules == NULL || rules->entries == NULL) return 0; + return vector_size(rules->entries); +} + +PROOF lithium_options lithium_options_default( + const lithium_rule_set* rules) { + return (lithium_options){rules, 4096, NULL, NULL}; +} + +/* ------------------------------------------------------------------------- */ +/* Missing deterministic SL introduction tactics */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm lithium_and_sltac_valid(thm* ths, gnode gn) { + (void)gn; + return conj_slrule(ths[0], ths[1]); +err: + ERR_FUN_PUTS("lithium_and_sltac_valid", cstr_gnode(gn)); + return empty_theorem; +} + +PROOF gnode_list LITHIUM_AND_SLTAC(const gnode gn) { + ENSURE_COND(gn != NULL && goal_is_sl(gn->g), + "LITHIUM_AND_SLTAC requires an SL goal"); + term hcon = goal_hcon(gn->g); + ENSURE_COND(is_sl_and(hcon), + "SL consequent is not an additive conjunction"); + dest_binop_results parts = dest_sl_and(hcon); + labeled_term_list lasmps = goal_lasmps(gn->g); + labeled_term_list lhants = goal_lhants(gn->g); + goal left = sl_goal_new(lasmps, lhants, parts.tm1); + goal right = sl_goal_new(lasmps, lhants, parts.tm2); + return gnode_expand(gn, LIST_GOAL(left, right), + lithium_and_sltac_valid, NULL); +err: + ERR_FUN_PUTS("LITHIUM_AND_SLTAC", cstr_gnode(gn)); + return NULL; +} + +PROOF typedef struct { + term eigenvariable; +} lithium_forall_sltac_env; + +PROOF static thm lithium_forall_sltac_valid(thm* ths, gnode gn) { + lithium_forall_sltac_env* env = + (lithium_forall_sltac_env*)gn->env; + return forall_slrule(env->eigenvariable, ths[0]); +err: + ERR_FUN_PUTS("lithium_forall_sltac_valid", cstr_gnode(gn)); + return empty_theorem; +} + +PROOF gnode LITHIUM_FORALL_SLTAC(const gnode gn, const char* var_name) { + ENSURE_COND(gn != NULL && goal_is_sl(gn->g), + "LITHIUM_FORALL_SLTAC requires an SL goal"); + term hcon = goal_hcon(gn->g); + ENSURE_COND(is_sl_forall(hcon), + "SL consequent is not universally quantified"); + dest_binder_results quantified = dest_sl_forall(hcon); + term eigenvariable = + var_name == NULL + ? fresh_var_in_goal(quantified.v, gn->g) + : mk_var(var_name, type_of(quantified.v)); + ENSURE_COND(!var_free_in_goal(eigenvariable, gn->g), + "Universal eigenvariable(`%s`) is free in the goal", + string_of_term(eigenvariable)); + + term body = subst_one(eigenvariable, quantified.v, quantified.tm); + goal child_goal = sl_goal_new(goal_lasmps(gn->g), goal_lhants(gn->g), body); + lithium_forall_sltac_env* env = + GC_MALLOC(sizeof(lithium_forall_sltac_env)); + env->eigenvariable = eigenvariable; + return gnode_expand(gn, LIST_GOAL(child_goal), + lithium_forall_sltac_valid, env)[0]; +err: + ERR_FUN_PUTS("LITHIUM_FORALL_SLTAC", cstr_gnode(gn), + cstr_string(var_name)); + return empty_gnode; +} + +/* ------------------------------------------------------------------------- */ +/* Interpreter utilities */ +/* ------------------------------------------------------------------------- */ + +PROOF static lithium_step_result lithium_step( + lithium_step_kind kind, const gnode_list leaves, const char* name) { + return (lithium_step_result){kind, leaves, name}; +} + +PROOF static char* lithium_cstr_gnode_or_null(const gnode gn) { + return gn == NULL ? GC_STRDUP("") : cstr_gnode(gn); +} + +PROOF static lithium_step_result lithium_no_match(void) { + return lithium_step(LITHIUM_NO_MATCH, NULL, NULL); +} + +PROOF static lithium_step_result lithium_error(const char* name) { + return lithium_step(LITHIUM_ERROR, NULL, name); +} + +PROOF static bool lithium_is_exact_frontier(const gnode gn, + const gnode_list leaves) { + if (gn == NULL || leaves == NULL) return false; + gnode_list actual = gnode_leaves(gn); + if (actual == NULL || vector_size(actual) != vector_size(leaves)) { + return false; + } + for (size_t i = 0; i < vector_size(leaves); ++i) { + if (leaves[i] == NULL || leaves[i] != actual[i]) return false; + } + return true; +} + +PROOF static lithium_step_result lithium_applied(const gnode gn, + const gnode_list leaves, + const char* name) { + if (leaves == NULL) return lithium_error(name); + if (!lithium_is_exact_frontier(gn, leaves)) return lithium_error(name); + lithium_step_kind kind = vector_size(leaves) == 0 + ? LITHIUM_CLOSED + : LITHIUM_APPLIED; + return lithium_step(kind, leaves, name); +} + +PROOF static bool lithium_same_goal(const goal left, const goal right) { + return alpha_compare(goal_ccl(left), goal_ccl(right)) == 0; +} + +PROOF static term_list lithium_acu_resources(const term assertion) { + term_list conjuncts = strip_sl_sep(assertion); + term_list resources = (term_list)vector_create(); + for (size_t i = 0; i < vector_size(conjuncts); ++i) { + if (!is_sl_emp(conjuncts[i])) vector_add(&resources, conjuncts[i]); + } + return resources; +} + +PROOF static bool lithium_same_goal_modulo_spatial_acu( + const goal left, const goal right) { + if (lithium_same_goal(left, right)) return true; + if (!goal_is_sl(left) || !goal_is_sl(right)) return false; + term_list left_resources = lithium_acu_resources(goal_hcon(left)); + term_list right_resources = lithium_acu_resources(goal_hcon(right)); + if (vector_size(left_resources) != vector_size(right_resources)) { + return false; + } + term_list remaining = NULL; + return term_list_try_subtract(left_resources, right_resources, + &remaining) && + vector_size(remaining) == 0; +} + +PROOF static term_list lithium_context_resources(const gnode gn) { + labeled_term_list lhants = goal_lhants(gn->g); + term_list resources = (term_list)vector_create(); + for (size_t i = 0; i < vector_size(lhants); ++i) { + term_list current = strip_sl_resources(lhants[i].tm); + vector_append(&resources, current); + } + return resources; +} + +PROOF static bool lithium_spatial_labels_valid(const gnode gn) { + labeled_term_list lhants = goal_lhants(gn->g); + for (size_t i = 0; i < vector_size(lhants); ++i) { + if (lhants[i].lb == NULL) return false; + for (size_t j = 0; j < i; ++j) { + if (strcmp(lhants[i].lb, lhants[j].lb) == 0) return false; + } + } + return true; +} + +/* Count the consequent occurrences greedily covered by complete labeled + * hypotheses. This mirrors AUTO_FRAME's linear, context-order policy. */ +PROOF static size_t lithium_frame_score(const gnode gn) { + term_list remaining = strip_sl_resources(goal_hcon(gn->g)); + labeled_term_list lhants = goal_lhants(gn->g); + size_t score = 0; + for (size_t i = 0; i < vector_size(lhants); ++i) { + term_list current = strip_sl_resources(lhants[i].tm); + term_list next = NULL; + if (term_list_try_subtract(remaining, current, &next)) { + score += vector_size(current); + remaining = next; + } + } + return score; +} + +PROOF static bool lithium_hyp_step_relevant(const gnode before, + const gnode after) { + if (lithium_same_goal(before->g, after->g)) return false; + size_t before_score = lithium_frame_score(before); + size_t after_score = lithium_frame_score(after); + size_t before_resources = vector_size(lithium_context_resources(before)); + size_t after_resources = vector_size(lithium_context_resources(after)); + return after_score > before_score || after_resources < before_resources; +} + +/* The SL apply tactics report ordinary mismatch as an error but guarantee + * that failure occurs before child installation. Probe a private tree so rule + * selection never mutates the caller. proof_try is process-global and not + * nestable, hence the explicit precondition. */ +PROOF static gnode lithium_probe_goal_rule(const gnode gn, const thm theorem) { + ENSURE_COND(!proof_is_in_try(), + "Lithium theorem matching cannot run inside proof_try"); + bool applicable = HCON_APPLY_SLTAC_APPLICABLE(gn, theorem); + ENSURE_OK("Lithium consequent-rule preflight failed"); + if (!applicable) return empty_gnode; + gnode probe = gnode_new(gn->g); + proof_try_begin(); + gnode child = HCON_APPLY_SLTAC(probe, theorem); + bool failed = NOT_OK || child == NULL; + if (failed) SET_OK(); + proof_try_end(); + if (failed) { + proof_clear_errors(); + return empty_gnode; + } + if (lithium_same_goal_modulo_spatial_acu(gn->g, child->g)) { + return empty_gnode; + } + return child; +err: + ERR_FUN_PUTS("lithium_probe_goal_rule", cstr_gnode(gn), + cstr_thm(theorem)); + return empty_gnode; +} + +PROOF static gnode lithium_probe_hyp_rule(const gnode gn, const thm theorem) { + ENSURE_COND(!proof_is_in_try(), + "Lithium theorem matching cannot run inside proof_try"); + gnode probe = gnode_new(gn->g); + proof_try_begin(); + gnode child = AUTO_HANT_APPLY_SLTAC(probe, NULL, theorem); + bool failed = NOT_OK || child == NULL; + if (failed) SET_OK(); + proof_try_end(); + if (failed) { + proof_clear_errors(); + return empty_gnode; + } + if (!lithium_hyp_step_relevant(probe, child)) return empty_gnode; + return child; +err: + ERR_FUN_PUTS("lithium_probe_hyp_rule", cstr_gnode(gn), + cstr_thm(theorem)); + return empty_gnode; +} + +PROOF typedef enum { + LITHIUM_REGISTERED_LEADING, + LITHIUM_REGISTERED_HYP +} lithium_registered_phase; + +PROOF static lithium_step_result lithium_try_registered( + const gnode gn, const lithium_rule_set* rules, + const lithium_registered_phase phase) { + if (rules == NULL) return lithium_no_match(); + ENSURE_COND(lithium_rule_set_current(rules), + "Lithium rule set belongs to a stale SL theory generation"); + + for (size_t i = 0; i < vector_size(rules->entries); ++i) { + lithium_rule rule = rules->entries[i]; + if (rule.kind == LITHIUM_CUSTOM_RULE) { + if (phase != LITHIUM_REGISTERED_LEADING) continue; + bool matches = rule.matches(gn, rule.data); + ENSURE_OK("Lithium custom matcher(`%s`) failed", rule.name); + ENSURE_COND(IS_NULL(gn->solved) && + vector_size(gn->children) == 0, + "Lithium custom matcher(`%s`) mutated its input goal", + rule.name); + if (!matches) continue; + gnode_list leaves = rule.apply(gn, rule.data); + ENSURE_OK("Committed Lithium rule(`%s`) failed", rule.name); + ENSURE_COND(leaves != NULL, + "Committed Lithium rule(`%s`) failed", rule.name); + return lithium_applied(gn, leaves, rule.name); + } + if (!goal_is_sl(gn->g)) continue; + + bool try_goal = phase == LITHIUM_REGISTERED_LEADING && + (rule.kind == LITHIUM_ENTAIL_RULE || + rule.kind == LITHIUM_GOAL_RULE); + if (try_goal && lithium_probe_goal_rule(gn, rule.theorem) != NULL) { + gnode child = HCON_APPLY_SLTAC(gn, rule.theorem); + ENSURE_COND(child != NULL, + "Selected Lithium goal rule(`%s`) failed on commit", + rule.name); + return lithium_applied(gn, LIST_GNODE(child), rule.name); + } + + bool try_hyp = phase == LITHIUM_REGISTERED_HYP && + (rule.kind == LITHIUM_ENTAIL_RULE || + rule.kind == LITHIUM_HYP_RULE); + if (try_hyp && lithium_probe_hyp_rule(gn, rule.theorem) != NULL) { + gnode child = AUTO_HANT_APPLY_SLTAC(gn, NULL, rule.theorem); + ENSURE_COND(child != NULL, + "Selected Lithium hypothesis rule(`%s`) failed on commit", + rule.name); + return lithium_applied(gn, LIST_GNODE(child), rule.name); + } + } + return lithium_no_match(); +err: + ERR_FUN_PUTS("lithium_try_registered", cstr_gnode(gn)); + return lithium_error("registered-rule-error"); +} + +PROOF static bool lithium_resources_fit(const term target, + const term_list available) { + term_list needed = strip_sl_resources(target); + term_list ignored = NULL; + return term_list_try_subtract(available, needed, &ignored); +} + +PROOF static bool lithium_goal_has_fact(const term hcon) { + term_list conjuncts = strip_sl_sep(hcon); + for (size_t i = 0; i < vector_size(conjuncts); ++i) { + if (is_sl_fact(conjuncts[i])) return true; + } + return false; +} + +PROOF static bool lithium_goal_has_nested_exists(const term hcon) { + if (is_sl_exists(hcon)) return false; + term_list conjuncts = strip_sl_sep(hcon); + for (size_t i = 0; i < vector_size(conjuncts); ++i) { + if (is_sl_exists(conjuncts[i])) return true; + } + return false; +} + +PROOF static bool lithium_match_witness(const term binder, + const term pattern, + const term target, + term* witness) { + term_list local_constants = list_free_vars(TERM_LIST(pattern, target)); + local_constants = term_list_subtract(local_constants, TERM_LIST(binder)); + ENSURE_COND(!proof_is_in_try(), + "Existential witness matching cannot run inside proof_try"); + proof_try_begin(); + instantiation inst = term_match(local_constants, pattern, target); + bool failed = NOT_OK; + if (failed) SET_OK(); + proof_try_end(); + if (failed) { + proof_clear_errors(); + return false; + } + if (alpha_compare(instantiate(inst, pattern), target) != 0) return false; + term value = instantiate(inst, binder); + if (alpha_compare(value, binder) == 0) return false; + *witness = value; + return true; +err: + ERR_FUN_PUTS("lithium_match_witness", cstr_term(pattern), + cstr_term(target)); + return false; +} + +PROOF static bool lithium_infer_exists_witness(const gnode gn, + term* witness) { + dest_binder_results existential = dest_sl_exists(goal_hcon(gn->g)); + if (!var_free_in(existential.v, existential.tm)) { + *witness = genvar(type_of(existential.v)); + return true; + } + + term_list patterns = strip_sl_sep(existential.tm); + labeled_term_list lhants = goal_lhants(gn->g); + for (size_t i = 0; i < vector_size(patterns); ++i) { + if (!var_free_in(existential.v, patterns[i])) continue; + for (size_t j = 0; j < vector_size(lhants); ++j) { + term_list candidates = strip_sl_sep(lhants[j].tm); + for (size_t k = 0; k < vector_size(candidates); ++k) { + if (lithium_match_witness(existential.v, patterns[i], + candidates[k], witness)) { + return true; + } + } + } + labeled_term_list assumptions = goal_lasmps(gn->g); + for (size_t j = 0; j < vector_size(assumptions); ++j) { + term candidate = mk_sl_fact(assumptions[j].tm); + if (lithium_match_witness(existential.v, patterns[i], candidate, + witness)) { + return true; + } + } + } + return false; +} + +/* ------------------------------------------------------------------------- */ +/* Built-in deterministic steps */ +/* ------------------------------------------------------------------------- */ + +PROOF static lithium_step_result lithium_general_step( + const gnode gn, const lithium_options options) { + /* Like Lithium's leading liTactic entry, an explicitly registered custom + * rule may override the ordinary connective interpreter. */ + lithium_step_result registered = + lithium_try_registered(gn, options.rules, + LITHIUM_REGISTERED_LEADING); + if (registered.kind != LITHIUM_NO_MATCH) return registered; + + term ccl = goal_ccl(gn->g); + if (is_forall(ccl) || is_imp(ccl) || is_not(ccl)) { + gnode child = AUTO_INTROS_TAC(gn); + return lithium_applied(gn, LIST_GNODE(child), "intro"); + } + if (is_sl_ent(ccl)) { + gnode_list leaves = SL_MODE(gn, "H"); + return lithium_applied(gn, leaves, "enter-sl"); + } + + labeled_term_list assumptions = goal_lasmps(gn->g); + for (size_t i = 0; i < vector_size(assumptions); ++i) { + if (alpha_compare(assumptions[i].tm, ccl) == 0) { + ACCEPT_TAC(gn, assume_rule(assumptions[i].tm)); + return lithium_applied(gn, LIST_GNODE(), "pure-assumption"); + } + } + if (is_true(ccl)) { + ACCEPT_TAC(gn, eqt_elim_rule(refl_rule(mk_true()))); + return lithium_applied(gn, LIST_GNODE(), "pure-true"); + } + if (is_eq(ccl)) { + dest_eq_results equality = dest_eq(ccl); + if (alpha_compare(equality.tm1, equality.tm2) == 0) { + ACCEPT_TAC(gn, refl_rule(equality.tm1)); + return lithium_applied(gn, LIST_GNODE(), "pure-reflexivity"); + } + } + if (is_conj(ccl)) { + return lithium_applied(gn, CONJ_TAC(gn), "pure-conjunction"); + } + if (is_disj(ccl)) { + dest_disj_results alternatives = dest_disj(ccl); + bool choose_left = false; + bool choose_right = false; + for (size_t i = 0; i < vector_size(assumptions); ++i) { + choose_left = choose_left || + alpha_compare(assumptions[i].tm, alternatives.tm1) == 0; + choose_right = choose_right || + alpha_compare(assumptions[i].tm, alternatives.tm2) == 0; + } + gnode child = (!choose_left && choose_right) + ? DISJ2_TAC(gn) + : DISJ1_TAC(gn); + return lithium_applied(gn, LIST_GNODE(child), "pure-disjunction"); + } + return lithium_no_match(); +err: + ERR_FUN_PUTS("lithium_general_step", cstr_gnode(gn)); + return lithium_error("general-step-error"); +} + +/* Spatial facts behave like the duplicable pure context in the currently + * installed C* logic. Expose them before linear cancellation, otherwise a + * greedy frame can consume the only syntactic fact occurrence before a + * duplicated fact obligation is generated. Only separating conjunctions on + * the path to a fact are opened here; unrelated structural assertions retain + * the ordinary left-step order. */ +PROOF static bool lithium_sep_contains_fact(const term assertion) { + term_list conjuncts = strip_sl_sep(assertion); + for (size_t i = 0; i < vector_size(conjuncts); ++i) { + if (is_sl_fact(conjuncts[i])) return true; + } + return false; +} + +PROOF static lithium_step_result lithium_fact_step(const gnode gn) { + labeled_term_list lhants = goal_lhants(gn->g); + for (size_t i = 0; i < vector_size(lhants); ++i) { + const char* label = lhants[i].lb; + term assertion = lhants[i].tm; + if (is_sl_fact(assertion)) { + term fact = dest_sl_fact(assertion); + if (is_false(fact)) { + CONTR_SLTAC(gn, label); + return lithium_applied(gn, LIST_GNODE(), "left-false"); + } + gnode child = INTRO_FACT_SLTAC(gn, CONST_STRING_LIST(label)); + return lithium_applied(gn, LIST_GNODE(child), "left-fact"); + } + if (is_sl_sep(assertion) && lithium_sep_contains_fact(assertion)) { + gnode child = HANT_SEP_SLTAC(gn, label, NULL, NULL); + return lithium_applied(gn, LIST_GNODE(child), "left-sep-to-fact"); + } + } + return lithium_no_match(); +err: + ERR_FUN_PUTS("lithium_fact_step", cstr_gnode(gn)); + return lithium_error("fact-step-error"); +} + +PROOF static lithium_step_result lithium_left_step(const gnode gn) { + labeled_term_list lhants = goal_lhants(gn->g); + term_list goal_resources = strip_sl_resources(goal_hcon(gn->g)); + + /* A wand consumes its argument linearly and appends the codomain. Match in + * context order and commit the first exact domain occurrence. */ + for (size_t i = 0; i < vector_size(lhants); ++i) { + if (!is_sl_wand(lhants[i].tm)) continue; + term domain = dest_sl_wand(lhants[i].tm).tm1; + for (size_t j = 0; j < vector_size(lhants); ++j) { + if (i == j || alpha_compare(domain, lhants[j].tm) != 0) continue; + gnode child = WAND_MP_SLTAC( + gn, lhants[i].lb, lhants[j].lb, NULL); + return lithium_applied(gn, LIST_GNODE(child), "left-wand-apply"); + } + } + + for (size_t i = 0; i < vector_size(lhants); ++i) { + const char* label = lhants[i].lb; + term hant = lhants[i].tm; + if (is_sl_sep(hant)) { + gnode child = HANT_SEP_SLTAC(gn, label, NULL, NULL); + return lithium_applied(gn, LIST_GNODE(child), "left-sep"); + } + if (is_sl_or(hant)) { + return lithium_applied(gn, + HANT_DISJ_SLTAC(gn, label, NULL, NULL), + "left-disjunction"); + } + if (is_sl_exists(hant)) { + gnode child = HANT_EXISTS_SLTAC(gn, label, NULL); + return lithium_applied(gn, LIST_GNODE(child), "left-exists"); + } + if (is_sl_fact(hant)) { + term fact = dest_sl_fact(hant); + if (is_false(fact)) { + CONTR_SLTAC(gn, label); + return lithium_applied(gn, LIST_GNODE(), "left-false"); + } + gnode child = INTRO_FACT_SLTAC(gn, CONST_STRING_LIST(label)); + return lithium_applied(gn, LIST_GNODE(child), "left-fact"); + } + if (is_sl_emp(hant)) { + gnode child = CLEAN_SLTAC(gn); + return lithium_applied(gn, LIST_GNODE(child), "left-unit"); + } + if (is_sl_and(hant)) { + dest_binop_results choices = dest_sl_and(hant); + term_list ignored = NULL; + bool left_fits = term_list_try_subtract( + goal_resources, strip_sl_resources(choices.tm1), &ignored); + bool right_fits = term_list_try_subtract( + goal_resources, strip_sl_resources(choices.tm2), &ignored); + if (left_fits || right_fits) { + size_t left_score = + left_fits ? vector_size(strip_sl_resources(choices.tm1)) : 0; + size_t right_score = + right_fits ? vector_size(strip_sl_resources(choices.tm2)) : 0; + bool select_left = left_fits && + (!right_fits || left_score >= right_score); + thm projection = + select_left + ? ispecl_rule(TERM_LIST(choices.tm1, choices.tm2), + sl_and_elim1()) + : ispecl_rule(TERM_LIST(choices.tm1, choices.tm2), + sl_and_elim2()); + gnode child = HANT_APPLY_SLTAC( + gn, CONST_STRING_LIST(label), label, projection); + return lithium_applied(gn, LIST_GNODE(child), "left-and-project"); + } + } + } + return lithium_no_match(); +err: + ERR_FUN_PUTS("lithium_left_step", cstr_gnode(gn)); + return lithium_error("left-step-error"); +} + +PROOF static lithium_step_result lithium_frame_step(const gnode gn) { + labeled_term_list lhants = goal_lhants(gn->g); + term_list remaining = strip_sl_resources(goal_hcon(gn->g)); + const_cstr_list labels = (const_cstr_list)vector_create(); + for (size_t i = 0; i < vector_size(lhants); ++i) { + term_list resources = strip_sl_resources(lhants[i].tm); + term_list next = NULL; + if (vector_size(resources) != 0 && + term_list_try_subtract(remaining, resources, &next)) { + vector_add(&labels, lhants[i].lb); + remaining = next; + } + } + if (vector_size(labels) != 0) { + gnode child = FRAME_SLTAC(gn, labels); + return lithium_applied(gn, LIST_GNODE(child), "direct-frame"); + } + if (is_sl_emp(goal_hcon(gn->g)) && + vector_size(lithium_context_resources(gn)) == 0) { + EMP_SLTAC(gn); + return lithium_applied(gn, LIST_GNODE(), "emp"); + } + return lithium_no_match(); +err: + ERR_FUN_PUTS("lithium_frame_step", cstr_gnode(gn)); + return lithium_error("frame-step-error"); +} + +PROOF static lithium_step_result lithium_right_step(const gnode gn) { + term hcon = goal_hcon(gn->g); + + if (sl_update_theory_is_installed() && is_sl_bupd(hcon)) { + labeled_term_list lhants = goal_lhants(gn->g); + if (vector_size(lhants) == 1 && is_sl_bupd(lhants[0].tm)) { + gnode child = BUPD_MONO_SLTAC(gn); + return lithium_applied(gn, LIST_GNODE(child), "bupd-mono"); + } + gnode child = BUPD_INTRO_SLTAC(gn); + return lithium_applied(gn, LIST_GNODE(child), "bupd-intro"); + } + if (lithium_goal_has_fact(hcon)) { + return lithium_applied(gn, PURE_SLTAC(gn), "right-fact"); + } + if (lithium_goal_has_nested_exists(hcon)) { + gnode child = EXISTS_PULL_SLTAC(gn); + return lithium_applied(gn, LIST_GNODE(child), "pull-exists"); + } + if (is_sl_and(hcon)) { + return lithium_applied(gn, LITHIUM_AND_SLTAC(gn), "right-and"); + } + if (is_sl_or(hcon)) { + dest_binop_results alternatives = dest_sl_or(hcon); + term_list resources = lithium_context_resources(gn); + bool left_fits = lithium_resources_fit(alternatives.tm1, resources); + bool right_fits = lithium_resources_fit(alternatives.tm2, resources); + size_t left_score = + left_fits ? vector_size(strip_sl_resources(alternatives.tm1)) : 0; + size_t right_score = + right_fits ? vector_size(strip_sl_resources(alternatives.tm2)) : 0; + bool choose_right = right_fits && + (!left_fits || right_score > left_score); + gnode child = choose_right ? DISJ2_SLTAC(gn) : DISJ1_SLTAC(gn); + return lithium_applied(gn, LIST_GNODE(child), "right-disjunction"); + } + if (is_sl_wand(hcon)) { + return lithium_applied(gn, INTRO_WAND_SLTAC(gn, NULL), "right-wand"); + } + if (is_sl_exists(hcon)) { + term witness; + if (!lithium_infer_exists_witness(gn, &witness)) { + return lithium_no_match(); + } + gnode child = EXISTS_SLTAC(gn, witness); + return lithium_applied(gn, LIST_GNODE(child), "right-exists"); + } + if (is_sl_forall(hcon)) { + gnode child = LITHIUM_FORALL_SLTAC(gn, NULL); + return lithium_applied(gn, LIST_GNODE(child), "right-forall"); + } + return lithium_no_match(); +err: + ERR_FUN_PUTS("lithium_right_step", cstr_gnode(gn)); + return lithium_error("right-step-error"); +} + +PROOF lithium_step_result LITHIUM_STEP_SLTAC( + const gnode gn, const lithium_options options) { + ENSURE_COND(!proof_is_in_try(), + "Lithium cannot run inside an active proof_try region"); + ENSURE_COND(gn != NULL, "Lithium goal node is null"); + ENSURE_COND(IS_NULL(gn->solved), "Lithium goal node is already solved"); + ENSURE_COND(vector_size(gn->children) == 0, + "A Lithium step requires an open proof-tree leaf"); + ENSURE_COND(options.rules == NULL || + lithium_rule_set_current(options.rules), + "Lithium rule set belongs to a stale SL theory generation"); + + if (goal_is_general(gn->g)) { + return lithium_general_step(gn, options); + } + ENSURE_COND(goal_is_sl(gn->g), + "Lithium supports only general and SL goals"); + ENSURE_COND(lithium_spatial_labels_valid(gn), + "Lithium requires non-null, pairwise-distinct spatial labels"); + + /* Custom and consequent rules form a liTactic-style leading phase and may + * override the fixed connective interpreter. Forward hypothesis rewrites + * are delayed until direct lookup and structural exposure have had a chance + * to use the original resource. */ + lithium_step_result step = + lithium_try_registered(gn, options.rules, + LITHIUM_REGISTERED_LEADING); + if (step.kind != LITHIUM_NO_MATCH) return step; + step = lithium_fact_step(gn); + if (step.kind != LITHIUM_NO_MATCH) return step; + step = lithium_frame_step(gn); + if (step.kind != LITHIUM_NO_MATCH) return step; + step = lithium_left_step(gn); + if (step.kind != LITHIUM_NO_MATCH) return step; + step = lithium_try_registered(gn, options.rules, + LITHIUM_REGISTERED_HYP); + if (step.kind != LITHIUM_NO_MATCH) return step; + return lithium_right_step(gn); +err: + ERR_FUN_PUTS("LITHIUM_STEP_SLTAC", lithium_cstr_gnode_or_null(gn)); + return lithium_error("step-error"); +} + +PROOF gnode_list LITHIUM_SLTAC(const gnode gn, + const lithium_options options) { + ENSURE_COND(!proof_is_in_try(), + "Lithium cannot run inside an active proof_try region"); + ENSURE_COND(gn != NULL, "Lithium root node is null"); + ENSURE_COND(options.max_steps != 0, + "Lithium max_steps must be positive"); + ENSURE_COND(options.rules == NULL || + lithium_rule_set_current(options.rules), + "Lithium rule set belongs to a stale SL theory generation"); + + gnode_list work = gnode_leaves(gn); + ENSURE_COND(work != NULL, + "Could not obtain the Lithium input frontier"); + gnode_list stuck = (gnode_list)vector_create(); + size_t cursor = 0; + size_t committed = 0; + while (cursor < vector_size(work)) { + gnode current = work[cursor++]; + ENSURE_COND(current != NULL, + "Lithium worklist contains a null proof-tree leaf"); + if (!IS_NULL(current->solved)) continue; + gnode before = options.trace == NULL ? NULL : gnode_new(current->g); + lithium_step_result step = LITHIUM_STEP_SLTAC(current, options); + ENSURE_COND(step.kind != LITHIUM_ERROR, + "Lithium interpreter step failed"); + if (step.kind == LITHIUM_NO_MATCH) { + vector_add(&stuck, current); + continue; + } + ENSURE_COND(committed < options.max_steps, + "Lithium exhausted its %zu-step fuel", options.max_steps); + ++committed; + if (options.trace != NULL) { + options.trace(step.rule_name, before, step.leaves, + options.trace_data); + ENSURE_OK("Lithium trace callback failed"); + } + if (step.leaves != NULL) vector_append(&work, step.leaves); + } + + if (vector_size(stuck) == 0) { + thm proved = gnode_prove(gn); + ENSURE_COND(!IS_NULL(proved), + "Lithium produced an invalid completed proof tree"); + return (gnode_list)vector_create(); + } + /* Work is scheduled breadth-first, but the public frontier follows proof + * tree order just like `gnode_leaves`. */ + return gnode_leaves(gn); +err: + ERR_FUN_PUTS("LITHIUM_SLTAC", lithium_cstr_gnode_or_null(gn)); + return NULL; +} diff --git a/proof_lithium.h b/proof_lithium.h new file mode 100644 index 0000000..468c74c --- /dev/null +++ b/proof_lithium.h @@ -0,0 +1,224 @@ +/** + * Lithium-inspired, rule-extensible goal-directed SL entailment automation. + * + * The interpreter is intentionally a search policy rather than a new proof + * rule. Every successful step expands an ordinary validated proof tree using + * `proof_backward`/`proof_backward_sl`; a registered theorem is accepted only + * through the same theorem-application validators as a handwritten proof. + * + * ## Search discipline + * + * Phase precedence is stronger than numeric priority: leading custom/GOAL + * rules are considered before structural interpretation, while HYP rules are + * considered later. Within either registered phase, rules are ordered by + * ascending numeric priority and then registration order. The first applicable + * rule in that phase is committed. Matchers may perform their own finite + * candidate search, but failure of selected recursive leaves never reopens the + * rule choice. + * + * `LITHIUM_GOAL_RULE` is the identity-modality C* analogue of RefinedC's + * `lemma_to_li_entails`: a theorem `P |-- Q` reduces a whole consequent that + * matches `Q` modulo spatial ACU to `P`, leaving the spatial context unchanged. + * It does not implicitly frame the theorem. `LITHIUM_HYP_RULE` is a smaller, + * binary forward-rewrite convenience, + * not a complete implementation of Lithium's continuation-aware + * `SimplifyHyp` or `Subsume` judgments. `LITHIUM_ENTAIL_RULE` opts into both + * directions. Leading theorem universals are matched; discharged HOL premises + * must already be available in the ordinary context before a rule can commit. + * + * The built-in interpreter normalizes left `**`, `||`, existential and fact + * assertions; consumes matching resources linearly; and handles right facts, + * additive conjunction/disjunction, wand, existential, universal, and an + * installed basic-update modality. It never silently weakens or duplicates a + * spatial resource. + */ + +#pragma once + +#include "proof/proof_backward_sl.h" +#require "proof/proof_backward_sl.c" + +/** How a registered rule is interpreted. */ +PROOF typedef enum { + /** C* convenience: enable both GOAL and HYP interpretations below. */ + LITHIUM_ENTAIL_RULE, + /** Exact consequent reduction; the `lemma_to_li_entails` analogue. */ + LITHIUM_GOAL_RULE, + /** Restricted binary forward rewrite of matching spatial hypotheses. */ + LITHIUM_HYP_RULE, + /** Delegate applicability and one committed proof-tree step to callbacks. */ + LITHIUM_CUSTOM_RULE +} lithium_rule_kind; + +/** + * Pure applicability test for a custom rule. + * + * Return false for an ordinary mismatch without setting prover error status or + * mutating `gn`. A true result commits the rule; its apply callback is then + * called exactly once on the real proof tree. + */ +PROOF typedef bool (*lithium_rule_matcher)(const gnode gn, + const void* data); + +/** + * Apply one already-selected custom rule. + * + * Return exactly the rule subtree's complete unsolved frontier in proof order, + * or an empty vector after closing the node. `NULL`, a null element, an omitted + * leaf, or an extra leaf is rejected as an actual tactic error. The callback + * must use validated tactics/proof-tree expansion; this interface does not + * make an unsafe callback sound. + */ +PROOF typedef gnode_list (*lithium_rule_tactic)(const gnode gn, + const void* data); + +/** One copied entry in a caller-owned rule set. */ +PROOF typedef struct { + const char* name; + size_t priority; + size_t order; + lithium_rule_kind kind; + thm theorem; + lithium_rule_matcher matches; + lithium_rule_tactic apply; + const void* data; +} lithium_rule; + +/** + * An ordered rule collection tied to one installed SL-theory generation. + * + * The vector is prover/GC managed. Copying this struct shares that vector, so + * pass a pointer to one logical owner while adding entries. + */ +PROOF typedef struct { + lithium_rule* entries; + size_t next_order; + size_t theory_generation; +} lithium_rule_set; + +/** Create an empty rule set for the active SL theory. */ +PROOF lithium_rule_set lithium_rule_set_new(void); + +/** + * Register a proved SL equality or entailment. + * + * Outer universals and leading implications are supported by the existing SL + * theorem matcher. `name` is copied. Within the rule's eligible phase, lower + * priorities run first and equal priorities retain registration order. Return + * zero on success and `-1` for a malformed theorem/rule set. + */ +PROOF int lithium_rule_set_add_theorem(lithium_rule_set* rules, + const char* name, size_t priority, + lithium_rule_kind kind, + const thm theorem); + +/** + * Register a callback rule with the same stable priority ordering. + * + * `data` is borrowed and must outlive every search using this set or a bundle + * produced from it by `lithium_rule_set_append`. + */ +PROOF int lithium_rule_set_add_custom(lithium_rule_set* rules, + const char* name, size_t priority, + lithium_rule_matcher matches, + lithium_rule_tactic apply, + const void* data); + +/** + * Append copied entries from another current-theory rule set. + * + * The backing vector is re-sorted by numeric priority, while dispatch still + * filters by phase first. At equal priority, existing destination entries + * precede appended entries, whose source order is retained. This lets + * independent modules publish rule bundles without process-global mutable + * registration. Self-append, aliased shallow-copy append, and stale sets fail. + */ +PROOF int lithium_rule_set_append(lithium_rule_set* destination, + const lithium_rule_set* source); + +/** Number of registered rules. */ +PROOF size_t lithium_rule_set_size(const lithium_rule_set* rules); + +/** Result of one interpreter step. */ +PROOF typedef enum { + LITHIUM_NO_MATCH, + LITHIUM_APPLIED, + LITHIUM_CLOSED, + LITHIUM_ERROR +} lithium_step_kind; + +PROOF typedef struct { + lithium_step_kind kind; + gnode_list leaves; + const char* rule_name; +} lithium_step_result; + +/** + * Optional trace called once after every committed step. + * + * `before` is a fresh shallow node containing the goal immediately before the + * step; it is an inspection snapshot, not the node that was expanded. `after` + * is the exact unresolved frontier of the real expanded subtree. + */ +PROOF typedef void (*lithium_trace_callback)(const char* rule_name, + const gnode before, + const gnode_list after, + const void* data); + +/** Solver configuration. A null rule set means structural rules only. */ +PROOF typedef struct { + const lithium_rule_set* rules; + size_t max_steps; + lithium_trace_callback trace; + const void* trace_data; +} lithium_options; + +/** Build options with 4096 steps and tracing disabled. */ +PROOF lithium_options lithium_options_default( + const lithium_rule_set* rules); + +/** + * Split a right additive conjunction using the full spatial context in both + * children. This fills a primitive gap in `proof_backward_sl` and validates + * with `conj_slrule`. + */ +PROOF gnode_list LITHIUM_AND_SLTAC(const gnode gn); + +/** + * Introduce a fresh eigenvariable for a right SL universal. + * + * A null name requests a fresh variant. Validation uses `forall_slrule` and + * therefore checks the eigenvariable side condition bottom-up. + */ +PROOF gnode LITHIUM_FORALL_SLTAC(const gnode gn, const char* var_name); + +/** + * Perform exactly one committed interpreter step on an open leaf. + * + * The leaf must be unsolved and have no children. SL leaves additionally need + * non-null, pairwise-distinct spatial labels. This function must not run inside + * an active `proof_try` region. + */ +PROOF lithium_step_result LITHIUM_STEP_SLTAC( + const gnode gn, const lithium_options options); + +/** + * Repeatedly solve every generated leaf until all close, no rule matches, or + * `max_steps` committed steps have been used. + * + * `gn` may be a fresh root or a partially expanded unsolved tree; search + * continues from its current leaves without replacing existing internal + * expansions. `LITHIUM_STEP_SLTAC` itself requires one open leaf. Neither API + * may be called inside an active `proof_try` region because theorem and witness + * probing use that process-global facility internally. + * + * General goals are first introduced and SL entailments enter SL mode. The + * return value is the ordered unresolved frontier; an empty vector means the + * input proof tree is complete. Getting stuck is a normal result and does not + * set prover error status. Malformed rules, callback failures, stale theory + * generations, or needing another committed step after exhausting fuel report + * an error and return `NULL`; a no-match leaf at the exact fuel boundary is + * still returned normally. + */ +PROOF gnode_list LITHIUM_SLTAC(const gnode gn, + const lithium_options options); diff --git a/proof_sl.c b/proof_sl.c index a977dbc..2841600 100644 --- a/proof_sl.c +++ b/proof_sl.c @@ -2005,6 +2005,39 @@ err: return empty_theorem; } +PROOF thm forall_slrule(const term v, const thm ent) { + ENSURE_COND(is_var(v), "Universal introduction binder must be a variable"); + dest_binop_results endpoints = dest_sl_ent(concl(ent)); + term hant = endpoints.tm1; + term hcon = endpoints.tm2; + ENSURE_COND(!var_free_in(v, hant), + "Universal introduction binder(`%s`) occurs in the antecedent", + string_of_term(v)); + + term family = mk_abs(v, hcon); + thm intro = ispecl_rule(TERM_LIST(hant, family), sl_forall_intro()); + + /* Specialization creates exactly two applications of `family`: one in the + * universally quantified premise and one below the target SL binder. Keep + * beta conversion confined to those generated redexes. */ + conv beta = get_conversion_by_name("BETA_CONV"); + conv premise_application = land_conv(binder_conv(rand_conv(beta))); + conv target_application = + rand_conv(rand_conv(rand_conv(binder_conv(beta)))); + intro = conv_rule( + then_conv(premise_application, target_application), intro); + + thm pointwise = gen_rule(v, ent); + thm result = match_mp_rule(intro, pointwise); + term exact_hcon = mk_sl_forall(v, hcon); + result = rehant_slrule(result, hant); + result = rehcon_slrule(result, exact_hcon); + return result; +err: + ERR_FUN_PUTS("forall_slrule", cstr_term(v), cstr_thm(ent)); + return empty_theorem; +} + /* Apply the cached eta-short monotonicity theorem once. Specializing its * premise introduces exactly the two redexes selected below; its endpoints * are already `EX (\v. H)` and `EX (\v. K)`. */ diff --git a/proof_sl.h b/proof_sl.h index a293842..c188e82 100644 --- a/proof_sl.h +++ b/proof_sl.h @@ -1331,6 +1331,23 @@ PROOF thm choose_slrule(const term v, const term ehp, const thm ent); */ PROOF thm exists_slrule(const term ehp, const term wit, const thm ent); +/** + * Introduce an SL universal in an entailment consequent. + * + * ```text + * 𝒜 ⊢ (H ⊢SL K) + * ------------------------------------------ forall_slrule x + * 𝒜 ⊢ (H ⊢SL (∀SL x. K)) + * ``` + * + * Require `x` to be a variable absent from `H` and every theorem hypothesis. + * The result preserves the exact antecedent and binds the free occurrences of + * `x` in `K`. Existing beta-redexes in caller-owned assertions are retained; + * only the family applications introduced while specializing the installed + * universal-introduction theorem are contracted. + */ +PROOF thm forall_slrule(const term v, const thm ent); + /** * Pull an actual left existential through separating conjunction. * diff --git a/test/proof_lithium_regression.c b/test/proof_lithium_regression.c new file mode 100644 index 0000000..ba9ddfd --- /dev/null +++ b/test/proof_lithium_regression.c @@ -0,0 +1,547 @@ +#include "proof/proof.h" +#include "userlib/qcp/c_logic_default.h" +#require "userlib/qcp/c_logic_default.c" + +/** Regression coverage for the Lithium-inspired committed entailment solver. */ + +PROOF static thm lithium_prove(const term proposition, + const lithium_rule_set* rules) { + gnode root = gnode_new_with_ccl(proposition); + lithium_options options = lithium_options_default(rules); + gnode_list leaves = LITHIUM_SLTAC(root, options); + ENSURE_COND(leaves != NULL && vector_size(leaves) == 0, + "Lithium left an unexpected open goal"); + return gnode_prove(root); +err: + ERR_FUN_PUTS("lithium_prove", cstr_term(proposition)); + return empty_theorem; +} + +PROOF static gnode_list lithium_stuck(const term proposition, + const lithium_rule_set* rules) { + gnode root = gnode_new_with_ccl(proposition); + lithium_options options = lithium_options_default(rules); + gnode_list leaves = LITHIUM_SLTAC(root, options); + ENSURE_COND(leaves != NULL && vector_size(leaves) != 0, + "Lithium unexpectedly proved a negative regression"); + return leaves; +err: + ERR_FUN_PUTS("lithium_stuck", cstr_term(proposition)); + return NULL; +} + +PROOF typedef struct { + size_t count; + const char* sequence[64]; + bool invalid_before_snapshot; +} lithium_trace_log; + +PROOF static void record_lithium_trace(const char* rule_name, + const gnode before, + const gnode_list after, + const void* data) { + (void)before; + (void)after; + lithium_trace_log* log = (lithium_trace_log*)data; + if (before == NULL || !IS_NULL(before->solved) || + vector_size(before->children) != 0) { + log->invalid_before_snapshot = true; + } + if (log->count < 64) log->sequence[log->count] = rule_name; + ++log->count; +} + +PROOF static size_t lithium_trace_count(const lithium_trace_log* log, + const char* rule_name) { + size_t result = 0; + size_t limit = log->count < 64 ? log->count : 64; + for (size_t i = 0; i < limit; ++i) { + if (strcmp(log->sequence[i], rule_name) == 0) ++result; + } + return result; +} + +PROOF static int lithium_trace_index(const lithium_trace_log* log, + const char* rule_name) { + size_t limit = log->count < 64 ? log->count : 64; + for (size_t i = 0; i < limit; ++i) { + if (strcmp(log->sequence[i], rule_name) == 0) return (int)i; + } + return -1; +} + +PROOF static thm lithium_prove_traced(const term proposition, + const lithium_rule_set* rules, + lithium_trace_log* log) { + gnode root = gnode_new_with_ccl(proposition); + lithium_options options = lithium_options_default(rules); + options.trace = record_lithium_trace; + options.trace_data = log; + gnode_list leaves = LITHIUM_SLTAC(root, options); + ENSURE_COND(leaves != NULL && vector_size(leaves) == 0, + "Traced Lithium proof left an unexpected open goal"); + ENSURE_COND(!log->invalid_before_snapshot, + "Lithium trace did not receive a pre-step snapshot"); + return gnode_prove(root); +err: + ERR_FUN_PUTS("lithium_prove_traced", cstr_term(proposition)); + return empty_theorem; +} + +PROOF static gnode_list lithium_stuck_traced(const term proposition, + const lithium_rule_set* rules, + lithium_trace_log* log) { + gnode root = gnode_new_with_ccl(proposition); + lithium_options options = lithium_options_default(rules); + options.trace = record_lithium_trace; + options.trace_data = log; + gnode_list leaves = LITHIUM_SLTAC(root, options); + ENSURE_COND(leaves != NULL && vector_size(leaves) != 0, + "Traced Lithium negative regression unexpectedly closed"); + ENSURE_COND(!log->invalid_before_snapshot, + "Lithium trace did not receive a pre-step snapshot"); + return leaves; +err: + ERR_FUN_PUTS("lithium_stuck_traced", cstr_term(proposition)); + return NULL; +} + +PROOF static bool choose_right_matches(const gnode gn, const void* data) { + (void)data; + return goal_is_sl(gn->g) && is_sl_or(goal_hcon(gn->g)); +} + +PROOF static gnode_list choose_right_apply(const gnode gn, + const void* data) { + (void)data; + return LIST_GNODE(DISJ2_SLTAC(gn)); +} + +PROOF static bool always_matches(const gnode gn, const void* data) { + (void)gn; + (void)data; + return true; +} + +PROOF static gnode_list malformed_null_apply(const gnode gn, + const void* data) { + (void)gn; + (void)data; + return LIST_GNODE(NULL); +} + +PROOF static void check_committed_priority(void) { + term good = `hp_good:cprop`; + term bad = `hp_bad:cprop`; + term target = mk_sl_or(good, bad); + thm high_bad = ispecl_rule(TERM_LIST(good, bad), sl_or_intro2()); + thm low_good = ispecl_rule(TERM_LIST(good, bad), sl_or_intro1()); + + /* Register and compose in the opposite order from numeric priority. */ + lithium_rule_set low_bundle = lithium_rule_set_new(); + lithium_rule_set high_bundle = lithium_rule_set_new(); + ENSURE_COND(lithium_rule_set_add_theorem( + &low_bundle, "low-good", 10, + LITHIUM_GOAL_RULE, low_good) == 0 && + lithium_rule_set_add_theorem( + &high_bundle, "high-bad", 1, + LITHIUM_GOAL_RULE, high_bad) == 0, + "Could not construct priority rule bundles"); + lithium_rule_set rules = lithium_rule_set_new(); + ENSURE_COND(lithium_rule_set_append(&rules, &low_bundle) == 0 && + lithium_rule_set_append(&rules, &high_bundle) == 0 && + lithium_rule_set_size(&rules) == 2, + "Could not compose priority rule bundles"); + + gnode root = gnode_new_with_ccl(mk_sl_ent(good, target)); + lithium_trace_log log = {0}; + lithium_options options = lithium_options_default(&rules); + options.trace = record_lithium_trace; + options.trace_data = &log; + gnode_list leaves = LITHIUM_SLTAC(root, options); + ENSURE_COND(leaves != NULL && vector_size(leaves) == 1 && + log.count >= 2 && + strcmp(log.sequence[0], "enter-sl") == 0 && + strcmp(log.sequence[1], "high-bad") == 0, + "Committed-priority regression did not reach its selected rule"); + + /* The trace starts with enter-sl; inspect the selected goal-rule expansion + * itself. It must reduce the target to bad and must not try low-good after + * that recursive goal gets stuck. */ + gnode stuck = leaves[0]; + ENSURE_COND(goal_is_sl(stuck->g) && + alpha_compare(goal_hcon(stuck->g), bad) == 0 && + lithium_trace_count(&log, "high-bad") == 1 && + lithium_trace_count(&log, "low-good") == 0, + "Lithium backtracked from the committed high-priority rule"); + + /* Equal priorities retain registration order. */ + lithium_rule_set equal_first_bundle = lithium_rule_set_new(); + lithium_rule_set equal_second_bundle = lithium_rule_set_new(); + ENSURE_COND(lithium_rule_set_add_theorem( + &equal_first_bundle, "first-bad", 5, + LITHIUM_GOAL_RULE, high_bad) == 0 && + lithium_rule_set_add_theorem( + &equal_second_bundle, "second-good", 5, + LITHIUM_GOAL_RULE, low_good) == 0, + "Could not register equal-priority rules"); + lithium_rule_set equal_rules = lithium_rule_set_new(); + ENSURE_COND(lithium_rule_set_append( + &equal_rules, &equal_first_bundle) == 0 && + lithium_rule_set_append( + &equal_rules, &equal_second_bundle) == 0, + "Could not append equal-priority rule bundles"); + lithium_trace_log equal_log = {0}; + gnode_list equal_leaves = lithium_stuck_traced( + mk_sl_ent(good, target), &equal_rules, &equal_log); + ENSURE_COND(equal_leaves != NULL && + lithium_trace_count(&equal_log, "first-bad") == 1 && + lithium_trace_count(&equal_log, "second-good") == 0, + "Equal-priority Lithium rules did not retain source order"); + + lithium_rule_set good_rules = lithium_rule_set_new(); + ENSURE_COND(lithium_rule_set_add_theorem( + &good_rules, "low-good", 10, + LITHIUM_GOAL_RULE, low_good) == 0, + "Could not register independently usable lower rule"); + lithium_trace_log low_log = {0}; + thm proved = lithium_prove_traced( + mk_sl_ent(good, target), &good_rules, &low_log); + ENSURE_COND(!IS_NULL(proved) && + lithium_trace_count(&low_log, "low-good") == 1, + "The lower-priority rule was not independently usable"); + return; +err: + ERR_FUN_PUTS("check_committed_priority"); +} + +PROOF static int proof_lithium_regression(void) { + thm reflexivity = lithium_prove( + `(hp_a:cprop) |-- hp_a`, NULL); + thm sep_unit = lithium_prove( + `emp ** (hp_a:cprop) |-- hp_a`, NULL); + thm sep_comm = lithium_prove( + `(hp_a:cprop) ** hp_b |-- hp_b ** hp_a`, NULL); + thm duplicate = lithium_prove( + `(hp_a:cprop) ** hp_b ** hp_a |-- hp_a ** hp_a ** hp_b`, NULL); + + gnode_list no_weakening = lithium_stuck( + `(hp_a:cprop) ** hp_b |-- hp_a`, NULL); + gnode_list no_duplication = lithium_stuck( + `(hp_a:cprop) |-- hp_a ** hp_a`, NULL); + + thm right_and = lithium_prove( + `(hp_a:cprop) |-- hp_a && hp_a`, NULL); + thm left_and_1 = lithium_prove( + `(hp_a:cprop) && hp_b |-- hp_a`, NULL); + thm left_and_2 = lithium_prove( + `(hp_a:cprop) && hp_b |-- hp_b`, NULL); + thm left_and_best = lithium_prove( + `(hp_a:cprop) && (hp_a ** hp_b) |-- hp_a ** hp_b`, NULL); + thm right_or_1 = lithium_prove( + `(hp_a:cprop) |-- hp_a || hp_b`, NULL); + thm right_or_2 = lithium_prove( + `(hp_b:cprop) |-- hp_a || hp_b`, NULL); + thm right_or_best = lithium_prove( + `(hp_a:cprop) ** hp_b |-- hp_a || (hp_a ** hp_b)`, NULL); + thm left_or = lithium_prove( + `(hp_a:cprop) || hp_b |-- hp_b || hp_a`, NULL); + + thm exists_round_trip = lithium_prove( + `(exists x. data_at p Tint x) |-- + (exists y. data_at p Tint y ** emp)`, NULL); + thm exists_with_fact = lithium_prove( + `data_at p Tint (c:int) |-- + (exists x. fact(x == c) ** data_at p Tint x)`, NULL); + thm exists_from_assumption = lithium_prove( + `(x:int) == c ==> (emp |-- (exists y. fact(y == c)))`, NULL); + thm exists_vacuous = lithium_prove( + `emp |-- (exists x:int. emp)`, NULL); + thm exists_pull = lithium_prove( + `data_at p Tint (c:int) ** (hp_a:cprop) |-- + (exists x. data_at p Tint x) ** (hp_a && hp_a)`, NULL); + lithium_trace_log unknown_witness_log = {0}; + gnode_list unknown_witness = lithium_stuck_traced( + `emp |-- (exists x:int. data_at p Tint x)`, + NULL, &unknown_witness_log); + ENSURE_COND(vector_size(unknown_witness) == 1 && + goal_is_sl(unknown_witness[0]->g) && + is_sl_exists(goal_hcon(unknown_witness[0]->g)) && + lithium_trace_count( + &unknown_witness_log, "right-exists") == 0, + "Lithium guessed an unknown existential witness"); + thm forall_intro = lithium_prove( + `(hp_a:cprop) |-- (forall x:int. hp_a)`, NULL); + thm forall_dependent = lithium_prove( + `emp |-- (forall x:int. fact(x == x))`, NULL); + + thm wand_intro = lithium_prove( + `(hp_f:cprop) |-- hp_a -* (hp_a ** hp_f)`, NULL); + thm wand_apply = lithium_prove( + `((hp_a:cprop) -* hp_b) ** hp_a |-- hp_b`, NULL); + + thm fact_round_trip = lithium_prove( + `fact(p) ** (hp_a:cprop) |-- fact(p) ** hp_a`, NULL); + thm fact_drop = lithium_prove( + `fact(p) ** (hp_a:cprop) |-- hp_a`, NULL); + thm fact_duplicate = lithium_prove( + `fact(p) ** (hp_a:cprop) |-- fact(p) ** fact(p) ** hp_a`, NULL); + thm fact_from_hol = lithium_prove( + `(p:bool) ==> ((hp_a:cprop) |-- fact(p) ** hp_a)`, NULL); + thm false_elim = lithium_prove( + `fact(F) ** (hp_a:cprop) |-- hp_b`, NULL); + + term update_a = `hp_update_a:cprop`; + term update_b = `hp_update_b:cprop`; + term bupd_a = mk_comb(sl_bupd(), update_a); + term bupd_or = mk_comb(sl_bupd(), mk_sl_or(update_a, update_b)); + thm bupd_intro = lithium_prove( + mk_sl_ent(update_a, bupd_a), NULL); + thm bupd_mono = lithium_prove( + mk_sl_ent(bupd_a, bupd_or), NULL); + + /* `lemma_to_li_entails`: a quantified registered theorem rewrites an exact + * RHS atom and recursively solves its LHS. */ + lithium_rule_set goal_rules = lithium_rule_set_new(); + ENSURE_COND(lithium_rule_set_add_theorem( + &goal_rules, "or-intro-goal", 10, + LITHIUM_GOAL_RULE, sl_or_intro1()) == 0, + "Could not register the goal theorem rule"); + lithium_trace_log goal_log = {0}; + thm registered_goal = lithium_prove_traced( + `(hp_a:cprop) ** hp_f |-- (hp_a || hp_b) ** hp_f`, + &goal_rules, &goal_log); + ENSURE_COND(lithium_trace_count(&goal_log, "or-intro-goal") == 1 && + lithium_trace_index(&goal_log, "direct-frame") >= 0 && + lithium_trace_index(&goal_log, "direct-frame") < + lithium_trace_index(&goal_log, "or-intro-goal"), + "The registered goal theorem was not selected"); + + /* A binary theorem can quantify an explicit separating frame parameter; + * unlike the unframed rule above, it can match before built-in framing. */ + term generic_p = `generic_p:cprop`; + term generic_q = `generic_q:cprop`; + term generic_k = `generic_k:cprop`; + thm generic_or = ispecl_rule( + TERM_LIST(generic_p, generic_q), sl_or_intro1()); + thm framed_or = frame_right_slrule(generic_or, generic_k); + framed_or = gen_rule(generic_p, framed_or); + framed_or = gen_rule(generic_q, framed_or); + framed_or = gen_rule(generic_k, framed_or); + lithium_rule_set framed_rules = lithium_rule_set_new(); + ENSURE_COND(lithium_rule_set_add_theorem( + &framed_rules, "framed-or-goal", 10, + LITHIUM_GOAL_RULE, framed_or) == 0, + "Could not register an explicit-frame goal theorem"); + lithium_trace_log framed_log = {0}; + thm registered_framed = lithium_prove_traced( + `(hp_a:cprop) ** hp_f |-- (hp_a || hp_b) ** hp_f`, + &framed_rules, &framed_log); + ENSURE_COND(framed_log.count >= 2 && + strcmp(framed_log.sequence[1], + "framed-or-goal") == 0, + "The explicit-frame theorem did not override framing"); + + /* A restricted forward-hypothesis analogue transforms one matching linear + * resource; this is intentionally not called full Lithium Subsume. */ + term hp_a = `hp_a:cprop`; + term hp_b = `hp_b:cprop`; + thm a_to_or = ispecl_rule(TERM_LIST(hp_a, hp_b), sl_or_intro1()); + lithium_rule_set hyp_rules = lithium_rule_set_new(); + ENSURE_COND(lithium_rule_set_add_theorem( + &hyp_rules, "or-intro-hyp", 10, + LITHIUM_HYP_RULE, a_to_or) == 0, + "Could not register the hypothesis theorem rule"); + lithium_trace_log hyp_log = {0}; + thm registered_hyp = lithium_prove_traced( + `(hp_a:cprop) |-- hp_a || hp_b`, &hyp_rules, &hyp_log); + ENSURE_COND(lithium_trace_count(&hyp_log, "or-intro-hyp") == 1, + "The registered hypothesis theorem was not selected"); + + lithium_trace_log irrelevant_hyp_log = {0}; + gnode_list irrelevant_hyp = lithium_stuck_traced( + `(hp_a:cprop) |-- hp_c`, &hyp_rules, &irrelevant_hyp_log); + ENSURE_COND(irrelevant_hyp != NULL && + lithium_trace_count( + &irrelevant_hyp_log, "or-intro-hyp") == 0, + "An immediately irrelevant HYP rewrite was committed"); + + /* The convenience ENTAIL kind participates in both phases. */ + lithium_rule_set entail_rules = lithium_rule_set_new(); + ENSURE_COND(lithium_rule_set_add_theorem( + &entail_rules, "dual-or-intro", 10, + LITHIUM_ENTAIL_RULE, a_to_or) == 0, + "Could not register a dual-direction theorem rule"); + lithium_trace_log entail_goal_log = {0}; + thm entail_goal = lithium_prove_traced( + `(hp_a:cprop) |-- hp_a || hp_b`, + &entail_rules, &entail_goal_log); + ENSURE_COND(lithium_trace_count( + &entail_goal_log, "dual-or-intro") == 1, + "ENTAIL did not use its GOAL interpretation"); + lithium_trace_log entail_hyp_log = {0}; + gnode_list entail_hyp = lithium_stuck_traced( + `(hp_a:cprop) ** hp_x |-- (hp_a || hp_b) ** hp_f`, + &entail_rules, &entail_hyp_log); + ENSURE_COND(entail_hyp != NULL && vector_size(entail_hyp) == 1 && + lithium_trace_count( + &entail_hyp_log, "dual-or-intro") == 1 && + alpha_compare(goal_hcon(entail_hyp[0]->g), + `hp_f:cprop`) == 0, + "ENTAIL did not use its HYP interpretation"); + + /* Phase order dominates numeric priority: leading GOAL is considered + * before a numerically earlier HYP rule. */ + lithium_rule_set phase_rules = lithium_rule_set_new(); + ENSURE_COND(lithium_rule_set_add_theorem( + &phase_rules, "hyp-priority-zero", 0, + LITHIUM_HYP_RULE, a_to_or) == 0 && + lithium_rule_set_add_theorem( + &phase_rules, "goal-priority-hundred", 100, + LITHIUM_GOAL_RULE, a_to_or) == 0, + "Could not register cross-phase priority rules"); + lithium_trace_log phase_log = {0}; + thm phase_precedence = lithium_prove_traced( + `(hp_a:cprop) |-- hp_a || hp_b`, &phase_rules, &phase_log); + ENSURE_COND(lithium_trace_count( + &phase_log, "goal-priority-hundred") == 1 && + lithium_trace_count( + &phase_log, "hyp-priority-zero") == 0, + "Numeric priority incorrectly overrode phase precedence"); + + /* Equality registrations use the same exact consequent path. */ + lithium_rule_set equality_rules = lithium_rule_set_new(); + ENSURE_COND(lithium_rule_set_add_theorem( + &equality_rules, "fact-true-equality", 10, + LITHIUM_GOAL_RULE, + sym_rule(sl_fact_true_emp())) == 0, + "Could not register an SL equality rule"); + lithium_trace_log equality_log = {0}; + thm registered_equality = lithium_prove_traced( + `emp |-- fact(T)`, + &equality_rules, &equality_log); + ENSURE_COND(lithium_trace_count( + &equality_log, "fact-true-equality") == 1, + "The registered equality theorem was not selected"); + + /* Leading HOL premises are checked against the ordinary context and are not + * silently assumed by theorem matching. */ + term guard = `guard:bool`; + thm guarded = disch_rule(guard, a_to_or); + lithium_rule_set guarded_rules = lithium_rule_set_new(); + ENSURE_COND(lithium_rule_set_add_theorem( + &guarded_rules, "guarded-or-intro", 1, + LITHIUM_GOAL_RULE, guarded) == 0 && + lithium_rule_set_add_theorem( + &guarded_rules, "unguarded-or-intro", 10, + LITHIUM_GOAL_RULE, a_to_or) == 0, + "Could not register guarded theorem rules"); + lithium_trace_log guarded_log = {0}; + thm registered_guard = lithium_prove_traced( + `guard ==> ((hp_a:cprop) |-- hp_a || hp_b)`, + &guarded_rules, &guarded_log); + ENSURE_COND(lithium_trace_count( + &guarded_log, "guarded-or-intro") == 1 && + lithium_trace_count( + &guarded_log, "unguarded-or-intro") == 0, + "An available HOL guard did not select the guarded rule"); + lithium_trace_log unguarded_log = {0}; + thm registered_without_guard = lithium_prove_traced( + `(hp_a:cprop) |-- hp_a || hp_b`, + &guarded_rules, &unguarded_log); + ENSURE_COND(lithium_trace_count( + &unguarded_log, "guarded-or-intro") == 0 && + lithium_trace_count( + &unguarded_log, "unguarded-or-intro") == 1, + "A theorem with an unavailable HOL guard was committed"); + + lithium_rule_set custom_rules = lithium_rule_set_new(); + ENSURE_COND(lithium_rule_set_add_custom( + &custom_rules, "choose-right", 0, + choose_right_matches, choose_right_apply, NULL) == 0, + "Could not register the custom rule"); + lithium_trace_log custom_log = {0}; + thm custom_rule = lithium_prove_traced( + `emp |-- (hp_a:cprop) || emp`, &custom_rules, &custom_log); + ENSURE_COND(lithium_trace_count(&custom_log, "choose-right") == 1, + "The registered custom rule was not selected"); + + /* A leading custom rule overrides a structurally solvable disjunction, and + * recursive failure does not fall back to the left built-in branch. */ + lithium_trace_log override_log = {0}; + gnode_list custom_override = lithium_stuck_traced( + `emp |-- emp || (hp_a:cprop)`, &custom_rules, &override_log); + ENSURE_COND(custom_override != NULL && + lithium_trace_count(&override_log, "choose-right") == 1, + "A selected custom rule did not override structural search"); + + lithium_trace_log custom_miss_log = {0}; + thm custom_miss = lithium_prove_traced( + `(hp_a:cprop) |-- hp_a`, &custom_rules, &custom_miss_log); + ENSURE_COND(lithium_trace_count(&custom_miss_log, "choose-right") == 0, + "A custom matcher miss was incorrectly traced as committed"); + + /* Malformed custom frontiers are rejected by one-step interpretation. */ + lithium_rule_set malformed_rules = lithium_rule_set_new(); + ENSURE_COND(lithium_rule_set_add_custom( + &malformed_rules, "malformed-null", 0, + always_matches, malformed_null_apply, NULL) == 0, + "Could not register malformed-frontier regression rule"); + gnode malformed_root = + gnode_new_with_ccl(`(hp_a:cprop) |-- hp_a`); + lithium_step_result malformed_step = LITHIUM_STEP_SLTAC( + malformed_root, lithium_options_default(&malformed_rules)); + ENSURE_COND(malformed_step.kind == LITHIUM_ERROR, + "Lithium accepted a malformed custom frontier"); + + /* Reaching the fuel limit is not an error when the next leaf is genuinely + * stuck and therefore requires no further committed step. */ + gnode fuel_root = + gnode_new_with_ccl(`(hp_fuel_a:cprop) |-- hp_fuel_b`); + lithium_options fuel_options = lithium_options_default(NULL); + fuel_options.max_steps = 1; + gnode_list fuel_frontier = LITHIUM_SLTAC(fuel_root, fuel_options); + ENSURE_COND(fuel_frontier != NULL && + vector_size(fuel_frontier) == 1 && + goal_is_sl(fuel_frontier[0]->g), + "Lithium misclassified a no-match leaf as fuel exhaustion"); + + check_committed_priority(); + + ENSURE_COND( + !IS_NULL(reflexivity) && !IS_NULL(sep_unit) && !IS_NULL(sep_comm) && + !IS_NULL(duplicate) && no_weakening != NULL && + no_duplication != NULL && !IS_NULL(right_and) && + !IS_NULL(left_and_1) && !IS_NULL(left_and_2) && + !IS_NULL(left_and_best) && + !IS_NULL(right_or_1) && !IS_NULL(right_or_2) && + !IS_NULL(right_or_best) && + !IS_NULL(left_or) && !IS_NULL(exists_round_trip) && + !IS_NULL(exists_with_fact) && + !IS_NULL(exists_from_assumption) && + !IS_NULL(exists_vacuous) && !IS_NULL(exists_pull) && + unknown_witness != NULL && + !IS_NULL(forall_intro) && !IS_NULL(forall_dependent) && + !IS_NULL(wand_intro) && + !IS_NULL(wand_apply) && !IS_NULL(fact_round_trip) && + !IS_NULL(fact_drop) && !IS_NULL(fact_duplicate) && + !IS_NULL(fact_from_hol) && !IS_NULL(false_elim) && + !IS_NULL(bupd_intro) && !IS_NULL(bupd_mono) && + !IS_NULL(registered_goal) && + !IS_NULL(registered_framed) && + !IS_NULL(registered_hyp) && irrelevant_hyp != NULL && + !IS_NULL(entail_goal) && entail_hyp != NULL && + !IS_NULL(phase_precedence) && + !IS_NULL(registered_equality) && + !IS_NULL(registered_guard) && + !IS_NULL(registered_without_guard) && + !IS_NULL(custom_rule) && custom_override != NULL && + !IS_NULL(custom_miss) && fuel_frontier != NULL, + "A Lithium regression returned an empty theorem or frontier"); + return 0; +err: + ERR_FUN_PUTS("proof_lithium_regression"); + return -1; +} + +PROOF int _proof_lithium_regression = proof_lithium_regression(); -- Gitee From 47b0eaccc00ad7f37ae221e73c40baf96ee17f92 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Mon, 10 Aug 2026 17:36:06 +0800 Subject: [PATCH 29/35] refactor: redesign RA and separation logic v2 --- adapter/ra_sl.c | 17 +- docs/RA_SL_THEORY_SUMMARY.md | 2483 ++++-------------- test/auth_ra_regression.c | 691 +---- test/auth_ra_structure_regression.c | 197 +- test/basic_ra_constructors_regression.c | 385 +-- test/c_resource_v2_regression.c | 175 ++ test/dependency_v2_regression.sh | 135 + test/gmap_ra_regression.c | 652 +---- test/named_ra_regression.c | 241 ++ test/ra_core_regression.c | 296 ++- test/sl_v2_regression.c | 150 ++ test/value_ra_constructors_regression.c | 340 ++- theory/c_program_logic/c_basic_update.c | 1520 +---------- theory/c_program_logic/c_basic_update.h | 152 +- theory/c_program_logic/c_fnspec.c | 9 +- theory/c_program_logic/c_fnspec.h | 8 +- theory/c_program_logic/c_ghost.c | 875 +++++++ theory/c_program_logic/c_ghost.h | 21 + theory/c_program_logic/c_ghost_update.c | 808 ------ theory/c_program_logic/c_ghost_update.h | 137 - theory/c_program_logic/c_memory.c | 53 +- theory/c_program_logic/c_resource.c | 562 +---- theory/c_program_logic/c_resource.h | 151 +- theory/c_program_logic/mem_ra.c | 2 + theory/c_program_logic/mem_ra.h | 6 - theory/c_program_logic/mem_value.c | 5 +- theory/logic/agree_ra.c | 142 +- theory/logic/agree_ra.h | 168 +- theory/logic/auth_ra.c | 690 +---- theory/logic/auth_ra.h | 695 +---- theory/logic/basic_update.c | 121 +- theory/logic/basic_update.h | 71 +- theory/logic/big_sep.c | 2931 +++------------------- theory/logic/big_sep.h | 365 +-- theory/logic/excl_ra.c | 67 +- theory/logic/excl_ra.h | 177 +- theory/logic/excl_ra_internal.h | 4 + theory/logic/frac_ra.c | 464 ++-- theory/logic/frac_ra.h | 285 +-- theory/logic/ghost_heap.c | 584 ----- theory/logic/ghost_heap.h | 131 - theory/logic/ghost_own.c | 225 -- theory/logic/ghost_own.h | 42 - theory/logic/ghost_update.c | 537 ---- theory/logic/ghost_update.h | 50 - theory/logic/gmap_ra.c | 1407 +---------- theory/logic/gmap_ra.h | 753 +----- theory/logic/gmap_ra_internal.h | 11 + theory/logic/local_update.c | 301 +-- theory/logic/local_update.h | 182 +- theory/logic/max_nat_ra.c | 140 +- theory/logic/max_nat_ra.h | 146 +- theory/logic/named_logic.c | 452 ++++ theory/logic/named_logic.h | 14 + theory/logic/named_ra.c | 191 ++ theory/logic/named_ra.h | 16 + theory/logic/option_ra.c | 376 ++- theory/logic/option_ra.h | 193 +- theory/logic/option_ra_internal.h | 9 + theory/logic/prod_ra.c | 548 ++-- theory/logic/prod_ra.h | 296 +-- theory/logic/prod_ra_internal.h | 8 + theory/logic/product_resource.c | 2074 +++++++++++++++ theory/logic/product_resource.h | 37 + theory/logic/product_resource_internal.h | 14 + theory/logic/ra.c | 726 ++---- theory/logic/ra.h | 628 +---- theory/logic/ra_builder.h | 98 +- theory/logic/ra_internal.h | 25 + theory/logic/resource_prop.c | 700 +++++- theory/logic/resource_prop.h | 197 +- theory/logic/resource_prop_internal.h | 28 + theory/logic/unit_ra.c | 86 +- theory/logic/unit_ra.h | 87 +- 74 files changed, 8540 insertions(+), 19023 deletions(-) create mode 100644 test/c_resource_v2_regression.c create mode 100755 test/dependency_v2_regression.sh create mode 100644 test/named_ra_regression.c create mode 100644 test/sl_v2_regression.c create mode 100644 theory/c_program_logic/c_ghost.c create mode 100644 theory/c_program_logic/c_ghost.h delete mode 100644 theory/c_program_logic/c_ghost_update.c delete mode 100644 theory/c_program_logic/c_ghost_update.h delete mode 100644 theory/logic/ghost_heap.c delete mode 100644 theory/logic/ghost_heap.h delete mode 100644 theory/logic/ghost_own.c delete mode 100644 theory/logic/ghost_own.h delete mode 100644 theory/logic/ghost_update.c delete mode 100644 theory/logic/ghost_update.h create mode 100644 theory/logic/gmap_ra_internal.h create mode 100644 theory/logic/named_logic.c create mode 100644 theory/logic/named_logic.h create mode 100644 theory/logic/named_ra.c create mode 100644 theory/logic/named_ra.h create mode 100644 theory/logic/option_ra_internal.h create mode 100644 theory/logic/prod_ra_internal.h create mode 100644 theory/logic/product_resource.c create mode 100644 theory/logic/product_resource.h create mode 100644 theory/logic/product_resource_internal.h create mode 100644 theory/logic/ra_internal.h create mode 100644 theory/logic/resource_prop_internal.h diff --git a/adapter/ra_sl.c b/adapter/ra_sl.c index 1d8f76b..3e69099 100644 --- a/adapter/ra_sl.c +++ b/adapter/ra_sl.c @@ -1,4 +1,5 @@ #include "proof/adapter/ra_sl.h" +#include "proof/theory/logic/resource_prop_internal.h" #require "proof/proof_sl.c" #require "proof/theory/logic/resource_prop.c" @@ -85,10 +86,10 @@ PROOF int ra_sl_build(const term R, sl_theory *out) { /* The ACU and existential-distribution laws are exact predicate equalities; * logical antisymmetry is deliberately installed as `r_equiv` instead. */ - theory.sep_emp_left = ispec_rule(R, R_SEP_EMP_L); - theory.sep_emp_right = ispec_rule(R, R_SEP_EMP_R); - theory.sep_assoc = ispec_rule(R, R_SEP_ASSOC); - theory.sep_comm = ispec_rule(R, R_SEP_COMM); + theory.sep_emp_left = ispec_rule(R, R_SEP_EMP_L_EQ); + theory.sep_emp_right = ispec_rule(R, R_SEP_EMP_R_EQ); + theory.sep_assoc = ispec_rule(R, R_SEP_ASSOC_EQ); + theory.sep_comm = ispec_rule(R, R_SEP_COMM_EQ); theory.sep_mono = ispec_rule(R, R_SEP_MONO); theory.wand_sep_adjoint = ispec_rule(R, R_WAND_ADJUNCTION); @@ -102,10 +103,10 @@ PROOF int ra_sl_build(const term R, sl_theory *out) { theory.exists_intro = ispec_rule(R, R_EXISTS_INTRO); theory.exists_elim = ispec_rule(R, R_EXISTS_ELIM); theory.exists_mono = ispec_rule(R, R_EXISTS_MONO); - theory.sep_exists_left = ispec_rule(R, R_SEP_EXISTS_L); - theory.sep_exists_right = ispec_rule(R, R_SEP_EXISTS_R); + theory.sep_exists_left = ispec_rule(R, R_SEP_EXISTS_L_EQ); + theory.sep_exists_right = ispec_rule(R, R_SEP_EXISTS_R_EQ); theory.forall_intro = ispec_rule(R, R_FORALL_INTRO); - theory.forall_elim = ispec_rule(R, R_FORALL_ELIM); + theory.forall_elim = ispec_rule(R, R_FORALL_ELIM_CONT); theory.ent_refl = ispec_rule(R, R_ENTAILS_REFL); theory.ent_trans = ispec_rule(R, R_ENTAILS_TRANS); @@ -114,7 +115,7 @@ PROOF int ra_sl_build(const term R, sl_theory *out) { theory.fact_intro = ispec_rule(R, R_FACT_INTRO); theory.fact_elim = ispec_rule(R, R_FACT_ELIM); theory.fact_dup = ispec_rule(R, R_FACT_DUP); - theory.fact_true_emp = ispec_rule(R, R_FACT_TRUE); + theory.fact_true_emp = ispec_rule(R, R_FACT_TRUE_EQ); *out = theory; return 0; diff --git a/docs/RA_SL_THEORY_SUMMARY.md b/docs/RA_SL_THEORY_SUMMARY.md index b5fb366..b24f6ec 100644 --- a/docs/RA_SL_THEORY_SUMMARY.md +++ b/docs/RA_SL_THEORY_SUMMARY.md @@ -1,2024 +1,559 @@ -# RA 与资源语义分离逻辑（SL）理论总览 +# C* first-order RA / linear separation logic v2 + +> 本文描述 `cstar_examples/proof` 当前 v2 理论的稳定设计与公开接口。 +> 实现中的定理对象仍由 HOL 内核机械检查；各 public header 是精确 API 的最终 +> 来源。v2 是一次 breaking redesign，不提供历史接口的兼容别名或转接层。 + +## 1. 设计边界 + +本理论面向“不含 later 的 first-order ghost state”。RA 是带 validity 的交换 +幺半群；SL 是其 carrier 上的严格 linear BI。此范围有意不引入 OFE/COFE、 +step index、camera extension、core、contractive functor、guarded fixpoint、 +later modality或 impredicative invariant ownership。 + +v2 固定以下边界： + +- predicate update `ra_updateP` 是唯一 primitive update；`ra_update` 只是它的 + singleton 特化； +- `ra_exclusive` 自带 source validity，不允许无效源通过真空蕴含被称为 + exclusive； +- 用户级 assertion algebra 统一以 `r_equiv` 表达；raw assertion-function + equality 只留给实现和 adapter； +- `r_pure` 与 `r_fact` 明确保留为两个不同构造：前者资源无关，后者精确占有 + unit； +- C resource 的参数 `G` 表示完整、闭合的 global ghost RA， + `c_resource_ra G = prod_ra mem_ra G`； +- generic basic update 可以更新完整 RA；C basic update 只能更新产品右分量， + 物理内存投影不变； +- numeric naming 是显式可选构造 `named_ra R = gmap_ra R`，不是 C resource + 暗中加入的一层； +- 释放当前 fragment 的操作统一称为 `drop`；它不声称隐藏 frame 中不存在同名 + 资源； +- theorem handles 保持现有命名风格：定义定理使用实际的小写标识符，其余公开 + 定理继续使用大写标识符； +- big separation 继续由同一个 `big_sep.{h,c}` 模块提供，不拆文件或子模块。 + +核心依赖关系如下： -> 快照：`cstar_stdlib` 工作区分支 `ghost-resources-phased`，基线提交 -> `8df07309956222d51a7dba65cfa24c7c592dbc77`，并包含 2026-08-10 -> 尚未提交的工作区修改。本文描述的是**当前工作区实际加载并由 HOL Light -> 打印出的定理对象**，不是基线提交的历史状态。 +```text +ra + ra_builder +├── local_update +├── unit_ra / prod_ra / option_ra / excl_ra / agree_ra +├── max_nat_ra / frac_ra +├── gmap_ra ─────────────── named_ra +└── auth_ra + +ra ─────────────────────── resource_prop +resource_prop + ra ─────── basic_update +resource_prop + prod_ra ── product_resource +resource_prop ──────────── big_sep + +gmap_ra + excl_ra ──────── mem_ra +mem_ra + complete G ────── c_resource +product_resource ───────── c_basic_update +c_basic_update + named_ra c_ghost +``` -本文先固定一套公共数学记号，再把公开理论分成三层： +## 2. RA 核心 -1. 离散幺半资源代数（RA）及其构造子； -2. 由 RA 解释的资源命题与分离逻辑（SL）； -3. 命名 ghost heap、C 物理内存与 `cprop`/`|--` 适配层。 +源文件：[`ra.h`](../theory/logic/ra.h)、 +[`ra.c`](../theory/logic/ra.c)。构造者接口位于 +[`ra_builder.h`](../theory/logic/ra_builder.h)。 -每个定理表的 “HOL statement” 栏保留 C*/HOL 的对象语言拼写；“数学陈述” -栏使用本节统一记号。HOL 栏最外层的 `` `|- ...` `` 表示无假设定理；省略的 -类型变量由 HOL 多态推断。`==` 是 HOL 对象等号，`==>` 是右结合蕴含，`<=>` -是布尔等价。数学栏的 `=`、`⇒`、`⇔` 分别对应它们。 +固定 `R:(A)ra`，记： -本文的数学公式统一使用 GitHub/KaTeX 兼容的 `$...$`（行内）与 `$$...$$` -（块级）分隔符；不使用部分 Markdown renderer 无法识别的 `\(...\)`、 -`\[...\]` 或自定义 LaTeX 宏。 +$$ +e_R = \operatorname{ra\_unit}(R),\qquad +a\cdot_R b = \operatorname{ra\_op}(R,a,b),\qquad +\checkmark_R(a)=\operatorname{ra\_valid}(R,a). +$$ -## 1. 范围、层次与依赖 +raw descriptor 的合法性为： -### 1.1 本文覆盖 +```text +ra_laws e op valid <=> + (forall a b c. op (op a b) c == op a (op b c)) && + (forall a b. op a b == op b a) && + (forall a. op e a == a) && + valid e && + (forall a b. valid (op a b) ==> valid a) +``` -| 层 | 模块 | 作用 | -|---|---|---| -| RA 核心 | `ra`, `ra_builder`, `local_update` | 抽象 RA、包含序、帧保持更新、局部更新 | -| RA 构造子 | `unit_ra`, `prod_ra`, `option_ra`, `excl_ra`, `agree_ra`, `max_nat_ra`, `frac_ra`, `auth_ra`, `gmap_ra` | 标准资源代数实例与提升定理 | -| 有限映射基础 | `finmap` | `gmap_ra`、map big-sep 与 ghost heap 的有限支撑映射 | -| SL 语义 | `resource_prop`, `big_sep`, `basic_update` | 资源命题、BI 联结词、迭代分离合取、basic update/view shift | -| ghost 资源 | `ghost_heap`, `ghost_own`, `ghost_update` | 命名资源单元、精确 ownership 与更新/分配 | -| C 实例 | `mem_ra`, `mem_own`, `c_resource`, `c_basic_update`, `c_ghost_update` | 物理内存 RA、物理×ghost 产品资源以及 C 层更新 | -| 语法适配 | `adapter/ra_sl*`, `proof_sl*` | 把某个闭合 RA 的语义运算安装成 `cprop`、`**`、`\|--` 等表面语法 | - -`c_integer`, `mem_value`, `c_memory` 和 `c_fnspec` 是上述语义的下游 C -程序逻辑；本文只在接口关系中提及，不把整数位运算、C 类型布局等非 RA/SL -定理混入核心目录。 - -上述 24 个 public headers 当前共有 576 个 `PROOF extern thm` handles。RA、 -local-update、BI、basic-update、big-sep、各 RA 构造子、ghost 与 C-resource -接口在本文逐条列出；`finmap` 中纯机械的 representation/insert/delete/domain -计算律采用“关键公式 + 其余完整名称索引”，以免有限映射实现细节淹没 RA/SL -主线。 - -第 15 节的排序索引还额外纳入 `excl_ra_internal.h` 的 5 个内部 theorem -handles 与 `proof_sl.h` 的 17 个 runtime-installed theorem globals，并把没有 -public theorem global 的 adapter/backward 文件显式标出；因此该索引总计 598 -条。 - -### 1.2 依赖关系 +`(A)ra` 是只收纳 lawful descriptor 的 abstract HOL type。普通 client 使用 +`RA_LAWS`、`RA_ASSOC`、`RA_COMM`、`RA_UNIT_L`、`RA_UNIT_R`、 +`RA_VALID_UNIT` 和 `RA_VALID_OP`，无需重复携带 laws premise。只有 constructor +author 需要 `ra_builder.h` 中的 `ra_laws_def`、`RA_TYPE_BIJECTION`、 +`RA_REP_LAWS`、`RA_ABS_REP`、`RA_UNIT_ABS`、`RA_OP_ABS`、`RA_VALID_ABS` +与 `RA_ABS_ETA`。 + +### 2.1 核心关系 + +兼容性、包含关系和两种 update 的定义是： ```text -ra ───────────────┬──────── unit / prod / option / excl / agree / max_nat / frac - ├──────── local_update ───── auth - └──────── finmap ─────────── gmap ───────── ghost_heap - │ -resource_prop ────┬──────── big_sep ghost_own - └──────── basic_update ───────────────────── ghost_update +ra_compatible R a b <=> + ra_valid R (ra_op R a b) -mem_ra = gmap_ra excl_ra -c_resource_ra G = prod_ra mem_ra (ghost_heap_ra G) +ra_included R a b <=> + exists frame. b == ra_op R a frame -resource_prop R ── ra_sl_build / ra_sl_scope ── proof_sl (`cprop`, `**`, `|--`) +ra_updateP R a P <=> + forall frame. + ra_valid R (ra_op R a frame) ==> + exists b. P b && ra_valid R (ra_op R b frame) + +ra_update R a b <=> + ra_updateP R a (\x. x == b) ``` -这里有两个容易混淆但必须分开的层次： +`ra_updateP` 中的结果 witness 可以依赖隐藏 `frame`。这正是 predicate update +的语义；确定性 update 不另设第二套 primitive 定义。 -- `resource_prop` 给出 `A -> bool` 上的**语义定义和闭合 HOL 定理**； -- `proof_sl` 接受已安装的 `sl_theory`，提供定理构造函数和经验证的 backward - tactics。后者不是另一套 RA 语义。 +公开更新定理分为两组： -## 2. 公共数学记号 ↔ HOL syntax +- predicate update：`RA_UPDATEP_SINGLETON`、`RA_UPDATEP_REFL`、 + `RA_UPDATEP_MONO`、`RA_UPDATEP_TRANS`、`RA_UPDATEP_VALID`、 + `RA_UPDATEP_FRAME`、`RA_UPDATEP_OP`； +- deterministic update：`RA_UPDATE_REFL`、`RA_UPDATE_TRANS`、 + `RA_UPDATE_FRAME`、`RA_UPDATE_OP`、`RA_UPDATE_INCLUDED`、 + `RA_UPDATE_TARGET_INCLUDED`、`RA_UPDATE_VALID`。 -### 2.1 元逻辑与类型 +包含关系是 extension preorder，不承诺反对称。公开规则为 +`RA_INCLUDED_REFL`、`RA_INCLUDED_UNIT`、`RA_INCLUDED_OP_L`、 +`RA_INCLUDED_OP_R`、`RA_INCLUDED_TRANS`、`RA_INCLUDED_OP_MONO`、 +`RA_INCLUDED_VALID`。兼容性公开 `RA_COMPAT_COMM` 和 `RA_COMPAT_UNIT`。 -| 数学记号 | HOL syntax | 含义 | -|---|---|---| -| $A,B,K,V$ | `A`, `B`, `K`, `V` | HOL 类型变量 | -| $R : \mathrm{RA}(A)$ | `R:(A)ra` | carrier 为 `A` 的合法 RA 描述子 | -| $P,Q,S,F : \mathcal P_R$ | `P,Q,S,F:A->bool` | 资源命题；$\mathcal P_R=A\to\mathbb B$ | -| $\top,\bot$ | `T`, `F`（printer 也可能显示 `true`, `false`） | HOL 布尔真/假 | -| $x=y$ | `x == y` | HOL 对象等号 | -| $\neg p$ | `~p` | 否定 | -| $p\land q$, $p\lor q$ | `p && q`, `p \|\| q` | HOL 布尔合取/析取 | -| $p\Rightarrow q$, $p\Leftrightarrow q$ | `p ==> q`, `p <=> q` | 蕴含/布尔等价 | -| $\forall x.\,p$, $\exists x.\,p$ | `forall x. p`, `exists x. p` | 量词 | -| $\lambda x.\,t$ | `\x. t` | lambda | -| $(x,y)$, $\pi_1,\pi_2$ | `(x,y)`, `FST`, `SND` | HOL product 与投影 | -| $\mathrm{Some}(x),\mathrm{None}$ | `SOME x`, `NONE` | option 构造子 | - -### 2.2 RA - -固定 -$$ -R=(|R|,\varepsilon_R,\mathbin{\cdot_R},\checkmark_R),\qquad |R|=A. -$$ +### 2.2 cancellative 与 exclusive -| 数学记号 | HOL syntax | 定义/读法 | -|---|---|---| -| $\varepsilon_R$ | `ra_unit R` | 单位元 | -| $a\cdot_R b$ | `ra_op R a b` | 资源合成 | -| $\checkmark_R(a)$ | `ra_valid R a` | `a` 有效 | -| $a\preccurlyeq_R b$ | `ra_included R a b` | 存在 frame $f$，使 $b=a\cdot_R f$ | -| $a\leadsto_R b$ | `ra_update R a b` | 确定性 frame-preserving update | -| $a\rightsquigarrow_R P$ | `ra_update_nd R a P` | 结果依赖隐藏 frame 的 ND update | -| $(a,f)\leadsto_R(b,g)$ | `ra_local_update R (a,f) (b,g)` | 保持同一隐藏 residual 的 local update | -| $\mathrm{Canc}(R)$ | `ra_cancellative R` | 有效合成上的左消去性 | -| $\mathrm{Excl}_R(a)$ | `ra_exclusive R a` | 与 `a` 相容的 frame 只能是单位元 | - -注意：$\preccurlyeq_R$ 一般只是 extension preorder，不保证反对称； -`ra_exclusive R a` 不蕴含 `ra_valid R a`，无效元素可因前提永假而 vacuous -exclusive。 - -### 2.3 资源命题与 SL - -| 数学记号 | HOL syntax | 点语义/读法 | -|---|---|---| -| $P\vdash_R Q$ | `r_entails R P Q` | 只在有效资源上观察的 entailment | -| $P\simeq_R Q$ | `r_equiv R P Q` | 双向 entailment；弱于原始函数等号 | -| $\mathsf{emp}_R$ | `r_emp R` | 精确拥有 $\varepsilon_R$ | -| $P*Q$ | `r_sep R P Q` | 资源可分成满足 `P`、`Q` 的两部分 | -| $\mathsf{own}_R(a)$ | `r_own R a` | 精确拥有 `a` | -| $\top_R,\bot_R$ | `r_top R`, `r_bottom R` | 恒真/恒假资源命题 | -| $P\land_R Q$, $P\lor_R Q$ | `r_and R P Q`, `r_or R P Q` | additive conjunction/disjunction | -| $P\Rightarrow_R Q$ | `r_impl R P Q` | 同一资源点上的蕴含 | -| $\exists_R x. P(x)$, $\forall_R x.P(x)$ | `r_exists R (\x. P x)`, `r_forall R (\x. P x)` | assertion-level 量词 | -| $\lceil\phi\rceil_R$ | `r_pure R phi` | 与资源无关的 pure 命题 | -| $\lfloor\phi\rfloor_R$ | `r_fact R phi` | $\lceil\phi\rceil_R\land\mathsf{emp}_R$；精确单位元 fact | -| $P\mathbin{-\!*}_R Q$ | `r_wand R P Q` | separating implication / magic wand | -| $\lvert\!\Rightarrow P$ | `r_bupd R P` | basic-update modality | -| $P\Rrightarrow_R Q$ | `r_viewshift R P Q` | $P\vdash_R\lvert\!\Rightarrow Q$ | -| $\mathop{\ast}_{x\in X}P(x)$ | `r_big_sep_*` | list/set/map/indexed big separation | - -原始函数等号 `P == Q` 对所有资源（包括无效资源）逐点相等； -$P\simeq_R Q$ 只要求在有效资源上互相蕴含。本文不会把二者混写。 - -### 2.4 标准构造子 - -| 构造 | HOL | 数学记号 | -|---|---|---| -| 单元 RA | `unit_ra` | $\mathbf 1$ | -| 产品 | `prod_ra R1 R2` | $R_1\times R_2$ | -| 添单位 option | `option_ra R` | $R_\bot$（`NONE` 是新单位） | -| exclusive | `excl_ra` | $\mathrm{Excl}(A)$；`ExclUnit`, `Excl a`, `ExclInvalid` | -| agreement | `agree_ra` | $\mathrm{Agree}(A)$；`AgreeUnit`, `Agree a`, `AgreeInvalid` | -| max-nat | `max_nat_ra` | $(\mathbb N,0,\max)$ | -| fractional | `frac_ra R` | $\mathrm{Frac}(R)$ | -| authoritative | `auth_ra R` | $\mathrm{Auth}(R)$；`auth_auth`, `auth_frag`, `auth_both` | -| finite-map lift | `gmap_ra R` | $K\rightharpoonup_{\mathrm{fin}}R$ | -| ghost heap | `ghost_heap_ra G` | $\mathbb N\rightharpoonup_{\mathrm{fin}}G$ | -| C resource | `c_resource_ra G` | $\mathrm{Mem}\times\mathrm{GhostHeap}(G)$ | +```text +ra_cancellative R <=> + forall frame a b. + ra_valid R (ra_op R frame a) ==> + ra_op R frame a == ra_op R frame b ==> + a == b + +ra_exclusive R a <=> + ra_valid R a && + forall frame. + ra_valid R (ra_op R a frame) ==> + frame == ra_unit R +``` -## 3. RA 核心：精确定义与定理 +因此 `ra_exclusive R a` 本身就能推出 `ra_valid R a`。公开使用 +`RA_EXCLUSIVE_INCLUDED`、`RA_EXCLUSIVE_UPDATE` 与 +`RA_CANCELLATIVE_APPLY`；invalid-source 的真空特例不属于稳定 client API。 -源文件：[`ra.h`](../theory/logic/ra.h)、[`ra.c`](../theory/logic/ra.c)。 +### 2.3 五参数 local update -### 3.1 表示、关系与直接消去 +源文件：[`local_update.h`](../theory/logic/local_update.h)、 +[`local_update.c`](../theory/logic/local_update.c)。 -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `ra_unit_def` | `` `\|- ra_unit R == FST (ra_rep R)` `` | $\varepsilon_R=\pi_1(\mathrm{rep}(R))$ | -| `ra_op_def` | `` `\|- ra_op R == FST (SND (ra_rep R))` `` | $(\cdot_R)=\pi_1\pi_2(\mathrm{rep}(R))$ | -| `ra_valid_def` | `` `\|- ra_valid R == SND (SND (ra_rep R))` `` | $\checkmark_R=\pi_2\pi_2(\mathrm{rep}(R))$ | -| `ra_included_def` | `` `\|- ra_included R a b <=> (exists frame. b == ra_op R a frame)` `` | $a\preccurlyeq_R b\Leftrightarrow\exists f.\ b=a\cdot_R f$ | -| `ra_update_nd_def` | `` `\|- ra_update_nd R a result <=> (forall frame. ra_valid R (ra_op R a frame) ==> (exists b. result b && ra_valid R (ra_op R b frame)))` `` | $a\rightsquigarrow_R P\Leftrightarrow\forall f.\ \checkmark(a\cdot f)\Rightarrow\exists b.\ P(b)\land\checkmark(b\cdot f)$ | -| `ra_update_def` | `` `\|- ra_update R a b <=> (forall frame. ra_valid R (ra_op R a frame) ==> ra_valid R (ra_op R b frame))` `` | $a\leadsto_R b\Leftrightarrow\forall f.\ \checkmark(a\cdot f)\Rightarrow\checkmark(b\cdot f)$ | -| `ra_cancellative_def` | `` `\|- ra_cancellative R <=> (forall frame a b. ra_valid R (ra_op R frame a) ==> ra_op R frame a == ra_op R frame b ==> a == b)` `` | $\mathrm{Canc}(R)\Leftrightarrow\forall f,a,b.\ \checkmark(f\cdot a)\land f\cdot a=f\cdot b\Rightarrow a=b$ | -| `ra_exclusive_def` | `` `\|- ra_exclusive R a <=> (forall frame. ra_valid R (ra_op R a frame) ==> frame == ra_unit R)` `` | $\mathrm{Excl}_R(a)\Leftrightarrow\forall f.\ \checkmark(a\cdot f)\Rightarrow f=\varepsilon$ | -| `RA_CANCELLATIVE_APPLY` | `` `\|- forall R frame a b. ra_cancellative R ==> ra_valid R (ra_op R frame a) ==> ra_op R frame a == ra_op R frame b ==> a == b` `` | 消去性的直接应用式 | -| `RA_EXCLUSIVE_APPLY` | `` `\|- forall R a frame. ra_exclusive R a ==> ra_valid R (ra_op R a frame) ==> frame == ra_unit R` `` | exclusive 的直接应用式 | -| `RA_UPDATE_APPLY` | `` `\|- forall R a b frame. ra_update R a b ==> ra_valid R (ra_op R a frame) ==> ra_valid R (ra_op R b frame)` `` | 确定更新保持任意相容 frame | -| `RA_UPDATE_ND_APPLY` | `` `\|- forall R a P frame. ra_update_nd R a P ==> ra_valid R (ra_op R a frame) ==> (exists b. P b && ra_valid R (ra_op R b frame))` `` | ND 更新为给定 frame 选择有效结果 | - -#### 3.1.1 Lawful descriptor 的构造边界 - -新 RA instance 先证明 raw descriptor -$(e,(\mathit{op},\mathit{valid}))$ 满足 ra_laws，再用 -ra_abs 构造 unary HOL type (A)ra： - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| ra_laws_def | |- ra_laws e op valid <=> (forall a b c. op (op a b) c == op a (op b c)) && (forall a b. op a b == op b a) && (forall a. op e a == a) && valid e && (forall a b. valid (op a b) ==> valid a) | 结合、交换、左单位、unit valid、validity downward closure | -| RA_TYPE_BIJECTION | |- (forall R. ra_abs (ra_rep R) == R) && (forall d. ra_laws (FST d) (FST (SND d)) (SND (SND d)) <=> ra_rep (ra_abs d) == d) | abstract RA type 与 lawful descriptors 的双射 | -| RA_REP_LAWS | |- forall R. ra_laws (FST (ra_rep R)) (FST (SND (ra_rep R))) (SND (SND (ra_rep R))) | 任意 abstract descriptor 的 representation lawful | -| RA_ABS_REP | |- forall e op valid. ra_laws e op valid ==> ra_rep (ra_abs (e,op,valid)) == e,op,valid | lawful descriptor 的 representation round trip | -| RA_UNIT_ABS | |- forall e op valid. ra_laws e op valid ==> ra_unit (ra_abs (e,op,valid)) == e | lawful descriptor 的 unit projection | -| RA_OP_ABS | |- forall e op valid. ra_laws e op valid ==> ra_op (ra_abs (e,op,valid)) == op | lawful descriptor 的 operation projection | -| RA_VALID_ABS | |- forall e op valid. ra_laws e op valid ==> ra_valid (ra_abs (e,op,valid)) == valid | lawful descriptor 的 validity projection | -| RA_ABS_ETA | |- forall R. ra_abs (ra_unit R,ra_op R,ra_valid R) == R | 用三个 public projections 重建同一 RA | +```text +ra_local_update R a f b g <=> + forall residual. + ra_valid R a ==> + a == ra_op R f residual ==> + ra_valid R b && b == ra_op R g residual +``` -ra_abs 在 HOL 中是总函数，但对不 lawful descriptor 没有对应的 -projection equation；不能省略 premise。 +这里 `(a,f)` 是更新前的 whole/local pair，`(b,g)` 是更新后的 pair；同一个 +未知 `residual` 被保留。接口直接使用五个参数，不再把两个 pair 包在 HOL +product 中。公开规则为： -### 3.2 内在 RA 律与有效性 +```text +RA_LOCAL_UPDATE_APPLY +RA_LOCAL_UPDATE_REFL +RA_LOCAL_UPDATE_TRANS +RA_LOCAL_UPDATE_FRAME +RA_LOCAL_UPDATE_PRESERVES_INCLUDED +RA_LOCAL_UPDATE_ALLOC +RA_LOCAL_UPDATE_EXCLUSIVE +RA_LOCAL_UPDATE_CANCEL +RA_LOCAL_UPDATE_CANCELLATIVE +``` -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `RA_LAWS` | `` `\|- forall R. ra_laws (ra_unit R) (ra_op R) (ra_valid R)` `` | 每个 `R:(A)ra` 都满足下列全部内在律 | -| `RA_ASSOC` | `` `\|- forall R a b c. ra_op R (ra_op R a b) c == ra_op R a (ra_op R b c)` `` | $(a\cdot b)\cdot c=a\cdot(b\cdot c)$ | -| `RA_COMM` | `` `\|- forall R a b. ra_op R a b == ra_op R b a` `` | $a\cdot b=b\cdot a$ | -| `RA_OP_SWAP_RIGHT` | `` `\|- forall R a b c. ra_op R (ra_op R a b) c == ra_op R (ra_op R a c) b` `` | $(a\cdot b)\cdot c=(a\cdot c)\cdot b$ | -| `RA_UNIT_L` | `` `\|- forall R a. ra_op R (ra_unit R) a == a` `` | $\varepsilon\cdot a=a$ | -| `RA_UNIT_R` | `` `\|- forall R a. ra_op R a (ra_unit R) == a` `` | $a\cdot\varepsilon=a$ | -| `RA_VALID_UNIT` | `` `\|- forall R. ra_valid R (ra_unit R)` `` | $\checkmark(\varepsilon)$ | -| `RA_VALID_OP_L` | `` `\|- forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R a` `` | $\checkmark(a\cdot b)\Rightarrow\checkmark(a)$ | -| `RA_VALID_OP_R` | `` `\|- forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R b` `` | $\checkmark(a\cdot b)\Rightarrow\checkmark(b)$ | -| `RA_VALID_OP` | `` `\|- forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R a && ra_valid R b` `` | $\checkmark(a\cdot b)\Rightarrow\checkmark(a)\land\checkmark(b)$ | - -反方向一般不成立：两个分别有效的资源未必彼此相容。 - -### 3.3 包含序 - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `RA_INCLUDED_REFL` | `` `\|- forall R a. ra_included R a a` `` | $a\preccurlyeq a$ | -| `RA_INCLUDED_UNIT` | `` `\|- forall R a. ra_included R (ra_unit R) a` `` | $\varepsilon\preccurlyeq a$ | -| `RA_INCLUDED_OP_L` | `` `\|- forall R a b. ra_included R a (ra_op R a b)` `` | $a\preccurlyeq a\cdot b$ | -| `RA_INCLUDED_OP_R` | `` `\|- forall R a b. ra_included R b (ra_op R a b)` `` | $b\preccurlyeq a\cdot b$ | -| `RA_INCLUDED_TRANS` | `` `\|- forall R a b c. ra_included R a b ==> ra_included R b c ==> ra_included R a c` `` | $a\preccurlyeq b\preccurlyeq c\Rightarrow a\preccurlyeq c$ | -| `RA_INCLUDED_OP_MONO_L` | `` `\|- forall R a1 a2 b. ra_included R a1 a2 ==> ra_included R (ra_op R a1 b) (ra_op R a2 b)` `` | $a_1\preccurlyeq a_2\Rightarrow a_1\cdot b\preccurlyeq a_2\cdot b$ | -| `RA_INCLUDED_OP_MONO_R` | `` `\|- forall R a1 a2 b. ra_included R a1 a2 ==> ra_included R (ra_op R b a1) (ra_op R b a2)` `` | $a_1\preccurlyeq a_2\Rightarrow b\cdot a_1\preccurlyeq b\cdot a_2$ | -| `RA_INCLUDED_OP_MONO` | `` `\|- forall R a1 a2 b1 b2. ra_included R a1 a2 ==> ra_included R b1 b2 ==> ra_included R (ra_op R a1 b1) (ra_op R a2 b2)` `` | 两个参数上的单调性 | -| `RA_INCLUDED_VALID` | `` `\|- forall R a b. ra_included R a b ==> ra_valid R b ==> ra_valid R a` `` | $a\preccurlyeq b\land\checkmark(b)\Rightarrow\checkmark(a)$ | -| `RA_INCLUDED_VALID_FRAME` | `` `\|- forall R a b frame. ra_included R a b ==> ra_valid R (ra_op R b frame) ==> ra_valid R (ra_op R a frame)` `` | 较小资源保持较大资源的相容 frame | -| `RA_INCLUDED_CANCEL_L` | `` `\|- forall R common a b. ra_cancellative R ==> ra_valid R (ra_op R common b) ==> ra_included R (ra_op R common a) (ra_op R common b) ==> ra_included R a b` `` | 有效前提下从 $c\cdot a\preccurlyeq c\cdot b$ 消去共同前缀 | - -### 3.4 exclusive - -| theorem | HOL statement | 数学陈述 | +## 3. RA 构造子 + +| 模块 | carrier / operation | 稳定能力 | |---|---|---| -| `RA_EXCLUSIVE_INCLUDED` | `` `\|- forall R a b. ra_exclusive R a ==> ra_valid R b ==> ra_included R a b ==> a == b` `` | exclusive 元素没有真有效扩张 | -| `RA_EXCLUSIVE_IFF_INCLUDED` | `` `\|- forall R a. ra_cancellative R ==> (ra_exclusive R a <=> forall b. ra_valid R b ==> ra_included R a b ==> a == b)` `` | 在 cancellative RA 中，exclusive 等价于有效扩张极大性 | -| `RA_INVALID_EXCLUSIVE` | `` `\|- forall R a. ~ra_valid R a ==> ra_exclusive R a` `` | 无效元素 vacuously exclusive | -| `RA_EXCLUSIVE_VALID_OP_IFF` | `` `\|- forall R a frame. ra_exclusive R a ==> (ra_valid R (ra_op R a frame) <=> ra_valid R a && frame == ra_unit R)` `` | $\mathrm{Excl}(a)\Rightarrow[\checkmark(a\cdot f)\Leftrightarrow\checkmark(a)\land f=\varepsilon]$ | +| `unit_ra` | singleton，unit 为 `one` | 全有效、全 included、predicate update 与 local update 的退化律 | +| `prod_ra R S` | `A#B`，逐坐标合成和 validity | 逐坐标 inclusion、update、local update，以及 `prod_inl`/`prod_inr` 提升 | +| `option_ra R` | `A option`，`NONE` 为新增 unit | `SOME` 上的 inclusion、update、local update 精确回落到 base RA | +| `excl_ra` | `ExclUnit | Excl a | ExclInvalid` | owned conflict、有效 exclusive token、替换 update | +| `agree_ra` | `AgreeUnit | Agree a | AgreeInvalid` | 相同值幂等，不同值冲突，兼容性推出 payload 相等 | +| `max_nat_ra` | `num`，unit `0`，operation `MAX` | inclusion 是 `<=`；base RA 上所有 deterministic update 都成立 | +| `frac_ra R` | empty 或正 share token | share 合成、full exclusivity、share weakening 与 predicate update lifting | +| `gmap_ra R` | finite map，逐 key 使用 `option_ra R` | pointwise validity/inclusion、key update、drop、fresh allocation | +| `named_ra R` | `gmap_ra R`，key 固定为 `num` | numeric name 下的 singleton ownership/update/drop/allocation | +| `auth_ra R` | authoritative + fragment | authoritative validity、framewise update、local-update lifting、allocation/drop | -### 3.5 nondeterministic frame-preserving update +### 3.1 产品嵌入 -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `RA_UPDATE_ND_SINGLETON` | `` `\|- forall R a b. ra_update_nd R a (\x. x == b) <=> ra_update R a b` `` | singleton ND update 等价于确定更新 | -| `RA_UPDATE_ND_REFL` | `` `\|- forall R a. ra_update_nd R a (\x. x == a)` `` | $a\rightsquigarrow\{a\}$ | -| `RA_UPDATE_ND_TRANS` | `` `\|- forall R a P Q. ra_update_nd R a P ==> (forall b. P b ==> ra_update_nd R b Q) ==> ra_update_nd R a Q` `` | ND Kleisli 式顺序复合 | -| `RA_UPDATE_ND_MONO` | `` `\|- forall R a P Q. ra_update_nd R a P ==> (forall b. P b ==> Q b) ==> ra_update_nd R a Q` `` | 后置谓词弱化 | -| `RA_UPDATE_ND_OF_UPDATE` | `` `\|- forall R a b P. ra_update R a b ==> P b ==> ra_update_nd R a P` `` | 确定更新嵌入 ND 更新 | -| `RA_UPDATE_ND_VALID` | `` `\|- forall R a P. ra_update_nd R a P ==> ra_valid R a ==> (exists b. P b && ra_valid R b)` `` | 有效源至少产生一个有效结果 | -| `RA_UPDATE_ND_INVALID` | `` `\|- forall R a P. ~ra_valid R a ==> ra_update_nd R a P` `` | 无效源上的更新 vacuous | -| `RA_UPDATE_ND_FRAME` | `` `\|- forall R a P. ra_update_nd R a P ==> (forall extra. ra_update_nd R (ra_op R a extra) (\x. exists b. P b && x == ra_op R b extra))` `` | 给源和每个结果加同一 `extra` | -| `RA_UPDATE_ND_OP` | `` `\|- forall R a c P Q. ra_update_nd R a P ==> ra_update_nd R c Q ==> ra_update_nd R (ra_op R a c) (\x. exists b d. P b && Q d && x == ra_op R b d)` `` | 两个独立 ND 更新按合成相乘 | -| `RA_EXCLUSIVE_UPDATE_ND_IFF` | `` `\|- forall R a P. ra_exclusive R a ==> (ra_update_nd R a P <=> ra_valid R a ==> (exists b. P b && ra_valid R b))` `` | exclusive 源把 ND 更新化为普通有效结果存在性 | - -### 3.6 deterministic frame-preserving update - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `RA_EXCLUSIVE_UPDATE` | `` `\|- forall R a b. ra_exclusive R a ==> ra_valid R b ==> ra_update R a b` `` | exclusive 源可更新到任意有效目标 | -| `RA_UPDATE_REFL` | `` `\|- forall R a. ra_update R a a` `` | $a\leadsto a$ | -| `RA_UPDATE_INVALID` | `` `\|- forall R a b. ~ra_valid R a ==> ra_update R a b` `` | 无效源上的更新 vacuous | -| `RA_UPDATE_INCLUDED` | `` `\|- forall R a b. ra_included R b a ==> ra_update R a b` `` | 可丢弃 extension | -| `RA_UPDATE_UNIT` | `` `\|- forall R a. ra_update R a (ra_unit R)` `` | 任意资源可丢弃为单位元 | -| `RA_UPDATE_TRANS` | `` `\|- forall R a b c. ra_update R a b ==> ra_update R b c ==> ra_update R a c` `` | 更新可传递复合 | -| `RA_UPDATE_TARGET_INCLUDED` | `` `\|- forall R a b c. ra_update R a b ==> ra_included R c b ==> ra_update R a c` `` | 更新目标可继续弱化到其 included 部分 | -| `RA_UPDATE_VALID` | `` `\|- forall R a b. ra_update R a b ==> ra_valid R a ==> ra_valid R b` `` | 有效源的更新目标有效 | -| `RA_EXCLUSIVE_UPDATE_IFF` | `` `\|- forall R a b. ra_exclusive R a ==> (ra_update R a b <=> ra_valid R a ==> ra_valid R b)` `` | exclusive 源上的确定更新精确刻画 | -| `RA_UPDATE_FRAME` | `` `\|- forall R a b. ra_update R a b ==> (forall extra. ra_update R (ra_op R a extra) (ra_op R b extra))` `` | 确定更新可加 frame | -| `RA_UPDATE_OP` | `` `\|- forall R a b c d. ra_update R a b ==> ra_update R c d ==> ra_update R (ra_op R a c) (ra_op R b d)` `` | 两个独立确定更新按合成相乘 | - -## 4. Local update +```text +prod_inl R S a == (a, ra_unit S) +prod_inr R S b == (ra_unit R, b) +``` -源文件：[`local_update.h`](../theory/logic/local_update.h)、 -[`local_update.c`](../theory/logic/local_update.c)。令 -$(a,f)\leadsto_R(b,g)$ 表示 `ra_local_update R (a,f) (b,g)`。 +`PROD_INL_OP`/`PROD_INR_OP` 保持 operation； +`PROD_INL_UPDATEP`/`PROD_INR_UPDATEP` 和 +`PROD_INL_UPDATE`/`PROD_INR_UPDATE` 把分量更新提升到完整产品。它们用于用 +普通嵌套 product 组合多个 global ghost protocol，无需异构 registry。 -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `ra_local_update_def` | `` `\|- ra_local_update R source target <=> (forall frame. ra_valid R (FST source) ==> FST source == ra_op R (SND source) frame ==> ra_valid R (FST target) && FST target == ra_op R (SND target) frame)` `` | 对每个满足 $a=f\cdot r$ 的同一 residual $r$，目标满足 $b=g\cdot r$ 且有效 | -| `RA_LOCAL_UPDATE_APPLY` | `` `\|- forall R source target frame. ra_local_update R source target ==> ra_valid R (FST source) ==> FST source == ra_op R (SND source) frame ==> ra_valid R (FST target) && FST target == ra_op R (SND target) frame` `` | 定义的直接应用式 | -| `RA_LOCAL_UPDATE_REFL` | `` `\|- forall R source. ra_local_update R source source` `` | $s\leadsto_R s$ | -| `RA_LOCAL_UPDATE_INVALID` | `` `\|- forall R a f b g. ~ra_valid R a ==> ra_local_update R (a,f) (b,g)` `` | 无效 whole 上 vacuous | -| `RA_LOCAL_UPDATE_TRANS` | `` `\|- forall R source middle target. ra_local_update R source middle ==> ra_local_update R middle target ==> ra_local_update R source target` `` | 传递复合 | -| `RA_LOCAL_UPDATE_FRAME` | `` `\|- forall R a f b g extra. ra_local_update R (a,f) (b,g) ==> ra_local_update R (a,ra_op R f extra) (b,ra_op R g extra)` `` | visible local part 两侧加同一 `extra` | -| `RA_LOCAL_UPDATE_PRESERVES_INCLUDED` | `` `\|- forall R a f b g external. ra_local_update R (a,f) (b,g) ==> ra_valid R a ==> ra_included R (ra_op R f external) a ==> ra_valid R b && ra_included R (ra_op R g external) b` `` | 保持所有外部 frame 下的 inclusion 与有效性 | -| `RA_LOCAL_UPDATE_VALID_INCLUDED` | `` `\|- forall R a f b g. ra_local_update R (a,f) (b,g) ==> ra_valid R a ==> ra_included R f a ==> ra_valid R b && ra_included R g b` `` | 上条在外部单位 frame 的特例 | -| `RA_LOCAL_UPDATE_OP` | `` `\|- forall R a f piece. (ra_valid R a ==> ra_valid R (ra_op R a piece)) ==> ra_local_update R (a,f) (ra_op R a piece,ra_op R f piece)` `` | 若扩张保持源有效性，则 whole 与 owned 同时分配 `piece` | -| `RA_LOCAL_UPDATE_ALLOC` | `` `\|- forall R a f piece. ra_valid R (ra_op R a piece) ==> ra_local_update R (a,f) (ra_op R a piece,ra_op R f piece)` `` | 直接有效性版本的同步分配 | -| `RA_LOCAL_UPDATE_EXCLUSIVE` | `` `\|- forall R a f b. ra_exclusive R f ==> ra_valid R b ==> ra_local_update R (a,f) (b,b)` `` | exclusive local part 可替换为完整拥有的任意有效 `b` | -| `RA_LOCAL_UPDATE_CANCEL` | `` `\|- forall R common a f. ra_cancellative R ==> ra_local_update R (ra_op R common a,ra_op R common f) (a,f)` `` | 从 whole 与 local part 同时消去共同前缀 | -| `RA_LOCAL_UPDATE_CANCEL_UNIT` | `` `\|- forall R common a. ra_cancellative R ==> ra_local_update R (ra_op R common a,common) (a,ra_unit R)` `` | 把共同 local part 全部消去 | -| `RA_LOCAL_UPDATE_CANCELLATIVE` | `` `\|- forall R a b common. ra_cancellative R ==> ra_valid R (ra_op R b common) ==> ra_local_update R (ra_op R a common,a) (ra_op R b common,b)` `` | cancellative RA 中保持 residual `common` 的同步替换 | - -## 5. 资源命题与 BI/SL +### 3.2 finite map 与 naming + +`gmap_ra R` 对每个 key 通过 `option_ra R` 逐点解释，finite-map representation +和 support 细节保持私有。client 通过 `GMAP_RA_OP_LOOKUP`、`GMAP_RA_VALID`、 +`GMAP_RA_VALID_LOOKUP`、`GMAP_RA_INCLUDED_LOOKUP_IFF`、 +`GMAP_RA_DECOMPOSE`、`GMAP_RA_LOCAL_UPDATE_AT`、`GMAP_RA_UPDATE_AT`、 +`GMAP_RA_UPDATEP_AT`、`GMAP_RA_DROP_AT` 与 allocation rules 操作它。 + +numeric naming 是一个显式薄层： + +```text +named_ra R == (gmap_ra R : ((num,A)finmap)ra) +``` + +[`named_ra.h`](../theory/logic/named_ra.h) 公开： + +```text +named_ra_def +NAMED_RA_UNIT +NAMED_RA_SINGLETON_OP +NAMED_RA_VALID_SINGLETON +NAMED_RA_UPDATE_SINGLETON +NAMED_RA_UPDATEP_SINGLETON +NAMED_RA_DROP +NAMED_RA_ALLOC +``` + +`DROP` 只表示将当前持有的 singleton fragment 更新到 unit；它不证明同名 key +未出现在未知 frame 中。fresh allocation 由 finite support 与无限 `num` key +space 保证。 + +## 4. 资源命题与严格 linear BI 源文件：[`resource_prop.h`](../theory/logic/resource_prop.h)、 -[`resource_prop.c`](../theory/logic/resource_prop.c)。以下等式定理是 assertion -函数的原始 HOL 等号，因此比 $\simeq_R$ 更强。 +[`resource_prop.c`](../theory/logic/resource_prop.c)。assertion 类型为 +`A->bool`。 -### 5.1 语义定义 +### 4.1 观察关系 -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `r_entails_def` | `` `\|- r_entails R P Q <=> (forall resource. ra_valid R resource ==> P resource ==> Q resource)` `` | $P\vdash_R Q\Leftrightarrow\forall a.\ \checkmark(a)\Rightarrow P(a)\Rightarrow Q(a)$ | -| `r_equiv_def` | `` `\|- r_equiv R P Q <=> r_entails R P Q && r_entails R Q P` `` | $P\simeq_RQ\Leftrightarrow(P\vdash_RQ)\land(Q\vdash_RP)$ | -| `r_emp_def` | `` `\|- r_emp R resource <=> resource == ra_unit R` `` | $\mathsf{emp}(a)\Leftrightarrow a=\varepsilon$ | -| `r_sep_def` | `` `\|- r_sep R P Q resource <=> (exists left right. resource == ra_op R left right && P left && Q right)` `` | $(P*Q)(a)\Leftrightarrow\exists x,y.\ a=x\cdot y\land P(x)\land Q(y)$ | -| `r_own_def` | `` `\|- r_own R owned resource <=> resource == owned` `` | $\mathsf{own}(x)(a)\Leftrightarrow a=x$ | -| `r_top_def` | `` `\|- r_top R resource <=> true` `` | $\top_R(a)\Leftrightarrow\top$ | -| `r_bottom_def` | `` `\|- r_bottom R resource <=> false` `` | $\bot_R(a)\Leftrightarrow\bot$ | -| `r_and_def` | `` `\|- r_and R P Q resource <=> P resource && Q resource` `` | $(P\land_RQ)(a)\Leftrightarrow P(a)\land Q(a)$ | -| `r_or_def` | `` `\|- r_or R P Q resource <=> P resource \|\| Q resource` `` | $(P\lor_RQ)(a)\Leftrightarrow P(a)\lor Q(a)$ | -| `r_impl_def` | `` `\|- r_impl R P Q resource <=> P resource ==> Q resource` `` | $(P\Rightarrow_RQ)(a)\Leftrightarrow(P(a)\Rightarrow Q(a))$ | -| `r_exists_def` | `` `\|- r_exists R P resource <=> (exists witness. P witness resource)` `` | $(\exists_Rx.P_x)(a)\Leftrightarrow\exists x.P_x(a)$ | -| `r_forall_def` | `` `\|- r_forall R P resource <=> (forall witness. P witness resource)` `` | $(\forall_Rx.P_x)(a)\Leftrightarrow\forall x.P_x(a)$ | -| `r_pure_def` | `` `\|- r_pure R phi resource <=> phi` `` | $\lceil\phi\rceil_R(a)\Leftrightarrow\phi$ | -| `r_fact_def` | `` `\|- r_fact R phi resource <=> phi && resource == ra_unit R` `` | $\lfloor\phi\rfloor_R(a)\Leftrightarrow\phi\land a=\varepsilon$ | -| `r_wand_def` | `` `\|- r_wand R P Q resource <=> (forall frame. ra_valid R (ra_op R resource frame) ==> P frame ==> Q (ra_op R resource frame))` `` | $(P-\!*Q)(a)\Leftrightarrow\forall f.\ \checkmark(a\cdot f)\Rightarrow P(f)\Rightarrow Q(a\cdot f)$ | - -`r_wand` 显式检查 `a·frame` 的有效性；entailment 本身也只观察有效资源。这两处 -有效性条件共同保证 adjunction 与 RA 的 partial composition 语义一致。 - -### 5.2 entailment 与 equivalence - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `R_ENTAILS_REFL` | `` `\|- forall R P. r_entails R P P` `` | $P\vdash_RP$ | -| `R_ENTAILS_TRANS` | `` `\|- forall R P Q S. r_entails R P Q ==> r_entails R Q S ==> r_entails R P S` `` | entailment 传递性 | -| `R_ENTAILS_POINTWISE` | `` `\|- forall R P Q. (forall resource. P resource ==> Q resource) ==> r_entails R P Q` `` | 全载体逐点蕴含可提升为有效资源 entailment | -| `R_EQUIV_POINTWISE` | `` `\|- forall R P Q. r_equiv R P Q <=> (forall resource. ra_valid R resource ==> (P resource <=> Q resource))` `` | $P\simeq_RQ$ 恰为有效点上的逐点等价 | -| `R_EQUIV_INTRO` | `` `\|- forall R P Q. r_entails R P Q ==> r_entails R Q P ==> r_equiv R P Q` `` | 双向 entailment 引入 equivalence | -| `R_EQUIV_REFL` | `` `\|- forall R P. r_equiv R P P` `` | $P\simeq_RP$ | -| `R_EQUIV_SYM` | `` `\|- forall R P Q. r_equiv R P Q ==> r_equiv R Q P` `` | 对称性 | -| `R_EQUIV_TRANS` | `` `\|- forall R P Q S. r_equiv R P Q ==> r_equiv R Q S ==> r_equiv R P S` `` | 传递性 | - -### 5.3 separating conjunction - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `R_SEP_ASSOC` | `` `\|- forall R P Q S. r_sep R (r_sep R P Q) S == r_sep R P (r_sep R Q S)` `` | $(P*Q)*S=P*(Q*S)$ | -| `R_SEP_COMM` | `` `\|- forall R P Q. r_sep R P Q == r_sep R Q P` `` | $P*Q=Q*P$ | -| `R_SEP_EMP_L` | `` `\|- forall R P. r_sep R (r_emp R) P == P` `` | $\mathsf{emp}*P=P$ | -| `R_SEP_EMP_R` | `` `\|- forall R P. r_sep R P (r_emp R) == P` `` | $P*\mathsf{emp}=P$ | -| `R_SEP_MONO` | `` `\|- forall R P P2 Q Q2. r_entails R P P2 ==> r_entails R Q Q2 ==> r_entails R (r_sep R P Q) (r_sep R P2 Q2)` `` | $P\vdash P'\land Q\vdash Q'\Rightarrow P*Q\vdash P'*Q'$ | -| `R_SEP_FRAME_L` | `` `\|- forall R P Q frame_pred. r_entails R P Q ==> r_entails R (r_sep R P frame_pred) (r_sep R Q frame_pred)` `` | $P\vdash Q\Rightarrow P*F\vdash Q*F$ | -| `R_SEP_FRAME_R` | `` `\|- forall R P Q frame_pred. r_entails R P Q ==> r_entails R (r_sep R frame_pred P) (r_sep R frame_pred Q)` `` | $P\vdash Q\Rightarrow F*P\vdash F*Q$ | -| `R_SEP_EXISTS_L` | `` `\|- forall R P Q. r_sep R (r_exists R (\witness. P witness)) Q == r_exists R (\witness. r_sep R (P witness) Q)` `` | $(\exists_Rx.P_x)*Q=\exists_Rx.(P_x*Q)$ | -| `R_SEP_EXISTS_R` | `` `\|- forall R P Q. r_sep R P (r_exists R (\witness. Q witness)) == r_exists R (\witness. r_sep R P (Q witness))` `` | $P*(\exists_Rx.Q_x)=\exists_Rx.(P*Q_x)$ | - -`R_SEP_FRAME_L/R` 的数学栏严格按**实际 theorem conclusion** 写。当前 -`resource_prop.h` 里的两条一行注释把 `F*P` 与 `P*F` 对调了；定理本身因 -`R_SEP_COMM` 逻辑上等价，但精确语法检查时应以本表为准。 - -### 5.4 additive connectives 与量词 - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `R_AND_INTRO` | `` `\|- forall R P Q S. r_entails R P Q ==> r_entails R P S ==> r_entails R P (r_and R Q S)` `` | $P\vdash Q\land P\vdash S\Rightarrow P\vdash Q\land_RS$ | -| `R_AND_ELIM_L` | `` `\|- forall R P Q. r_entails R (r_and R P Q) P` `` | $P\land_RQ\vdash P$ | -| `R_AND_ELIM_R` | `` `\|- forall R P Q. r_entails R (r_and R P Q) Q` `` | $P\land_RQ\vdash Q$ | -| `R_OR_INTRO_L` | `` `\|- forall R P Q. r_entails R P (r_or R P Q)` `` | $P\vdash P\lor_RQ$ | -| `R_OR_INTRO_R` | `` `\|- forall R P Q. r_entails R Q (r_or R P Q)` `` | $Q\vdash P\lor_RQ$ | -| `R_OR_ELIM` | `` `\|- forall R P Q S. r_entails R P S ==> r_entails R Q S ==> r_entails R (r_or R P Q) S` `` | 析取消去 | -| `R_EXISTS_INTRO` | `` `\|- forall R P witness. r_entails R (P witness) (r_exists R (\bound. P bound))` `` | $P_w\vdash\exists_Rx.P_x$ | -| `R_EXISTS_ELIM` | `` `\|- forall R P Q. (forall witness. r_entails R (P witness) Q) ==> r_entails R (r_exists R (\bound. P bound)) Q` `` | $(\forall x.P_x\vdash Q)\Rightarrow(\exists_Rx.P_x)\vdash Q$ | -| `R_EXISTS_MONO` | `` `\|- forall R P Q. (forall witness. r_entails R (P witness) (Q witness)) ==> r_entails R (r_exists R (\bound. P bound)) (r_exists R (\bound. Q bound))` `` | existential 的 pointwise 单调性 | -| `R_FORALL_INTRO` | `` `\|- forall R P Q. (forall witness. r_entails R P (Q witness)) ==> r_entails R P (r_forall R (\bound. Q bound))` `` | universal 引入 | -| `R_FORALL_ELIM` | `` `\|- forall R P Q witness. r_entails R (P witness) Q ==> r_entails R (r_forall R (\bound. P bound)) Q` `` | 以给定 witness 消去 universal | - -### 5.5 pure、exact-unit fact、ownership 与 adjunction - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `R_PURE_AND_INTRO` | `` `\|- forall R phi P Q. phi ==> r_entails R P Q ==> r_entails R P (r_and R (r_pure R phi) Q)` `` | 已知 $\phi$ 时把 pure 事实加入 additive conjunction | -| `R_PURE_AND_ELIM` | `` `\|- forall R phi P Q. (phi ==> r_entails R P Q) ==> r_entails R (r_and R (r_pure R phi) P) Q` `` | 从 pure guard 下证明即可消去它 | -| `R_FACT_AS_PURE_AND_EMP` | `` `\|- forall R phi. r_fact R phi == r_and R (r_pure R phi) (r_emp R)` `` | $\lfloor\phi\rfloor=\lceil\phi\rceil\land_R\mathsf{emp}$ | -| `R_FACT_TRUE` | `` `\|- forall R. r_fact R true == r_emp R` `` | $\lfloor\top\rfloor=\mathsf{emp}$ | -| `R_FACT_FALSE` | `` `\|- forall R. r_fact R false == r_bottom R` `` | $\lfloor\bot\rfloor=\bot_R$ | -| `R_FACT_SEP_L` | `` `\|- forall R phi P. r_sep R (r_fact R phi) P == r_and R (r_pure R phi) P` `` | $\lfloor\phi\rfloor*P=\lceil\phi\rceil\land_RP$ | -| `R_FACT_SEP_R` | `` `\|- forall R phi P. r_sep R P (r_fact R phi) == r_and R (r_pure R phi) P` `` | $P*\lfloor\phi\rfloor=\lceil\phi\rceil\land_RP$ | -| `R_FACT_INTRO` | `` `\|- forall R phi P Q. phi ==> r_entails R P Q ==> r_entails R P (r_sep R (r_fact R phi) Q)` `` | 已知 $\phi$ 时引入 exact-unit fact | -| `R_FACT_ELIM` | `` `\|- forall R phi P Q. (phi ==> r_entails R P Q) ==> r_entails R (r_sep R (r_fact R phi) P) Q` `` | fact 消去 | -| `R_FACT_DUP` | `` `\|- forall R phi. r_entails R (r_fact R phi) (r_sep R (r_fact R phi) (r_fact R phi))` `` | exact-unit fact 可复制 | -| `R_OWN_UNIT` | `` `\|- forall R. r_own R (ra_unit R) == r_emp R` `` | $\mathsf{own}(\varepsilon)=\mathsf{emp}$ | -| `R_OWN_OP` | `` `\|- forall R a b. r_own R (ra_op R a b) == r_sep R (r_own R a) (r_own R b)` `` | $\mathsf{own}(a\cdot b)=\mathsf{own}(a)*\mathsf{own}(b)$ | -| `R_OWN_VALID` | `` `\|- forall R a. r_entails R (r_own R a) (r_and R (r_pure R (ra_valid R a)) (r_own R a))` `` | ownership entail 自身有效性，同时保留 ownership | -| `R_IMPL_ADJUNCTION` | `` `\|- forall R P Q S. r_entails R (r_and R P Q) S <=> r_entails R P (r_impl R Q S)` `` | $P\land_RQ\vdash S\Leftrightarrow P\vdash(Q\Rightarrow_RS)$ | -| `R_WAND_ADJUNCTION` | `` `\|- forall R P Q S. r_entails R (r_sep R P Q) S <=> r_entails R P (r_wand R Q S)` `` | $P*Q\vdash S\Leftrightarrow P\vdash(Q-\!*_RS)$ | -| `R_SEP_AND_FORWARD_R` | `` `\|- forall R P Q S. r_entails R (r_sep R P (r_and R Q S)) (r_and R (r_sep R P Q) (r_sep R P S))` `` | $P*(Q\land_RS)\vdash(P*Q)\land_R(P*S)$ | -| `R_SEP_AND_FORWARD_L` | `` `\|- forall R P Q S. r_entails R (r_sep R (r_and R Q S) P) (r_and R (r_sep R Q P) (r_sep R S P))` `` | $(Q\land_RS)*P\vdash(Q*P)\land_R(S*P)$ | - -后两条只有 forward entailment；一般不能反推为等式，因为 additive conjunction -两侧可以采用不同的资源分解。 - -## 6. Basic update 与 view shift - -源文件：[`basic_update.h`](../theory/logic/basic_update.h)、 -[`basic_update.c`](../theory/logic/basic_update.c)。记 -$\lvert\!\Rightarrow P=\mathsf{bupd}_R(P)$， -$P\Rrightarrow_RQ=\mathsf{viewshift}_R(P,Q)$。 - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `r_bupd_def` | `` `\|- r_bupd R Q owned <=> ra_update_nd R owned Q` `` | $(\lvert\!\Rightarrow Q)(a)\Leftrightarrow a\rightsquigarrow_RQ$ | -| `r_viewshift_def` | `` `\|- r_viewshift R P Q <=> r_entails R P (r_bupd R Q)` `` | $P\Rrightarrow_RQ\Leftrightarrow P\vdash_R\lvert\!\Rightarrow Q$ | -| `R_BUPD_INTRO` | `` `\|- forall R P. r_entails R P (r_bupd R P)` `` | $P\vdash\lvert\!\Rightarrow P$ | -| `R_BUPD_MONO` | `` `\|- forall R P Q. r_entails R P Q ==> r_entails R (r_bupd R P) (r_bupd R Q)` `` | $P\vdash Q\Rightarrow(\lvert\!\Rightarrow P)\vdash(\lvert\!\Rightarrow Q)$ | -| `R_BUPD_IDEM` | `` `\|- forall R P. r_entails R (r_bupd R (r_bupd R P)) (r_bupd R P)` `` | $\lvert\!\Rightarrow\lvert\!\Rightarrow P\vdash\lvert\!\Rightarrow P$ | -| `R_BUPD_FRAME` | `` `\|- forall R P frame_pred. r_entails R (r_sep R (r_bupd R P) frame_pred) (r_bupd R (r_sep R P frame_pred))` `` | $(\lvert\!\Rightarrow P)*F\vdash\lvert\!\Rightarrow(P*F)$ | -| `R_VIEWSHIFT_REFL` | `` `\|- forall R P. r_viewshift R P P` `` | $P\Rrightarrow_RP$ | -| `R_ENTAILS_TO_VIEWSHIFT` | `` `\|- forall R P Q. r_entails R P Q ==> r_viewshift R P Q` `` | $P\vdash Q\Rightarrow P\Rrightarrow_RQ$ | -| `R_VIEWSHIFT_TRANS` | `` `\|- forall R P Q S. r_viewshift R P Q ==> r_viewshift R Q S ==> r_viewshift R P S` `` | view shift 传递性 | -| `R_VIEWSHIFT_MONO` | `` `\|- forall R P2 P Q Q2. r_entails R P2 P ==> r_viewshift R P Q ==> r_entails R Q Q2 ==> r_viewshift R P2 Q2` `` | 前件逆变、后件协变 | -| `R_VIEWSHIFT_FRAME` | `` `\|- forall R P Q frame_pred. r_viewshift R P Q ==> r_viewshift R (r_sep R P frame_pred) (r_sep R Q frame_pred)` `` | $P\Rrightarrow Q\Rightarrow P*F\Rrightarrow Q*F$ | -| `R_VIEWSHIFT_SEP` | `` `\|- forall R P1 Q1 P2 Q2. r_viewshift R P1 Q1 ==> r_viewshift R P2 Q2 ==> r_viewshift R (r_sep R P1 P2) (r_sep R Q1 Q2)` `` | 两个 view shift 按 separating conjunction 组合 | -| `R_VIEWSHIFT_EXISTS_L` | `` `\|- forall R P Q. (forall witness. r_viewshift R (P witness) Q) ==> r_viewshift R (r_exists R (\bound. P bound)) Q` `` | 从 existential 前件消去 witness | -| `R_VIEWSHIFT_EXISTS_R` | `` `\|- forall R P Q witness. r_viewshift R P (Q witness) ==> r_viewshift R P (r_exists R (\bound. Q bound))` `` | 向 existential 后件引入指定 witness | -| `R_VIEWSHIFT_EXISTS` | `` `\|- forall R P Q. (forall witness. r_viewshift R (P witness) (Q witness)) ==> r_viewshift R (r_exists R (\bound. P bound)) (r_exists R (\bound. Q bound))` `` | pointwise view shift 提升过 existential | -| `R_OWN_UPDATE` | `` `\|- forall R a b. ra_update R a b ==> r_viewshift R (r_own R a) (r_own R b)` `` | RA 确定更新提升为 ownership view shift | -| `R_OWN_UPDATE_ND` | `` `\|- forall R a result_pred. ra_update_nd R a result_pred ==> r_viewshift R (r_own R a) (r_exists R (\selected. r_and R (r_pure R (result_pred selected)) (r_own R selected)))` `` | ND 更新暴露 existential 结果、后置条件与新 ownership | - -## 7. Iterated separating conjunction（big-sep） - -源文件：[`big_sep.h`](../theory/logic/big_sep.h)、 -[`big_sep.c`](../theory/logic/big_sep.c)。采用以下数学缩写： - -- $\mathop{\ast}_R[P_0,\ldots,P_n]$：`r_big_sep R Ps`； -- $\mathop{\ast}_{x\in xs}^{R}\Phi(x)$：`r_big_sep_list R Phi xs`； -- $\mathop{\ast}_{x\in s}^{R}\Phi(x)$：`r_big_sep_set R Phi s`； -- $\mathop{\ast}_{k\mapsto v\in m}^{R}\Phi(k,v)$：`r_big_sep_map R Phi m`； -- $\mathop{\ast}_{(i,x)\in xs,o}^{R}\Phi(i,x)$： - `r_big_sep_listi_from R Phi o xs`，省略 `o` 时从 `0` 开始。 - -以下所有 `==` 仍是 assertion 的原始 HOL 等号。 - -### 7.1 定义与 literal assertion list - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `r_big_sep_listi_from_def` | `` `\|- r_big_sep_listi_from R Phi offset [] == r_emp R && r_big_sep_listi_from R Phi offset (x :: xs) == r_sep R (Phi offset x) (r_big_sep_listi_from R Phi (SUC offset) xs)` `` | offset-indexed fold 的 `[]`/`::` 方程 | -| `r_big_sep_listi_def` | `` `\|- r_big_sep_listi R Phi xs == r_big_sep_listi_from R Phi 0 xs` `` | indexed fold 从 0 开始 | -| `r_big_sep_def` | `` `\|- r_big_sep R [] == r_emp R && r_big_sep R (P :: Ps) == r_sep R P (r_big_sep R Ps)` `` | 断言列表的右结合 fold | -| `r_big_sep_list_def` | `` `\|- r_big_sep_list R Phi xs == r_big_sep R (MAP Phi xs)` `` | 数据列表先 `MAP Phi` 再 fold | -| `r_big_sep_set_def` | `` `\|- r_big_sep_set R Phi s == iterate (r_sep R) s Phi` `` | 用 commutative-monoid `iterate` 折叠集合 | -| `r_big_sep_map_value_def` | `` `\|- r_big_sep_map_value m key == (@value. finmap_lookup m key == SOME value)` `` | 在 domain 内用 Hilbert choice 取该 key 的值 | -| `r_big_sep_map_def` | `` `\|- r_big_sep_map R Phi m == r_big_sep_set R (\key. Phi key (r_big_sep_map_value m key)) (finmap_dom m)` `` | map fold 是 domain 上的 set fold | -| `R_BIG_SEP_NIL` | `` `\|- forall R. r_big_sep R [] == r_emp R` `` | $\mathop{\ast}_R[]=\mathsf{emp}$ | -| `R_BIG_SEP_CONS` | `` `\|- forall R P Ps. r_big_sep R (P :: Ps) == r_sep R P (r_big_sep R Ps)` `` | $\mathop{\ast}(P::Ps)=P*\mathop{\ast}Ps$ | -| `R_BIG_SEP_SINGLETON` | `` `\|- forall R P. r_big_sep R [P] == P` `` | singleton fold | -| `R_BIG_SEP_APPEND` | `` `\|- forall R left right. r_big_sep R (left ++ right) == r_sep R (r_big_sep R left) (r_big_sep R right)` `` | append 分解为两个 fold 的 `*` | -| `R_BIG_SEP_SNOC` | `` `\|- forall R Ps P. r_big_sep R (Ps ++ [P]) == r_sep R (r_big_sep R Ps) P` `` | snoc 方程 | -| `R_BIG_SEP_REVERSE` | `` `\|- forall R Ps. r_big_sep R (REVERSE Ps) == r_big_sep R Ps` `` | reverse 不变性 | -| `R_BIG_SEP_SWAP_HEAD` | `` `\|- forall R P Q Ps. r_big_sep R (P :: Q :: Ps) == r_big_sep R (Q :: P :: Ps)` `` | 相邻头元素可交换 | - -### 7.2 Unindexed list binder - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `R_BIG_SEP_LIST_NIL` | `` `\|- forall R Phi. r_big_sep_list R Phi [] == r_emp R` `` | 空列表 | -| `R_BIG_SEP_LIST_CONS` | `` `\|- forall R Phi x xs. r_big_sep_list R Phi (x :: xs) == r_sep R (Phi x) (r_big_sep_list R Phi xs)` `` | cons | -| `R_BIG_SEP_LIST_SINGLETON` | `` `\|- forall R Phi x. r_big_sep_list R Phi [x] == Phi x` `` | singleton | -| `R_BIG_SEP_LIST_APPEND` | `` `\|- forall R Phi left right. r_big_sep_list R Phi (left ++ right) == r_sep R (r_big_sep_list R Phi left) (r_big_sep_list R Phi right)` `` | append | -| `R_BIG_SEP_LIST_REVERSE` | `` `\|- forall R Phi xs. r_big_sep_list R Phi (REVERSE xs) == r_big_sep_list R Phi xs` `` | reverse 不变性 | -| `R_BIG_SEP_LIST_SWAP_HEAD` | `` `\|- forall R Phi x y xs. r_big_sep_list R Phi (x :: y :: xs) == r_big_sep_list R Phi (y :: x :: xs)` `` | 相邻头元素交换 | -| `R_BIG_SEP_LIST_MONO` | `` `\|- forall R Phi Psi xs. (forall x. r_entails R (Phi x) (Psi x)) ==> r_entails R (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs)` `` | 全局 pointwise entailment 提升到 fold | -| `R_BIG_SEP_LIST_MONO_ON` | `` `\|- forall R Phi Psi xs. (forall x. MEM x xs ==> r_entails R (Phi x) (Psi x)) ==> r_entails R (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs)` `` | 只需对 `MEM x xs` 的元素证明单调性 | -| `R_BIG_SEP_LIST_EQUIV` | `` `\|- forall R Phi Psi xs. (forall x. r_equiv R (Phi x) (Psi x)) ==> r_equiv R (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs)` `` | pointwise $\simeq_R$ 提升 | -| `R_BIG_SEP_LIST_EQUIV_ON` | `` `\|- forall R Phi Psi xs. (forall x. MEM x xs ==> r_equiv R (Phi x) (Psi x)) ==> r_equiv R (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs)` `` | member-restricted equivalence | -| `R_BIG_SEP_LIST_MAP` | `` `\|- forall R Phi f xs. r_big_sep_list R Phi (MAP f xs) == r_big_sep_list R (\x. Phi (f x)) xs` `` | 数据 `MAP` 等价于 predicate composition | -| `R_BIG_SEP_LIST_EMP` | `` `\|- forall R xs. r_big_sep_list R (\x. r_emp R) xs == r_emp R` `` | 全 `emp` fold 为 `emp` | -| `R_BIG_SEP_LIST_SEP` | `` `\|- forall R Phi Psi xs. r_big_sep_list R (\x. r_sep R (Phi x) (Psi x)) xs == r_sep R (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs)` `` | pointwise `*` 分配过 list fold | - -### 7.3 Finite-set binder - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `R_BIG_SEP_SET_EMPTY` | `` `\|- forall R Phi. r_big_sep_set R Phi {} == r_emp R` `` | 空集 fold | -| `R_BIG_SEP_SET_INSERT` | `` `\|- forall R Phi x s. FINITE s ==> ~(x IN s) ==> r_big_sep_set R Phi (x INSERT s) == r_sep R (Phi x) (r_big_sep_set R Phi s)` `` | finite fresh insertion | -| `R_BIG_SEP_SET_SINGLETON` | `` `\|- forall R Phi x. r_big_sep_set R Phi {x} == Phi x` `` | singleton | -| `R_BIG_SEP_SET_UNION` | `` `\|- forall R Phi left right. FINITE left && FINITE right && DISJOINT left right ==> r_big_sep_set R Phi (left UNION right) == r_sep R (r_big_sep_set R Phi left) (r_big_sep_set R Phi right)` `` | 有限不交并分解 | -| `R_BIG_SEP_SET_EQ` | `` `\|- forall R Phi Psi s. (forall x. x IN s ==> Phi x == Psi x) ==> r_big_sep_set R Phi s == r_big_sep_set R Psi s` `` | 集合成员上的 pointwise 原始等号 | -| `R_BIG_SEP_SET_MONO` | `` `\|- forall R Phi Psi s. FINITE s ==> (forall x. x IN s ==> r_entails R (Phi x) (Psi x)) ==> r_entails R (r_big_sep_set R Phi s) (r_big_sep_set R Psi s)` `` | finite-set entailment 单调性 | -| `R_BIG_SEP_SET_EQUIV` | `` `\|- forall R Phi Psi s. FINITE s ==> (forall x. x IN s ==> r_equiv R (Phi x) (Psi x)) ==> r_equiv R (r_big_sep_set R Phi s) (r_big_sep_set R Psi s)` `` | finite-set equivalence | -| `R_BIG_SEP_SET_EMP` | `` `\|- forall R s. r_big_sep_set R (\x. r_emp R) s == r_emp R` `` | 全 `emp`；包括无限集合（`iterate` 的退化语义） | -| `R_BIG_SEP_SET_SEP` | `` `\|- forall R Phi Psi s. FINITE s ==> r_big_sep_set R (\x. r_sep R (Phi x) (Psi x)) s == r_sep R (r_big_sep_set R Phi s) (r_big_sep_set R Psi s)` `` | finite set 上 pointwise `*` 分配 | - -### 7.4 Finite-map binder - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `R_BIG_SEP_MAP_VALUE` | `` `\|- forall m key value. finmap_lookup m key == SOME value ==> r_big_sep_map_value m key == value` `` | 成功 lookup 唯一确定 choice value | -| `R_BIG_SEP_MAP_VALUE_LOOKUP` | `` `\|- forall m key. key IN finmap_dom m ==> finmap_lookup m key == SOME (r_big_sep_map_value m key)` `` | domain 中 key 的 choice 可查回 | -| `R_BIG_SEP_MAP_EMPTY` | `` `\|- forall R Phi. r_big_sep_map R Phi finmap_empty == r_emp R` `` | 空 map | -| `R_BIG_SEP_MAP_INSERT` | `` `\|- forall R Phi key value m. finmap_lookup m key == NONE ==> r_big_sep_map R Phi (finmap_insert key value m) == r_sep R (Phi key value) (r_big_sep_map R Phi m)` `` | fresh insert | -| `R_BIG_SEP_MAP_SINGLETON` | `` `\|- forall R Phi key value. r_big_sep_map R Phi (finmap_singleton key value) == Phi key value` `` | singleton map | -| `R_BIG_SEP_MAP_DELETE` | `` `\|- forall R Phi m key value. finmap_lookup m key == SOME value ==> r_big_sep_map R Phi m == r_sep R (Phi key value) (r_big_sep_map R Phi (finmap_delete key m))` `` | 抽出存在的 binding | -| `R_BIG_SEP_MAP_EQ` | `` `\|- forall R Phi Psi m. (forall key value. finmap_lookup m key == SOME value ==> Phi key value == Psi key value) ==> r_big_sep_map R Phi m == r_big_sep_map R Psi m` `` | present bindings 上原始等号 | -| `R_BIG_SEP_MAP_MONO` | `` `\|- forall R Phi Psi m. (forall key value. finmap_lookup m key == SOME value ==> r_entails R (Phi key value) (Psi key value)) ==> r_entails R (r_big_sep_map R Phi m) (r_big_sep_map R Psi m)` `` | present bindings 上 entailment 单调性 | -| `R_BIG_SEP_MAP_EQUIV` | `` `\|- forall R Phi Psi m. (forall key value. finmap_lookup m key == SOME value ==> r_equiv R (Phi key value) (Psi key value)) ==> r_equiv R (r_big_sep_map R Phi m) (r_big_sep_map R Psi m)` `` | present bindings 上 equivalence | -| `R_BIG_SEP_MAP_EMP` | `` `\|- forall R m. r_big_sep_map R (\key value. r_emp R) m == r_emp R` `` | 全 `emp` map fold | -| `R_BIG_SEP_MAP_SEP` | `` `\|- forall R Phi Psi m. r_big_sep_map R (\key value. r_sep R (Phi key value) (Psi key value)) m == r_sep R (r_big_sep_map R Phi m) (r_big_sep_map R Psi m)` `` | pointwise `*` 分配过 map fold | - -### 7.5 Indexed list binder - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `R_BIG_SEP_LISTI_NIL` | `` `\|- forall R Phi. r_big_sep_listi R Phi [] == r_emp R` `` | 空 indexed list | -| `R_BIG_SEP_LISTI_CONS` | `` `\|- forall R Phi x xs. r_big_sep_listi R Phi (x :: xs) == r_sep R (Phi 0 x) (r_big_sep_listi_from R Phi 1 xs)` `` | 头索引 0，尾 offset 1 | -| `R_BIG_SEP_LISTI_FROM_APPEND` | `` `\|- forall R Phi left offset right. r_big_sep_listi_from R Phi offset (left ++ right) == r_sep R (r_big_sep_listi_from R Phi offset left) (r_big_sep_listi_from R Phi (offset + LENGTH left) right)` `` | offset-aware append | -| `R_BIG_SEP_LISTI_APPEND` | `` `\|- forall R Phi left right. r_big_sep_listi R Phi (left ++ right) == r_sep R (r_big_sep_listi R Phi left) (r_big_sep_listi_from R Phi (LENGTH left) right)` `` | zero-based append | -| `R_BIG_SEP_LISTI_SINGLETON` | `` `\|- forall R Phi x. r_big_sep_listi R Phi [x] == Phi 0 x` `` | singleton | -| `R_BIG_SEP_LISTI_FROM_SHIFT` | `` `\|- forall R Phi offset xs. r_big_sep_listi_from R Phi offset xs == r_big_sep_listi R (\index x. Phi (offset + index) x) xs` `` | offset 等价于 index predicate 平移 | -| `R_BIG_SEP_LISTI_CONS_SHIFT` | `` `\|- forall R Phi x xs. r_big_sep_listi R Phi (x :: xs) == r_sep R (Phi 0 x) (r_big_sep_listi R (\index y. Phi (SUC index) y) xs)` `` | 尾 predicate 平移 1 的 cons 方程 | -| `R_BIG_SEP_LISTI_APPEND_SHIFT` | `` `\|- forall R Phi left right. r_big_sep_listi R Phi (left ++ right) == r_sep R (r_big_sep_listi R Phi left) (r_big_sep_listi R (\index x. Phi (LENGTH left + index) x) right)` `` | 右段 predicate 平移 `LENGTH left` | -| `R_BIG_SEP_LISTI_FROM_MONO` | `` `\|- forall R Phi Psi xs offset. (forall index x. r_entails R (Phi index x) (Psi index x)) ==> r_entails R (r_big_sep_listi_from R Phi offset xs) (r_big_sep_listi_from R Psi offset xs)` `` | offset fold 的 pointwise entailment | -| `R_BIG_SEP_LISTI_MONO` | `` `\|- forall R Phi Psi xs. (forall index x. r_entails R (Phi index x) (Psi index x)) ==> r_entails R (r_big_sep_listi R Phi xs) (r_big_sep_listi R Psi xs)` `` | zero-based indexed monotonicity | -| `R_BIG_SEP_LISTI_FROM_EQUIV` | `` `\|- forall R Phi Psi xs offset. (forall index x. r_equiv R (Phi index x) (Psi index x)) ==> r_equiv R (r_big_sep_listi_from R Phi offset xs) (r_big_sep_listi_from R Psi offset xs)` `` | offset fold 的 equivalence | -| `R_BIG_SEP_LISTI_EQUIV` | `` `\|- forall R Phi Psi xs. (forall index x. r_equiv R (Phi index x) (Psi index x)) ==> r_equiv R (r_big_sep_listi R Phi xs) (r_big_sep_listi R Psi xs)` `` | zero-based indexed equivalence | -| `R_BIG_SEP_LISTI_FROM_SEP` | `` `\|- forall R Phi Psi xs offset. r_big_sep_listi_from R (\index x. r_sep R (Phi index x) (Psi index x)) offset xs == r_sep R (r_big_sep_listi_from R Phi offset xs) (r_big_sep_listi_from R Psi offset xs)` `` | offset-indexed pointwise `*` 分配 | -| `R_BIG_SEP_LISTI_SEP` | `` `\|- forall R Phi Psi xs. r_big_sep_listi R (\index x. r_sep R (Phi index x) (Psi index x)) xs == r_sep R (r_big_sep_listi R Phi xs) (r_big_sep_listi R Psi xs)` `` | zero-based indexed pointwise `*` 分配 | - -## 8. RA 构造子 - -本节的 product、option、exclusive、agreement、fractional、authoritative 与 -finite-map lift 都是**新 RA 实例**；ghost heap、memory RA 与 C resource RA 则是 -这些构造子的别名或闭合特化。ND lifting 中出现的 lambda 都是精确 image -predicate；这对反向 `IFF` 定理成立至关重要。 - -### 8.1 Unit RA - -源文件：[`unit_ra.h`](../theory/logic/unit_ra.h)、 -[`unit_ra.c`](../theory/logic/unit_ra.c)。carrier 是 HOL singleton type `1`。 - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `UNIT_RA_UNIT` | `` `\|- ra_unit unit_ra == one` `` | $\varepsilon_{\mathbf1}=\star$ | -| `UNIT_RA_OP` | `` `\|- forall a b. ra_op unit_ra a b == one` `` | $a\cdot b=\star$ | -| `UNIT_RA_VALID` | `` `\|- forall a. ra_valid unit_ra a` `` | 所有元素有效 | -| `UNIT_RA_INCLUDED` | `` `\|- forall a b. ra_included unit_ra a b` `` | 唯一元素间 inclusion 总成立 | -| `UNIT_RA_EXCLUSIVE` | `` `\|- forall a. ra_exclusive unit_ra a` `` | 唯一相容 frame 就是 unit | -| `UNIT_RA_CANCELLATIVE` | `` `\|- ra_cancellative unit_ra` `` | cancellative | -| `UNIT_RA_UPDATE` | `` `\|- forall a b. ra_update unit_ra a b` `` | 任意确定更新成立 | -| `UNIT_RA_UPDATE_ND_IFF` | `` `\|- forall a P. ra_update_nd unit_ra a P <=> P one` `` | ND 更新当且仅当后置谓词包含 $\star$ | -| `UNIT_RA_LOCAL_UPDATE` | `` `\|- forall source target. ra_local_update unit_ra source target` `` | 任意 local update 成立 | - -### 8.2 Product RA - -源文件：[`prod_ra.h`](../theory/logic/prod_ra.h)、 -[`prod_ra.c`](../theory/logic/prod_ra.c)。记 $R=R_1\times R_2$。 - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `PROD_RA_UNIT` | `` `\|- forall R1 R2. ra_unit (prod_ra R1 R2) == ra_unit R1,ra_unit R2` `` | $\varepsilon_R=(\varepsilon_1,\varepsilon_2)$ | -| `PROD_RA_OP` | `` `\|- forall R1 R2 x y. ra_op (prod_ra R1 R2) x y == ra_op R1 (FST x) (FST y),ra_op R2 (SND x) (SND y)` `` | product operation 逐坐标计算 | -| `PROD_RA_VALID` | `` `\|- forall R1 R2 x. ra_valid (prod_ra R1 R2) x <=> ra_valid R1 (FST x) && ra_valid R2 (SND x)` `` | $\checkmark_R(x_1,x_2)\Leftrightarrow\checkmark_1(x_1)\land\checkmark_2(x_2)$ | -| `PROD_RA_INCLUDED` | `` `\|- forall R1 R2 x y. ra_included (prod_ra R1 R2) x y <=> ra_included R1 (FST x) (FST y) && ra_included R2 (SND x) (SND y)` `` | inclusion 逐坐标 | -| `PROD_RA_EXCLUSIVE` | `` `\|- forall R1 R2 x. ra_exclusive R1 (FST x) ==> ra_exclusive R2 (SND x) ==> ra_exclusive (prod_ra R1 R2) x` `` | 两坐标 exclusive 推出 product exclusive | -| `PROD_RA_EXCLUSIVE_ELIM_LEFT` | `` `\|- forall R1 R2 x. ra_valid (prod_ra R1 R2) x ==> ra_exclusive (prod_ra R1 R2) x ==> ra_exclusive R1 (FST x)` `` | 有效 product exclusive 投影到左坐标 | -| `PROD_RA_EXCLUSIVE_ELIM_RIGHT` | `` `\|- forall R1 R2 x. ra_valid (prod_ra R1 R2) x ==> ra_exclusive (prod_ra R1 R2) x ==> ra_exclusive R2 (SND x)` `` | 同上，右坐标 | -| `PROD_RA_EXCLUSIVE_IFF` | `` `\|- forall R1 R2 x. ra_valid (prod_ra R1 R2) x ==> (ra_exclusive (prod_ra R1 R2) x <=> ra_exclusive R1 (FST x) && ra_exclusive R2 (SND x))` `` | 有效源下 product exclusive 的精确刻画 | -| `PROD_RA_CANCELLATIVE` | `` `\|- forall R1 R2. ra_cancellative R1 ==> ra_cancellative R2 ==> ra_cancellative (prod_ra R1 R2)` `` | cancellation 逐坐标提升 | -| `PROD_RA_CANCELLATIVE_IFF` | `` `\|- forall R1 R2. ra_cancellative (prod_ra R1 R2) <=> ra_cancellative R1 && ra_cancellative R2` `` | product cancellative 当且仅当两分量均 cancellative | -| `PROD_RA_UPDATE_ND` | `` `\|- forall R1 R2 a1 a2 P1 P2. ra_update_nd R1 a1 P1 ==> ra_update_nd R2 a2 P2 ==> ra_update_nd (prod_ra R1 R2) (a1,a2) (\x. exists b1 b2. P1 b1 && P2 b2 && x == b1,b2)` `` | 两个 ND 更新逐坐标合成 | -| `PROD_RA_UPDATE` | `` `\|- forall R1 R2 a1 a2 b1 b2. ra_update R1 a1 b1 ==> ra_update R2 a2 b2 ==> ra_update (prod_ra R1 R2) (a1,a2) (b1,b2)` `` | 两个确定更新逐坐标合成 | -| `PROD_RA_UPDATE_ELIM_LEFT` | `` `\|- forall R1 R2 a1 a2 b1 b2. ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) ==> ra_valid R2 a2 ==> ra_update R1 a1 b1` `` | 另一源分量有效时反投影左更新 | -| `PROD_RA_UPDATE_ELIM_RIGHT` | `` `\|- forall R1 R2 a1 a2 b1 b2. ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) ==> ra_valid R1 a1 ==> ra_update R2 a2 b2` `` | 对称的右投影 | -| `PROD_RA_UPDATE_IFF` | `` `\|- forall R1 R2 a1 a2 b1 b2. ra_valid R1 a1 ==> ra_valid R2 a2 ==> (ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) <=> ra_update R1 a1 b1 && ra_update R2 a2 b2)` `` | 两源分量有效时 product update 的精确刻画 | -| `PROD_RA_UPDATE_LEFT_ND` | `` `\|- forall R1 R2 a1 a2 P. ra_update_nd R1 a1 P ==> ra_update_nd (prod_ra R1 R2) (a1,a2) (\x. exists b1. P b1 && x == b1,a2)` `` | 只更新左坐标的 ND lifting | -| `PROD_RA_UPDATE_LEFT` | `` `\|- forall R1 R2 a1 a2 b1. ra_update R1 a1 b1 ==> ra_update (prod_ra R1 R2) (a1,a2) (b1,a2)` `` | 只确定更新左坐标 | -| `PROD_RA_UPDATE_RIGHT_ND` | `` `\|- forall R1 R2 a1 a2 P. ra_update_nd R2 a2 P ==> ra_update_nd (prod_ra R1 R2) (a1,a2) (\x. exists b2. P b2 && x == a1,b2)` `` | 只更新右坐标的 ND lifting | -| `PROD_RA_UPDATE_RIGHT` | `` `\|- forall R1 R2 a1 a2 b2. ra_update R2 a2 b2 ==> ra_update (prod_ra R1 R2) (a1,a2) (a1,b2)` `` | 只确定更新右坐标 | -| `PROD_RA_LOCAL_UPDATE` | `` `\|- forall R1 R2 a1 f1 b1 g1 a2 f2 b2 g2. ra_local_update R1 (a1,f1) (b1,g1) ==> ra_local_update R2 (a2,f2) (b2,g2) ==> ra_local_update (prod_ra R1 R2) ((a1,a2),f1,f2) ((b1,b2),g1,g2)` `` | local update 逐坐标合成 | -| `PROD_RA_LOCAL_UPDATE_LEFT` | `` `\|- forall R1 R2 a1 f1 b1 g1 a2 f2. ra_local_update R1 (a1,f1) (b1,g1) ==> ra_local_update (prod_ra R1 R2) ((a1,a2),f1,f2) ((b1,a2),g1,f2)` `` | 只提升左 local update | -| `PROD_RA_LOCAL_UPDATE_RIGHT` | `` `\|- forall R1 R2 a1 f1 a2 f2 b2 g2. ra_local_update R2 (a2,f2) (b2,g2) ==> ra_local_update (prod_ra R1 R2) ((a1,a2),f1,f2) ((a1,b2),f1,g2)` `` | 只提升右 local update | - -### 8.3 Option RA - -源文件：[`option_ra.h`](../theory/logic/option_ra.h)、 -[`option_ra.c`](../theory/logic/option_ra.c)。`NONE` 是新单位元； -`SOME (ra_unit R)` 仍表示一个在场 binding，二者不相等。 - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `OPTION_RA_UNIT` | `` `\|- forall R. ra_unit (option_ra R) == NONE` `` | $\varepsilon_{R_\bot}=\mathrm{None}$ | -| `OPTION_RA_OP_NONE_L` | `` `\|- forall R x. ra_op (option_ra R) NONE x == x` `` | `NONE` 左单位律 | -| `OPTION_RA_OP_NONE_R` | `` `\|- forall R x. ra_op (option_ra R) x NONE == x` `` | `NONE` 右单位律 | -| `OPTION_RA_OP_SOME_SOME` | `` `\|- forall R a b. ra_op (option_ra R) (SOME a) (SOME b) == SOME (ra_op R a b)` `` | 两个在场值按 base RA 合成 | -| `OPTION_RA_SOME_INJ` | `` `\|- forall a b. SOME a == SOME b <=> a == b` `` | `SOME` 单射 | -| `OPTION_RA_SOME_NE_NONE` | `` `\|- forall a. ~(SOME a == NONE)` `` | 在场与缺席不同 | -| `OPTION_RA_VALID_NONE` | `` `\|- forall R. ra_valid (option_ra R) NONE` `` | 新单位有效 | -| `OPTION_RA_VALID_SOME` | `` `\|- forall R a. ra_valid (option_ra R) (SOME a) <=> ra_valid R a` `` | 在场值有效性继承 base | -| `OPTION_RA_INCLUDED_NONE` | `` `\|- forall R x. ra_included (option_ra R) NONE x` `` | `NONE` 是 extension preorder 的底 | -| `OPTION_RA_INCLUDED_SOME_SOME` | `` `\|- forall R a b. ra_included (option_ra R) (SOME a) (SOME b) <=> ra_included R a b` `` | 在场值 inclusion 反映 base inclusion | -| `OPTION_RA_NOT_INCLUDED_SOME_NONE` | `` `\|- forall R a. ~ra_included (option_ra R) (SOME a) NONE` `` | 在场值不能扩张成新单位 | -| `OPTION_RA_EXCLUSIVE_SOME_IFF` | `` `\|- forall R a. ra_exclusive (option_ra R) (SOME a) <=> ~ra_valid R a` `` | `SOME a` 仅在 base `a` 无效时 vacuously exclusive | -| `OPTION_RA_NOT_EXCLUSIVE_NONE` | `` `\|- forall R. ~ra_exclusive (option_ra R) NONE` `` | 新单位总有非单位相容 frame | -| `OPTION_RA_NOT_CANCELLATIVE` | `` `\|- forall R. ~ra_cancellative (option_ra R)` `` | `NONE` 与 `SOME ε` 区分使 cancellation 失败 | -| `OPTION_RA_LOCAL_UPDATE_SOME` | `` `\|- forall R a f b g. ra_local_update R (a,f) (b,g) ==> ra_local_update (option_ra R) (SOME a,SOME f) (SOME b,SOME g)` `` | base local update 的 `SOME` lifting | -| `OPTION_RA_LOCAL_UPDATE_SOME_IFF` | `` `\|- forall R a f b g. ra_local_update (option_ra R) (SOME a,SOME f) (SOME b,SOME g) <=> ra_local_update R (a,f) (b,g)` `` | 上述 lifting 的精确 iff | -| `OPTION_RA_UPDATE` | `` `\|- forall R a b. ra_update R a b ==> ra_update (option_ra R) (SOME a) (SOME b)` `` | base update lifting | -| `OPTION_RA_UPDATE_IFF` | `` `\|- forall R a b. ra_update (option_ra R) (SOME a) (SOME b) <=> ra_update R a b` `` | 在场确定更新精确反映 base | -| `OPTION_RA_UPDATE_ND` | `` `\|- forall R a P. ra_update_nd R a P ==> ra_update_nd (option_ra R) (SOME a) (\x. exists b. P b && x == SOME b)` `` | base ND update 的精确 `SOME` image | -| `OPTION_RA_UPDATE_ND_IFF` | `` `\|- forall R a P. ra_update_nd (option_ra R) (SOME a) (\x. exists b. P b && x == SOME b) <=> ra_update_nd R a P` `` | 精确 `SOME` image 上的 iff | - -### 8.4 Exclusive RA - -源文件：[`excl_ra.h`](../theory/logic/excl_ra.h)、 -[`excl_ra.c`](../theory/logic/excl_ra.c)。carrier 为 -`ExclUnit | Excl a | ExclInvalid`。 - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `EXCL_RA_UNIT` | `` `\|- ra_unit excl_ra == ExclUnit` `` | unit 是 `ExclUnit` | -| `EXCL_RA_OWNED_INJ` | `` `\|- forall a b. Excl a == Excl b <=> a == b` `` | owned constructor 单射 | -| `EXCL_RA_OWNED_NE_UNIT` | `` `\|- forall a. ~(Excl a == ExclUnit)` `` | owned 不等于 unit | -| `EXCL_RA_INVALID_NE_UNIT` | `` `\|- ~(ExclInvalid == ExclUnit)` `` | invalid 不等于 unit | -| `EXCL_RA_INVALID_NE_OWNED` | `` `\|- forall a. ~(ExclInvalid == Excl a)` `` | invalid 不等于 owned | -| `EXCL_RA_OWNED_CONFLICT` | `` `\|- forall a b. ra_op excl_ra (Excl a) (Excl b) == ExclInvalid` `` | 任意两个 owned token 冲突 | -| `EXCL_RA_VALID_UNIT` | `` `\|- ra_valid excl_ra ExclUnit` `` | unit 有效 | -| `EXCL_RA_VALID_OWNED` | `` `\|- forall a. ra_valid excl_ra (Excl a)` `` | 每个单独 owned token 有效 | -| `EXCL_RA_INVALID` | `` `\|- ~ra_valid excl_ra ExclInvalid` `` | invalid 无效 | -| `EXCL_RA_VALID_IFF` | `` `\|- forall x. ra_valid excl_ra x <=> ~(x == ExclInvalid)` `` | 有效当且仅当不是 invalid | -| `EXCL_RA_INCLUDED_OWNED` | `` `\|- forall a b. ra_included excl_ra (Excl a) (Excl b) <=> a == b` `` | owned-to-owned inclusion 恰为 payload 等号 | -| `EXCL_RA_INCLUDED_OWNED_IFF` | `` `\|- forall a x. ra_included excl_ra (Excl a) x <=> x == Excl a \|\| x == ExclInvalid` `` | owned 的全部 extension：自身或 invalid | -| `EXCL_RA_INCLUDED_INVALID_IFF` | `` `\|- forall x. ra_included excl_ra ExclInvalid x <=> x == ExclInvalid` `` | invalid 仅 included 于自身 | -| `EXCL_RA_EXCLUSIVE` | `` `\|- forall a. ra_exclusive excl_ra (Excl a)` `` | owned token exclusive | -| `EXCL_RA_EXCLUSIVE_INVALID` | `` `\|- ra_exclusive excl_ra ExclInvalid` `` | invalid vacuously exclusive | -| `EXCL_RA_CANCELLATIVE` | `` `\|- ra_cancellative excl_ra` `` | exclusive RA cancellative | -| `EXCL_RA_UPDATE` | `` `\|- forall a b. ra_update excl_ra (Excl a) (Excl b)` `` | 任意有效 owned token 可互换 | -| `EXCL_RA_UPDATE_VALID` | `` `\|- forall a x. ra_valid excl_ra x ==> ra_update excl_ra (Excl a) x` `` | owned 源可更新到任意有效目标 | -| `EXCL_RA_UPDATE_OWNED_IFF` | `` `\|- forall a x. ra_update excl_ra (Excl a) x <=> ra_valid excl_ra x` `` | 上条是必要充分条件 | -| `EXCL_RA_UPDATE_INVALID` | `` `\|- forall x. ra_update excl_ra ExclInvalid x` `` | invalid 源任意更新 | -| `EXCL_RA_LOCAL_UPDATE_VALID` | `` `\|- forall a x. ra_valid excl_ra x ==> ra_local_update excl_ra (Excl a,Excl a) (x,x)` `` | 完整 owned pair 可替换为有效完整目标 | -| `EXCL_RA_LOCAL_UPDATE_IFF` | `` `\|- forall a x. ra_local_update excl_ra (Excl a,Excl a) (x,x) <=> ra_valid excl_ra x` `` | 上述 local update 的 iff | - -内部构造接口 [`excl_ra_internal.h`](../theory/logic/excl_ra_internal.h) 另外导出 -`excl_owned_op_def`、`excl_op_def`、两个 datatype distinction theorem 与 -`EXCL_RA_OP_FN`；普通客户端不应依赖它们。 - -### 8.5 Agreement RA - -源文件：[`agree_ra.h`](../theory/logic/agree_ra.h)、 -[`agree_ra.c`](../theory/logic/agree_ra.c)。carrier 为 -`AgreeUnit | Agree a | AgreeInvalid`；同 payload token 可复制，异 payload 合成无效。 - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `AGREE_RA_UNIT` | `` `\|- ra_unit agree_ra == AgreeUnit` `` | unit | -| `AGREE_RA_OWNED_OP` | `` `\|- forall a b. ra_op agree_ra (Agree a) (Agree b) == (if a == b then Agree a else AgreeInvalid)` `` | 同值幂等，异值冲突 | -| `AGREE_RA_IDEMPOTENT` | `` `\|- forall a. ra_op agree_ra (Agree a) (Agree a) == Agree a` `` | `Agree a` 可复制/合并 | -| `AGREE_RA_OWNED_INJ` | `` `\|- forall a b. Agree a == Agree b <=> a == b` `` | constructor 单射 | -| `AGREE_RA_OWNED_NE_UNIT` | `` `\|- forall a. ~(Agree a == AgreeUnit)` `` | owned 与 unit 区分 | -| `AGREE_RA_INVALID_NE_UNIT` | `` `\|- ~(AgreeInvalid == AgreeUnit)` `` | invalid 与 unit 区分 | -| `AGREE_RA_INVALID_NE_OWNED` | `` `\|- forall a. ~(AgreeInvalid == Agree a)` `` | invalid 与 owned 区分 | -| `AGREE_RA_VALID_UNIT` | `` `\|- ra_valid agree_ra AgreeUnit` `` | unit 有效 | -| `AGREE_RA_VALID_OWNED` | `` `\|- forall a. ra_valid agree_ra (Agree a)` `` | 单个 owned token 有效 | -| `AGREE_RA_INVALID` | `` `\|- ~ra_valid agree_ra AgreeInvalid` `` | invalid 无效 | -| `AGREE_RA_VALID_COMBINE_IFF` | `` `\|- forall a b. ra_valid agree_ra (ra_op agree_ra (Agree a) (Agree b)) <=> a == b` `` | 两 token 可相容当且仅当 payload 相等 | -| `AGREE_RA_INCLUDED_OWNED` | `` `\|- forall a b. ra_included agree_ra (Agree a) (Agree b) <=> a == b` `` | owned-to-owned inclusion | -| `AGREE_RA_INCLUDED_UNIT` | `` `\|- forall x. ra_included agree_ra AgreeUnit x` `` | unit included 于所有元素 | -| `AGREE_RA_NOT_INCLUDED_OWNED_UNIT` | `` `\|- forall a. ~ra_included agree_ra (Agree a) AgreeUnit` `` | owned 不能扩张成 unit | -| `AGREE_RA_INCLUDED_OWNED_INVALID` | `` `\|- forall a. ra_included agree_ra (Agree a) AgreeInvalid` `` | raw inclusion 允许 invalid extension | -| `AGREE_RA_NOT_INCLUDED_INVALID_UNIT` | `` `\|- ~ra_included agree_ra AgreeInvalid AgreeUnit` `` | invalid 不 included 于 unit | -| `AGREE_RA_NOT_INCLUDED_INVALID_OWNED` | `` `\|- forall a. ~ra_included agree_ra AgreeInvalid (Agree a)` `` | invalid 不 included 于 owned | -| `AGREE_RA_NOT_EXCLUSIVE_OWNED` | `` `\|- forall a. ~ra_exclusive agree_ra (Agree a)` `` | 幂等 token 非 exclusive | -| `AGREE_RA_EXCLUSIVE_INVALID` | `` `\|- ra_exclusive agree_ra AgreeInvalid` `` | invalid vacuously exclusive | -| `AGREE_RA_NOT_CANCELLATIVE` | `` `\|- ~ra_cancellative agree_ra` `` | 幂等性破坏 cancellation | -| `AGREE_RA_AGREEMENT` | `` `\|- forall a b. ra_valid agree_ra (ra_op agree_ra (Agree a) (Agree b)) ==> a == b` `` | 有效合成蕴含 agreement | -| `AGREE_RA_UPDATE_IFF` | `` `\|- forall a b. ra_update agree_ra (Agree a) (Agree b) <=> a == b` `` | owned token 只能更新为相同 payload | -| `AGREE_RA_LOCAL_UPDATE_OWNED_IFF` | `` `\|- forall a b. ra_local_update agree_ra (Agree a,Agree a) (Agree b,Agree b) <=> a == b` `` | 完整 local update 同样保持 payload | - -### 8.6 Max-natural RA - -源文件：[`max_nat_ra.h`](../theory/logic/max_nat_ra.h)、 -[`max_nat_ra.c`](../theory/logic/max_nat_ra.c)。这是 -$(\mathbb N,0,\max,\top)$。 - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `MAX_NAT_RA_UNIT` | `` `\|- ra_unit max_nat_ra == 0` `` | unit 为 0 | -| `MAX_NAT_RA_OP` | `` `\|- forall a b. ra_op max_nat_ra a b == MAX a b` `` | operation 为 `max` | -| `MAX_NAT_RA_VALID` | `` `\|- forall n. ra_valid max_nat_ra n` `` | 全部自然数有效 | -| `MAX_NAT_RA_INCLUDED` | `` `\|- forall a b. ra_included max_nat_ra a b <=> a <= b` `` | RA inclusion 恰为数值 $\le$ | -| `MAX_NAT_RA_INCLUDED_ZERO` | `` `\|- forall n. ra_included max_nat_ra 0 n` `` | 0 是底 | -| `MAX_NAT_RA_INCLUDED_OP` | `` `\|- forall a b bound. ra_included max_nat_ra (ra_op max_nat_ra a b) bound <=> a <= bound && b <= bound` `` | $\max(a,b)\le n\Leftrightarrow a\le n\land b\le n$ | -| `MAX_NAT_RA_IDEMPOTENT` | `` `\|- forall n. ra_op max_nat_ra n n == n` `` | max 幂等 | -| `MAX_NAT_RA_OP_EQ_RIGHT` | `` `\|- forall a b. a <= b ==> ra_op max_nat_ra a b == b` `` | 右侧较大时 max 为右侧 | -| `MAX_NAT_RA_OP_EQ_LEFT` | `` `\|- forall a b. b <= a ==> ra_op max_nat_ra a b == a` `` | 对称形式 | -| `MAX_NAT_RA_NOT_EXCLUSIVE` | `` `\|- forall n. ~ra_exclusive max_nat_ra n` `` | 没有 exclusive 元素 | -| `MAX_NAT_RA_NOT_CANCELLATIVE` | `` `\|- ~ra_cancellative max_nat_ra` `` | max 非 cancellative | -| `MAX_NAT_RA_INCLUDED_MONO_RIGHT` | `` `\|- forall old new fragment. old <= new ==> ra_included max_nat_ra fragment old ==> ra_included max_nat_ra fragment new` `` | 提高上界保持 fragment inclusion | -| `MAX_NAT_RA_LOCAL_UPDATE_UNIT_IFF` | `` `\|- forall old new. ra_local_update max_nat_ra (old,0) (new,0) <=> old == new` `` | 没有 owned fragment 时 local update 不能改变 whole | -| `MAX_NAT_RA_UPDATE` | `` `\|- forall old new. ra_update max_nat_ra old new` `` | base 确定更新全成立（不能表达单调协议） | -| `MAX_NAT_RA_UPDATE_ND` | `` `\|- forall old P. (exists new. P new) ==> ra_update_nd max_nat_ra old P` `` | 非空后置谓词足够 | -| `MAX_NAT_RA_UPDATE_ND_IFF` | `` `\|- forall old P. ra_update_nd max_nat_ra old P <=> (exists new. P new)` `` | ND 更新恰为后置谓词非空 | - -### 8.7 Fractional RA - -源文件：[`frac_ra.h`](../theory/logic/frac_ra.h)、 -[`frac_ra.c`](../theory/logic/frac_ra.c)。`frac_own p a` 是 total HOL -function，但计算、单射和有效性定理通常带 `&0 < p` 前提；数学上只把正权重 -当作规范 fractional ownership。 - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `FRAC_RA_UNIT` | `` `\|- forall R. ra_unit (frac_ra R) == frac_empty` `` | fractional unit 是 empty | -| `FRAC_RA_FULL` | `` `\|- forall a. frac_full a == frac_own (&1) a` `` | full share 是权重 1 | -| `FRAC_RA_OWN_OP` | `` `\|- forall R p q a b. &0 < p ==> &0 < q ==> ra_op (frac_ra R) (frac_own p a) (frac_own q b) == frac_own (p + q) (ra_op R a b)` `` | 权重相加、payload 按 base 合成 | -| `FRAC_RA_OWN_INJ` | `` `\|- forall p q a b. &0 < p ==> &0 < q ==> (frac_own p a == frac_own q b <=> p == q && a == b)` `` | 正权重 constructor 单射 | -| `FRAC_RA_OWN_NE_EMPTY` | `` `\|- forall p a. ~(frac_own p a == frac_empty)` `` | owned 与 empty 不同 | -| `FRAC_RA_FULL_INJ` | `` `\|- forall a b. frac_full a == frac_full b <=> a == b` `` | full 单射 | -| `FRAC_RA_FULL_NE_EMPTY` | `` `\|- forall a. ~(frac_full a == frac_empty)` `` | full 非 empty | -| `FRAC_RA_VALID_EMPTY` | `` `\|- forall R. ra_valid (frac_ra R) frac_empty` `` | empty 有效 | -| `FRAC_RA_VALID_OWN` | `` `\|- forall R p a. &0 < p ==> (ra_valid (frac_ra R) (frac_own p a) <=> p <= &1 && ra_valid R a)` `` | 正 share 有效 iff $p\le1$ 且 payload 有效 | -| `FRAC_RA_VALID_FULL` | `` `\|- forall R a. ra_valid (frac_ra R) (frac_full a) <=> ra_valid R a` `` | full 有效性等于 payload 有效性 | -| `FRAC_RA_INCLUDED_EMPTY` | `` `\|- forall R x. ra_included (frac_ra R) frac_empty x` `` | empty 是底 | -| `FRAC_RA_INCLUDED_OWN` | `` `\|- forall R p q a b. &0 < p ==> &0 < q ==> (ra_included (frac_ra R) (frac_own p a) (frac_own q b) <=> p == q && a == b \|\| p < q && ra_included R a b)` `` | 相等 share 需相同 payload；严格增 share 需 base inclusion | -| `FRAC_RA_NOT_INCLUDED_OWN_EMPTY` | `` `\|- forall R p a. &0 < p ==> ~ra_included (frac_ra R) (frac_own p a) frac_empty` `` | 正 share 不 included 于 empty | -| `FRAC_RA_INCLUDED_FULL` | `` `\|- forall R a b. ra_included (frac_ra R) (frac_full a) (frac_full b) <=> a == b` `` | full-to-full inclusion 恰为 payload 等号 | -| `FRAC_RA_EXCLUSIVE_FULL` | `` `\|- forall R a. ra_exclusive (frac_ra R) (frac_full a)` `` | full share exclusive（无效 payload 时可 vacuous） | -| `FRAC_RA_CANCELLATIVE` | `` `\|- forall R. ra_cancellative R ==> ra_cancellative (frac_ra R)` `` | base cancellation 提升 | -| `FRAC_RA_UPDATE_WEAKEN` | `` `\|- forall R p q a b. &0 < q ==> q <= p ==> ra_update R a b ==> ra_update (frac_ra R) (frac_own p a) (frac_own q b)` `` | 可降低 share 并执行 base update | -| `FRAC_RA_UPDATE_WEAKEN_ND` | `` `\|- forall R p q a P. &0 < q ==> q <= p ==> ra_update_nd R a P ==> ra_update_nd (frac_ra R) (frac_own p a) (\x. exists b. P b && x == frac_own q b)` `` | ND 版 share weakening | -| `FRAC_RA_UPDATE_FULL` | `` `\|- forall R a b. ra_valid R b ==> ra_update (frac_ra R) (frac_full a) (frac_full b)` `` | full share 可换成任意有效 payload | -| `FRAC_RA_UPDATE_FULL_IFF` | `` `\|- forall R a b. ra_update (frac_ra R) (frac_full a) (frac_full b) <=> ra_valid R a ==> ra_valid R b` `` | full deterministic update 的精确刻画 | -| `FRAC_RA_UPDATE_FULL_ND` | `` `\|- forall R a P. (exists b. P b && ra_valid R b) ==> ra_update_nd (frac_ra R) (frac_full a) (\x. exists b. P b && x == frac_full b)` `` | 存在有效 payload 即可进行 full ND update | -| `FRAC_RA_UPDATE_FULL_ND_IFF` | `` `\|- forall R a P. ra_update_nd (frac_ra R) (frac_full a) (\x. exists b. P b && x == frac_full b) <=> ra_valid R a ==> (exists b. P b && ra_valid R b)` `` | 考虑无效源 vacuity 的精确 iff | - -### 8.8 Finite-map carrier support - -$\texttt{(K,V)finmap}$ 是“有限 support 的总函数 -$K\to\mathrm{option}\ V$”的保守 HOL subtype；它是 gmap_ra 的 -carrier 支撑，不是 RA 或 BI connective。以下列出最常用于理解 RA 证明的边界定理。 - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| finmap_finite_def | |- forall f. finmap_finite f <=> FINITE {k | ~(f k == NONE)} | representation 的非空 support 有限 | -| FINMAP_TYPE_BIJECTION | |- (forall m. finmap_abs (finmap_rep m) == m) && (forall f. finmap_finite f <=> finmap_rep (finmap_abs f) == f) | subtype abstraction/representation 双射 | -| FINMAP_EQ | |- forall m n. m == n <=> finmap_rep m == finmap_rep n | map equality 可降到 representation | -| finmap_empty_def | |- finmap_empty == finmap_abs (\k. NONE) | 空 map 处处 absent | -| finmap_lookup_def | |- forall m k. finmap_lookup m k == finmap_rep m k | lookup 是 representation observation | -| finmap_singleton_def | |- forall key v. finmap_singleton key v == finmap_abs (\k. if k == key then SOME v else NONE) | singleton 只在 key 处 present | -| finmap_insert_def | |- forall key v m. finmap_insert key v m == finmap_abs (\k. if k == key then SOME v else finmap_rep m k) | insert 覆盖 key | -| finmap_delete_def | |- forall key m. finmap_delete key m == finmap_abs (\k. if k == key then NONE else finmap_rep m k) | delete 令 key absent | -| finmap_dom_def | |- forall m. finmap_dom m == {k | ~(finmap_lookup m k == NONE)} | domain 是 present keys | -| FINMAP_SINGLETON_LOOKUP | |- forall key v k. finmap_lookup (finmap_singleton key v) k == if k == key then SOME v else NONE | singleton lookup equation | -| FINMAP_INSERT_LOOKUP | |- forall key v m k. finmap_lookup (finmap_insert key v m) k == if k == key then SOME v else finmap_lookup m k | insert lookup equation | -| FINMAP_DELETE_LOOKUP | |- forall key m k. finmap_lookup (finmap_delete key m) k == if k == key then NONE else finmap_lookup m k | delete lookup equation | -| FINMAP_EQ_LOOKUP | |- forall m n. m == n <=> (forall k. finmap_lookup m k == finmap_lookup n k) | lookup extensionality | -| FINMAP_DECOMPOSE | |- forall key v m. finmap_lookup m key == SOME v ==> finmap_insert key v (finmap_delete key m) == m | present entry 可删后重建 | -| FINMAP_DOM_FINITE | |- forall m. FINITE (finmap_dom m) | 每个 map 的 domain 有限 | -| FINMAP_FRESH_IN_PAIR | |- forall candidates m n. INFINITE candidates ==> (exists key. key IN candidates && finmap_lookup m key == NONE && finmap_lookup n key == NONE) | 任意两个有限 map 在无限候选集中有共同 fresh key | -| FINMAP_FRESH | |- forall m. INFINITE (UNIV:K->bool) ==> (exists key. finmap_lookup m key == NONE) | 无限 key type 上每个有限 map 有 fresh key | -| FINMAP_INDUCT | |- forall P. P finmap_empty ==> (forall key v m. finmap_lookup m key == NONE ==> P m ==> P (finmap_insert key v m)) ==> (forall m. P m) | 以 fresh insert 为步的有限 map 归纳 | - -其余公开定理不是隐藏公理，而是上述 representation 的派生计算律： - -- representation/lookup： - FINMAP_REP_FINITE、FINMAP_EMPTY_REP、 - FINMAP_EMPTY_LOOKUP、FINMAP_SINGLETON_SUPPORT、 - FINMAP_SINGLETON_REP、FINMAP_INSERT_SUPPORT、 - FINMAP_INSERT_REP、FINMAP_INSERT_LOOKUP_EQ、 - FINMAP_INSERT_LOOKUP_NE、FINMAP_DELETE_SUPPORT、 - FINMAP_DELETE_REP、FINMAP_DELETE_LOOKUP_EQ、 - FINMAP_DELETE_LOOKUP_NE； -- insert/delete algebra： - FINMAP_INSERT_EMPTY、FINMAP_DELETE_EMPTY、 - FINMAP_INSERT_OVERWRITE、FINMAP_INSERT_COMM、 - FINMAP_DELETE_IDEMPOTENT、FINMAP_DELETE_COMM、 - FINMAP_DELETE_INSERT、FINMAP_DELETE_INSERT_NE、 - FINMAP_INSERT_DELETE、FINMAP_INSERT_ID、 - FINMAP_DELETE_ID； -- domain/freshness： - FINMAP_DOM_EMPTY、FINMAP_DOM_SINGLETON、 - FINMAP_IN_DOM、FINMAP_IN_DOM_SOME、 - FINMAP_NOT_IN_DOM、FINMAP_FRESH_IN、 - FINMAP_FRESH_PAIR、FINMAP_DOM_EQ_EMPTY、 - FINMAP_DOM_INSERT、FINMAP_DOM_DELETE。 - -### 8.9 Finite-map RA - -$\mathrm{GMap}_K(R)=\texttt{gmap_ra R}$ 的 carrier 是有限映射 -$K\rightharpoonup A$。每个 key 在代数上按 -$\mathrm{Option}(R)$ 组合；因此 absent 是 $\texttt{NONE}$，而 -$\texttt{SOME }\varepsilon_R$ 仍然是 present。 - -#### Operation、validity 与 inclusion - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| GMAP_RA_UNIT | |- forall R. ra_unit (gmap_ra R) == finmap_empty | $\varepsilon_{\mathrm{GMap}(R)}=\varnothing$ | -| GMAP_RA_OP_LOOKUP | |- forall R m n k. finmap_lookup (ra_op (gmap_ra R) m n) k == ra_op (option_ra R) (finmap_lookup m k) (finmap_lookup n k) | $(m\cdot n)(k)=m(k)\cdot_{\mathrm{Option}(R)}n(k)$ | -| GMAP_RA_SINGLETON_OP | |- forall R key a b. ra_op (gmap_ra R) (finmap_singleton key a) (finmap_singleton key b) == finmap_singleton key (ra_op R a b) | 同 key 的 singleton 逐点组合 | -| GMAP_RA_OP_SINGLETON_AT | |- forall R key a frame m. finmap_lookup m key == SOME a ==> ra_op (gmap_ra R) m (finmap_singleton key frame) == finmap_insert key (ra_op R a frame) m | 已存在 key 与 singleton frame 的组合等价于更新该 key | -| GMAP_RA_OP_INSERT_INSERT | |- forall R key a b m n. ra_op (gmap_ra R) (finmap_insert key a m) (finmap_insert key b n) == finmap_insert key (ra_op R a b) (ra_op (gmap_ra R) m n) | 两侧同 key insert 后再组合 | -| GMAP_RA_OP_DELETE | |- forall R key m n. ra_op (gmap_ra R) (finmap_delete key m) (finmap_delete key n) == finmap_delete key (ra_op (gmap_ra R) m n) | 双侧 delete 与 map operation 交换 | -| GMAP_RA_SINGLETON_OP_FRESH | |- forall R key a m. finmap_lookup m key == NONE ==> ra_op (gmap_ra R) (finmap_singleton key a) m == finmap_insert key a m | fresh singleton 的组合就是 insert | -| GMAP_RA_DECOMPOSE | |- forall R key a m. finmap_lookup m key == SOME a ==> m == ra_op (gmap_ra R) (finmap_singleton key a) (finmap_delete key m) | existing entry 与删除后的余图分解原 map | -| GMAP_RA_SINGLETON_OP_DELETE | |- forall R key a m. ra_op (gmap_ra R) (finmap_singleton key a) (finmap_delete key m) == finmap_insert key a m | singleton 与删 key 后余图的组合 | -| GMAP_RA_DOM_OP | |- forall R m n. finmap_dom (ra_op (gmap_ra R) m n) == finmap_dom m UNION finmap_dom n | $\operatorname{dom}(m\cdot n)=\operatorname{dom}m\cup\operatorname{dom}n$ | -| GMAP_RA_VALID | |- forall R m. ra_valid (gmap_ra R) m <=> (forall k. ra_valid (option_ra R) (finmap_lookup m k)) | map validity 是逐 key 的 option-validity | -| GMAP_RA_VALID_SINGLETON | |- forall R key a. ra_valid (gmap_ra R) (finmap_singleton key a) <=> ra_valid R a | singleton valid iff payload valid | -| GMAP_RA_VALID_LOOKUP_DELETE | |- forall R key m. ra_valid (gmap_ra R) m <=> ra_valid (option_ra R) (finmap_lookup m key) && ra_valid (gmap_ra R) (finmap_delete key m) | validity 可拆成一个 lookup 和其余 map | -| GMAP_RA_VALID_DELETE_SOME | |- forall R key a m. finmap_lookup m key == SOME a ==> (ra_valid (gmap_ra R) m <=> ra_valid R a && ra_valid (gmap_ra R) (finmap_delete key m)) | present entry 下的 validity 分解 | -| GMAP_RA_VALID_LOOKUP | |- forall R key a m. ra_valid (gmap_ra R) m ==> finmap_lookup m key == SOME a ==> ra_valid R a | valid map 中每个 present payload valid | -| GMAP_RA_VALID_DELETE | |- forall R key m. ra_valid (gmap_ra R) m ==> ra_valid (gmap_ra R) (finmap_delete key m) | delete 保 validity | -| GMAP_RA_VALID_INSERT | |- forall R key a m. ra_valid (gmap_ra R) (finmap_insert key a m) <=> ra_valid R a && ra_valid (gmap_ra R) (finmap_delete key m) | insert 后 validity 的精确条件 | -| GMAP_RA_VALID_INSERT_OF_VALID | |- forall R key a m. ra_valid R a ==> ra_valid (gmap_ra R) m ==> ra_valid (gmap_ra R) (finmap_insert key a m) | valid payload 插入 valid map 后仍 valid | -| GMAP_RA_VALID_INSERT_FRESH | |- forall R key a m. finmap_lookup m key == NONE ==> (ra_valid (gmap_ra R) (finmap_insert key a m) <=> ra_valid R a && ra_valid (gmap_ra R) m) | fresh insert 的 validity 分解 | -| GMAP_RA_INCLUDED_LOOKUP | |- forall R m n. ra_included (gmap_ra R) m n ==> (forall k. ra_included (option_ra R) (finmap_lookup m k) (finmap_lookup n k)) | map inclusion 推出逐 key inclusion | -| GMAP_RA_INCLUDED_OF_LOOKUP | |- forall R m n. (forall k. ra_included (option_ra R) (finmap_lookup m k) (finmap_lookup n k)) ==> ra_included (gmap_ra R) m n | 逐 key inclusion 推出 map inclusion | -| GMAP_RA_INCLUDED_LOOKUP_IFF | |- forall R m n. ra_included (gmap_ra R) m n <=> (forall k. ra_included (option_ra R) (finmap_lookup m k) (finmap_lookup n k)) | map inclusion 的 pointwise iff | -| GMAP_RA_INCLUDED_DELETE | |- forall R key m. ra_included (gmap_ra R) (finmap_delete key m) m | 删除后的 map included 于原 map | -| GMAP_RA_INCLUDED_LOOKUP_SOME | |- forall R m n. ra_included (gmap_ra R) m n <=> (forall key a. finmap_lookup m key == SOME a ==> (exists b. finmap_lookup n key == SOME b && ra_included R a b)) | 只量化 source 中 present entries 的 characterization | -| GMAP_RA_INCLUDED_DOM | |- forall R m n. ra_included (gmap_ra R) m n ==> finmap_dom m SUBSET finmap_dom n | inclusion 单调扩大 domain | -| GMAP_RA_INCLUDED_SINGLETON | |- forall R key a b. ra_included (gmap_ra R) (finmap_singleton key a) (finmap_singleton key b) <=> ra_included R a b | 同 key singleton inclusion 回落到 base | - -#### Local、deterministic 与 nondeterministic update - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| GMAP_RA_LOCAL_UPDATE_SINGLETON | |- forall R key a f b g. ra_local_update R (a,f) (b,g) ==> ra_local_update (gmap_ra R) (finmap_singleton key a,finmap_singleton key f) (finmap_singleton key b,finmap_singleton key g) | base local update 提升到 singleton | -| GMAP_RA_LOCAL_UPDATE_SINGLETON_IFF | |- forall R key a f b g. ra_local_update (gmap_ra R) (finmap_singleton key a,finmap_singleton key f) (finmap_singleton key b,finmap_singleton key g) <=> ra_local_update R (a,f) (b,g) | singleton local update 的 iff | -| GMAP_RA_LOCAL_UPDATE_AT | |- forall R key a f b g m. finmap_lookup m key == SOME a ==> ra_local_update R (a,f) (b,g) ==> ra_local_update (gmap_ra R) (m,finmap_singleton key f) (finmap_insert key b m,finmap_singleton key g) | 对 map 中现有 key 执行 base local update | -| GMAP_RA_LOCAL_UPDATE_AT_IFF | |- forall R key a f b g m. finmap_lookup m key == SOME a ==> (ra_local_update (gmap_ra R) (m,finmap_singleton key f) (finmap_insert key b m,finmap_singleton key g) <=> ra_valid (gmap_ra R) m ==> ra_local_update R (a,f) (b,g)) | at-key local update 的 exact iff；invalid source 时真空 | -| GMAP_RA_UPDATE_SINGLETON | |- forall R key a b. ra_update R a b ==> ra_update (gmap_ra R) (finmap_singleton key a) (finmap_singleton key b) | base deterministic update 提升到 singleton | -| GMAP_RA_UPDATE_SINGLETON_IFF | |- forall R key a b. ra_update (gmap_ra R) (finmap_singleton key a) (finmap_singleton key b) <=> ra_update R a b | singleton deterministic update 的 iff | -| GMAP_RA_UPDATE_INSERT | |- forall R key a b m. ra_update R a b ==> ra_update (gmap_ra R) (finmap_insert key a m) (finmap_insert key b m) | insert payload update | -| GMAP_RA_UPDATE_AT | |- forall R key a b m. finmap_lookup m key == SOME a ==> ra_update R a b ==> ra_update (gmap_ra R) m (finmap_insert key b m) | existing key 的 deterministic update | -| GMAP_RA_UPDATE_AT_IFF | |- forall R key a b m. finmap_lookup m key == SOME a ==> (ra_update (gmap_ra R) m (finmap_insert key b m) <=> ra_valid (gmap_ra R) m ==> ra_update R a b) | existing-key update 的 iff | -| GMAP_RA_UPDATE_DELETE | |- forall R key m. ra_update (gmap_ra R) m (finmap_delete key m) | 任意 key 都可 frame-preservingly deallocate | -| GMAP_RA_UPDATE_SINGLETON_ND | |- forall R key a P. ra_update_nd R a P ==> ra_update_nd (gmap_ra R) (finmap_singleton key a) (\m. exists b. P b && m == finmap_singleton key b) | base ND update 提升到 singleton image | -| GMAP_RA_UPDATE_SINGLETON_ND_IFF | |- forall R key a P. ra_update_nd (gmap_ra R) (finmap_singleton key a) (\m. exists b. P b && m == finmap_singleton key b) <=> ra_update_nd R a P | singleton-image ND update 的 iff | -| GMAP_RA_UPDATE_INSERT_ND | |- forall R key a P m. ra_update_nd R a P ==> ra_update_nd (gmap_ra R) (finmap_insert key a m) (\result. exists b. P b && result == finmap_insert key b m) | insert payload 的 ND update | -| GMAP_RA_UPDATE_AT_ND | |- forall R key a P m. finmap_lookup m key == SOME a ==> ra_update_nd R a P ==> ra_update_nd (gmap_ra R) m (\result. exists b. P b && result == finmap_insert key b m) | existing key 的 ND update | -| GMAP_RA_UPDATE_AT_ND_IFF | |- forall R key a P m. finmap_lookup m key == SOME a ==> (ra_update_nd (gmap_ra R) m (\result. exists b. P b && result == finmap_insert key b m) <=> ra_valid (gmap_ra R) m ==> ra_update_nd R a P) | existing-key ND update 的 iff | - -#### Fresh allocation - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| GMAP_RA_ALLOC_STRONG_DEP | |- forall R candidates payload m. INFINITE candidates ==> (forall key. key IN candidates ==> finmap_lookup m key == NONE ==> ra_valid R (payload key)) ==> ra_update_nd (gmap_ra R) m (\result. exists key. key IN candidates && finmap_lookup m key == NONE && result == finmap_insert key (payload key) m) | 在无限候选集中选 fresh key；payload 可依赖所选 key | -| GMAP_RA_ALLOC_STRONG | |- forall R candidates m a. INFINITE candidates ==> ra_valid R a ==> ra_update_nd (gmap_ra R) m (\result. exists key. key IN candidates && finmap_lookup m key == NONE && result == finmap_insert key a m) | 固定 valid payload 的候选集分配 | -| GMAP_RA_ALLOC | |- forall R m a. INFINITE (:K) ==> ra_valid R a ==> ra_update_nd (gmap_ra R) m (\result. exists key. finmap_lookup m key == NONE && result == finmap_insert key a m) | 无限 key type 上分配 fresh key | -| GMAP_RA_ALLOC_COFINITE | |- forall R forbidden m a. INFINITE (:K) ==> FINITE forbidden ==> ra_valid R a ==> ra_update_nd (gmap_ra R) m (\result. exists key. ~(key IN forbidden) && finmap_lookup m key == NONE && result == finmap_insert key a m) | 分配时还能避开给定有限禁集 | -| GMAP_RA_ALLOC_EMPTY | |- forall R a. INFINITE (:K) ==> ra_valid R a ==> ra_update_nd (gmap_ra R) finmap_empty (\result. exists key. result == finmap_singleton key a) | 空 map 上分配成某个 singleton | +```text +r_entails R P Q <=> + forall resource. + ra_valid R resource ==> P resource ==> Q resource -这里的 existential key 位于 ND update 的结果谓词中，因此可随隐藏 frame -选择；不能把公开结论加强为“预先固定一个对所有 frame 都 fresh 的 key”。 +r_equiv R P Q <=> + r_entails R P Q && r_entails R Q P +``` -### 8.10 Authoritative RA +`r_equiv` 只观察有效资源；两个 assertion 可以在无效资源上不同而仍逻辑等价。 +所以 public connective laws 使用 `r_equiv`，不把 raw HOL 函数等号当作用户级 +逻辑等价。实现确实需要 rewrite 时，才包含 +`resource_prop_internal.h` 或 `product_resource_internal.h` 中的 `*_EQ` +helpers。 -源文件：[`auth_ra.h`](../theory/logic/auth_ra.h)、 -[`auth_ra.c`](../theory/logic/auth_ra.c)。记 -$\bullet a=\texttt{auth_auth R a}$、 -$\circ f=\texttt{auth_frag f}$、 -$\bullet a\,\circ f=\texttt{auth_both a f}$。carrier 是 -`(A)excl # A`；operation 是 `excl_ra × R` 的 product operation，但 authority -在场时 validity 额外要求 fragment included 于 authoritative value。 +### 4.2 核心 assertion -#### 构造、计算与区分 +```text +r_emp R resource <=> + resource == ra_unit R -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `AUTH_RA_UNIT` | `` `\|- forall R. ra_unit (auth_ra R) == auth_frag (ra_unit R)` `` | $\varepsilon_{\mathrm{Auth}(R)}=\circ\varepsilon_R$ | -| `AUTH_RA_AUTH_FRAG` | `` `\|- forall R a fragment. ra_op (auth_ra R) (auth_auth R a) (auth_frag fragment) == auth_both a fragment` `` | $\bullet a\cdot\circ f=\bullet a\,\circ f$ | -| `AUTH_RA_FRAG_FRAG` | `` `\|- forall R f g. ra_op (auth_ra R) (auth_frag f) (auth_frag g) == auth_frag (ra_op R f g)` `` | $\circ f\cdot\circ g=\circ(f\cdot_Rg)$ | -| `AUTH_RA_BOTH_FRAG` | `` `\|- forall R a f g. ra_op (auth_ra R) (auth_both a f) (auth_frag g) == auth_both a (ra_op R f g)` `` | combined resource 吸收额外 fragment | -| `AUTH_RA_BOTH_UNIT` | `` `\|- forall R a. auth_both a (ra_unit R) == auth_auth R a` `` | $\bullet a\,\circ\varepsilon=\bullet a$ | -| `AUTH_RA_FRAG_INJ` | `` `\|- forall f g. auth_frag f == auth_frag g <=> f == g` `` | fragment constructor 单射 | -| `AUTH_RA_BOTH_INJ` | `` `\|- forall a f b g. auth_both a f == auth_both b g <=> a == b && f == g` `` | combined constructor 双参数单射 | -| `AUTH_RA_BOTH_NE_FRAG` | `` `\|- forall a f g. ~(auth_both a f == auth_frag g)` `` | combined 与 fragment-only 区分 | -| `AUTH_RA_AUTH_INJ` | `` `\|- forall R a b. auth_auth R a == auth_auth R b <=> a == b` `` | authority-only 单射 | -| `AUTH_RA_AUTH_NE_FRAG` | `` `\|- forall R a f. ~(auth_auth R a == auth_frag f)` `` | authority-only 与 fragment-only 区分 | -| `AUTH_RA_AUTH_EQ_BOTH` | `` `\|- forall R a b f. auth_auth R a == auth_both b f <=> a == b && f == ra_unit R` `` | authority-only 恰为 unit fragment 的 combined resource | - -#### Validity、frame 与 authority conflict - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `AUTH_RA_VALID_FRAG` | `` `\|- forall R fragment. ra_valid (auth_ra R) (auth_frag fragment) <=> ra_valid R fragment` `` | fragment-only 有效性继承 base | -| `AUTH_RA_VALID_BOTH` | `` `\|- forall R a fragment. ra_valid (auth_ra R) (auth_both a fragment) <=> ra_valid R a && ra_included R fragment a` `` | $\checkmark(\bullet a\,\circ f)\Leftrightarrow\checkmark_R(a)\land f\preccurlyeq_Ra$ | -| `AUTH_RA_VALID_BOTH_INTRO` | `` `\|- forall R a f. ra_valid R a ==> ra_included R f a ==> ra_valid (auth_ra R) (auth_both a f)` `` | combined validity 引入 | -| `AUTH_RA_VALID_BOTH_ELIM_VALID` | `` `\|- forall R a f. ra_valid (auth_ra R) (auth_both a f) ==> ra_valid R a` `` | 提取 authority validity | -| `AUTH_RA_VALID_BOTH_ELIM_INCLUDED` | `` `\|- forall R a f. ra_valid (auth_ra R) (auth_both a f) ==> ra_included R f a` `` | 提取 fragment inclusion | -| `AUTH_RA_VALID_AUTH` | `` `\|- forall R a. ra_valid (auth_ra R) (auth_auth R a) <=> ra_valid R a` `` | authority-only validity | -| `AUTH_RA_VALID_AUTH_FRAG` | `` `\|- forall R a f. ra_valid (auth_ra R) (ra_op (auth_ra R) (auth_auth R a) (auth_frag f)) <=> ra_valid R a && ra_included R f a` `` | authority 与一个 fragment 相容的精确条件 | -| `AUTH_RA_VALID_BOTH_FRAG` | `` `\|- forall R a f g. ra_valid (auth_ra R) (ra_op (auth_ra R) (auth_both a f) (auth_frag g)) <=> ra_valid R a && ra_included R (ra_op R f g) a` `` | combined + external fragment 的条件 | -| `AUTH_RA_VALID_BOTH_FRAME` | `` `\|- forall R a f frame. ra_valid (auth_ra R) (ra_op (auth_ra R) (auth_both a f) frame) <=> (exists external. frame == auth_frag external && ra_valid R a && ra_included R (ra_op R f external) a)` `` | 任意相容 frame 必须是 fragment-only，并满足 base inclusion | -| `AUTH_RA_VALID_AUTH_FRAME` | `` `\|- forall R a frame. ra_valid (auth_ra R) (ra_op (auth_ra R) (auth_auth R a) frame) <=> (exists external. frame == auth_frag external && ra_valid R a && ra_included R external a)` `` | authority-only 的 frame characterization | -| `AUTH_RA_AUTH_CONFLICT` | `` `\|- forall R a b. ~ra_valid (auth_ra R) (ra_op (auth_ra R) (auth_auth R a) (auth_auth R b))` `` | 两个 authority-only 永远冲突 | -| `AUTH_RA_BOTH_CONFLICT` | `` `\|- forall R a f b g. ~ra_valid (auth_ra R) (ra_op (auth_ra R) (auth_both a f) (auth_both b g))` `` | 两个 combined authority 永远冲突 | -| `AUTH_RA_AUTH_BOTH_CONFLICT` | `` `\|- forall R a b g. ~ra_valid (auth_ra R) (ra_op (auth_ra R) (auth_auth R a) (auth_both b g))` `` | authority-only 与 combined authority 冲突 | -| `AUTH_RA_BOTH_EXCLUSIVE` | `` `\|- forall R a f. ra_exclusive R f ==> ra_exclusive (auth_ra R) (auth_both a f)` `` | exclusive local fragment 使 combined resource exclusive | - -#### Inclusion 与 cancellation - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `AUTH_RA_INCLUDED_FRAG_FRAG` | `` `\|- forall R f g. ra_included (auth_ra R) (auth_frag f) (auth_frag g) <=> ra_included R f g` `` | $\circ f\preccurlyeq\circ g\Leftrightarrow f\preccurlyeq_Rg$ | -| `AUTH_RA_INCLUDED_FRAG_AUTH` | `` `\|- forall R f a. ra_included (auth_ra R) (auth_frag f) (auth_auth R a) <=> ra_included R f (ra_unit R)` `` | fragment 到 authority-only 的特殊 unit 条件 | -| `AUTH_RA_INCLUDED_FRAG_BOTH` | `` `\|- forall R f a g. ra_included (auth_ra R) (auth_frag f) (auth_both a g) <=> ra_included R f g` `` | fragment 到 combined 只观察 fragment 分量 | -| `AUTH_RA_INCLUDED_AUTH_FRAG` | `` `\|- forall R a g. ~ra_included (auth_ra R) (auth_auth R a) (auth_frag g)` `` | authority 不能扩张成 fragment-only | -| `AUTH_RA_INCLUDED_AUTH_AUTH` | `` `\|- forall R a b. ra_included (auth_ra R) (auth_auth R a) (auth_auth R b) <=> a == b` `` | authority-only inclusion 保持 authority 值 | -| `AUTH_RA_INCLUDED_AUTH_BOTH` | `` `\|- forall R a b g. ra_included (auth_ra R) (auth_auth R a) (auth_both b g) <=> a == b` `` | authority-only 可扩张为同 authority 的 combined resource | -| `AUTH_RA_INCLUDED_BOTH_FRAG` | `` `\|- forall R a f g. ~ra_included (auth_ra R) (auth_both a f) (auth_frag g)` `` | combined 不能扩张成 fragment-only | -| `AUTH_RA_INCLUDED_BOTH_AUTH` | `` `\|- forall R a f b. ra_included (auth_ra R) (auth_both a f) (auth_auth R b) <=> a == b && ra_included R f (ra_unit R)` `` | combined 到 authority-only 还需 fragment included 于 unit | -| `AUTH_RA_INCLUDED_BOTH_BOTH` | `` `\|- forall R a f b g. ra_included (auth_ra R) (auth_both a f) (auth_both b g) <=> a == b && ra_included R f g` `` | authority 值相同且 fragment inclusion | -| `AUTH_RA_CANCELLATIVE` | `` `\|- forall R. ra_cancellative R ==> ra_cancellative (auth_ra R)` `` | base cancellation 提升 | -| `AUTH_RA_CANCELLATIVE_IFF` | `` `\|- forall R. ra_cancellative (auth_ra R) <=> ra_cancellative R` `` | auth construction 不增不减 cancellation | - -#### Frame-preserving update 与 local update lifting - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| `AUTH_RA_UPDATE_FRAMEWISE` | `` `\|- forall R a f b g. (forall external. ra_valid R a && ra_included R (ra_op R f external) a ==> ra_valid R b && ra_included R (ra_op R g external) b) ==> ra_update (auth_ra R) (auth_both a f) (auth_both b g)` `` | 若每个 source-compatible external fragment 在目标仍兼容，则 combined update 成立 | -| `AUTH_RA_UPDATE_FRAMEWISE_IFF` | `` `\|- forall R a f b g. ra_update (auth_ra R) (auth_both a f) (auth_both b g) <=> (forall external. ra_valid R a && ra_included R (ra_op R f external) a ==> ra_valid R b && ra_included R (ra_op R g external) b)` `` | 上述条件也是必要条件 | -| `AUTH_RA_UPDATE` | `` `\|- forall R a f b g. ra_local_update R (a,f) (b,g) ==> ra_update (auth_ra R) (auth_both a f) (auth_both b g)` `` | base local update 是 auth update 的主桥 | -| `AUTH_RA_UPDATE_ND` | `` `\|- forall R a f P. (forall external. ra_valid R a && ra_included R (ra_op R f external) a ==> (exists b g. P b g && ra_valid R b && ra_included R (ra_op R g external) b)) ==> ra_update_nd (auth_ra R) (auth_both a f) (\candidate. exists b g. P b g && candidate == auth_both b g)` `` | target pair 可随 external frame 选择的 ND criterion | -| `AUTH_RA_UPDATE_ND_FRAMEWISE_IFF` | `` `\|- forall R a f P. ra_update_nd (auth_ra R) (auth_both a f) (\candidate. exists b g. P b g && candidate == auth_both b g) <=> (forall external. ra_valid R a && ra_included R (ra_op R f external) a ==> (exists b g. P b g && ra_valid R b && ra_included R (ra_op R g external) b))` `` | combined-image ND criterion 的 iff | -| `AUTH_RA_UPDATE_AUTH_IFF` | `` `\|- forall R a b. ra_update (auth_ra R) (auth_auth R a) (auth_auth R b) <=> ra_valid R a ==> ra_valid R b && ra_included R a b` `` | authority-only 可更新 iff 有效源时目标有效且旧 authority included 于新 authority | -| `AUTH_RA_UPDATE_AUTH_INCLUDED` | `` `\|- forall R a b. ra_valid R b ==> ra_included R a b ==> ra_update (auth_ra R) (auth_auth R a) (auth_auth R b)` `` | 上条的 direct intro | -| `AUTH_RA_UPDATE_DROP_FRAG` | `` `\|- forall R a f. ra_update (auth_ra R) (auth_both a f) (auth_auth R a)` `` | 丢弃 local fragment | -| `AUTH_RA_UPDATE_DROP_AUTH` | `` `\|- forall R a f. ra_update (auth_ra R) (auth_both a f) (auth_frag f)` `` | 丢弃 authority | -| `AUTH_RA_UPDATE_WEAKEN_FRAG` | `` `\|- forall R a f g. ra_included R g f ==> ra_update (auth_ra R) (auth_both a f) (auth_both a g)` `` | authority 不变，fragment 向 included 部分弱化 | -| `AUTH_RA_FRAG_UPDATE_INCLUDED` | `` `\|- forall R f g. ra_included R g f ==> ra_update (auth_ra R) (auth_frag f) (auth_frag g)` `` | fragment-only 弱化 | -| `AUTH_RA_UPDATE_BOTH_INCLUDED` | `` `\|- forall R a b f. ra_valid R b ==> ra_included R a b ==> ra_update (auth_ra R) (auth_both a f) (auth_both b f)` `` | 扩大 authority、保持 local fragment | -| `AUTH_RA_UPDATE_ALLOC` | `` `\|- forall R a b g. ra_local_update R (a,ra_unit R) (b,g) ==> ra_update (auth_ra R) (auth_auth R a) (auth_both b g)` `` | 由无 local fragment 分配出 `g` | -| `AUTH_RA_UPDATE_DEALLOC` | `` `\|- forall R a f b. ra_local_update R (a,f) (b,ra_unit R) ==> ra_update (auth_ra R) (auth_both a f) (auth_auth R b)` `` | local update 消耗 fragment | -| `AUTH_RA_UPDATE_AUTH` | `` `\|- forall R a b g. ra_local_update R (a,ra_unit R) (b,g) ==> ra_update (auth_ra R) (auth_auth R a) (auth_auth R b)` `` | 执行 local update 后丢弃其 produced fragment | -| `AUTH_RA_LOCAL_UPDATE` | `` `\|- forall R a b0 b1 a_new b0_new b1_new. ra_local_update R (b0,b1) (b0_new,b1_new) ==> ra_included R b0_new a_new ==> ra_valid R a_new ==> ra_local_update (auth_ra R) (auth_both a b0,auth_both a b1) (auth_both a_new b0_new,auth_both a_new b1_new)` `` | base local update 提升为 auth local update，并显式验证目标 authority | -| `AUTH_RA_ALLOC_BOTH` | `` `\|- forall R a f piece. ra_valid R (ra_op R a piece) ==> ra_update (auth_ra R) (auth_both a f) (auth_both (ra_op R a piece) (ra_op R f piece))` `` | authority 与 local fragment 同步扩张 `piece` | -| `AUTH_RA_ALLOC` | `` `\|- forall R a piece. ra_valid R (ra_op R a piece) ==> ra_update (auth_ra R) (auth_auth R a) (auth_both (ra_op R a piece) piece)` `` | authority-only 分配新 fragment | -| `AUTH_RA_UPDATE_CANCELLATIVE` | `` `\|- forall R a b frame. ra_cancellative R ==> ra_valid R (ra_op R b frame) ==> ra_update (auth_ra R) (auth_both (ra_op R a frame) a) (auth_both (ra_op R b frame) b)` `` | cancellative base 上保持同一 residual `frame` 的同步替换 | - -## 9. Named ghost resource - -### 9.1 Ghost heap algebra - -$\mathcal G_R=\texttt{ghost_heap_ra R}=\mathrm{GMap}_{\mathbb N}(R)$。 -name 的 absence 是 NONE；已经分配且 payload 恰为 -$\varepsilon_R$ 的状态是 SOME (ra_unit R)，二者不可混淆。 - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| ghost_heap_ra_def | |- forall G. ghost_heap_ra G == gmap_ra G | $\mathcal G_R=\mathrm{GMap}_{\mathbb N}(R)$ | -| GHOST_HEAP_UNIT | |- forall G. ra_unit (ghost_heap_ra G) == (finmap_empty:(num,A)finmap) | ghost heap unit 是空 map | -| GHOST_HEAP_OP_LOOKUP | |- forall G h k name. finmap_lookup (ra_op (ghost_heap_ra G) h k) name == ra_op (option_ra G) (finmap_lookup h name) (finmap_lookup k name) | operation 按 name pointwise | -| GHOST_HEAP_VALID | |- forall G h. ra_valid (ghost_heap_ra G) h <=> (forall name. ra_valid (option_ra G) (finmap_lookup h name)) | validity 按 name pointwise | -| GHOST_HEAP_SINGLETON_OP | |- forall G name a b. ra_op (ghost_heap_ra G) (finmap_singleton name a) (finmap_singleton name b) == finmap_singleton name (ra_op G a b) | 同名 payload 组合 | -| GHOST_HEAP_VALID_SINGLETON | |- forall G name a. ra_valid (ghost_heap_ra G) (finmap_singleton name a) <=> ra_valid G a | singleton valid iff payload valid | -| GHOST_HEAP_SINGLETON_UNIT_NE_EMPTY | |- forall G name. ~(finmap_singleton name (ra_unit G) == (finmap_empty:(num,A)finmap)) | 已分配 unit payload 不等于未分配 | -| GHOST_HEAP_UPDATE_SINGLETON | |- forall G name a b. ra_update G a b ==> ra_update (ghost_heap_ra G) (finmap_singleton name a) (finmap_singleton name b) | payload update 提升到固定 name | -| GHOST_HEAP_UPDATE_SINGLETON_ND | |- forall G name a P. ra_update_nd G a P ==> ra_update_nd (ghost_heap_ra G) (finmap_singleton name a) (\h. exists b. P b && h == finmap_singleton name b) | payload ND update 提升到固定 name | -| GHOST_HEAP_DEALLOC | |- forall G name a. ra_update (ghost_heap_ra G) (finmap_singleton name a) (finmap_empty:(num,A)finmap) | singleton fragment 可 deallocate | -| GHOST_HEAP_FRESH | |- forall h:(num,A)finmap. exists name:num. finmap_lookup h name == NONE | 每个 heap 有 fresh name | -| GHOST_HEAP_FRESH_PAIR | |- forall h frame. exists name:num. finmap_lookup h name == NONE && finmap_lookup frame name == NONE | 两个 heap 有共同 fresh name | -| GHOST_HEAP_ALLOC | |- forall G h a. ra_valid G a ==> ra_update_nd (ghost_heap_ra G) h (\result. exists name. finmap_lookup h name == NONE && result == ra_op (ghost_heap_ra G) h (finmap_singleton name a)) | 分配 fresh name；公开 freshness 只相对 source $h$ | -| GHOST_HEAP_ALLOC_EMPTY | |- forall G a. ra_valid G a ==> ra_update_nd (ghost_heap_ra G) (finmap_empty:(num,A)finmap) (\result. exists name. result == finmap_singleton name a) | 空 heap 分配为某个 singleton | - -GHOST_HEAP_ALLOC 的 name 可依赖隐藏 frame；不要把它强化为 -对 frame 也公开 fresh 的单一 witness。 - -### 9.2 Exact named ownership 与 generic viewshift - -记 $\mathsf{own}_n(a)=\texttt{ghost_own G name a}$。这是固定 name 的 exact -singleton ownership。 - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| ghost_own_def | |- forall G name a heap. ghost_own G name a heap <=> r_own (ghost_heap_ra G) (finmap_singleton name a) heap | $\mathsf{own}_n(a)$ 精确拥有 singleton $[n\mapsto a]$ | -| GHOST_OWN_AS_R_OWN | |- forall G name a. ghost_own G name a == r_own (ghost_heap_ra G) (finmap_singleton name a) | predicate extensional equality | -| GHOST_OWN_OP | |- forall G name a b. r_sep (ghost_heap_ra G) (ghost_own G name a) (ghost_own G name b) == ghost_own G name (ra_op G a b) | $\mathsf{own}_n(a)*\mathsf{own}_n(b)=\mathsf{own}_n(a\cdot b)$ | -| GHOST_OWN_VALID | |- forall G name a. r_entails (ghost_heap_ra G) (ghost_own G name a) (r_and (ghost_heap_ra G) (r_pure (ghost_heap_ra G) (ra_valid G a)) (ghost_own G name a)) | ownership 可观察 payload validity，同时保留所有权 | -| GHOST_OWN_UPDATE | |- forall G name a b. ra_update G a b ==> r_viewshift (ghost_heap_ra G) (ghost_own G name a) (ghost_own G name b) | base update 给出 generic ghost viewshift | -| GHOST_OWN_UPDATE_ND | |- forall G name a result_pred. ra_update_nd G a result_pred ==> r_viewshift (ghost_heap_ra G) (ghost_own G name a) (r_exists (ghost_heap_ra G) (\selected. r_and (ghost_heap_ra G) (r_pure (ghost_heap_ra G) (result_pred selected)) (ghost_own G name selected))) | base ND update 给出带 witness/pure fact 的 viewshift | -| GHOST_OWN_ALLOC_EMPTY | |- forall G a. ra_valid G a ==> r_viewshift (ghost_heap_ra G) (r_emp (ghost_heap_ra G)) (r_exists (ghost_heap_ra G) (\name. ghost_own G name a)) | 从 emp 分配某个 named ghost | -| GHOST_OWN_ALLOC | |- forall G a P. ra_valid G a ==> r_viewshift (ghost_heap_ra G) P (r_exists (ghost_heap_ra G) (\name. r_sep (ghost_heap_ra G) (ghost_own G name a) P)) | 在任意 frame-preserved assertion 旁分配 | +r_sep R P Q resource <=> + exists left right. + resource == ra_op R left right && P left && Q right -本节最后四条使用 generic -$\texttt{r_viewshift (ghost_heap_ra G)}$；它们还不是 C 程序逻辑的受限 -viewshift。 +r_own R owned resource <=> + resource == owned -## 10. C resource 实例 +r_wand R P Q resource <=> + forall frame. + ra_valid R (ra_op R resource frame) ==> + P frame ==> + Q (ra_op R resource frame) +``` -### 10.1 Physical byte RA +此外提供 `r_top`、`r_bottom`、`r_and`、`r_or`、`r_impl`、`r_exists`、 +`r_forall`。这是 linear 逻辑：没有一般的资源 weakening 或 contraction。 +`R_SEP_ASSOC`、`R_SEP_COMM`、`R_SEP_EMP_L`、`R_SEP_EMP_R`、 +`R_SEP_EXISTS_L`、`R_SEP_EXISTS_R` 的结论都是 `r_equiv`。 -物理内存 RA 是地址到 exclusive byte-state 的 finite-map RA： -$$ -\mathcal M=\texttt{mem_ra} -=\mathrm{GMap}_{\mathbb Z}(\mathrm{Excl}(\texttt{pmem_byte_state})). -$$ +### 4.3 `r_pure` 与 `r_fact` 必须区分 -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| mem_ra_def | |- mem_ra == gmap_ra (excl_ra:((pmem_byte_state)excl)ra) | $\mathcal M=\mathrm{GMap}(\mathrm{Excl}(\text{byte-state}))$ | -| MEM_RA_UNIT | |- ra_unit mem_ra == (finmap_empty:(int,(pmem_byte_state)excl)finmap) | 空物理内存 ownership 是 unit | -| MEM_RA_OP_LOOKUP | |- forall left right address. finmap_lookup (ra_op mem_ra left right) address == ra_op (option_ra (excl_ra:((pmem_byte_state)excl)ra)) (finmap_lookup left address) (finmap_lookup right address) | 按地址 pointwise/exclusive 组合 | -| MEM_RA_VALID | |- forall memory. ra_valid mem_ra memory <=> (forall address:int. ra_valid (option_ra (excl_ra:((pmem_byte_state)excl)ra)) (finmap_lookup memory address)) | validity 按地址 pointwise | -| pmem_singleton_def | |- forall address state. pmem_singleton address state == finmap_singleton address (Excl state) | 单地址 exact byte ownership | -| pmem_uninit_def | |- forall address. pmem_uninit address == pmem_singleton address PMemUninit | 已分配但未初始化 byte | -| pmem_byte_def | |- forall address byte. pmem_byte address byte == pmem_singleton address (PMemByte byte) | 携带整数值的 initialized byte | -| PMEM_SINGLETON_VALID | |- forall address state. ra_valid mem_ra (pmem_singleton address state) | canonical singleton 总是 valid | -| PMEM_UNINIT_VALID | |- forall address. ra_valid mem_ra (pmem_uninit address) | uninitialized singleton valid | -| PMEM_BYTE_VALID | |- forall address byte. ra_valid mem_ra (pmem_byte address byte) | initialized singleton valid | -| PMEM_SINGLETON_OVERLAP_INVALID | |- forall address left right. ~ra_valid mem_ra (ra_op mem_ra (pmem_singleton address left) (pmem_singleton address right)) | 同地址两份 canonical ownership 冲突 | -| PMEM_UPDATE_UNINIT_BYTE | |- forall address byte. ra_update mem_ra (pmem_uninit address) (pmem_byte address byte) | 代数上 uninit-to-byte update | -| PMEM_UPDATE_BYTE_UNINIT | |- forall address byte. ra_update mem_ra (pmem_byte address byte) (pmem_uninit address) | 代数上 byte-to-uninit update | -| PMEM_UPDATE_BYTE_BYTE | |- forall address old_byte new_byte. ra_update mem_ra (pmem_byte address old_byte) (pmem_byte address new_byte) | 代数上可改写 owned byte | -| pmem_own_def | |- forall memory. pmem_own memory == r_own mem_ra memory | physical assertion 是 exact ownership | -| pmem_uninit_at_def | |- forall address. pmem_uninit_at address == pmem_own (pmem_uninit address) | 单地址 uninitialized assertion | -| pmem_byte_at_def | |- forall address byte. pmem_byte_at address byte == pmem_own (pmem_byte address byte) | 单地址 initialized assertion | - -最后三条 PMEM_UPDATE_* 只是 RA algebra lemma。改变物理内存必须由 -C command 的 symbolic semantics 支持，不能把它们直接暴露成程序级 viewshift。 - -### 10.2 Physical × ghost product - -令 -$$ -R_G=\texttt{c_resource_ra G} -=\mathcal M\times\mathcal G_G. -$$ -assertion 的 carrier 同时线性记录 physical 与 named ghost projection。 +v2 有意保留以下两个不同定义： -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| c_resource_ra_def | |- forall G. c_resource_ra G == prod_ra mem_ra (ghost_heap_ra G) | $R_G=\mathcal M\times\mathcal G_G$ | -| C_RESOURCE_RA_UNIT | |- forall G. ra_unit (c_resource_ra G) == (ra_unit mem_ra,ra_unit (ghost_heap_ra G)) | product unit 分量化 | -| C_RESOURCE_RA_OP | |- forall G left right. ra_op (c_resource_ra G) left right == (ra_op mem_ra (FST left) (FST right),ra_op (ghost_heap_ra G) (SND left) (SND right)) | product operation 分量化 | -| C_RESOURCE_RA_VALID | |- forall G resource. ra_valid (c_resource_ra G) resource <=> ra_valid mem_ra (FST resource) && ra_valid (ghost_heap_ra G) (SND resource) | product validity 分量化 | -| c_lift_phys_def | |- forall G P resource. c_lift_phys G P resource <=> P (FST resource) && SND resource == ra_unit (ghost_heap_ra G) | exact physical lift；ghost 必须为 unit | -| C_LIFT_PHYS_EMP | |- forall G. c_lift_phys G (r_emp mem_ra) == r_emp (c_resource_ra G) | physical lift 保 emp | -| C_LIFT_PHYS_SEP | |- forall G P Q. c_lift_phys G (r_sep mem_ra P Q) == r_sep (c_resource_ra G) (c_lift_phys G P) (c_lift_phys G Q) | physical lift 保 separating conjunction | -| C_LIFT_PHYS_ENTAILS | |- forall G P Q. r_entails mem_ra P Q ==> r_entails (c_resource_ra G) (c_lift_phys G P) (c_lift_phys G Q) | physical entailment 单调提升 | -| c_ghost_own_def | |- forall G name a. c_ghost_own G name a == r_own (c_resource_ra G) (ra_unit mem_ra,finmap_singleton name a) | ghost singleton 的 physical 分量精确为 unit | -| c_pmem_uninit_at_def | |- forall G address. c_pmem_uninit_at G address == c_lift_phys G (pmem_uninit_at address) | uninitialized byte 的 exact C-resource lift | -| c_pmem_byte_at_def | |- forall G address byte. c_pmem_byte_at G address byte == c_lift_phys G (pmem_byte_at address byte) | initialized byte 的 exact C-resource lift | - -c_lift_phys 和 c_ghost_own 都是 exact lift： -另一 projection 必须是 unit；它们不是可丢弃另一侧资源的 affine embedding。 - -### 10.3 Ghost-only C basic update - -与 generic $r\_\text{viewshift}$ 不同，C modality 定义性地保留物理 -projection： - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| c_bupd_def | |- forall G Q resource. c_bupd G Q resource <=> ra_update_nd (ghost_heap_ra G) (SND resource) (\ghost'. Q (FST resource,ghost')) | $\mathop{\mathsf{bupd}}\nolimits_G Q(p,g)$ 只 ND-update $g$，结果仍用原 $p$ | -| c_viewshift_def | |- forall G P Q. c_viewshift G P Q <=> r_entails (c_resource_ra G) P (c_bupd G Q) | $P\Rightarrow_G^C Q\;\Leftrightarrow\;P\vdash_{R_G}\mathsf{bupd}_GQ$ | -| C_BUPD_INTRO | |- forall G P. r_entails (c_resource_ra G) P (c_bupd G P) | $P\vdash\mathsf{bupd}\,P$ | -| C_BUPD_MONO | |- forall G P Q. r_entails (c_resource_ra G) P Q ==> r_entails (c_resource_ra G) (c_bupd G P) (c_bupd G Q) | basic update 单调 | -| C_BUPD_IDEM | |- forall G P. r_entails (c_resource_ra G) (c_bupd G (c_bupd G P)) (c_bupd G P) | basic update 可压平 | -| C_BUPD_FRAME | |- forall G P F. r_entails (c_resource_ra G) (r_sep (c_resource_ra G) (c_bupd G P) F) (c_bupd G (r_sep (c_resource_ra G) P F)) | linear frame 被精确保留 | -| C_ENTAILS_TO_VIEWSHIFT | |- forall G P Q. r_entails (c_resource_ra G) P Q ==> c_viewshift G P Q | entailment 嵌入 C viewshift | -| C_VIEWSHIFT_REFL | |- forall G P. c_viewshift G P P | reflexivity | -| C_VIEWSHIFT_TRANS | |- forall G P Q S. c_viewshift G P Q ==> c_viewshift G Q S ==> c_viewshift G P S | transitivity | -| C_VIEWSHIFT_MONO | |- forall G P2 P Q Q2. r_entails (c_resource_ra G) P2 P ==> c_viewshift G P Q ==> r_entails (c_resource_ra G) Q Q2 ==> c_viewshift G P2 Q2 | consequence on both endpoints | -| C_VIEWSHIFT_FRAME | |- forall G P Q F. c_viewshift G P Q ==> c_viewshift G (r_sep (c_resource_ra G) P F) (r_sep (c_resource_ra G) Q F) | right frame | -| C_VIEWSHIFT_SEP | |- forall G P1 Q1 P2 Q2. c_viewshift G P1 Q1 ==> c_viewshift G P2 Q2 ==> c_viewshift G (r_sep (c_resource_ra G) P1 P2) (r_sep (c_resource_ra G) Q1 Q2) | independent viewshifts 可 separating-compose | -| C_VIEWSHIFT_FACT | |- forall G guard P Q. (guard ==> c_viewshift G P Q) ==> c_viewshift G (r_sep (c_resource_ra G) (r_fact (c_resource_ra G) guard) P) (r_sep (c_resource_ra G) (r_fact (c_resource_ra G) guard) Q) | pure guard 以 exact-unit fact 线性内化 | -| C_VIEWSHIFT_EXISTS | |- forall G P Q. (forall witness:B. c_viewshift G (P witness) (Q witness)) ==> c_viewshift G (r_exists (c_resource_ra G) (\bound:B. P bound)) (r_exists (c_resource_ra G) (\bound:B. Q bound)) | pointwise viewshift 提升过同一 existential witness | - -因此程序级关系是 -$\texttt{c_viewshift G}$，不是 -$\texttt{r_viewshift (c_resource_ra G)}$：后者允许从代数上改 physical -projection，却没有执行 C 指令。 - -### 10.4 C named-ghost API - -| theorem | HOL statement | 数学陈述 | -|---|---|---| -| C_GHOST_OWN_OP | |- forall G name a b. c_ghost_own G name (ra_op G a b) == r_sep (c_resource_ra G) (c_ghost_own G name a) (c_ghost_own G name b) | 同 name 的 C ghost ownership 按 payload operation 分解 | -| C_GHOST_OWN_VALID | |- forall G name a. r_entails (c_resource_ra G) (c_ghost_own G name a) (r_sep (c_resource_ra G) (r_fact (c_resource_ra G) (ra_valid G a)) (c_ghost_own G name a)) | 提取 payload validity fact 并保留 ownership | -| C_GHOST_OWN_UPDATE | |- forall G name a b. ra_update G a b ==> c_viewshift G (c_ghost_own G name a) (c_ghost_own G name b) | 固定 name 的 deterministic payload update | -| C_GHOST_OWN_UPDATE_ND | |- forall G name a P. ra_update_nd G a P ==> c_viewshift G (c_ghost_own G name a) (r_exists (c_resource_ra G) (\b. r_and (c_resource_ra G) (r_pure (c_resource_ra G) (P b)) (c_ghost_own G name b))) | 固定 name 的 ND payload update | -| C_GHOST_OWN_DEALLOC | |- forall G name a. c_viewshift G (c_ghost_own G name a) (r_emp (c_resource_ra G)) | 释放调用者的 singleton fragment | -| C_GHOST_OWN_ALLOC_EMPTY | |- forall G a. ra_valid G a ==> c_viewshift G (r_emp (c_resource_ra G)) (r_exists (c_resource_ra G) (\name. c_ghost_own G name a)) | 从 C emp 分配 named ghost | -| C_GHOST_OWN_ALLOC | |- forall G a P. ra_valid G a ==> c_viewshift G P (r_exists (c_resource_ra G) (\name. r_sep (c_resource_ra G) (c_ghost_own G name a) P)) | 分配并线性保留任意 C assertion | - -deallocation 只释放调用者拥有的 fragment，不能推出该 name 在所有兼容隐藏 -fragment 中都不存在；allocation 的公开 postcondition 同样没有额外 pure freshness -fact。 - -## 11. Generic SL adapter 与当前 C syntax - -这一层不添加 object-logic 公理。ra_sl_build(R,out) 只接受 -closed、monomorphic、unary 的 $R:(A)\texttt{ra}$，令 -$\mathrm{Prop}=A\to\texttt{bool}$，并把 -r_emp/r_sep/r_wand/.../r_fact 以及第 5 节的 derived -定理按 $R$ specialization 后装入 generic sl_theory。 - -ra_sl_scope_prepare 以 conservative -new_const_definition 建立 closed aliases -cstar_sl__<scope>__*，再把 primitive theorem rewrite -到 alias head；ra_sl_scope_install 只安装 theorem bundle。 -直到 ra_sl_scope_activate 才改变 parser： - -| 激活后的 surface syntax | 实际 semantic head | 数学读法 | -|---|---|---| -| emp | selected r_emp R alias | $\mathsf{emp}_R$ | -| P ** Q | selected r_sep R P Q alias | $P*Q$ | -| P -* Q | selected r_wand R P Q alias | $P-\!*Q$ | -| P && Q, P || Q | selected assertion-level r_and/r_or aliases | additive $\land,\lor$ | -| exists x. P, forall x. P | selected r_exists/r_forall aliases | assertion 量词 | -| fact(p) | selected r_fact R p alias | exact-unit fact $\lfloor p\rfloor$ | -| pure(p) | selected r_pure R p alias | resource-independent pure $\lceil p\rceil$ | -| P |-- Q | selected r_entails R P Q alias | validity-aware entailment | -| P -||- Q | selected r_equiv R P Q alias | 双向 validity-aware equivalence | -| P -|- Q | assertion type 上的 raw HOL == | 所有资源点上的函数等号 | -| P ==*=> Q | selected c_viewshift G P Q | ghost-only C viewshift | - -特别地，-|- 与 -||- 不是同一个关系。 -前者强到包含 invalid resources；后者只由 $r\_\text{entails}$ 双向定义。 - -在 c_logic_install(G) 中，实际安装顺序是： - -1. 取 combined_ra = c_resource_ra G； -2. 建立并 fold scoped aliases； -3. fold C_BUPD_*、C_VIEWSHIFT_* 与 C named-ghost API； -4. 安装 base/update theory，再激活 parser； -5. 令 cprop 成为所选 assertion carrier 的 parser type - abbreviation，并令 ==*=> 指向受限 c_viewshift。 - -所以 cprop 不是新的 HOL type，更不是旧模型的 -hprop。默认逻辑只是在同一安装过程里选 -$G=\texttt{unit_ra}$。 - -proof_sl.h 是 generic proof signature； -proof_sl.c 动态构造 derived theorem/tactic，并在安装时 exact-check -每个 primitive conclusion。它不是第二套 BI semantics。 - -## 12. 当前 protocol/client theory 的位置 - -下列 theory 显式消费上述 RA-SL，但属于实例或应用协议，不是基础公理。列出其 -selected RA 与最能说明语义的实际 theorem statement： - -| client | selected RA / HOL statement | 数学陈述 | -|---|---|---| -| allocator | G = excl_ra:((((int#int)#bool)excl)ra); source goal: |- forall allocator block. emp ==*=> exists name. own name (Excl ((allocator,block),T)) | 初始化时分配一个 exclusive phase token | -| monotonic counter | G = auth_ra max_nat_ra; |- forall current known. ra_valid G (auth_both current known) <=> known <= current | fragment 保存已知下界；authority 是当前 counter | -| monotonic counter step | |- forall current known. ra_update (auth_ra max_nat_ra) (auth_both current known) (auth_both (mc_counter_step current) (mc_counter_step known)) | authority 与本地 known fragment 同步作 saturating step | -| bit pair | G = auth_ra (prod_ra excl_ra excl_ra) | 两个 exclusive bit 分量由一个 authority 协调，左右 token 是 fragments | -| two modules | T = prod_ra (auth_ra (prod_ra excl_ra excl_ra)) (auth_ra max_nat_ra); |- forall current next known. current <= next ==> ra_update (auth_ra max_nat_ra) (auth_both current known) (auth_both next known) | product 隔离两个协议；counter authority 可单调提升 | -| fractional permissions | |- forall old next. ra_update (frac_ra (agree_ra:((A)agree)ra)) (frac_full (Agree old)) (frac_full (Agree next))（另有 FSL_FRAC_SPLIT_JOIN/VALID_COMBINE/SCALE_OP） | full share 可改写 agreed payload；并支持 split/join、总权重 validity 与 scaling | -| fixed pool | G = auth_ra (gmap_ra excl_ra) | authoritative finite map 管理 pool；属于 client model | -| wand helpers | schemas such as r_entails R (r_sep R P (r_wand R P Q)) Q | 从已安装的 wand adjunction 导出的 theorem constructors | - -这些 client 的不透明 assertion definitions 与程序 triples 应继续留在各自模型 -文档；把它们混进 foundational theorem 表会掩盖通用定理和一次实例化之间的 -边界。 +```text +r_pure R phi resource <=> + phi + +r_fact R phi resource <=> + phi && resource == ra_unit R +``` + +也就是说： + +- `r_pure R phi` 是资源无关的 proposition embedding；它在任意资源点的真假 + 都只由 `phi` 决定； +- `r_fact R phi` 是 exact-unit spatial fact，等价于 pure proposition 与 + `r_emp` 的 additive conjunction；它可以安全地参与分离合取的单位元规则。 + +两者不可互换。尤其是 ownership validity 和 predicate-update witness 使用 +`r_fact`，以便结论形如： + +```text +r_fact R condition ** exact ownership +``` + +而不是用一个资源无关 proposition 偷偷消费或制造空间资源。相关公开规则是： + +```text +R_PURE_AND_INTRO R_PURE_AND_ELIM +R_FACT_AS_PURE_AND_EMP R_FACT_TRUE +R_FACT_FALSE R_FACT_SEP_L +R_FACT_SEP_R R_FACT_INTRO +R_FACT_ELIM R_FACT_DUP +R_OWN_UNIT R_OWN_OP +R_OWN_VALID +``` + +## 5. Basic update 与 view shift + +### 5.1 generic modality + +源文件：[`basic_update.h`](../theory/logic/basic_update.h)。 + +```text +r_bupd R Q owned <=> + ra_updateP R owned Q + +r_viewshift R P Q <=> + r_entails R P (r_bupd R Q) +``` + +generic modality 可以更新完整的 `R`。公开组合律包括 intro、mono、idem、frame、 +viewshift refl/trans/mono/frame/sep/exists，以及 `R_OWN_UPDATE` 和 +`R_OWN_UPDATEP`。其中 predicate-update ownership rule 的后置条件显式给出 +witness、`r_fact R (P witness)` 与 exact ownership。 + +### 5.2 产品 assertion lift 与右分量 update + +源文件：[`product_resource.h`](../theory/logic/product_resource.h)、 +[`product_resource.c`](../theory/logic/product_resource.c)。 + +产品 lift 是 exact lift： + +```text +r_lift_left R S P (left,right) <=> + P left && right == ra_unit S + +r_lift_right R S Q (left,right) <=> + left == ra_unit R && Q right +``` + +因此 lift 保持 `emp`、`sep` 与 entailment，同时明确要求另一坐标为 unit。 + +右分量 basic update 定义为： + +```text +r_bupd_right R S Q resource <=> + ra_updateP S (SND resource) + (\right'. Q (FST resource,right')) + +r_viewshift_right R S P Q <=> + r_entails (prod_ra R S) P (r_bupd_right R S Q) +``` + +结果始终复用源的 `FST resource`，只有 `SND` 可以变化。公开 API 提供 +`R_BUPD_RIGHT_*`、`R_VIEWSHIFT_RIGHT_*`、`R_RIGHT_OWN_UPDATE` 和 +`R_RIGHT_OWN_UPDATEP`，用于 C 层以及其他需要固定左投影的产品逻辑。 + +## 6. Big separation + +源文件保持为 [`big_sep.h`](../theory/logic/big_sep.h) 与 +[`big_sep.c`](../theory/logic/big_sep.c)，不拆分模块。 + +稳定 API 只公开 list right-fold： + +```text +r_big_sep_list R Phi [] = r_emp R +r_big_sep_list R Phi (x::xs) = + r_sep R (Phi x) (r_big_sep_list R Phi xs) +``` + +公开规则仍全部使用 `r_equiv`： + +```text +r_big_sep_list_def +R_BIG_SEP_LIST_NIL +R_BIG_SEP_LIST_CONS +R_BIG_SEP_LIST_SINGLETON +R_BIG_SEP_LIST_APPEND +R_BIG_SEP_LIST_MONO +R_BIG_SEP_LIST_EQUIV +R_BIG_SEP_LIST_MAP +R_BIG_SEP_LIST_SEP +``` + +set/map/indexed binder 不进入稳定核心 surface；这不意味着拆分现有 big-sep +文件，而是保持同一模块中的精简 list API。 + +## 7. Named ownership + +[`named_logic.h`](../theory/logic/named_logic.h) 在 `named_ra R` 上定义： + +```text +named_own R name a = + r_own (named_ra R) (finmap_singleton name a) +``` + +公开规则为 `NAMED_OWN_OP`、`NAMED_OWN_VALID`、`NAMED_OWN_UPDATE`、 +`NAMED_OWN_UPDATEP`、`NAMED_OWN_DROP`、`NAMED_OWN_ALLOC`。其中： + +- `NAMED_OWN_OP` 的结论是 `r_equiv`； +- `NAMED_OWN_VALID` 把 payload validity 放入 exact-unit `r_fact`； +- `NAMED_OWN_UPDATEP` 的后置条件是 witness、`r_fact` 与更新后的 exact + ownership； +- allocation 返回 fresh numeric name；drop 只丢弃当前 fragment。 + +## 8. C resource theory + +### 8.1 物理内存 RA + +[`mem_ra.h`](../theory/c_program_logic/mem_ra.h) 定义 byte state： + +```text +pmem_byte_state = PMemUninit | PMemByte int +``` + +物理内存 carrier 是： + +```text +(int,(pmem_byte_state)excl)finmap +``` + +并且： + +```text +mem_ra = gmap_ra excl_ra +``` + +缺失 key 表示不拥有该 byte；存在的 `Excl state` 表示 exact byte ownership。 +同址两个 canonical singleton 合成无效。物理 byte 状态的 RA update 是 C command +语义的实现引理，不能直接包装成程序级 ghost viewshift。 + +### 8.2 完整 global ghost RA + +[`c_resource.h`](../theory/c_program_logic/c_resource.h) 定义： + +```text +c_resource_ra G = prod_ra mem_ra G +``` + +`G` 是 complete global ghost RA，不是某个 name 下的 payload RA。若程序只需要 +一种命名协议，可显式选择 `G = named_ra R`；若需要多种协议，可令： + +```text +G = prod_ra (named_ra R1) (named_ra R2) +``` + +并用 `prod_inl` / `prod_inr` 嵌入对应分量。 + +C assertion lift 为： + +```text +c_lift_phys G = r_lift_left mem_ra G +c_lift_ghost G = r_lift_right mem_ra G +c_ghost_own G ghost = c_lift_ghost G (r_own G ghost) +``` + +因此 physical assertion 精确要求 ghost 分量为 unit，ghost assertion 精确要求 +physical 分量为 unit；分离合取负责把它们组合成完整 C resource。 + +### 8.3 C-only ghost update + +[`c_basic_update.h`](../theory/c_program_logic/c_basic_update.h) 定义： + +```text +c_bupd G = r_bupd_right mem_ra G +c_viewshift G = r_viewshift_right mem_ra G +``` + +`C_BUPD_PRESERVES_PHYS` 明确证明所有 observable result 的 physical projection +与 source 相同。这是 generic update 和 C program-level update 之间不可越过的 +安全边界。 + +[`c_ghost.h`](../theory/c_program_logic/c_ghost.h) 为任意 complete `G` 公开： + +```text +C_GHOST_OWN_OP +C_GHOST_OWN_VALID +C_GHOST_OWN_UPDATE +C_GHOST_OWN_UPDATEP +C_GHOST_OWN_DROP +``` + +当 complete global RA 恰为 `named_ra R` 时，`c_named_own` 提供 convenience +层，并公开 `C_NAMED_OWN_OP`、`C_NAMED_OWN_VALID`、`C_NAMED_OWN_UPDATE`、 +`C_NAMED_OWN_UPDATEP`、`C_NAMED_OWN_DROP`、`C_NAMED_OWN_ALLOC`。这只是显式 +specialization，不改变 `c_resource_ra` 的定义。 + +## 9. Adapter 与安装边界 + +[`adapter/ra_sl.h`](../adapter/ra_sl.h) 的 `ra_sl_build R` 接收一个闭合、 +monomorphic 的 RA term，把 generic resource-proposition 定理 specialize 成 +`sl_theory`。它不定义第二套逻辑，也不包含 C memory 或 update 语义。 + +`ra_sl_scope` 负责为被选中的 RA 建立闭合 assertion aliases，并在 commit +阶段安装到 runtime/parser。C installer 应选择一个完整 global RA；需要 numeric +naming 时，它显式选择 `named_ra R`。安装过程不依赖历史接口的兼容包装。 + +adapter 为满足 runtime theorem schema 可能使用 internal raw-equality theorem； +这不会扩大 public logical API。client-facing 推理仍通过 `r_entails`、`r_equiv` +和对应 uppercase theorem handles。 + +## 10. 稳定 API 与实现私有 API + +稳定 client surface 由 public headers 中的 `PROOF extern` 声明组成。以下内容 +刻意保持私有： + +- RA representation normalization 和 constructor discrimination； +- invalid-source 的真空 update 辅助引理； +- assertion raw equality rewrite rules； +- option/product/gmap 的单向 normalization helpers； +- finite-map representation 与 support 实现细节； +- adapter 安装事务中的中间 theorem bundles。 + +对应 internal headers 仅供实现模块使用： + +```text +ra_internal.h +resource_prop_internal.h +product_resource_internal.h +prod_ra_internal.h +option_ra_internal.h +gmap_ra_internal.h +``` + +v2 不提供兼容层。下游代码应直接迁移到 `ra_updateP`、五参数 +`ra_local_update`、显式 `named_ra`、`drop`、完整 global `G` 和 `r_equiv` +public laws。 + +## 11. 回归与可信边界 -## 13. 精确性审计、已知差异与可信边界 +每个理论模块在加载前后记录 axioms 数量，并验证公开定理： -### 13.1 本文如何核对 “实际 theorem” +- theorem handle 非空； +- theorem hypotheses 为空； +- 加载模块不增加 axioms。 -本文 HOL 栏来自当前工作区加载后的 theorem object，而不是只抄注释： +回归测试覆盖 RA 核心、构造子、gmap、auth、named RA、SL、C resource 与依赖 +边界。接口审计还应保证： -1. #require 对应 theory implementation； -2. 对每个 public handle 调用 cstr_thm(...)； -3. 由本地 cstarc verify 完整加载； -4. 对核心 aggregate dump 检查 verifier JSON 中 - verification_conditions=[]、axioms=[]； -5. 另以 proof/test/ra_core_regression.c 对根 RA theorem 做 - alpha-equivalence regression。 - -这里的 “axioms=[]” 只断言本次加载的 RA/SL theory 路径没有新增 -axiom，不应误写成“全仓库没有公理”。PROOF extern thm 只是 C -侧 theorem-handle 声明；证明来自被 require 的 implementation。 -new_fun_definition / new_const_definition 与 subtype -type-bijection theorem 是 conservative definitional extension，也不是 -new_axiom。 - -### 13.2 两处需要特别记录的接口差异 - -1. resource_prop.h 对 R_SEP_FRAME_L/R 的一行说明 - 曾把左右放置写反。当前实际 theorem object 是： - - 
-   |- r_entails R P Q ==>
-      r_entails R (r_sep R P frame) (r_sep R Q frame)   [R_SEP_FRAME_L]
-   |- r_entails R P Q ==>
-      r_entails R (r_sep R frame P) (r_sep R frame Q)   [R_SEP_FRAME_R]
-
- - 本文第 5.3 节按实际 conclusion，而不是按那两行说明命名。 - -2. proof_sl.h 的 update primitive schema 注释列表漏写了 - struct field viewshift_fact。字段实际存在，且 - proof_sl.c 会 exact-check： - - 
-   |- forall guard P Q.
-        (guard ==> viewshift P Q) ==>
-        viewshift (fact guard ** P) (fact guard ** Q)
-
- - 这与 C_VIEWSHIFT_FACT 的实际 theorem 完全一致；不能根据注释 - 漏项推断 update theory 不需要 fact law。 - -另有旧 proof/docs/SL_PROOF_SPEC.md 仍把 active assertion type -写成 hprop。当前形式化接口以 c_logic.h 和实际 -parser installation 为准：active type abbreviation 是 cprop。 - -### 13.3 直接 trust boundary - -核心 theory/logic 与本文列出的 C-resource theory 均做 -get_all_axioms() 前后审计，未见直接 new_axiom。 -但仓库整体保留显式的可信入口： - -- proof_backward.c 中 CHEAT_TAC 可由 goal 建 axiom； -- proof_symexec.c 为 symbolic-execution bridge 注册若干 - new_axiom 规则。 - -它们不能被描述成由 resource_prop 派生的基础 SL theorem，也不在 -本文 “core aggregate 无新 axiom” 的结论内。 - -## 14. 阅读与使用顺序 - -做精确检查时，建议沿以下顺序： - -1. 先用第 2 节确定 ==、-|-、 - -||-、|-- 与 - ==*=> 分别是哪一层关系； -2. 用第 3–4 节检查 algebra/update 前提，尤其 invalid-source 的 vacuity； -3. 用第 5–7 节检查 assertion connective 与 modality； -4. 用第 8–9 节把 constructor、key 与 hidden frame 条件展开； -5. 在 C proof 中只使用第 10 节的 ghost-only viewshift 改 ghost state； - physical mutation 必须回到 C command semantics； -6. 最后才把第 11 节 surface syntax 反解回对应 HOL head。 - -## 15. 按文件的重要性排序索引 - -本节把同一 theory pair（`.h` 声明、`.c` 定义或证明）中的 public theorem -按阅读和证明使用的重要性排序。这里的等级不是“定理真假强弱”，而是建议的 -阅读顺序： - -| 等级 | 判定标准 | -|---|---| -| **P0 — 语义入口** | 定义定理、完整 characterization、类型/安全边界；理解文件不可跳过 | -| **P1 — 主推理规则** | client proof 和 soundness argument 的主要 algebra、validity、update 或 adjunction 规则 | -| **P2 — 常用派生规则** | 常用 iff、lifting、frame、monotonicity、拆装与 consequence 规则 | -| **P3 — 机械/便利规则** | normalization、单侧投影、构造子区分、特殊 case 与实现支撑 | - -同一等级内部仍按“先语义依赖、后便捷推论”排序。某条定理被放入 P2/P3 -不表示它不可靠或不应使用；只表示首次理解该文件时可以稍后阅读。下列每个 -名字恰对应一个 public `PROOF extern thm` handle。 - -### 15.1 RA core 与构造边界 - -#### ra.{h,c}（58） - -八个基本定义和完整 characterization 优先；monoid/order/update 主规则随后， -最后是交换重写和单侧便利规则。 - -- **P0**： - ra_unit_def → ra_op_def → - ra_valid_def → ra_included_def → - ra_update_nd_def → ra_update_def → - ra_cancellative_def → ra_exclusive_def → - RA_LAWS → RA_EXCLUSIVE_VALID_OP_IFF → - RA_EXCLUSIVE_IFF_INCLUDED → - RA_EXCLUSIVE_UPDATE_ND_IFF → - RA_EXCLUSIVE_UPDATE_IFF -- **P1**： - RA_ASSOC → RA_COMM → - RA_UNIT_L → RA_VALID_UNIT → - RA_VALID_OP_L → RA_UPDATE_APPLY → - RA_UPDATE_ND_APPLY → RA_INCLUDED_REFL → - RA_INCLUDED_TRANS → RA_INCLUDED_UNIT → - RA_INCLUDED_OP_L → RA_INCLUDED_VALID → - RA_INCLUDED_VALID_FRAME → - RA_EXCLUSIVE_INCLUDED → - RA_UPDATE_ND_TRANS → RA_UPDATE_ND_FRAME → - RA_UPDATE_ND_OP → RA_EXCLUSIVE_UPDATE → - RA_UPDATE_INCLUDED → RA_UPDATE_TRANS → - RA_UPDATE_VALID → RA_UPDATE_FRAME → - RA_UPDATE_OP -- **P2**： - RA_CANCELLATIVE_APPLY → - RA_EXCLUSIVE_APPLY → - RA_INCLUDED_OP_MONO_L → - RA_INCLUDED_OP_MONO → - RA_INCLUDED_CANCEL_L → - RA_INVALID_EXCLUSIVE → - RA_UPDATE_ND_SINGLETON → - RA_UPDATE_ND_REFL → RA_UPDATE_ND_MONO → - RA_UPDATE_ND_OF_UPDATE → - RA_UPDATE_ND_VALID → - RA_UPDATE_ND_INVALID → RA_UPDATE_INVALID → - RA_UPDATE_TARGET_INCLUDED -- **P3**： - RA_OP_SWAP_RIGHT → RA_UNIT_R → - RA_VALID_OP_R → RA_VALID_OP → - RA_INCLUDED_OP_R → - RA_INCLUDED_OP_MONO_R → - RA_UPDATE_REFL → RA_UPDATE_UNIT - -#### ra_builder.{h,c}（8） - -这是新 RA 的 lawful-descriptor 构造边界；八条都属于 P0。 - -- **P0**： - ra_laws_def → RA_TYPE_BIJECTION → - RA_REP_LAWS → RA_ABS_REP → - RA_UNIT_ABS → RA_OP_ABS → - RA_VALID_ABS → RA_ABS_ETA -- **P1/P2/P3**：无。 - -#### local_update.{h,c}（14） - -定义与直接消去先行；保持同一 residual 的组合规则高于真空、消去和 -cancellative 特化。 - -- **P0**： - ra_local_update_def → - RA_LOCAL_UPDATE_APPLY -- **P1**： - RA_LOCAL_UPDATE_TRANS → - RA_LOCAL_UPDATE_FRAME → - RA_LOCAL_UPDATE_PRESERVES_INCLUDED → - RA_LOCAL_UPDATE_VALID_INCLUDED → - RA_LOCAL_UPDATE_OP → - RA_LOCAL_UPDATE_ALLOC → - RA_LOCAL_UPDATE_EXCLUSIVE -- **P2**： - RA_LOCAL_UPDATE_REFL → - RA_LOCAL_UPDATE_INVALID → - RA_LOCAL_UPDATE_CANCEL → - RA_LOCAL_UPDATE_CANCEL_UNIT → - RA_LOCAL_UPDATE_CANCELLATIVE -- **P3**：无。 - -### 15.2 基础 RA 构造子 - -#### unit_ra.{h,c}（9） - -唯一 carrier 的计算规则先于“所有 update 都成立”的退化性质。 - -- **P0**： - UNIT_RA_UNIT → UNIT_RA_OP → - UNIT_RA_VALID -- **P1**： - UNIT_RA_UPDATE → UNIT_RA_UPDATE_ND_IFF → - UNIT_RA_LOCAL_UPDATE -- **P2**： - UNIT_RA_INCLUDED → UNIT_RA_EXCLUSIVE → - UNIT_RA_CANCELLATIVE -- **P3**：无。 - -#### prod_ra.{h,c}（22） - -先读 componentwise 表示和完整 iff；再读双侧/单侧 update lifting，最后是 -投影消去与 local-update 便利规则。 - -- **P0**： - PROD_RA_UNIT → PROD_RA_OP → - PROD_RA_VALID → PROD_RA_INCLUDED → - PROD_RA_EXCLUSIVE_IFF → - PROD_RA_CANCELLATIVE_IFF → - PROD_RA_UPDATE_IFF -- **P1**： - PROD_RA_EXCLUSIVE → - PROD_RA_CANCELLATIVE → - PROD_RA_UPDATE_ND → PROD_RA_UPDATE → - PROD_RA_UPDATE_LEFT → - PROD_RA_UPDATE_RIGHT → - PROD_RA_LOCAL_UPDATE -- **P2**： - PROD_RA_EXCLUSIVE_ELIM_LEFT → - PROD_RA_EXCLUSIVE_ELIM_RIGHT → - PROD_RA_UPDATE_ELIM_LEFT → - PROD_RA_UPDATE_ELIM_RIGHT → - PROD_RA_UPDATE_LEFT_ND → - PROD_RA_UPDATE_RIGHT_ND → - PROD_RA_LOCAL_UPDATE_LEFT → - PROD_RA_LOCAL_UPDATE_RIGHT -- **P3**：无。 - -#### option_ra.{h,c}（20） - -NONE 作为新 unit 的语义最高；SOME lifting 随后， -datatype equality 与否定形状最后。 - -- **P0**： - OPTION_RA_UNIT → - OPTION_RA_OP_SOME_SOME → - OPTION_RA_VALID_NONE → - OPTION_RA_VALID_SOME → - OPTION_RA_INCLUDED_SOME_SOME → - OPTION_RA_EXCLUSIVE_SOME_IFF → - OPTION_RA_NOT_CANCELLATIVE → - OPTION_RA_LOCAL_UPDATE_SOME_IFF → - OPTION_RA_UPDATE_IFF → - OPTION_RA_UPDATE_ND_IFF -- **P1**： - OPTION_RA_OP_NONE_L → - OPTION_RA_OP_NONE_R → - OPTION_RA_INCLUDED_NONE → - OPTION_RA_LOCAL_UPDATE_SOME → - OPTION_RA_UPDATE → OPTION_RA_UPDATE_ND -- **P2**： - OPTION_RA_NOT_INCLUDED_SOME_NONE → - OPTION_RA_NOT_EXCLUSIVE_NONE -- **P3**： - OPTION_RA_SOME_INJ → - OPTION_RA_SOME_NE_NONE - -#### excl_ra.{h,c}（22） - -冲突、完整 validity/inclusion/update characterization 是安全边界；构造子 -不等式仅用于机械化简。 - -- **P0**： - EXCL_RA_UNIT → - EXCL_RA_OWNED_CONFLICT → - EXCL_RA_VALID_IFF → - EXCL_RA_INCLUDED_OWNED_IFF → - EXCL_RA_INCLUDED_INVALID_IFF → - EXCL_RA_UPDATE_OWNED_IFF → - EXCL_RA_LOCAL_UPDATE_IFF -- **P1**： - EXCL_RA_VALID_UNIT → - EXCL_RA_VALID_OWNED → EXCL_RA_INVALID → - EXCL_RA_INCLUDED_OWNED → - EXCL_RA_EXCLUSIVE → - EXCL_RA_CANCELLATIVE → EXCL_RA_UPDATE → - EXCL_RA_UPDATE_VALID → - EXCL_RA_LOCAL_UPDATE_VALID -- **P2**： - EXCL_RA_EXCLUSIVE_INVALID → - EXCL_RA_UPDATE_INVALID -- **P3**： - EXCL_RA_OWNED_INJ → - EXCL_RA_OWNED_NE_UNIT → - EXCL_RA_INVALID_NE_UNIT → - EXCL_RA_INVALID_NE_OWNED - -#### excl_ra_internal.{h,c}（5，内部构造接口） - -普通 client 不应依赖本文件；两个 operation 定义是内部 P0，其余仅服务构造 -与 normalization。 - -- **P0**： - excl_owned_op_def → excl_op_def -- **P1/P2**：无。 -- **P3**： - EXCL_RA_OP_FN → EXCL_OWNED_NE_UNIT → - EXCL_INVALID_NE_UNIT - -#### agree_ra.{h,c}（23） - -agreement operation、valid composition 与精确 update 是协议边界；构造子区分 -最后阅读。 - -- **P0**： - AGREE_RA_UNIT → AGREE_RA_OWNED_OP → - AGREE_RA_VALID_COMBINE_IFF → - AGREE_RA_INCLUDED_OWNED → - AGREE_RA_NOT_CANCELLATIVE → - AGREE_RA_UPDATE_IFF → - AGREE_RA_LOCAL_UPDATE_OWNED_IFF -- **P1**： - AGREE_RA_IDEMPOTENT → - AGREE_RA_VALID_UNIT → - AGREE_RA_VALID_OWNED → AGREE_RA_INVALID → - AGREE_RA_INCLUDED_UNIT → - AGREE_RA_AGREEMENT -- **P2**： - AGREE_RA_NOT_INCLUDED_OWNED_UNIT → - AGREE_RA_INCLUDED_OWNED_INVALID → - AGREE_RA_NOT_INCLUDED_INVALID_UNIT → - AGREE_RA_NOT_INCLUDED_INVALID_OWNED → - AGREE_RA_NOT_EXCLUSIVE_OWNED → - AGREE_RA_EXCLUSIVE_INVALID -- **P3**： - AGREE_RA_OWNED_INJ → - AGREE_RA_OWNED_NE_UNIT → - AGREE_RA_INVALID_NE_UNIT → - AGREE_RA_INVALID_NE_OWNED - -#### max_nat_ra.{h,c}（16） - -unit/max/validity、included = <= 与 update/local-update -characterization 定义其单调协议用途；max 化简其次。 - -- **P0**： - MAX_NAT_RA_UNIT → MAX_NAT_RA_OP → - MAX_NAT_RA_VALID → - MAX_NAT_RA_INCLUDED → - MAX_NAT_RA_NOT_EXCLUSIVE → - MAX_NAT_RA_NOT_CANCELLATIVE → - MAX_NAT_RA_LOCAL_UPDATE_UNIT_IFF → - MAX_NAT_RA_UPDATE_ND_IFF -- **P1**： - MAX_NAT_RA_INCLUDED_OP → - MAX_NAT_RA_INCLUDED_MONO_RIGHT → - MAX_NAT_RA_UPDATE → - MAX_NAT_RA_UPDATE_ND -- **P2**： - MAX_NAT_RA_INCLUDED_ZERO → - MAX_NAT_RA_IDEMPOTENT → - MAX_NAT_RA_OP_EQ_RIGHT → - MAX_NAT_RA_OP_EQ_LEFT -- **P3**：无。 - -#### frac_ra.{h,c}（22） - -正权重 operation、validity、inclusion 与 full-update iff 最优先；constructor -injection 和 empty 特例最后。 - -- **P0**： - FRAC_RA_UNIT → FRAC_RA_FULL → - FRAC_RA_OWN_OP → FRAC_RA_VALID_OWN → - FRAC_RA_VALID_FULL → - FRAC_RA_INCLUDED_OWN → - FRAC_RA_INCLUDED_FULL → - FRAC_RA_EXCLUSIVE_FULL → - FRAC_RA_UPDATE_FULL_IFF → - FRAC_RA_UPDATE_FULL_ND_IFF -- **P1**： - FRAC_RA_UPDATE_WEAKEN → - FRAC_RA_UPDATE_FULL → - FRAC_RA_UPDATE_FULL_ND -- **P2**： - FRAC_RA_CANCELLATIVE → - FRAC_RA_UPDATE_WEAKEN_ND -- **P3**： - FRAC_RA_OWN_INJ → - FRAC_RA_OWN_NE_EMPTY → - FRAC_RA_FULL_INJ → - FRAC_RA_FULL_NE_EMPTY → - FRAC_RA_VALID_EMPTY → - FRAC_RA_INCLUDED_EMPTY → - FRAC_RA_NOT_INCLUDED_OWN_EMPTY - -#### auth_ra.{h,c}（55） - -authority/fragment validity、冲突、九种 inclusion case 和完整 update -characterization 是协议安全中心；operation、allocation 和 specialization 随后。 - -- **P0**： - AUTH_RA_UNIT → AUTH_RA_AUTH_EQ_BOTH → - AUTH_RA_VALID_FRAG → - AUTH_RA_VALID_BOTH → - AUTH_RA_VALID_AUTH → - AUTH_RA_VALID_BOTH_FRAME → - AUTH_RA_VALID_AUTH_FRAME → - AUTH_RA_AUTH_CONFLICT → - AUTH_RA_BOTH_CONFLICT → - AUTH_RA_AUTH_BOTH_CONFLICT → - AUTH_RA_INCLUDED_FRAG_FRAG → - AUTH_RA_INCLUDED_FRAG_AUTH → - AUTH_RA_INCLUDED_FRAG_BOTH → - AUTH_RA_INCLUDED_AUTH_FRAG → - AUTH_RA_INCLUDED_AUTH_AUTH → - AUTH_RA_INCLUDED_AUTH_BOTH → - AUTH_RA_INCLUDED_BOTH_FRAG → - AUTH_RA_INCLUDED_BOTH_AUTH → - AUTH_RA_INCLUDED_BOTH_BOTH → - AUTH_RA_CANCELLATIVE_IFF → - AUTH_RA_UPDATE_FRAMEWISE_IFF → - AUTH_RA_UPDATE_ND_FRAMEWISE_IFF → - AUTH_RA_UPDATE_AUTH_IFF -- **P1**： - AUTH_RA_AUTH_FRAG → - AUTH_RA_FRAG_FRAG → - AUTH_RA_BOTH_FRAG → AUTH_RA_BOTH_UNIT → - AUTH_RA_VALID_BOTH_INTRO → - AUTH_RA_VALID_BOTH_ELIM_VALID → - AUTH_RA_VALID_BOTH_ELIM_INCLUDED → - AUTH_RA_VALID_AUTH_FRAG → - AUTH_RA_VALID_BOTH_FRAG → - AUTH_RA_BOTH_EXCLUSIVE → - AUTH_RA_CANCELLATIVE → - AUTH_RA_UPDATE_FRAMEWISE → - AUTH_RA_UPDATE → AUTH_RA_UPDATE_ND → - AUTH_RA_UPDATE_AUTH_INCLUDED → - AUTH_RA_UPDATE_BOTH_INCLUDED → - AUTH_RA_LOCAL_UPDATE → - AUTH_RA_ALLOC_BOTH → AUTH_RA_ALLOC -- **P2**： - AUTH_RA_UPDATE_DROP_FRAG → - AUTH_RA_UPDATE_DROP_AUTH → - AUTH_RA_UPDATE_WEAKEN_FRAG → - AUTH_RA_FRAG_UPDATE_INCLUDED → - AUTH_RA_UPDATE_ALLOC → - AUTH_RA_UPDATE_DEALLOC → - AUTH_RA_UPDATE_AUTH → - AUTH_RA_UPDATE_CANCELLATIVE -- **P3**： - AUTH_RA_FRAG_INJ → AUTH_RA_BOTH_INJ → - AUTH_RA_BOTH_NE_FRAG → - AUTH_RA_AUTH_INJ → - AUTH_RA_AUTH_NE_FRAG - -### 15.3 Resource proposition、update 与 big-sep - -#### resource_prop.{h,c}（60） - -有效性敏感 entailment 与 BI connective 定义先行；主证明规则居中，pointwise、 -equivalence 和 normalization 便利式随后。 - -- **P0**： - r_entails_def → r_equiv_def → - r_sep_def → r_emp_def → - r_wand_def → r_own_def → - r_pure_def → r_fact_def → - r_and_def → r_or_def → - r_impl_def → r_exists_def → - r_forall_def → r_top_def → - r_bottom_def -- **P1**： - R_ENTAILS_REFL → R_ENTAILS_TRANS → - R_EQUIV_INTRO → R_SEP_ASSOC → - R_SEP_COMM → R_SEP_EMP_L → - R_SEP_EMP_R → R_SEP_MONO → - R_SEP_FRAME_L → R_SEP_FRAME_R → - R_WAND_ADJUNCTION → R_IMPL_ADJUNCTION → - R_AND_INTRO → R_AND_ELIM_L → - R_AND_ELIM_R → R_OR_INTRO_L → - R_OR_INTRO_R → R_OR_ELIM → - R_EXISTS_INTRO → R_EXISTS_ELIM → - R_FORALL_INTRO → R_FORALL_ELIM → - R_PURE_AND_INTRO → R_PURE_AND_ELIM → - R_FACT_INTRO → R_FACT_ELIM → - R_FACT_DUP → R_OWN_OP → - R_OWN_VALID -- **P2**： - R_ENTAILS_POINTWISE → - R_EQUIV_POINTWISE → R_EQUIV_REFL → - R_EQUIV_SYM → R_EQUIV_TRANS → - R_SEP_EXISTS_L → R_SEP_EXISTS_R → - R_EXISTS_MONO → - R_FACT_AS_PURE_AND_EMP → - R_FACT_SEP_L → R_FACT_SEP_R → - R_OWN_UNIT → R_SEP_AND_FORWARD_R → - R_SEP_AND_FORWARD_L -- **P3**： - R_FACT_TRUE → R_FACT_FALSE - -#### basic_update.{h,c}（17） - -先界定 generic bupd/viewshift，再读模态闭包、frame 与 ownership bridge； -existential lifting 和独立组合随后。 - -- **P0**： - r_bupd_def → r_viewshift_def -- **P1**： - R_BUPD_INTRO → R_BUPD_MONO → - R_BUPD_FRAME → R_VIEWSHIFT_REFL → - R_ENTAILS_TO_VIEWSHIFT → - R_VIEWSHIFT_TRANS → - R_VIEWSHIFT_MONO → - R_VIEWSHIFT_FRAME → R_OWN_UPDATE → - R_OWN_UPDATE_ND -- **P2**： - R_BUPD_IDEM → R_VIEWSHIFT_SEP → - R_VIEWSHIFT_EXISTS_L → - R_VIEWSHIFT_EXISTS_R → - R_VIEWSHIFT_EXISTS -- **P3**：无。 - -#### big_sep.{h,c}（61） - -五类 binder 定义优先；各容器的递归、拆分、单调和 pointwise-sep 分配是 -主规则；映射/offset 变换与 normalization 特例随后。 - -- **P0**： - r_big_sep_def → r_big_sep_list_def → - r_big_sep_listi_from_def → - r_big_sep_listi_def → - r_big_sep_set_def → - r_big_sep_map_value_def → - r_big_sep_map_def -- **P1**： - R_BIG_SEP_NIL → R_BIG_SEP_CONS → - R_BIG_SEP_APPEND → - R_BIG_SEP_LIST_NIL → - R_BIG_SEP_LIST_CONS → - R_BIG_SEP_LIST_APPEND → - R_BIG_SEP_LIST_MONO → - R_BIG_SEP_LIST_SEP → - R_BIG_SEP_SET_EMPTY → - R_BIG_SEP_SET_INSERT → - R_BIG_SEP_SET_UNION → - R_BIG_SEP_SET_MONO → - R_BIG_SEP_SET_SEP → - R_BIG_SEP_MAP_EMPTY → - R_BIG_SEP_MAP_INSERT → - R_BIG_SEP_MAP_DELETE → - R_BIG_SEP_MAP_MONO → - R_BIG_SEP_MAP_SEP → - R_BIG_SEP_LISTI_NIL → - R_BIG_SEP_LISTI_CONS → - R_BIG_SEP_LISTI_FROM_APPEND → - R_BIG_SEP_LISTI_MONO → - R_BIG_SEP_LISTI_SEP -- **P2**： - R_BIG_SEP_LIST_MONO_ON → - R_BIG_SEP_LIST_EQUIV → - R_BIG_SEP_LIST_EQUIV_ON → - R_BIG_SEP_LIST_MAP → - R_BIG_SEP_SET_EQ → - R_BIG_SEP_SET_EQUIV → - R_BIG_SEP_MAP_EQ → - R_BIG_SEP_MAP_EQUIV → - R_BIG_SEP_LISTI_APPEND → - R_BIG_SEP_LISTI_FROM_MONO → - R_BIG_SEP_LISTI_FROM_EQUIV → - R_BIG_SEP_LISTI_EQUIV → - R_BIG_SEP_LISTI_FROM_SEP -- **P3**： - R_BIG_SEP_SINGLETON → - R_BIG_SEP_SNOC → R_BIG_SEP_REVERSE → - R_BIG_SEP_SWAP_HEAD → - R_BIG_SEP_LIST_SINGLETON → - R_BIG_SEP_LIST_REVERSE → - R_BIG_SEP_LIST_SWAP_HEAD → - R_BIG_SEP_LIST_EMP → - R_BIG_SEP_SET_SINGLETON → - R_BIG_SEP_SET_EMP → - R_BIG_SEP_MAP_VALUE → - R_BIG_SEP_MAP_VALUE_LOOKUP → - R_BIG_SEP_MAP_SINGLETON → - R_BIG_SEP_MAP_EMP → - R_BIG_SEP_LISTI_SINGLETON → - R_BIG_SEP_LISTI_FROM_SHIFT → - R_BIG_SEP_LISTI_CONS_SHIFT → - R_BIG_SEP_LISTI_APPEND_SHIFT - -### 15.4 Finite map 与 map RA - -#### finmap.{h,c}（52） - -有限 support subtype、absence/lookup/domain 是语义入口；外延、读写、分解、 -freshness 与归纳高于裸 representation/support 计算。 - -- **P0**： - finmap_finite_def → - FINMAP_TYPE_BIJECTION → - FINMAP_REP_FINITE → FINMAP_EQ → - finmap_empty_def → finmap_lookup_def → - finmap_singleton_def → finmap_insert_def → - finmap_delete_def → finmap_dom_def -- **P1**： - FINMAP_EQ_LOOKUP → - FINMAP_EMPTY_LOOKUP → - FINMAP_SINGLETON_LOOKUP → - FINMAP_INSERT_LOOKUP → - FINMAP_INSERT_LOOKUP_EQ → - FINMAP_INSERT_LOOKUP_NE → - FINMAP_DELETE_LOOKUP → - FINMAP_DELETE_LOOKUP_EQ → - FINMAP_DELETE_LOOKUP_NE → - FINMAP_INSERT_OVERWRITE → - FINMAP_INSERT_COMM → - FINMAP_DELETE_INSERT → - FINMAP_DELETE_INSERT_NE → - FINMAP_INSERT_DELETE → - FINMAP_DECOMPOSE → - FINMAP_DOM_FINITE → FINMAP_IN_DOM → - FINMAP_IN_DOM_SOME → FINMAP_NOT_IN_DOM → - FINMAP_DOM_INSERT → FINMAP_DOM_DELETE → - FINMAP_FRESH_IN → FINMAP_FRESH_IN_PAIR → - FINMAP_INDUCT -- **P2**： - FINMAP_INSERT_EMPTY → - FINMAP_DELETE_EMPTY → - FINMAP_DELETE_IDEMPOTENT → - FINMAP_DELETE_COMM → FINMAP_INSERT_ID → - FINMAP_DELETE_ID → FINMAP_DOM_EMPTY → - FINMAP_DOM_SINGLETON → - FINMAP_DOM_EQ_EMPTY → FINMAP_FRESH → - FINMAP_FRESH_PAIR -- **P3**： - FINMAP_EMPTY_REP → - FINMAP_SINGLETON_SUPPORT → - FINMAP_SINGLETON_REP → - FINMAP_INSERT_SUPPORT → - FINMAP_INSERT_REP → - FINMAP_DELETE_SUPPORT → - FINMAP_DELETE_REP - -#### gmap_ra.{h,c}（46） - -unit、pointwise operation 与 pointwise validity 是入口；拆分、inclusion、 -at-key update 和最一般 fresh allocation 是主规则；singleton/iff 桥接和 -具体计算随后。 - -- **P0**： - GMAP_RA_UNIT → GMAP_RA_OP_LOOKUP → - GMAP_RA_VALID -- **P1**： - GMAP_RA_DECOMPOSE → - GMAP_RA_OP_SINGLETON_AT → - GMAP_RA_SINGLETON_OP_FRESH → - GMAP_RA_VALID_LOOKUP_DELETE → - GMAP_RA_VALID_INSERT → - GMAP_RA_VALID_LOOKUP → - GMAP_RA_INCLUDED_LOOKUP_IFF → - GMAP_RA_INCLUDED_LOOKUP → - GMAP_RA_INCLUDED_OF_LOOKUP → - GMAP_RA_INCLUDED_LOOKUP_SOME → - GMAP_RA_INCLUDED_DELETE → - GMAP_RA_INCLUDED_DOM → - GMAP_RA_INCLUDED_SINGLETON → - GMAP_RA_LOCAL_UPDATE_AT → - GMAP_RA_UPDATE_INSERT → - GMAP_RA_UPDATE_AT → - GMAP_RA_UPDATE_DELETE → - GMAP_RA_UPDATE_INSERT_ND → - GMAP_RA_UPDATE_AT_ND → - GMAP_RA_ALLOC_STRONG_DEP -- **P2**： - GMAP_RA_SINGLETON_OP_DELETE → - GMAP_RA_VALID_DELETE_SOME → - GMAP_RA_VALID_DELETE → - GMAP_RA_VALID_INSERT_OF_VALID → - GMAP_RA_VALID_INSERT_FRESH → - GMAP_RA_LOCAL_UPDATE_SINGLETON → - GMAP_RA_LOCAL_UPDATE_SINGLETON_IFF → - GMAP_RA_LOCAL_UPDATE_AT_IFF → - GMAP_RA_UPDATE_SINGLETON → - GMAP_RA_UPDATE_SINGLETON_IFF → - GMAP_RA_UPDATE_AT_IFF → - GMAP_RA_UPDATE_SINGLETON_ND → - GMAP_RA_UPDATE_SINGLETON_ND_IFF → - GMAP_RA_UPDATE_AT_ND_IFF → - GMAP_RA_ALLOC_STRONG → GMAP_RA_ALLOC → - GMAP_RA_ALLOC_COFINITE -- **P3**： - GMAP_RA_SINGLETON_OP → - GMAP_RA_OP_INSERT_INSERT → - GMAP_RA_OP_DELETE → GMAP_RA_DOM_OP → - GMAP_RA_VALID_SINGLETON → - GMAP_RA_ALLOC_EMPTY - -### 15.5 Named ghost 与物理内存 - -#### ghost_heap.{h,c}（14） - -finite-map RA 别名、pointwise semantics 和 NONE 与 -SOME unit 的区别先行；update/allocation 随后。 - -- **P0**： - ghost_heap_ra_def → GHOST_HEAP_UNIT → - GHOST_HEAP_OP_LOOKUP → - GHOST_HEAP_VALID → - GHOST_HEAP_SINGLETON_UNIT_NE_EMPTY -- **P1**： - GHOST_HEAP_SINGLETON_OP → - GHOST_HEAP_VALID_SINGLETON → - GHOST_HEAP_UPDATE_SINGLETON → - GHOST_HEAP_UPDATE_SINGLETON_ND → - GHOST_HEAP_DEALLOC → GHOST_HEAP_ALLOC → - GHOST_HEAP_ALLOC_EMPTY -- **P2**： - GHOST_HEAP_FRESH_PAIR → - GHOST_HEAP_FRESH -- **P3**：无。 - -#### ghost_own.{h,c}（4） - -exact singleton ownership 的定义最优先；predicate equality、组合和 validity -observation 随后。 - -- **P0**：ghost_own_def -- **P1**： - GHOST_OWN_AS_R_OWN → GHOST_OWN_OP → - GHOST_OWN_VALID -- **P2/P3**：无。 - -#### ghost_update.{h,c}（4） - -本文件全部是 generic ghost-heap viewshift 的 client-facing 主规则；不承担 C -物理 projection 不变性的安全边界。 - -- **P0**：无。 -- **P1**： - GHOST_OWN_UPDATE → - GHOST_OWN_UPDATE_ND → - GHOST_OWN_ALLOC → - GHOST_OWN_ALLOC_EMPTY -- **P2/P3**：无。 - -#### mem_ra.{h,c}（14） - -physical RA、canonical byte fragments 与 overlap-invalid 是语义/安全入口； -三个 PMEM_UPDATE_* 虽是重要实现引理，却绝不是程序级 viewshift。 - -- **P0**： - mem_ra_def → MEM_RA_UNIT → - MEM_RA_OP_LOOKUP → MEM_RA_VALID → - pmem_singleton_def → pmem_uninit_def → - pmem_byte_def → - PMEM_SINGLETON_OVERLAP_INVALID -- **P1**： - PMEM_UPDATE_UNINIT_BYTE → - PMEM_UPDATE_BYTE_UNINIT → - PMEM_UPDATE_BYTE_BYTE -- **P2**： - PMEM_SINGLETON_VALID → - PMEM_UNINIT_VALID → PMEM_BYTE_VALID -- **P3**：无。 - -pmem_byte_state_type 是 public indtype handle，不是 -thm，所以不计入这 14 条。 - -#### mem_own.{h,c}（3） - -exact physical ownership 是入口，两个 byte-state assertion 是专门化。 - -- **P0**：pmem_own_def -- **P1**： - pmem_byte_at_def → pmem_uninit_at_def -- **P2/P3**：无。 - -### 15.6 C resource 与受限 update - -这一组的最高优先级安全边界是： -c_bupd_def 只更新 SND resource，并始终以原 -FST resource 评价结果；所以 generic -r_viewshift (c_resource_ra G) 不能替代 C viewshift。 - -#### c_resource.{h,c}（11） - -product carrier、componentwise semantics 与两个 exact lift 是 P0；lift 的 -BI-preservation 和 byte specialization 随后。 - -- **P0**： - c_resource_ra_def → - C_RESOURCE_RA_UNIT → - C_RESOURCE_RA_OP → - C_RESOURCE_RA_VALID → c_lift_phys_def → - c_ghost_own_def -- **P1**： - C_LIFT_PHYS_SEP → - C_LIFT_PHYS_ENTAILS → - C_LIFT_PHYS_EMP -- **P2**： - c_pmem_byte_at_def → - c_pmem_uninit_at_def -- **P3**：无。 - -#### c_basic_update.{h,c}（14） - -ghost-only modality/viewshift 的定义绝对优先；linear frame、composition 与 -consequence 是主规则；pure/existential lifting 属于二级结构规则。 - -- **P0**： - c_bupd_def → c_viewshift_def -- **P1**： - C_BUPD_FRAME → C_VIEWSHIFT_FRAME → - C_VIEWSHIFT_TRANS → C_VIEWSHIFT_SEP → - C_BUPD_INTRO -- **P2**： - C_BUPD_MONO → C_BUPD_IDEM → - C_VIEWSHIFT_MONO → - C_ENTAILS_TO_VIEWSHIFT → - C_VIEWSHIFT_REFL → - C_VIEWSHIFT_FACT → - C_VIEWSHIFT_EXISTS -- **P3**：无。 - -#### c_ghost_update.{h,c}（7） - -固定 name update、deallocation 与 allocation 是 C proof 的主 API；ownership -algebra 与 validity observation 是支持规则。 - -- **P0**：无；安全性继承自上一文件的 ghost-only viewshift 定义。 -- **P1**： - C_GHOST_OWN_UPDATE → - C_GHOST_OWN_UPDATE_ND → - C_GHOST_OWN_DEALLOC → - C_GHOST_OWN_ALLOC → - C_GHOST_OWN_ALLOC_EMPTY -- **P2**： - C_GHOST_OWN_OP → - C_GHOST_OWN_VALID -- **P3**：无。 - -### 15.7 Adapter 与 generic proof layer - -#### proof_sl.{h,c}（17 个 runtime-installed theorem globals） - -这些 handle 只有在 sl_install_theory 成功后才发布；它们是当前 -active SL signature 的派生 proof schemas，不是 RA/C 语义定义。 - -- **P0**：无。 -- **P1**： - sl_ent_sym_left → sl_ent_restate → - sl_ent_frame_left → - sl_ent_frame_right → - sl_sep_combine → sl_ac_rule → - sl_undisch -- **P2**： - sl_frame_restate → - sl_ent_subst_frame → - sl_or_elim_frame → sl_disj_mono → - sl_conj1 → sl_conj2 → - sl_exists_elim_frame → sl_exists_wit -- **P3**： - sl_disj1_mono → sl_disj2_mono - -#### 没有 public theorem globals 的相关文件 - -- adapter/ra_sl.{h,c}：0 个 PROOF extern thm； - ra_sl_build 构造按 closed monomorphic RA 专化的 - sl_theory bundle。 -- adapter/ra_sl_scope.{h,c}：0 个；theorem 存在于运行时 - scope struct fields 中，随后被安装，不是独立 extern globals。 -- proof_backward_sl.{h,c}：0 个；提供 generic backward tactics。 - -### 15.8 完整性核对 - -本索引覆盖： - -- 24 个 foundational theory headers 的 576 个 public theorem handles； -- excl_ra_internal.h 的 5 个内部 theorem handles； -- proof_sl.h 的 17 个 runtime-installed theorem globals。 - -合计 **598 条**。每条在本节 P0–P3 列表中恰好出现一次；无 theorem-global -的 adapter/backward 文件也已显式列出，避免把运行时 struct field 误当成 -静态 theorem。 +- public headers 不重新导出 implementation-only raw equality； +- update API 只有 `ra_updateP` primitive 与 singleton `ra_update`； +- exclusive 始终包含 source validity； +- ownership validity/updateP 使用 `r_fact`，不混同 `r_pure`； +- C update 不能改变 physical projection； +- C resource 不隐式增加 naming layer； +- big-sep 仍是单一 `big_sep.{h,c}` 模块； +- theorem handle 的既有大小写风格保持不变。 diff --git a/test/auth_ra_regression.c b/test/auth_ra_regression.c index 78a0cfc..8846144 100644 --- a/test/auth_ra_regression.c +++ b/test/auth_ra_regression.c @@ -4,6 +4,7 @@ #require "proof/proof_backward.c" #require "proof/theory/logic/auth_ra.c" +/* Exact public-v2 update signatures for auth_ra. */ PROOF static void check_auth_theorem( const thm theorem, const term expected, @@ -18,490 +19,63 @@ err: ERR_FUN_PUTS("check_auth_theorem", label); } -PROOF static int audit_auth_ra_regressions(void) { +PROOF static thm ra_at_num_excl(thm theorem) { + type_list variables = term_tyvars(concl(theorem)); + ENSURE_COND(vector_size(variables) == 1, + "expected exactly one carrier type variable"); + type_pair_list types = (type_pair_list)vector_create(); + vector_add(&types, ((type_pair){`:(num)excl`, variables[0]})); + return inst_type_rule(types, theorem); +err: + ERR_FUN_PUTS("ra_at_num_excl"); + return empty_theorem; +} + +PROOF static int audit_auth_ra_v2_regressions(void) { term R = `excl_ra:((num)excl)ra`; term a = `a:(num)excl`; term f = `f:(num)excl`; term b = `b:(num)excl`; term g = `g:(num)excl`; - term c = `c:(num)excl`; - term h = `h:(num)excl`; - term extra = `extra:(num)excl`; - term external = `external:(num)excl`; + term residual = `residual:(num)excl`; term piece = `piece:(num)excl`; - term common = `common:(num)excl`; - term P = `P:(num)excl->(num)excl->bool`; - term source = `((a:(num)excl),(f:(num)excl))`; - term middle = `((b:(num)excl),(g:(num)excl))`; - term target = `((c:(num)excl),(h:(num)excl))`; + /* Local updates are a five-argument relation; the residual is quantified + * by the definition rather than bundled into source/target pairs. */ check_auth_theorem( - ra_local_update_def, + ra_at_num_excl(ra_local_update_def), `ra_local_update - (R:(A)ra) - (source:A#A) - (target:A#A) <=> - forall frame:A. - ra_valid R (FST source) ==> - FST source == ra_op R (SND source) frame ==> - ra_valid R (FST target) && - FST target == ra_op R (SND target) frame`, + (R:((num)excl)ra) + (a:(num)excl) + (f:(num)excl) + (b:(num)excl) + (g:(num)excl) <=> + forall hidden:(num)excl. + ra_valid R a ==> + a == ra_op R f hidden ==> + ra_valid R b && + b == ra_op R g hidden`, "ra_local_update_def"); check_auth_theorem( ispecl_rule( - TERM_LIST(R, source, middle, external), + TERM_LIST(R, a, f, b, g, residual), RA_LOCAL_UPDATE_APPLY), `ra_local_update (excl_ra:((num)excl)ra) - ((a:(num)excl),(f:(num)excl)) - ((b:(num)excl),(g:(num)excl)) ==> - ra_valid - (excl_ra:((num)excl)ra) - (FST (((a:(num)excl),(f:(num)excl)))) ==> - FST (((a:(num)excl),(f:(num)excl))) == - ra_op - (excl_ra:((num)excl)ra) - (SND (((a:(num)excl),(f:(num)excl)))) - (external:(num)excl) ==> - ra_valid - (excl_ra:((num)excl)ra) - (FST (((b:(num)excl),(g:(num)excl)))) && - FST (((b:(num)excl),(g:(num)excl))) == - ra_op - (excl_ra:((num)excl)ra) - (SND (((b:(num)excl),(g:(num)excl)))) - external`, - "RA_LOCAL_UPDATE_APPLY"); - - check_auth_theorem( - ispecl_rule(TERM_LIST(R, source), RA_LOCAL_UPDATE_REFL), - `ra_local_update - (excl_ra:((num)excl)ra) - ((a:(num)excl),(f:(num)excl)) - ((a:(num)excl),(f:(num)excl))`, - "RA_LOCAL_UPDATE_REFL"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f, b, g), - RA_LOCAL_UPDATE_INVALID), - `~(ra_valid - (excl_ra:((num)excl)ra) - (a:(num)excl)) ==> - ra_local_update - (excl_ra:((num)excl)ra) - ((a:(num)excl),(f:(num)excl)) - ((b:(num)excl),(g:(num)excl))`, - "RA_LOCAL_UPDATE_INVALID"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, source, middle, target), - RA_LOCAL_UPDATE_TRANS), - `ra_local_update - (excl_ra:((num)excl)ra) - ((a:(num)excl),(f:(num)excl)) - ((b:(num)excl),(g:(num)excl)) ==> - ra_local_update - (excl_ra:((num)excl)ra) - ((b:(num)excl),(g:(num)excl)) - ((c:(num)excl),(h:(num)excl)) ==> - ra_local_update - (excl_ra:((num)excl)ra) - ((a:(num)excl),(f:(num)excl)) - ((c:(num)excl),(h:(num)excl))`, - "RA_LOCAL_UPDATE_TRANS"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f, b, g, extra), - RA_LOCAL_UPDATE_FRAME), - `ra_local_update - (excl_ra:((num)excl)ra) - ((a:(num)excl),(f:(num)excl)) - ((b:(num)excl),(g:(num)excl)) ==> - ra_local_update - (excl_ra:((num)excl)ra) - (a,ra_op (excl_ra:((num)excl)ra) f (extra:(num)excl)) - (b,ra_op (excl_ra:((num)excl)ra) g extra)`, - "RA_LOCAL_UPDATE_FRAME"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f, b, g, external), - RA_LOCAL_UPDATE_PRESERVES_INCLUDED), - `ra_local_update - (excl_ra:((num)excl)ra) - ((a:(num)excl),(f:(num)excl)) - ((b:(num)excl),(g:(num)excl)) ==> + (a:(num)excl) + (f:(num)excl) + (b:(num)excl) + (g:(num)excl) ==> ra_valid (excl_ra:((num)excl)ra) a ==> - ra_included - (excl_ra:((num)excl)ra) - (ra_op + a == + ra_op (excl_ra:((num)excl)ra) f - (external:(num)excl)) - a ==> + (residual:(num)excl) ==> ra_valid (excl_ra:((num)excl)ra) b && - ra_included - (excl_ra:((num)excl)ra) - (ra_op (excl_ra:((num)excl)ra) g external) - b`, - "RA_LOCAL_UPDATE_PRESERVES_INCLUDED"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f, b, g), - RA_LOCAL_UPDATE_VALID_INCLUDED), - `ra_local_update - (excl_ra:((num)excl)ra) - ((a:(num)excl),(f:(num)excl)) - ((b:(num)excl),(g:(num)excl)) ==> - ra_valid - (excl_ra:((num)excl)ra) - (a:(num)excl) ==> - ra_included - (excl_ra:((num)excl)ra) - (f:(num)excl) - a ==> - ra_valid - (excl_ra:((num)excl)ra) - (b:(num)excl) && - ra_included - (excl_ra:((num)excl)ra) - (g:(num)excl) - b`, - "RA_LOCAL_UPDATE_VALID_INCLUDED"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f, piece), - RA_LOCAL_UPDATE_OP), - `(ra_valid - (excl_ra:((num)excl)ra) - (a:(num)excl) ==> - ra_valid - (excl_ra:((num)excl)ra) - (ra_op - (excl_ra:((num)excl)ra) - a - (piece:(num)excl))) ==> - ra_local_update - (excl_ra:((num)excl)ra) - (a,(f:(num)excl)) - (ra_op (excl_ra:((num)excl)ra) a piece, - ra_op (excl_ra:((num)excl)ra) f piece)`, - "RA_LOCAL_UPDATE_OP"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f, piece), - RA_LOCAL_UPDATE_ALLOC), - `ra_valid - (excl_ra:((num)excl)ra) - (ra_op - (excl_ra:((num)excl)ra) - (a:(num)excl) - (piece:(num)excl)) ==> - ra_local_update - (excl_ra:((num)excl)ra) - (a,(f:(num)excl)) - (ra_op (excl_ra:((num)excl)ra) a piece, - ra_op (excl_ra:((num)excl)ra) f piece)`, - "RA_LOCAL_UPDATE_ALLOC"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f, b), - RA_LOCAL_UPDATE_EXCLUSIVE), - `ra_exclusive - (excl_ra:((num)excl)ra) - (f:(num)excl) ==> - ra_valid - (excl_ra:((num)excl)ra) - (b:(num)excl) ==> - ra_local_update - (excl_ra:((num)excl)ra) - ((a:(num)excl),f) - (b,b)`, - "RA_LOCAL_UPDATE_EXCLUSIVE"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, common, a, f), - RA_LOCAL_UPDATE_CANCEL), - `ra_cancellative (excl_ra:((num)excl)ra) ==> - ra_local_update - (excl_ra:((num)excl)ra) - (ra_op - (excl_ra:((num)excl)ra) - (common:(num)excl) - (a:(num)excl), - ra_op (excl_ra:((num)excl)ra) common (f:(num)excl)) - (a,f)`, - "RA_LOCAL_UPDATE_CANCEL"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, common, a), - RA_LOCAL_UPDATE_CANCEL_UNIT), - `ra_cancellative (excl_ra:((num)excl)ra) ==> - ra_local_update - (excl_ra:((num)excl)ra) - (ra_op - (excl_ra:((num)excl)ra) - (common:(num)excl) - (a:(num)excl), - common) - (a,ra_unit (excl_ra:((num)excl)ra))`, - "RA_LOCAL_UPDATE_CANCEL_UNIT"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, b, common), - RA_LOCAL_UPDATE_CANCELLATIVE), - `ra_cancellative (excl_ra:((num)excl)ra) ==> - ra_valid - (excl_ra:((num)excl)ra) - (ra_op - (excl_ra:((num)excl)ra) - (b:(num)excl) - (common:(num)excl)) ==> - ra_local_update - (excl_ra:((num)excl)ra) - (ra_op (excl_ra:((num)excl)ra) (a:(num)excl) common,a) - (ra_op (excl_ra:((num)excl)ra) b common,b)`, - "RA_LOCAL_UPDATE_CANCELLATIVE"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f, b, g), - AUTH_RA_UPDATE_FRAMEWISE), - `(forall external:(num)excl. - ra_valid (excl_ra:((num)excl)ra) (a:(num)excl) && - ra_included - (excl_ra:((num)excl)ra) - (ra_op - (excl_ra:((num)excl)ra) - (f:(num)excl) - external) - a ==> - ra_valid (excl_ra:((num)excl)ra) (b:(num)excl) && - ra_included - (excl_ra:((num)excl)ra) - (ra_op (excl_ra:((num)excl)ra) (g:(num)excl) external) - b) ==> - ra_update - (auth_ra (excl_ra:((num)excl)ra)) - (auth_both (a:(num)excl) (f:(num)excl)) - (auth_both (b:(num)excl) (g:(num)excl))`, - "AUTH_RA_UPDATE_FRAMEWISE"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f, b, g), - AUTH_RA_UPDATE), - `ra_local_update - (excl_ra:((num)excl)ra) - ((a:(num)excl),(f:(num)excl)) - ((b:(num)excl),(g:(num)excl)) ==> - ra_update - (auth_ra (excl_ra:((num)excl)ra)) - (auth_both (a:(num)excl) (f:(num)excl)) - (auth_both (b:(num)excl) (g:(num)excl))`, - "AUTH_RA_UPDATE"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, b, g), - AUTH_RA_UPDATE_ALLOC), - `ra_local_update - (excl_ra:((num)excl)ra) - ((a:(num)excl),ra_unit (excl_ra:((num)excl)ra)) - ((b:(num)excl),(g:(num)excl)) ==> - ra_update - (auth_ra (excl_ra:((num)excl)ra)) - (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) - (auth_both (b:(num)excl) (g:(num)excl))`, - "AUTH_RA_UPDATE_ALLOC"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f, b), - AUTH_RA_UPDATE_DEALLOC), - `ra_local_update - (excl_ra:((num)excl)ra) - ((a:(num)excl),(f:(num)excl)) - ((b:(num)excl),ra_unit (excl_ra:((num)excl)ra)) ==> - ra_update - (auth_ra (excl_ra:((num)excl)ra)) - (auth_both (a:(num)excl) (f:(num)excl)) - (auth_auth (excl_ra:((num)excl)ra) (b:(num)excl))`, - "AUTH_RA_UPDATE_DEALLOC"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, b, g), - AUTH_RA_UPDATE_AUTH), - `ra_local_update - (excl_ra:((num)excl)ra) - ((a:(num)excl),ra_unit (excl_ra:((num)excl)ra)) - ((b:(num)excl),(g:(num)excl)) ==> - ra_update - (auth_ra (excl_ra:((num)excl)ra)) - (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) - (auth_auth (excl_ra:((num)excl)ra) (b:(num)excl))`, - "AUTH_RA_UPDATE_AUTH"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f, piece), - AUTH_RA_ALLOC_BOTH), - `ra_valid - (excl_ra:((num)excl)ra) - (ra_op - (excl_ra:((num)excl)ra) - (a:(num)excl) - (piece:(num)excl)) ==> - ra_update - (auth_ra (excl_ra:((num)excl)ra)) - (auth_both (a:(num)excl) (f:(num)excl)) - (auth_both - (ra_op (excl_ra:((num)excl)ra) a piece) - (ra_op (excl_ra:((num)excl)ra) f piece))`, - "AUTH_RA_ALLOC_BOTH"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, b, common), - AUTH_RA_UPDATE_CANCELLATIVE), - `ra_cancellative (excl_ra:((num)excl)ra) ==> - ra_valid - (excl_ra:((num)excl)ra) - (ra_op - (excl_ra:((num)excl)ra) - (b:(num)excl) - (common:(num)excl)) ==> - ra_update - (auth_ra (excl_ra:((num)excl)ra)) - (auth_both - (ra_op (excl_ra:((num)excl)ra) (a:(num)excl) common) - a) - (auth_both - (ra_op (excl_ra:((num)excl)ra) b common) - b)`, - "AUTH_RA_UPDATE_CANCELLATIVE"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f), - AUTH_RA_VALID_BOTH_INTRO), - `ra_valid - (excl_ra:((num)excl)ra) - (a:(num)excl) ==> - ra_included - (excl_ra:((num)excl)ra) - (f:(num)excl) - a ==> - ra_valid - (auth_ra (excl_ra:((num)excl)ra)) - (auth_both (a:(num)excl) (f:(num)excl))`, - "AUTH_RA_VALID_BOTH_INTRO"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f), - AUTH_RA_VALID_BOTH_ELIM_VALID), - `ra_valid - (auth_ra (excl_ra:((num)excl)ra)) - (auth_both (a:(num)excl) (f:(num)excl)) ==> - ra_valid - (excl_ra:((num)excl)ra) - (a:(num)excl)`, - "AUTH_RA_VALID_BOTH_ELIM_VALID"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f), - AUTH_RA_VALID_BOTH_ELIM_INCLUDED), - `ra_valid - (auth_ra (excl_ra:((num)excl)ra)) - (auth_both (a:(num)excl) (f:(num)excl)) ==> - ra_included - (excl_ra:((num)excl)ra) - (f:(num)excl) - (a:(num)excl)`, - "AUTH_RA_VALID_BOTH_ELIM_INCLUDED"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f), - AUTH_RA_VALID_AUTH_FRAG), - `ra_valid - (auth_ra (excl_ra:((num)excl)ra)) - (ra_op - (auth_ra (excl_ra:((num)excl)ra)) - (auth_auth - (excl_ra:((num)excl)ra) - (a:(num)excl)) - (auth_frag (f:(num)excl))) <=> - ra_valid - (excl_ra:((num)excl)ra) - (a:(num)excl) && - ra_included - (excl_ra:((num)excl)ra) - (f:(num)excl) - a`, - "AUTH_RA_VALID_AUTH_FRAG"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f, g), - AUTH_RA_VALID_BOTH_FRAG), - `ra_valid - (auth_ra (excl_ra:((num)excl)ra)) - (ra_op - (auth_ra (excl_ra:((num)excl)ra)) - (auth_both (a:(num)excl) (f:(num)excl)) - (auth_frag (g:(num)excl))) <=> - ra_valid - (excl_ra:((num)excl)ra) - (a:(num)excl) && - ra_included - (excl_ra:((num)excl)ra) - (ra_op - (excl_ra:((num)excl)ra) - (f:(num)excl) - (g:(num)excl)) - a`, - "AUTH_RA_VALID_BOTH_FRAG"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, b, g), - AUTH_RA_AUTH_BOTH_CONFLICT), - `~(ra_valid - (auth_ra (excl_ra:((num)excl)ra)) - (ra_op - (auth_ra (excl_ra:((num)excl)ra)) - (auth_auth - (excl_ra:((num)excl)ra) - (a:(num)excl)) - (auth_both (b:(num)excl) (g:(num)excl))))`, - "AUTH_RA_AUTH_BOTH_CONFLICT"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f), - AUTH_RA_BOTH_EXCLUSIVE), - `ra_exclusive - (excl_ra:((num)excl)ra) - (f:(num)excl) ==> - ra_exclusive - (auth_ra (excl_ra:((num)excl)ra)) - (auth_both (a:(num)excl) (f:(num)excl))`, - "AUTH_RA_BOTH_EXCLUSIVE"); + b == ra_op (excl_ra:((num)excl)ra) g residual`, + "RA_LOCAL_UPDATE_APPLY"); check_auth_theorem( ispec_rule(R, AUTH_RA_CANCELLATIVE_IFF), @@ -519,129 +93,71 @@ PROOF static int audit_auth_ra_regressions(void) { (auth_both (a:(num)excl) (f:(num)excl)) (auth_both (b:(num)excl) (g:(num)excl)) <=> forall external:(num)excl. - ra_valid - (excl_ra:((num)excl)ra) - (a:(num)excl) && + ra_valid (excl_ra:((num)excl)ra) a && ra_included (excl_ra:((num)excl)ra) - (ra_op - (excl_ra:((num)excl)ra) - (f:(num)excl) - external) + (ra_op (excl_ra:((num)excl)ra) f external) a ==> - ra_valid - (excl_ra:((num)excl)ra) - (b:(num)excl) && + ra_valid (excl_ra:((num)excl)ra) b && ra_included (excl_ra:((num)excl)ra) - (ra_op - (excl_ra:((num)excl)ra) - (g:(num)excl) - external) + (ra_op (excl_ra:((num)excl)ra) g external) b`, "AUTH_RA_UPDATE_FRAMEWISE_IFF"); check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f, P), - AUTH_RA_UPDATE_ND_FRAMEWISE_IFF), - `ra_update_nd + ispecl_rule(TERM_LIST(R, a, f, b, g), AUTH_RA_UPDATE_LOCAL), + `ra_local_update + (excl_ra:((num)excl)ra) + (a:(num)excl) + (f:(num)excl) + (b:(num)excl) + (g:(num)excl) ==> + ra_update (auth_ra (excl_ra:((num)excl)ra)) - (auth_both (a:(num)excl) (f:(num)excl)) - (\candidate:((num)excl)excl#(num)excl. - exists (b:(num)excl) (g:(num)excl). - (P:(num)excl->(num)excl->bool) b g && - candidate == auth_both b g) <=> - forall external:(num)excl. - ra_valid - (excl_ra:((num)excl)ra) - (a:(num)excl) && - ra_included - (excl_ra:((num)excl)ra) - (ra_op - (excl_ra:((num)excl)ra) - (f:(num)excl) - external) - a ==> - exists (b:(num)excl) (g:(num)excl). - P b g && - ra_valid - (excl_ra:((num)excl)ra) - b && - ra_included - (excl_ra:((num)excl)ra) - (ra_op - (excl_ra:((num)excl)ra) - g - external) - b`, - "AUTH_RA_UPDATE_ND_FRAMEWISE_IFF"); + (auth_both a f) + (auth_both b g)`, + "AUTH_RA_UPDATE_LOCAL"); check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, b), - AUTH_RA_UPDATE_AUTH_IFF), + ispecl_rule(TERM_LIST(R, a, b), AUTH_RA_UPDATE_AUTH_IFF), `ra_update (auth_ra (excl_ra:((num)excl)ra)) - (auth_auth - (excl_ra:((num)excl)ra) - (a:(num)excl)) - (auth_auth - (excl_ra:((num)excl)ra) - (b:(num)excl)) <=> - (ra_valid - (excl_ra:((num)excl)ra) - (a:(num)excl) ==> - ra_valid - (excl_ra:((num)excl)ra) - (b:(num)excl) && - ra_included - (excl_ra:((num)excl)ra) - a - b)`, + (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) + (auth_auth (excl_ra:((num)excl)ra) (b:(num)excl)) <=> + (ra_valid (excl_ra:((num)excl)ra) a ==> + ra_valid (excl_ra:((num)excl)ra) b && + ra_included (excl_ra:((num)excl)ra) a b)`, "AUTH_RA_UPDATE_AUTH_IFF"); check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, b), - AUTH_RA_UPDATE_AUTH_INCLUDED), - `ra_valid - (excl_ra:((num)excl)ra) - (b:(num)excl) ==> - ra_included + ispecl_rule(TERM_LIST(R, a, b, g), AUTH_RA_UPDATE_ALLOC), + `ra_local_update (excl_ra:((num)excl)ra) (a:(num)excl) - b ==> + (ra_unit (excl_ra:((num)excl)ra)) + (b:(num)excl) + (g:(num)excl) ==> ra_update (auth_ra (excl_ra:((num)excl)ra)) - (auth_auth - (excl_ra:((num)excl)ra) - a) - (auth_auth - (excl_ra:((num)excl)ra) - b)`, - "AUTH_RA_UPDATE_AUTH_INCLUDED"); + (auth_auth (excl_ra:((num)excl)ra) a) + (auth_both b g)`, + "AUTH_RA_UPDATE_ALLOC"); check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f), - AUTH_RA_UPDATE_DROP_FRAG), + ispecl_rule(TERM_LIST(R, a, f), AUTH_RA_UPDATE_DROP_LOCAL), `ra_update (auth_ra (excl_ra:((num)excl)ra)) (auth_both (a:(num)excl) (f:(num)excl)) - (auth_auth - (excl_ra:((num)excl)ra) - a)`, - "AUTH_RA_UPDATE_DROP_FRAG"); + (auth_auth (excl_ra:((num)excl)ra) a)`, + "AUTH_RA_UPDATE_DROP_LOCAL"); check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f), - AUTH_RA_UPDATE_DROP_AUTH), + ispecl_rule(TERM_LIST(R, a, f), AUTH_RA_UPDATE_DROP_AUTH), `ra_update (auth_ra (excl_ra:((num)excl)ra)) (auth_both (a:(num)excl) (f:(num)excl)) - (auth_frag (f:(num)excl))`, + (auth_frag f)`, "AUTH_RA_UPDATE_DROP_AUTH"); check_auth_theorem( @@ -659,63 +175,26 @@ PROOF static int audit_auth_ra_regressions(void) { "AUTH_RA_UPDATE_WEAKEN_FRAG"); check_auth_theorem( - ispecl_rule( - TERM_LIST(R, f, g), - AUTH_RA_FRAG_UPDATE_INCLUDED), - `ra_included - (excl_ra:((num)excl)ra) - (g:(num)excl) - (f:(num)excl) ==> - ra_update - (auth_ra (excl_ra:((num)excl)ra)) - (auth_frag (f:(num)excl)) - (auth_frag g)`, - "AUTH_RA_FRAG_UPDATE_INCLUDED"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, b, f), - AUTH_RA_UPDATE_BOTH_INCLUDED), + ispecl_rule(TERM_LIST(R, a, piece), AUTH_RA_ALLOC), `ra_valid (excl_ra:((num)excl)ra) - (b:(num)excl) ==> - ra_included - (excl_ra:((num)excl)ra) - (a:(num)excl) - b ==> + (ra_op + (excl_ra:((num)excl)ra) + (a:(num)excl) + (piece:(num)excl)) ==> ra_update (auth_ra (excl_ra:((num)excl)ra)) - (auth_both a (f:(num)excl)) - (auth_both b f)`, - "AUTH_RA_UPDATE_BOTH_INCLUDED"); - - check_auth_theorem( - ispecl_rule( - TERM_LIST(R, a, f, g, b, c, h), - AUTH_RA_LOCAL_UPDATE), - `ra_local_update - (excl_ra:((num)excl)ra) - ((f:(num)excl),(g:(num)excl)) - ((c:(num)excl),(h:(num)excl)) ==> - ra_included - (excl_ra:((num)excl)ra) - c - (b:(num)excl) ==> - ra_valid - (excl_ra:((num)excl)ra) - b ==> - ra_local_update - (auth_ra (excl_ra:((num)excl)ra)) - (auth_both (a:(num)excl) f, - auth_both a g) - (auth_both b c, - auth_both b h)`, - "AUTH_RA_LOCAL_UPDATE"); + (auth_auth (excl_ra:((num)excl)ra) a) + (auth_both + (ra_op (excl_ra:((num)excl)ra) a piece) + piece)`, + "AUTH_RA_ALLOC"); return 0; err: - ERR_FUN_PUTS("audit_auth_ra_regressions"); + ERR_FUN_PUTS("audit_auth_ra_v2_regressions"); return -1; } -PROOF static int _AUTH_RA_REGRESSION = audit_auth_ra_regressions(); +PROOF static int _AUTH_RA_V2_REGRESSION = + audit_auth_ra_v2_regressions(); diff --git a/test/auth_ra_structure_regression.c b/test/auth_ra_structure_regression.c index 1da81fa..3eed6aa 100644 --- a/test/auth_ra_structure_regression.c +++ b/test/auth_ra_structure_regression.c @@ -4,9 +4,7 @@ #require "proof/proof_backward.c" #require "proof/theory/logic/auth_ra.c" -/* Public-interface regression coverage for the constructor-level structure - * of auth_ra. In addition to checking the exact specialized conclusion, the - * common checker rejects leaked proof hypotheses. */ +/* Constructor-level checks intentionally stop at the v2 auth_ra.h boundary. */ PROOF static void check_auth_structure_theorem( const thm theorem, const term expected, @@ -21,7 +19,7 @@ err: ERR_FUN_PUTS("check_auth_structure_theorem", label); } -PROOF static int audit_auth_ra_structure_regressions(void) { +PROOF static int audit_auth_ra_structure_v2(void) { term R = `excl_ra:((num)excl)ra`; term a = `a:(num)excl`; term f = `f:(num)excl`; @@ -29,50 +27,67 @@ PROOF static int audit_auth_ra_structure_regressions(void) { term g = `g:(num)excl`; term frame = `frame:((num)excl)excl#(num)excl`; - /* Constructor equality and distinction. */ check_auth_structure_theorem( - ispecl_rule(TERM_LIST(f, g), AUTH_RA_FRAG_INJ), - `((auth_frag (f:(num)excl)):((num)excl)excl#(num)excl) == - auth_frag (g:(num)excl) <=> - f == g`, - "AUTH_RA_FRAG_INJ"); + ispec_rule(R, AUTH_RA_UNIT), + `ra_unit (auth_ra (excl_ra:((num)excl)ra)) == + auth_frag (ra_unit (excl_ra:((num)excl)ra))`, + "AUTH_RA_UNIT"); check_auth_structure_theorem( - ispecl_rule(TERM_LIST(a, f, b, g), AUTH_RA_BOTH_INJ), - `((auth_both (a:(num)excl) (f:(num)excl)): - ((num)excl)excl#(num)excl) == - auth_both (b:(num)excl) (g:(num)excl) <=> - a == b && f == g`, - "AUTH_RA_BOTH_INJ"); + ispecl_rule(TERM_LIST(R, a, f), AUTH_RA_AUTH_FRAG), + `ra_op + (auth_ra (excl_ra:((num)excl)ra)) + (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) + (auth_frag (f:(num)excl)) == + auth_both a f`, + "AUTH_RA_AUTH_FRAG"); check_auth_structure_theorem( - ispecl_rule(TERM_LIST(a, f, g), AUTH_RA_BOTH_NE_FRAG), - `~(((auth_both (a:(num)excl) (f:(num)excl)): - ((num)excl)excl#(num)excl) == - auth_frag (g:(num)excl))`, - "AUTH_RA_BOTH_NE_FRAG"); + ispecl_rule(TERM_LIST(R, f, g), AUTH_RA_FRAG_FRAG), + `ra_op + (auth_ra (excl_ra:((num)excl)ra)) + (auth_frag (f:(num)excl)) + (auth_frag (g:(num)excl)) == + auth_frag + (ra_op (excl_ra:((num)excl)ra) f g)`, + "AUTH_RA_FRAG_FRAG"); check_auth_structure_theorem( - ispecl_rule(TERM_LIST(R, a, b), AUTH_RA_AUTH_INJ), - `auth_auth (excl_ra:((num)excl)ra) (a:(num)excl) == - auth_auth (excl_ra:((num)excl)ra) (b:(num)excl) <=> - a == b`, - "AUTH_RA_AUTH_INJ"); + ispecl_rule(TERM_LIST(R, a, f, g), AUTH_RA_BOTH_FRAG), + `ra_op + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl)) + (auth_frag (g:(num)excl)) == + auth_both + a + (ra_op (excl_ra:((num)excl)ra) f g)`, + "AUTH_RA_BOTH_FRAG"); check_auth_structure_theorem( - ispecl_rule(TERM_LIST(R, a, f), AUTH_RA_AUTH_NE_FRAG), - `~(auth_auth (excl_ra:((num)excl)ra) (a:(num)excl) == - auth_frag (f:(num)excl))`, - "AUTH_RA_AUTH_NE_FRAG"); + ispecl_rule(TERM_LIST(R, f), AUTH_RA_VALID_FRAG), + `ra_valid + (auth_ra (excl_ra:((num)excl)ra)) + (auth_frag (f:(num)excl)) <=> + ra_valid (excl_ra:((num)excl)ra) f`, + "AUTH_RA_VALID_FRAG"); check_auth_structure_theorem( - ispecl_rule(TERM_LIST(R, a, b, f), AUTH_RA_AUTH_EQ_BOTH), - `auth_auth (excl_ra:((num)excl)ra) (a:(num)excl) == - auth_both (b:(num)excl) (f:(num)excl) <=> - a == b && f == ra_unit (excl_ra:((num)excl)ra)`, - "AUTH_RA_AUTH_EQ_BOTH"); + ispecl_rule(TERM_LIST(R, a, f), AUTH_RA_VALID_BOTH), + `ra_valid + (auth_ra (excl_ra:((num)excl)ra)) + (auth_both (a:(num)excl) (f:(num)excl)) <=> + ra_valid (excl_ra:((num)excl)ra) a && + ra_included (excl_ra:((num)excl)ra) f a`, + "AUTH_RA_VALID_BOTH"); + + check_auth_structure_theorem( + ispecl_rule(TERM_LIST(R, a), AUTH_RA_VALID_AUTH), + `ra_valid + (auth_ra (excl_ra:((num)excl)ra)) + (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) <=> + ra_valid (excl_ra:((num)excl)ra) a`, + "AUTH_RA_VALID_AUTH"); - /* The public frame characterizations used by update clients. */ check_auth_structure_theorem( ispecl_rule( TERM_LIST(R, a, f, frame), @@ -93,26 +108,15 @@ PROOF static int audit_auth_ra_structure_regressions(void) { "AUTH_RA_VALID_BOTH_FRAME"); check_auth_structure_theorem( - ispecl_rule( - TERM_LIST(R, a, frame), - AUTH_RA_VALID_AUTH_FRAME), - `ra_valid - (auth_ra (excl_ra:((num)excl)ra)) - (ra_op - (auth_ra (excl_ra:((num)excl)ra)) - (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) - (frame:((num)excl)excl#(num)excl)) <=> - exists external:(num)excl. - frame == auth_frag external && - ra_valid (excl_ra:((num)excl)ra) a && - ra_included (excl_ra:((num)excl)ra) external a`, - "AUTH_RA_VALID_AUTH_FRAME"); + ispecl_rule(TERM_LIST(R, a, b), AUTH_RA_AUTH_CONFLICT), + `~(ra_compatible + (auth_ra (excl_ra:((num)excl)ra)) + (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) + (auth_auth (excl_ra:((num)excl)ra) (b:(num)excl)))`, + "AUTH_RA_AUTH_CONFLICT"); - /* All nine source/target constructor forms for inclusion. */ check_auth_structure_theorem( - ispecl_rule( - TERM_LIST(R, f, g), - AUTH_RA_INCLUDED_FRAG_FRAG), + ispecl_rule(TERM_LIST(R, f, g), AUTH_RA_INCLUDED_FRAG_FRAG), `ra_included (auth_ra (excl_ra:((num)excl)ra)) (auth_frag (f:(num)excl)) @@ -120,20 +124,6 @@ PROOF static int audit_auth_ra_structure_regressions(void) { ra_included (excl_ra:((num)excl)ra) f g`, "AUTH_RA_INCLUDED_FRAG_FRAG"); - check_auth_structure_theorem( - ispecl_rule( - TERM_LIST(R, f, a), - AUTH_RA_INCLUDED_FRAG_AUTH), - `ra_included - (auth_ra (excl_ra:((num)excl)ra)) - (auth_frag (f:(num)excl)) - (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) <=> - ra_included - (excl_ra:((num)excl)ra) - f - (ra_unit (excl_ra:((num)excl)ra))`, - "AUTH_RA_INCLUDED_FRAG_AUTH"); - check_auth_structure_theorem( ispecl_rule( TERM_LIST(R, f, a, g), @@ -145,16 +135,6 @@ PROOF static int audit_auth_ra_structure_regressions(void) { ra_included (excl_ra:((num)excl)ra) f g`, "AUTH_RA_INCLUDED_FRAG_BOTH"); - check_auth_structure_theorem( - ispecl_rule( - TERM_LIST(R, a, g), - AUTH_RA_INCLUDED_AUTH_FRAG), - `~(ra_included - (auth_ra (excl_ra:((num)excl)ra)) - (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) - (auth_frag (g:(num)excl)))`, - "AUTH_RA_INCLUDED_AUTH_FRAG"); - check_auth_structure_theorem( ispecl_rule( TERM_LIST(R, a, b), @@ -177,31 +157,6 @@ PROOF static int audit_auth_ra_structure_regressions(void) { a == b`, "AUTH_RA_INCLUDED_AUTH_BOTH"); - check_auth_structure_theorem( - ispecl_rule( - TERM_LIST(R, a, f, g), - AUTH_RA_INCLUDED_BOTH_FRAG), - `~(ra_included - (auth_ra (excl_ra:((num)excl)ra)) - (auth_both (a:(num)excl) (f:(num)excl)) - (auth_frag (g:(num)excl)))`, - "AUTH_RA_INCLUDED_BOTH_FRAG"); - - check_auth_structure_theorem( - ispecl_rule( - TERM_LIST(R, a, f, b), - AUTH_RA_INCLUDED_BOTH_AUTH), - `ra_included - (auth_ra (excl_ra:((num)excl)ra)) - (auth_both (a:(num)excl) (f:(num)excl)) - (auth_auth (excl_ra:((num)excl)ra) (b:(num)excl)) <=> - a == b && - ra_included - (excl_ra:((num)excl)ra) - f - (ra_unit (excl_ra:((num)excl)ra))`, - "AUTH_RA_INCLUDED_BOTH_AUTH"); - check_auth_structure_theorem( ispecl_rule( TERM_LIST(R, a, f, b, g), @@ -210,41 +165,15 @@ PROOF static int audit_auth_ra_structure_regressions(void) { (auth_ra (excl_ra:((num)excl)ra)) (auth_both (a:(num)excl) (f:(num)excl)) (auth_both (b:(num)excl) (g:(num)excl)) <=> - a == b && ra_included (excl_ra:((num)excl)ra) f g`, + a == b && + ra_included (excl_ra:((num)excl)ra) f g`, "AUTH_RA_INCLUDED_BOTH_BOTH"); - /* Existing public constructor validity remains stable alongside the new - * frame rules. */ - check_auth_structure_theorem( - ispecl_rule(TERM_LIST(R, a), AUTH_RA_VALID_AUTH), - `ra_valid - (auth_ra (excl_ra:((num)excl)ra)) - (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) <=> - ra_valid (excl_ra:((num)excl)ra) a`, - "AUTH_RA_VALID_AUTH"); - - check_auth_structure_theorem( - ispecl_rule(TERM_LIST(R, f), AUTH_RA_VALID_FRAG), - `ra_valid - (auth_ra (excl_ra:((num)excl)ra)) - (auth_frag (f:(num)excl)) <=> - ra_valid (excl_ra:((num)excl)ra) f`, - "AUTH_RA_VALID_FRAG"); - - check_auth_structure_theorem( - ispecl_rule(TERM_LIST(R, a, f), AUTH_RA_VALID_BOTH), - `ra_valid - (auth_ra (excl_ra:((num)excl)ra)) - (auth_both (a:(num)excl) (f:(num)excl)) <=> - ra_valid (excl_ra:((num)excl)ra) a && - ra_included (excl_ra:((num)excl)ra) f a`, - "AUTH_RA_VALID_BOTH"); - return 0; err: - ERR_FUN_PUTS("audit_auth_ra_structure_regressions"); + ERR_FUN_PUTS("audit_auth_ra_structure_v2"); return -1; } -PROOF static int _AUTH_RA_STRUCTURE_REGRESSION = - audit_auth_ra_structure_regressions(); +PROOF static int _AUTH_RA_STRUCTURE_V2_REGRESSION = + audit_auth_ra_structure_v2(); diff --git a/test/basic_ra_constructors_regression.c b/test/basic_ra_constructors_regression.c index ee01a96..f4bcd7e 100644 --- a/test/basic_ra_constructors_regression.c +++ b/test/basic_ra_constructors_regression.c @@ -6,9 +6,6 @@ #require "proof/theory/logic/prod_ra.c" #require "proof/theory/logic/unit_ra.c" -/* Exact public-interface regression for the three foundational RA - * constructors. Each check also rejects empty theorems and leaked proof - * hypotheses, so weakening a contract cannot silently pass this test. */ PROOF static void check_basic_ra_theorem( const thm theorem, const term expected, @@ -23,80 +20,99 @@ err: ERR_FUN_PUTS("check_basic_ra_theorem", label); } -PROOF static int audit_basic_ra_constructor_regressions(void) { - /* Unit RA: complete order and update behavior. */ +PROOF static thm basic_ra_at_num(thm theorem) { + type_list variables = term_tyvars(concl(theorem)); + ENSURE_COND(vector_size(variables) == 1, + "expected exactly one carrier type variable"); + type_pair_list types = (type_pair_list)vector_create(); + vector_add(&types, ((type_pair){`:num`, variables[0]})); + return inst_type_rule(types, theorem); +err: + ERR_FUN_PUTS("basic_ra_at_num"); + return empty_theorem; +} + +PROOF static int audit_unit_ra_regressions(void) { + check_basic_ra_theorem( + UNIT_RA_UNIT, + `ra_unit unit_ra == (one:1)`, + "UNIT_RA_UNIT"); + check_basic_ra_theorem( + UNIT_RA_OP, + `forall a b:1. ra_op unit_ra a b == one`, + "UNIT_RA_OP"); + check_basic_ra_theorem( + UNIT_RA_VALID, + `forall a:1. ra_valid unit_ra a`, + "UNIT_RA_VALID"); check_basic_ra_theorem( UNIT_RA_INCLUDED, `forall a b:1. ra_included unit_ra a b`, "UNIT_RA_INCLUDED"); check_basic_ra_theorem( - UNIT_RA_UPDATE, - `forall a b:1. ra_update unit_ra a b`, - "UNIT_RA_UPDATE"); + UNIT_RA_EXCLUSIVE, + `forall a:1. ra_exclusive unit_ra a`, + "UNIT_RA_EXCLUSIVE"); check_basic_ra_theorem( - UNIT_RA_UPDATE_ND_IFF, + UNIT_RA_UPDATEP_IFF, `forall (a:1) (P:1->bool). - ra_update_nd unit_ra a P <=> P one`, - "UNIT_RA_UPDATE_ND_IFF"); + ra_updateP unit_ra a P <=> P one`, + "UNIT_RA_UPDATEP_IFF"); check_basic_ra_theorem( UNIT_RA_LOCAL_UPDATE, - `forall source target:1#1. - ra_local_update unit_ra source target`, + `forall a f b g:1. ra_local_update unit_ra a f b g`, "UNIT_RA_LOCAL_UPDATE"); + return 0; +err: + ERR_FUN_PUTS("audit_unit_ra_regressions"); + return -1; +} +PROOF static int audit_excl_ra_regressions(void) { term a = `a:num`; term b = `b:num`; term x = `x:(num)excl`; - /* Exclusive RA: constructors, validity, inclusion, and exact updates. */ check_basic_ra_theorem( - ispecl_rule(TERM_LIST(a, b), EXCL_RA_OWNED_INJ), - `((Excl (a:num):(num)excl) == Excl (b:num)) <=> a == b`, - "EXCL_RA_OWNED_INJ"); + basic_ra_at_num(EXCL_RA_UNIT), + `ra_unit (excl_ra:((num)excl)ra) == ExclUnit`, + "EXCL_RA_UNIT"); check_basic_ra_theorem( - ispec_rule(a, EXCL_RA_OWNED_NE_UNIT), - `~((Excl (a:num):(num)excl) == ExclUnit)`, - "EXCL_RA_OWNED_NE_UNIT"); + ispecl_rule(TERM_LIST(a, b), EXCL_RA_OWNED_CONFLICT), + `ra_op + (excl_ra:((num)excl)ra) + (Excl (a:num)) + (Excl (b:num)) == + ExclInvalid`, + "EXCL_RA_OWNED_CONFLICT"); check_basic_ra_theorem( - EXCL_RA_INVALID_NE_UNIT, - `~((ExclInvalid:(A)excl) == ExclUnit)`, - "EXCL_RA_INVALID_NE_UNIT"); + basic_ra_at_num(EXCL_RA_VALID_UNIT), + `ra_valid (excl_ra:((num)excl)ra) ExclUnit`, + "EXCL_RA_VALID_UNIT"); check_basic_ra_theorem( - ispec_rule(a, EXCL_RA_INVALID_NE_OWNED), - `~((ExclInvalid:(num)excl) == Excl (a:num))`, - "EXCL_RA_INVALID_NE_OWNED"); + ispec_rule(a, EXCL_RA_VALID_OWNED), + `ra_valid (excl_ra:((num)excl)ra) (Excl (a:num))`, + "EXCL_RA_VALID_OWNED"); check_basic_ra_theorem( - ispec_rule(x, EXCL_RA_VALID_IFF), - `ra_valid (excl_ra:((num)excl)ra) (x:(num)excl) <=> - ~(x == ExclInvalid)`, - "EXCL_RA_VALID_IFF"); + basic_ra_at_num(EXCL_RA_INVALID), + `~(ra_valid (excl_ra:((num)excl)ra) ExclInvalid)`, + "EXCL_RA_INVALID"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(a, x), EXCL_RA_INCLUDED_OWNED_IFF), + ispecl_rule(TERM_LIST(a, b), EXCL_RA_INCLUDED_OWNED), `ra_included (excl_ra:((num)excl)ra) (Excl (a:num)) - (x:(num)excl) <=> - x == Excl a \/ x == ExclInvalid`, - "EXCL_RA_INCLUDED_OWNED_IFF"); - check_basic_ra_theorem( - ispec_rule(x, EXCL_RA_INCLUDED_INVALID_IFF), - `ra_included - (excl_ra:((num)excl)ra) - ExclInvalid - (x:(num)excl) <=> - x == ExclInvalid`, - "EXCL_RA_INCLUDED_INVALID_IFF"); + (Excl (b:num)) <=> + a == b`, + "EXCL_RA_INCLUDED_OWNED"); check_basic_ra_theorem( - EXCL_RA_EXCLUSIVE_INVALID, - `ra_exclusive - (excl_ra:((A)excl)ra) - (ExclInvalid:(A)excl)`, - "EXCL_RA_EXCLUSIVE_INVALID"); + ispec_rule(a, EXCL_RA_EXCLUSIVE), + `ra_exclusive (excl_ra:((num)excl)ra) (Excl (a:num))`, + "EXCL_RA_EXCLUSIVE"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(a, x), EXCL_RA_UPDATE_VALID), - `ra_valid (excl_ra:((num)excl)ra) (x:(num)excl) ==> - ra_update excl_ra (Excl (a:num)) x`, - "EXCL_RA_UPDATE_VALID"); + basic_ra_at_num(EXCL_RA_CANCELLATIVE), + `ra_cancellative (excl_ra:((num)excl)ra)`, + "EXCL_RA_CANCELLATIVE"); check_basic_ra_theorem( ispecl_rule(TERM_LIST(a, x), EXCL_RA_UPDATE_OWNED_IFF), `ra_update @@ -105,33 +121,27 @@ PROOF static int audit_basic_ra_constructor_regressions(void) { (x:(num)excl) <=> ra_valid excl_ra x`, "EXCL_RA_UPDATE_OWNED_IFF"); - check_basic_ra_theorem( - ispec_rule(x, EXCL_RA_UPDATE_INVALID), - `ra_update - (excl_ra:((num)excl)ra) - ExclInvalid - (x:(num)excl)`, - "EXCL_RA_UPDATE_INVALID"); - check_basic_ra_theorem( - ispecl_rule(TERM_LIST(a, x), EXCL_RA_LOCAL_UPDATE_VALID), - `ra_valid (excl_ra:((num)excl)ra) (x:(num)excl) ==> - ra_local_update - excl_ra - (Excl (a:num),Excl a) - (x,x)`, - "EXCL_RA_LOCAL_UPDATE_VALID"); check_basic_ra_theorem( ispecl_rule(TERM_LIST(a, x), EXCL_RA_LOCAL_UPDATE_IFF), `ra_local_update (excl_ra:((num)excl)ra) - (Excl (a:num),Excl a) - ((x:(num)excl),x) <=> + (Excl (a:num)) + (Excl a) + (x:(num)excl) + x <=> ra_valid excl_ra x`, "EXCL_RA_LOCAL_UPDATE_IFF"); + return 0; +err: + ERR_FUN_PUTS("audit_excl_ra_regressions"); + return -1; +} - term R1 = `unit_ra`; - term R2 = `excl_ra:((num)excl)ra`; - term p = `p:1#(num)excl`; +PROOF static int audit_prod_ra_regressions(void) { + term R = `unit_ra`; + term S = `excl_ra:((num)excl)ra`; + term x = `x:1#(num)excl`; + term y = `y:1#(num)excl`; term a1 = `a1:1`; term b1 = `b1:1`; term a2 = `a2:(num)excl`; @@ -140,121 +150,158 @@ PROOF static int audit_basic_ra_constructor_regressions(void) { term g1 = `g1:1`; term f2 = `f2:(num)excl`; term g2 = `g2:(num)excl`; + term P1 = `P1:1->bool`; + term P2 = `P2:(num)excl->bool`; - /* Product exclusivity and optional laws. */ - check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R1, R2, p), PROD_RA_EXCLUSIVE), - `ra_exclusive unit_ra (FST (p:1#(num)excl)) ==> - ra_exclusive (excl_ra:((num)excl)ra) (SND p) ==> - ra_exclusive (prod_ra unit_ra excl_ra) p`, - "PROD_RA_EXCLUSIVE"); - check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R1, R2, p), PROD_RA_EXCLUSIVE_ELIM_LEFT), - `ra_valid (prod_ra unit_ra (excl_ra:((num)excl)ra)) - (p:1#(num)excl) ==> - ra_exclusive (prod_ra unit_ra excl_ra) p ==> - ra_exclusive unit_ra (FST p)`, - "PROD_RA_EXCLUSIVE_ELIM_LEFT"); - check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R1, R2, p), PROD_RA_EXCLUSIVE_ELIM_RIGHT), - `ra_valid (prod_ra unit_ra (excl_ra:((num)excl)ra)) - (p:1#(num)excl) ==> - ra_exclusive (prod_ra unit_ra excl_ra) p ==> - ra_exclusive excl_ra (SND p)`, - "PROD_RA_EXCLUSIVE_ELIM_RIGHT"); - check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R1, R2, p), PROD_RA_EXCLUSIVE_IFF), - `ra_valid (prod_ra unit_ra (excl_ra:((num)excl)ra)) - (p:1#(num)excl) ==> - (ra_exclusive (prod_ra unit_ra excl_ra) p <=> - ra_exclusive unit_ra (FST p) && - ra_exclusive excl_ra (SND p))`, - "PROD_RA_EXCLUSIVE_IFF"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R1, R2), PROD_RA_CANCELLATIVE_IFF), + ispecl_rule(TERM_LIST(R, S), PROD_RA_UNIT), + `ra_unit (prod_ra unit_ra (excl_ra:((num)excl)ra)) == + (ra_unit unit_ra,ra_unit excl_ra)`, + "PROD_RA_UNIT"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(R, S, x, y), PROD_RA_OP), + `ra_op + (prod_ra unit_ra (excl_ra:((num)excl)ra)) + (x:1#(num)excl) + (y:1#(num)excl) == + (ra_op unit_ra (FST x) (FST y), + ra_op excl_ra (SND x) (SND y))`, + "PROD_RA_OP"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(R, S, x), PROD_RA_VALID), + `ra_valid + (prod_ra unit_ra (excl_ra:((num)excl)ra)) + (x:1#(num)excl) <=> + ra_valid unit_ra (FST x) && ra_valid excl_ra (SND x)`, + "PROD_RA_VALID"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(R, S, x, y), PROD_RA_INCLUDED), + `ra_included + (prod_ra unit_ra (excl_ra:((num)excl)ra)) + (x:1#(num)excl) + (y:1#(num)excl) <=> + ra_included unit_ra (FST x) (FST y) && + ra_included excl_ra (SND x) (SND y)`, + "PROD_RA_INCLUDED"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(R, S), PROD_RA_CANCELLATIVE_IFF), `ra_cancellative - (prod_ra unit_ra (excl_ra:((num)excl)ra)) <=> + (prod_ra unit_ra (excl_ra:((num)excl)ra)) <=> ra_cancellative unit_ra && ra_cancellative (excl_ra:((num)excl)ra)`, "PROD_RA_CANCELLATIVE_IFF"); - - /* Product deterministic update projections and exact characterization. */ check_basic_ra_theorem( - ispecl_rule( - TERM_LIST(R1, R2, a1, a2, b1, b2), - PROD_RA_UPDATE_ELIM_LEFT), - `ra_update + ispecl_rule(TERM_LIST(R, S, x), PROD_RA_EXCLUSIVE_IFF), + `ra_exclusive (prod_ra unit_ra (excl_ra:((num)excl)ra)) - ((a1:1),(a2:(num)excl)) - ((b1:1),(b2:(num)excl)) ==> - ra_valid excl_ra a2 ==> - ra_update unit_ra a1 b1`, - "PROD_RA_UPDATE_ELIM_LEFT"); + (x:1#(num)excl) <=> + ra_exclusive unit_ra (FST x) && + ra_exclusive excl_ra (SND x)`, + "PROD_RA_EXCLUSIVE_IFF"); check_basic_ra_theorem( ispecl_rule( - TERM_LIST(R1, R2, a1, a2, b1, b2), - PROD_RA_UPDATE_ELIM_RIGHT), - `ra_update - (prod_ra unit_ra (excl_ra:((num)excl)ra)) - ((a1:1),(a2:(num)excl)) - ((b1:1),(b2:(num)excl)) ==> - ra_valid unit_ra a1 ==> - ra_update excl_ra a2 b2`, - "PROD_RA_UPDATE_ELIM_RIGHT"); + TERM_LIST(R, S, a1, a2, P1, P2), + PROD_RA_UPDATEP), + `ra_updateP unit_ra (a1:1) (P1:1->bool) ==> + ra_updateP excl_ra (a2:(num)excl) (P2:(num)excl->bool) ==> + ra_updateP + (prod_ra unit_ra excl_ra) + (a1,a2) + (\x:1#(num)excl. + exists b1:1. exists b2:(num)excl. + P1 b1 && P2 b2 && x == (b1,b2))`, + "PROD_RA_UPDATEP"); check_basic_ra_theorem( - ispecl_rule( - TERM_LIST(R1, R2, a1, a2, b1, b2), - PROD_RA_UPDATE_IFF), - `ra_valid unit_ra (a1:1) ==> - ra_valid (excl_ra:((num)excl)ra) (a2:(num)excl) ==> - (ra_update - (prod_ra unit_ra excl_ra) - (a1,a2) - ((b1:1),(b2:(num)excl)) <=> - ra_update unit_ra a1 b1 && ra_update excl_ra a2 b2)`, - "PROD_RA_UPDATE_IFF"); - - /* Product local-update lifting, including both one-sided forms. */ + ispecl_rule(TERM_LIST(R, S, a1, a2, b1), PROD_RA_UPDATE_LEFT), + `ra_update unit_ra (a1:1) (b1:1) ==> + ra_update (prod_ra unit_ra (excl_ra:((num)excl)ra)) + (a1,(a2:(num)excl)) (b1,a2)`, + "PROD_RA_UPDATE_LEFT"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(R, S, a1, a2, b2), PROD_RA_UPDATE_RIGHT), + `ra_update excl_ra (a2:(num)excl) (b2:(num)excl) ==> + ra_update (prod_ra unit_ra excl_ra) ((a1:1),a2) (a1,b2)`, + "PROD_RA_UPDATE_RIGHT"); check_basic_ra_theorem( ispecl_rule( - TERM_LIST( - R1, R2, - a1, f1, b1, g1, - a2, f2, b2, g2), + TERM_LIST(R, S, a1, f1, b1, g1, a2, f2, b2, g2), PROD_RA_LOCAL_UPDATE), - `ra_local_update unit_ra ((a1:1),(f1:1)) ((b1:1),(g1:1)) ==> - ra_local_update - (excl_ra:((num)excl)ra) - ((a2:(num)excl),(f2:(num)excl)) - ((b2:(num)excl),(g2:(num)excl)) ==> - ra_local_update - (prod_ra unit_ra excl_ra) - ((a1,a2),(f1,f2)) - ((b1,b2),(g1,g2))`, + `ra_local_update unit_ra (a1:1) (f1:1) (b1:1) (g1:1) ==> + ra_local_update excl_ra + (a2:(num)excl) (f2:(num)excl) (b2:(num)excl) (g2:(num)excl) ==> + ra_local_update (prod_ra unit_ra excl_ra) + (a1,a2) (f1,f2) (b1,b2) (g1,g2)`, "PROD_RA_LOCAL_UPDATE"); + check_basic_ra_theorem( - ispecl_rule( - TERM_LIST(R1, R2, a1, f1, b1, g1, a2, f2), - PROD_RA_LOCAL_UPDATE_LEFT), - `ra_local_update unit_ra ((a1:1),(f1:1)) ((b1:1),(g1:1)) ==> - ra_local_update - (prod_ra unit_ra (excl_ra:((num)excl)ra)) - ((a1,(a2:(num)excl)),(f1,(f2:(num)excl))) - ((b1,a2),(g1,f2))`, - "PROD_RA_LOCAL_UPDATE_LEFT"); + ispecl_rule(TERM_LIST(R, S, a1), prod_inl_def), + `prod_inl unit_ra (excl_ra:((num)excl)ra) (a1:1) == + (a1,ra_unit excl_ra)`, + "prod_inl_def"); check_basic_ra_theorem( - ispecl_rule( - TERM_LIST(R1, R2, a1, f1, a2, f2, b2, g2), - PROD_RA_LOCAL_UPDATE_RIGHT), - `ra_local_update - (excl_ra:((num)excl)ra) - ((a2:(num)excl),(f2:(num)excl)) - ((b2:(num)excl),(g2:(num)excl)) ==> - ra_local_update - (prod_ra unit_ra excl_ra) - (((a1:1),a2),((f1:1),f2)) - ((a1,b2),(f1,g2))`, - "PROD_RA_LOCAL_UPDATE_RIGHT"); + ispecl_rule(TERM_LIST(R, S, a2), prod_inr_def), + `prod_inr unit_ra (excl_ra:((num)excl)ra) (a2:(num)excl) == + (ra_unit unit_ra,a2)`, + "prod_inr_def"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(R, S, a1, b1), PROD_INL_OP), + `prod_inl unit_ra (excl_ra:((num)excl)ra) + (ra_op unit_ra (a1:1) (b1:1)) == + ra_op (prod_ra unit_ra (excl_ra:((num)excl)ra)) + (prod_inl unit_ra (excl_ra:((num)excl)ra) a1) + (prod_inl unit_ra (excl_ra:((num)excl)ra) b1)`, + "PROD_INL_OP"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(R, S, a2, b2), PROD_INR_OP), + `prod_inr unit_ra excl_ra (ra_op excl_ra (a2:(num)excl) (b2:(num)excl)) == + ra_op (prod_ra unit_ra excl_ra) + (prod_inr unit_ra excl_ra a2) + (prod_inr unit_ra excl_ra b2)`, + "PROD_INR_OP"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(R, S, a1, P1), PROD_INL_UPDATEP), + `ra_updateP unit_ra (a1:1) (P1:1->bool) ==> + ra_updateP (prod_ra unit_ra (excl_ra:((num)excl)ra)) + (prod_inl unit_ra (excl_ra:((num)excl)ra) a1) + (\x:1#(num)excl. exists b:1. + P1 b && + x == prod_inl unit_ra (excl_ra:((num)excl)ra) b)`, + "PROD_INL_UPDATEP"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(R, S, a2, P2), PROD_INR_UPDATEP), + `ra_updateP excl_ra (a2:(num)excl) (P2:(num)excl->bool) ==> + ra_updateP (prod_ra unit_ra excl_ra) + (prod_inr unit_ra excl_ra a2) + (\x:1#(num)excl. exists b:(num)excl. + P2 b && x == prod_inr unit_ra excl_ra b)`, + "PROD_INR_UPDATEP"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(R, S, a1, b1), PROD_INL_UPDATE), + `ra_update unit_ra (a1:1) (b1:1) ==> + ra_update (prod_ra unit_ra (excl_ra:((num)excl)ra)) + (prod_inl unit_ra (excl_ra:((num)excl)ra) a1) + (prod_inl unit_ra (excl_ra:((num)excl)ra) b1)`, + "PROD_INL_UPDATE"); + check_basic_ra_theorem( + ispecl_rule(TERM_LIST(R, S, a2, b2), PROD_INR_UPDATE), + `ra_update excl_ra (a2:(num)excl) (b2:(num)excl) ==> + ra_update (prod_ra unit_ra excl_ra) + (prod_inr unit_ra excl_ra a2) + (prod_inr unit_ra excl_ra b2)`, + "PROD_INR_UPDATE"); + return 0; +err: + ERR_FUN_PUTS("audit_prod_ra_regressions"); + return -1; +} + +PROOF static int audit_basic_ra_constructor_regressions(void) { + ENSURE_COND(audit_unit_ra_regressions() == 0, + "unit RA regressions failed"); + ENSURE_COND(audit_excl_ra_regressions() == 0, + "exclusive RA regressions failed"); + ENSURE_COND(audit_prod_ra_regressions() == 0, + "product RA regressions failed"); return 0; err: ERR_FUN_PUTS("audit_basic_ra_constructor_regressions"); diff --git a/test/c_resource_v2_regression.c b/test/c_resource_v2_regression.c new file mode 100644 index 0000000..1bb6585 --- /dev/null +++ b/test/c_resource_v2_regression.c @@ -0,0 +1,175 @@ +#include "proof/theory/c_program_logic/c_ghost.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/c_program_logic/c_ghost.c" + +PROOF static void check_c_resource_v2_theorem( + const thm theorem, + const term expected, + const char *label) { + ENSURE_COND(!IS_NULL(theorem), "%s is empty", label); + ENSURE_COND(vector_size(hyp(theorem)) == 0, + "%s unexpectedly has hypotheses", label); + ENSURE_COND(alpha_compare(concl(theorem), expected) == 0, + "%s has the wrong conclusion", label); + return; +err: + ERR_FUN_PUTS("check_c_resource_v2_theorem", label); +} + +PROOF static thm c_resource_v2_at_num(const thm theorem) { + type_list variables = term_tyvars(concl(theorem)); + ENSURE_COND(vector_size(variables) == 1, + "expected exactly one C ghost carrier type variable"); + type_pair_list types = (type_pair_list)vector_create(); + vector_add(&types, ((type_pair){`:num`, variables[0]})); + return inst_type_rule(types, theorem); +err: + ERR_FUN_PUTS("c_resource_v2_at_num"); + return empty_theorem; +} + +PROOF static int audit_c_resource_v2_regressions(void) { + term G = `G:(num)ra`; + term ghost = `ghost:num`; + term result_pred = `result_pred:num->bool`; + term c_post = + `Q:(((int,(pmem_byte_state)excl)finmap)#num)->bool`; + term resource = + `resource:((int,(pmem_byte_state)excl)finmap)#num`; + + /* The complete user-supplied G is the right component. There is no + * implicit ghost heap, option layer, or hidden allocation state. */ + check_c_resource_v2_theorem( + c_resource_v2_at_num(c_resource_ra_def), + `c_resource_ra (G:(num)ra) == prod_ra mem_ra G`, + "c_resource_ra is the complete-global product carrier"); + + check_c_resource_v2_theorem( + c_resource_v2_at_num(c_lift_phys_def), + `c_lift_phys + (G:(num)ra) + (P:(int,(pmem_byte_state)excl)finmap->bool) == + r_lift_left mem_ra G P`, + "c_lift_phys is the exact left lift"); + + check_c_resource_v2_theorem( + c_resource_v2_at_num(c_lift_ghost_def), + `c_lift_ghost (G:(num)ra) (Q:num->bool) == + r_lift_right mem_ra G Q`, + "c_lift_ghost is the exact right lift"); + + check_c_resource_v2_theorem( + ispecl_rule(TERM_LIST(G, c_post, resource), C_BUPD_PRESERVES_PHYS), + `ra_valid + (c_resource_ra (G:(num)ra)) + (resource:((int,(pmem_byte_state)excl)finmap)#num) ==> + c_bupd G + (Q:(((int,(pmem_byte_state)excl)finmap)#num)->bool) + resource ==> + exists ghost':num. Q (FST resource,ghost')`, + "C_BUPD_PRESERVES_PHYS keeps the physical projection"); + + /* `sl_v2_regression.c` separately locks r_fact to `phi && a == unit`. + * This exact statement therefore makes validity consume an exact-unit + * fact, rather than admitting the resource-independent r_pure assertion. */ + check_c_resource_v2_theorem( + ispecl_rule(TERM_LIST(G, ghost), C_GHOST_OWN_VALID), + `r_entails + (c_resource_ra (G:(num)ra)) + (c_ghost_own G (ghost:num)) + (r_sep + (c_resource_ra G) + (r_fact (c_resource_ra G) (ra_valid G ghost)) + (c_ghost_own G ghost))`, + "C_GHOST_OWN_VALID exposes validity through exact-unit fact"); + + check_c_resource_v2_theorem( + ispecl_rule( + TERM_LIST(G, ghost, result_pred), + C_GHOST_OWN_UPDATEP), + `ra_updateP + (G:(num)ra) + (ghost:num) + (result_pred:num->bool) ==> + c_viewshift + G + (c_ghost_own G ghost) + (r_exists + (c_resource_ra G) + (\selected:num. + r_sep + (c_resource_ra G) + (r_fact + (c_resource_ra G) + (result_pred selected)) + (c_ghost_own G selected)))`, + "C_GHOST_OWN_UPDATEP returns an exact-unit result witness"); + + term R = `R:(num)ra`; + term name = `name:num`; + term payload = `payload:num`; + term named_result_pred = `named_result_pred:num->bool`; + term named_assertion = + `P_named: + (((int,(pmem_byte_state)excl)finmap)#(num,num)finmap)->bool`; + + check_c_resource_v2_theorem( + ispecl_rule( + TERM_LIST(R, name, payload, named_result_pred), + C_NAMED_OWN_UPDATEP), + `ra_updateP + (R:(num)ra) + (payload:num) + (named_result_pred:num->bool) ==> + c_viewshift + (named_ra R) + (c_named_own R (name:num) payload) + (r_exists + (c_resource_ra (named_ra R)) + (\selected:num. + r_sep + (c_resource_ra (named_ra R)) + (r_fact + (c_resource_ra (named_ra R)) + (named_result_pred selected)) + (c_named_own R name selected)))`, + "C_NAMED_OWN_UPDATEP preserves the result witness"); + + /* DROP is unconditional. In particular, its exact conclusion contains no + * freshness token or premise that could make later reuse of `name` illegal. */ + check_c_resource_v2_theorem( + ispecl_rule(TERM_LIST(R, name, payload), C_NAMED_OWN_DROP), + `c_viewshift + (named_ra (R:(num)ra)) + (c_named_own R (name:num) (payload:num)) + (r_emp (c_resource_ra (named_ra R)))`, + "C_NAMED_OWN_DROP is unconditional and freshness-free"); + + check_c_resource_v2_theorem( + ispecl_rule( + TERM_LIST(R, payload, named_assertion), + C_NAMED_OWN_ALLOC), + `ra_valid (R:(num)ra) (payload:num) ==> + c_viewshift + (named_ra R) + (P_named: + (((int,(pmem_byte_state)excl)finmap)#(num,num)finmap)->bool) + (r_exists + (c_resource_ra (named_ra R)) + (\allocated:num. + r_sep + (c_resource_ra (named_ra R)) + (c_named_own R allocated payload) + P_named))`, + "C_NAMED_OWN_ALLOC allocates into the complete named global RA"); + + return 0; +err: + ERR_FUN_PUTS("audit_c_resource_v2_regressions"); + return -1; +} + +PROOF static int _C_RESOURCE_V2_REGRESSION_AUDIT = + audit_c_resource_v2_regressions(); diff --git a/test/dependency_v2_regression.sh b/test/dependency_v2_regression.sh new file mode 100755 index 0000000..b33c668 --- /dev/null +++ b/test/dependency_v2_regression.sh @@ -0,0 +1,135 @@ +#!/usr/bin/env bash + +# Static architecture/API regression for the RA/SL v2 boundary. +# +# This deliberately checks source-visible dependencies and public declarations; +# theorem-level semantic regressions live in the neighbouring *.c tests. + +set -eu + +script_dir=$(CDPATH= cd -- "$(dirname -- "$0")" && pwd) +proof_root=$(CDPATH= cd -- "$script_dir/.." && pwd) +logic_dir="$proof_root/theory/logic" +theory_dir="$proof_root/theory" + +if ! command -v rg >/dev/null 2>&1; then + echo "dependency_v2_regression: rg is required" >&2 + exit 2 +fi + +failed=0 + +reject_matches() { + description=$1 + pattern=$2 + shift 2 + + matches=$(rg -n --no-heading -- "$pattern" "$@" 2>/dev/null || true) + if [ -n "$matches" ]; then + echo "dependency_v2_regression: $description" >&2 + echo "$matches" >&2 + failed=1 + fi +} + +# These are the foundational algebra modules. The SL modules intentionally +# remain in theory/logic for now, so the boundary is expressed explicitly. +ra_file_names=( + ra.h ra.c ra_builder.h ra_internal.h + local_update.h local_update.c + unit_ra.h unit_ra.c + prod_ra.h prod_ra.c prod_ra_internal.h + option_ra.h option_ra.c option_ra_internal.h + excl_ra.h excl_ra.c excl_ra_internal.h + agree_ra.h agree_ra.c + finmap.h finmap.c + gmap_ra.h gmap_ra.c gmap_ra_internal.h + named_ra.h named_ra.c + auth_ra.h auth_ra.c + max_nat_ra.h max_nat_ra.c + frac_ra.h frac_ra.c +) + +existing_ra_files=() +for name in "${ra_file_names[@]}"; do + file="$logic_dir/$name" + if [ -f "$file" ]; then + existing_ra_files+=("$file") + fi +done + +reject_matches \ + "foundational RA module depends on an SL module" \ + '^[[:space:]]*#(include|require)[[:space:]]+"proof/theory/logic/(resource_prop|basic_update|big_sep|product_resource|named_logic|ghost_own|ghost_update)\.(h|c)"' \ + "${existing_ra_files[@]}" + +reject_matches \ + "foundational RA module depends on c_program_logic" \ + '^[[:space:]]*#(include|require)[[:space:]]+"proof/theory/c_program_logic/' \ + "${existing_ra_files[@]}" + +# Internal headers are the only supported home for representation and raw +# rewrite helpers, so they are intentionally excluded from public-surface +# checks below. +public_headers=() +while IFS= read -r header; do + public_headers+=("$header") +done < <(find "$theory_dir" -type f -name '*.h' ! -name '*_internal.h' -print) + +reject_matches \ + "public header exposes removed ra_update_nd" \ + '\bra_update_nd\b' \ + "${public_headers[@]}" + +reject_matches \ + "public header exposes a deallocation API; use DROP" \ + '(_DEALLOC|_dealloc)(_|\b)|\bdealloc\b' \ + "${public_headers[@]}" + +reject_matches \ + "public header exposes an invalid-source vacuity theorem" \ + '^PROOF[[:space:]]+extern[[:space:]]+thm[[:space:]]+[A-Z0-9_]*(RA_UPDATE_INVALID|RA_UPDATEP_INVALID|RA_INVALID_EXCLUSIVE)[A-Z0-9_]*;' \ + "${public_headers[@]}" + +reject_matches \ + "public assertion header exposes a raw-equality theorem handle" \ + '^PROOF[[:space:]]+extern[[:space:]]+thm[[:space:]]+R_[A-Z0-9_]*_EQ;' \ + "$logic_dir/resource_prop.h" \ + "$logic_dir/basic_update.h" \ + "$logic_dir/big_sep.h" \ + "$logic_dir/product_resource.h" \ + "$logic_dir/named_logic.h" + +reject_matches \ + "public assertion header exposes the deprecated raw-equality notation" \ + '-\|-' \ + "$logic_dir/resource_prop.h" \ + "$logic_dir/basic_update.h" \ + "$logic_dir/big_sep.h" \ + "$logic_dir/product_resource.h" \ + "$logic_dir/named_logic.h" + +# Pin the relation itself to the curried five-argument interface. This is +# stronger and less ambiguous than trying to infer arity from theorem names. +if ! rg -q \ + 'ra_local_update \(R:\(A\)ra\) \(a:A\) \(f:A\) \(b:A\) \(g:A\) <=>' \ + "$logic_dir/local_update.c"; then + echo "dependency_v2_regression: ra_local_update is not the five-argument v2 relation" >&2 + failed=1 +fi + +# The former ghost_* surface was replaced by named_ra/named_logic. Keeping +# those headers would leave both the old vocabulary and raw assertion laws +# publicly includable even if no current client happens to use them. +for obsolete_header in ghost_heap.h ghost_own.h ghost_update.h; do + if [ -e "$logic_dir/$obsolete_header" ]; then + echo "dependency_v2_regression: obsolete public header remains: theory/logic/$obsolete_header" >&2 + failed=1 + fi +done + +if [ "$failed" -ne 0 ]; then + exit 1 +fi + +echo "dependency_v2_regression: ok" diff --git a/test/gmap_ra_regression.c b/test/gmap_ra_regression.c index 461225b..e602f61 100644 --- a/test/gmap_ra_regression.c +++ b/test/gmap_ra_regression.c @@ -6,6 +6,8 @@ #require "proof/theory/logic/excl_ra.c" #require "proof/theory/logic/gmap_ra.c" +/* Public-v2 regression coverage. In particular, this file deliberately does + * not mention the representation lemmas used to construct gmap_ra. */ PROOF static void check_gmap_theorem( const thm theorem, const term expected, @@ -20,129 +22,35 @@ err: ERR_FUN_PUTS("check_gmap_theorem", label); } -/* Overwriting an invalid entry is valid when the replacement is valid. This - * distinguishes the exact insert characterization from the too-strong and - * false condition that the pre-overwrite map itself must be valid. */ -PROOF static thm prove_gmap_valid_overwrite_regression(void) { - term old_map = ` - finmap_insert - (0:num) - (ExclInvalid:(num)excl) - (finmap_empty:(num,(num)excl)finmap) - `; - term map_ra = ` - (gmap_ra (excl_ra:((num)excl)ra)): - ((num,(num)excl)finmap)ra - `; - - thm insertion = ispecl_rule( - TERM_LIST( - `excl_ra:((num)excl)ra`, - `0:num`, - `Excl (7:num)`, - old_map), - GMAP_RA_VALID_INSERT); - thm payload_valid = ispec_rule(`7:num`, EXCL_RA_VALID_OWNED); - - thm empty_valid = ispec_rule(map_ra, RA_VALID_UNIT); - empty_valid = rewrite_rule( - THM_LIST(GMAP_RA_UNIT), - empty_valid); - - thm delete_insert = ispecl_rule( - TERM_LIST( - `0:num`, - `ExclInvalid:(num)excl`, - `finmap_empty:(num,(num)excl)finmap`), - FINMAP_DELETE_INSERT); - thm deleted_is_empty = rewrite_rule( - THM_LIST(FINMAP_DELETE_EMPTY), - delete_insert); - thm deleted_validity_eq = ap_term_rule( - `ra_valid - ((gmap_ra (excl_ra:((num)excl)ra)): - ((num,(num)excl)finmap)ra)`, - deleted_is_empty); - thm deleted_valid = eq_mp_rule( - gsym_rule(deleted_validity_eq), - empty_valid); - - thm result = eq_mp_rule( - gsym_rule(insertion), - conj_rule(payload_valid, deleted_valid)); - ENSURE_COND(alpha_compare( - concl(result), - `ra_valid - ((gmap_ra (excl_ra:((num)excl)ra)): - ((num,(num)excl)finmap)ra) - (finmap_insert - (0:num) - (Excl (7:num)) - (finmap_insert - (0:num) - (ExclInvalid:(num)excl) - (finmap_empty: - (num,(num)excl)finmap)))`) == 0, - "overwrite regression proved the wrong map"); - return result; +PROOF static thm gmap_key_at_num(thm theorem) { + type_list variables = term_tyvars(concl(theorem)); + ENSURE_COND(vector_size(variables) == 1, + "expected exactly one remaining key type variable"); + type_pair_list types = (type_pair_list)vector_create(); + vector_add(&types, ((type_pair){`:num`, variables[0]})); + return inst_type_rule(types, theorem); err: - ERR_FUN_PUTS("prove_gmap_valid_overwrite_regression"); + ERR_FUN_PUTS("gmap_key_at_num"); return empty_theorem; } -PROOF static thm prove_gmap_invalid_old_entry_regression(void) { - term old_map = ` - finmap_insert - (0:num) - (ExclInvalid:(num)excl) - (finmap_empty:(num,(num)excl)finmap) - `; - term goal_tm = ` - ~(ra_valid - ((gmap_ra (excl_ra:((num)excl)ra)): - ((num,(num)excl)finmap)ra) - (finmap_insert - (0:num) - (ExclInvalid:(num)excl) - (finmap_empty:(num,(num)excl)finmap))) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = DISCH_TAC(root, "Hold_valid"); - thm invalid_lookup_valid = mp_rule( - ispecl_rule( - TERM_LIST( - `excl_ra:((num)excl)ra`, - `0:num`, - `ExclInvalid:(num)excl`, - old_map), - GMAP_RA_VALID_LOOKUP), - assume_rule(` - ra_valid - ((gmap_ra (excl_ra:((num)excl)ra)): - ((num,(num)excl)finmap)ra) - (finmap_insert - (0:num) - (ExclInvalid:(num)excl) - (finmap_empty:(num,(num)excl)finmap)) - `)); - invalid_lookup_valid = mp_rule( - invalid_lookup_valid, - ispecl_rule( - TERM_LIST( - `0:num`, - `ExclInvalid:(num)excl`, - `finmap_empty:(num,(num)excl)finmap`), - FINMAP_INSERT_LOOKUP_EQ)); - ACCEPT_TAC( - body, - not_elim_rule(EXCL_RA_INVALID, invalid_lookup_valid)); - return gnode_prove(root); +PROOF static thm ra_at_num_excl_map(thm theorem) { + type_list variables = term_tyvars(concl(theorem)); + ENSURE_COND(vector_size(variables) == 1, + "expected exactly one RA carrier type variable"); + type_pair_list types = (type_pair_list)vector_create(); + vector_add( + &types, + ((type_pair){`:(num,(num)excl)finmap`, variables[0]})); + return inst_type_rule(types, theorem); +err: + ERR_FUN_PUTS("ra_at_num_excl_map"); + return empty_theorem; } -PROOF static int audit_gmap_regressions(void) { +PROOF static int audit_gmap_v2_regressions(void) { term R = `excl_ra:((num)excl)ra`; term key = `key:num`; - term other = `other:num`; term a = `a:(num)excl`; term f = `f:(num)excl`; term b = `b:(num)excl`; @@ -151,496 +59,176 @@ PROOF static int audit_gmap_regressions(void) { term n = `n:(num,(num)excl)finmap`; term P = `P:(num)excl->bool`; term candidates = `candidates:num->bool`; - term forbidden = `forbidden:num->bool`; term payload = `payload:num->(num)excl`; + term forbidden = `forbidden:num->bool`; check_gmap_theorem( - ispecl_rule( - TERM_LIST(candidates, m, n), - FINMAP_FRESH_IN_PAIR), - `INFINITE (candidates:num->bool) ==> - exists fresh:num. - fresh IN candidates && - finmap_lookup - (m:(num,(num)excl)finmap) - fresh == NONE && - finmap_lookup - (n:(num,(num)excl)finmap) - fresh == NONE`, - "FINMAP_FRESH_IN_PAIR"); + gmap_key_at_num(ispec_rule(R, GMAP_RA_UNIT)), + `ra_unit + (gmap_ra (excl_ra:((num)excl)ra)) == + (finmap_empty:(num,(num)excl)finmap)`, + "GMAP_RA_UNIT"); check_gmap_theorem( - ispecl_rule( - TERM_LIST(other, key, a, m), - FINMAP_DELETE_INSERT_NE), - `~((other:num) == (key:num)) ==> - finmap_delete - other - (finmap_insert - key - (a:(num)excl) - (m:(num,(num)excl)finmap)) == - finmap_insert key a (finmap_delete other m)`, - "FINMAP_DELETE_INSERT_NE"); - - check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, key, a, m), - GMAP_RA_SINGLETON_OP_DELETE), - `ra_op + ispecl_rule(TERM_LIST(R, key, a), GMAP_RA_VALID_SINGLETON), + `ra_valid (gmap_ra (excl_ra:((num)excl)ra)) - (finmap_singleton (key:num) (a:(num)excl)) - (finmap_delete key (m:(num,(num)excl)finmap)) == - finmap_insert key a m`, - "GMAP_RA_SINGLETON_OP_DELETE"); + (finmap_singleton (key:num) (a:(num)excl)) <=> + ra_valid (excl_ra:((num)excl)ra) a`, + "GMAP_RA_VALID_SINGLETON"); check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, key, a, f, m), - GMAP_RA_OP_SINGLETON_AT), + ispecl_rule(TERM_LIST(R, key, a, m), GMAP_RA_DECOMPOSE), `finmap_lookup (m:(num,(num)excl)finmap) (key:num) == SOME (a:(num)excl) ==> + m == ra_op (gmap_ra (excl_ra:((num)excl)ra)) - m - (finmap_singleton key (f:(num)excl)) == - finmap_insert - key - (ra_op - (excl_ra:((num)excl)ra) - a - f) - m`, - "GMAP_RA_OP_SINGLETON_AT"); - - check_gmap_theorem( - ispecl_rule(TERM_LIST(R, key, m), GMAP_RA_VALID_LOOKUP_DELETE), - `ra_valid - (gmap_ra (excl_ra:((num)excl)ra)) - (m:(num,(num)excl)finmap) <=> - ra_valid - (option_ra (excl_ra:((num)excl)ra)) - (finmap_lookup m (key:num)) && - ra_valid - (gmap_ra (excl_ra:((num)excl)ra)) - (finmap_delete key m)`, - "GMAP_RA_VALID_LOOKUP_DELETE"); - check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, key, a, m), - GMAP_RA_VALID_DELETE_SOME), - `finmap_lookup - (m:(num,(num)excl)finmap) - (key:num) == SOME (a:(num)excl) ==> - (ra_valid - (gmap_ra (excl_ra:((num)excl)ra)) - m <=> - ra_valid (excl_ra:((num)excl)ra) a && - ra_valid - (gmap_ra (excl_ra:((num)excl)ra)) - (finmap_delete key m))`, - "GMAP_RA_VALID_DELETE_SOME"); - check_gmap_theorem( - ispecl_rule(TERM_LIST(R, key, a, m), GMAP_RA_VALID_LOOKUP), - `ra_valid - (gmap_ra (excl_ra:((num)excl)ra)) - (m:(num,(num)excl)finmap) ==> - finmap_lookup m (key:num) == SOME (a:(num)excl) ==> - ra_valid (excl_ra:((num)excl)ra) a`, - "GMAP_RA_VALID_LOOKUP"); - check_gmap_theorem( - ispecl_rule(TERM_LIST(R, key, a, m), GMAP_RA_VALID_INSERT), - `ra_valid - (gmap_ra (excl_ra:((num)excl)ra)) - (finmap_insert - (key:num) - (a:(num)excl) - (m:(num,(num)excl)finmap)) <=> - ra_valid (excl_ra:((num)excl)ra) a && - ra_valid - (gmap_ra (excl_ra:((num)excl)ra)) + (finmap_singleton key a) (finmap_delete key m)`, - "GMAP_RA_VALID_INSERT"); - check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, key, a, m), - GMAP_RA_VALID_INSERT_OF_VALID), - `ra_valid (excl_ra:((num)excl)ra) (a:(num)excl) ==> - ra_valid - (gmap_ra (excl_ra:((num)excl)ra)) - (m:(num,(num)excl)finmap) ==> - ra_valid - (gmap_ra (excl_ra:((num)excl)ra)) - (finmap_insert (key:num) a m)`, - "GMAP_RA_VALID_INSERT_OF_VALID"); - check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, key, a, m), - GMAP_RA_VALID_INSERT_FRESH), - `finmap_lookup - (m:(num,(num)excl)finmap) - (key:num) == NONE ==> - (ra_valid - (gmap_ra (excl_ra:((num)excl)ra)) - (finmap_insert key (a:(num)excl) m) <=> - ra_valid (excl_ra:((num)excl)ra) a && - ra_valid - (gmap_ra (excl_ra:((num)excl)ra)) - m)`, - "GMAP_RA_VALID_INSERT_FRESH"); - check_gmap_theorem( - ispecl_rule(TERM_LIST(R, key, m), GMAP_RA_VALID_DELETE), - `ra_valid - (gmap_ra (excl_ra:((num)excl)ra)) - (m:(num,(num)excl)finmap) ==> - ra_valid - (gmap_ra (excl_ra:((num)excl)ra)) - (finmap_delete (key:num) m)`, - "GMAP_RA_VALID_DELETE"); + "GMAP_RA_DECOMPOSE"); + check_gmap_theorem( - ispecl_rule(TERM_LIST(R, key, m), GMAP_RA_INCLUDED_DELETE), + ispecl_rule(TERM_LIST(R, m, n), GMAP_RA_INCLUDED_LOOKUP_IFF), `ra_included (gmap_ra (excl_ra:((num)excl)ra)) - (finmap_delete - (key:num) - (m:(num,(num)excl)finmap)) - m`, - "GMAP_RA_INCLUDED_DELETE"); - check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, key, a, b, m), - GMAP_RA_UPDATE_INSERT), - `ra_update - (excl_ra:((num)excl)ra) - (a:(num)excl) - (b:(num)excl) ==> - ra_update - (gmap_ra (excl_ra:((num)excl)ra)) - (finmap_insert - (key:num) - a - (m:(num,(num)excl)finmap)) - (finmap_insert key b m)`, - "GMAP_RA_UPDATE_INSERT"); - check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, key, a, f, b, g), - GMAP_RA_LOCAL_UPDATE_SINGLETON), - `ra_local_update - (excl_ra:((num)excl)ra) - ((a:(num)excl),(f:(num)excl)) - ((b:(num)excl),(g:(num)excl)) ==> - ra_local_update - (gmap_ra (excl_ra:((num)excl)ra)) - (finmap_singleton (key:num) a, - finmap_singleton key f) - (finmap_singleton key b, - finmap_singleton key g)`, - "GMAP_RA_LOCAL_UPDATE_SINGLETON"); - check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, key, a, f, b, g), - GMAP_RA_LOCAL_UPDATE_SINGLETON_IFF), - `ra_local_update - (gmap_ra (excl_ra:((num)excl)ra)) - (finmap_singleton (key:num) (a:(num)excl), - finmap_singleton key (f:(num)excl)) - (finmap_singleton key (b:(num)excl), - finmap_singleton key (g:(num)excl)) <=> - ra_local_update - (excl_ra:((num)excl)ra) - (a,f) - (b,g)`, - "GMAP_RA_LOCAL_UPDATE_SINGLETON_IFF"); + (m:(num,(num)excl)finmap) + (n:(num,(num)excl)finmap) <=> + forall query:num. + ra_included + (option_ra (excl_ra:((num)excl)ra)) + (finmap_lookup m query) + (finmap_lookup n query)`, + "GMAP_RA_INCLUDED_LOOKUP_IFF"); + check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, key, a, f, b, g, m), - GMAP_RA_LOCAL_UPDATE_AT), + ispecl_rule(TERM_LIST(R, key, a, f, b, g, m), + GMAP_RA_LOCAL_UPDATE_AT), `finmap_lookup (m:(num,(num)excl)finmap) (key:num) == SOME (a:(num)excl) ==> ra_local_update (excl_ra:((num)excl)ra) - ((a:(num)excl),(f:(num)excl)) - ((b:(num)excl),(g:(num)excl)) ==> + a (f:(num)excl) (b:(num)excl) (g:(num)excl) ==> ra_local_update (gmap_ra (excl_ra:((num)excl)ra)) - (m,finmap_singleton key f) - (finmap_insert key b m,finmap_singleton key g)`, + m + (finmap_singleton key f) + (finmap_insert key b m) + (finmap_singleton key g)`, "GMAP_RA_LOCAL_UPDATE_AT"); + check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, key, a, f, b, g, m), - GMAP_RA_LOCAL_UPDATE_AT_IFF), - `finmap_lookup - (m:(num,(num)excl)finmap) - (key:num) == SOME (a:(num)excl) ==> - (ra_local_update - (gmap_ra (excl_ra:((num)excl)ra)) - (m,finmap_singleton key (f:(num)excl)) - (finmap_insert key (b:(num)excl) m, - finmap_singleton key (g:(num)excl)) <=> - (ra_valid - (gmap_ra (excl_ra:((num)excl)ra)) - m ==> - ra_local_update - (excl_ra:((num)excl)ra) - (a,f) - (b,g)))`, - "GMAP_RA_LOCAL_UPDATE_AT_IFF"); - check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, key, a, b), - GMAP_RA_UPDATE_SINGLETON_IFF), - `ra_update - (gmap_ra (excl_ra:((num)excl)ra)) - (finmap_singleton (key:num) (a:(num)excl)) - (finmap_singleton key (b:(num)excl)) <=> - ra_update - (excl_ra:((num)excl)ra) - a - b`, - "GMAP_RA_UPDATE_SINGLETON_IFF"); - check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, key, a, b, m), - GMAP_RA_UPDATE_AT), + ispecl_rule(TERM_LIST(R, key, a, b, m), GMAP_RA_UPDATE_AT), `finmap_lookup (m:(num,(num)excl)finmap) (key:num) == SOME (a:(num)excl) ==> ra_update (excl_ra:((num)excl)ra) - a - (b:(num)excl) ==> + a (b:(num)excl) ==> ra_update (gmap_ra (excl_ra:((num)excl)ra)) m (finmap_insert key b m)`, "GMAP_RA_UPDATE_AT"); + check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, key, a, b, m), - GMAP_RA_UPDATE_AT_IFF), + ispecl_rule(TERM_LIST(R, key, a, P, m), GMAP_RA_UPDATEP_AT), `finmap_lookup (m:(num,(num)excl)finmap) (key:num) == SOME (a:(num)excl) ==> - (ra_update - (gmap_ra (excl_ra:((num)excl)ra)) - m - (finmap_insert key (b:(num)excl) m) <=> - (ra_valid - (gmap_ra (excl_ra:((num)excl)ra)) - m ==> - ra_update - (excl_ra:((num)excl)ra) - a - b))`, - "GMAP_RA_UPDATE_AT_IFF"); - check_gmap_theorem( - ispecl_rule(TERM_LIST(R, key, m), GMAP_RA_UPDATE_DELETE), - `ra_update - (gmap_ra (excl_ra:((num)excl)ra)) - (m:(num,(num)excl)finmap) - (finmap_delete (key:num) m)`, - "GMAP_RA_UPDATE_DELETE"); - check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, key, a, P, m), - GMAP_RA_UPDATE_INSERT_ND), - `ra_update_nd + ra_updateP (excl_ra:((num)excl)ra) - (a:(num)excl) - (P:(num)excl->bool) ==> - ra_update_nd - (gmap_ra (excl_ra:((num)excl)ra)) - (finmap_insert - (key:num) - a - (m:(num,(num)excl)finmap)) - (\result:(num,(num)excl)finmap. - exists selected:(num)excl. - P selected && - result == finmap_insert key selected m)`, - "GMAP_RA_UPDATE_INSERT_ND"); - check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, key, a, P), - GMAP_RA_UPDATE_SINGLETON_ND_IFF), - `ra_update_nd - (gmap_ra (excl_ra:((num)excl)ra)) - (finmap_singleton (key:num) (a:(num)excl)) - (\result:(num,(num)excl)finmap. - exists selected:(num)excl. - P selected && - result == finmap_singleton key selected) <=> - ra_update_nd - (excl_ra:((num)excl)ra) - a - (P:(num)excl->bool)`, - "GMAP_RA_UPDATE_SINGLETON_ND_IFF"); - check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, key, a, P, m), - GMAP_RA_UPDATE_AT_ND), - `finmap_lookup - (m:(num,(num)excl)finmap) - (key:num) == SOME (a:(num)excl) ==> - ra_update_nd - (excl_ra:((num)excl)ra) - a - (P:(num)excl->bool) ==> - ra_update_nd + a (P:(num)excl->bool) ==> + ra_updateP (gmap_ra (excl_ra:((num)excl)ra)) m (\result:(num,(num)excl)finmap. exists selected:(num)excl. P selected && result == finmap_insert key selected m)`, - "GMAP_RA_UPDATE_AT_ND"); + "GMAP_RA_UPDATEP_AT"); + + /* Drop only removes this fragment's binding. It has no freshness premise + * and makes no claim that this name remains unavailable to later allocs. */ check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, key, a, P, m), - GMAP_RA_UPDATE_AT_ND_IFF), - `finmap_lookup + ispecl_rule(TERM_LIST(R, key, m), GMAP_RA_DROP_AT), + `ra_update + (gmap_ra (excl_ra:((num)excl)ra)) (m:(num,(num)excl)finmap) - (key:num) == SOME (a:(num)excl) ==> - (ra_update_nd - (gmap_ra (excl_ra:((num)excl)ra)) - m - (\result:(num,(num)excl)finmap. - exists selected:(num)excl. - P selected && - result == finmap_insert key selected m) <=> - (ra_valid - (gmap_ra (excl_ra:((num)excl)ra)) - m ==> - ra_update_nd - (excl_ra:((num)excl)ra) - a - (P:(num)excl->bool)))`, - "GMAP_RA_UPDATE_AT_ND_IFF"); + (finmap_delete (key:num) m)`, + "GMAP_RA_DROP_AT"); + + /* The existential result is inside the universal frame quantifier. This + * is the semantic regression that permits allocation's chosen fresh key to + * depend on the hidden frame. */ + check_gmap_theorem( + ra_at_num_excl_map(ra_updateP_def), + `ra_updateP + (R:((num,(num)excl)finmap)ra) + (a:(num,(num)excl)finmap) + (result:(num,(num)excl)finmap->bool) <=> + forall frame:(num,(num)excl)finmap. + ra_valid + R + (ra_op + R + a frame) ==> + exists selected:(num,(num)excl)finmap. + result selected && + ra_valid + R + (ra_op + R + selected frame)`, + "ra_updateP witness is frame dependent"); + check_gmap_theorem( ispecl_rule( TERM_LIST(R, candidates, payload, m), GMAP_RA_ALLOC_STRONG_DEP), `INFINITE (candidates:num->bool) ==> - (forall fresh:num. - fresh IN candidates ==> + (forall candidate:num. + candidate IN candidates ==> finmap_lookup (m:(num,(num)excl)finmap) - fresh == NONE ==> + candidate == NONE ==> ra_valid (excl_ra:((num)excl)ra) - ((payload:num->(num)excl) fresh)) ==> - ra_update_nd + ((payload:num->(num)excl) candidate)) ==> + ra_updateP (gmap_ra (excl_ra:((num)excl)ra)) m (\result:(num,(num)excl)finmap. - exists fresh:num. - fresh IN candidates && - finmap_lookup m fresh == NONE && + exists candidate:num. + candidate IN candidates && + finmap_lookup m candidate == NONE && result == - finmap_insert fresh (payload fresh) m)`, + finmap_insert candidate (payload candidate) m)`, "GMAP_RA_ALLOC_STRONG_DEP"); + check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, candidates, m, a), - GMAP_RA_ALLOC_STRONG), - `INFINITE (candidates:num->bool) ==> - ra_valid - (excl_ra:((num)excl)ra) - (a:(num)excl) ==> - ra_update_nd - (gmap_ra (excl_ra:((num)excl)ra)) - m - (\result:(num,(num)excl)finmap. - exists fresh:num. - fresh IN candidates && - finmap_lookup m fresh == NONE && - result == finmap_insert fresh a m)`, - "GMAP_RA_ALLOC_STRONG"); - check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, m, a), - GMAP_RA_ALLOC), - `INFINITE (UNIV:num->bool) ==> - ra_valid - (excl_ra:((num)excl)ra) - (a:(num)excl) ==> - ra_update_nd - (gmap_ra (excl_ra:((num)excl)ra)) - m - (\result:(num,(num)excl)finmap. - exists fresh:num. - finmap_lookup m fresh == NONE && - result == finmap_insert fresh a m)`, - "GMAP_RA_ALLOC"); - check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, forbidden, m, a), - GMAP_RA_ALLOC_COFINITE), + ispecl_rule(TERM_LIST(R, forbidden, m, a), + GMAP_RA_ALLOC_COFINITE), `INFINITE (UNIV:num->bool) ==> FINITE (forbidden:num->bool) ==> - ra_valid - (excl_ra:((num)excl)ra) - (a:(num)excl) ==> - ra_update_nd - (gmap_ra (excl_ra:((num)excl)ra)) - m - (\result:(num,(num)excl)finmap. - exists fresh:num. - ~(fresh IN forbidden) && - finmap_lookup m fresh == NONE && - result == finmap_insert fresh a m)`, - "GMAP_RA_ALLOC_COFINITE"); - check_gmap_theorem( - ispecl_rule( - TERM_LIST(R, a), - GMAP_RA_ALLOC_EMPTY), - `INFINITE (UNIV:K->bool) ==> - ra_valid - (excl_ra:((num)excl)ra) - (a:(num)excl) ==> - ra_update_nd - (gmap_ra (excl_ra:((num)excl)ra)) - (finmap_empty:(K,(num)excl)finmap) - (\result:(K,(num)excl)finmap. - exists fresh:K. - result == finmap_singleton fresh a)`, - "GMAP_RA_ALLOC_EMPTY"); - - thm concrete_alloc = mp_rule( - mp_rule( - ispecl_rule( - TERM_LIST( - R, - m, - `Excl (7:num)`), - GMAP_RA_ALLOC), - get_theorem_by_name("num_INFINITE")), - ispec_rule(`7:num`, EXCL_RA_VALID_OWNED)); - check_gmap_theorem( - concrete_alloc, - `ra_update_nd + ra_valid (excl_ra:((num)excl)ra) (a:(num)excl) ==> + ra_updateP (gmap_ra (excl_ra:((num)excl)ra)) (m:(num,(num)excl)finmap) (\result:(num,(num)excl)finmap. - exists fresh:num. - finmap_lookup m fresh == NONE && - result == finmap_insert fresh (Excl (7:num)) m)`, - "GMAP_RA_ALLOC[num]"); + exists candidate:num. + ~(candidate IN forbidden) && + finmap_lookup m candidate == NONE && + result == finmap_insert candidate a m)`, + "GMAP_RA_ALLOC_COFINITE"); - thm overwrite = prove_gmap_valid_overwrite_regression(); - ENSURE_COND(!IS_NULL(overwrite) && vector_size(hyp(overwrite)) == 0, - "valid overwrite regression failed"); - thm old_invalid = prove_gmap_invalid_old_entry_regression(); - ENSURE_COND(!IS_NULL(old_invalid) && vector_size(hyp(old_invalid)) == 0, - "invalid overwritten entry regression failed"); return 0; err: - ERR_FUN_PUTS("audit_gmap_regressions"); + ERR_FUN_PUTS("audit_gmap_v2_regressions"); return -1; } -PROOF static int _GMAP_RA_REGRESSION = audit_gmap_regressions(); +PROOF static int _GMAP_RA_V2_REGRESSION = + audit_gmap_v2_regressions(); diff --git a/test/named_ra_regression.c b/test/named_ra_regression.c new file mode 100644 index 0000000..7dd0deb --- /dev/null +++ b/test/named_ra_regression.c @@ -0,0 +1,241 @@ +#include "proof/theory/logic/excl_ra.h" +#include "proof/theory/logic/named_logic.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/excl_ra.c" +#require "proof/theory/logic/named_logic.c" + +/* The named layer is intentionally just the numeric specialization of gmap, + * exposed through exact singleton ownership. */ +PROOF static void check_named_theorem( + const thm theorem, + const term expected, + const char *label) { + ENSURE_COND(!IS_NULL(theorem), "%s is empty", label); + ENSURE_COND(vector_size(hyp(theorem)) == 0, + "%s unexpectedly has hypotheses", label); + ENSURE_COND(alpha_compare(concl(theorem), expected) == 0, + "%s has the wrong conclusion", label); + return; +err: + ERR_FUN_PUTS("check_named_theorem", label); +} + +PROOF static thm named_at_num_excl(thm theorem) { + type_list variables = term_tyvars(concl(theorem)); + ENSURE_COND(vector_size(variables) == 1, + "expected exactly one named payload type variable"); + type_pair_list types = (type_pair_list)vector_create(); + vector_add(&types, ((type_pair){`:(num)excl`, variables[0]})); + return inst_type_rule(types, theorem); +err: + ERR_FUN_PUTS("named_at_num_excl"); + return empty_theorem; +} + +PROOF static int audit_named_v2_regressions(void) { + term R = `excl_ra:((num)excl)ra`; + term name = `name:num`; + term a = `a:(num)excl`; + term b = `b:(num)excl`; + term P = `P:(num)excl->bool`; + term m = `m:(num,(num)excl)finmap`; + term assertion = `Q:(num,(num)excl)finmap->bool`; + + check_named_theorem( + ispec_rule(R, NAMED_RA_UNIT), + `ra_unit (named_ra (excl_ra:((num)excl)ra)) == + (finmap_empty:(num,(num)excl)finmap)`, + "NAMED_RA_UNIT"); + + check_named_theorem( + ispecl_rule(TERM_LIST(R, name, a, b), NAMED_RA_SINGLETON_OP), + `ra_op + (named_ra (excl_ra:((num)excl)ra)) + (finmap_singleton (name:num) (a:(num)excl)) + (finmap_singleton name (b:(num)excl)) == + finmap_singleton + name + (ra_op (excl_ra:((num)excl)ra) a b)`, + "NAMED_RA_SINGLETON_OP"); + + check_named_theorem( + ispecl_rule(TERM_LIST(R, name, a), NAMED_RA_VALID_SINGLETON), + `ra_valid + (named_ra (excl_ra:((num)excl)ra)) + (finmap_singleton (name:num) (a:(num)excl)) <=> + ra_valid (excl_ra:((num)excl)ra) a`, + "NAMED_RA_VALID_SINGLETON"); + + check_named_theorem( + ispecl_rule(TERM_LIST(R, name, a, b), NAMED_RA_UPDATE_SINGLETON), + `ra_update + (excl_ra:((num)excl)ra) + (a:(num)excl) + (b:(num)excl) ==> + ra_update + (named_ra (excl_ra:((num)excl)ra)) + (finmap_singleton (name:num) a) + (finmap_singleton name b)`, + "NAMED_RA_UPDATE_SINGLETON"); + + check_named_theorem( + ispecl_rule( + TERM_LIST(R, name, a, P), + NAMED_RA_UPDATEP_SINGLETON), + `ra_updateP + (excl_ra:((num)excl)ra) + (a:(num)excl) + (P:(num)excl->bool) ==> + ra_updateP + (named_ra (excl_ra:((num)excl)ra)) + (finmap_singleton (name:num) a) + (\result:(num,(num)excl)finmap. + exists selected:(num)excl. + P selected && + result == finmap_singleton name selected)`, + "NAMED_RA_UPDATEP_SINGLETON"); + + /* Dropping ownership produces the unit. There is intentionally no + * persistent tombstone or freshness conclusion. */ + check_named_theorem( + ispecl_rule(TERM_LIST(R, name, a), NAMED_RA_DROP), + `ra_update + (named_ra (excl_ra:((num)excl)ra)) + (finmap_singleton (name:num) (a:(num)excl)) + (finmap_empty:(num,(num)excl)finmap)`, + "NAMED_RA_DROP"); + + check_named_theorem( + ispecl_rule(TERM_LIST(R, m, a), NAMED_RA_ALLOC), + `ra_valid + (excl_ra:((num)excl)ra) + (a:(num)excl) ==> + ra_updateP + (named_ra (excl_ra:((num)excl)ra)) + (m:(num,(num)excl)finmap) + (\result:(num,(num)excl)finmap. + exists allocated:num. + finmap_lookup m allocated == NONE && + result == finmap_insert allocated a m)`, + "NAMED_RA_ALLOC"); + + check_named_theorem( + named_at_num_excl(named_own_def), + `named_own + (R:((num)excl)ra) + (name:num) + (a:(num)excl) == + r_own + (named_ra R) + (finmap_singleton name a)`, + "named_own_def"); + + check_named_theorem( + ispecl_rule(TERM_LIST(R, name, a, b), NAMED_OWN_OP), + `r_equiv + (named_ra (excl_ra:((num)excl)ra)) + (named_own + (excl_ra:((num)excl)ra) + (name:num) + (ra_op + (excl_ra:((num)excl)ra) + (a:(num)excl) + (b:(num)excl))) + (r_sep + (named_ra (excl_ra:((num)excl)ra)) + (named_own (excl_ra:((num)excl)ra) name a) + (named_own (excl_ra:((num)excl)ra) name b))`, + "NAMED_OWN_OP"); + + check_named_theorem( + ispecl_rule(TERM_LIST(R, name, a), NAMED_OWN_VALID), + `r_entails + (named_ra (excl_ra:((num)excl)ra)) + (named_own + (excl_ra:((num)excl)ra) + (name:num) + (a:(num)excl)) + (r_sep + (named_ra (excl_ra:((num)excl)ra)) + (r_fact + (named_ra (excl_ra:((num)excl)ra)) + (ra_valid (excl_ra:((num)excl)ra) a)) + (named_own (excl_ra:((num)excl)ra) name a))`, + "NAMED_OWN_VALID uses fact"); + + check_named_theorem( + ispecl_rule(TERM_LIST(R, name, a, b), NAMED_OWN_UPDATE), + `ra_update + (excl_ra:((num)excl)ra) + (a:(num)excl) + (b:(num)excl) ==> + r_viewshift + (named_ra (excl_ra:((num)excl)ra)) + (named_own (excl_ra:((num)excl)ra) (name:num) a) + (named_own (excl_ra:((num)excl)ra) name b)`, + "NAMED_OWN_UPDATE"); + + check_named_theorem( + ispecl_rule(TERM_LIST(R, name, a, P), NAMED_OWN_UPDATEP), + `ra_updateP + (excl_ra:((num)excl)ra) + (a:(num)excl) + (P:(num)excl->bool) ==> + r_viewshift + (named_ra (excl_ra:((num)excl)ra)) + (named_own (excl_ra:((num)excl)ra) (name:num) a) + (r_exists + (named_ra (excl_ra:((num)excl)ra)) + (\selected:(num)excl. + r_sep + (named_ra (excl_ra:((num)excl)ra)) + (r_fact + (named_ra (excl_ra:((num)excl)ra)) + (P selected)) + (named_own + (excl_ra:((num)excl)ra) + name + selected)))`, + "NAMED_OWN_UPDATEP uses fact"); + + check_named_theorem( + ispecl_rule(TERM_LIST(R, name, a), NAMED_OWN_DROP), + `r_viewshift + (named_ra (excl_ra:((num)excl)ra)) + (named_own + (excl_ra:((num)excl)ra) + (name:num) + (a:(num)excl)) + (r_emp (named_ra (excl_ra:((num)excl)ra)))`, + "NAMED_OWN_DROP"); + + check_named_theorem( + ispecl_rule(TERM_LIST(R, a, assertion), NAMED_OWN_ALLOC), + `ra_valid + (excl_ra:((num)excl)ra) + (a:(num)excl) ==> + r_viewshift + (named_ra (excl_ra:((num)excl)ra)) + (Q:(num,(num)excl)finmap->bool) + (r_exists + (named_ra (excl_ra:((num)excl)ra)) + (\allocated:num. + r_sep + (named_ra (excl_ra:((num)excl)ra)) + (named_own + (excl_ra:((num)excl)ra) + allocated + a) + Q))`, + "NAMED_OWN_ALLOC"); + + return 0; +err: + ERR_FUN_PUTS("audit_named_v2_regressions"); + return -1; +} + +PROOF static int _NAMED_V2_REGRESSION = + audit_named_v2_regressions(); diff --git a/test/ra_core_regression.c b/test/ra_core_regression.c index 9c389d3..511c4ff 100644 --- a/test/ra_core_regression.c +++ b/test/ra_core_regression.c @@ -1,11 +1,11 @@ #include "proof/theory/logic/ra.h" +#include "proof/theory/logic/local_update.h" #include "proof/proof_backward.h" #require "proof/proof_backward.c" #require "proof/theory/logic/ra.c" +#require "proof/theory/logic/local_update.c" -/* Exact-contract coverage for the core rules whose shape is especially - * important to goal-directed automation and constructor proofs. */ PROOF static void check_ra_core_theorem( const thm theorem, const term expected, @@ -20,102 +20,270 @@ err: ERR_FUN_PUTS("check_ra_core_theorem", label); } +PROOF static thm ra_core_at_num(thm theorem) { + type_list variables = term_tyvars(concl(theorem)); + ENSURE_COND(vector_size(variables) == 1, + "expected exactly one carrier type variable"); + type_pair_list types = (type_pair_list)vector_create(); + vector_add(&types, ((type_pair){`:num`, variables[0]})); + return inst_type_rule(types, theorem); +err: + ERR_FUN_PUTS("ra_core_at_num"); + return empty_theorem; +} + +/* A v2-exclusive source is valid by construction. */ +PROOF static thm prove_exclusive_source_valid(void) { + term goal_tm = ` + forall (R:(num)ra) (a:num). + ra_exclusive R a ==> ra_valid R a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm exclusive = rewrite_rule( + THM_LIST(ra_exclusive_def), + assume_rule(`ra_exclusive (R:(num)ra) (a:num)`)); + ACCEPT_TAC(body, conjunct1_rule(exclusive)); + return gnode_prove(root); +} + +/* Regression against the removed invalid-source vacuity of exclusivity. */ +PROOF static thm prove_invalid_source_not_exclusive(void) { + term goal_tm = ` + forall (R:(num)ra) (a:num). + ~(ra_valid R a) ==> ~(ra_exclusive R a) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm exclusive = rewrite_rule( + THM_LIST(ra_exclusive_def), + assume_rule(`ra_exclusive (R:(num)ra) (a:num)`)); + CONTR_TAC( + body, + not_elim_rule( + assume_rule(`~(ra_valid (R:(num)ra) (a:num))`), + conjunct1_rule(exclusive))); + return gnode_prove(root); +} + PROOF static int audit_ra_core_regressions(void) { term R = `R:(num)ra`; term a = `a:num`; term b = `b:num`; term c = `c:num`; - term frame = `frame:num`; + term d = `d:num`; + term f = `f:num`; + term g = `g:num`; + term h = `h:num`; + term extra = `extra:num`; term P = `P:num->bool`; + term Q = `Q:num->bool`; check_ra_core_theorem( - ispecl_rule(TERM_LIST(R, a, frame), RA_EXCLUSIVE_APPLY), - `ra_exclusive (R:(num)ra) (a:num) ==> - ra_valid R (ra_op R a (frame:num)) ==> - frame == ra_unit R`, - "RA_EXCLUSIVE_APPLY"); + ra_core_at_num(ra_compatible_def), + `ra_compatible (R:(num)ra) (a:num) (b:num) <=> + ra_valid R (ra_op R a b)`, + "ra_compatible_def"); + + check_ra_core_theorem( + ra_core_at_num(ra_included_def), + `ra_included (R:(num)ra) (a:num) (b:num) <=> + exists frame:num. b == ra_op R a frame`, + "ra_included_def"); + + check_ra_core_theorem( + ra_core_at_num(ra_updateP_def), + `ra_updateP (R:(num)ra) (a:num) (result:num->bool) <=> + forall frame:num. + ra_valid R (ra_op R a frame) ==> + exists b:num. result b && ra_valid R (ra_op R b frame)`, + "ra_updateP_def"); + + check_ra_core_theorem( + ra_core_at_num(ra_update_def), + `ra_update (R:(num)ra) (a:num) (b:num) <=> + ra_updateP R a (\x:num. x == b)`, + "ra_update_def"); + + check_ra_core_theorem( + ra_core_at_num(ra_exclusive_def), + `ra_exclusive (R:(num)ra) (a:num) <=> + ra_valid R a && + (forall frame:num. + ra_valid R (ra_op R a frame) ==> + frame == ra_unit R)`, + "ra_exclusive_def"); + + check_ra_core_theorem( + ispecl_rule(TERM_LIST(R, a, b), RA_COMPAT_COMM), + `ra_compatible (R:(num)ra) (a:num) (b:num) <=> + ra_compatible R b a`, + "RA_COMPAT_COMM"); + + check_ra_core_theorem( + ispecl_rule(TERM_LIST(R, a), RA_COMPAT_UNIT), + `ra_compatible (R:(num)ra) (a:num) (ra_unit R) <=> + ra_valid R a`, + "RA_COMPAT_UNIT"); + + check_ra_core_theorem( + ispecl_rule(TERM_LIST(R, a, b), RA_UPDATEP_SINGLETON), + `ra_updateP (R:(num)ra) (a:num) (\x:num. x == b) <=> + ra_update R a (b:num)`, + "RA_UPDATEP_SINGLETON"); + + check_ra_core_theorem( + ispecl_rule(TERM_LIST(R, a, P, Q), RA_UPDATEP_MONO), + `ra_updateP (R:(num)ra) (a:num) (P:num->bool) ==> + (forall b:num. P b ==> Q b) ==> + ra_updateP R a Q`, + "RA_UPDATEP_MONO"); + + check_ra_core_theorem( + ispecl_rule(TERM_LIST(R, a, P, Q), RA_UPDATEP_TRANS), + `ra_updateP (R:(num)ra) (a:num) (P:num->bool) ==> + (forall b:num. P b ==> ra_updateP R b Q) ==> + ra_updateP R a Q`, + "RA_UPDATEP_TRANS"); check_ra_core_theorem( - ispecl_rule(TERM_LIST(R, a, b, frame), RA_UPDATE_APPLY), + ispecl_rule(TERM_LIST(R, a, P, extra), RA_UPDATEP_FRAME), + `ra_updateP (R:(num)ra) (a:num) (P:num->bool) ==> + ra_updateP R (ra_op R a (extra:num)) + (\x:num. exists b:num. P b && x == ra_op R b extra)`, + "RA_UPDATEP_FRAME"); + + check_ra_core_theorem( + ispecl_rule(TERM_LIST(R, a, c, P, Q), RA_UPDATEP_OP), + `ra_updateP (R:(num)ra) (a:num) (P:num->bool) ==> + ra_updateP R (c:num) (Q:num->bool) ==> + ra_updateP R (ra_op R a c) + (\x:num. + exists b d:num. + P b && Q d && x == ra_op R b d)`, + "RA_UPDATEP_OP"); + + check_ra_core_theorem( + ispecl_rule(TERM_LIST(R, a, b, extra), RA_UPDATE_FRAME), + `ra_update (R:(num)ra) (a:num) (b:num) ==> + ra_update R (ra_op R a (extra:num)) (ra_op R b extra)`, + "RA_UPDATE_FRAME"); + + check_ra_core_theorem( + ispecl_rule(TERM_LIST(R, a, b, c, d), RA_UPDATE_OP), `ra_update (R:(num)ra) (a:num) (b:num) ==> - ra_valid R (ra_op R a (frame:num)) ==> - ra_valid R (ra_op R b frame)`, - "RA_UPDATE_APPLY"); + ra_update R (c:num) (d:num) ==> + ra_update R (ra_op R a c) (ra_op R b d)`, + "RA_UPDATE_OP"); + + check_ra_core_theorem( + ispecl_rule(TERM_LIST(R, a, b), RA_EXCLUSIVE_UPDATE), + `ra_exclusive (R:(num)ra) (a:num) ==> + ra_valid R (b:num) ==> + ra_update R a b`, + "RA_EXCLUSIVE_UPDATE"); + + check_ra_core_theorem( + prove_exclusive_source_valid(), + `forall (R:(num)ra) (a:num). + ra_exclusive R a ==> ra_valid R a`, + "exclusive source validity"); + + check_ra_core_theorem( + prove_invalid_source_not_exclusive(), + `forall (R:(num)ra) (a:num). + ~(ra_valid R a) ==> ~(ra_exclusive R a)`, + "invalid source is not exclusive"); check_ra_core_theorem( - ispecl_rule(TERM_LIST(R, a, P, frame), RA_UPDATE_ND_APPLY), - `ra_update_nd (R:(num)ra) (a:num) (P:num->bool) ==> - ra_valid R (ra_op R a (frame:num)) ==> - exists b:num. P b && ra_valid R (ra_op R b frame)`, - "RA_UPDATE_ND_APPLY"); + ra_core_at_num(ra_local_update_def), + `ra_local_update (R:(num)ra) (a:num) (f:num) (b:num) (g:num) <=> + forall residual:num. + ra_valid R a ==> + a == ra_op R f residual ==> + ra_valid R b && b == ra_op R g residual`, + "ra_local_update_def"); check_ra_core_theorem( ispecl_rule( - TERM_LIST(R, frame, a, b), - RA_INCLUDED_CANCEL_L), - `ra_cancellative (R:(num)ra) ==> - ra_valid R (ra_op R (frame:num) (b:num)) ==> - ra_included - R - (ra_op R frame (a:num)) - (ra_op R frame b) ==> - ra_included R a b`, - "RA_INCLUDED_CANCEL_L"); + TERM_LIST(R, a, f, b, g, extra), + RA_LOCAL_UPDATE_APPLY), + `ra_local_update (R:(num)ra) (a:num) (f:num) (b:num) (g:num) ==> + ra_valid R a ==> + a == ra_op R f (extra:num) ==> + ra_valid R b && b == ra_op R g extra`, + "RA_LOCAL_UPDATE_APPLY"); check_ra_core_theorem( - ispecl_rule(TERM_LIST(R, a), RA_INVALID_EXCLUSIVE), - `~(ra_valid (R:(num)ra) (a:num)) ==> - ra_exclusive R a`, - "RA_INVALID_EXCLUSIVE"); + ispecl_rule(TERM_LIST(R, a, f), RA_LOCAL_UPDATE_REFL), + `ra_local_update (R:(num)ra) (a:num) (f:num) a f`, + "RA_LOCAL_UPDATE_REFL"); check_ra_core_theorem( ispecl_rule( - TERM_LIST(R, a, frame), - RA_EXCLUSIVE_VALID_OP_IFF), - `ra_exclusive (R:(num)ra) (a:num) ==> - (ra_valid R (ra_op R a (frame:num)) <=> - ra_valid R a && frame == ra_unit R)`, - "RA_EXCLUSIVE_VALID_OP_IFF"); + TERM_LIST(R, a, f, b, g, c, h), + RA_LOCAL_UPDATE_TRANS), + `ra_local_update (R:(num)ra) (a:num) (f:num) (b:num) (g:num) ==> + ra_local_update R b g (c:num) (h:num) ==> + ra_local_update R a f c h`, + "RA_LOCAL_UPDATE_TRANS"); check_ra_core_theorem( - ispecl_rule(TERM_LIST(R, a, P), RA_UPDATE_ND_INVALID), - `~(ra_valid (R:(num)ra) (a:num)) ==> - ra_update_nd R a (P:num->bool)`, - "RA_UPDATE_ND_INVALID"); + ispecl_rule( + TERM_LIST(R, a, f, b, g, extra), + RA_LOCAL_UPDATE_FRAME), + `ra_local_update (R:(num)ra) (a:num) (f:num) (b:num) (g:num) ==> + ra_local_update R a (ra_op R f (extra:num)) b (ra_op R g extra)`, + "RA_LOCAL_UPDATE_FRAME"); check_ra_core_theorem( ispecl_rule( - TERM_LIST(R, a, P), - RA_EXCLUSIVE_UPDATE_ND_IFF), - `ra_exclusive (R:(num)ra) (a:num) ==> - (ra_update_nd R a (P:num->bool) <=> - (ra_valid R a ==> - exists b:num. P b && ra_valid R b))`, - "RA_EXCLUSIVE_UPDATE_ND_IFF"); + TERM_LIST(R, a, f, b, g, extra), + RA_LOCAL_UPDATE_PRESERVES_INCLUDED), + `ra_local_update (R:(num)ra) (a:num) (f:num) (b:num) (g:num) ==> + ra_valid R a ==> + ra_included R (ra_op R f (extra:num)) a ==> + ra_valid R b && ra_included R (ra_op R g extra) b`, + "RA_LOCAL_UPDATE_PRESERVES_INCLUDED"); check_ra_core_theorem( - ispecl_rule(TERM_LIST(R, a, b), RA_UPDATE_INVALID), - `~(ra_valid (R:(num)ra) (a:num)) ==> - ra_update R a (b:num)`, - "RA_UPDATE_INVALID"); + ispecl_rule( + TERM_LIST(R, a, f, extra), + RA_LOCAL_UPDATE_ALLOC), + `ra_valid (R:(num)ra) (ra_op R (a:num) (extra:num)) ==> + ra_local_update R a (f:num) (ra_op R a extra) (ra_op R f extra)`, + "RA_LOCAL_UPDATE_ALLOC"); check_ra_core_theorem( ispecl_rule( - TERM_LIST(R, a, b, c), - RA_UPDATE_TARGET_INCLUDED), - `ra_update (R:(num)ra) (a:num) (b:num) ==> - ra_included R (c:num) b ==> - ra_update R a c`, - "RA_UPDATE_TARGET_INCLUDED"); + TERM_LIST(R, a, f, b), + RA_LOCAL_UPDATE_EXCLUSIVE), + `ra_exclusive (R:(num)ra) (f:num) ==> + ra_valid R (b:num) ==> + ra_local_update R (a:num) f b b`, + "RA_LOCAL_UPDATE_EXCLUSIVE"); check_ra_core_theorem( ispecl_rule( - TERM_LIST(R, a, b), - RA_EXCLUSIVE_UPDATE_IFF), - `ra_exclusive (R:(num)ra) (a:num) ==> - (ra_update R a (b:num) <=> - (ra_valid R a ==> ra_valid R b))`, - "RA_EXCLUSIVE_UPDATE_IFF"); + TERM_LIST(R, extra, a, f), + RA_LOCAL_UPDATE_CANCEL), + `ra_cancellative (R:(num)ra) ==> + ra_local_update R + (ra_op R (extra:num) (a:num)) + (ra_op R extra (f:num)) + a f`, + "RA_LOCAL_UPDATE_CANCEL"); + + check_ra_core_theorem( + ispecl_rule( + TERM_LIST(R, a, b, extra), + RA_LOCAL_UPDATE_CANCELLATIVE), + `ra_cancellative (R:(num)ra) ==> + ra_valid R (ra_op R (b:num) (extra:num)) ==> + ra_local_update R + (ra_op R (a:num) extra) a + (ra_op R b extra) b`, + "RA_LOCAL_UPDATE_CANCELLATIVE"); return 0; } diff --git a/test/sl_v2_regression.c b/test/sl_v2_regression.c new file mode 100644 index 0000000..127b7ee --- /dev/null +++ b/test/sl_v2_regression.c @@ -0,0 +1,150 @@ +#include "proof/theory/logic/big_sep.h" +#include "proof/theory/logic/product_resource.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/big_sep.c" +#require "proof/theory/logic/product_resource.c" + +PROOF static void check_sl_v2_theorem(const thm theorem, + const term expected, + const char *label) { + ENSURE_COND(!IS_NULL(theorem), "%s is empty", label); + ENSURE_COND(vector_size(hyp(theorem)) == 0, + "%s unexpectedly has hypotheses", label); + ENSURE_COND(alpha_compare(concl(theorem), expected) == 0, + "%s has the wrong conclusion", label); + return; +err: + ERR_FUN_PUTS("check_sl_v2_theorem", label); +} + +PROOF static thm sl_v2_at_num(const thm theorem) { + type_list variables = term_tyvars(concl(theorem)); + ENSURE_COND(vector_size(variables) == 1, + "expected exactly one assertion carrier type variable"); + type_pair_list types = (type_pair_list)vector_create(); + vector_add(&types, ((type_pair){`:num`, variables[0]})); + return inst_type_rule(types, theorem); +err: + ERR_FUN_PUTS("sl_v2_at_num"); + return empty_theorem; +} + +PROOF static int audit_sl_v2_regressions(void) { + term R = `R:(num)ra`; + term S = `S:(bool)ra`; + term phi = `phi:bool`; + term resource = `resource:num`; + term a = `a:bool`; + term result_pred = `result_pred:bool->bool`; + term assertion = `P:(num#bool)->bool`; + term target = `Q:(num#bool)->bool`; + term family = `Phi:num->(num#bool)->bool`; + term target_family = `Psi:num->(num#bool)->bool`; + + /* The user override intentionally keeps these two notions distinct. */ + check_sl_v2_theorem( + sl_v2_at_num(r_pure_def), + `r_pure (R:(num)ra) (phi:bool) (resource:num) <=> phi`, + "r_pure remains resource-independent"); + check_sl_v2_theorem( + sl_v2_at_num(r_fact_def), + `r_fact (R:(num)ra) (phi:bool) (resource:num) <=> + phi && resource == ra_unit R`, + "r_fact remains exact-unit"); + + check_sl_v2_theorem( + ispecl_rule( + TERM_LIST( + `R:(num)ra`, + `S:(bool)ra`, + `a:bool`, + `result_pred:bool->bool`), + R_RIGHT_OWN_UPDATEP), + `ra_updateP (S:(bool)ra) (a:bool) (result_pred:bool->bool) ==> + r_viewshift_right + (R:(num)ra) S + (r_lift_right R S (r_own S a)) + (r_exists + (prod_ra R S) + (\selected:bool. + r_sep + (prod_ra R S) + (r_fact (prod_ra R S) (result_pred selected)) + (r_lift_right R S (r_own S selected))))`, + "R_RIGHT_OWN_UPDATEP uses exact-unit fact"); + + check_sl_v2_theorem( + ispecl_rule( + TERM_LIST( + R, + S, + phi, + assertion, + target), + R_VIEWSHIFT_RIGHT_FACT), + `((phi:bool) ==> + r_viewshift_right + (R:(num)ra) (S:(bool)ra) + (P:(num#bool)->bool) + (Q:(num#bool)->bool)) ==> + r_viewshift_right + R S + (r_sep + (prod_ra R S) + (r_fact (prod_ra R S) phi) + P) + (r_sep + (prod_ra R S) + (r_fact (prod_ra R S) phi) + Q)`, + "R_VIEWSHIFT_RIGHT_FACT schema"); + + check_sl_v2_theorem( + ispecl_rule( + TERM_LIST(R, S, family, target_family), + R_VIEWSHIFT_RIGHT_EXISTS), + `(forall witness:num. + r_viewshift_right + (R:(num)ra) (S:(bool)ra) + ((Phi:num->(num#bool)->bool) witness) + ((Psi:num->(num#bool)->bool) witness)) ==> + r_viewshift_right + R S + (r_exists + (prod_ra R S) + (\bound:num. (Phi:num->(num#bool)->bool) bound)) + (r_exists + (prod_ra R S) + (\bound:num. (Psi:num->(num#bool)->bool) bound))`, + "R_VIEWSHIFT_RIGHT_EXISTS schema"); + + check_sl_v2_theorem( + ispecl_rule( + TERM_LIST( + `R:(num)ra`, + `Item:bool->num->bool`, + `f:num->bool`, + `xs:(num)list`), + R_BIG_SEP_LIST_MAP), + `r_equiv + (R:(num)ra) + (r_big_sep_list + R + (Item:bool->num->bool) + (MAP (f:num->bool) (xs:(num)list))) + (r_big_sep_list + R + (\x:num. (Item:bool->num->bool) (f x)) + xs)`, + "R_BIG_SEP_LIST_MAP is list-only and r_equiv"); + + return 0; +err: + ERR_FUN_PUTS("audit_sl_v2_regressions"); + return -1; +} + +PROOF static int _SL_V2_REGRESSION_AUDIT = + audit_sl_v2_regressions(); diff --git a/test/value_ra_constructors_regression.c b/test/value_ra_constructors_regression.c index 8f58454..eca384b 100644 --- a/test/value_ra_constructors_regression.c +++ b/test/value_ra_constructors_regression.c @@ -38,142 +38,121 @@ err: PROOF static int audit_agree_constructor_regressions(void) { check_value_ra_theorem( - AGREE_RA_OWNED_INJ, - `forall (a:A) (b:A). - (Agree a:(A)agree) == Agree b <=> a == b`, - "AGREE_RA_OWNED_INJ"); + AGREE_RA_UNIT, + `ra_unit agree_ra == (AgreeUnit:(A)agree)`, + "AGREE_RA_UNIT"); check_value_ra_theorem( - AGREE_RA_OWNED_NE_UNIT, - `forall a:A. ~((Agree a:(A)agree) == AgreeUnit)`, - "AGREE_RA_OWNED_NE_UNIT"); - check_value_ra_theorem( - AGREE_RA_INVALID_NE_UNIT, - `~((AgreeInvalid:(A)agree) == AgreeUnit)`, - "AGREE_RA_INVALID_NE_UNIT"); + AGREE_RA_OWNED_OP, + `forall a b:A. + ra_op agree_ra (Agree a) (Agree b) == + (if a == b then Agree a else (AgreeInvalid:(A)agree))`, + "AGREE_RA_OWNED_OP"); check_value_ra_theorem( - AGREE_RA_INVALID_NE_OWNED, - `forall a:A. ~((AgreeInvalid:(A)agree) == Agree a)`, - "AGREE_RA_INVALID_NE_OWNED"); + AGREE_RA_IDEMPOTENT, + `forall a:A. + ra_op agree_ra (Agree a) (Agree a) == (Agree a:(A)agree)`, + "AGREE_RA_IDEMPOTENT"); check_value_ra_theorem( AGREE_RA_VALID_UNIT, `ra_valid agree_ra (AgreeUnit:(A)agree)`, "AGREE_RA_VALID_UNIT"); check_value_ra_theorem( - AGREE_RA_INCLUDED_UNIT, - `forall x:(A)agree. - ra_included agree_ra AgreeUnit x`, - "AGREE_RA_INCLUDED_UNIT"); - check_value_ra_theorem( - AGREE_RA_NOT_INCLUDED_OWNED_UNIT, - `forall a:A. - ~(ra_included agree_ra (Agree a) AgreeUnit)`, - "AGREE_RA_NOT_INCLUDED_OWNED_UNIT"); - check_value_ra_theorem( - AGREE_RA_INCLUDED_OWNED_INVALID, - `forall a:A. - ra_included agree_ra (Agree a) AgreeInvalid`, - "AGREE_RA_INCLUDED_OWNED_INVALID"); + AGREE_RA_VALID_OWNED, + `forall a:A. ra_valid agree_ra (Agree a)`, + "AGREE_RA_VALID_OWNED"); check_value_ra_theorem( - value_ra_at_num(AGREE_RA_NOT_INCLUDED_INVALID_UNIT), - `~(ra_included - (agree_ra:((num)agree)ra) - (AgreeInvalid:(num)agree) - (AgreeUnit:(num)agree))`, - "AGREE_RA_NOT_INCLUDED_INVALID_UNIT"); + AGREE_RA_INVALID, + `~(ra_valid agree_ra (AgreeInvalid:(A)agree))`, + "AGREE_RA_INVALID"); check_value_ra_theorem( - AGREE_RA_NOT_INCLUDED_INVALID_OWNED, - `forall a:A. - ~(ra_included agree_ra AgreeInvalid (Agree a))`, - "AGREE_RA_NOT_INCLUDED_INVALID_OWNED"); + AGREE_RA_VALID_COMBINE_IFF, + `forall a b:A. + ra_valid agree_ra (ra_op agree_ra (Agree a) (Agree b)) <=> + a == b`, + "AGREE_RA_VALID_COMBINE_IFF"); check_value_ra_theorem( - AGREE_RA_NOT_EXCLUSIVE_OWNED, - `forall a:A. - ~(ra_exclusive agree_ra (Agree a))`, - "AGREE_RA_NOT_EXCLUSIVE_OWNED"); + AGREE_RA_AGREEMENT, + `forall a b:A. + ra_compatible agree_ra (Agree a) (Agree b) ==> a == b`, + "AGREE_RA_AGREEMENT"); check_value_ra_theorem( - AGREE_RA_EXCLUSIVE_INVALID, - `ra_exclusive agree_ra (AgreeInvalid:(A)agree)`, - "AGREE_RA_EXCLUSIVE_INVALID"); + AGREE_RA_INCLUDED_OWNED, + `forall a b:A. + ra_included agree_ra (Agree a) (Agree b) <=> a == b`, + "AGREE_RA_INCLUDED_OWNED"); check_value_ra_theorem( AGREE_RA_NOT_CANCELLATIVE, `~(ra_cancellative (agree_ra:((A)agree)ra))`, "AGREE_RA_NOT_CANCELLATIVE"); check_value_ra_theorem( - AGREE_RA_LOCAL_UPDATE_OWNED_IFF, + AGREE_RA_UPDATE_IFF, `forall a b:A. - ra_local_update - agree_ra - (Agree a,Agree a) - (Agree b,Agree b) <=> + ra_update agree_ra (Agree a) (Agree b) <=> a == b`, + "AGREE_RA_UPDATE_IFF"); + check_value_ra_theorem( + AGREE_RA_LOCAL_UPDATE_IFF, + `forall a b:A. + ra_local_update agree_ra + (Agree a) (Agree a) (Agree b) (Agree b) <=> a == b`, - "AGREE_RA_LOCAL_UPDATE_OWNED_IFF"); + "AGREE_RA_LOCAL_UPDATE_IFF"); return 0; } PROOF static int audit_frac_constructor_regressions(void) { check_value_ra_theorem( - FRAC_RA_OWN_INJ, - `forall (p:real) (q:real) (a:A) (b:A). - &0 < p ==> - &0 < q ==> - (frac_own p a == frac_own q b <=> - p == q && a == b)`, - "FRAC_RA_OWN_INJ"); - check_value_ra_theorem( - FRAC_RA_OWN_NE_EMPTY, - `forall (p:real) (a:A). - ~(frac_own p a == (frac_empty:(A)frac))`, - "FRAC_RA_OWN_NE_EMPTY"); + FRAC_RA_UNIT, + `forall R:(A)ra. + ra_unit (frac_ra R) == (frac_empty:(A)frac)`, + "FRAC_RA_UNIT"); check_value_ra_theorem( - FRAC_RA_FULL_INJ, - `forall (a:A) (b:A). - frac_full a == frac_full b <=> a == b`, - "FRAC_RA_FULL_INJ"); + FRAC_RA_FULL, + `forall a:A. frac_full a == frac_own (&1) a`, + "FRAC_RA_FULL"); check_value_ra_theorem( - FRAC_RA_FULL_NE_EMPTY, - `forall a:A. - ~(frac_full a == (frac_empty:(A)frac))`, - "FRAC_RA_FULL_NE_EMPTY"); - check_value_ra_theorem( - FRAC_RA_INCLUDED_EMPTY, - `forall (R:(A)ra) (x:(A)frac). - ra_included (frac_ra R) frac_empty x`, - "FRAC_RA_INCLUDED_EMPTY"); - check_value_ra_theorem( - FRAC_RA_INCLUDED_OWN, - `forall - (R:(A)ra) - (p:real) - (q:real) - (a:A) - (b:A). + FRAC_RA_OWN_OP, + `forall (R:(A)ra) (p:real) (q:real) (a:A) (b:A). &0 < p ==> &0 < q ==> - (ra_included - (frac_ra R) - (frac_own p a) - (frac_own q b) <=> - (p == q && a == b) || - (p < q && ra_included R a b))`, - "FRAC_RA_INCLUDED_OWN"); + ra_op (frac_ra R) (frac_own p a) (frac_own q b) == + frac_own (p + q) (ra_op R a b)`, + "FRAC_RA_OWN_OP"); check_value_ra_theorem( - FRAC_RA_NOT_INCLUDED_OWN_EMPTY, + FRAC_RA_VALID_OWN, `forall (R:(A)ra) (p:real) (a:A). &0 < p ==> - ~(ra_included - (frac_ra R) - (frac_own p a) - frac_empty)`, - "FRAC_RA_NOT_INCLUDED_OWN_EMPTY"); + (ra_valid (frac_ra R) (frac_own p a) <=> + p <= &1 && ra_valid R a)`, + "FRAC_RA_VALID_OWN"); check_value_ra_theorem( - FRAC_RA_INCLUDED_FULL, - `forall (R:(A)ra) (a:A) (b:A). - ra_included + FRAC_RA_EXCLUSIVE_FULL, + `forall (R:(A)ra) (a:A). + ra_valid R a ==> + ra_exclusive (frac_ra R) (frac_full a)`, + "FRAC_RA_EXCLUSIVE_FULL"); + check_value_ra_theorem( + FRAC_RA_UPDATE_WEAKEN, + `forall (R:(A)ra) (p:real) (q:real) (a:A) (b:A). + &0 < q ==> + q <= p ==> + ra_update R a b ==> + ra_update (frac_ra R) - (frac_full a) - (frac_full b) <=> - a == b`, - "FRAC_RA_INCLUDED_FULL"); + (frac_own p a) + (frac_own q b)`, + "FRAC_RA_UPDATE_WEAKEN"); + check_value_ra_theorem( + FRAC_RA_UPDATEP_WEAKEN, + `forall (R:(A)ra) (p:real) (q:real) (a:A) (P:A->bool). + &0 < q ==> + q <= p ==> + ra_updateP R a P ==> + ra_updateP + (frac_ra R) + (frac_own p a) + (\x:(A)frac. + exists b:A. P b && x == frac_own q b)`, + "FRAC_RA_UPDATEP_WEAKEN"); check_value_ra_theorem( FRAC_RA_UPDATE_FULL_IFF, `forall (R:(A)ra) (a:A) (b:A). @@ -183,108 +162,111 @@ PROOF static int audit_frac_constructor_regressions(void) { (frac_full b) <=> (ra_valid R a ==> ra_valid R b))`, "FRAC_RA_UPDATE_FULL_IFF"); - check_value_ra_theorem( - FRAC_RA_UPDATE_FULL_ND_IFF, - `forall (R:(A)ra) (a:A) (P:A->bool). - (ra_update_nd - (frac_ra R) - (frac_full a) - (\x:(A)frac. - exists b:A. - P b && x == frac_full b) <=> - (ra_valid R a ==> - exists b:A. P b && ra_valid R b))`, - "FRAC_RA_UPDATE_FULL_ND_IFF"); return 0; } PROOF static int audit_option_constructor_regressions(void) { check_value_ra_theorem( - OPTION_RA_SOME_INJ, - `forall (a:A) (b:A). - (SOME a:A option) == SOME b <=> a == b`, - "OPTION_RA_SOME_INJ"); + OPTION_RA_UNIT, + `forall R:(A)ra. ra_unit (option_ra R) == (NONE:A option)`, + "OPTION_RA_UNIT"); + check_value_ra_theorem( + OPTION_RA_OP_NONE_L, + `forall (R:(A)ra) (x:A option). + ra_op (option_ra R) NONE x == x`, + "OPTION_RA_OP_NONE_L"); check_value_ra_theorem( - OPTION_RA_SOME_NE_NONE, - `forall a:A. ~((SOME a:A option) == NONE)`, - "OPTION_RA_SOME_NE_NONE"); + OPTION_RA_OP_SOME_SOME, + `forall (R:(A)ra) (a:A) (b:A). + ra_op (option_ra R) (SOME a) (SOME b) == + SOME (ra_op R a b)`, + "OPTION_RA_OP_SOME_SOME"); + check_value_ra_theorem( + OPTION_RA_VALID_NONE, + `forall R:(A)ra. ra_valid (option_ra R) (NONE:A option)`, + "OPTION_RA_VALID_NONE"); check_value_ra_theorem( - OPTION_RA_EXCLUSIVE_SOME_IFF, + OPTION_RA_VALID_SOME, `forall (R:(A)ra) (a:A). - ra_exclusive (option_ra R) (SOME a) <=> - ~(ra_valid R a)`, - "OPTION_RA_EXCLUSIVE_SOME_IFF"); + ra_valid (option_ra R) (SOME a) <=> ra_valid R a`, + "OPTION_RA_VALID_SOME"); check_value_ra_theorem( - OPTION_RA_NOT_EXCLUSIVE_NONE, - `forall R:(A)ra. - ~(ra_exclusive (option_ra R) (NONE:A option))`, - "OPTION_RA_NOT_EXCLUSIVE_NONE"); + OPTION_RA_INCLUDED_NONE, + `forall (R:(A)ra) (x:A option). + ra_included (option_ra R) NONE x`, + "OPTION_RA_INCLUDED_NONE"); + check_value_ra_theorem( + OPTION_RA_INCLUDED_SOME_SOME, + `forall (R:(A)ra) (a:A) (b:A). + ra_included (option_ra R) (SOME a) (SOME b) <=> + ra_included R a b`, + "OPTION_RA_INCLUDED_SOME_SOME"); + check_value_ra_theorem( + OPTION_RA_NOT_INCLUDED_SOME_NONE, + `forall (R:(A)ra) (a:A). + ~(ra_included (option_ra R) (SOME a) NONE)`, + "OPTION_RA_NOT_INCLUDED_SOME_NONE"); + check_value_ra_theorem( + OPTION_RA_SOME_UNIT_NE_NONE, + `forall R:(A)ra. ~((SOME (ra_unit R):A option) == NONE)`, + "OPTION_RA_SOME_UNIT_NE_NONE"); check_value_ra_theorem( OPTION_RA_NOT_CANCELLATIVE, `forall R:(A)ra. ~(ra_cancellative (option_ra R))`, "OPTION_RA_NOT_CANCELLATIVE"); check_value_ra_theorem( - OPTION_RA_LOCAL_UPDATE_SOME, - `forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). - ra_local_update R (a,f) (b,g) ==> - ra_local_update - (option_ra R) - (SOME a,SOME f) - (SOME b,SOME g)`, - "OPTION_RA_LOCAL_UPDATE_SOME"); - check_value_ra_theorem( - OPTION_RA_LOCAL_UPDATE_SOME_IFF, - `forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). - ra_local_update + OPTION_RA_UPDATEP_IFF, + `forall (R:(A)ra) (a:A) (P:A->bool). + ra_updateP (option_ra R) - (SOME a,SOME f) - (SOME b,SOME g) <=> - ra_local_update R (a,f) (b,g)`, - "OPTION_RA_LOCAL_UPDATE_SOME_IFF"); + (SOME a) + (\x:A option. exists b:A. P b && x == SOME b) <=> + ra_updateP R a P`, + "OPTION_RA_UPDATEP_IFF"); check_value_ra_theorem( OPTION_RA_UPDATE_IFF, `forall (R:(A)ra) (a:A) (b:A). - ra_update - (option_ra R) - (SOME a) - (SOME b) <=> + ra_update (option_ra R) (SOME a) (SOME b) <=> ra_update R a b`, "OPTION_RA_UPDATE_IFF"); check_value_ra_theorem( - OPTION_RA_UPDATE_ND_IFF, - `forall (R:(A)ra) (a:A) (P:A->bool). - (ra_update_nd - (option_ra R) - (SOME a) - (\x:A option. - exists b:A. P b && x == SOME b) <=> - ra_update_nd R a P)`, - "OPTION_RA_UPDATE_ND_IFF"); + OPTION_RA_LOCAL_UPDATE_IFF, + `forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + ra_local_update + (option_ra R) + (SOME a) (SOME f) (SOME b) (SOME g) <=> + ra_local_update R a f b g`, + "OPTION_RA_LOCAL_UPDATE_IFF"); return 0; } PROOF static int audit_max_nat_constructor_regressions(void) { check_value_ra_theorem( - MAX_NAT_RA_NOT_EXCLUSIVE, - `forall n:num. ~(ra_exclusive max_nat_ra n)`, - "MAX_NAT_RA_NOT_EXCLUSIVE"); - check_value_ra_theorem( - MAX_NAT_RA_NOT_CANCELLATIVE, - `~(ra_cancellative max_nat_ra)`, - "MAX_NAT_RA_NOT_CANCELLATIVE"); - check_value_ra_theorem( - MAX_NAT_RA_LOCAL_UPDATE_UNIT_IFF, - `forall old new:num. - ra_local_update max_nat_ra (old,0) (new,0) <=> - old == new`, - "MAX_NAT_RA_LOCAL_UPDATE_UNIT_IFF"); - check_value_ra_theorem( - MAX_NAT_RA_UPDATE_ND_IFF, - `forall (old:num) (P:num->bool). - ra_update_nd max_nat_ra old P <=> - exists new:num. P new`, - "MAX_NAT_RA_UPDATE_ND_IFF"); + MAX_NAT_RA_UNIT, + `ra_unit max_nat_ra == 0`, + "MAX_NAT_RA_UNIT"); + check_value_ra_theorem( + MAX_NAT_RA_OP, + `forall a b:num. ra_op max_nat_ra a b == MAX a b`, + "MAX_NAT_RA_OP"); + check_value_ra_theorem( + MAX_NAT_RA_VALID, + `forall n:num. ra_valid max_nat_ra n`, + "MAX_NAT_RA_VALID"); + check_value_ra_theorem( + MAX_NAT_RA_INCLUDED, + `forall a b:num. + ra_included max_nat_ra a b <=> a <= b`, + "MAX_NAT_RA_INCLUDED"); + check_value_ra_theorem( + MAX_NAT_RA_IDEMPOTENT, + `forall n:num. ra_op max_nat_ra n n == n`, + "MAX_NAT_RA_IDEMPOTENT"); + check_value_ra_theorem( + MAX_NAT_RA_UPDATE, + `forall a b:num. ra_update max_nat_ra a b`, + "MAX_NAT_RA_UPDATE"); return 0; } diff --git a/theory/c_program_logic/c_basic_update.c b/theory/c_program_logic/c_basic_update.c index edb6f66..4ebd9f5 100644 --- a/theory/c_program_logic/c_basic_update.c +++ b/theory/c_program_logic/c_basic_update.c @@ -4,1503 +4,93 @@ #require "proof/proof_backward.c" #require "proof/theory/c_program_logic/c_resource.c" -PROOF static thm_list C_BASIC_UPDATE_INITIAL_AXIOMS = get_all_axioms(); PROOF static size_t C_BASIC_UPDATE_AXIOMS_BEFORE = - vector_size(C_BASIC_UPDATE_INITIAL_AXIOMS); - -/* ------------------------------------------------------------------------- */ -/* Modality and viewshift */ -/* ------------------------------------------------------------------------- */ + vector_size(get_all_axioms()); PROOF thm c_bupd_def = new_fun_definition(` c_bupd - (G:(A)ra) - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (resource:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) <=> - ra_update_nd - (ghost_heap_ra G) - (SND resource) - (\ghost':(num,A)finmap. Q (FST resource,ghost')) + (G:(A)ra) = + r_bupd_right mem_ra G `); PROOF thm c_viewshift_def = new_fun_definition(` c_viewshift - (G:(A)ra) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) <=> - r_entails (c_resource_ra G) P (c_bupd G Q) + (G:(A)ra) = + r_viewshift_right mem_ra G `); -/* ------------------------------------------------------------------------- */ -/* Basic-update laws */ -/* ------------------------------------------------------------------------- */ - -PROOF static thm prove_c_bupd_intro(void) { - term goal_tm = ` +PROOF static thm prove_c_bupd_preserves_phys(void) { + gnode root = gnode_new_with_ccl(` forall (G:(A)ra) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). - r_entails (c_resource_ra G) P (c_bupd G P) - `; - gnode root = gnode_new_with_ccl(goal_tm); - thm_list definitions = THM_LIST( - r_entails_def, - c_bupd_def, - ra_update_nd_def); - conv unfold_definitions = pure_rewrite_conv(definitions); - gnode body = CONV_TAC(root, unfold_definitions); - body = AUTO_INTROS_TAC(body); - term unchanged_ghost = ` - SND (resource: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) - `; - body = EXISTS_TAC(body, unchanged_ghost); - gnode_list result = CONJ_TAC(body); - - conv beta = get_conversion_by_name("BETA_CONV"); - gnode post_goal = CONV_TAC(result[0], beta); - - term source_fact_tm = ` - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (resource:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) - `; - thm source_fact = assume_rule(source_fact_tm); - term resource_tm = ` - resource:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap - `; - thm pair = get_theorem_by_name("PAIR"); - thm resource_eta = ispec_rule(resource_tm, pair); - term predicate = ` - P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool - `; - thm predicate_eta = ap_term_rule(predicate, resource_eta); - thm resource_to_pair = gsym_rule(predicate_eta); - thm post_fact = eq_mp_rule(resource_to_pair, source_fact); - ACCEPT_TAC(post_goal, post_fact); - - term validity_fact_tm = ` - ra_valid - (ghost_heap_ra (G:(A)ra)) - (ra_op - (ghost_heap_ra G) - (SND (resource: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)) - (frame:(num,A)finmap)) - `; - thm validity_fact = assume_rule(validity_fact_tm); - ACCEPT_TAC(result[1], validity_fact); - thm proved = gnode_prove(root); - return proved; -} - -PROOF thm C_BUPD_INTRO = prove_c_bupd_intro(); - -PROOF static thm prove_c_bupd_mono(void) { - term goal_tm = ` - forall - (G:(A)ra) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). - r_entails (c_resource_ra G) P Q ==> - r_entails - (c_resource_ra G) - (c_bupd G P) - (c_bupd G Q) - `; - gnode root = gnode_new_with_ccl(goal_tm); - thm_list definitions = THM_LIST( - r_entails_def, - c_bupd_def, - ra_update_nd_def); - conv unfold_definitions = pure_rewrite_conv(definitions); - gnode body = CONV_TAC(root, unfold_definitions); + (Q:(((int,(pmem_byte_state)excl)finmap)#A)->bool) + (resource:((int,(pmem_byte_state)excl)finmap)#A). + ra_valid (c_resource_ra G) resource ==> + c_bupd G Q resource ==> + exists ghost':A. Q (FST resource,ghost') + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + c_resource_ra_def, + c_bupd_def, + r_bupd_right_def, + PROD_RA_VALID))); body = GEN_TAC(body, "G"); - body = GEN_TAC(body, "P"); body = GEN_TAC(body, "Q"); - body = DISCH_TAC(body, "Hmono"); - body = GEN_TAC(body, "owned"); - body = DISCH_TAC(body, "Hvalid_owned"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid"); body = DISCH_TAC(body, "Hupdate"); - body = GEN_TAC(body, "frame"); - body = DISCH_TAC(body, "Hvalid_source"); - - term update_assumption_tm = ` - forall frame:(num,A)finmap. - ra_valid - (ghost_heap_ra (G:(A)ra)) - (ra_op - (ghost_heap_ra G) - (SND (owned: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)) - frame) ==> - exists selected:(num,A)finmap. - (\ghost':(num,A)finmap. - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (FST owned,ghost')) selected && - ra_valid - (ghost_heap_ra G) - (ra_op (ghost_heap_ra G) selected frame) - `; - thm update_assumption = assume_rule(update_assumption_tm); - term frame_tm = `frame:(num,A)finmap`; - thm update_at_frame = spec_rule(frame_tm, update_assumption); - term valid_source_tm = ` - ra_valid - (ghost_heap_ra (G:(A)ra)) - (ra_op - (ghost_heap_ra G) - (SND (owned: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)) - (frame:(num,A)finmap)) - `; - thm valid_source = assume_rule(valid_source_tm); - thm selected = mp_rule(update_at_frame, valid_source); - body = ASSUME_TAC(body, selected, "Hselected"); - body = ASMP_EXISTS_TAC(body, "Hselected", "selected"); - body = ASMP_CONJ_TAC( - body, - "Hselected", - "HP_selected", - "Hvalid_selected_frame"); - - term ghost_ra_tm = `G:(A)ra`; - term owned_tm = ` - owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap - `; - term_list owned_valid_arguments = TERM_LIST(ghost_ra_tm, owned_tm); - thm owned_valid_rule = ispecl_rule( - owned_valid_arguments, - C_RESOURCE_RA_VALID); - term owned_valid_tm = ` - ra_valid - (c_resource_ra (G:(A)ra)) - (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) - `; - thm owned_valid = assume_rule(owned_valid_tm); - thm owned_components = eq_mp_rule(owned_valid_rule, owned_valid); - - term ghost_heap_ra_tm = `ghost_heap_ra (G:(A)ra)`; - term selected_tm = `selected:(num,A)finmap`; - term_list op_left_arguments = TERM_LIST( - ghost_heap_ra_tm, - selected_tm, - frame_tm); - thm op_left_rule = ispecl_rule(op_left_arguments, RA_VALID_OP_L); - term selected_frame_valid_tm = ` - ra_valid - (ghost_heap_ra (G:(A)ra)) - (ra_op - (ghost_heap_ra G) - (selected:(num,A)finmap) - (frame:(num,A)finmap)) - `; - thm selected_frame_valid = assume_rule(selected_frame_valid_tm); - thm selected_ghost_valid = mp_rule( - op_left_rule, - selected_frame_valid); - - term selected_pair_tm = ` - (FST (owned: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap), - selected:(num,A)finmap) - `; - term_list selected_pair_arguments = TERM_LIST( - ghost_ra_tm, - selected_pair_tm); - thm selected_pair_rule = ispecl_rule( - selected_pair_arguments, - C_RESOURCE_RA_VALID); - thm fst = get_theorem_by_name("FST"); - thm snd = get_theorem_by_name("SND"); - thm_list pair_rewrites = THM_LIST(fst, snd); - selected_pair_rule = pure_rewrite_rule( - pair_rewrites, - selected_pair_rule); - thm physical_valid = conjunct1_rule(owned_components); - thm selected_components_valid = conj_rule( - physical_valid, - selected_ghost_valid); - thm components_to_pair_valid = gsym_rule(selected_pair_rule); - thm selected_pair_valid = eq_mp_rule( - components_to_pair_valid, - selected_components_valid); - - term mono_assumption_tm = ` - forall resource: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap. - ra_valid (c_resource_ra (G:(A)ra)) resource ==> - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - resource ==> - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - resource - `; - thm mono_assumption = assume_rule(mono_assumption_tm); - thm mono_at_selected = spec_rule(selected_pair_tm, mono_assumption); - thm selected_implication = mp_rule( - mono_at_selected, - selected_pair_valid); - term selected_p_tm = ` - (\ghost':(num,A)finmap. - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (FST (owned: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap), - ghost')) - (selected:(num,A)finmap) - `; - thm selected_p_raw = assume_rule(selected_p_tm); - thm selected_p = beta_rule(selected_p_raw); - thm selected_q = mp_rule(selected_implication, selected_p); - body = EXISTS_TAC(body, selected_tm); - gnode_list result = CONJ_TAC(body); - conv beta = get_conversion_by_name("BETA_CONV"); - gnode post_goal = CONV_TAC(result[0], beta); - ACCEPT_TAC(post_goal, selected_q); - ACCEPT_TAC(result[1], selected_frame_valid); - thm proved = gnode_prove(root); - return proved; -} - -PROOF thm C_BUPD_MONO = prove_c_bupd_mono(); - -PROOF static thm prove_c_bupd_idem(void) { - term goal_tm = ` - forall - (G:(A)ra) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). - r_entails - (c_resource_ra G) - (c_bupd G (c_bupd G P)) - (c_bupd G P) - `; - gnode root = gnode_new_with_ccl(goal_tm); - thm fst = get_theorem_by_name("FST"); - thm snd = get_theorem_by_name("SND"); - thm_list definitions = THM_LIST( - r_entails_def, - c_bupd_def, - ra_update_nd_def, - fst, - snd); - conv unfold_definitions = pure_rewrite_conv(definitions); - gnode body = CONV_TAC(root, unfold_definitions); - body = GEN_TAC(body, "G"); - body = GEN_TAC(body, "P"); - body = GEN_TAC(body, "owned"); - body = DISCH_TAC(body, "Hvalid_owned"); - body = DISCH_TAC(body, "Hnested"); - body = GEN_TAC(body, "frame"); - body = DISCH_TAC(body, "Hvalid_source"); - - const_cstr_list nested_labels = CONST_STRING_LIST("Hnested"); - term_list nested_terms = gnode_get_asmps(body, nested_labels); - term nested_update_tm = nested_terms[0]; - thm nested_update = assume_rule(nested_update_tm); - term frame_tm = `frame:(num,A)finmap`; - thm nested_at_frame = spec_rule(frame_tm, nested_update); - const_cstr_list source_labels = CONST_STRING_LIST("Hvalid_source"); - term_list source_terms = gnode_get_asmps(body, source_labels); - term valid_source_tm = source_terms[0]; - thm valid_source = assume_rule(valid_source_tm); - thm middle = mp_rule(nested_at_frame, valid_source); - body = ASSUME_TAC(body, middle, "Hmiddle"); - body = ASMP_EXISTS_TAC(body, "Hmiddle", "middle"); - body = ASMP_CONJ_TAC( + thm ghost_valid = conjunct2_rule( + assume_rule(` + ra_valid mem_ra + (FST (resource:((int,(pmem_byte_state)excl)finmap)#A)) && + ra_valid (G:(A)ra) (SND resource) + `)); + term_list update_terms = gnode_get_asmps( body, - "Hmiddle", - "Hmiddle_update", - "Hvalid_middle_frame"); - const_cstr_list middle_update_labels = - CONST_STRING_LIST("Hmiddle_update"); - term_list middle_update_terms = gnode_get_asmps( + CONST_STRING_LIST("Hupdate")); + thm result = match_mp_rule( + RA_UPDATEP_VALID, + assume_rule(update_terms[0])); + result = match_mp_rule(result, ghost_valid); + result = conv_rule( + depth_conv(get_conversion_by_name("BETA_CONV")), + result); + body = ASSUME_TAC(body, result, "Hresult"); + body = ASMP_EXISTS_TAC(body, "Hresult", "ghost'"); + body = ASMP_CONJ_TAC(body, "Hresult", "Hpost", "Hvalid_result"); + term_list post_terms = gnode_get_asmps( body, - middle_update_labels); - term middle_update_tm = middle_update_terms[0]; - thm middle_update = assume_rule(middle_update_tm); - thm middle_update_reduced = beta_rule(middle_update); - thm middle_at_frame = spec_rule(frame_tm, middle_update_reduced); - const_cstr_list middle_valid_labels = - CONST_STRING_LIST("Hvalid_middle_frame"); - term_list middle_valid_terms = gnode_get_asmps( + CONST_STRING_LIST("Hpost")); + body = EXISTS_TAC(body, `ghost':A`); + ACCEPT_TAC( body, - middle_valid_labels); - term valid_middle_frame_tm = middle_valid_terms[0]; - thm valid_middle_frame = assume_rule(valid_middle_frame_tm); - thm selected_raw = mp_rule(middle_at_frame, valid_middle_frame); - thm selected = beta_rule(selected_raw); - - conv beta = get_conversion_by_name("BETA_CONV"); - conv beta_depth = depth_conv(beta); - body = CONV_TAC(body, beta_depth); - ACCEPT_TAC(body, selected); - thm proved = gnode_prove(root); - return proved; + assume_rule(post_terms[0])); + return gnode_prove(root); } -PROOF thm C_BUPD_IDEM = prove_c_bupd_idem(); - -PROOF static thm prove_c_bupd_frame(void) { - term goal_tm = ` - forall - (G:(A)ra) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Frame:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). - r_entails - (c_resource_ra G) - (r_sep (c_resource_ra G) (c_bupd G P) Frame) - (c_bupd G (r_sep (c_resource_ra G) P Frame)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - thm_list definitions = THM_LIST( - r_entails_def, - r_sep_def, - c_bupd_def, - ra_update_nd_def); - conv unfold_definitions = pure_rewrite_conv(definitions); - gnode body = CONV_TAC(root, unfold_definitions); - body = GEN_TAC(body, "G"); - body = GEN_TAC(body, "P"); - body = GEN_TAC(body, "Frame"); - body = GEN_TAC(body, "owned_total"); - body = DISCH_TAC(body, "Hvalid_owned_total"); - body = DISCH_TAC(body, "Hsep"); - body = ASMP_EXISTS_TAC(body, "Hsep", "updated"); - body = ASMP_EXISTS_TAC(body, "Hsep", "explicit_frame"); - body = ASMP_CONJ_TAC( - body, - "Hsep", - "Hsplit", - "Hpreds"); - body = ASMP_CONJ_TAC( - body, - "Hpreds", - "Hupdate", - "Hframe_pred"); - body = GEN_TAC(body, "hidden"); - body = DISCH_TAC(body, "Hvalid_with_hidden"); - - const_cstr_list split_labels = CONST_STRING_LIST("Hsplit"); - term_list split_terms = gnode_get_asmps(body, split_labels); - term split_tm = split_terms[0]; - thm split = assume_rule(split_tm); - term snd_function = ` - SND: - (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> - (num,A)finmap - `; - thm split_snd = ap_term_rule(snd_function, split); - thm snd = get_theorem_by_name("SND"); - thm_list snd_rewrites = THM_LIST(C_RESOURCE_RA_OP, snd); - split_snd = pure_rewrite_rule(snd_rewrites, split_snd); - term valid_with_hidden_predicate = ` - \base:(num,A)finmap. - ra_valid - (ghost_heap_ra (G:(A)ra)) - (ra_op (ghost_heap_ra G) base (hidden:(num,A)finmap)) - `; - thm replace_owned_ghost_raw = ap_term_rule( - valid_with_hidden_predicate, - split_snd); - thm replace_owned_ghost = beta_rule(replace_owned_ghost_raw); - const_cstr_list hidden_valid_labels = - CONST_STRING_LIST("Hvalid_with_hidden"); - term_list hidden_valid_terms = gnode_get_asmps( - body, - hidden_valid_labels); - term valid_with_hidden_tm = hidden_valid_terms[0]; - thm valid_with_hidden = assume_rule(valid_with_hidden_tm); - thm valid_grouped = eq_mp_rule( - replace_owned_ghost, - valid_with_hidden); - term ghost_heap_ra_tm = `ghost_heap_ra (G:(A)ra)`; - term updated_ghost_tm = ` - SND (updated: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) - `; - term explicit_ghost_tm = ` - SND (explicit_frame: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) - `; - term hidden_tm = `hidden:(num,A)finmap`; - term_list source_assoc_arguments = TERM_LIST( - ghost_heap_ra_tm, - updated_ghost_tm, - explicit_ghost_tm, - hidden_tm); - thm source_assoc = ispecl_rule( - source_assoc_arguments, - RA_ASSOC); - thm source_assoc_validity = ap_term_rule( - `ra_valid (ghost_heap_ra (G:(A)ra)):(num,A)finmap->bool`, - source_assoc); - thm valid_for_update = eq_mp_rule( - source_assoc_validity, - valid_grouped); - - const_cstr_list update_labels = CONST_STRING_LIST("Hupdate"); - term_list update_terms = gnode_get_asmps(body, update_labels); - term update_tm = update_terms[0]; - thm update_raw = assume_rule(update_tm); - thm update = beta_rule(update_raw); - term combined_hidden_tm = ` - ra_op - (ghost_heap_ra (G:(A)ra)) - (SND (explicit_frame: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)) - (hidden:(num,A)finmap) - `; - thm update_at_frame = spec_rule(combined_hidden_tm, update); - thm selected = mp_rule(update_at_frame, valid_for_update); - body = ASSUME_TAC(body, selected, "Hselected"); - body = ASMP_EXISTS_TAC(body, "Hselected", "selected"); - body = ASMP_CONJ_TAC( - body, - "Hselected", - "HP_selected", - "Hvalid_selected"); - - term selected_tm = `selected:(num,A)finmap`; - term exposed_result_tm = ` - ra_op - (ghost_heap_ra (G:(A)ra)) - (selected:(num,A)finmap) - (SND (explicit_frame: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)) - `; - body = EXISTS_TAC(body, exposed_result_tm); - gnode_list result = CONJ_TAC(body); - - conv beta = get_conversion_by_name("BETA_CONV"); - conv beta_depth = depth_conv(beta); - gnode post = CONV_TAC(result[0], beta_depth); - term updated_selected_tm = ` - (FST (updated: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap), - selected:(num,A)finmap) - `; - post = EXISTS_TAC(post, updated_selected_tm); - term explicit_frame_tm = ` - explicit_frame: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap - `; - post = EXISTS_TAC(post, explicit_frame_tm); - gnode_list post1 = CONJ_TAC(post); - - term fst_function = ` - FST: - (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> - (int,(pmem_byte_state)excl)finmap - `; - thm split_fst = ap_term_rule(fst_function, split); - thm fst = get_theorem_by_name("FST"); - thm_list fst_rewrites = THM_LIST(C_RESOURCE_RA_OP, fst); - split_fst = pure_rewrite_rule(fst_rewrites, split_fst); - - thm_list resource_op_rewrites = THM_LIST( - C_RESOURCE_RA_OP, - fst, - snd); - conv unfold_resource_op = pure_rewrite_conv(resource_op_rewrites); - gnode post_eq = CONV_TAC(post1[0], unfold_resource_op); - thm pair_eq = get_theorem_by_name("PAIR_EQ"); - thm_list pair_eq_rewrites = THM_LIST(pair_eq); - conv expose_pair_eq = once_rewrite_conv(pair_eq_rewrites); - post_eq = CONV_TAC(post_eq, expose_pair_eq); - gnode_list post_eq_parts = CONJ_TAC(post_eq); - ACCEPT_TAC(post_eq_parts[0], split_fst); - thm exposed_result_refl = refl_rule(exposed_result_tm); - ACCEPT_TAC(post_eq_parts[1], exposed_result_refl); - - gnode_list post2 = CONJ_TAC(post1[1]); - const_cstr_list selected_pred_labels = - CONST_STRING_LIST("HP_selected"); - term_list selected_pred_terms = gnode_get_asmps( - post2[0], - selected_pred_labels); - term selected_pred_tm = selected_pred_terms[0]; - thm selected_pred_raw = assume_rule(selected_pred_tm); - thm selected_pred = beta_rule(selected_pred_raw); - ACCEPT_TAC(post2[0], selected_pred); - const_cstr_list frame_pred_labels = - CONST_STRING_LIST("Hframe_pred"); - term_list frame_pred_terms = gnode_get_asmps( - post2[1], - frame_pred_labels); - term frame_pred_tm = frame_pred_terms[0]; - thm frame_pred = assume_rule(frame_pred_tm); - ACCEPT_TAC(post2[1], frame_pred); - - term_list result_assoc_arguments = TERM_LIST( - ghost_heap_ra_tm, - selected_tm, - explicit_ghost_tm, - hidden_tm); - thm result_assoc = ispecl_rule( - result_assoc_arguments, - RA_ASSOC); - thm result_assoc_validity = ap_term_rule( - `ra_valid (ghost_heap_ra (G:(A)ra)):(num,A)finmap->bool`, - result_assoc); - const_cstr_list selected_valid_labels = - CONST_STRING_LIST("Hvalid_selected"); - term_list selected_valid_terms = gnode_get_asmps( - result[1], - selected_valid_labels); - term selected_valid_tm = selected_valid_terms[0]; - thm selected_valid = assume_rule(selected_valid_tm); - thm regroup_result = gsym_rule(result_assoc_validity); - thm result_valid = eq_mp_rule(regroup_result, selected_valid); - ACCEPT_TAC(result[1], result_valid); - thm proved = gnode_prove(root); - return proved; -} - -PROOF thm C_BUPD_FRAME = prove_c_bupd_frame(); - -/* ------------------------------------------------------------------------- */ -/* Viewshift laws */ -/* ------------------------------------------------------------------------- */ - -PROOF static thm prove_c_entails_to_viewshift(void) { - term goal_tm = ` - forall - (G:(A)ra) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). - r_entails (c_resource_ra G) P Q ==> - c_viewshift G P Q - `; - gnode root = gnode_new_with_ccl(goal_tm); - thm_list viewshift_definitions = THM_LIST(c_viewshift_def); - conv expose_viewshift = once_rewrite_conv(viewshift_definitions); - gnode body = CONV_TAC(root, expose_viewshift); - body = AUTO_INTROS_TAC(body); - - term resource_ra = `c_resource_ra (G:(A)ra)`; - term source = - `P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term target = - `Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term updated_target = `c_bupd (G:(A)ra) Q`; - term_list trans_arguments = TERM_LIST( - resource_ra, - source, - target, - updated_target); - thm transitivity = ispecl_rule( - trans_arguments, - R_ENTAILS_TRANS); - term entailment_tm = ` - r_entails - (c_resource_ra (G:(A)ra)) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - `; - thm entailment = assume_rule(entailment_tm); - thm transitivity_at_entailment = mp_rule( - transitivity, - entailment); - - term ghost_ra = `G:(A)ra`; - term_list intro_arguments = TERM_LIST(ghost_ra, target); - thm target_intro = ispecl_rule( - intro_arguments, - C_BUPD_INTRO); - thm result = mp_rule( - transitivity_at_entailment, - target_intro); - ACCEPT_TAC(body, result); - thm proved = gnode_prove(root); - return proved; -} - -PROOF thm C_ENTAILS_TO_VIEWSHIFT = - prove_c_entails_to_viewshift(); - -PROOF static thm prove_c_viewshift_refl(void) { - term goal_tm = ` - forall - (G:(A)ra) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). - c_viewshift G P P - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - - term ghost_ra = `G:(A)ra`; - term assertion = - `P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term_list lift_arguments = TERM_LIST( - ghost_ra, - assertion, - assertion); - thm lift = ispecl_rule( - lift_arguments, - C_ENTAILS_TO_VIEWSHIFT); - - term resource_ra = `c_resource_ra (G:(A)ra)`; - term_list reflexivity_arguments = TERM_LIST( - resource_ra, - assertion); - thm reflexivity = ispecl_rule( - reflexivity_arguments, - R_ENTAILS_REFL); - thm result = mp_rule(lift, reflexivity); - ACCEPT_TAC(body, result); - thm proved = gnode_prove(root); - return proved; -} - -PROOF thm C_VIEWSHIFT_REFL = prove_c_viewshift_refl(); - -PROOF static thm prove_c_viewshift_trans(void) { - term goal_tm = ` - forall - (G:(A)ra) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (S:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). - c_viewshift G P Q ==> - c_viewshift G Q S ==> - c_viewshift G P S - `; - gnode root = gnode_new_with_ccl(goal_tm); - thm_list viewshift_definitions = THM_LIST(c_viewshift_def); - conv expose_viewshift = pure_rewrite_conv(viewshift_definitions); - gnode body = CONV_TAC(root, expose_viewshift); - body = AUTO_INTROS_TAC(body); - - term ghost_ra = `G:(A)ra`; - term resource_ra = `c_resource_ra (G:(A)ra)`; - term source = - `P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term middle = - `Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term target = - `S:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term updated_middle = `c_bupd (G:(A)ra) Q`; - term updated_target = `c_bupd (G:(A)ra) S`; - term nested_updated_target = `c_bupd (G:(A)ra) (c_bupd G S)`; - - term_list mono_arguments = TERM_LIST( - ghost_ra, - middle, - updated_target); - thm lift_second = ispecl_rule( - mono_arguments, - C_BUPD_MONO); - term second_entailment_tm = ` - r_entails - (c_resource_ra (G:(A)ra)) - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (c_bupd - G - (S:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)) - `; - thm second_entailment = assume_rule(second_entailment_tm); - thm lifted_second = mp_rule(lift_second, second_entailment); - - term_list collapse_arguments = TERM_LIST( - resource_ra, - updated_middle, - nested_updated_target, - updated_target); - thm collapse_transitivity = ispecl_rule( - collapse_arguments, - R_ENTAILS_TRANS); - thm collapse_after_lift = mp_rule( - collapse_transitivity, - lifted_second); - term_list idempotence_arguments = TERM_LIST( - ghost_ra, - target); - thm idempotence = ispecl_rule( - idempotence_arguments, - C_BUPD_IDEM); - thm collapsed = mp_rule(collapse_after_lift, idempotence); - - term_list result_arguments = TERM_LIST( - resource_ra, - source, - updated_middle, - updated_target); - thm result_transitivity = ispecl_rule( - result_arguments, - R_ENTAILS_TRANS); - term first_entailment_tm = ` - r_entails - (c_resource_ra (G:(A)ra)) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (c_bupd - G - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)) - `; - thm first_entailment = assume_rule(first_entailment_tm); - thm result_after_first = mp_rule( - result_transitivity, - first_entailment); - thm result = mp_rule(result_after_first, collapsed); - ACCEPT_TAC(body, result); - thm proved = gnode_prove(root); - return proved; -} - -PROOF thm C_VIEWSHIFT_TRANS = prove_c_viewshift_trans(); - -PROOF static thm prove_c_viewshift_mono(void) { - term goal_tm = ` - forall - (G:(A)ra) - (P2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). - r_entails (c_resource_ra G) P2 P ==> - c_viewshift G P Q ==> - r_entails (c_resource_ra G) Q Q2 ==> - c_viewshift G P2 Q2 - `; - gnode root = gnode_new_with_ccl(goal_tm); - thm_list viewshift_definitions = THM_LIST(c_viewshift_def); - conv expose_viewshift = pure_rewrite_conv(viewshift_definitions); - gnode body = CONV_TAC(root, expose_viewshift); - body = AUTO_INTROS_TAC(body); - - term ghost_ra = `G:(A)ra`; - term resource_ra = `c_resource_ra (G:(A)ra)`; - term outer_source = - `P2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term source = - `P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term target = - `Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term outer_target = - `Q2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term updated_target = `c_bupd (G:(A)ra) Q`; - term updated_outer_target = `c_bupd (G:(A)ra) Q2`; - - term_list mono_arguments = TERM_LIST( - ghost_ra, - target, - outer_target); - thm lift_post = ispecl_rule( - mono_arguments, - C_BUPD_MONO); - term post_entailment_tm = ` - r_entails - (c_resource_ra (G:(A)ra)) - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - `; - thm post_entailment = assume_rule(post_entailment_tm); - thm lifted_post = mp_rule(lift_post, post_entailment); - - term_list post_change_arguments = TERM_LIST( - resource_ra, - source, - updated_target, - updated_outer_target); - thm post_change_transitivity = ispecl_rule( - post_change_arguments, - R_ENTAILS_TRANS); - term viewshift_entailment_tm = ` - r_entails - (c_resource_ra (G:(A)ra)) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (c_bupd - G - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)) - `; - thm viewshift_entailment = assume_rule(viewshift_entailment_tm); - thm post_change_after_viewshift = mp_rule( - post_change_transitivity, - viewshift_entailment); - thm changed_post = mp_rule( - post_change_after_viewshift, - lifted_post); - - term_list result_arguments = TERM_LIST( - resource_ra, - outer_source, - source, - updated_outer_target); - thm result_transitivity = ispecl_rule( - result_arguments, - R_ENTAILS_TRANS); - term pre_entailment_tm = ` - r_entails - (c_resource_ra (G:(A)ra)) - (P2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - `; - thm pre_entailment = assume_rule(pre_entailment_tm); - thm result_after_pre = mp_rule( - result_transitivity, - pre_entailment); - thm result = mp_rule(result_after_pre, changed_post); - ACCEPT_TAC(body, result); - thm proved = gnode_prove(root); - return proved; -} - -PROOF thm C_VIEWSHIFT_MONO = prove_c_viewshift_mono(); - -PROOF static thm prove_c_viewshift_frame(void) { - term goal_tm = ` - forall - (G:(A)ra) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Frame:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). - c_viewshift G P Q ==> - c_viewshift - G - (r_sep (c_resource_ra G) P Frame) - (r_sep (c_resource_ra G) Q Frame) - `; - gnode root = gnode_new_with_ccl(goal_tm); - thm_list viewshift_definitions = THM_LIST(c_viewshift_def); - conv expose_viewshift = pure_rewrite_conv(viewshift_definitions); - gnode body = CONV_TAC(root, expose_viewshift); - body = AUTO_INTROS_TAC(body); - - term ghost_ra = `G:(A)ra`; - term resource_ra = `c_resource_ra (G:(A)ra)`; - term source = - `P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term target = - `Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term frame = - `Frame:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term updated_target = `c_bupd (G:(A)ra) Q`; - term framed_source = `r_sep (c_resource_ra (G:(A)ra)) P Frame`; - term framed_update = ` - r_sep (c_resource_ra (G:(A)ra)) (c_bupd G Q) Frame - `; - term updated_frame = ` - c_bupd (G:(A)ra) (r_sep (c_resource_ra G) Q Frame) - `; - - term_list sep_frame_arguments = TERM_LIST( - resource_ra, - source, - updated_target, - frame); - thm sep_frame = ispecl_rule( - sep_frame_arguments, - R_SEP_FRAME_L); - term viewshift_entailment_tm = ` - r_entails - (c_resource_ra (G:(A)ra)) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (c_bupd - G - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool)) - `; - thm viewshift_entailment = assume_rule(viewshift_entailment_tm); - thm expose_update = mp_rule( - sep_frame, - viewshift_entailment); - - term_list transitivity_arguments = TERM_LIST( - resource_ra, - framed_source, - framed_update, - updated_frame); - thm transitivity = ispecl_rule( - transitivity_arguments, - R_ENTAILS_TRANS); - thm transitivity_after_expose = mp_rule( - transitivity, - expose_update); - term_list update_frame_arguments = TERM_LIST( - ghost_ra, - target, - frame); - thm update_frame = ispecl_rule( - update_frame_arguments, - C_BUPD_FRAME); - thm result = mp_rule( - transitivity_after_expose, - update_frame); - ACCEPT_TAC(body, result); - thm proved = gnode_prove(root); - return proved; -} - -PROOF thm C_VIEWSHIFT_FRAME = prove_c_viewshift_frame(); - -/* One entailment direction of exact SEP commutativity. */ -PROOF static thm prove_c_sep_comm_entails(void) { - term goal_tm = ` - forall - (G:(A)ra) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). - r_entails - (c_resource_ra G) - (r_sep (c_resource_ra G) P Q) - (r_sep (c_resource_ra G) Q P) - `; - gnode root = gnode_new_with_ccl(goal_tm); - thm_list entailment_definitions = THM_LIST(r_entails_def); - conv expose_entailment = once_rewrite_conv(entailment_definitions); - gnode body = CONV_TAC(root, expose_entailment); - body = AUTO_INTROS_TAC(body); - term resource_ra = `c_resource_ra (G:(A)ra)`; - term left = - `P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term right = - `Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term_list commute_arguments = TERM_LIST( - resource_ra, - left, - right); - thm commute = ispecl_rule( - commute_arguments, - R_SEP_COMM); - term resource = ` - resource:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap - `; - thm commute_at = ap_thm_rule( - commute, - resource); - term separated_tm = ` - r_sep - (c_resource_ra (G:(A)ra)) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (resource:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) - `; - thm separated = assume_rule(separated_tm); - thm result = eq_mp_rule(commute_at, separated); - ACCEPT_TAC(body, result); - thm proved = gnode_prove(root); - return proved; -} - -PROOF static thm C_SEP_COMM_ENTAILS = - prove_c_sep_comm_entails(); - -PROOF static thm prove_c_viewshift_frame_left(void) { - term goal_tm = ` - forall - (G:(A)ra) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Frame:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). - c_viewshift G P Q ==> - c_viewshift - G - (r_sep (c_resource_ra G) Frame P) - (r_sep (c_resource_ra G) Frame Q) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - - term ghost_ra = `G:(A)ra`; - term source = - `P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term target = - `Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term frame = - `Frame:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - - term_list frame_arguments = TERM_LIST( - ghost_ra, - source, - target, - frame); - thm frame_rule = ispecl_rule( - frame_arguments, - C_VIEWSHIFT_FRAME); - term viewshift_tm = ` - c_viewshift - (G:(A)ra) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - `; - thm viewshift = assume_rule(viewshift_tm); - thm right_framed = mp_rule(frame_rule, viewshift); - - term_list source_commute_arguments = TERM_LIST( - ghost_ra, - frame, - source); - thm source_commute = ispecl_rule( - source_commute_arguments, - C_SEP_COMM_ENTAILS); - term_list target_commute_arguments = TERM_LIST( - ghost_ra, - target, - frame); - thm target_commute = ispecl_rule( - target_commute_arguments, - C_SEP_COMM_ENTAILS); - - term framed_source_left = ` - r_sep (c_resource_ra (G:(A)ra)) Frame P - `; - term framed_source_right = ` - r_sep (c_resource_ra (G:(A)ra)) P Frame - `; - term framed_target_right = ` - r_sep (c_resource_ra (G:(A)ra)) Q Frame - `; - term framed_target_left = ` - r_sep (c_resource_ra (G:(A)ra)) Frame Q - `; - term_list mono_arguments = TERM_LIST( - ghost_ra, - framed_source_left, - framed_source_right, - framed_target_right, - framed_target_left); - thm mono = ispecl_rule( - mono_arguments, - C_VIEWSHIFT_MONO); - thm after_source_commute = mp_rule( - mono, - source_commute); - thm after_right_frame = mp_rule( - after_source_commute, - right_framed); - thm result = mp_rule( - after_right_frame, - target_commute); - ACCEPT_TAC(body, result); - thm proved = gnode_prove(root); - return proved; -} - -PROOF static thm C_VIEWSHIFT_FRAME_LEFT = - prove_c_viewshift_frame_left(); - -PROOF static thm prove_c_viewshift_sep(void) { - term goal_tm = ` - forall - (G:(A)ra) - (P1:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q1:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (P2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). - c_viewshift G P1 Q1 ==> - c_viewshift G P2 Q2 ==> - c_viewshift - G - (r_sep (c_resource_ra G) P1 P2) - (r_sep (c_resource_ra G) Q1 Q2) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - - term ghost_ra = `G:(A)ra`; - term source_left = - `P1:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term target_left = - `Q1:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term source_right = - `P2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term target_right = - `Q2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - - term_list first_arguments = TERM_LIST( - ghost_ra, - source_left, - target_left, - source_right); - thm first_frame = ispecl_rule( - first_arguments, - C_VIEWSHIFT_FRAME); - term first_viewshift_tm = ` - c_viewshift - (G:(A)ra) - (P1:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q1:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - `; - thm first_viewshift = assume_rule(first_viewshift_tm); - thm first = mp_rule(first_frame, first_viewshift); - - term_list second_arguments = TERM_LIST( - ghost_ra, - source_right, - target_right, - target_left); - thm second_frame = ispecl_rule( - second_arguments, - C_VIEWSHIFT_FRAME_LEFT); - term second_viewshift_tm = ` - c_viewshift - (G:(A)ra) - (P2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q2:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - `; - thm second_viewshift = assume_rule(second_viewshift_tm); - thm second = mp_rule(second_frame, second_viewshift); - - term source = ` - r_sep (c_resource_ra (G:(A)ra)) P1 P2 - `; - term middle = ` - r_sep (c_resource_ra (G:(A)ra)) Q1 P2 - `; - term target = ` - r_sep (c_resource_ra (G:(A)ra)) Q1 Q2 - `; - term_list transitivity_arguments = TERM_LIST( - ghost_ra, - source, - middle, - target); - thm transitivity = ispecl_rule( - transitivity_arguments, - C_VIEWSHIFT_TRANS); - thm after_first = mp_rule(transitivity, first); - thm result = mp_rule(after_first, second); - ACCEPT_TAC(body, result); - thm proved = gnode_prove(root); - return proved; -} - -PROOF thm C_VIEWSHIFT_SEP = prove_c_viewshift_sep(); - -PROOF static thm prove_c_viewshift_fact(void) { - term goal_tm = ` - forall - (G:(A)ra) - (guard:bool) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). - (guard ==> c_viewshift G P Q) ==> - c_viewshift - G - (r_sep - (c_resource_ra G) - (r_fact (c_resource_ra G) guard) - P) - (r_sep - (c_resource_ra G) - (r_fact (c_resource_ra G) guard) - Q) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - gnode_list cases = BOOL_CASES_TAC(body, `guard:bool`, "Hguard"); - - term ghost_ra = `G:(A)ra`; - term resource_ra = `c_resource_ra (G:(A)ra)`; - term guard = `guard:bool`; - term fact = `r_fact (c_resource_ra (G:(A)ra)) (guard:bool)`; - term source = - `P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term target = - `Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - - thm guarded_change = assume_rule(` - (guard:bool) ==> - c_viewshift - (G:(A)ra) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - `); - thm selected_change = mp_rule( - guarded_change, - assume_rule(`guard:bool`)); - thm fact_refl = ispecl_rule( - TERM_LIST(ghost_ra, fact), - C_VIEWSHIFT_REFL); - thm combine = ispecl_rule( - TERM_LIST(ghost_ra, fact, fact, source, target), - C_VIEWSHIFT_SEP); - thm after_fact = mp_rule(combine, fact_refl); - ACCEPT_TAC(cases[0], mp_rule(after_fact, selected_change)); - - CONV_WITH_ASMP_TAC( - cases[1], - simp_conv, - THM_LIST( - c_viewshift_def, - r_entails_def, - r_sep_def, - r_fact_def)); - (void)resource_ra; - thm proved = gnode_prove(root); - ENSURE_COND( - equals_term(concl(proved), goal_tm), - "C_VIEWSHIFT_FACT does not exactly match its documented statement"); - return proved; -err: - ERR_FUN_PUTS("prove_c_viewshift_fact"); - return empty_theorem; -} - -PROOF thm C_VIEWSHIFT_FACT = - prove_c_viewshift_fact(); - -/* Eliminate a source existential while retaining one common target. */ -PROOF static thm prove_c_viewshift_exists_l(void) { - term goal_tm = ` - forall - (G:(A)ra) - (P:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). - (forall witness:B. - c_viewshift G (P witness) Q) ==> - c_viewshift - G - (r_exists (c_resource_ra G) (\bound:B. P bound)) - Q - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = GEN_TAC(root, "G"); - body = GEN_TAC(body, "P"); - body = GEN_TAC(body, "Q"); - body = DISCH_TAC(body, "Hall"); - thm_list viewshift_definitions = THM_LIST(c_viewshift_def); - conv expose_viewshift = once_rewrite_conv(viewshift_definitions); - body = CONV_TAC(body, expose_viewshift); - - term resource_ra = `c_resource_ra (G:(A)ra)`; - term source_family = - `P:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term updated_target = ` - c_bupd - G - (Q:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - `; - term_list exists_elim_arguments = TERM_LIST( - resource_ra, - source_family, - updated_target); - thm exists_elim = ispecl_rule( - exists_elim_arguments, - R_EXISTS_ELIM); - body = MATCH_MP_TAC(body, exists_elim); - body = GEN_TAC(body, "witness"); - - term witness = `witness:B`; - const_cstr_list pointwise_labels = CONST_STRING_LIST("Hall"); - term_list pointwise_terms = gnode_get_asmps(body, pointwise_labels); - term pointwise_assumption_tm = pointwise_terms[0]; - thm pointwise_assumption = assume_rule(pointwise_assumption_tm); - thm selected = spec_rule(witness, pointwise_assumption); - thm exposed = pure_once_rewrite_rule( - viewshift_definitions, - selected); - ACCEPT_TAC(body, exposed); - thm proved = gnode_prove(root); - return proved; -} - -PROOF static thm C_VIEWSHIFT_EXISTS_L = - prove_c_viewshift_exists_l(); - -/* Introduce a target existential with one explicit witness. */ -PROOF static thm prove_c_viewshift_exists_r(void) { - term goal_tm = ` - forall - (G:(A)ra) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (witness:B). - c_viewshift G P (Q witness) ==> - c_viewshift - G - P - (r_exists (c_resource_ra G) (\bound:B. Q bound)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = GEN_TAC(root, "G"); - body = GEN_TAC(body, "P"); - body = GEN_TAC(body, "Q"); - body = GEN_TAC(body, "witness"); - body = DISCH_TAC(body, "Hchange"); - thm_list viewshift_definitions = THM_LIST(c_viewshift_def); - conv expose_viewshift = once_rewrite_conv(viewshift_definitions); - body = CONV_TAC(body, expose_viewshift); - - term ghost_ra = `G:(A)ra`; - term source = - `P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term selected_target = ` - (Q:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (witness:B) - `; - const_cstr_list change_labels = CONST_STRING_LIST("Hchange"); - term_list change_terms = gnode_get_asmps(body, change_labels); - term change_assumption_tm = change_terms[0]; - thm change_assumption = assume_rule(change_assumption_tm); - thm selected = pure_once_rewrite_rule( - viewshift_definitions, - change_assumption); - - term resource_ra = `c_resource_ra (G:(A)ra)`; - term target_family = - `Q:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term witness = `witness:B`; - term_list post_inclusion_arguments = TERM_LIST( - resource_ra, - target_family, - witness); - thm post_inclusion = ispecl_rule( - post_inclusion_arguments, - R_EXISTS_INTRO); - - term existential_target = ` - r_exists - (c_resource_ra G) - (\bound:B. - (Q:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - bound) - `; - term_list bupd_mono_arguments = TERM_LIST( - ghost_ra, - selected_target, - existential_target); - thm bupd_mono = ispecl_rule( - bupd_mono_arguments, - C_BUPD_MONO); - thm lifted_post = mp_rule(bupd_mono, post_inclusion); - - term selected_update = ` - c_bupd - G - ((Q:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (witness:B)) - `; - term existential_update = ` - c_bupd - G - (r_exists - (c_resource_ra G) - (\bound:B. - (Q:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - bound)) - `; - term_list transitivity_arguments = TERM_LIST( - resource_ra, - source, - selected_update, - existential_update); - thm transitivity = ispecl_rule( - transitivity_arguments, - R_ENTAILS_TRANS); - thm after_selected = mp_rule(transitivity, selected); - thm result = mp_rule(after_selected, lifted_post); - ACCEPT_TAC(body, result); - thm proved = gnode_prove(root); - return proved; -} - -PROOF static thm C_VIEWSHIFT_EXISTS_R = - prove_c_viewshift_exists_r(); - -PROOF static thm prove_c_viewshift_exists(void) { - term goal_tm = ` - forall - (G:(A)ra) - (P:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (Q:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). - (forall witness:B. - c_viewshift G (P witness) (Q witness)) ==> - c_viewshift - G - (r_exists (c_resource_ra G) (\bound:B. P bound)) - (r_exists (c_resource_ra G) (\bound:B. Q bound)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = GEN_TAC(root, "G"); - body = GEN_TAC(body, "P"); - body = GEN_TAC(body, "Q"); - body = DISCH_TAC(body, "Hall"); - term ghost_ra = `G:(A)ra`; - term source_family = - `P:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term existential_target = ` - r_exists - (c_resource_ra G) - (\bound:B. - (Q:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - bound) - `; - term_list eliminate_source_arguments = TERM_LIST( - ghost_ra, - source_family, - existential_target); - thm eliminate_source = ispecl_rule( - eliminate_source_arguments, - C_VIEWSHIFT_EXISTS_L); - body = MATCH_MP_TAC(body, eliminate_source); - body = GEN_TAC(body, "witness"); - - term witness = `witness:B`; - const_cstr_list pointwise_labels = CONST_STRING_LIST("Hall"); - term_list pointwise_terms = gnode_get_asmps(body, pointwise_labels); - term pointwise_assumption_tm = pointwise_terms[0]; - thm pointwise_assumption = assume_rule(pointwise_assumption_tm); - thm selected = spec_rule(witness, pointwise_assumption); - - term selected_source = ` - (P:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool) - (witness:B) - `; - term target_family = - `Q:B->(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool`; - term_list introduce_target_arguments = TERM_LIST( - ghost_ra, - selected_source, - target_family, - witness); - thm introduce_target = ispecl_rule( - introduce_target_arguments, - C_VIEWSHIFT_EXISTS_R); - thm result = mp_rule(introduce_target, selected); - ACCEPT_TAC(body, result); - thm proved = gnode_prove(root); - return proved; -} - -PROOF thm C_VIEWSHIFT_EXISTS = - prove_c_viewshift_exists(); - -/* ------------------------------------------------------------------------- */ -/* Conservative-extension audit */ -/* ------------------------------------------------------------------------- */ +PROOF thm C_BUPD_PRESERVES_PHYS = + prove_c_bupd_preserves_phys(); PROOF static int audit_c_basic_update(void) { thm_list public_theorems = THM_LIST( c_bupd_def, c_viewshift_def, - C_BUPD_INTRO, - C_BUPD_MONO, - C_BUPD_IDEM, - C_BUPD_FRAME, - C_ENTAILS_TO_VIEWSHIFT, - C_VIEWSHIFT_REFL, - C_VIEWSHIFT_TRANS, - C_VIEWSHIFT_MONO, - C_VIEWSHIFT_FRAME, - C_VIEWSHIFT_SEP, - C_VIEWSHIFT_FACT, - C_VIEWSHIFT_EXISTS); - + C_BUPD_PRESERVES_PHYS); for (size_t i = 0; i < vector_size(public_theorems); ++i) { ENSURE_COND(!IS_NULL(public_theorems[i]), - "C basic-update theorem %zu is empty", i); - term_list theorem_hypotheses = hyp(public_theorems[i]); - size_t hypothesis_count = vector_size(theorem_hypotheses); - ENSURE_COND(hypothesis_count == 0, - "C basic-update theorem %zu has hypotheses", i); + "C update theorem %zu is empty", i); + ENSURE_COND(vector_size(hyp(public_theorems[i])) == 0, + "C update theorem %zu has hypotheses", i); } - thm_list final_axioms = get_all_axioms(); - size_t final_axiom_count = vector_size(final_axioms); - ENSURE_COND(final_axiom_count == C_BASIC_UPDATE_AXIOMS_BEFORE, - "C basic-update theory introduced an axiom"); + ENSURE_COND(vector_size(get_all_axioms()) == C_BASIC_UPDATE_AXIOMS_BEFORE, + "C update theory introduced an axiom"); return 0; err: ERR_FUN_PUTS("audit_c_basic_update"); return -1; } -PROOF static int _C_BASIC_UPDATE_AUDIT = - audit_c_basic_update(); +PROOF static int _C_BASIC_UPDATE_AUDIT = audit_c_basic_update(); diff --git a/theory/c_program_logic/c_basic_update.h b/theory/c_program_logic/c_basic_update.h index 24f4638..0513d74 100644 --- a/theory/c_program_logic/c_basic_update.h +++ b/theory/c_program_logic/c_basic_update.h @@ -1,154 +1,14 @@ -/** - * @file c_basic_update.h - * @brief Ghost-only basic updates and view shifts for C resource assertions. - * - * `c_bupd G Q (physical,ghost)` performs an `ra_update_nd` only in - * `ghost_heap_ra G` over carrier `(num,A)finmap`, and evaluates `Q` at - * `(physical,ghost')`. The physical projection is therefore definitionally - * fixed across every result and every hidden ghost frame. The generic - * `r_viewshift (c_resource_ra G)` is not a C view shift because it can update - * physical memory; this module exports only the restricted ghost-only relation - * below. - * - * For this header, let - * - * ```text - * R_G = c_resource_ra G - * Prop_G = carrier(R_G) -> bool - * P ⊢_G Q = r_entails R_G P Q - * P **_G Q = r_sep R_G P Q - * P ⇛_G Q = c_viewshift G P Q. - * ``` - * - * The symbol `⇛_G` is notation used only in documentation; the HOL constant - * is `c_viewshift G`. Every exported theorem below is hypothesis-free and - * universally quantified over the variables displayed in its contract. - */ - #pragma once -#include "proof/theory/c_program_logic/c_resource.h" +/* C program-level updates may change only the global ghost component. */ -/* ------------------------------------------------------------------------- */ -/* Modality and viewshift */ -/* ------------------------------------------------------------------------- */ +#include "proof/theory/c_program_logic/c_resource.h" -/** - * Defining theorem for the ghost-only basic-update modality: - * - * ```text - * ⊢ ∀G Q resource. - * c_bupd G Q resource ⇔ - * ra_update_nd (ghost_heap_ra G) (SND resource) - * (\ghost'. Q (FST resource, ghost')). - * ``` - * - * In particular, every result is evaluated with the original `FST resource`. - */ +/* `c_bupd G == r_bupd_right mem_ra G`. */ PROOF extern thm c_bupd_def; -/** - * Defining theorem for C view shift: - * - * ```text - * ⊢ ∀G P Q. c_viewshift G P Q ⇔ P ⊢_G c_bupd G Q. - * ``` - * - * This relation is intentionally narrower than - * `r_viewshift (c_resource_ra G)`. - */ +/* `c_viewshift G == r_viewshift_right mem_ra G`. */ PROOF extern thm c_viewshift_def; -/* ------------------------------------------------------------------------- */ -/* Basic-update laws */ -/* ------------------------------------------------------------------------- */ - -/** Introduction: `⊢ ∀G P. P ⊢_G c_bupd G P`. */ -PROOF extern thm C_BUPD_INTRO; - -/** - * Monotonicity: - * `⊢ ∀G P Q. (P ⊢_G Q) ⇒ (c_bupd G P ⊢_G c_bupd G Q)`. - */ -PROOF extern thm C_BUPD_MONO; - -/** Idempotence: `⊢ ∀G P. c_bupd G (c_bupd G P) ⊢_G c_bupd G P`. */ -PROOF extern thm C_BUPD_IDEM; - -/** - * Linear frame law: - * `⊢ ∀G P F. (c_bupd G P **_G F) ⊢_G c_bupd G (P **_G F)`. - * - * The frame is preserved linearly; this is not an affine weakening rule. - */ -PROOF extern thm C_BUPD_FRAME; - -/* ------------------------------------------------------------------------- */ -/* Viewshift laws */ -/* ------------------------------------------------------------------------- */ - -/** Entailment embeds into view shift: `⊢ ∀G P Q. (P ⊢_G Q) ⇒ (P ⇛_G Q)`. */ -PROOF extern thm C_ENTAILS_TO_VIEWSHIFT; - -/** Reflexivity: `⊢ ∀G P. P ⇛_G P`. */ -PROOF extern thm C_VIEWSHIFT_REFL; - -/** - * Sequential composition: - * `⊢ ∀G P Q S. (P ⇛_G Q) ⇒ (Q ⇛_G S) ⇒ (P ⇛_G S)`. - */ -PROOF extern thm C_VIEWSHIFT_TRANS; - -/** - * Consequence on both endpoints: - * - * ```text - * ⊢ ∀G P2 P Q Q2. - * (P2 ⊢_G P) ⇒ (P ⇛_G Q) ⇒ (Q ⊢_G Q2) ⇒ (P2 ⇛_G Q2). - * ``` - */ -PROOF extern thm C_VIEWSHIFT_MONO; - -/** - * Right framing: - * `⊢ ∀G P Q F. (P ⇛_G Q) ⇒ ((P **_G F) ⇛_G (Q **_G F))`. - */ -PROOF extern thm C_VIEWSHIFT_FRAME; - -/** - * Independent composition: - * - * ```text - * ⊢ ∀G P1 Q1 P2 Q2. - * (P1 ⇛_G Q1) ⇒ (P2 ⇛_G Q2) ⇒ - * ((P1 **_G P2) ⇛_G (Q1 **_G Q2)). - * ``` - */ -PROOF extern thm C_VIEWSHIFT_SEP; - -/** - * Internalize a pure guard while preserving it linearly: - * - * ```text - * ⊢ ∀G p P Q. - * (p ⇒ P ⇛_G Q) ⇒ - * ((fact_G(p) **_G P) ⇛_G (fact_G(p) **_G Q)). - * ``` - * - * When `p` is false the source assertion is empty; when it is true the fact - * is the separating unit and the supplied view shift applies. - */ -PROOF extern thm C_VIEWSHIFT_FACT; - -/** - * Pointwise view shifts lift through an SL existential: - * - * ```text - * ⊢ ∀G P Q. - * (∀w:B. P w ⇛_G Q w) ⇒ - * (r_exists R_G (\x. P x) ⇛_G r_exists R_G (\x. Q x)). - * ``` - * - * The same witness type `B` and pointwise family index are used on both sides. - */ -PROOF extern thm C_VIEWSHIFT_EXISTS; +/* Every observable result keeps the source physical projection. */ +PROOF extern thm C_BUPD_PRESERVES_PHYS; diff --git a/theory/c_program_logic/c_fnspec.c b/theory/c_program_logic/c_fnspec.c index a988527..fae39bb 100644 --- a/theory/c_program_logic/c_fnspec.c +++ b/theory/c_program_logic/c_fnspec.c @@ -10,7 +10,6 @@ PROOF static int c_fnspec_declare_markers(void) { type cell_type = mk_var_type("A"); type parameter_type = mk_var_type("B"); type int_type = mk_int_type(); - type num_type = mk_nat_type(); type bool_type = mk_bool_type(); type_list nullary_arguments = empty_list(type); @@ -27,12 +26,8 @@ PROOF static int c_fnspec_declare_markers(void) { vector_add(&memory_arguments, byte_ownership_type); type memory_type = mk_app_type("finmap", memory_arguments); - type_list ghost_heap_arguments = empty_list(type); - vector_add(&ghost_heap_arguments, num_type); - vector_add(&ghost_heap_arguments, cell_type); - type ghost_heap_type = mk_app_type("finmap", ghost_heap_arguments); - - type resource_type = mk_prod_type(memory_type, ghost_heap_type); + /* G is the complete global ghost RA, so its carrier is A itself. */ + type resource_type = mk_prod_type(memory_type, cell_type); type assertion_type = mk_fun_type(resource_type, bool_type); type_list ra_arguments = empty_list(type); diff --git a/theory/c_program_logic/c_fnspec.h b/theory/c_program_logic/c_fnspec.h index 049f253..83feec8 100644 --- a/theory/c_program_logic/c_fnspec.h +++ b/theory/c_program_logic/c_fnspec.h @@ -14,13 +14,13 @@ * * where `Prop_G = carrier(c_resource_ra G) -> bool`. They are deliberately * opaque: their operational meaning is part of the certified C-logic/QCP - * boundary, not an RA or BI equation. `c_logic_install(G)` specializes them, - * creates scoped `fnspec`/`fnspec_w` aliases, and includes those aliases in the - * immutable runtime descriptor. + * boundary, not an RA or BI equation. The named-resource installer + * `c_logic_install_named(R)` specializes `G` to `named_ra R`, creates scoped + * `fnspec`/`fnspec_w` aliases, and includes them in its immutable runtime + * descriptor. */ #pragma once #include "proof/theory/c_program_logic/c_resource.h" #include "proof/theory/c_program_logic/c_types.h" - diff --git a/theory/c_program_logic/c_ghost.c b/theory/c_program_logic/c_ghost.c new file mode 100644 index 0000000..809981a --- /dev/null +++ b/theory/c_program_logic/c_ghost.c @@ -0,0 +1,875 @@ +#include "proof/theory/c_program_logic/c_ghost.h" +#include "proof/theory/logic/gmap_ra_internal.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/c_program_logic/c_basic_update.c" +#require "proof/theory/logic/named_ra.c" + +PROOF static size_t C_GHOST_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF static thm prove_c_ghost_own_op(void) { + gnode root = gnode_new_with_ccl(` + forall (G:(A)ra) (a:A) (b:A). + r_equiv + (c_resource_ra G) + (c_ghost_own G (ra_op G a b)) + (r_sep + (c_resource_ra G) + (c_ghost_own G a) + (c_ghost_own G b)) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST( + c_resource_ra_def, + c_ghost_own_def, + c_lift_ghost_def))); + + thm own_equiv = rewrite_rule( + THM_LIST(r_equiv_def), + ispecl_rule( + TERM_LIST(`G:(A)ra`, `a:A`, `b:A`), + R_OWN_OP)); + thm own_forward = conjunct1_rule(own_equiv); + thm own_reverse = conjunct2_rule(own_equiv); + thm lifted_forward = mp_rule( + ispecl_rule( + TERM_LIST( + `mem_ra`, `G:(A)ra`, + `r_own G (ra_op G (a:A) (b:A))`, + `r_sep G (r_own G (a:A)) (r_own G (b:A))`), + R_LIFT_RIGHT_ENTAILS), + own_forward); + thm lifted_reverse = mp_rule( + ispecl_rule( + TERM_LIST( + `mem_ra`, `G:(A)ra`, + `r_sep G (r_own G (a:A)) (r_own G (b:A))`, + `r_own G (ra_op G (a:A) (b:A))`), + R_LIFT_RIGHT_ENTAILS), + own_reverse); + thm sep_equiv = rewrite_rule( + THM_LIST(r_equiv_def), + ispecl_rule( + TERM_LIST( + `mem_ra`, `G:(A)ra`, + `r_own G (a:A)`, `r_own G (b:A)`), + R_LIFT_RIGHT_SEP)); + thm sep_forward = conjunct1_rule(sep_equiv); + thm sep_reverse = conjunct2_rule(sep_equiv); + + thm forward = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra mem_ra (G:(A)ra)`, + `r_lift_right mem_ra G + (r_own G (ra_op G (a:A) (b:A)))`, + `r_lift_right mem_ra G + (r_sep G (r_own G (a:A)) (r_own G (b:A)))`, + `r_sep (prod_ra mem_ra G) + (r_lift_right mem_ra G (r_own G (a:A))) + (r_lift_right mem_ra G (r_own G (b:A)))`), + R_ENTAILS_TRANS), + lifted_forward), + sep_forward); + thm reverse = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra mem_ra (G:(A)ra)`, + `r_sep (prod_ra mem_ra G) + (r_lift_right mem_ra G (r_own G (a:A))) + (r_lift_right mem_ra G (r_own G (b:A)))`, + `r_lift_right mem_ra G + (r_sep G (r_own G (a:A)) (r_own G (b:A)))`, + `r_lift_right mem_ra G + (r_own G (ra_op G (a:A) (b:A)))`), + R_ENTAILS_TRANS), + sep_reverse), + lifted_reverse); + thm result = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra mem_ra (G:(A)ra)`, + `r_lift_right mem_ra G + (r_own G (ra_op G (a:A) (b:A)))`, + `r_sep (prod_ra mem_ra G) + (r_lift_right mem_ra G (r_own G (a:A))) + (r_lift_right mem_ra G (r_own G (b:A)))`), + R_EQUIV_INTRO), + forward), + reverse); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm C_GHOST_OWN_OP = prove_c_ghost_own_op(); + +PROOF static thm prove_c_ghost_own_valid(void) { + gnode root = gnode_new_with_ccl(` + forall (G:(A)ra) (a:A). + r_entails + (c_resource_ra G) + (c_ghost_own G a) + (r_sep + (c_resource_ra G) + (r_fact (c_resource_ra G) (ra_valid G a)) + (c_ghost_own G a)) + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + c_resource_ra_def, + c_ghost_own_def, + c_lift_ghost_def, + r_lift_right_def, + r_own_def, + r_sep_def, + r_fact_def, + PROD_RA_VALID))); + body = GEN_TAC(body, "G"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "resource"); + body = DISCH_TAC(body, "Hvalid"); + body = DISCH_TAC(body, "Hown"); + body = ASMP_CONJ_TAC(body, "Hvalid", "Hvalid_mem", "Hvalid_ghost"); + body = ASMP_CONJ_TAC(body, "Hown", "Hphys_unit", "Hghost_owned"); + + thm valid_a = eq_mp_rule( + ap_term_rule( + `ra_valid (G:(A)ra):A->bool`, + assume_rule(` + SND (resource:((int,(pmem_byte_state)excl)finmap)#A) == (a:A) + `)), + assume_rule(` + ra_valid (G:(A)ra) + (SND (resource:((int,(pmem_byte_state)excl)finmap)#A)) + `)); + body = EXISTS_TAC(body, `ra_unit (prod_ra mem_ra (G:(A)ra))`); + body = EXISTS_TAC(body, `resource:((int,(pmem_byte_state)excl)finmap)#A`); + gnode_list split = CONJ_TAC(body); + ACCEPT_TAC( + split[0], + gsym_rule(ispecl_rule( + TERM_LIST( + `prod_ra mem_ra (G:(A)ra)`, + `resource:((int,(pmem_byte_state)excl)finmap)#A`), + RA_UNIT_L))); + gnode_list predicates = CONJ_TAC(split[1]); + gnode_list fact = CONJ_TAC(predicates[0]); + ACCEPT_TAC(fact[0], valid_a); + ACCEPT_TAC(fact[1], refl_rule(`ra_unit (prod_ra mem_ra (G:(A)ra))`)); + gnode_list owned = CONJ_TAC(predicates[1]); + ACCEPT_TAC( + owned[0], + assume_rule(` + FST (resource:((int,(pmem_byte_state)excl)finmap)#A) == + ra_unit mem_ra + `)); + ACCEPT_TAC( + owned[1], + assume_rule(` + SND (resource:((int,(pmem_byte_state)excl)finmap)#A) == (a:A) + `)); + return gnode_prove(root); +} + +PROOF thm C_GHOST_OWN_VALID = prove_c_ghost_own_valid(); + +PROOF static thm prove_c_ghost_own_update(void) { + gnode root = gnode_new_with_ccl(` + forall (G:(A)ra) (a:A) (b:A). + ra_update G a b ==> + c_viewshift G (c_ghost_own G a) (c_ghost_own G b) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST( + c_viewshift_def, + c_ghost_own_def, + c_lift_ghost_def))); + thm result = mp_rule( + ispecl_rule( + TERM_LIST(`mem_ra`, `G:(A)ra`, `a:A`, `b:A`), + R_RIGHT_OWN_UPDATE), + assume_rule(`ra_update (G:(A)ra) (a:A) (b:A)`)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm C_GHOST_OWN_UPDATE = prove_c_ghost_own_update(); + +PROOF static thm prove_c_ghost_own_updatep(void) { + gnode root = gnode_new_with_ccl(` + forall (G:(A)ra) (a:A) (P:A->bool). + ra_updateP G a P ==> + c_viewshift + G + (c_ghost_own G a) + (r_exists + (c_resource_ra G) + (\b:A. + r_sep + (c_resource_ra G) + (r_fact (c_resource_ra G) (P b)) + (c_ghost_own G b))) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST( + c_resource_ra_def, + c_viewshift_def, + c_ghost_own_def, + c_lift_ghost_def))); + thm result = mp_rule( + ispecl_rule( + TERM_LIST(`mem_ra`, `G:(A)ra`, `a:A`, `P:A->bool`), + R_RIGHT_OWN_UPDATEP), + assume_rule(`ra_updateP (G:(A)ra) (a:A) (P:A->bool)`)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm C_GHOST_OWN_UPDATEP = prove_c_ghost_own_updatep(); + +PROOF static thm prove_c_ghost_own_drop(void) { + gnode root = gnode_new_with_ccl(` + forall (G:(A)ra) (a:A). + c_viewshift + G + (c_ghost_own G a) + (r_emp (c_resource_ra G)) + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + c_viewshift_def, + r_viewshift_right_def, + r_entails_def, + r_bupd_right_def, + c_resource_ra_def, + c_ghost_own_def, + c_lift_ghost_def, + r_lift_right_def, + r_own_def, + r_emp_def, + ra_updateP_def, + PROD_RA_VALID, + PROD_RA_UNIT))); + body = CONV_TAC(body, depth_conv(get_conversion_by_name("BETA_CONV"))); + body = GEN_TAC(body, "G"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "owned"); + body = DISCH_TAC(body, "Hvalid_owned"); + body = DISCH_TAC(body, "Hsource"); + body = ASMP_CONJ_TAC(body, "Hsource", "Hphys_unit", "Hghost_owned"); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hvalid_source"); + + thm valid_frame = conjunct2_rule(mp_rule( + ispecl_rule( + TERM_LIST( + `G:(A)ra`, + `SND (owned:((int,(pmem_byte_state)excl)finmap)#A)`, + `frame:A`), + RA_VALID_OP), + assume_rule(` + ra_valid + (G:(A)ra) + (ra_op G + (SND (owned:((int,(pmem_byte_state)excl)finmap)#A)) + (frame:A)) + `))); + body = EXISTS_TAC(body, `ra_unit (G:(A)ra)`); + gnode_list result = CONJ_TAC(body); + thm pair_eq = get_theorem_by_name("PAIR_EQ"); + pair_eq = ispec_rule( + `FST (owned:((int,(pmem_byte_state)excl)finmap)#A)`, pair_eq); + pair_eq = ispec_rule(`ra_unit (G:(A)ra)`, pair_eq); + pair_eq = ispec_rule(`ra_unit mem_ra`, pair_eq); + pair_eq = ispec_rule(`ra_unit (G:(A)ra)`, pair_eq); + thm physical_pair = eq_mp_rule( + gsym_rule(pair_eq), + conj_rule( + assume_rule(` + FST (owned:((int,(pmem_byte_state)excl)finmap)#A) == + ra_unit mem_ra + `), + refl_rule(`ra_unit (G:(A)ra)`))); + ACCEPT_TAC(result[0], physical_pair); + ACCEPT_TAC( + result[1], + eq_mp_rule( + ap_term_rule( + `ra_valid (G:(A)ra):A->bool`, + gsym_rule(ispecl_rule( + TERM_LIST(`G:(A)ra`, `frame:A`), + RA_UNIT_L))), + valid_frame)); + return gnode_prove(root); +} + +PROOF thm C_GHOST_OWN_DROP = prove_c_ghost_own_drop(); + +PROOF thm c_named_own_def = new_fun_definition(` + c_named_own + (R:(A)ra) + (name:num) + (a:A) = + c_ghost_own + (named_ra R) + (finmap_singleton name a) +`); + +PROOF static thm prove_c_named_own_op(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (name:num) (a:A) (b:A). + r_equiv + (c_resource_ra (named_ra R)) + (c_named_own R name (ra_op R a b)) + (r_sep + (c_resource_ra (named_ra R)) + (c_named_own R name a) + (c_named_own R name b)) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(c_named_own_def))); + thm result = ispecl_rule( + TERM_LIST( + `named_ra (R:(A)ra)`, + `finmap_singleton (name:num) (a:A)`, + `finmap_singleton (name:num) (b:A)`), + C_GHOST_OWN_OP); + result = rewrite_rule( + THM_LIST(NAMED_RA_SINGLETON_OP), + result); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm C_NAMED_OWN_OP = prove_c_named_own_op(); + +PROOF static thm prove_c_named_own_valid(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (name:num) (a:A). + r_entails + (c_resource_ra (named_ra R)) + (c_named_own R name a) + (r_sep + (c_resource_ra (named_ra R)) + (r_fact + (c_resource_ra (named_ra R)) + (ra_valid R a)) + (c_named_own R name a)) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(c_named_own_def))); + thm result = ispecl_rule( + TERM_LIST( + `named_ra (R:(A)ra)`, + `finmap_singleton (name:num) (a:A)`), + C_GHOST_OWN_VALID); + result = rewrite_rule( + THM_LIST(NAMED_RA_VALID_SINGLETON), + result); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm C_NAMED_OWN_VALID = prove_c_named_own_valid(); + +PROOF static thm prove_c_named_own_update(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (name:num) (a:A) (b:A). + ra_update R a b ==> + c_viewshift + (named_ra R) + (c_named_own R name a) + (c_named_own R name b) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(c_named_own_def))); + thm map_update = mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `name:num`, `a:A`, `b:A`), + NAMED_RA_UPDATE_SINGLETON), + assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); + thm result = mp_rule( + ispecl_rule( + TERM_LIST( + `named_ra (R:(A)ra)`, + `finmap_singleton (name:num) (a:A)`, + `finmap_singleton (name:num) (b:A)`), + C_GHOST_OWN_UPDATE), + map_update); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm C_NAMED_OWN_UPDATE = prove_c_named_own_update(); + +PROOF static thm prove_c_named_own_updatep(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (name:num) (a:A) (P:A->bool). + ra_updateP R a P ==> + c_viewshift + (named_ra R) + (c_named_own R name a) + (r_exists + (c_resource_ra (named_ra R)) + (\b:A. + r_sep + (c_resource_ra (named_ra R)) + (r_fact (c_resource_ra (named_ra R)) (P b)) + (c_named_own R name b))) + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + c_viewshift_def, + r_viewshift_right_def, + r_entails_def, + r_bupd_right_def, + c_resource_ra_def, + c_named_own_def, + c_ghost_own_def, + c_lift_ghost_def, + r_lift_right_def, + r_own_def, + r_exists_def, + r_sep_def, + r_fact_def, + ra_updateP_def))); + body = CONV_TAC(body, depth_conv(get_conversion_by_name("BETA_CONV"))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "name"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "P"); + body = DISCH_TAC(body, "Hpayload_update"); + body = GEN_TAC(body, "owned"); + body = DISCH_TAC(body, "Hvalid_owned"); + body = DISCH_TAC(body, "Hsource"); + body = ASMP_CONJ_TAC(body, "Hsource", "Hphys_unit", "Hghost_owned"); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hvalid_source"); + + term_list payload_terms = gnode_get_asmps( + body, + CONST_STRING_LIST("Hpayload_update")); + thm payload_update = eq_mp_rule( + gsym_rule(inst_rule( + TERM_PAIR_LIST( + (term_pair){`P:A->bool`, `result:A->bool`}), + ra_updateP_def)), + assume_rule(payload_terms[0])); + thm map_update = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, `name:num`, `a:A`, `P:A->bool`), + NAMED_RA_UPDATEP_SINGLETON), + payload_update); + map_update = rewrite_rule(THM_LIST(ra_updateP_def), map_update); + thm source_eq = beta_rule(ap_term_rule( + `\ghost:(num,A)finmap. + ra_valid + (named_ra (R:(A)ra)) + (ra_op (named_ra R) ghost (frame:(num,A)finmap))`, + assume_rule(` + SND + (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) == + finmap_singleton (name:num) (a:A) + `))); + thm source_valid = eq_mp_rule( + source_eq, + assume_rule(` + ra_valid + (named_ra (R:(A)ra)) + (ra_op + (named_ra R) + (SND + (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)) + (frame:(num,A)finmap)) + `)); + thm selected = mp_rule( + spec_rule(`frame:(num,A)finmap`, map_update), + source_valid); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "selected"); + body = ASMP_CONJ_TAC( + body, "Hselected", "Himage", "Hvalid_selected"); + body = ASMP_EXISTS_TAC(body, "Himage", "b"); + body = ASMP_CONJ_TAC(body, "Himage", "HP", "Hselected_eq"); + + body = EXISTS_TAC(body, `selected:(num,A)finmap`); + gnode_list result = CONJ_TAC(body); + gnode post = CONV_TAC( + result[0], + depth_conv(get_conversion_by_name("BETA_CONV"))); + post = EXISTS_TAC(post, `b:A`); + post = CONV_TAC( + post, + pure_rewrite_conv(THM_LIST( + r_sep_def, + r_fact_def, + c_named_own_def, + c_ghost_own_def, + c_lift_ghost_def, + r_lift_right_def, + r_own_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + post = CONV_TAC( + post, + depth_conv(get_conversion_by_name("BETA_CONV"))); + post = EXISTS_TAC( + post, + `ra_unit + (prod_ra mem_ra (named_ra (R:(A)ra)))`); + post = EXISTS_TAC( + post, + `(FST + (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap), + selected:(num,A)finmap)`); + gnode_list post_split = CONJ_TAC(post); + ACCEPT_TAC( + post_split[0], + gsym_rule(ispecl_rule( + TERM_LIST( + `prod_ra mem_ra (named_ra (R:(A)ra))`, + `(FST + (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap), + selected:(num,A)finmap)`), + RA_UNIT_L))); + gnode_list predicates = CONJ_TAC(post_split[1]); + gnode_list fact = CONJ_TAC(predicates[0]); + ACCEPT_TAC(fact[0], assume_rule(`(P:A->bool) (b:A)`)); + ACCEPT_TAC( + fact[1], + refl_rule(`ra_unit (prod_ra mem_ra (named_ra (R:(A)ra)))`)); + gnode_list named_owned = CONJ_TAC(predicates[1]); + term_list physical_terms = gnode_get_asmps( + named_owned[0], CONST_STRING_LIST("Hphys_unit")); + ACCEPT_TAC( + named_owned[0], + trans_rule( + ispecl_rule( + TERM_LIST( + `FST + (owned: + ((int,(pmem_byte_state)excl)finmap)# + (num,A)finmap)`, + `selected:(num,A)finmap`), + get_theorem_by_name("FST")), + assume_rule(physical_terms[0]))); + ACCEPT_TAC( + named_owned[1], + trans_rule( + ispecl_rule( + TERM_LIST( + `FST + (owned: + ((int,(pmem_byte_state)excl)finmap)# + (num,A)finmap)`, + `selected:(num,A)finmap`), + get_theorem_by_name("SND")), + assume_rule(` + (selected:(num,A)finmap) == + finmap_singleton (name:num) (b:A) + `))); + ACCEPT_TAC( + result[1], + assume_rule(` + ra_valid + (named_ra (R:(A)ra)) + (ra_op + (named_ra R) + (selected:(num,A)finmap) + (frame:(num,A)finmap)) + `)); + return gnode_prove(root); +} + +PROOF thm C_NAMED_OWN_UPDATEP = + prove_c_named_own_updatep(); + +PROOF static thm prove_c_named_own_drop(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (name:num) (a:A). + c_viewshift + (named_ra R) + (c_named_own R name a) + (r_emp (c_resource_ra (named_ra R))) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(c_named_own_def))); + thm result = ispecl_rule( + TERM_LIST( + `named_ra (R:(A)ra)`, + `finmap_singleton (name:num) (a:A)`), + C_GHOST_OWN_DROP); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm C_NAMED_OWN_DROP = prove_c_named_own_drop(); + +PROOF static thm prove_c_named_own_alloc(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (a:A) + (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). + ra_valid R a ==> + c_viewshift + (named_ra R) + P + (r_exists + (c_resource_ra (named_ra R)) + (\name:num. + r_sep + (c_resource_ra (named_ra R)) + (c_named_own R name a) + P)) + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + c_viewshift_def, + r_viewshift_right_def, + r_entails_def, + r_bupd_right_def, + c_resource_ra_def, + c_named_own_def, + c_ghost_own_def, + c_lift_ghost_def, + r_lift_right_def, + r_own_def, + r_exists_def, + r_sep_def, + ra_updateP_def, + PROD_RA_OP))); + body = CONV_TAC(body, depth_conv(get_conversion_by_name("BETA_CONV"))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "P"); + body = DISCH_TAC(body, "Hvalid_a"); + body = GEN_TAC(body, "owned"); + body = DISCH_TAC(body, "Hvalid_owned"); + body = DISCH_TAC(body, "HP"); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hvalid_source"); + + term_list valid_a_terms = gnode_get_asmps( + body, + CONST_STRING_LIST("Hvalid_a")); + term_list source_pred_terms = gnode_get_asmps( + body, + CONST_STRING_LIST("HP")); + thm source_pred = assume_rule(source_pred_terms[0]); + + thm allocation = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `SND + (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)`, + `a:A`), + NAMED_RA_ALLOC), + assume_rule(valid_a_terms[0])); + allocation = rewrite_rule(THM_LIST(ra_updateP_def), allocation); + thm selected = mp_rule( + spec_rule(`frame:(num,A)finmap`, allocation), + assume_rule(` + ra_valid + (named_ra (R:(A)ra)) + (ra_op + (named_ra R) + (SND + (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)) + (frame:(num,A)finmap)) + `)); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "result"); + body = ASMP_CONJ_TAC( + body, "Hselected", "Hallocated", "Hvalid_result"); + body = ASMP_EXISTS_TAC(body, "Hallocated", "name"); + body = ASMP_CONJ_TAC( + body, "Hallocated", "Hfresh", "Hresult_eq"); + + body = EXISTS_TAC(body, `result:(num,A)finmap`); + gnode_list update_result = CONJ_TAC(body); + gnode post = CONV_TAC( + update_result[0], + depth_conv(get_conversion_by_name("BETA_CONV"))); + post = EXISTS_TAC(post, `name:num`); + post = CONV_TAC( + post, + pure_rewrite_conv(THM_LIST( + r_sep_def, + c_named_own_def, + c_ghost_own_def, + c_lift_ghost_def, + r_lift_right_def, + r_own_def))); + post = CONV_TAC( + post, + depth_conv(get_conversion_by_name("BETA_CONV"))); + post = EXISTS_TAC( + post, + `(ra_unit mem_ra,finmap_singleton (name:num) (a:A))`); + post = EXISTS_TAC( + post, + `owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap`); + gnode_list split = CONJ_TAC(post); + + thm op_fresh = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `name:num`, + `a:A`, + `SND + (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)`), + GMAP_RA_SINGLETON_OP_FRESH), + assume_rule(` + finmap_lookup + (SND + (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)) + (name:num) == + NONE + `)); + op_fresh = rewrite_rule( + THM_LIST(gsym_rule(named_ra_def)), + op_fresh); + thm physical_eq = gsym_rule(ispecl_rule( + TERM_LIST( + `mem_ra`, + `FST + (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)`), + RA_UNIT_L)); + thm ghost_eq = trans_rule( + assume_rule(` + (result:(num,A)finmap) == + finmap_insert + (name:num) + (a:A) + (SND + (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)) + `), + gsym_rule(op_fresh)); + thm pair_eq = get_theorem_by_name("PAIR_EQ"); + pair_eq = ispec_rule( + `FST + (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)`, + pair_eq); + pair_eq = ispec_rule(`result:(num,A)finmap`, pair_eq); + pair_eq = ispec_rule( + `ra_op mem_ra + (ra_unit mem_ra) + (FST + (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap))`, + pair_eq); + pair_eq = ispec_rule( + `ra_op (named_ra (R:(A)ra)) + (finmap_singleton (name:num) (a:A)) + (SND + (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap))`, + pair_eq); + thm prod_op = ispecl_rule( + TERM_LIST( + `mem_ra`, + `named_ra (R:(A)ra)`, + `(ra_unit mem_ra,finmap_singleton (name:num) (a:A))`, + `owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap`), + PROD_RA_OP); + prod_op = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + prod_op); + ACCEPT_TAC( + split[0], + trans_rule( + eq_mp_rule( + gsym_rule(pair_eq), + conj_rule(physical_eq, ghost_eq)), + gsym_rule(prod_op))); + gnode_list predicates = CONJ_TAC(split[1]); + gnode_list named_owned = CONJ_TAC(predicates[0]); + ACCEPT_TAC( + named_owned[0], + ispecl_rule( + TERM_LIST( + `ra_unit mem_ra`, + `finmap_singleton (name:num) (a:A)`), + get_theorem_by_name("FST"))); + ACCEPT_TAC( + named_owned[1], + ispecl_rule( + TERM_LIST( + `ra_unit mem_ra`, + `finmap_singleton (name:num) (a:A)`), + get_theorem_by_name("SND"))); + ACCEPT_TAC( + predicates[1], + source_pred); + ACCEPT_TAC( + update_result[1], + assume_rule(` + ra_valid + (named_ra (R:(A)ra)) + (ra_op + (named_ra R) + (result:(num,A)finmap) + (frame:(num,A)finmap)) + `)); + return gnode_prove(root); +} + +PROOF thm C_NAMED_OWN_ALLOC = prove_c_named_own_alloc(); + +PROOF static int audit_c_ghost(void) { + thm_list public_theorems = THM_LIST( + C_GHOST_OWN_OP, + C_GHOST_OWN_VALID, + C_GHOST_OWN_UPDATE, + C_GHOST_OWN_UPDATEP, + C_GHOST_OWN_DROP, + c_named_own_def, + C_NAMED_OWN_OP, + C_NAMED_OWN_VALID, + C_NAMED_OWN_UPDATE, + C_NAMED_OWN_UPDATEP, + C_NAMED_OWN_DROP, + C_NAMED_OWN_ALLOC); + for (size_t i = 0; i < vector_size(public_theorems); ++i) { + ENSURE_COND(!IS_NULL(public_theorems[i]), + "C ghost theorem %zu is empty", i); + ENSURE_COND(vector_size(hyp(public_theorems[i])) == 0, + "C ghost theorem %zu has hypotheses", i); + } + ENSURE_COND(vector_size(get_all_axioms()) == C_GHOST_AXIOMS_BEFORE, + "C ghost theory introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_c_ghost"); + return -1; +} + +PROOF static int _C_GHOST_AUDIT = audit_c_ghost(); diff --git a/theory/c_program_logic/c_ghost.h b/theory/c_program_logic/c_ghost.h new file mode 100644 index 0000000..406eae7 --- /dev/null +++ b/theory/c_program_logic/c_ghost.h @@ -0,0 +1,21 @@ +#pragma once + +/* Generic ownership and updates for the complete global ghost RA. */ + +#include "proof/theory/c_program_logic/c_basic_update.h" +#include "proof/theory/logic/named_ra.h" + +PROOF extern thm C_GHOST_OWN_OP; +PROOF extern thm C_GHOST_OWN_VALID; +PROOF extern thm C_GHOST_OWN_UPDATE; +PROOF extern thm C_GHOST_OWN_UPDATEP; +PROOF extern thm C_GHOST_OWN_DROP; + +/* Convenience layer when the complete global RA is one named RA. */ +PROOF extern thm c_named_own_def; +PROOF extern thm C_NAMED_OWN_OP; +PROOF extern thm C_NAMED_OWN_VALID; +PROOF extern thm C_NAMED_OWN_UPDATE; +PROOF extern thm C_NAMED_OWN_UPDATEP; +PROOF extern thm C_NAMED_OWN_DROP; +PROOF extern thm C_NAMED_OWN_ALLOC; diff --git a/theory/c_program_logic/c_ghost_update.c b/theory/c_program_logic/c_ghost_update.c deleted file mode 100644 index fc9a903..0000000 --- a/theory/c_program_logic/c_ghost_update.c +++ /dev/null @@ -1,808 +0,0 @@ -#include "proof/theory/c_program_logic/c_ghost_update.h" - -#include "proof/proof_backward.h" -#require "proof/proof_backward.c" -#require "proof/theory/c_program_logic/c_basic_update.c" -#require "proof/theory/logic/ghost_heap.c" - -PROOF static thm_list C_GHOST_UPDATE_INITIAL_AXIOMS = get_all_axioms(); -PROOF static size_t C_GHOST_UPDATE_AXIOMS_BEFORE = - vector_size(C_GHOST_UPDATE_INITIAL_AXIOMS); - -/* ------------------------------------------------------------------------- */ -/* Exact ownership algebra */ -/* ------------------------------------------------------------------------- */ - -PROOF static thm prove_c_ghost_own_op(void) { - term goal_tm = ` - forall (G:(A)ra) (name:num) (a:A) (b:A). - c_ghost_own G name (ra_op G a b) == - r_sep - (c_resource_ra G) - (c_ghost_own G name a) - (c_ghost_own G name b) - `; - gnode root = gnode_new_with_ccl(goal_tm); - thm own_op_backwards = gsym_rule(R_OWN_OP); - thm fst = get_theorem_by_name("FST"); - thm snd = get_theorem_by_name("SND"); - thm_list normalization_rules = THM_LIST( - c_ghost_own_def, - own_op_backwards, - C_RESOURCE_RA_OP, - fst, - snd, - RA_UNIT_L, - GHOST_HEAP_SINGLETON_OP); - conv normalization = rewrite_conv(normalization_rules); - gnode normalized = CONV_TAC(root, normalization); - thm result = gnode_prove(root); - return result; -} - -PROOF thm C_GHOST_OWN_OP = prove_c_ghost_own_op(); - -PROOF static thm prove_c_ghost_own_valid(void) { - term goal_tm = ` - forall (G:(A)ra) (name:num) (a:A). - r_entails - (c_resource_ra G) - (c_ghost_own G name a) - (r_sep - (c_resource_ra G) - (r_fact - (c_resource_ra G) - (ra_valid G a)) - (c_ghost_own G name a)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(c_ghost_own_def))); - body = CONV_TAC( - body, - once_rewrite_conv(THM_LIST(R_FACT_SEP_L))); - - thm owned_valid = ispecl_rule( - TERM_LIST( - `c_resource_ra (G:(A)ra)`, - `(ra_unit mem_ra, - finmap_singleton (name:num) (a:A))`), - R_OWN_VALID); - thm fst = get_theorem_by_name("FST"); - thm snd = get_theorem_by_name("SND"); - thm and_clauses = get_theorem_by_name("AND_CLAUSES"); - owned_valid = pure_rewrite_rule( - THM_LIST( - C_RESOURCE_RA_VALID, - fst, - snd, - RA_VALID_UNIT, - GHOST_HEAP_VALID_SINGLETON, - and_clauses), - owned_valid); - ACCEPT_TAC(body, owned_valid); - thm proved = gnode_prove(root); - ENSURE_COND( - equals_term(concl(proved), goal_tm), - "C_GHOST_OWN_VALID does not exactly match its documented statement"); - return proved; -err: - ERR_FUN_PUTS("prove_c_ghost_own_valid"); - return empty_theorem; -} - -PROOF thm C_GHOST_OWN_VALID = - prove_c_ghost_own_valid(); - -/* ------------------------------------------------------------------------- */ -/* Fixed-name payload updates */ -/* ------------------------------------------------------------------------- */ - -/* Bridge a ghost-heap update into the C modality while fixing physical FST. */ -PROOF static thm prove_c_ghost_heap_own_update(void) { - term goal_tm = ` - forall - (G:(A)ra) - (owned:(num,A)finmap) - (selected:(num,A)finmap). - ra_update (ghost_heap_ra G) owned selected ==> - c_viewshift - G - (r_own - (c_resource_ra G) - (ra_unit mem_ra,owned)) - (r_own - (c_resource_ra G) - (ra_unit mem_ra,selected)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - thm_list definitions = THM_LIST( - c_viewshift_def, - r_entails_def, - c_bupd_def, - r_own_def, - ra_update_nd_def, - ra_update_def); - conv unfold_definitions = pure_rewrite_conv(definitions); - gnode body = CONV_TAC(root, unfold_definitions); - body = GEN_TAC(body, "G"); - body = GEN_TAC(body, "owned"); - body = GEN_TAC(body, "selected"); - body = DISCH_TAC(body, "Hupdate"); - body = GEN_TAC(body, "resource"); - body = DISCH_TAC(body, "Hvalid_resource"); - body = DISCH_TAC(body, "Hown"); - body = GEN_TAC(body, "hidden"); - body = DISCH_TAC(body, "Hvalid_source"); - - const_cstr_list own_labels = CONST_STRING_LIST("Hown"); - term_list own_terms = gnode_get_asmps(body, own_labels); - term own_tm = own_terms[0]; - thm own = assume_rule(own_tm); - term fst_function = ` - FST: - (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> - (int,(pmem_byte_state)excl)finmap - `; - thm fst_owned = ap_term_rule(fst_function, own); - thm fst = get_theorem_by_name("FST"); - thm_list fst_rewrites = THM_LIST(fst); - fst_owned = pure_rewrite_rule(fst_rewrites, fst_owned); - term snd_function = ` - SND: - (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> - (num,A)finmap - `; - thm snd_owned = ap_term_rule(snd_function, own); - thm snd = get_theorem_by_name("SND"); - thm_list snd_rewrites = THM_LIST(snd); - snd_owned = pure_rewrite_rule(snd_rewrites, snd_owned); - term validity_predicate = ` - \ghost:(num,A)finmap. - ra_valid - (ghost_heap_ra (G:(A)ra)) - (ra_op (ghost_heap_ra G) ghost (hidden:(num,A)finmap)) - `; - thm replace_source_raw = ap_term_rule( - validity_predicate, - snd_owned); - thm replace_source = beta_rule(replace_source_raw); - const_cstr_list valid_source_labels = - CONST_STRING_LIST("Hvalid_source"); - term_list valid_source_terms = gnode_get_asmps( - body, - valid_source_labels); - term valid_source_tm = valid_source_terms[0]; - thm valid_source = assume_rule(valid_source_tm); - thm valid_owned = eq_mp_rule(replace_source, valid_source); - - const_cstr_list update_labels = CONST_STRING_LIST("Hupdate"); - term_list update_terms = gnode_get_asmps(body, update_labels); - term update_tm = update_terms[0]; - thm update = assume_rule(update_tm); - term hidden_tm = `hidden:(num,A)finmap`; - thm update_at_hidden = spec_rule(hidden_tm, update); - thm valid_selected = mp_rule(update_at_hidden, valid_owned); - - term selected_tm = `selected:(num,A)finmap`; - body = EXISTS_TAC(body, selected_tm); - gnode_list result = CONJ_TAC(body); - - term resource_fst_tm = ` - FST (resource: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) - `; - term physical_unit_tm = ` - ra_unit mem_ra:(int,(pmem_byte_state)excl)finmap - `; - thm pair_eq = get_theorem_by_name("PAIR_EQ"); - term_list pair_eq_arguments = TERM_LIST( - resource_fst_tm, - selected_tm, - physical_unit_tm, - selected_tm); - thm pair_components = ispecl_rule(pair_eq_arguments, pair_eq); - thm selected_refl = refl_rule(selected_tm); - thm components = conj_rule(fst_owned, selected_refl); - thm components_to_pair = gsym_rule(pair_components); - thm exact_pair = eq_mp_rule(components_to_pair, components); - conv beta = get_conversion_by_name("BETA_CONV"); - gnode exact_goal = CONV_TAC(result[0], beta); - ACCEPT_TAC(exact_goal, exact_pair); - ACCEPT_TAC(result[1], valid_selected); - thm proved = gnode_prove(root); - return proved; -} - -PROOF static thm C_GHOST_HEAP_OWN_UPDATE = - prove_c_ghost_heap_own_update(); - -PROOF static thm prove_c_ghost_own_update(void) { - term goal_tm = ` - forall - (G:(A)ra) - (name:num) - (a:A) - (b:A). - ra_update G a b ==> - c_viewshift - G - (c_ghost_own G name a) - (c_ghost_own G name b) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - thm_list own_definitions = THM_LIST(c_ghost_own_def); - conv unfold_own = pure_rewrite_conv(own_definitions); - body = CONV_TAC(body, unfold_own); - term ghost_ra_tm = `G:(A)ra`; - term name_tm = `name:num`; - term source_value_tm = `a:A`; - term target_value_tm = `b:A`; - term_list singleton_update_arguments = TERM_LIST( - ghost_ra_tm, - name_tm, - source_value_tm, - target_value_tm); - thm singleton_update = ispecl_rule( - singleton_update_arguments, - GHOST_HEAP_UPDATE_SINGLETON); - term update_tm = `ra_update (G:(A)ra) (a:A) (b:A)`; - thm update = assume_rule(update_tm); - thm local = mp_rule(singleton_update, update); - term source_heap_tm = `finmap_singleton (name:num) (a:A)`; - term target_heap_tm = `finmap_singleton (name:num) (b:A)`; - term_list heap_update_arguments = TERM_LIST( - ghost_ra_tm, - source_heap_tm, - target_heap_tm); - thm heap_update = ispecl_rule( - heap_update_arguments, - C_GHOST_HEAP_OWN_UPDATE); - thm result = mp_rule(heap_update, local); - ACCEPT_TAC(body, result); - thm proved = gnode_prove(root); - return proved; -} - -PROOF thm C_GHOST_OWN_UPDATE = - prove_c_ghost_own_update(); - -PROOF static thm prove_c_ghost_own_update_nd(void) { - term goal_tm = ` - forall - (G:(A)ra) - (name:num) - (a:A) - (P:A->bool). - ra_update_nd G a P ==> - c_viewshift - G - (c_ghost_own G name a) - (r_exists - (c_resource_ra G) - (\b:A. - r_and - (c_resource_ra G) - (r_pure (c_resource_ra G) (P b)) - (c_ghost_own G name b))) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = GEN_TAC(root, "G"); - body = GEN_TAC(body, "name"); - body = GEN_TAC(body, "a"); - body = GEN_TAC(body, "P"); - body = DISCH_TAC(body, "Hbase_update"); - - term ghost_ra_tm = `G:(A)ra`; - term name_tm = `name:num`; - term owned_value_tm = `a:A`; - term result_predicate_tm = `P:A->bool`; - term_list local_arguments = TERM_LIST( - ghost_ra_tm, - name_tm, - owned_value_tm, - result_predicate_tm); - thm local_rule = ispecl_rule( - local_arguments, - GHOST_HEAP_UPDATE_SINGLETON_ND); - const_cstr_list base_update_labels = - CONST_STRING_LIST("Hbase_update"); - term_list base_update_terms = gnode_get_asmps( - body, - base_update_labels); - term base_update_tm = base_update_terms[0]; - thm base_update = assume_rule(base_update_tm); - thm local = mp_rule(local_rule, base_update); - thm_list update_definitions = THM_LIST(ra_update_nd_def); - local = pure_once_rewrite_rule( - update_definitions, - local); - local = beta_rule(local); - body = ASSUME_TAC(body, local, "Hlocal_update"); - - thm_list definitions = THM_LIST( - c_viewshift_def, - r_entails_def, - c_bupd_def, - c_ghost_own_def, - r_own_def, - r_exists_def, - r_and_def, - r_pure_def, - ra_update_nd_def); - conv unfold_definitions = pure_rewrite_conv(definitions); - body = CONV_TAC(body, unfold_definitions); - body = GEN_TAC(body, "resource"); - body = DISCH_TAC(body, "Hvalid_resource"); - body = DISCH_TAC(body, "Hown"); - body = GEN_TAC(body, "hidden"); - body = DISCH_TAC(body, "Hvalid_source"); - - const_cstr_list own_labels = CONST_STRING_LIST("Hown"); - term_list own_terms = gnode_get_asmps(body, own_labels); - term own_tm = own_terms[0]; - thm own = assume_rule(own_tm); - term fst_function = ` - FST: - (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> - (int,(pmem_byte_state)excl)finmap - `; - thm fst_owned = ap_term_rule(fst_function, own); - thm fst = get_theorem_by_name("FST"); - thm_list fst_rewrites = THM_LIST(fst); - fst_owned = pure_rewrite_rule(fst_rewrites, fst_owned); - term snd_function = ` - SND: - (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> - (num,A)finmap - `; - thm snd_owned = ap_term_rule(snd_function, own); - thm snd = get_theorem_by_name("SND"); - thm_list snd_rewrites = THM_LIST(snd); - snd_owned = pure_rewrite_rule(snd_rewrites, snd_owned); - term validity_predicate = ` - \ghost:(num,A)finmap. - ra_valid - (ghost_heap_ra (G:(A)ra)) - (ra_op (ghost_heap_ra G) ghost (hidden:(num,A)finmap)) - `; - thm replace_source_raw = ap_term_rule( - validity_predicate, - snd_owned); - thm replace_source = beta_rule(replace_source_raw); - const_cstr_list valid_source_labels = - CONST_STRING_LIST("Hvalid_source"); - term_list valid_source_terms = gnode_get_asmps( - body, - valid_source_labels); - term valid_source_tm = valid_source_terms[0]; - thm valid_source = assume_rule(valid_source_tm); - thm valid_local_source = eq_mp_rule( - replace_source, - valid_source); - - const_cstr_list local_update_labels = - CONST_STRING_LIST("Hlocal_update"); - term_list local_update_terms = gnode_get_asmps( - body, - local_update_labels); - term local_update_tm = local_update_terms[0]; - thm local_update = assume_rule(local_update_tm); - term hidden_tm = `hidden:(num,A)finmap`; - thm local_at_hidden = spec_rule(hidden_tm, local_update); - thm selected = mp_rule(local_at_hidden, valid_local_source); - body = ASSUME_TAC(body, selected, "Hselected"); - body = ASMP_EXISTS_TAC(body, "Hselected", "selected_heap"); - body = ASMP_CONJ_TAC( - body, - "Hselected", - "Hselected_pred", - "Hvalid_selected"); - body = ASMP_EXISTS_TAC(body, "Hselected_pred", "b"); - body = ASMP_CONJ_TAC( - body, - "Hselected_pred", - "HP_b", - "Hselected_exact"); - - term selected_heap_tm = `selected_heap:(num,A)finmap`; - body = EXISTS_TAC(body, selected_heap_tm); - gnode_list result = CONJ_TAC(body); - conv beta = get_conversion_by_name("BETA_CONV"); - conv beta_depth = depth_conv(beta); - gnode post = CONV_TAC(result[0], beta_depth); - term selected_value_tm = `b:A`; - post = EXISTS_TAC(post, selected_value_tm); - thm_list post_definitions = THM_LIST( - r_and_def, - r_pure_def, - r_own_def); - conv unfold_post = pure_rewrite_conv(post_definitions); - post = CONV_TAC(post, unfold_post); - gnode_list post_parts = CONJ_TAC(post); - const_cstr_list selected_value_labels = CONST_STRING_LIST("HP_b"); - term_list selected_value_terms = gnode_get_asmps( - post_parts[0], - selected_value_labels); - term selected_value_fact_tm = selected_value_terms[0]; - thm selected_value_fact = assume_rule(selected_value_fact_tm); - ACCEPT_TAC(post_parts[0], selected_value_fact); - - const_cstr_list selected_exact_labels = - CONST_STRING_LIST("Hselected_exact"); - term_list selected_exact_terms = gnode_get_asmps( - post_parts[1], - selected_exact_labels); - term selected_exact_tm = selected_exact_terms[0]; - thm selected_exact = assume_rule(selected_exact_tm); - term resource_fst_tm = ` - FST (resource: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) - `; - term physical_unit_tm = ` - ra_unit mem_ra:(int,(pmem_byte_state)excl)finmap - `; - term singleton_selected_tm = ` - finmap_singleton (name:num) (b:A) - `; - thm pair_eq = get_theorem_by_name("PAIR_EQ"); - term_list pair_eq_arguments = TERM_LIST( - resource_fst_tm, - selected_heap_tm, - physical_unit_tm, - singleton_selected_tm); - thm pair_components = ispecl_rule(pair_eq_arguments, pair_eq); - thm components = conj_rule(fst_owned, selected_exact); - thm components_to_pair = gsym_rule(pair_components); - thm exact_pair = eq_mp_rule(components_to_pair, components); - ACCEPT_TAC(post_parts[1], exact_pair); - - const_cstr_list selected_valid_labels = - CONST_STRING_LIST("Hvalid_selected"); - term_list selected_valid_terms = gnode_get_asmps( - result[1], - selected_valid_labels); - term selected_valid_tm = selected_valid_terms[0]; - thm selected_valid = assume_rule(selected_valid_tm); - ACCEPT_TAC(result[1], selected_valid); - thm proved = gnode_prove(root); - return proved; -} - -PROOF thm C_GHOST_OWN_UPDATE_ND = - prove_c_ghost_own_update_nd(); - -PROOF static thm prove_c_ghost_own_dealloc(void) { - term goal_tm = ` - forall (G:(A)ra) (name:num) (a:A). - c_viewshift - G - (c_ghost_own G name a) - (r_emp (c_resource_ra G)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(c_ghost_own_def))); - - term ghost_ra = `G:(A)ra`; - term source = `finmap_singleton (name:num) (a:A)`; - term empty = `finmap_empty:(num,A)finmap`; - thm heap_release = ispecl_rule( - TERM_LIST(ghost_ra, `name:num`, `a:A`), - GHOST_HEAP_DEALLOC); - thm bridge = ispecl_rule( - TERM_LIST(ghost_ra, source, empty), - C_GHOST_HEAP_OWN_UPDATE); - thm released = mp_rule(bridge, heap_release); - - thm ghost_unit = ispec_rule(ghost_ra, GHOST_HEAP_UNIT); - released = pure_once_rewrite_rule( - THM_LIST(gsym_rule(ghost_unit)), - released); - thm resource_unit = ispec_rule(ghost_ra, C_RESOURCE_RA_UNIT); - released = pure_once_rewrite_rule( - THM_LIST(gsym_rule(resource_unit)), - released); - released = pure_once_rewrite_rule( - THM_LIST(R_OWN_UNIT), - released); - ACCEPT_TAC(body, released); - thm proved = gnode_prove(root); - ENSURE_COND( - equals_term(concl(proved), goal_tm), - "C_GHOST_OWN_DEALLOC does not exactly match its documented statement"); - return proved; -err: - ERR_FUN_PUTS("prove_c_ghost_own_dealloc"); - return empty_theorem; -} - -PROOF thm C_GHOST_OWN_DEALLOC = - prove_c_ghost_own_dealloc(); - -/* ------------------------------------------------------------------------- */ -/* Fresh-name allocation */ -/* ------------------------------------------------------------------------- */ - -PROOF static thm prove_c_ghost_own_alloc_empty(void) { - term goal_tm = ` - forall (G:(A)ra) (a:A). - ra_valid G a ==> - c_viewshift - G - (r_emp (c_resource_ra G)) - (r_exists - (c_resource_ra G) - (\name:num. c_ghost_own G name a)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - thm_list definitions = THM_LIST( - c_viewshift_def, - r_entails_def, - c_bupd_def, - r_emp_def, - r_exists_def, - c_ghost_own_def, - r_own_def); - conv unfold_definitions = pure_rewrite_conv(definitions); - gnode body = CONV_TAC(root, unfold_definitions); - conv beta = get_conversion_by_name("BETA_CONV"); - conv beta_depth = depth_conv(beta); - body = CONV_TAC(body, beta_depth); - body = GEN_TAC(body, "G"); - body = GEN_TAC(body, "a"); - body = DISCH_TAC(body, "Hvalid_a"); - body = GEN_TAC(body, "resource"); - body = DISCH_TAC(body, "Hvalid_resource"); - body = DISCH_TAC(body, "Hemp"); - thm_list update_definitions = THM_LIST(ra_update_nd_def); - conv expose_update = once_rewrite_conv(update_definitions); - body = CONV_TAC(body, expose_update); - body = GEN_TAC(body, "hidden"); - body = DISCH_TAC(body, "Hvalid_source"); - - const_cstr_list emp_labels = CONST_STRING_LIST("Hemp"); - term_list emp_terms = gnode_get_asmps(body, emp_labels); - term emp_tm = emp_terms[0]; - thm emp = assume_rule(emp_tm); - term ghost_ra_tm = `G:(A)ra`; - thm resource_unit_rule = ispec_rule( - ghost_ra_tm, - C_RESOURCE_RA_UNIT); - thm resource_unit = trans_rule(emp, resource_unit_rule); - term fst_function = ` - FST: - (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> - (int,(pmem_byte_state)excl)finmap - `; - thm fst_empty = ap_term_rule(fst_function, resource_unit); - thm fst = get_theorem_by_name("FST"); - thm_list fst_rewrites = THM_LIST(fst); - fst_empty = pure_rewrite_rule(fst_rewrites, fst_empty); - term snd_function = ` - SND: - (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> - (num,A)finmap - `; - thm snd_empty = ap_term_rule(snd_function, resource_unit); - thm snd = get_theorem_by_name("SND"); - thm_list snd_rewrites = THM_LIST(snd); - snd_empty = pure_rewrite_rule(snd_rewrites, snd_empty); - thm ghost_heap_unit = ispec_rule(ghost_ra_tm, GHOST_HEAP_UNIT); - snd_empty = trans_rule(snd_empty, ghost_heap_unit); - - term source_validity_predicate = ` - \ghost:(num,A)finmap. - ra_valid - (ghost_heap_ra (G:(A)ra)) - (ra_op - (ghost_heap_ra G) - ghost - (hidden:(num,A)finmap)) - `; - thm replace_source_raw = ap_term_rule( - source_validity_predicate, - snd_empty); - thm replace_source = beta_rule(replace_source_raw); - const_cstr_list valid_source_labels = - CONST_STRING_LIST("Hvalid_source"); - term_list valid_source_terms = gnode_get_asmps( - body, - valid_source_labels); - term valid_source_tm = valid_source_terms[0]; - thm valid_source = assume_rule(valid_source_tm); - thm valid_empty_source = eq_mp_rule( - replace_source, - valid_source); - - term owned_value_tm = `a:A`; - term_list allocation_arguments = TERM_LIST( - ghost_ra_tm, - owned_value_tm); - thm allocation_rule = ispecl_rule( - allocation_arguments, - GHOST_HEAP_ALLOC_EMPTY); - const_cstr_list value_valid_labels = CONST_STRING_LIST("Hvalid_a"); - term_list value_valid_terms = gnode_get_asmps( - body, - value_valid_labels); - term value_valid_tm = value_valid_terms[0]; - thm value_valid = assume_rule(value_valid_tm); - thm allocation = mp_rule(allocation_rule, value_valid); - allocation = pure_once_rewrite_rule( - update_definitions, - allocation); - allocation = beta_rule(allocation); - term hidden_tm = `hidden:(num,A)finmap`; - thm allocation_at_hidden = spec_rule(hidden_tm, allocation); - thm selected = mp_rule(allocation_at_hidden, valid_empty_source); - body = ASSUME_TAC(body, selected, "Hselected"); - body = ASMP_EXISTS_TAC(body, "Hselected", "result_heap"); - body = ASMP_CONJ_TAC( - body, - "Hselected", - "Hallocated", - "Hvalid_result"); - body = ASMP_EXISTS_TAC(body, "Hallocated", "name"); - - term result_heap_tm = `result_heap:(num,A)finmap`; - body = EXISTS_TAC(body, result_heap_tm); - gnode_list result = CONJ_TAC(body); - gnode post = CONV_TAC(result[0], beta_depth); - term name_tm = `name:num`; - post = EXISTS_TAC(post, name_tm); - thm_list own_definitions = THM_LIST(r_own_def); - conv unfold_own = pure_rewrite_conv(own_definitions); - post = CONV_TAC(post, unfold_own); - - const_cstr_list allocated_labels = CONST_STRING_LIST("Hallocated"); - term_list allocated_terms = gnode_get_asmps(post, allocated_labels); - term allocated_tm = allocated_terms[0]; - thm allocated = assume_rule(allocated_tm); - term resource_fst_tm = ` - FST (resource: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) - `; - term physical_unit_tm = ` - ra_unit mem_ra:(int,(pmem_byte_state)excl)finmap - `; - term singleton_tm = `finmap_singleton (name:num) (a:A)`; - thm pair_eq = get_theorem_by_name("PAIR_EQ"); - term_list pair_eq_arguments = TERM_LIST( - resource_fst_tm, - result_heap_tm, - physical_unit_tm, - singleton_tm); - thm pair_components = ispecl_rule(pair_eq_arguments, pair_eq); - thm components = conj_rule(fst_empty, allocated); - thm components_to_pair = gsym_rule(pair_components); - thm exact_pair = eq_mp_rule(components_to_pair, components); - ACCEPT_TAC(post, exact_pair); - - const_cstr_list result_valid_labels = - CONST_STRING_LIST("Hvalid_result"); - term_list result_valid_terms = gnode_get_asmps( - result[1], - result_valid_labels); - term result_valid_tm = result_valid_terms[0]; - thm result_valid = assume_rule(result_valid_tm); - ACCEPT_TAC(result[1], result_valid); - thm proved = gnode_prove(root); - return proved; -} - -PROOF thm C_GHOST_OWN_ALLOC_EMPTY = - prove_c_ghost_own_alloc_empty(); - -PROOF static thm prove_c_ghost_own_alloc(void) { - term goal_tm = ` - forall - (G:(A)ra) - (a:A) - (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). - ra_valid G a ==> - c_viewshift - G - P - (r_exists - (c_resource_ra G) - (\name:num. - r_sep - (c_resource_ra G) - (c_ghost_own G name a) - P)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = GEN_TAC(root, "G"); - body = GEN_TAC(body, "a"); - body = GEN_TAC(body, "P"); - body = DISCH_TAC(body, "Hvalid_a"); - - term ghost_ra_tm = `G:(A)ra`; - term owned_value_tm = `a:A`; - term_list empty_allocation_arguments = TERM_LIST( - ghost_ra_tm, - owned_value_tm); - thm empty_allocation_rule = ispecl_rule( - empty_allocation_arguments, - C_GHOST_OWN_ALLOC_EMPTY); - const_cstr_list value_valid_labels = CONST_STRING_LIST("Hvalid_a"); - term_list value_valid_terms = gnode_get_asmps( - body, - value_valid_labels); - term value_valid_tm = value_valid_terms[0]; - thm value_valid = assume_rule(value_valid_tm); - thm empty_allocation = mp_rule( - empty_allocation_rule, - value_valid); - - term empty_source_tm = `r_emp (c_resource_ra (G:(A)ra))`; - term allocated_target_tm = ` - r_exists - (c_resource_ra (G:(A)ra)) - (\name:num. c_ghost_own G name (a:A)) - `; - term frame_tm = ` - P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool - `; - term_list frame_arguments = TERM_LIST( - ghost_ra_tm, - empty_source_tm, - allocated_target_tm, - frame_tm); - thm frame_rule = ispecl_rule(frame_arguments, C_VIEWSHIFT_FRAME); - thm framed = mp_rule(frame_rule, empty_allocation); - thm_list normalization_rules = THM_LIST( - R_SEP_EMP_L, - R_SEP_EXISTS_L); - thm normalized = pure_rewrite_rule( - normalization_rules, - framed); - normalized = beta_rule(normalized); - ACCEPT_TAC(body, normalized); - thm proved = gnode_prove(root); - return proved; -} - -PROOF thm C_GHOST_OWN_ALLOC = - prove_c_ghost_own_alloc(); - -/* ------------------------------------------------------------------------- */ -/* Conservative-extension audit */ -/* ------------------------------------------------------------------------- */ - -PROOF static int audit_c_ghost_update(void) { - thm_list public_theorems = THM_LIST( - C_GHOST_OWN_OP, - C_GHOST_OWN_VALID, - C_GHOST_OWN_UPDATE, - C_GHOST_OWN_UPDATE_ND, - C_GHOST_OWN_DEALLOC, - C_GHOST_OWN_ALLOC_EMPTY, - C_GHOST_OWN_ALLOC); - - for (size_t i = 0; i < vector_size(public_theorems); ++i) { - ENSURE_COND(!IS_NULL(public_theorems[i]), - "C ghost-update theorem %zu is empty", i); - term_list theorem_hypotheses = hyp(public_theorems[i]); - size_t hypothesis_count = vector_size(theorem_hypotheses); - ENSURE_COND(hypothesis_count == 0, - "C ghost-update theorem %zu has hypotheses", i); - } - thm_list final_axioms = get_all_axioms(); - size_t final_axiom_count = vector_size(final_axioms); - ENSURE_COND(final_axiom_count == C_GHOST_UPDATE_AXIOMS_BEFORE, - "C ghost-update theory introduced an axiom"); - return 0; -err: - ERR_FUN_PUTS("audit_c_ghost_update"); - return -1; -} - -PROOF static int _C_GHOST_UPDATE_AUDIT = - audit_c_ghost_update(); diff --git a/theory/c_program_logic/c_ghost_update.h b/theory/c_program_logic/c_ghost_update.h deleted file mode 100644 index ca0cb7f..0000000 --- a/theory/c_program_logic/c_ghost_update.h +++ /dev/null @@ -1,137 +0,0 @@ -/** - * @file c_ghost_update.h - * @brief C-level algebra, update, and allocation rules for named ghost cells. - * - * The underlying finite-map updates come from `ghost_heap.h`; every theorem - * below concludes with the restricted `c_viewshift` from `c_basic_update.h`. - * Consequently the physical projection is preserved definitionally. This - * module contains no assertion-model installation or symbolic-state code. - * - * In this header, `R_G` abbreviates `c_resource_ra G`, `P ⇛_G Q` abbreviates - * `c_viewshift G P Q`, and `P **_G Q` abbreviates `r_sep R_G P Q`. - * `name:num` is a logical ghost-heap key, not a QCP-special value. All exported - * rules are hypothesis-free HOL theorems with the displayed premises - * represented as object-level implications. - */ - -#pragma once - -#include "proof/theory/c_program_logic/c_basic_update.h" - -/* ------------------------------------------------------------------------- */ -/* Exact ownership algebra */ -/* ------------------------------------------------------------------------- */ - -/** - * Two fragments of the same named cell compose through the payload RA: - * - * ```text - * ⊢ ∀G name a b. - * c_ghost_own G name (ra_op G a b) = - * (c_ghost_own G name a **_G c_ghost_own G name b). - * ``` - * - * Both sides own the physical-memory unit and exactly one ghost-heap key. - * In particular, this law preserves the shared `name`; it does not allocate - * or rename a logical cell. The conclusion is raw HOL equality of assertions, - * not merely one direction of SL entailment. - */ -PROOF extern thm C_GHOST_OWN_OP; - -/** - * Extract payload validity as a duplicable fact without consuming ownership: - * - * ```text - * ⊢ ∀G name a. - * c_ghost_own G name a ⊢_G - * r_fact R_G (ra_valid G a) **_G c_ghost_own G name a. - * ``` - * - * This is the C-resource specialization of `R_OWN_VALID`. It observes only - * the selected singleton ghost projection and preserves the physical unit. - */ -PROOF extern thm C_GHOST_OWN_VALID; - -/* ------------------------------------------------------------------------- */ -/* Fixed-name payload updates */ -/* ------------------------------------------------------------------------- */ - -/** - * Lift a deterministic payload update at a fixed name: - * - * ```text - * ⊢ ∀G name a b. - * ra_update G a b ⇒ - * (c_ghost_own G name a ⇛_G c_ghost_own G name b). - * ``` - */ -PROOF extern thm C_GHOST_OWN_UPDATE; - -/** - * Lift a nondeterministic payload update at a fixed name: - * - * ```text - * ⊢ ∀G name a result_pred. - * ra_update_nd G a result_pred ⇒ - * c_ghost_own G name a ⇛_G - * r_exists R_G (\b. - * r_and R_G (r_pure R_G (result_pred b)) - * (c_ghost_own G name b)). - * ``` - * - * The existential witness is the selected result `b`; the pure conjunct - * records that the selection satisfies `result_pred`. - */ -PROOF extern thm C_GHOST_OWN_UPDATE_ND; - -/** - * Release one owned named-cell fragment while preserving every hidden frame: - * - * ```text - * ⊢ ∀G name a. c_ghost_own G name a ⇛_G r_emp R_G. - * ``` - * - * This removes the caller's singleton ghost-heap resource. It does not assert - * that no compatible fragment remains at `name`, and it never changes the - * physical projection. - */ -PROOF extern thm C_GHOST_OWN_DEALLOC; - -/* ------------------------------------------------------------------------- */ -/* Existential ghost-cell allocation */ -/* ------------------------------------------------------------------------- */ - -/** - * For each compatible hidden ghost frame, the proof can choose a name absent - * from both the owned ghost heap and that frame. The public target exposes - * ownership at the selected name but no separate pure freshness proposition; - * callers must not infer lookup freshness beyond the displayed theorem shape. - * No physical resource is allocated. - */ - -/** - * Allocate into the empty combined resource: - * - * ```text - * ⊢ ∀G a. - * ra_valid G a ⇒ - * r_emp R_G ⇛_G r_exists R_G (\name. c_ghost_own G name a). - * ``` - * - * The premise is necessary because allocation must produce a valid singleton. - */ -PROOF extern thm C_GHOST_OWN_ALLOC_EMPTY; - -/** - * Allocate while linearly preserving an arbitrary C assertion: - * - * ```text - * ⊢ ∀G a P. - * ra_valid G a ⇒ - * P ⇛_G r_exists R_G (\name. c_ghost_own G name a **_G P). - * ``` - * - * `P` is retained exactly as a linear frame; the rule does not duplicate or - * discard any physical or ghost ownership already described by `P`. - */ -PROOF extern thm C_GHOST_OWN_ALLOC; diff --git a/theory/c_program_logic/c_memory.c b/theory/c_program_logic/c_memory.c index d25498b..447ef67 100644 --- a/theory/c_program_logic/c_memory.c +++ b/theory/c_program_logic/c_memory.c @@ -1,4 +1,6 @@ #include "proof/theory/c_program_logic/c_memory.h" +#include "proof/theory/logic/product_resource_internal.h" +#include "proof/theory/logic/resource_prop_internal.h" #include "proof/proof_backward.h" #require "proof/proof_backward.c" @@ -152,7 +154,7 @@ PROOF thm c_allocated_at_def = new_fun_definition(` (G:(A)ra) (address:int) (count:num) : - (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool = + (((int,(pmem_byte_state)excl)finmap)#A)->bool = c_lift_phys G (pmem_allocated_at address count) `); @@ -165,7 +167,9 @@ PROOF static thm prove_c_allocated_at_zero(void) { CONV_TAC(root, rewrite_conv(THM_LIST( c_allocated_at_def, PMEM_ALLOCATED_AT_ZERO, - C_LIFT_PHYS_EMP))); + c_lift_phys_def, + c_resource_ra_def, + R_LIFT_LEFT_EMP_EQ))); return gnode_prove(root); } @@ -184,7 +188,9 @@ PROOF static thm prove_c_allocated_at_append(void) { CONV_TAC(root, rewrite_conv(THM_LIST( c_allocated_at_def, PMEM_ALLOCATED_AT_APPEND, - C_LIFT_PHYS_SEP))); + c_lift_phys_def, + c_resource_ra_def, + R_LIFT_LEFT_SEP_EQ))); return gnode_prove(root); } @@ -418,7 +424,7 @@ PROOF thm c_data_at_def = new_fun_definition(` (address:int) (ty:ctype) (integer_value:int) : - (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool = + (((int,(pmem_byte_state)excl)finmap)#A)->bool = c_lift_phys G (pmem_data_at address ty integer_value) `); @@ -427,7 +433,7 @@ PROOF thm c_undef_data_at_def = new_fun_definition(` (G:(A)ra) (address:int) (ty:ctype) : - (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool = + (((int,(pmem_byte_state)excl)finmap)#A)->bool = c_lift_phys G (pmem_undef_data_at address ty) `); @@ -443,14 +449,16 @@ PROOF static thm prove_c_allocated_at_to_undef_data_at(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC(body, pure_rewrite_conv(THM_LIST( c_allocated_at_def, - c_undef_data_at_def))); + c_undef_data_at_def, + c_lift_phys_def, + c_resource_ra_def))); thm lift = ispecl_rule( TERM_LIST( - `G:(A)ra`, + `mem_ra`, `G:(A)ra`, `pmem_allocated_at (address:int) (pmem_c_width (ty:ctype))`, `pmem_undef_data_at (address:int) (ty:ctype)`), - C_LIFT_PHYS_ENTAILS); + R_LIFT_LEFT_ENTAILS); thm physical = ispecl_rule( TERM_LIST(`address:int`, `ty:ctype`), PMEM_ALLOCATED_AT_TO_UNDEF_DATA_AT); @@ -479,14 +487,16 @@ PROOF static thm prove_c_data_at_to_undef_data_at(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC(body, pure_rewrite_conv(THM_LIST( c_data_at_def, - c_undef_data_at_def))); + c_undef_data_at_def, + c_lift_phys_def, + c_resource_ra_def))); thm lift = ispecl_rule( TERM_LIST( - `G:(A)ra`, + `mem_ra`, `G:(A)ra`, `pmem_data_at (address:int) (ty:ctype) (integer_value:int)`, `pmem_undef_data_at (address:int) (ty:ctype)`), - C_LIFT_PHYS_ENTAILS); + R_LIFT_LEFT_ENTAILS); thm physical = ispecl_rule( TERM_LIST(`address:int`, `ty:ctype`, `integer_value:int`), PMEM_DATA_AT_TO_UNDEF_DATA_AT); @@ -512,15 +522,17 @@ PROOF static thm prove_c_data_at_allocated_at(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC(body, pure_rewrite_conv(THM_LIST( c_data_at_def, - c_allocated_at_def))); + c_allocated_at_def, + c_lift_phys_def, + c_resource_ra_def))); thm lift = ispecl_rule( TERM_LIST( - `G:(A)ra`, + `mem_ra`, `G:(A)ra`, `pmem_data_at (address:int) (ty:ctype) (integer_value:int)`, `pmem_allocated_at (address:int) (pmem_c_width (ty:ctype))`), - C_LIFT_PHYS_ENTAILS); + R_LIFT_LEFT_ENTAILS); thm physical = ispecl_rule( TERM_LIST(`address:int`, `ty:ctype`, `integer_value:int`), PMEM_DATA_AT_ALLOCATED_AT); @@ -542,14 +554,16 @@ PROOF static thm prove_c_undef_data_at_allocated_at(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC(body, pure_rewrite_conv(THM_LIST( c_undef_data_at_def, - c_allocated_at_def))); + c_allocated_at_def, + c_lift_phys_def, + c_resource_ra_def))); thm lift = ispecl_rule( TERM_LIST( - `G:(A)ra`, + `mem_ra`, `G:(A)ra`, `pmem_undef_data_at (address:int) (ty:ctype)`, `pmem_allocated_at (address:int) (pmem_c_width (ty:ctype))`), - C_LIFT_PHYS_ENTAILS); + R_LIFT_LEFT_ENTAILS); thm physical = ispecl_rule( TERM_LIST(`address:int`, `ty:ctype`), PMEM_UNDEF_DATA_AT_ALLOCATED_AT); @@ -582,6 +596,7 @@ PROOF static thm prove_c_data_at_pure_range(void) { r_entails_def, c_data_at_def, c_lift_phys_def, + r_lift_left_def, pmem_data_at_def, r_and_def, r_pure_def, @@ -655,9 +670,9 @@ PROOF static thm prove_c_data_at_value_range(void) { thm fact_sep = ispecl_rule( TERM_LIST(R, bounds, source), - R_FACT_SEP_R); + R_FACT_SEP_R_EQ); thm replace_target = beta_rule(ap_term_rule( - `\target:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool. + `\target:(((int,(pmem_byte_state)excl)finmap)#A)->bool. r_entails (c_resource_ra (G:(A)ra)) (c_data_at G (address:int) (ty:ctype) (integer_value:int)) diff --git a/theory/c_program_logic/c_resource.c b/theory/c_program_logic/c_resource.c index f2dfa7b..aa9a61a 100644 --- a/theory/c_program_logic/c_resource.c +++ b/theory/c_program_logic/c_resource.c @@ -3,571 +3,106 @@ #include "proof/proof_backward.h" #require "proof/proof_backward.c" #require "proof/theory/c_program_logic/mem_own.c" -#require "proof/theory/logic/ghost_heap.c" -#require "proof/theory/logic/prod_ra.c" -#require "proof/theory/logic/resource_prop.c" +#require "proof/theory/logic/product_resource.c" -PROOF static thm_list C_RESOURCE_INITIAL_AXIOMS = get_all_axioms(); PROOF static size_t C_RESOURCE_AXIOMS_BEFORE = - vector_size(C_RESOURCE_INITIAL_AXIOMS); - -/* ------------------------------------------------------------------------- */ -/* Combined C resource algebra */ -/* ------------------------------------------------------------------------- */ + vector_size(get_all_axioms()); PROOF thm c_resource_ra_def = new_fun_definition(` c_resource_ra (G:(A)ra) : - ((((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)ra) = - prod_ra mem_ra (ghost_heap_ra G) + (((int,(pmem_byte_state)excl)finmap)#A)ra = + prod_ra mem_ra G `); PROOF static thm prove_c_resource_ra_unit(void) { term goal_tm = ` forall G:(A)ra. ra_unit (c_resource_ra G) == - (ra_unit mem_ra,ra_unit (ghost_heap_ra G)) + (ra_unit mem_ra,ra_unit G) `; gnode root = gnode_new_with_ccl(goal_tm); - thm_list rewrites = THM_LIST(c_resource_ra_def, PROD_RA_UNIT); - conv simplify = rewrite_conv(rewrites); - CONV_TAC(root, simplify); - thm proved = gnode_prove(root); - return proved; + CONV_TAC( + root, + rewrite_conv(THM_LIST(c_resource_ra_def, PROD_RA_UNIT))); + return gnode_prove(root); } -PROOF thm C_RESOURCE_RA_UNIT = - prove_c_resource_ra_unit(); +PROOF thm C_RESOURCE_RA_UNIT = prove_c_resource_ra_unit(); PROOF static thm prove_c_resource_ra_op(void) { term goal_tm = ` forall (G:(A)ra) - (left:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) - (right:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap). - ra_op (c_resource_ra G) left right == - (ra_op mem_ra (FST left) (FST right), - ra_op (ghost_heap_ra G) (SND left) (SND right)) + (x:((int,(pmem_byte_state)excl)finmap)#A) + (y:((int,(pmem_byte_state)excl)finmap)#A). + ra_op (c_resource_ra G) x y == + (ra_op mem_ra (FST x) (FST y), + ra_op G (SND x) (SND y)) `; gnode root = gnode_new_with_ccl(goal_tm); - thm_list rewrites = THM_LIST(c_resource_ra_def, PROD_RA_OP); - conv simplify = rewrite_conv(rewrites); - CONV_TAC(root, simplify); - thm proved = gnode_prove(root); - return proved; + CONV_TAC( + root, + rewrite_conv(THM_LIST(c_resource_ra_def, PROD_RA_OP))); + return gnode_prove(root); } -PROOF thm C_RESOURCE_RA_OP = - prove_c_resource_ra_op(); +PROOF thm C_RESOURCE_RA_OP = prove_c_resource_ra_op(); PROOF static thm prove_c_resource_ra_valid(void) { term goal_tm = ` forall (G:(A)ra) - (resource:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap). - (ra_valid (c_resource_ra G) resource <=> - ra_valid mem_ra (FST resource) && - ra_valid (ghost_heap_ra G) (SND resource)) + (resource:((int,(pmem_byte_state)excl)finmap)#A). + ra_valid (c_resource_ra G) resource <=> + ra_valid mem_ra (FST resource) && + ra_valid G (SND resource) `; gnode root = gnode_new_with_ccl(goal_tm); - thm_list rewrites = THM_LIST(c_resource_ra_def, PROD_RA_VALID); - conv simplify = rewrite_conv(rewrites); - CONV_TAC(root, simplify); - thm proved = gnode_prove(root); - return proved; + CONV_TAC( + root, + rewrite_conv(THM_LIST(c_resource_ra_def, PROD_RA_VALID))); + return gnode_prove(root); } -PROOF thm C_RESOURCE_RA_VALID = - prove_c_resource_ra_valid(); - -/* ------------------------------------------------------------------------- */ -/* Exact physical and ghost embeddings */ -/* ------------------------------------------------------------------------- */ +PROOF thm C_RESOURCE_RA_VALID = prove_c_resource_ra_valid(); PROOF thm c_lift_phys_def = new_fun_definition(` c_lift_phys (G:(A)ra) - (P:(int,(pmem_byte_state)excl)finmap->bool) - (resource:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) <=> - P (FST resource) && - SND resource == ra_unit (ghost_heap_ra G) + (P:(int,(pmem_byte_state)excl)finmap->bool) = + r_lift_left mem_ra G P `); -PROOF static thm prove_c_lift_phys_emp(void) { - term goal_tm = ` - forall G:(A)ra. - c_lift_phys G (r_emp mem_ra) == - r_emp (c_resource_ra G) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = GEN_TAC(root, "G"); - thm fun_eq_thm = get_theorem_by_name("FUN_EQ_THM"); - term_list funext_arguments = TERM_LIST( - `c_lift_phys - (G:(A)ra) - (r_emp mem_ra)`, - `r_emp (c_resource_ra (G:(A)ra))`); - thm funext = ispecl_rule(funext_arguments, fun_eq_thm); - thm_list funext_rewrites = THM_LIST(funext); - conv funext_rewrite = once_rewrite_conv(funext_rewrites); - body = CONV_TAC(body, funext_rewrite); - body = GEN_TAC(body, "resource"); - thm_list definitions = THM_LIST( - c_lift_phys_def, - r_emp_def, - C_RESOURCE_RA_UNIT); - conv unfold_definitions = pure_rewrite_conv(definitions); - body = CONV_TAC(body, unfold_definitions); - - term physical_unit = ` - ra_unit mem_ra: - (int,(pmem_byte_state)excl)finmap - `; - term ghost_unit = ` - ra_unit (ghost_heap_ra (G:(A)ra)):(num,A)finmap - `; - term resource = ` - resource: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap - `; - term fst_resource = ` - FST (resource: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) - `; - term snd_resource = ` - SND (resource: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) - `; - thm pair_eq = get_theorem_by_name("PAIR_EQ"); - term_list pair_arguments = TERM_LIST( - fst_resource, - snd_resource, - physical_unit, - ghost_unit); - thm pair_components = ispecl_rule(pair_arguments, pair_eq); - thm components_to_pair = gsym_rule(pair_components); - - thm pair_eta = get_theorem_by_name("PAIR"); - thm resource_eta = ispec_rule(resource, pair_eta); - term has_units = ` - \candidate: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap. - candidate == - (ra_unit mem_ra, - ra_unit (ghost_heap_ra (G:(A)ra))) - `; - thm pair_to_resource_raw = ap_term_rule(has_units, resource_eta); - thm pair_to_resource = beta_rule(pair_to_resource_raw); - thm result = trans_rule(components_to_pair, pair_to_resource); - ACCEPT_TAC(body, result); - thm proved = gnode_prove(root); - return proved; -} - -PROOF thm C_LIFT_PHYS_EMP = - prove_c_lift_phys_emp(); - -PROOF static thm prove_c_lift_phys_sep(void) { - term goal_tm = ` - forall - (G:(A)ra) - (P:(int,(pmem_byte_state)excl)finmap->bool) - (Q:(int,(pmem_byte_state)excl)finmap->bool). - c_lift_phys G (r_sep mem_ra P Q) == - r_sep - (c_resource_ra G) - (c_lift_phys G P) - (c_lift_phys G Q) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - term source_assertion = ` - c_lift_phys +PROOF thm c_lift_ghost_def = new_fun_definition(` + c_lift_ghost (G:(A)ra) - (r_sep mem_ra - (P:(int,(pmem_byte_state)excl)finmap->bool) - (Q:(int,(pmem_byte_state)excl)finmap->bool)) - `; - term target_assertion = ` - r_sep - (c_resource_ra (G:(A)ra)) - (c_lift_phys G - (P:(int,(pmem_byte_state)excl)finmap->bool)) - (c_lift_phys G - (Q:(int,(pmem_byte_state)excl)finmap->bool)) - `; - term_list funext_arguments = TERM_LIST( - source_assertion, - target_assertion); - thm fun_eq_thm = get_theorem_by_name("FUN_EQ_THM"); - thm funext = ispecl_rule(funext_arguments, fun_eq_thm); - thm_list funext_rewrites = THM_LIST(funext); - conv expose_pointwise = once_rewrite_conv(funext_rewrites); - body = CONV_TAC(body, expose_pointwise); - body = GEN_TAC(body, "resource"); - thm_list definitions = THM_LIST(c_lift_phys_def, r_sep_def); - conv unfold_definitions = pure_rewrite_conv(definitions); - body = CONV_TAC(body, unfold_definitions); - gnode_list directions = EQ_TAC(body); - - gnode forward = DISCH_TAC(directions[0], "Hlifted_physical_sep"); - forward = ASMP_CONJ_TAC( - forward, - "Hlifted_physical_sep", - "Hphysical_sep", - "Hresource_ghost_unit"); - forward = ASMP_EXISTS_TAC( - forward, "Hphysical_sep", "physical_left"); - forward = ASMP_EXISTS_TAC( - forward, "Hphysical_sep", "physical_right"); - forward = ASMP_CONJ_TAC( - forward, - "Hphysical_sep", - "Hphysical_split", - "Hphysical_predicates"); - forward = ASMP_CONJ_TAC( - forward, - "Hphysical_predicates", - "HP", - "HQ"); - - term ghost_unit = ` - ra_unit (ghost_heap_ra (G:(A)ra)):(num,A)finmap - `; - term resource = ` - resource: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap - `; - term combined_left = ` - ((physical_left:(int,(pmem_byte_state)excl)finmap), - ra_unit (ghost_heap_ra (G:(A)ra))) - `; - term combined_right = ` - ((physical_right:(int,(pmem_byte_state)excl)finmap), - ra_unit (ghost_heap_ra (G:(A)ra))) - `; - forward = EXISTS_TAC(forward, combined_left); - forward = EXISTS_TAC(forward, combined_right); - gnode_list forward_result = CONJ_TAC(forward); - - const_cstr_list projected_labels = CONST_STRING_LIST( - "Hphysical_split", - "Hresource_ghost_unit"); - term_list projected_terms = gnode_get_asmps( - forward_result[0], - projected_labels); - thm physical_split_fact = assume_rule(projected_terms[0]); - thm resource_ghost_unit = assume_rule(projected_terms[1]); - thm projected_components = conj_rule( - physical_split_fact, - resource_ghost_unit); - term fst_resource = ` - FST (resource: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) - `; - term snd_resource = ` - SND (resource: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) - `; - term physical_combination = ` - ra_op - mem_ra - (physical_left:(int,(pmem_byte_state)excl)finmap) - (physical_right:(int,(pmem_byte_state)excl)finmap) - `; - term_list pair_arguments = TERM_LIST( - fst_resource, - snd_resource, - physical_combination, - ghost_unit); - thm pair_eq = get_theorem_by_name("PAIR_EQ"); - thm pair_components = ispecl_rule(pair_arguments, pair_eq); - thm components_to_pair = gsym_rule(pair_components); - thm projected_pair = eq_mp_rule( - components_to_pair, - projected_components); - thm pair_eta = get_theorem_by_name("PAIR"); - thm resource_eta = ispec_rule(resource, pair_eta); - thm resource_eta_reverse = gsym_rule(resource_eta); - thm resource_as_pair = trans_rule( - resource_eta_reverse, - projected_pair); - term ghost_ra = `G:(A)ra`; - term_list combined_op_arguments = TERM_LIST( - ghost_ra, - combined_left, - combined_right); - thm combined_op = ispecl_rule( - combined_op_arguments, - C_RESOURCE_RA_OP); - thm fst = get_theorem_by_name("FST"); - thm snd = get_theorem_by_name("SND"); - thm_list combined_op_rewrites = THM_LIST(fst, snd, RA_UNIT_L); - combined_op = pure_rewrite_rule( - combined_op_rewrites, - combined_op); - thm combined_op_reverse = gsym_rule(combined_op); - thm combined_split = trans_rule( - resource_as_pair, - combined_op_reverse); - ACCEPT_TAC(forward_result[0], combined_split); - - gnode_list forward_predicates = CONJ_TAC(forward_result[1]); - gnode_list forward_left = CONJ_TAC(forward_predicates[0]); - thm_list fst_rewrites = THM_LIST(fst); - conv simplify_fst = rewrite_conv(fst_rewrites); - gnode left_predicate = CONV_TAC(forward_left[0], simplify_fst); - const_cstr_list left_predicate_labels = CONST_STRING_LIST("HP"); - term_list left_predicate_terms = gnode_get_asmps( - left_predicate, - left_predicate_labels); - thm left_predicate_fact = assume_rule(left_predicate_terms[0]); - ACCEPT_TAC(left_predicate, left_predicate_fact); - thm_list snd_rewrites = THM_LIST(snd); - conv simplify_snd = rewrite_conv(snd_rewrites); - CONV_TAC(forward_left[1], simplify_snd); - - gnode_list forward_right = CONJ_TAC(forward_predicates[1]); - gnode right_predicate = CONV_TAC(forward_right[0], simplify_fst); - const_cstr_list right_predicate_labels = CONST_STRING_LIST("HQ"); - term_list right_predicate_terms = gnode_get_asmps( - right_predicate, - right_predicate_labels); - thm right_predicate_fact = assume_rule(right_predicate_terms[0]); - ACCEPT_TAC(right_predicate, right_predicate_fact); - CONV_TAC(forward_right[1], simplify_snd); - - gnode reverse = DISCH_TAC(directions[1], "Hcombined_sep"); - reverse = ASMP_EXISTS_TAC(reverse, "Hcombined_sep", "left"); - reverse = ASMP_EXISTS_TAC(reverse, "Hcombined_sep", "right"); - reverse = ASMP_CONJ_TAC( - reverse, - "Hcombined_sep", - "Hcombined_split", - "Hlifted_predicates"); - reverse = ASMP_CONJ_TAC( - reverse, - "Hlifted_predicates", - "Hlifted_P", - "Hlifted_Q"); - reverse = ASMP_CONJ_TAC( - reverse, - "Hlifted_P", - "HP", - "Hleft_ghost_unit"); - reverse = ASMP_CONJ_TAC( - reverse, - "Hlifted_Q", - "HQ", - "Hright_ghost_unit"); - gnode_list reverse_result = CONJ_TAC(reverse); - - term left_physical = ` - FST (left: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) - `; - term right_physical = ` - FST (right: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) - `; - gnode physical_sep = EXISTS_TAC(reverse_result[0], left_physical); - physical_sep = EXISTS_TAC(physical_sep, right_physical); - gnode_list physical_result = CONJ_TAC(physical_sep); - const_cstr_list combined_split_labels = - CONST_STRING_LIST("Hcombined_split"); - term_list combined_split_terms = gnode_get_asmps( - physical_result[0], - combined_split_labels); - thm combined_split_fact = assume_rule(combined_split_terms[0]); - term fst_function = ` - FST: - (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> - (int,(pmem_byte_state)excl)finmap - `; - thm physical_split = ap_term_rule( - fst_function, - combined_split_fact); - thm_list physical_split_rewrites = THM_LIST( - C_RESOURCE_RA_OP, - fst); - physical_split = pure_rewrite_rule( - physical_split_rewrites, - physical_split); - ACCEPT_TAC(physical_result[0], physical_split); - gnode_list physical_predicates = CONJ_TAC(physical_result[1]); - const_cstr_list left_labels = CONST_STRING_LIST("HP"); - term_list left_terms = gnode_get_asmps( - physical_predicates[0], - left_labels); - thm left_fact = assume_rule(left_terms[0]); - ACCEPT_TAC(physical_predicates[0], left_fact); - const_cstr_list right_labels = CONST_STRING_LIST("HQ"); - term_list right_terms = gnode_get_asmps( - physical_predicates[1], - right_labels); - thm right_fact = assume_rule(right_terms[0]); - ACCEPT_TAC(physical_predicates[1], right_fact); - - term snd_function = ` - SND: - (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)-> - (num,A)finmap - `; - thm ghost_split = ap_term_rule( - snd_function, - combined_split_fact); - const_cstr_list ghost_unit_labels = CONST_STRING_LIST( - "Hleft_ghost_unit", - "Hright_ghost_unit"); - term_list ghost_unit_terms = gnode_get_asmps( - reverse_result[1], - ghost_unit_labels); - thm left_ghost_unit = assume_rule(ghost_unit_terms[0]); - thm right_ghost_unit = assume_rule(ghost_unit_terms[1]); - thm_list ghost_split_rewrites = THM_LIST( - C_RESOURCE_RA_OP, - snd, - left_ghost_unit, - right_ghost_unit, - RA_UNIT_L); - ghost_split = pure_rewrite_rule( - ghost_split_rewrites, - ghost_split); - ACCEPT_TAC(reverse_result[1], ghost_split); - thm proved = gnode_prove(root); - return proved; -} - -PROOF thm C_LIFT_PHYS_SEP = - prove_c_lift_phys_sep(); - -PROOF static thm prove_c_lift_phys_entails(void) { - term goal_tm = ` - forall - (G:(A)ra) - (P:(int,(pmem_byte_state)excl)finmap->bool) - (Q:(int,(pmem_byte_state)excl)finmap->bool). - r_entails mem_ra P Q ==> - r_entails - (c_resource_ra G) - (c_lift_phys G P) - (c_lift_phys G Q) - `; - gnode root = gnode_new_with_ccl(goal_tm); - thm_list entails_definitions = THM_LIST(r_entails_def); - conv unfold_entails = pure_rewrite_conv(entails_definitions); - gnode body = CONV_TAC(root, unfold_entails); - body = GEN_TAC(body, "G"); - body = GEN_TAC(body, "P"); - body = GEN_TAC(body, "Q"); - body = DISCH_TAC(body, "Hphysical_entails"); - body = GEN_TAC(body, "resource"); - body = DISCH_TAC(body, "Hcombined_valid"); - body = DISCH_TAC(body, "Hlifted_P"); - - const_cstr_list lifted_p_labels = CONST_STRING_LIST("Hlifted_P"); - term_list lifted_p_terms = gnode_get_asmps(body, lifted_p_labels); - term lifted_p_tm = lifted_p_terms[0]; - thm lifted_p_assumption = assume_rule(lifted_p_tm); - thm_list lift_definitions = THM_LIST(c_lift_phys_def); - thm lifted_P = pure_once_rewrite_rule( - lift_definitions, - lifted_p_assumption); - body = ASSUME_TAC(body, lifted_P, "Hlifted_P_parts"); - body = ASMP_CONJ_TAC( - body, - "Hlifted_P_parts", - "HP", - "Hghost_unit"); - - term ghost_ra = `G:(A)ra`; - term resource = ` - resource:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap - `; - term_list combined_valid_arguments = TERM_LIST(ghost_ra, resource); - thm combined_valid = ispecl_rule( - combined_valid_arguments, - C_RESOURCE_RA_VALID); - const_cstr_list valid_labels = CONST_STRING_LIST("Hcombined_valid"); - term_list valid_terms = gnode_get_asmps(body, valid_labels); - term valid_tm = valid_terms[0]; - thm valid_assumption = assume_rule(valid_tm); - thm valid_components = eq_mp_rule( - combined_valid, - valid_assumption); - thm physical_valid = conjunct1_rule(valid_components); - const_cstr_list entails_labels = - CONST_STRING_LIST("Hphysical_entails"); - term_list entails_terms = gnode_get_asmps(body, entails_labels); - term physical_entails_tm = entails_terms[0]; - thm physical_entails = assume_rule(physical_entails_tm); - term physical_resource = ` - FST (resource: - ((int,(pmem_byte_state)excl)finmap)#(num,A)finmap) - `; - thm entails_at_resource = spec_rule( - physical_resource, - physical_entails); - thm entails_if_owned = mp_rule( - entails_at_resource, - physical_valid); - const_cstr_list physical_owned_labels = CONST_STRING_LIST("HP"); - term_list physical_owned_terms = gnode_get_asmps( - body, - physical_owned_labels); - term physical_owned_tm = physical_owned_terms[0]; - thm physical_owned = assume_rule(physical_owned_tm); - thm physical_Q = mp_rule(entails_if_owned, physical_owned); - - conv unfold_lift = pure_once_rewrite_conv(lift_definitions); - gnode lifted_Q = CONV_TAC(body, unfold_lift); - gnode_list result = CONJ_TAC(lifted_Q); - ACCEPT_TAC(result[0], physical_Q); - const_cstr_list ghost_unit_labels = CONST_STRING_LIST("Hghost_unit"); - term_list ghost_unit_terms = gnode_get_asmps( - result[1], - ghost_unit_labels); - thm ghost_unit_fact = assume_rule(ghost_unit_terms[0]); - ACCEPT_TAC(result[1], ghost_unit_fact); - thm proved = gnode_prove(root); - return proved; -} - -PROOF thm C_LIFT_PHYS_ENTAILS = - prove_c_lift_phys_entails(); + (Q:A->bool) = + r_lift_right mem_ra G Q +`); PROOF thm c_ghost_own_def = new_fun_definition(` c_ghost_own (G:(A)ra) - (name:num) - (a:A) : - (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool = - r_own - (c_resource_ra G) - (ra_unit mem_ra,finmap_singleton name a) + (ghost:A) = + c_lift_ghost G (r_own G ghost) `); PROOF thm c_pmem_uninit_at_def = new_fun_definition(` c_pmem_uninit_at (G:(A)ra) - (address:int) : - (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool = - c_lift_phys G (pmem_uninit_at address) + (address:int) = + c_lift_phys G (r_own mem_ra (pmem_uninit address)) `); PROOF thm c_pmem_byte_at_def = new_fun_definition(` c_pmem_byte_at (G:(A)ra) (address:int) - (byte:int) : - (((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool = - c_lift_phys G (pmem_byte_at address byte) + (byte:int) = + c_lift_phys G (r_own mem_ra (pmem_byte address byte)) `); -/* ------------------------------------------------------------------------- */ -/* Conservative-extension audit */ -/* ------------------------------------------------------------------------- */ - PROOF static int audit_c_resource(void) { thm_list public_theorems = THM_LIST( c_resource_ra_def, @@ -575,24 +110,17 @@ PROOF static int audit_c_resource(void) { C_RESOURCE_RA_OP, C_RESOURCE_RA_VALID, c_lift_phys_def, - C_LIFT_PHYS_EMP, - C_LIFT_PHYS_SEP, - C_LIFT_PHYS_ENTAILS, + c_lift_ghost_def, c_ghost_own_def, c_pmem_uninit_at_def, c_pmem_byte_at_def); - for (size_t i = 0; i < vector_size(public_theorems); ++i) { ENSURE_COND(!IS_NULL(public_theorems[i]), "C resource theorem %zu is empty", i); - term_list theorem_hypotheses = hyp(public_theorems[i]); - size_t hypothesis_count = vector_size(theorem_hypotheses); - ENSURE_COND(hypothesis_count == 0, + ENSURE_COND(vector_size(hyp(public_theorems[i])) == 0, "C resource theorem %zu has hypotheses", i); } - thm_list final_axioms = get_all_axioms(); - size_t final_axiom_count = vector_size(final_axioms); - ENSURE_COND(final_axiom_count == C_RESOURCE_AXIOMS_BEFORE, + ENSURE_COND(vector_size(get_all_axioms()) == C_RESOURCE_AXIOMS_BEFORE, "C resource theory introduced an axiom"); return 0; err: diff --git a/theory/c_program_logic/c_resource.h b/theory/c_program_logic/c_resource.h index 35ff9e0..827ab65 100644 --- a/theory/c_program_logic/c_resource.h +++ b/theory/c_program_logic/c_resource.h @@ -1,159 +1,22 @@ -/** - * @file c_resource.h - * @brief Product resource used by C assertions with user-selected ghost state. - * - * For `G:(A)ra`, the assertion carrier is - * - * ((int,(pmem_byte_state)excl)finmap) # (num,A)finmap - * - * and `c_resource_ra G` combines the physical-memory RA with the typed ghost - * heap RA. Assertions are the generic `r_*` resource propositions specialized - * at this combined RA; this module does not define a second BI language. - * - * Soundness boundary: the product algebra is only the assertion resource - * model. Program-level logical updates are the ghost-only `c_bupd` and - * `c_viewshift` operations declared in `c_basic_update.h`. Clients must not - * treat a generic `r_viewshift (c_resource_ra G)` as a C view shift, because - * it could change the physical-memory projection without executing C code. - * - * Documentation below writes `R_G` for `c_resource_ra G`, `P ⊢_G Q` for - * `r_entails R_G P Q`, and `P **_G Q` for `r_sep R_G P Q`. These symbols are - * documentation notation only; no additional HOL constants are introduced. - */ - #pragma once -#include "proof/theory/c_program_logic/mem_own.h" -#include "proof/theory/logic/ghost_heap.h" -#include "proof/theory/logic/prod_ra.h" -#include "proof/theory/logic/resource_prop.h" +/* Physical memory paired with one complete, closed global ghost RA. */ -/* ------------------------------------------------------------------------- */ -/* Combined C resource algebra */ -/* ------------------------------------------------------------------------- */ +#include "proof/theory/c_program_logic/mem_own.h" +#include "proof/theory/logic/product_resource.h" -/** - * Defining theorem: - * `⊢ ∀G. c_resource_ra G = prod_ra mem_ra (ghost_heap_ra G)`. - */ +/* `c_resource_ra G == prod_ra mem_ra G`. */ PROOF extern thm c_resource_ra_def; - -/** - * Unit projection law: - * - * ```text - * ⊢ ∀G. ra_unit R_G = - * (ra_unit mem_ra, ra_unit (ghost_heap_ra G)). - * ``` - */ PROOF extern thm C_RESOURCE_RA_UNIT; - -/** - * Componentwise composition law: - * - * ```text - * ⊢ ∀G left right. - * ra_op R_G left right = - * (ra_op mem_ra (FST left) (FST right), - * ra_op (ghost_heap_ra G) (SND left) (SND right)). - * ``` - */ PROOF extern thm C_RESOURCE_RA_OP; - -/** - * Componentwise validity law: - * - * ```text - * ⊢ ∀G resource. - * ra_valid R_G resource ⇔ - * ra_valid mem_ra (FST resource) ∧ - * ra_valid (ghost_heap_ra G) (SND resource). - * ``` - */ PROOF extern thm C_RESOURCE_RA_VALID; -/* ------------------------------------------------------------------------- */ -/* Exact physical and ghost embeddings */ -/* ------------------------------------------------------------------------- */ - -/** - * Exact physical lift. The physical predicate receives `FST resource`, and - * the ghost projection must be the ghost-heap unit. Thus the lift owns no - * hidden or discardable ghost resource. - * - * ```text - * ⊢ ∀G P resource. - * c_lift_phys G P resource ⇔ - * P (FST resource) ∧ - * SND resource = ra_unit (ghost_heap_ra G). - * ``` - */ +/* Exact product lifts. */ PROOF extern thm c_lift_phys_def; +PROOF extern thm c_lift_ghost_def; -/** - * The exact physical lift preserves the empty assertion: - * - * ```text - * ⊢ ∀G. c_lift_phys G (r_emp mem_ra) = r_emp R_G. - * ``` - * - * Both sides require the physical unit and the selected ghost-heap unit; the - * equality is between predicates on the complete C resource. - */ -PROOF extern thm C_LIFT_PHYS_EMP; - -/** - * The exact physical lift preserves separating conjunction: - * - * ```text - * ⊢ ∀G P Q. - * c_lift_phys G (r_sep mem_ra P Q) = - * (c_lift_phys G P **_G c_lift_phys G Q). - * ``` - * - * The forward direction gives each lifted fragment the ghost unit. The - * reverse direction projects the physical split and uses exact ghost-unit - * ownership on both lifted fragments. - */ -PROOF extern thm C_LIFT_PHYS_SEP; - -/** - * Physical entailment lifts monotonically to complete C resources: - * - * ```text - * ⊢ ∀G P Q. - * r_entails mem_ra P Q ⇒ - * (c_lift_phys G P ⊢_G c_lift_phys G Q). - * ``` - * - * Combined validity supplies physical validity through its first projection; - * the ghost-unit equality is preserved unchanged. - */ -PROOF extern thm C_LIFT_PHYS_ENTAILS; - -/** - * Exact ownership of one logical cell: - * - * ```text - * ⊢ ∀G name a. - * c_ghost_own G name a = - * r_own R_G (ra_unit mem_ra, finmap_singleton name a). - * ``` - * - * Its physical projection is exactly empty. - */ +/* Exact ownership of an arbitrary global ghost fragment. */ PROOF extern thm c_ghost_own_def; -/** - * Exact lift of uninitialized-byte ownership: - * `⊢ ∀G address. c_pmem_uninit_at G address = - * c_lift_phys G (pmem_uninit_at address)`. - */ PROOF extern thm c_pmem_uninit_at_def; - -/** - * Exact lift of initialized-byte ownership: - * `⊢ ∀G address byte. c_pmem_byte_at G address byte = - * c_lift_phys G (pmem_byte_at address byte)`. - */ PROOF extern thm c_pmem_byte_at_def; diff --git a/theory/c_program_logic/mem_ra.c b/theory/c_program_logic/mem_ra.c index 352d0b8..4186e87 100644 --- a/theory/c_program_logic/mem_ra.c +++ b/theory/c_program_logic/mem_ra.c @@ -1,4 +1,6 @@ #include "proof/theory/c_program_logic/mem_ra.h" +#include "proof/theory/logic/excl_ra_internal.h" +#include "proof/theory/logic/gmap_ra_internal.h" #include "proof/proof_backward.h" #require "proof/proof_backward.c" diff --git a/theory/c_program_logic/mem_ra.h b/theory/c_program_logic/mem_ra.h index a726d39..29918ca 100644 --- a/theory/c_program_logic/mem_ra.h +++ b/theory/c_program_logic/mem_ra.h @@ -113,12 +113,6 @@ PROOF extern thm pmem_byte_def; /** `⊢ ∀address state. ra_valid mem_ra (pmem_singleton address state)`. */ PROOF extern thm PMEM_SINGLETON_VALID; -/** `⊢ ∀address. ra_valid mem_ra (pmem_uninit address)`. */ -PROOF extern thm PMEM_UNINIT_VALID; - -/** `⊢ ∀address byte. ra_valid mem_ra (pmem_byte address byte)`. */ -PROOF extern thm PMEM_BYTE_VALID; - /** * Two canonical owned singletons at the same address compose to an invalid * memory, independently of their byte states: diff --git a/theory/c_program_logic/mem_value.c b/theory/c_program_logic/mem_value.c index 7d20308..a8588a8 100644 --- a/theory/c_program_logic/mem_value.c +++ b/theory/c_program_logic/mem_value.c @@ -1,4 +1,5 @@ #include "proof/theory/c_program_logic/mem_value.h" +#include "proof/theory/logic/resource_prop_internal.h" #include "proof/proof_backward.h" #require "proof/proof_backward.c" @@ -146,7 +147,7 @@ PROOF static thm prove_pmem_allocated_at_append(void) { get_theorem_by_name("ADD_CLAUSES"), zero_address, PMEM_ALLOCATED_AT_ZERO, - R_SEP_EMP_L))); + R_SEP_EMP_L_EQ))); gnode step = AUTO_INTROS_TAC(cases[1]); thm ih_general = assume_rule( @@ -172,7 +173,7 @@ PROOF static thm prove_pmem_allocated_at_append(void) { get_theorem_by_name("ADD_CLAUSES"), PMEM_ALLOCATED_AT_SUC, address, - R_SEP_ASSOC))); + R_SEP_ASSOC_EQ))); thm lifted_ih = beta_rule(ap_term_rule(` \tail:((int,(pmem_byte_state)excl)finmap)->bool. r_sep mem_ra (pmem_allocated_byte_at base) tail diff --git a/theory/logic/agree_ra.c b/theory/logic/agree_ra.c index 6997f09..9683770 100644 --- a/theory/logic/agree_ra.c +++ b/theory/logic/agree_ra.c @@ -491,15 +491,16 @@ PROOF static thm prove_agree_ra_agreement(void) { term a = `a:A`; term b = `b:A`; term combined_valid = ` - ra_valid agree_ra - (ra_op agree_ra (Agree (a:A)) (Agree (b:A))) + ra_compatible agree_ra (Agree (a:A)) (Agree (b:A)) `; thm equivalence = ispecl_rule( TERM_LIST(a, b), AGREE_RA_VALID_COMBINE_IFF); thm conclusion = eq_mp_rule( equivalence, - assume_rule(combined_valid)); + rewrite_rule( + THM_LIST(ra_compatible_def), + assume_rule(combined_valid))); conclusion = disch_rule(combined_valid, conclusion); conclusion = gen_rule(b, conclusion); return gen_rule(a, conclusion); @@ -535,22 +536,35 @@ PROOF static thm prove_agree_ra_update_iff(void) { thm source_valid = eq_mp_rule( sym_rule(source_valid_eq), ispec_rule(`a:A`, AGREE_RA_VALID_OWNED)); - thm update = pure_once_rewrite_rule( - THM_LIST(ra_update_def), + thm framed_update = mp_rule( + ispecl_rule( + TERM_LIST( + `agree_ra:((A)agree)ra`, + `Agree (a:A):(A)agree`, + `Agree (b:A):(A)agree`, + `Agree (a:A):(A)agree`), + RA_UPDATE_FRAME), assume_rule(` - ra_update - agree_ra - (Agree (a:A)) - (Agree (b:A)) + ra_update agree_ra (Agree (a:A)) (Agree (b:A)) `)); thm target_valid = mp_rule( - spec_rule(`Agree (a:A):(A)agree`, update), + ispecl_rule( + TERM_LIST( + `agree_ra:((A)agree)ra`, + `ra_op agree_ra (Agree (a:A)) (Agree (a:A))`, + `ra_op agree_ra (Agree (b:A)) (Agree (a:A))`), + RA_UPDATE_VALID), + framed_update); + target_valid = mp_rule( + target_valid, source_valid); thm target_agrees = mp_rule( ispecl_rule( TERM_LIST(`b:A`, `a:A`), AGREE_RA_AGREEMENT), - target_valid); + rewrite_rule( + THM_LIST(gsym_rule(ra_compatible_def)), + target_valid)); ACCEPT_TAC(forward, sym_rule(target_agrees)); gnode reverse = DISCH_TAC(directions[1], "Heq"); @@ -575,13 +589,15 @@ PROOF static thm prove_agree_ra_update_iff(void) { PROOF thm AGREE_RA_UPDATE_IFF = prove_agree_ra_update_iff(); -PROOF static thm prove_agree_ra_local_update_owned_iff(void) { +PROOF static thm prove_agree_ra_local_update_iff(void) { term goal_tm = ` forall a b:A. ra_local_update agree_ra - (Agree a,Agree a) - (Agree b,Agree b) <=> + (Agree a) + (Agree a) + (Agree b) + (Agree b) <=> a == b `; gnode root = gnode_new_with_ccl(goal_tm); @@ -593,22 +609,21 @@ PROOF static thm prove_agree_ra_local_update_owned_iff(void) { thm updated = ispecl_rule( TERM_LIST( `agree_ra:((A)agree)ra`, - `((Agree (a:A)),(Agree (a:A)))`, - `((Agree (b:A)),(Agree (b:A)))`, + `Agree (a:A):(A)agree`, + `Agree (a:A):(A)agree`, + `Agree (b:A):(A)agree`, + `Agree (b:A):(A)agree`, `Agree (a:A):(A)agree`), RA_LOCAL_UPDATE_APPLY); - updated = rewrite_rule( - THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")), - updated); updated = mp_rule( updated, assume_rule(` ra_local_update agree_ra - ((Agree (a:A)),(Agree (a:A))) - ((Agree (b:A)),(Agree (b:A))) + (Agree (a:A)) + (Agree (a:A)) + (Agree (b:A)) + (Agree (b:A)) `)); updated = mp_rule( updated, @@ -627,35 +642,42 @@ PROOF static thm prove_agree_ra_local_update_owned_iff(void) { ispecl_rule( TERM_LIST(`b:A`, `a:A`), AGREE_RA_AGREEMENT), - target_op_valid); + rewrite_rule( + THM_LIST(gsym_rule(ra_compatible_def)), + target_op_valid)); ACCEPT_TAC(forward, sym_rule(payload_eq)); gnode reverse = DISCH_TAC( directions[1], "Heq"); - thm pair_eq = beta_rule(ap_term_rule( - `\x:A. - ((Agree x),(Agree x))`, - assume_rule(`(a:A) == (b:A)`))); - thm target_transport = beta_rule(ap_term_rule( - `\target:(A)agree#(A)agree. - ra_local_update - agree_ra - ((Agree (a:A)),(Agree (a:A))) - target`, - pair_eq)); + thm owned_eq = ap_term_rule( + `Agree:A->(A)agree`, + assume_rule(`(a:A) == (b:A)`)); + thm whole_transport = beta_rule(ap_term_rule( + `\target:(A)agree. + ra_local_update agree_ra + (Agree (a:A)) (Agree (a:A)) target (Agree (b:A))`, + owned_eq)); + thm local_transport = beta_rule(ap_term_rule( + `\target:(A)agree. + ra_local_update agree_ra + (Agree (a:A)) (Agree (a:A)) (Agree (a:A)) target`, + owned_eq)); thm reflexive = ispecl_rule( TERM_LIST( `agree_ra:((A)agree)ra`, - `((Agree (a:A)),(Agree (a:A)))`), + `Agree (a:A):(A)agree`, + `Agree (a:A):(A)agree`), RA_LOCAL_UPDATE_REFL); ACCEPT_TAC( reverse, - eq_mp_rule(target_transport, reflexive)); + eq_mp_rule( + whole_transport, + eq_mp_rule(local_transport, reflexive))); return gnode_prove(root); } -PROOF thm AGREE_RA_LOCAL_UPDATE_OWNED_IFF = - prove_agree_ra_local_update_owned_iff(); +PROOF thm AGREE_RA_LOCAL_UPDATE_IFF = + prove_agree_ra_local_update_iff(); /* ------------------------------------------------------------------------- */ /* Order */ @@ -909,7 +931,9 @@ PROOF static thm prove_agree_ra_not_exclusive_owned(void) { ispec_rule(`a:A`, AGREE_RA_IDEMPOTENT))), ispec_rule(`a:A`, AGREE_RA_VALID_OWNED)); thm frame_is_unit = mp_rule( - spec_rule(`Agree (a:A):(A)agree`, exclusive), + spec_rule( + `Agree (a:A):(A)agree`, + conjunct2_rule(exclusive)), combined_valid); frame_is_unit = rewrite_rule( THM_LIST(AGREE_RA_UNIT), @@ -924,41 +948,6 @@ PROOF static thm prove_agree_ra_not_exclusive_owned(void) { PROOF thm AGREE_RA_NOT_EXCLUSIVE_OWNED = prove_agree_ra_not_exclusive_owned(); -PROOF static thm prove_agree_ra_exclusive_invalid(void) { - term goal_tm = ` - ra_exclusive agree_ra (AgreeInvalid:(A)agree) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = CONV_TAC( - root, - once_rewrite_conv(THM_LIST(ra_exclusive_def))); - body = GEN_TAC(body, "frame"); - body = DISCH_TAC(body, "Hcombined"); - thm invalid_valid = mp_rule( - ispecl_rule( - TERM_LIST( - `agree_ra:((A)agree)ra`, - `AgreeInvalid:(A)agree`, - `frame:(A)agree`), - RA_VALID_OP_L), - assume_rule(` - ra_valid - agree_ra - (ra_op - agree_ra - (AgreeInvalid:(A)agree) - (frame:(A)agree)) - `)); - thm contradiction = not_elim_rule( - AGREE_RA_INVALID, - invalid_valid); - CONTR_TAC(body, contradiction); - return gnode_prove(root); -} - -PROOF thm AGREE_RA_EXCLUSIVE_INVALID = - prove_agree_ra_exclusive_invalid(); - PROOF static thm prove_agree_ra_not_cancellative(void) { term goal_tm = `~(ra_cancellative (agree_ra:((A)agree)ra))`; gnode root = gnode_new_with_ccl(goal_tm); @@ -1033,11 +1022,10 @@ PROOF static int audit_agree_ra(void) { AGREE_RA_NOT_INCLUDED_INVALID_UNIT, AGREE_RA_NOT_INCLUDED_INVALID_OWNED, AGREE_RA_NOT_EXCLUSIVE_OWNED, - AGREE_RA_EXCLUSIVE_INVALID, AGREE_RA_NOT_CANCELLATIVE, AGREE_RA_AGREEMENT, AGREE_RA_UPDATE_IFF, - AGREE_RA_LOCAL_UPDATE_OWNED_IFF); + AGREE_RA_LOCAL_UPDATE_IFF); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { ENSURE_COND(!IS_NULL(audited_theorems[i]), diff --git a/theory/logic/agree_ra.h b/theory/logic/agree_ra.h index 2661ff2..37e8f3c 100644 --- a/theory/logic/agree_ra.h +++ b/theory/logic/agree_ra.h @@ -1,180 +1,18 @@ #pragma once -/* - * `agree_ra:((A)agree)ra` is the discrete agreement resource algebra. An - * owned value `Agree a` may be duplicated, but two owned values compose - * validly only when their payloads agree. `AgreeUnit` is empty and - * `AgreeInvalid` represents disagreement. Its carrier is `(A)agree`, unit - * is `AgreeUnit`, disagreement composes to `AgreeInvalid`, and exactly - * `AgreeUnit` plus all `Agree a` values are valid. - * - * This header exposes only semantic laws stated directly over the abstract RA - * operations. The datatype handle, recursive implementation, construction - * laws, and `ra_abs` projection equations are private to `agree_ra.c`. - */ +/* Discrete agreement resource algebra. */ #include "proof/theory/logic/local_update.h" -/* ------------------------------------------------------------------------- */ -/* Core representation */ -/* ------------------------------------------------------------------------- */ - -/* `ra_unit agree_ra == (AgreeUnit:(A)agree)`. */ PROOF extern thm AGREE_RA_UNIT; - -/* - * Exact composition of two owned agreement tokens: - * - * `forall a b:A. - * ra_op agree_ra (Agree a) (Agree b) == - * (if a == b - * then Agree a - * else (AgreeInvalid:(A)agree))` - */ PROOF extern thm AGREE_RA_OWNED_OP; - -/* - * `forall a:A. - * ra_op agree_ra (Agree a) (Agree a) == (Agree a:(A)agree)` - */ PROOF extern thm AGREE_RA_IDEMPOTENT; - -/* ------------------------------------------------------------------------- */ -/* Constructor equality and distinction */ -/* ------------------------------------------------------------------------- */ - -/* - * forall (a:A) (b:A). - * (Agree a:(A)agree) == Agree b <=> a == b - */ -PROOF extern thm AGREE_RA_OWNED_INJ; - -/* `forall a:A. ~((Agree a:(A)agree) == AgreeUnit)`. */ -PROOF extern thm AGREE_RA_OWNED_NE_UNIT; - -/* `~((AgreeInvalid:(A)agree) == AgreeUnit)`. */ -PROOF extern thm AGREE_RA_INVALID_NE_UNIT; - -/* `forall a:A. ~((AgreeInvalid:(A)agree) == Agree a)`. */ -PROOF extern thm AGREE_RA_INVALID_NE_OWNED; - -/* ------------------------------------------------------------------------- */ -/* Validity */ -/* ------------------------------------------------------------------------- */ - -/* `ra_valid agree_ra (AgreeUnit:(A)agree)`. */ PROOF extern thm AGREE_RA_VALID_UNIT; - -/* `forall a:A. ra_valid agree_ra (Agree a)`. */ PROOF extern thm AGREE_RA_VALID_OWNED; - -/* `~(ra_valid agree_ra (AgreeInvalid:(A)agree))`. */ PROOF extern thm AGREE_RA_INVALID; - -/* - * `forall a b:A. - * ra_valid agree_ra - * (ra_op agree_ra (Agree a) (Agree b)) <=> - * a == b` - */ PROOF extern thm AGREE_RA_VALID_COMBINE_IFF; - -/* ------------------------------------------------------------------------- */ -/* Order */ -/* ------------------------------------------------------------------------- */ - -/* - * Inclusion between owned agreement tokens is payload equality: - * - * `forall a b:A. - * ra_included agree_ra (Agree a) (Agree b) <=> - * a == b` - * - * This statement deliberately restricts the target to an owned token. - * Raw inclusion also permits the invalid extension - * `Agree a <= AgreeInvalid`. - */ +PROOF extern thm AGREE_RA_AGREEMENT; PROOF extern thm AGREE_RA_INCLUDED_OWNED; - -/* `forall x:(A)agree. ra_included agree_ra AgreeUnit x`. */ -PROOF extern thm AGREE_RA_INCLUDED_UNIT; - -/* - * `forall a:A. - * ~(ra_included agree_ra (Agree a) AgreeUnit)` - */ -PROOF extern thm AGREE_RA_NOT_INCLUDED_OWNED_UNIT; - -/* - * Invalid extensions remain visible in the raw inclusion preorder: - * - * `forall a:A. - * ra_included agree_ra (Agree a) AgreeInvalid` - */ -PROOF extern thm AGREE_RA_INCLUDED_OWNED_INVALID; - -/* `~(ra_included agree_ra AgreeInvalid AgreeUnit)`. */ -PROOF extern thm AGREE_RA_NOT_INCLUDED_INVALID_UNIT; - -/* - * `forall a:A. - * ~(ra_included agree_ra AgreeInvalid (Agree a))` - */ -PROOF extern thm AGREE_RA_NOT_INCLUDED_INVALID_OWNED; - -/* ------------------------------------------------------------------------- */ -/* Exclusive and cancellative laws */ -/* ------------------------------------------------------------------------- */ - -/* `forall a:A. ~(ra_exclusive agree_ra (Agree a))`. */ -PROOF extern thm AGREE_RA_NOT_EXCLUSIVE_OWNED; - -/* `ra_exclusive agree_ra (AgreeInvalid:(A)agree)`. */ -PROOF extern thm AGREE_RA_EXCLUSIVE_INVALID; - -/* `~(ra_cancellative (agree_ra:((A)agree)ra))`. */ PROOF extern thm AGREE_RA_NOT_CANCELLATIVE; - -/* ------------------------------------------------------------------------- */ -/* Agreement */ -/* ------------------------------------------------------------------------- */ - -/* - * `forall a b:A. - * ra_valid agree_ra - * (ra_op agree_ra (Agree a) (Agree b)) ==> - * a == b` - */ -PROOF extern thm AGREE_RA_AGREEMENT; - -/* ------------------------------------------------------------------------- */ -/* Updates */ -/* ------------------------------------------------------------------------- */ - -/* - * Exact characterization of updates between owned agreement tokens: - * - * `forall a b:A. - * ra_update agree_ra (Agree a) (Agree b) <=> - * a == b` - * - * Necessity uses `Agree a` itself as a compatible frame. Sufficiency is the - * generic reflexive update after substituting equality. Dropping an owned - * token to `AgreeUnit` remains possible through `RA_UPDATE_INCLUDED`. - */ PROOF extern thm AGREE_RA_UPDATE_IFF; - -/* - * A synchronized local update between fully owned agreement pairs cannot - * change the payload: - * - * `forall a b:A. - * ra_local_update - * agree_ra - * (Agree a,Agree a) - * (Agree b,Agree b) <=> - * a == b` - * - * Necessity exposes `Agree a` as a residual of the idempotent source. - */ -PROOF extern thm AGREE_RA_LOCAL_UPDATE_OWNED_IFF; +PROOF extern thm AGREE_RA_LOCAL_UPDATE_IFF; diff --git a/theory/logic/auth_ra.c b/theory/logic/auth_ra.c index 94c5283..718c910 100644 --- a/theory/logic/auth_ra.c +++ b/theory/logic/auth_ra.c @@ -1,7 +1,8 @@ #include "proof/theory/logic/auth_ra.h" #include "proof/theory/logic/excl_ra_internal.h" -#include "proof/theory/logic/prod_ra.h" +#include "proof/theory/logic/prod_ra_internal.h" #include "proof/theory/logic/ra_builder.h" +#include "proof/theory/logic/ra_internal.h" #include "proof/proof_backward.h" #require "proof/proof_backward.c" @@ -1024,17 +1025,16 @@ PROOF thm AUTH_RA_VALID_BOTH_FRAG = PROOF static thm prove_auth_ra_auth_conflict(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (b:A). - ~(ra_valid + ~(ra_compatible (auth_ra R) - (ra_op - (auth_ra R) - (auth_auth R a) - (auth_auth R b))) + (auth_auth R a) + (auth_auth R b)) `; gnode root = gnode_new_with_ccl(goal_tm); CONV_TAC( root, rewrite_conv(THM_LIST( + ra_compatible_def, AUTH_RA_OP_COMPONENTS, AUTH_RA_VALID_COMPONENTS, auth_auth_def, @@ -1300,84 +1300,6 @@ PROOF static thm prove_auth_ra_auth_both_conflict(void) { PROOF thm AUTH_RA_AUTH_BOTH_CONFLICT = prove_auth_ra_auth_both_conflict(); -PROOF static thm prove_auth_ra_both_exclusive(void) { - term goal_tm = ` - forall (R:(A)ra) (a:A) (f:A). - ra_exclusive R f ==> - ra_exclusive (auth_ra R) (auth_both a f) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - body = CONV_TAC( - body, - once_rewrite_conv(THM_LIST(ra_exclusive_def))); - body = GEN_TAC(body, "frame"); - body = DISCH_TAC(body, "Hvalid_frame"); - - thm frame_details = eq_mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `a:A`, - `f:A`, - `frame:(A)excl#A`), - AUTH_RA_VALID_BOTH_FRAME), - assume_rule(` - ra_valid - (auth_ra (R:(A)ra)) - (ra_op - (auth_ra R) - (auth_both (a:A) (f:A)) - (frame:(A)excl#A)) - `)); - body = ASSUME_TAC(body, frame_details, "Hframe_details"); - body = ASMP_EXISTS_TAC(body, "Hframe_details", "external"); - body = ASMP_CONJ_TAC( - body, - "Hframe_details", - "Hframe", - "Hsource"); - - thm source_valid = match_mp_rule( - match_mp_rule( - RA_INCLUDED_VALID, - conjunct2_rule(assume_rule(` - ra_valid (R:(A)ra) (a:A) && - ra_included - R - (ra_op R (f:A) (external:A)) - a - `))), - conjunct1_rule(assume_rule(` - ra_valid (R:(A)ra) (a:A) && - ra_included - R - (ra_op R (f:A) (external:A)) - a - `))); - thm exclusive = rewrite_rule( - THM_LIST(ra_exclusive_def), - assume_rule(`ra_exclusive (R:(A)ra) (f:A)`)); - thm external_is_unit = mp_rule( - spec_rule(`external:A`, exclusive), - source_valid); - - thm replace_external = ap_term_rule( - `auth_frag:A->(A)excl#A`, - external_is_unit); - thm unit_equation = ispec_rule(`R:(A)ra`, AUTH_RA_UNIT); - thm result = trans_rule( - assume_rule(` - (frame:(A)excl#A) == auth_frag (external:A) - `), - trans_rule(replace_external, gsym_rule(unit_equation))); - ACCEPT_TAC(body, result); - return gnode_prove(root); -} - -PROOF thm AUTH_RA_BOTH_EXCLUSIVE = - prove_auth_ra_both_exclusive(); - /* ExclUnit is the exclusive RA unit and is therefore included in every * exclusive carrier element. */ PROOF static thm prove_auth_excl_unit_included(void) { @@ -1819,8 +1741,17 @@ PROOF static thm prove_auth_ra_update_framewise(void) { gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - once_rewrite_conv(THM_LIST(ra_update_def))); + pure_rewrite_conv(THM_LIST(ra_update_def, ra_updateP_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); body = AUTO_INTROS_TAC(body); + body = EXISTS_TAC(body, `auth_both (b:A) (g:A)`); + gnode_list update_result = CONJ_TAC(body); + ACCEPT_TAC( + update_result[0], + refl_rule(`auth_both (b:A) (g:A)`)); + body = update_result[1]; thm source_characterization = ispecl_rule( TERM_LIST( @@ -1912,16 +1843,21 @@ PROOF static thm prove_auth_ra_update_framewise_iff(void) { (ra_op R (f:A) (external:A)) a `)); - thm update_rule = rewrite_rule( - THM_LIST(ra_update_def), - assume_rule(` - ra_update - (auth_ra (R:(A)ra)) - (auth_both (a:A) (f:A)) - (auth_both (b:A) (g:A)) - `)); thm target_valid = mp_rule( - spec_rule(`auth_frag (external:A)`, update_rule), + mp_rule( + ispecl_rule( + TERM_LIST( + `auth_ra (R:(A)ra)`, + `auth_both (a:A) (f:A)`, + `auth_both (b:A) (g:A)`, + `auth_frag (external:A)`), + RA_UPDATE_APPLY), + assume_rule(` + ra_update + (auth_ra (R:(A)ra)) + (auth_both (a:A) (f:A)) + (auth_both (b:A) (g:A)) + `)), source_valid); thm target_details = eq_mp_rule( ispecl_rule( @@ -1963,7 +1899,7 @@ PROOF thm AUTH_RA_UPDATE_FRAMEWISE_IFF = * witness behind any source inclusion; the framewise auth criterion then * turns that base fact into a frame-preserving update of authoritative * resources. */ -PROOF static thm prove_auth_ra_update(void) { +PROOF static thm prove_auth_ra_update_local(void) { term goal_tm = ` forall (R:(A)ra) @@ -1971,7 +1907,7 @@ PROOF static thm prove_auth_ra_update(void) { (f:A) (b:A) (g:A). - ra_local_update R (a,f) (b,g) ==> + ra_local_update R a f b g ==> ra_update (auth_ra R) (auth_both a f) @@ -2007,7 +1943,7 @@ PROOF static thm prove_auth_ra_update(void) { RA_LOCAL_UPDATE_PRESERVES_INCLUDED); preserved = mp_rule( preserved, - assume_rule(`ra_local_update (R:(A)ra) (a,f) (b,g)`)); + assume_rule(`ra_local_update (R:(A)ra) (a:A) (f:A) (b:A) (g:A)`)); preserved = mp_rule( preserved, assume_rule(`ra_valid (R:(A)ra) (a:A)`)); @@ -2023,258 +1959,8 @@ PROOF static thm prove_auth_ra_update(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_UPDATE = - prove_auth_ra_update(); - -PROOF static thm prove_auth_ra_update_nd(void) { - term goal_tm = ` - forall - (R:(A)ra) - (a:A) - (f:A) - (P:A->A->bool). - (forall external:A. - ra_valid R a && - ra_included R (ra_op R f external) a ==> - exists (b:A) (g:A). - P b g && - ra_valid R b && - ra_included R (ra_op R g external) b) ==> - ra_update_nd - (auth_ra R) - (auth_both a f) - (\candidate:(A)excl#A. - exists (b:A) (g:A). - P b g && - candidate == auth_both b g) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = CONV_TAC( - root, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); - body = CONV_TAC( - body, - depth_conv(get_conversion_by_name("BETA_CONV"))); - body = AUTO_INTROS_TAC(body); - - thm source_characterization = ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `a:A`, - `f:A`, - `frame:(A)excl#A`), - AUTH_RA_VALID_BOTH_FRAME_COMPONENTS); - thm source_details = eq_mp_rule( - source_characterization, - assume_rule(` - ra_valid - (auth_ra (R:(A)ra)) - (ra_op - (auth_ra R) - (auth_both (a:A) (f:A)) - (frame:(A)excl#A)) - `)); - thm selected = mp_rule( - spec_rule( - `SND (frame:(A)excl#A)`, - assume_rule(` - forall external:A. - ra_valid (R:(A)ra) (a:A) && - ra_included R (ra_op R (f:A) external) a ==> - exists (b:A) (g:A). - (P:A->A->bool) b g && - ra_valid R b && - ra_included R (ra_op R g external) b - `)), - conjunct2_rule(source_details)); - body = ASSUME_TAC(body, selected, "Hselected"); - body = ASMP_EXISTS_TAC(body, "Hselected", "b"); - body = ASMP_EXISTS_TAC(body, "Hselected", "g"); - body = ASMP_CONJ_TAC( - body, - "Hselected", - "HP", - "Htarget_condition"); - - body = EXISTS_TAC(body, `auth_both (b:A) (g:A)`); - gnode_list result = CONJ_TAC(body); - - gnode predicate = EXISTS_TAC(result[0], `b:A`); - predicate = EXISTS_TAC(predicate, `g:A`); - gnode_list predicate_parts = CONJ_TAC(predicate); - ACCEPT_TAC( - predicate_parts[0], - assume_rule(`(P:A->A->bool) (b:A) (g:A)`)); - ACCEPT_TAC( - predicate_parts[1], - refl_rule(`auth_both (b:A) (g:A)`)); - - thm target_details = conj_rule( - conjunct1_rule(source_details), - assume_rule(` - ra_valid (R:(A)ra) (b:A) && - ra_included - R - (ra_op R (g:A) (SND (frame:(A)excl#A))) - b - `)); - thm target_characterization = ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `b:A`, - `g:A`, - `frame:(A)excl#A`), - AUTH_RA_VALID_BOTH_FRAME_COMPONENTS); - ACCEPT_TAC( - result[1], - eq_mp_rule(gsym_rule(target_characterization), target_details)); - return gnode_prove(root); -} - -PROOF thm AUTH_RA_UPDATE_ND = - prove_auth_ra_update_nd(); - -PROOF static thm prove_auth_ra_update_nd_framewise_iff(void) { - term goal_tm = ` - forall - (R:(A)ra) - (a:A) - (f:A) - (P:A->A->bool). - ra_update_nd - (auth_ra R) - (auth_both a f) - (\candidate:(A)excl#A. - exists (b:A) (g:A). - P b g && - candidate == auth_both b g) <=> - forall external:A. - ra_valid R a && - ra_included R (ra_op R f external) a ==> - exists (b:A) (g:A). - P b g && - ra_valid R b && - ra_included R (ra_op R g external) b - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - gnode_list directions = EQ_TAC(body); - - gnode forward = DISCH_TAC(directions[0], "Hupdate_nd"); - forward = GEN_TAC(forward, "external"); - forward = DISCH_TAC(forward, "Hsource"); - thm source_valid = eq_mp_rule( - gsym_rule(ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `a:A`, - `f:A`, - `external:A`), - AUTH_RA_VALID_BOTH_FRAG)), - assume_rule(` - ra_valid (R:(A)ra) (a:A) && - ra_included - R - (ra_op R (f:A) (external:A)) - a - `)); - thm update_rule = rewrite_rule( - THM_LIST(ra_update_nd_def), - assume_rule(` - ra_update_nd - (auth_ra (R:(A)ra)) - (auth_both (a:A) (f:A)) - (\candidate:(A)excl#A. - exists (b:A) (g:A). - (P:A->A->bool) b g && - candidate == auth_both b g) - `)); - thm selected = mp_rule( - spec_rule(`auth_frag (external:A)`, update_rule), - source_valid); - selected = conv_rule( - depth_conv(get_conversion_by_name("BETA_CONV")), - selected); - forward = ASSUME_TAC(forward, selected, "Hselected"); - forward = ASMP_EXISTS_TAC(forward, "Hselected", "candidate"); - forward = ASMP_CONJ_TAC( - forward, - "Hselected", - "Hpredicate", - "Htarget_valid"); - forward = ASMP_EXISTS_TAC(forward, "Hpredicate", "b"); - forward = ASMP_EXISTS_TAC(forward, "Hpredicate", "g"); - forward = ASMP_CONJ_TAC( - forward, - "Hpredicate", - "HP", - "Hcandidate"); - - thm replace_candidate = beta_rule(ap_term_rule( - `\x:(A)excl#A. - ra_valid - (auth_ra (R:(A)ra)) - (ra_op - (auth_ra R) - x - (auth_frag (external:A)))`, - assume_rule(` - (candidate:(A)excl#A) == - auth_both (b:A) (g:A) - `))); - thm target_valid = eq_mp_rule( - replace_candidate, - assume_rule(` - ra_valid - (auth_ra (R:(A)ra)) - (ra_op - (auth_ra R) - (candidate:(A)excl#A) - (auth_frag (external:A))) - `)); - thm target_details = eq_mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `b:A`, - `g:A`, - `external:A`), - AUTH_RA_VALID_BOTH_FRAG), - target_valid); - - forward = EXISTS_TAC(forward, `b:A`); - forward = EXISTS_TAC(forward, `g:A`); - gnode_list result = CONJ_TAC(forward); - ACCEPT_TAC( - result[0], - assume_rule(`(P:A->A->bool) (b:A) (g:A)`)); - ACCEPT_TAC(result[1], target_details); - - gnode reverse = DISCH_TAC(directions[1], "Hframewise"); - ACCEPT_TAC( - reverse, - mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `a:A`, - `f:A`, - `P:A->A->bool`), - AUTH_RA_UPDATE_ND), - assume_rule(` - forall external:A. - ra_valid (R:(A)ra) (a:A) && - ra_included R (ra_op R (f:A) external) a ==> - exists (b:A) (g:A). - (P:A->A->bool) b g && - ra_valid R b && - ra_included R (ra_op R g external) b - `))); - return gnode_prove(root); -} - -PROOF thm AUTH_RA_UPDATE_ND_FRAMEWISE_IFF = - prove_auth_ra_update_nd_framewise_iff(); +PROOF thm AUTH_RA_UPDATE_LOCAL = + prove_auth_ra_update_local(); /* ------------------------------------------------------------------------- */ /* Exact authority and weakening updates */ @@ -2398,7 +2084,7 @@ PROOF static thm prove_auth_ra_update_auth_included(void) { PROOF thm AUTH_RA_UPDATE_AUTH_INCLUDED = prove_auth_ra_update_auth_included(); -PROOF static thm prove_auth_ra_update_drop_frag(void) { +PROOF static thm prove_auth_ra_update_drop_local(void) { term R = `R:(A)ra`; term a = `a:A`; term f = `f:A`; @@ -2422,8 +2108,8 @@ PROOF static thm prove_auth_ra_update_drop_frag(void) { return gen_rule(R, result); } -PROOF thm AUTH_RA_UPDATE_DROP_FRAG = - prove_auth_ra_update_drop_frag(); +PROOF thm AUTH_RA_UPDATE_DROP_LOCAL = + prove_auth_ra_update_drop_local(); PROOF static thm prove_auth_ra_update_drop_auth(void) { term R = `R:(A)ra`; @@ -2546,10 +2232,10 @@ PROOF static thm prove_auth_ra_update_both_included(void) { TERM_LIST( `auth_ra (R:(A)ra)`, `auth_auth (R:(A)ra) (a:A)`, - `auth_auth (R:(A)ra) (b:A)`), + `auth_auth (R:(A)ra) (b:A)`, + `auth_frag (f:A)`), RA_UPDATE_FRAME), authority_update); - framed = spec_rule(`auth_frag (f:A)`, framed); framed = rewrite_rule( THM_LIST(AUTH_RA_AUTH_FRAG), framed); @@ -2565,7 +2251,7 @@ PROOF thm AUTH_RA_UPDATE_BOTH_INCLUDED = PROOF static thm prove_auth_ra_update_alloc(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (b:A) (g:A). - ra_local_update R (a,ra_unit R) (b,g) ==> + ra_local_update R a (ra_unit R) b g ==> ra_update (auth_ra R) (auth_auth R a) @@ -2581,12 +2267,14 @@ PROOF static thm prove_auth_ra_update_alloc(void) { `ra_unit (R:(A)ra)`, `b:A`, `g:A`), - AUTH_RA_UPDATE), + AUTH_RA_UPDATE_LOCAL), assume_rule(` ra_local_update (R:(A)ra) - ((a:A),ra_unit R) - ((b:A),(g:A)) + (a:A) + (ra_unit R) + (b:A) + (g:A) `)); updated = rewrite_rule( THM_LIST(AUTH_RA_BOTH_UNIT), @@ -2598,278 +2286,6 @@ PROOF static thm prove_auth_ra_update_alloc(void) { PROOF thm AUTH_RA_UPDATE_ALLOC = prove_auth_ra_update_alloc(); -/* Iris `auth_update_dealloc`: a unit target fragment is exactly the public - * authority-only constructor. */ -PROOF static thm prove_auth_ra_update_dealloc(void) { - term goal_tm = ` - forall (R:(A)ra) (a:A) (f:A) (b:A). - ra_local_update R (a,f) (b,ra_unit R) ==> - ra_update - (auth_ra R) - (auth_both a f) - (auth_auth R b) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - thm updated = mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `a:A`, - `f:A`, - `b:A`, - `ra_unit (R:(A)ra)`), - AUTH_RA_UPDATE), - assume_rule(` - ra_local_update - (R:(A)ra) - ((a:A),(f:A)) - ((b:A),ra_unit R) - `)); - updated = rewrite_rule( - THM_LIST(AUTH_RA_BOTH_UNIT), - updated); - ACCEPT_TAC(body, updated); - return gnode_prove(root); -} - -PROOF thm AUTH_RA_UPDATE_DEALLOC = - prove_auth_ra_update_dealloc(); - -/* Iris `auth_update_auth`: first expose the fragment produced by the local - * update, then apply the public fragment-dropping rule. */ -PROOF static thm prove_auth_ra_update_auth(void) { - term goal_tm = ` - forall (R:(A)ra) (a:A) (b:A) (g:A). - ra_local_update R (a,ra_unit R) (b,g) ==> - ra_update - (auth_ra R) - (auth_auth R a) - (auth_auth R b) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - thm allocated = mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `a:A`, - `b:A`, - `g:A`), - AUTH_RA_UPDATE_ALLOC), - assume_rule(` - ra_local_update - (R:(A)ra) - ((a:A),ra_unit R) - ((b:A),(g:A)) - `)); - - thm discard_fragment = ispecl_rule( - TERM_LIST(`R:(A)ra`, `b:A`, `g:A`), - AUTH_RA_UPDATE_DROP_FRAG); - thm result = mp_rule( - mp_rule( - ispecl_rule( - TERM_LIST( - `auth_ra (R:(A)ra)`, - `auth_auth (R:(A)ra) (a:A)`, - `auth_both (b:A) (g:A)`, - `auth_auth (R:(A)ra) (b:A)`), - RA_UPDATE_TRANS), - allocated), - discard_fragment); - ACCEPT_TAC(body, result); - return gnode_prove(root); -} - -PROOF thm AUTH_RA_UPDATE_AUTH = - prove_auth_ra_update_auth(); - -PROOF static thm prove_auth_ra_local_update(void) { - term goal_tm = ` - forall - (R:(A)ra) - (a:A) - (b0:A) - (b1:A) - (a_new:A) - (b0_new:A) - (b1_new:A). - ra_local_update R (b0,b1) (b0_new,b1_new) ==> - ra_included R b0_new a_new ==> - ra_valid R a_new ==> - ra_local_update - (auth_ra R) - (auth_both a b0,auth_both a b1) - (auth_both a_new b0_new,auth_both a_new b1_new) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - body = CONV_TAC( - body, - once_rewrite_conv(THM_LIST(ra_local_update_def))); - body = CONV_TAC( - body, - rewrite_conv(THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")))); - body = AUTO_INTROS_TAC(body); - - thm source_validity_eq = beta_rule(ap_term_rule( - `\x:(A)excl#A. - ra_valid (auth_ra (R:(A)ra)) x`, - assume_rule(` - auth_both (a:A) (b0:A) == - ra_op - (auth_ra (R:(A)ra)) - (auth_both a (b1:A)) - (frame:(A)excl#A) - `))); - thm source_owned_frame_valid = eq_mp_rule( - source_validity_eq, - assume_rule(` - ra_valid - (auth_ra (R:(A)ra)) - (auth_both (a:A) (b0:A)) - `)); - thm frame_details = eq_mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `a:A`, - `b1:A`, - `frame:(A)excl#A`), - AUTH_RA_VALID_BOTH_FRAME), - source_owned_frame_valid); - body = ASSUME_TAC(body, frame_details, "Hframe_details"); - body = ASMP_EXISTS_TAC(body, "Hframe_details", "external"); - body = ASMP_CONJ_TAC( - body, - "Hframe_details", - "Hframe", - "Hsource_details"); - - thm source_authority_valid = mp_rule( - ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`, `b0:A`), - AUTH_RA_VALID_BOTH_ELIM_VALID), - assume_rule(` - ra_valid - (auth_ra (R:(A)ra)) - (auth_both (a:A) (b0:A)) - `)); - thm source_fragment_included = mp_rule( - ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`, `b0:A`), - AUTH_RA_VALID_BOTH_ELIM_INCLUDED), - assume_rule(` - ra_valid - (auth_ra (R:(A)ra)) - (auth_both (a:A) (b0:A)) - `)); - thm source_fragment_valid = mp_rule( - mp_rule( - ispecl_rule( - TERM_LIST(`R:(A)ra`, `b0:A`, `a:A`), - RA_INCLUDED_VALID), - source_fragment_included), - source_authority_valid); - - thm normalized_source_eq = rewrite_rule( - THM_LIST( - assume_rule(` - (frame:(A)excl#A) == auth_frag (external:A) - `), - AUTH_RA_BOTH_FRAG), - assume_rule(` - auth_both (a:A) (b0:A) == - ra_op - (auth_ra (R:(A)ra)) - (auth_both a (b1:A)) - (frame:(A)excl#A) - `)); - thm source_components = eq_mp_rule( - ispecl_rule( - TERM_LIST( - `a:A`, - `b0:A`, - `a:A`, - `ra_op (R:(A)ra) (b1:A) (external:A)`), - AUTH_RA_BOTH_INJ), - normalized_source_eq); - thm source_base_eq = conjunct2_rule(source_components); - - thm base_apply = rewrite_rule( - THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")), - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `((b0:A),(b1:A))`, - `((b0_new:A),(b1_new:A))`, - `external:A`), - RA_LOCAL_UPDATE_APPLY)); - thm base_result = mp_rule( - mp_rule( - mp_rule( - base_apply, - assume_rule(` - ra_local_update - (R:(A)ra) - ((b0:A),(b1:A)) - ((b0_new:A),(b1_new:A)) - `)), - source_fragment_valid), - source_base_eq); - - thm target_valid = mp_rule( - mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `a_new:A`, - `b0_new:A`), - AUTH_RA_VALID_BOTH_INTRO), - assume_rule(`ra_valid (R:(A)ra) (a_new:A)`)), - assume_rule(` - ra_included (R:(A)ra) (b0_new:A) (a_new:A) - `)); - - thm target_fragment_eq = beta_rule(ap_term_rule( - `\x:A. auth_both (a_new:A) x`, - conjunct2_rule(base_result))); - thm target_fragment_op = ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `a_new:A`, - `b1_new:A`, - `external:A`), - AUTH_RA_BOTH_FRAG); - thm replace_target_frame = beta_rule(ap_term_rule( - `\fr:(A)excl#A. - ra_op - (auth_ra (R:(A)ra)) - (auth_both (a_new:A) (b1_new:A)) - fr`, - assume_rule(` - (frame:(A)excl#A) == auth_frag (external:A) - `))); - thm target_eq = trans_rule( - target_fragment_eq, - trans_rule( - gsym_rule(target_fragment_op), - gsym_rule(replace_target_frame))); - - gnode_list result = CONJ_TAC(body); - ACCEPT_TAC(result[0], target_valid); - ACCEPT_TAC(result[1], target_eq); - return gnode_prove(root); -} - -PROOF thm AUTH_RA_LOCAL_UPDATE = - prove_auth_ra_local_update(); - /* ------------------------------------------------------------------------- */ /* Allocation and cancellative specializations */ /* ------------------------------------------------------------------------- */ @@ -2912,7 +2328,7 @@ PROOF static thm prove_auth_ra_alloc_both(void) { `f:A`, `ra_op (R:(A)ra) (a:A) (piece:A)`, `ra_op (R:(A)ra) (f:A) (piece:A)`), - AUTH_RA_UPDATE), + AUTH_RA_UPDATE_LOCAL), local); ACCEPT_TAC(body, updated); return gnode_prove(root); @@ -2994,7 +2410,7 @@ PROOF static thm prove_auth_ra_update_cancellative(void) { `a:A`, `ra_op (R:(A)ra) (b:A) (frame:A)`, `b:A`), - AUTH_RA_UPDATE), + AUTH_RA_UPDATE_LOCAL), local); ACCEPT_TAC(body, updated); return gnode_prove(root); @@ -3047,7 +2463,6 @@ PROOF static int audit_auth_ra(void) { AUTH_RA_VALID_AUTH_FRAME, AUTH_RA_BOTH_CONFLICT, AUTH_RA_AUTH_BOTH_CONFLICT, - AUTH_RA_BOTH_EXCLUSIVE, AUTH_EXCL_UNIT_INCLUDED, AUTH_EXCL_OWNED_NOT_INCLUDED_UNIT, AUTH_RA_INCLUDED_FRAG_FRAG, @@ -3063,20 +2478,15 @@ PROOF static int audit_auth_ra(void) { AUTH_RA_CANCELLATIVE_IFF, AUTH_RA_UPDATE_FRAMEWISE, AUTH_RA_UPDATE_FRAMEWISE_IFF, - AUTH_RA_UPDATE, - AUTH_RA_UPDATE_ND, - AUTH_RA_UPDATE_ND_FRAMEWISE_IFF, + AUTH_RA_UPDATE_LOCAL, AUTH_RA_UPDATE_AUTH_IFF, AUTH_RA_UPDATE_AUTH_INCLUDED, - AUTH_RA_UPDATE_DROP_FRAG, + AUTH_RA_UPDATE_DROP_LOCAL, AUTH_RA_UPDATE_DROP_AUTH, AUTH_RA_UPDATE_WEAKEN_FRAG, AUTH_RA_FRAG_UPDATE_INCLUDED, AUTH_RA_UPDATE_BOTH_INCLUDED, AUTH_RA_UPDATE_ALLOC, - AUTH_RA_UPDATE_DEALLOC, - AUTH_RA_UPDATE_AUTH, - AUTH_RA_LOCAL_UPDATE, AUTH_RA_ALLOC_BOTH, AUTH_RA_ALLOC, AUTH_RA_UPDATE_CANCELLATIVE); diff --git a/theory/logic/auth_ra.h b/theory/logic/auth_ra.h index 636c1b0..19a2886 100644 --- a/theory/logic/auth_ra.h +++ b/theory/logic/auth_ra.h @@ -1,722 +1,37 @@ #pragma once -/* - * Authoritative resources over an intrinsic resource algebra. - * - * For `R=(|R|,ε_R,·_R,valid_R)` with `R:(A)ra` and `|R|=A`, the - * carrier is `(A)excl # A`. The - * exclusive first component records - * whether this resource owns the unique authoritative value; the second - * component records an ordinary fragment. Operation is the product of - * `excl_ra` and `R`; validity additionally requires every fragment to be - * included in its authoritative value when authority is present. - * - * Public HOL constructors have shapes - * - * auth_auth : (A)ra -> A -> (A)excl#A, - * auth_frag : A -> (A)excl#A, - * auth_both : A -> A -> (A)excl#A. - * - * This client interface deliberately hides the raw operation, raw validity - * predicate, abstraction descriptor, and constructor definitions. Clients - * reason through the exact computation, validity, and update rules below. - */ +/* Authoritative resource algebra over a base RA. */ #include "proof/theory/logic/excl_ra.h" #include "proof/theory/logic/local_update.h" -/* ------------------------------------------------------------------------- */ -/* Core representation and constructors */ -/* ------------------------------------------------------------------------- */ - -/* - * The authoritative RA unit is a fragment-only base unit: - * - * forall R:(A)ra. - * ra_unit (auth_ra R) == auth_frag (ra_unit R) - */ PROOF extern thm AUTH_RA_UNIT; - -/* - * Authoritative ownership composes with a fragment: - * - * forall (R:(A)ra) (a:A) (f:A). - * ra_op (auth_ra R) (auth_auth R a) (auth_frag f) == - * auth_both a f - */ PROOF extern thm AUTH_RA_AUTH_FRAG; - -/* - * Fragment-only resources compose through the base RA: - * - * forall (R:(A)ra) (f:A) (g:A). - * ra_op (auth_ra R) (auth_frag f) (auth_frag g) == - * auth_frag (ra_op R f g) - */ PROOF extern thm AUTH_RA_FRAG_FRAG; - -/* - * A combined authoritative resource absorbs another fragment into its - * fragment component: - * - * forall (R:(A)ra) (a:A) (f:A) (g:A). - * ra_op (auth_ra R) (auth_both a f) (auth_frag g) == - * auth_both a (ra_op R f g) - */ PROOF extern thm AUTH_RA_BOTH_FRAG; -/* - * A combined resource with the base unit fragment is authority-only: - * - * forall (R:(A)ra) (a:A). - * auth_both a (ra_unit R) == auth_auth R a - */ -PROOF extern thm AUTH_RA_BOTH_UNIT; - -/* ------------------------------------------------------------------------- */ -/* Constructor equality and distinction */ -/* ------------------------------------------------------------------------- */ - -/* - * Fragment-only construction is injective: - * - * forall (f:A) (g:A). - * (auth_frag f:(A)excl#A) == auth_frag g <=> f == g - */ -PROOF extern thm AUTH_RA_FRAG_INJ; - -/* - * Combined construction is injective in both components: - * - * forall (a:A) (f:A) (b:A) (g:A). - * (auth_both a f:(A)excl#A) == auth_both b g <=> - * a == b && f == g - */ -PROOF extern thm AUTH_RA_BOTH_INJ; - -/* - * A combined authoritative resource is never fragment-only: - * - * forall (a:A) (f:A) (g:A). - * ~((auth_both a f:(A)excl#A) == auth_frag g) - */ -PROOF extern thm AUTH_RA_BOTH_NE_FRAG; - -/* - * Authority-only construction is injective for a fixed base RA: - * - * forall (R:(A)ra) (a:A) (b:A). - * auth_auth R a == auth_auth R b <=> a == b - */ -PROOF extern thm AUTH_RA_AUTH_INJ; - -/* - * An authority-only resource is never fragment-only: - * - * forall (R:(A)ra) (a:A) (f:A). - * ~(auth_auth R a == auth_frag f) - */ -PROOF extern thm AUTH_RA_AUTH_NE_FRAG; - -/* - * Authority-only is exactly combined ownership with the base unit fragment: - * - * forall (R:(A)ra) (a:A) (b:A) (f:A). - * auth_auth R a == auth_both b f <=> - * a == b && f == ra_unit R - */ -PROOF extern thm AUTH_RA_AUTH_EQ_BOTH; - -/* ------------------------------------------------------------------------- */ -/* Validity and authority conflict */ -/* ------------------------------------------------------------------------- */ - -/* - * forall (R:(A)ra) (f:A). - * ra_valid (auth_ra R) (auth_frag f) <=> ra_valid R f - */ PROOF extern thm AUTH_RA_VALID_FRAG; - -/* - * Combined validity exposes the authoritative value and its fragment: - * - * forall (R:(A)ra) (a:A) (f:A). - * ra_valid (auth_ra R) (auth_both a f) <=> - * ra_valid R a && ra_included R f a - */ PROOF extern thm AUTH_RA_VALID_BOTH; - -/* - * Direct introduction form of combined validity: - * - * forall (R:(A)ra) (a:A) (f:A). - * ra_valid R a ==> - * ra_included R f a ==> - * ra_valid (auth_ra R) (auth_both a f) - */ -PROOF extern thm AUTH_RA_VALID_BOTH_INTRO; - -/* - * forall (R:(A)ra) (a:A) (f:A). - * ra_valid (auth_ra R) (auth_both a f) ==> - * ra_valid R a - */ -PROOF extern thm AUTH_RA_VALID_BOTH_ELIM_VALID; - -/* - * forall (R:(A)ra) (a:A) (f:A). - * ra_valid (auth_ra R) (auth_both a f) ==> - * ra_included R f a - */ -PROOF extern thm AUTH_RA_VALID_BOTH_ELIM_INCLUDED; - -/* - * forall (R:(A)ra) (a:A). - * ra_valid (auth_ra R) (auth_auth R a) <=> ra_valid R a - */ PROOF extern thm AUTH_RA_VALID_AUTH; - -/* - * Validity of authority composed with one fragment: - * - * forall (R:(A)ra) (a:A) (f:A). - * ra_valid - * (auth_ra R) - * (ra_op - * (auth_ra R) - * (auth_auth R a) - * (auth_frag f)) <=> - * ra_valid R a && ra_included R f a - */ -PROOF extern thm AUTH_RA_VALID_AUTH_FRAG; - -/* - * Validity after framing combined ownership by another fragment: - * - * forall (R:(A)ra) (a:A) (f:A) (g:A). - * ra_valid - * (auth_ra R) - * (ra_op - * (auth_ra R) - * (auth_both a f) - * (auth_frag g)) <=> - * ra_valid R a && - * ra_included R (ra_op R f g) a - */ -PROOF extern thm AUTH_RA_VALID_BOTH_FRAG; - -/* - * Exact constructor-level characterization of every frame compatible with - * combined authoritative ownership: - * - * forall - * (R:(A)ra) - * (a:A) - * (f:A) - * (frame:(A)excl#A). - * ra_valid - * (auth_ra R) - * (ra_op - * (auth_ra R) - * (auth_both a f) - * frame) <=> - * exists external:A. - * frame == auth_frag external && - * ra_valid R a && - * ra_included R (ra_op R f external) a - */ PROOF extern thm AUTH_RA_VALID_BOTH_FRAME; - -/* - * Authority-only specialization of `AUTH_RA_VALID_BOTH_FRAME`: - * - * forall - * (R:(A)ra) - * (a:A) - * (frame:(A)excl#A). - * ra_valid - * (auth_ra R) - * (ra_op - * (auth_ra R) - * (auth_auth R a) - * frame) <=> - * exists external:A. - * frame == auth_frag external && - * ra_valid R a && - * ra_included R external a - */ -PROOF extern thm AUTH_RA_VALID_AUTH_FRAME; - -/* - * forall (R:(A)ra) (a:A) (b:A). - * ~(ra_valid - * (auth_ra R) - * (ra_op - * (auth_ra R) - * (auth_auth R a) - * (auth_auth R b))) - */ PROOF extern thm AUTH_RA_AUTH_CONFLICT; -/* - * Two combined resources also conflict, independently of their fragments: - * - * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). - * ~(ra_valid - * (auth_ra R) - * (ra_op - * (auth_ra R) - * (auth_both a f) - * (auth_both b g))) - */ -PROOF extern thm AUTH_RA_BOTH_CONFLICT; - -/* - * Authority-only and combined ownership always conflict: - * - * forall (R:(A)ra) (a:A) (b:A) (g:A). - * ~(ra_valid - * (auth_ra R) - * (ra_op - * (auth_ra R) - * (auth_auth R a) - * (auth_both b g))) - */ -PROOF extern thm AUTH_RA_AUTH_BOTH_CONFLICT; - -/* - * An exclusive locally owned fragment makes combined ownership exclusive: - * - * forall (R:(A)ra) (a:A) (f:A). - * ra_exclusive R f ==> - * ra_exclusive (auth_ra R) (auth_both a f) - */ -PROOF extern thm AUTH_RA_BOTH_EXCLUSIVE; - -/* ------------------------------------------------------------------------- */ -/* Constructor inclusion */ -/* ------------------------------------------------------------------------- */ - -/* - * forall (R:(A)ra) (f:A) (g:A). - * ra_included - * (auth_ra R) - * (auth_frag f) - * (auth_frag g) <=> - * ra_included R f g - */ PROOF extern thm AUTH_RA_INCLUDED_FRAG_FRAG; - -/* - * A fragment can extend to authority-only exactly when it extends to the - * base unit. No positivity assumption is made on the base RA. - * - * forall (R:(A)ra) (f:A) (a:A). - * ra_included - * (auth_ra R) - * (auth_frag f) - * (auth_auth R a) <=> - * ra_included R f (ra_unit R) - */ -PROOF extern thm AUTH_RA_INCLUDED_FRAG_AUTH; - -/* - * forall (R:(A)ra) (f:A) (a:A) (g:A). - * ra_included - * (auth_ra R) - * (auth_frag f) - * (auth_both a g) <=> - * ra_included R f g - */ PROOF extern thm AUTH_RA_INCLUDED_FRAG_BOTH; - -/* - * Authority cannot extend to a fragment-only resource: - * - * forall (R:(A)ra) (a:A) (g:A). - * ~(ra_included - * (auth_ra R) - * (auth_auth R a) - * (auth_frag g)) - */ -PROOF extern thm AUTH_RA_INCLUDED_AUTH_FRAG; - -/* - * forall (R:(A)ra) (a:A) (b:A). - * ra_included - * (auth_ra R) - * (auth_auth R a) - * (auth_auth R b) <=> - * a == b - */ PROOF extern thm AUTH_RA_INCLUDED_AUTH_AUTH; - -/* - * forall (R:(A)ra) (a:A) (b:A) (g:A). - * ra_included - * (auth_ra R) - * (auth_auth R a) - * (auth_both b g) <=> - * a == b - */ PROOF extern thm AUTH_RA_INCLUDED_AUTH_BOTH; - -/* - * Combined authoritative ownership cannot extend to a fragment-only - * resource: - * - * forall (R:(A)ra) (a:A) (f:A) (g:A). - * ~(ra_included - * (auth_ra R) - * (auth_both a f) - * (auth_frag g)) - */ -PROOF extern thm AUTH_RA_INCLUDED_BOTH_FRAG; - -/* - * The `ra_included R f (ra_unit R)` conjunct cannot in general be replaced - * by `f == ra_unit R`, even when the base RA is cancellative. - * - * forall (R:(A)ra) (a:A) (f:A) (b:A). - * ra_included - * (auth_ra R) - * (auth_both a f) - * (auth_auth R b) <=> - * a == b && ra_included R f (ra_unit R) - */ -PROOF extern thm AUTH_RA_INCLUDED_BOTH_AUTH; - -/* - * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). - * ra_included - * (auth_ra R) - * (auth_both a f) - * (auth_both b g) <=> - * a == b && ra_included R f g - */ PROOF extern thm AUTH_RA_INCLUDED_BOTH_BOTH; -/* ------------------------------------------------------------------------- */ -/* Laws: optional algebraic properties */ -/* ------------------------------------------------------------------------- */ - -/* - * Cancellativity of the base RA lifts through authoritative ownership: - * - * forall R:(A)ra. - * ra_cancellative R ==> - * ra_cancellative (auth_ra R) - */ -PROOF extern thm AUTH_RA_CANCELLATIVE; - -/* - * The authoritative construction neither gains nor loses cancellativity: - * - * forall R:(A)ra. - * ra_cancellative (auth_ra R) <=> ra_cancellative R - */ PROOF extern thm AUTH_RA_CANCELLATIVE_IFF; -/* ------------------------------------------------------------------------- */ -/* Updates: general frame-preserving rules */ -/* ------------------------------------------------------------------------- */ - -/* - * Direct framewise deterministic authoritative update criterion. - * - * To update `auth_both a f` to `auth_both b g`, it is sufficient to show - * that every external fragment compatible with the source remains compatible - * with the target. This condition is not implied by an attempted lift of - * `ra_update R a b`: a base update need not preserve which fragments are - * included in the authoritative value. - * - * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). - * (forall external:A. - * ra_valid R a && - * ra_included R (ra_op R f external) a ==> - * ra_valid R b && - * ra_included R (ra_op R g external) b) ==> - * ra_update - * (auth_ra R) - * (auth_both a f) - * (auth_both b g) - */ -PROOF extern thm AUTH_RA_UPDATE_FRAMEWISE; - -/* - * Exact deterministic framewise characterization: - * - * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). - * ra_update - * (auth_ra R) - * (auth_both a f) - * (auth_both b g) <=> - * forall external:A. - * ra_valid R a && - * ra_included R (ra_op R f external) a ==> - * ra_valid R b && - * ra_included R (ra_op R g external) b - */ PROOF extern thm AUTH_RA_UPDATE_FRAMEWISE_IFF; -/* - * Iris-style lifting of a base local update to the authoritative RA: - * - * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). - * ra_local_update R (a,f) (b,g) ==> - * ra_update - * (auth_ra R) - * (auth_both a f) - * (auth_both b g) - * - * A local update preserves the same residual base frame exactly. This is - * stronger than the framewise criterion above, and consequently supplies - * that criterion by preserving an inclusion witness. - */ -PROOF extern thm AUTH_RA_UPDATE; - -/* - * Predicate-valued authoritative update. The selected `(b,g)` may depend on - * the hidden external fragment, matching the semantics of `ra_update_nd`. - * This theorem deliberately retains the general framewise premise: the - * fixed-target `ra_local_update` relation cannot express a target selected - * separately for each hidden frame. - * - * forall (R:(A)ra) (a:A) (f:A) (P:A->A->bool). - * (forall external:A. - * ra_valid R a && - * ra_included R (ra_op R f external) a ==> - * exists (b:A) (g:A). - * P b g && - * ra_valid R b && - * ra_included R (ra_op R g external) b) ==> - * ra_update_nd - * (auth_ra R) - * (auth_both a f) - * (\candidate:(A)excl#A. - * exists (b:A) (g:A). - * P b g && candidate == auth_both b g) - */ -PROOF extern thm AUTH_RA_UPDATE_ND; - -/* - * Exact ND framewise characterization for results restricted to combined - * authoritative ownership: - * - * forall (R:(A)ra) (a:A) (f:A) (P:A->A->bool). - * ra_update_nd - * (auth_ra R) - * (auth_both a f) - * (\candidate:(A)excl#A. - * exists (b:A) (g:A). - * P b g && candidate == auth_both b g) <=> - * forall external:A. - * ra_valid R a && - * ra_included R (ra_op R f external) a ==> - * exists (b:A) (g:A). - * P b g && - * ra_valid R b && - * ra_included R (ra_op R g external) b - */ -PROOF extern thm AUTH_RA_UPDATE_ND_FRAMEWISE_IFF; - -/* ------------------------------------------------------------------------- */ -/* Updates: exact authority and weakening rules */ -/* ------------------------------------------------------------------------- */ +/* Base local updates lift to frame-preserving authoritative updates. */ +PROOF extern thm AUTH_RA_UPDATE_LOCAL; -/* - * Exact authority-only deterministic update characterization. The source - * validity guard is essential because updates from an invalid authority are - * vacuous. - * - * forall (R:(A)ra) (a:A) (b:A). - * ra_update - * (auth_ra R) - * (auth_auth R a) - * (auth_auth R b) <=> - * (ra_valid R a ==> - * ra_valid R b && ra_included R a b) - */ PROOF extern thm AUTH_RA_UPDATE_AUTH_IFF; - -/* - * forall (R:(A)ra) (a:A) (b:A). - * ra_valid R b ==> - * ra_included R a b ==> - * ra_update - * (auth_ra R) - * (auth_auth R a) - * (auth_auth R b) - */ -PROOF extern thm AUTH_RA_UPDATE_AUTH_INCLUDED; - -/* - * Discard the locally owned fragment while retaining authority: - * - * forall (R:(A)ra) (a:A) (f:A). - * ra_update - * (auth_ra R) - * (auth_both a f) - * (auth_auth R a) - */ -PROOF extern thm AUTH_RA_UPDATE_DROP_FRAG; - -/* - * Discard authority while retaining the locally owned fragment: - * - * forall (R:(A)ra) (a:A) (f:A). - * ra_update - * (auth_ra R) - * (auth_both a f) - * (auth_frag f) - */ +PROOF extern thm AUTH_RA_UPDATE_ALLOC; +PROOF extern thm AUTH_RA_UPDATE_DROP_LOCAL; PROOF extern thm AUTH_RA_UPDATE_DROP_AUTH; - -/* - * Weaken the locally owned fragment beneath unchanged authority: - * - * forall (R:(A)ra) (a:A) (f:A) (g:A). - * ra_included R g f ==> - * ra_update - * (auth_ra R) - * (auth_both a f) - * (auth_both a g) - */ PROOF extern thm AUTH_RA_UPDATE_WEAKEN_FRAG; - -/* - * Base inclusion lifts to a fragment-only authoritative update: - * - * forall (R:(A)ra) (f:A) (g:A). - * ra_included R g f ==> - * ra_update - * (auth_ra R) - * (auth_frag f) - * (auth_frag g) - */ -PROOF extern thm AUTH_RA_FRAG_UPDATE_INCLUDED; - -/* - * Grow an authoritative value while preserving the same local fragment: - * - * forall (R:(A)ra) (a:A) (b:A) (f:A). - * ra_valid R b ==> - * ra_included R a b ==> - * ra_update - * (auth_ra R) - * (auth_both a f) - * (auth_both b f) - */ -PROOF extern thm AUTH_RA_UPDATE_BOTH_INCLUDED; - -/* ------------------------------------------------------------------------- */ -/* Updates: Iris-style constructor specializations */ -/* ------------------------------------------------------------------------- */ - -/* - * Allocate a local fragment while changing the authoritative value: - * - * forall (R:(A)ra) (a:A) (b:A) (g:A). - * ra_local_update R (a,ra_unit R) (b,g) ==> - * ra_update - * (auth_ra R) - * (auth_auth R a) - * (auth_both b g) - */ -PROOF extern thm AUTH_RA_UPDATE_ALLOC; - -/* - * Consume the locally owned fragment as part of a local update: - * - * forall (R:(A)ra) (a:A) (f:A) (b:A). - * ra_local_update R (a,f) (b,ra_unit R) ==> - * ra_update - * (auth_ra R) - * (auth_both a f) - * (auth_auth R b) - */ -PROOF extern thm AUTH_RA_UPDATE_DEALLOC; - -/* - * Change authority using a local update and discard its produced fragment: - * - * forall (R:(A)ra) (a:A) (b:A) (g:A). - * ra_local_update R (a,ra_unit R) (b,g) ==> - * ra_update - * (auth_ra R) - * (auth_auth R a) - * (auth_auth R b) - */ -PROOF extern thm AUTH_RA_UPDATE_AUTH; - -/* ------------------------------------------------------------------------- */ -/* Local updates of authoritative resources */ -/* ------------------------------------------------------------------------- */ - -/* - * Lift a base local update to a local update between authoritative pairs: - * - * forall - * (R:(A)ra) - * (a:A) - * (b0:A) (b1:A) - * (a':A) - * (b0':A) (b1':A). - * ra_local_update R (b0,b1) (b0',b1') ==> - * ra_included R b0' a' ==> - * ra_valid R a' ==> - * ra_local_update - * (auth_ra R) - * (auth_both a b0,auth_both a b1) - * (auth_both a' b0',auth_both a' b1') - * - * A compatible hidden auth frame must be `auth_frag external`; the base - * local update preserves that exact `external`. The two target premises are - * precisely the validity condition for `auth_both a' b0'`. - */ -PROOF extern thm AUTH_RA_LOCAL_UPDATE; - -/* ------------------------------------------------------------------------- */ -/* Updates: allocation and cancellative specializations */ -/* ------------------------------------------------------------------------- */ - -/* - * Extend both the authority and the locally owned fragment by `piece`: - * - * forall (R:(A)ra) (a:A) (f:A) (piece:A). - * ra_valid R (ra_op R a piece) ==> - * ra_update - * (auth_ra R) - * (auth_both a f) - * (auth_both - * (ra_op R a piece) - * (ra_op R f piece)) - */ -PROOF extern thm AUTH_RA_ALLOC_BOTH; - -/* - * Allocate a fragment while extending an authority-only resource: - * - * forall (R:(A)ra) (a:A) (piece:A). - * ra_valid R (ra_op R a piece) ==> - * ra_update - * (auth_ra R) - * (auth_auth R a) - * (auth_both (ra_op R a piece) piece) - */ PROOF extern thm AUTH_RA_ALLOC; - -/* - * Synchronized residual replacement for cancellative base RAs: - * - * forall (R:(A)ra) (a:A) (b:A) (frame:A). - * ra_cancellative R ==> - * ra_valid R (ra_op R b frame) ==> - * ra_update - * (auth_ra R) - * (auth_both (ra_op R a frame) a) - * (auth_both (ra_op R b frame) b) - * - * No base `ra_update` premise is used. - */ -PROOF extern thm AUTH_RA_UPDATE_CANCELLATIVE; diff --git a/theory/logic/basic_update.c b/theory/logic/basic_update.c index d4eb8a7..a17f11c 100644 --- a/theory/logic/basic_update.c +++ b/theory/logic/basic_update.c @@ -12,7 +12,7 @@ PROOF thm r_bupd_def = new_fun_definition(` (R:(A)ra) (Q:A->bool) (owned:A) <=> - ra_update_nd R owned Q + ra_updateP R owned Q `); PROOF thm r_viewshift_def = new_fun_definition(` @@ -36,7 +36,7 @@ PROOF static thm prove_r_bupd_intro(void) { pure_rewrite_conv(THM_LIST( r_entails_def, r_bupd_def, - ra_update_nd_def))); + ra_updateP_def))); body = AUTO_INTROS_TAC(body); body = EXISTS_TAC(body, `resource:A`); gnode_list result = CONJ_TAC(body); @@ -74,7 +74,7 @@ PROOF static thm prove_r_bupd_mono(void) { pure_rewrite_conv(THM_LIST( r_entails_def, r_bupd_def, - ra_update_nd_def))); + ra_updateP_def))); body = GEN_TAC(body, "R"); body = GEN_TAC(body, "P"); body = GEN_TAC(body, "Q"); @@ -110,18 +110,18 @@ PROOF static thm prove_r_bupd_mono(void) { "HP", "Hvalid_selected_frame"); - thm valid_selected = mp_rule( + thm valid_selected = conjunct1_rule(mp_rule( ispecl_rule( TERM_LIST( `R:(A)ra`, `selected:A`, `frame:A`), - RA_VALID_OP_L), + RA_VALID_OP), assume_rule(` ra_valid (R:(A)ra) (ra_op R (selected:A) (frame:A)) - `)); + `))); thm q_selected = mp_rule( mp_rule( spec_rule( @@ -167,7 +167,7 @@ PROOF static thm prove_r_bupd_idem(void) { pure_rewrite_conv(THM_LIST( r_entails_def, r_bupd_def, - ra_update_nd_def))); + ra_updateP_def))); body = GEN_TAC(body, "R"); body = GEN_TAC(body, "P"); body = GEN_TAC(body, "owned"); @@ -247,7 +247,7 @@ PROOF static thm prove_r_bupd_frame(void) { r_entails_def, r_sep_def, r_bupd_def, - ra_update_nd_def))); + ra_updateP_def))); body = GEN_TAC(body, "R"); body = GEN_TAC(body, "P"); body = GEN_TAC(body, "frame_pred"); @@ -697,35 +697,37 @@ PROOF static thm prove_r_viewshift_sep(void) { r_viewshift (R:(A)ra) (P2:A->bool) (Q2:A->bool) `)); - thm source_commute = ispecl_rule( + thm source_commute = rewrite_rule( + THM_LIST(r_equiv_def), + ispecl_rule( TERM_LIST( `R:(A)ra`, - `P2:A->bool`, - `Q1:A->bool`), - R_SEP_COMM); - thm source_eq = beta_rule(ap_term_rule( - `\source:A->bool. - r_viewshift - (R:(A)ra) - source - (r_sep R (Q2:A->bool) (Q1:A->bool))`, - source_commute)); - thm second_source_aligned = eq_mp_rule(source_eq, second_framed); + `Q1:A->bool`, + `P2:A->bool`), + R_SEP_COMM)); - thm target_commute = ispecl_rule( + thm target_commute = rewrite_rule( + THM_LIST(r_equiv_def), + ispecl_rule( TERM_LIST( `R:(A)ra`, `Q2:A->bool`, `Q1:A->bool`), - R_SEP_COMM); - thm target_eq = beta_rule(ap_term_rule( - `\target:A->bool. - r_viewshift - (R:(A)ra) - (r_sep R (Q1:A->bool) (P2:A->bool)) - target`, - target_commute)); - thm second_aligned = eq_mp_rule(target_eq, second_source_aligned); + R_SEP_COMM)); + thm second_aligned = mp_rule( + mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_sep R (Q1:A->bool) (P2:A->bool)`, + `r_sep R (P2:A->bool) (Q1:A->bool)`, + `r_sep R (Q2:A->bool) (Q1:A->bool)`, + `r_sep R (Q1:A->bool) (Q2:A->bool)`), + R_VIEWSHIFT_MONO), + conjunct1_rule(source_commute)), + second_framed), + conjunct1_rule(target_commute)); thm result = mp_rule( mp_rule( @@ -909,8 +911,11 @@ PROOF static thm prove_r_own_update(void) { r_entails_def, r_bupd_def, r_own_def, - ra_update_nd_def, + ra_updateP_def, ra_update_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); body = GEN_TAC(body, "R"); body = GEN_TAC(body, "a"); body = GEN_TAC(body, "b"); @@ -935,7 +940,7 @@ PROOF static thm prove_r_own_update(void) { (R:(A)ra) (ra_op R (owned:A) (frame:A)) `)); - thm valid_b_frame = mp_rule( + thm selected = mp_rule( spec_rule( `frame:A`, assume_rule(` @@ -943,36 +948,34 @@ PROOF static thm prove_r_own_update(void) { ra_valid (R:(A)ra) (ra_op R (a:A) frame) ==> - ra_valid R (ra_op R (b:A) frame) + exists selected:A. + selected == (b:A) && + ra_valid R (ra_op R selected frame) `)), valid_a_frame); - - body = EXISTS_TAC(body, `b:A`); - gnode_list result = CONJ_TAC(body); - ACCEPT_TAC(result[0], refl_rule(`b:A`)); - ACCEPT_TAC(result[1], valid_b_frame); + ACCEPT_TAC(body, selected); return gnode_prove(root); } PROOF thm R_OWN_UPDATE = prove_r_own_update(); -PROOF static thm prove_r_own_update_nd(void) { +PROOF static thm prove_r_own_updatep(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (result_pred:A->bool). - ra_update_nd R a result_pred ==> + ra_updateP R a result_pred ==> r_viewshift R (r_own R a) (r_exists R (\selected:A. - r_and + r_sep R - (r_pure R (result_pred selected)) + (r_fact R (result_pred selected)) (r_own R selected))) `; gnode root = gnode_new_with_ccl(goal_tm); @@ -984,9 +987,9 @@ PROOF static thm prove_r_own_update_nd(void) { r_bupd_def, r_own_def, r_exists_def, - r_and_def, - r_pure_def, - ra_update_nd_def))); + r_sep_def, + r_fact_def, + ra_updateP_def))); body = CONV_TAC( body, depth_conv(get_conversion_by_name("BETA_CONV"))); @@ -1041,16 +1044,28 @@ PROOF static thm prove_r_own_update_nd(void) { post = CONV_TAC( post, pure_rewrite_conv(THM_LIST( - r_and_def, - r_pure_def, + r_sep_def, + r_fact_def, r_own_def))); - gnode_list post_parts = CONJ_TAC(post); + post = EXISTS_TAC(post, `ra_unit (R:(A)ra)`); + post = EXISTS_TAC(post, `selected:A`); + gnode_list post_split = CONJ_TAC(post); ACCEPT_TAC( - post_parts[0], + post_split[0], + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `selected:A`), + RA_UNIT_L))); + gnode_list post_preds = CONJ_TAC(post_split[1]); + gnode_list post_fact = CONJ_TAC(post_preds[0]); + ACCEPT_TAC( + post_fact[0], assume_rule(` (result_pred:A->bool) (selected:A) `)); - ACCEPT_TAC(post_parts[1], refl_rule(`selected:A`)); + ACCEPT_TAC( + post_fact[1], + refl_rule(`ra_unit (R:(A)ra)`)); + ACCEPT_TAC(post_preds[1], refl_rule(`selected:A`)); ACCEPT_TAC( result[1], assume_rule(` @@ -1061,8 +1076,8 @@ PROOF static thm prove_r_own_update_nd(void) { return gnode_prove(root); } -PROOF thm R_OWN_UPDATE_ND = - prove_r_own_update_nd(); +PROOF thm R_OWN_UPDATEP = + prove_r_own_updatep(); PROOF static int audit_basic_update(void) { thm_list public_theorems = THM_LIST( @@ -1082,7 +1097,7 @@ PROOF static int audit_basic_update(void) { R_VIEWSHIFT_EXISTS_R, R_VIEWSHIFT_EXISTS, R_OWN_UPDATE, - R_OWN_UPDATE_ND); + R_OWN_UPDATEP); for (size_t i = 0; i < vector_size(public_theorems); ++i) { ENSURE_COND( diff --git a/theory/logic/basic_update.h b/theory/logic/basic_update.h index 00be5c9..2e66645 100644 --- a/theory/logic/basic_update.h +++ b/theory/logic/basic_update.h @@ -1,91 +1,30 @@ #pragma once -/* - * Basic updates and view shifts over `R=(|R|, ε_R, ·_R, valid_R)`, - * where `R:(A)ra` and `|R|=A`. - * - * `r_bupd R Q a` is the nondeterministic frame-preserving update `a ↝ Q`: - * - * forall frame. valid(a op frame) ==> - * exists b. Q b && valid(b op frame). - * - * We write `P ⇛_R Q` below for the HOL proposition `r_viewshift R P Q`; - * formally `P ⇛_R Q` iff `P ⊢_R r_bupd R Q`. The result witness may - * depend on the hidden frame. - * This is a pure proof-stdlib theory: loading it registers no QCP descriptor, - * parser interface, or symbolic state. - */ +/* Generic algebraic basic updates. This modality may update the complete RA; + * product-restricted clients must use product_resource.h instead. */ #include "proof/theory/logic/resource_prop.h" -/* ------------------------------------------------------------------------- */ -/* Core representation */ -/* ------------------------------------------------------------------------- */ - -/* `r_bupd R Q a <=> ra_update_nd R a Q`. */ +/* `r_bupd R Q owned <=> ra_updateP R owned Q`. */ PROOF extern thm r_bupd_def; /* `r_viewshift R P Q <=> r_entails R P (r_bupd R Q)`. */ PROOF extern thm r_viewshift_def; -/* ------------------------------------------------------------------------- */ -/* Basic-update laws */ -/* ------------------------------------------------------------------------- */ - -/* `forall R P. P ⊢_R r_bupd R P`. */ PROOF extern thm R_BUPD_INTRO; - -/* `P ⊢_R Q ==> r_bupd R P ⊢_R r_bupd R Q`. */ PROOF extern thm R_BUPD_MONO; - -/* `r_bupd R (r_bupd R P) ⊢_R r_bupd R P`. */ PROOF extern thm R_BUPD_IDEM; - -/* `(r_bupd R P)*F ⊢_R r_bupd R (P*F)`. */ PROOF extern thm R_BUPD_FRAME; -/* ------------------------------------------------------------------------- */ -/* View-shift laws */ -/* ------------------------------------------------------------------------- */ - -/* `forall R P. r_viewshift R P P`. */ PROOF extern thm R_VIEWSHIFT_REFL; - -/* `P ⊢_R Q ==> r_viewshift R P Q`. */ PROOF extern thm R_ENTAILS_TO_VIEWSHIFT; - -/* `P ⇛_R Q ==> Q ⇛_R S ==> P ⇛_R S`. */ PROOF extern thm R_VIEWSHIFT_TRANS; - -/* `P2 ⊢_R P ==> P ⇛_R Q ==> Q ⊢_R Q2 ==> P2 ⇛_R Q2`. */ PROOF extern thm R_VIEWSHIFT_MONO; - -/* `P ⇛_R Q ==> P*F ⇛_R Q*F`. */ PROOF extern thm R_VIEWSHIFT_FRAME; - -/* `P1 ⇛_R Q1 ==> P2 ⇛_R Q2 ==> P1*P2 ⇛_R Q1*Q2`. */ PROOF extern thm R_VIEWSHIFT_SEP; - -/* `(forall x:B. P x ⇛_R Q) ==> r_exists R (\x. P x) ⇛_R Q`. */ -PROOF extern thm R_VIEWSHIFT_EXISTS_L; - -/* `P ⇛_R Q witness ==> P ⇛_R r_exists R (\x. Q x)`. */ -PROOF extern thm R_VIEWSHIFT_EXISTS_R; - -/* `(forall x:B. P x ⇛_R Q x) ==> - * r_exists R (\x. P x) ⇛_R r_exists R (\x. Q x)`. */ PROOF extern thm R_VIEWSHIFT_EXISTS; -/* ------------------------------------------------------------------------- */ -/* Ownership updates */ -/* ------------------------------------------------------------------------- */ - -/* `ra_update R a b ==> r_viewshift R (r_own R a) (r_own R b)`. */ PROOF extern thm R_OWN_UPDATE; -/* - * `ra_update_nd R a P ==> - * r_viewshift R (r_own R a) - * (r_exists R (\b. r_and R (r_pure R (P b)) (r_own R b)))`. - */ -PROOF extern thm R_OWN_UPDATE_ND; +/* Predicate update exposes a witness, an exact-unit fact, and exact ownership. */ +PROOF extern thm R_OWN_UPDATEP; diff --git a/theory/logic/big_sep.c b/theory/logic/big_sep.c index 8bf46f8..9cc21c1 100644 --- a/theory/logic/big_sep.c +++ b/theory/logic/big_sep.c @@ -1,10 +1,9 @@ #include "proof/theory/logic/big_sep.h" +#include "proof/theory/logic/resource_prop_internal.h" #include "proof/proof_backward.h" -#include "proof/theory/data/list.h" #require "proof/proof_backward.c" #require "proof/theory/data/list.c" -#require "proof/theory/logic/finmap.c" #require "proof/theory/logic/resource_prop.c" PROOF static size_t BIG_SEP_AXIOMS_BEFORE = @@ -24,19 +23,40 @@ err: return empty_theorem; } -/* Canonical AC package expected by the kernel's `ac_rule`. */ +PROOF static thm prove_r_equiv_of_eq(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (P:A->bool) (Q:A->bool). + P == Q ==> + r_equiv R P Q + `); + gnode body = AUTO_INTROS_TAC(root); + thm lifted = beta_rule(ap_term_rule( + `\X:A->bool. r_equiv (R:(A)ra) (P:A->bool) X`, + assume_rule(`(P:A->bool) == (Q:A->bool)`))); + ACCEPT_TAC( + body, + eq_mp_rule( + lifted, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `P:A->bool`), + R_EQUIV_REFL))); + return gnode_prove(root); +} + +PROOF static thm R_EQUIV_OF_EQ_BIG_SEP = + prove_r_equiv_of_eq(); + PROOF static thm prove_r_sep_ac(void) { term R = `R:(A)ra`; term P = `P:A->bool`; term Q = `Q:A->bool`; term S = `S:A->bool`; - thm commute = ispecl_rule( TERM_LIST(R, P, Q), - R_SEP_COMM); + R_SEP_COMM_EQ); thm associate = ispecl_rule( TERM_LIST(R, P, Q, S), - R_SEP_ASSOC); + R_SEP_ASSOC_EQ); thm expose_pair = gsym_rule(associate); thm swap_pair = beta_rule(ap_term_rule( `\pair:A->bool. @@ -44,7 +64,7 @@ PROOF static thm prove_r_sep_ac(void) { commute)); thm regroup = ispecl_rule( TERM_LIST(R, Q, P, S), - R_SEP_ASSOC); + R_SEP_ASSOC_EQ); thm left_commute = trans_rule( expose_pair, trans_rule(swap_pair, regroup)); @@ -56,169 +76,94 @@ PROOF static thm prove_r_sep_ac(void) { PROOF static thm R_SEP_AC = prove_r_sep_ac(); -/* - * HOL's iteration theorems conventionally use type variable `A` for their - * index. Resource propositions also use `A` for the RA carrier, so first - * alpha-rename the theorem's index type to keep later specialization from - * accidentally identifying the two roles. - */ -PROOF static thm freshen_iterate_index_type(thm theorem) { - type_pair_list types = (type_pair_list)vector_create(); - vector_add(&types, ((type_pair){`:D`, `:A`})); - return inst_type_rule(types, theorem); -} - -PROOF thm r_big_sep_listi_from_def = new_rec_definition( +PROOF thm r_big_sep_list_def = new_rec_definition( get_theorem_by_name("list_RECURSION"), ` - (r_big_sep_listi_from + (r_big_sep_list (R:(A)ra) - (Phi:num->B->A->bool) - (offset:num) + (Phi:B->A->bool) ([]:(B)list) = r_emp R) && - (r_big_sep_listi_from + (r_big_sep_list R Phi - offset ((x:B) :: (xs:(B)list)) = - r_sep - R - (Phi offset x) - (r_big_sep_listi_from R Phi (SUC offset) xs)) - `); - -PROOF thm r_big_sep_listi_def = new_fun_definition(` - r_big_sep_listi - (R:(A)ra) - (Phi:num->B->A->bool) - (xs:(B)list) = - r_big_sep_listi_from R Phi 0 xs -`); - -PROOF thm r_big_sep_def = new_rec_definition( - get_theorem_by_name("list_RECURSION"), - ` - (r_big_sep - (R:(A)ra) - ([]:(A->bool)list) = - r_emp R) && - (r_big_sep - R - ((P:A->bool) :: (Ps:(A->bool)list)) = - r_sep R P (r_big_sep R Ps)) + r_sep R (Phi x) (r_big_sep_list R Phi xs)) `); -PROOF thm r_big_sep_list_def = new_fun_definition(` - r_big_sep_list - (R:(A)ra) - (Phi:B->A->bool) - (xs:(B)list) = - r_big_sep R (MAP Phi xs) -`); - -PROOF thm r_big_sep_set_def = new_fun_definition(` - r_big_sep_set - (R:(A)ra) - (Phi:B->A->bool) - (s:B->bool) = - iterate (r_sep R) s Phi -`); - -PROOF thm r_big_sep_map_value_def = new_fun_definition(` - r_big_sep_map_value - (m:(K,V)finmap) - (key:K) = - (@value:V. finmap_lookup m key == SOME value) -`); - -PROOF thm r_big_sep_map_def = new_fun_definition(` - r_big_sep_map - (R:(A)ra) - (Phi:K->V->A->bool) - (m:(K,V)finmap) = - r_big_sep_set - R - (\key:K. Phi key (r_big_sep_map_value m key)) - (finmap_dom m) -`); - -PROOF static thm prove_r_big_sep_nil(void) { +/* Definitional equations and algebraic folds are first proved as private raw + * equalities. The stable handles below lift them to r_equiv. */ +PROOF static thm prove_r_big_sep_list_nil_eq(void) { gnode root = gnode_new_with_ccl(` - forall R:(A)ra. - r_big_sep R ([]:(A->bool)list) == r_emp R + forall (R:(A)ra) (Phi:B->A->bool). + r_big_sep_list R Phi ([]:(B)list) == r_emp R `); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - r_big_sep_def, - conjunct1_rule(r_big_sep_def)))); + CONV_TAC(root, rewrite_conv(THM_LIST(r_big_sep_list_def))); return gnode_prove(root); } -PROOF thm R_BIG_SEP_NIL = - prove_r_big_sep_nil(); +PROOF static thm R_BIG_SEP_LIST_NIL_EQ = + prove_r_big_sep_list_nil_eq(); -PROOF static thm prove_r_big_sep_cons(void) { +PROOF static thm prove_r_big_sep_list_cons_eq(void) { gnode root = gnode_new_with_ccl(` forall (R:(A)ra) - (P:A->bool) - (Ps:(A->bool)list). - r_big_sep R (P :: Ps) == - r_sep R P (r_big_sep R Ps) + (Phi:B->A->bool) + (x:B) + (xs:(B)list). + r_big_sep_list R Phi (x :: xs) == + r_sep R (Phi x) (r_big_sep_list R Phi xs) `); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - r_big_sep_def))); + CONV_TAC(root, rewrite_conv(THM_LIST(r_big_sep_list_def))); return gnode_prove(root); } -PROOF thm R_BIG_SEP_CONS = - prove_r_big_sep_cons(); +PROOF static thm R_BIG_SEP_LIST_CONS_EQ = + prove_r_big_sep_list_cons_eq(); -PROOF static thm prove_r_big_sep_singleton(void) { - term R = `R:(A)ra`; - term P = `P:A->bool`; - thm unfold = ispecl_rule( - TERM_LIST(R, P, `[]:(A->bool)list`), - R_BIG_SEP_CONS); - thm empty_tail = beta_rule(ap_term_rule( - `\Q:A->bool. r_sep (R:(A)ra) (P:A->bool) Q`, - ispec_rule(R, R_BIG_SEP_NIL))); - thm result = trans_rule( - unfold, - trans_rule( - empty_tail, - ispecl_rule(TERM_LIST(R, P), R_SEP_EMP_R))); - result = gen_rule(P, result); - return gen_rule(R, result); +PROOF static thm prove_r_big_sep_list_singleton_eq(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (Phi:B->A->bool) (x:B). + r_big_sep_list R Phi (x :: []) == Phi x + `); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + R_BIG_SEP_LIST_CONS_EQ, + R_BIG_SEP_LIST_NIL_EQ, + R_SEP_EMP_R_EQ))); + return gnode_prove(root); } -PROOF thm R_BIG_SEP_SINGLETON = - prove_r_big_sep_singleton(); +PROOF static thm R_BIG_SEP_LIST_SINGLETON_EQ = + prove_r_big_sep_list_singleton_eq(); -PROOF static thm prove_r_big_sep_append(void) { +PROOF static thm prove_r_big_sep_list_append_eq(void) { gnode root = gnode_new_with_ccl(` forall (R:(A)ra) - (left:(A->bool)list) - (right:(A->bool)list). - r_big_sep R (APPEND left right) == - r_sep R (r_big_sep R left) (r_big_sep R right) + (Phi:B->A->bool) + (left:(B)list) + (right:(B)list). + r_big_sep_list R Phi (APPEND left right) == + r_sep + R + (r_big_sep_list R Phi left) + (r_big_sep_list R Phi right) `); gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); body = GEN_TAC(body, "left"); - gnode_list cases = INDUCT_TAC(body, `left:(A->bool)list`); + gnode_list cases = INDUCT_TAC(body, `left:(B)list`); gnode base = AUTO_INTROS_TAC(cases[0]); base = CONV_TAC( base, pure_rewrite_conv(THM_LIST( HOL_APPEND, - R_BIG_SEP_NIL, - R_SEP_EMP_L))); + R_BIG_SEP_LIST_NIL_EQ, + R_SEP_EMP_L_EQ))); RULE_TAC(base, prove_reflexive_equality_goal); gnode step = AUTO_INTROS_TAC(cases[1]); @@ -227,99 +172,114 @@ PROOF static thm prove_r_big_sep_append(void) { pure_rewrite_conv, THM_LIST( HOL_APPEND, - R_BIG_SEP_CONS, - R_SEP_ASSOC)); + R_BIG_SEP_LIST_CONS_EQ, + R_SEP_ASSOC_EQ)); RULE_TAC(step, prove_reflexive_equality_goal); return gnode_prove(root); } -PROOF thm R_BIG_SEP_APPEND = - prove_r_big_sep_append(); +PROOF static thm R_BIG_SEP_LIST_APPEND_EQ = + prove_r_big_sep_list_append_eq(); -PROOF static thm prove_r_big_sep_snoc(void) { +PROOF static thm prove_r_big_sep_list_map_eq(void) { gnode root = gnode_new_with_ccl(` forall (R:(A)ra) - (Ps:(A->bool)list) - (P:A->bool). - r_big_sep R (APPEND Ps (P :: [])) == - r_sep R (r_big_sep R Ps) P - `); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - R_BIG_SEP_APPEND, - R_BIG_SEP_SINGLETON))); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_SNOC = - prove_r_big_sep_snoc(); - -PROOF static thm prove_r_big_sep_reverse(void) { - gnode root = gnode_new_with_ccl(` - forall (R:(A)ra) (Ps:(A->bool)list). - r_big_sep R (REVERSE Ps) == r_big_sep R Ps + (Phi:B->A->bool) + (f:C->B) + (xs:(C)list). + r_big_sep_list R Phi (MAP f xs) == + r_big_sep_list R (\x:C. Phi (f x)) xs `); gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Ps"); - gnode_list cases = INDUCT_TAC(body, `Ps:(A->bool)list`); - + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "f"); + body = GEN_TAC(body, "xs"); + gnode_list cases = INDUCT_TAC(body, `xs:(C)list`); CONV_TAC( cases[0], rewrite_conv(THM_LIST( - HOL_REVERSE, - R_BIG_SEP_NIL))); - - gnode step = AUTO_INTROS_TAC(cases[1]); - CONV_WITH_ASMP_TAC( - step, - rewrite_conv, + get_theorem_by_name("MAP"), + R_BIG_SEP_LIST_NIL_EQ))); + gnode step = CONV_WITH_ASMP_TAC( + cases[1], + pure_rewrite_conv, THM_LIST( - HOL_REVERSE, - R_BIG_SEP_SNOC, - R_BIG_SEP_CONS, - R_SEP_COMM)); + get_theorem_by_name("MAP"), + R_BIG_SEP_LIST_CONS_EQ)); + step = CONV_TAC( + step, + depth_conv(get_conversion_by_name("BETA_CONV"))); + RULE_TAC(step, prove_reflexive_equality_goal); return gnode_prove(root); } -PROOF thm R_BIG_SEP_REVERSE = - prove_r_big_sep_reverse(); +PROOF static thm R_BIG_SEP_LIST_MAP_EQ = + prove_r_big_sep_list_map_eq(); -PROOF static thm prove_r_big_sep_swap_head(void) { +PROOF static thm prove_r_big_sep_list_sep_eq(void) { gnode root = gnode_new_with_ccl(` forall (R:(A)ra) - (P:A->bool) - (Q:A->bool) - (Ps:(A->bool)list). - r_big_sep R (P :: Q :: Ps) == - r_big_sep R (Q :: P :: Ps) + (Phi:B->A->bool) + (Psi:B->A->bool) + (xs:(B)list). + r_big_sep_list + R + (\x:B. r_sep R (Phi x) (Psi x)) + xs == + r_sep + R + (r_big_sep_list R Phi xs) + (r_big_sep_list R Psi xs) `); - gnode body = AUTO_INTROS_TAC(root); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(R_BIG_SEP_CONS))); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "Phi"); + body = GEN_TAC(body, "Psi"); + body = GEN_TAC(body, "xs"); + gnode_list cases = INDUCT_TAC(body, `xs:(B)list`); + CONV_TAC( + cases[0], + rewrite_conv(THM_LIST( + R_BIG_SEP_LIST_NIL_EQ, + R_SEP_EMP_L_EQ))); + gnode step = CONV_WITH_ASMP_TAC( + cases[1], + pure_rewrite_conv, + THM_LIST(R_BIG_SEP_LIST_CONS_EQ)); + step = CONV_TAC( + step, + depth_conv(get_conversion_by_name("BETA_CONV"))); ACCEPT_TAC( - body, - ac_rule(R_SEP_AC, goal_ccl(body->g))); + step, + ac_rule(R_SEP_AC, goal_ccl(step->g))); return gnode_prove(root); } -PROOF thm R_BIG_SEP_SWAP_HEAD = - prove_r_big_sep_swap_head(); +PROOF static thm R_BIG_SEP_LIST_SEP_EQ = + prove_r_big_sep_list_sep_eq(); PROOF static thm prove_r_big_sep_list_nil(void) { gnode root = gnode_new_with_ccl(` forall (R:(A)ra) (Phi:B->A->bool). - r_big_sep_list R Phi ([]:(B)list) == r_emp R + r_equiv R (r_big_sep_list R Phi ([]:(B)list)) (r_emp R) `); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - r_big_sep_list_def, - get_theorem_by_name("MAP"), - R_BIG_SEP_NIL))); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_big_sep_list + (R:(A)ra) + (Phi:B->A->bool) + ([]:(B)list)`, + `r_emp (R:(A)ra)`), + R_EQUIV_OF_EQ_BIG_SEP), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `Phi:B->A->bool`), + R_BIG_SEP_LIST_NIL_EQ))); return gnode_prove(root); } @@ -333,15 +293,33 @@ PROOF static thm prove_r_big_sep_list_cons(void) { (Phi:B->A->bool) (x:B) (xs:(B)list). - r_big_sep_list R Phi (x :: xs) == - r_sep R (Phi x) (r_big_sep_list R Phi xs) + r_equiv + R + (r_big_sep_list R Phi (x :: xs)) + (r_sep R (Phi x) (r_big_sep_list R Phi xs)) `); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - r_big_sep_list_def, - get_theorem_by_name("MAP"), - R_BIG_SEP_CONS))); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_big_sep_list + (R:(A)ra) + (Phi:B->A->bool) + ((x:B) :: (xs:(B)list))`, + `r_sep (R:(A)ra) + ((Phi:B->A->bool) (x:B)) + (r_big_sep_list R Phi (xs:(B)list))`), + R_EQUIV_OF_EQ_BIG_SEP), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Phi:B->A->bool`, + `x:B`, + `xs:(B)list`), + R_BIG_SEP_LIST_CONS_EQ))); return gnode_prove(root); } @@ -351,14 +329,24 @@ PROOF thm R_BIG_SEP_LIST_CONS = PROOF static thm prove_r_big_sep_list_singleton(void) { gnode root = gnode_new_with_ccl(` forall (R:(A)ra) (Phi:B->A->bool) (x:B). - r_big_sep_list R Phi (x :: []) == Phi x + r_equiv R (r_big_sep_list R Phi (x :: [])) (Phi x) `); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - R_BIG_SEP_LIST_CONS, - R_BIG_SEP_LIST_NIL, - R_SEP_EMP_R))); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_big_sep_list + (R:(A)ra) + (Phi:B->A->bool) + ((x:B) :: [])`, + `(Phi:B->A->bool) (x:B)`), + R_EQUIV_OF_EQ_BIG_SEP), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `Phi:B->A->bool`, `x:B`), + R_BIG_SEP_LIST_SINGLETON_EQ))); return gnode_prove(root); } @@ -372,65 +360,40 @@ PROOF static thm prove_r_big_sep_list_append(void) { (Phi:B->A->bool) (left:(B)list) (right:(B)list). - r_big_sep_list R Phi (APPEND left right) == - r_sep + r_equiv R - (r_big_sep_list R Phi left) - (r_big_sep_list R Phi right) - `); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - r_big_sep_list_def, - get_theorem_by_name("MAP_APPEND"), - R_BIG_SEP_APPEND))); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LIST_APPEND = - prove_r_big_sep_list_append(); - -PROOF static thm prove_r_big_sep_list_reverse(void) { - gnode root = gnode_new_with_ccl(` - forall (R:(A)ra) (Phi:B->A->bool) (xs:(B)list). - r_big_sep_list R Phi (REVERSE xs) == - r_big_sep_list R Phi xs - `); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - r_big_sep_list_def, - gsym_rule(get_theorem_by_name("MAP_REVERSE")), - R_BIG_SEP_REVERSE))); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LIST_REVERSE = - prove_r_big_sep_list_reverse(); - -PROOF static thm prove_r_big_sep_list_swap_head(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:B->A->bool) - (x:B) - (y:B) - (xs:(B)list). - r_big_sep_list R Phi (x :: y :: xs) == - r_big_sep_list R Phi (y :: x :: xs) + (r_big_sep_list R Phi (APPEND left right)) + (r_sep R + (r_big_sep_list R Phi left) + (r_big_sep_list R Phi right)) `); gnode body = AUTO_INTROS_TAC(root); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(R_BIG_SEP_LIST_CONS))); ACCEPT_TAC( body, - ac_rule(R_SEP_AC, goal_ccl(body->g))); + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_big_sep_list + (R:(A)ra) + (Phi:B->A->bool) + (APPEND (left:(B)list) (right:(B)list))`, + `r_sep (R:(A)ra) + (r_big_sep_list R Phi (left:(B)list)) + (r_big_sep_list R Phi (right:(B)list))`), + R_EQUIV_OF_EQ_BIG_SEP), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Phi:B->A->bool`, + `left:(B)list`, + `right:(B)list`), + R_BIG_SEP_LIST_APPEND_EQ))); return gnode_prove(root); } -PROOF thm R_BIG_SEP_LIST_SWAP_HEAD = - prove_r_big_sep_list_swap_head(); +PROOF thm R_BIG_SEP_LIST_APPEND = + prove_r_big_sep_list_append(); PROOF static thm prove_r_big_sep_list_mono(void) { gnode root = gnode_new_with_ccl(` @@ -440,6 +403,7 @@ PROOF static thm prove_r_big_sep_list_mono(void) { (Psi:B->A->bool) (xs:(B)list). (forall x:B. + MEM x xs ==> r_entails R (Phi x) (Psi x)) ==> r_entails R @@ -455,7 +419,7 @@ PROOF static thm prove_r_big_sep_list_mono(void) { gnode base = DISCH_TAC(cases[0], "Hpointwise"); base = CONV_TAC( base, - pure_rewrite_conv(THM_LIST(R_BIG_SEP_LIST_NIL))); + pure_rewrite_conv(THM_LIST(R_BIG_SEP_LIST_NIL_EQ))); ACCEPT_TAC( base, ispecl_rule( @@ -465,35 +429,56 @@ PROOF static thm prove_r_big_sep_list_mono(void) { gnode step = DISCH_TAC(cases[1], "Hpointwise"); step = CONV_TAC( step, - pure_rewrite_conv(THM_LIST(R_BIG_SEP_LIST_CONS))); - thm head_entails = spec_rule( - `a0:B`, - assume_rule(` - forall x:B. - r_entails - (R:(A)ra) - ((Phi:B->A->bool) x) - ((Psi:B->A->bool) x) - `)); + pure_rewrite_conv(THM_LIST(R_BIG_SEP_LIST_CONS_EQ))); + thm pointwise = assume_rule(` + forall x:B. + MEM x ((a0:B) :: (a1:(B)list)) ==> + r_entails + (R:(A)ra) + ((Phi:B->A->bool) x) + ((Psi:B->A->bool) x) + `); + thm mem_head_equiv = apply_conversion( + pure_rewrite_conv(THM_LIST(get_theorem_by_name("MEM"))), + `MEM (a0:B) ((a0:B) :: (a1:(B)list))`); + thm mem_head = eq_mp_rule( + gsym_rule(mem_head_equiv), + disj1_rule( + refl_rule(`a0:B`), + `MEM (a0:B) (a1:(B)list)`)); + thm head_entails = mp_rule( + spec_rule(`a0:B`, pointwise), + mem_head); + + term x = `x:B`; + term mem_tail_tm = `MEM (x:B) (a1:(B)list)`; + thm mem_tail = assume_rule(mem_tail_tm); + thm mem_tail_equiv = apply_conversion( + pure_rewrite_conv(THM_LIST(get_theorem_by_name("MEM"))), + `MEM (x:B) ((a0:B) :: (a1:(B)list))`); + thm mem_whole = eq_mp_rule( + gsym_rule(mem_tail_equiv), + disj2_rule(`(x:B) == (a0:B)`, mem_tail)); + thm entails_at_x = mp_rule( + spec_rule(x, pointwise), + mem_whole); + thm tail_pointwise = gen_rule( + x, + disch_rule(mem_tail_tm, entails_at_x)); thm tail_entails = mp_rule( assume_rule(` (forall x:B. + MEM x (a1:(B)list) ==> r_entails (R:(A)ra) ((Phi:B->A->bool) x) ((Psi:B->A->bool) x)) ==> r_entails R - (r_big_sep_list R Phi (a1:(B)list)) + (r_big_sep_list R Phi a1) (r_big_sep_list R Psi a1) `), - assume_rule(` - forall x:B. - r_entails - (R:(A)ra) - ((Phi:B->A->bool) x) - ((Psi:B->A->bool) x) - `)); + tail_pointwise); thm result = mp_rule( mp_rule( ispecl_rule( @@ -519,193 +504,7 @@ PROOF static thm prove_r_big_sep_list_mono(void) { PROOF thm R_BIG_SEP_LIST_MONO = prove_r_big_sep_list_mono(); -PROOF static thm prove_r_big_sep_list_mono_on(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:B->A->bool) - (Psi:B->A->bool) - (xs:(B)list). - (forall x:B. - MEM x xs ==> - r_entails R (Phi x) (Psi x)) ==> - r_entails - R - (r_big_sep_list R Phi xs) - (r_big_sep_list R Psi xs) - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = GEN_TAC(body, "Psi"); - body = GEN_TAC(body, "xs"); - gnode_list cases = INDUCT_TAC(body, `xs:(B)list`); - - gnode base = DISCH_TAC(cases[0], "Hpointwise"); - base = CONV_TAC( - base, - pure_rewrite_conv(THM_LIST(R_BIG_SEP_LIST_NIL))); - ACCEPT_TAC( - base, - ispecl_rule( - TERM_LIST(`R:(A)ra`, `r_emp (R:(A)ra)`), - R_ENTAILS_REFL)); - - gnode step = DISCH_TAC(cases[1], "Hpointwise"); - step = CONV_TAC( - step, - pure_rewrite_conv(THM_LIST(R_BIG_SEP_LIST_CONS))); - thm pointwise = assume_rule(` - forall x:B. - MEM x ((a0:B) :: (a1:(B)list)) ==> - r_entails - (R:(A)ra) - ((Phi:B->A->bool) x) - ((Psi:B->A->bool) x) - `); - thm mem_head_equiv = apply_conversion( - pure_rewrite_conv(THM_LIST(get_theorem_by_name("MEM"))), - `MEM (a0:B) ((a0:B) :: (a1:(B)list))`); - thm mem_head_disjunction = disj1_rule( - refl_rule(`a0:B`), - `MEM (a0:B) (a1:(B)list)`); - thm mem_head = eq_mp_rule( - gsym_rule(mem_head_equiv), - mem_head_disjunction); - thm head_entails = mp_rule( - spec_rule(`a0:B`, pointwise), - mem_head); - - term x = `x:B`; - term mem_tail_tm = `MEM (x:B) (a1:(B)list)`; - thm mem_tail = assume_rule(mem_tail_tm); - thm mem_tail_equiv = apply_conversion( - pure_rewrite_conv(THM_LIST(get_theorem_by_name("MEM"))), - `MEM (x:B) ((a0:B) :: (a1:(B)list))`); - thm mem_whole = eq_mp_rule( - gsym_rule(mem_tail_equiv), - disj2_rule(`(x:B) == (a0:B)`, mem_tail)); - thm entails_at_x = mp_rule( - spec_rule(x, pointwise), - mem_whole); - thm tail_pointwise = gen_rule( - x, - disch_rule(mem_tail_tm, entails_at_x)); - thm tail_entails = mp_rule( - assume_rule(` - (forall x:B. - MEM x (a1:(B)list) ==> - r_entails - (R:(A)ra) - ((Phi:B->A->bool) x) - ((Psi:B->A->bool) x)) ==> - r_entails - R - (r_big_sep_list R Phi a1) - (r_big_sep_list R Psi a1) - `), - tail_pointwise); - thm result = mp_rule( - mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `(Phi:B->A->bool) (a0:B)`, - `(Psi:B->A->bool) (a0:B)`, - `r_big_sep_list - (R:(A)ra) - (Phi:B->A->bool) - (a1:(B)list)`, - `r_big_sep_list - (R:(A)ra) - (Psi:B->A->bool) - (a1:(B)list)`), - R_SEP_MONO), - head_entails), - tail_entails); - ACCEPT_TAC(step, result); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LIST_MONO_ON = - prove_r_big_sep_list_mono_on(); - -PROOF static thm prove_r_big_sep_list_equiv(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:B->A->bool) - (Psi:B->A->bool) - (xs:(B)list). - (forall x:B. - r_equiv R (Phi x) (Psi x)) ==> - r_equiv - R - (r_big_sep_list R Phi xs) - (r_big_sep_list R Psi xs) - `); - gnode body = AUTO_INTROS_TAC(root); - thm pointwise_equiv = assume_rule(` - forall x:B. - r_equiv - (R:(A)ra) - ((Phi:B->A->bool) x) - ((Psi:B->A->bool) x) - `); - - term x = `x:B`; - thm at_x = spec_rule(x, pointwise_equiv); - thm both_at_x = rewrite_rule( - THM_LIST(r_equiv_def), - at_x); - thm forward_pointwise = gen_rule( - x, - conjunct1_rule(both_at_x)); - thm reverse_pointwise = gen_rule( - x, - conjunct2_rule(both_at_x)); - - thm forward = mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `Phi:B->A->bool`, - `Psi:B->A->bool`, - `xs:(B)list`), - R_BIG_SEP_LIST_MONO), - forward_pointwise); - thm reverse = mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `Psi:B->A->bool`, - `Phi:B->A->bool`, - `xs:(B)list`), - R_BIG_SEP_LIST_MONO), - reverse_pointwise); - thm result = mp_rule( - mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `r_big_sep_list - (R:(A)ra) - (Phi:B->A->bool) - (xs:(B)list)`, - `r_big_sep_list - (R:(A)ra) - (Psi:B->A->bool) - (xs:(B)list)`), - R_EQUIV_INTRO), - forward), - reverse); - ACCEPT_TAC(body, result); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LIST_EQUIV = - prove_r_big_sep_list_equiv(); - -PROOF static thm prove_r_big_sep_list_equiv_on(void) { +PROOF static thm prove_r_big_sep_list_equiv(void) { gnode root = gnode_new_with_ccl(` forall (R:(A)ra) @@ -751,7 +550,7 @@ PROOF static thm prove_r_big_sep_list_equiv_on(void) { `Phi:B->A->bool`, `Psi:B->A->bool`, `xs:(B)list`), - R_BIG_SEP_LIST_MONO_ON), + R_BIG_SEP_LIST_MONO), forward_pointwise); thm reverse = mp_rule( ispecl_rule( @@ -760,30 +559,31 @@ PROOF static thm prove_r_big_sep_list_equiv_on(void) { `Psi:B->A->bool`, `Phi:B->A->bool`, `xs:(B)list`), - R_BIG_SEP_LIST_MONO_ON), + R_BIG_SEP_LIST_MONO), reverse_pointwise); - thm result = mp_rule( + ACCEPT_TAC( + body, mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `r_big_sep_list - (R:(A)ra) - (Phi:B->A->bool) - (xs:(B)list)`, - `r_big_sep_list - (R:(A)ra) - (Psi:B->A->bool) - (xs:(B)list)`), - R_EQUIV_INTRO), - forward), - reverse); - ACCEPT_TAC(body, result); + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_big_sep_list + (R:(A)ra) + (Phi:B->A->bool) + (xs:(B)list)`, + `r_big_sep_list + (R:(A)ra) + (Psi:B->A->bool) + (xs:(B)list)`), + R_EQUIV_INTRO), + forward), + reverse)); return gnode_prove(root); } -PROOF thm R_BIG_SEP_LIST_EQUIV_ON = - prove_r_big_sep_list_equiv_on(); +PROOF thm R_BIG_SEP_LIST_EQUIV = + prove_r_big_sep_list_equiv(); PROOF static thm prove_r_big_sep_list_map(void) { gnode root = gnode_new_with_ccl(` @@ -792,56 +592,37 @@ PROOF static thm prove_r_big_sep_list_map(void) { (Phi:B->A->bool) (f:C->B) (xs:(C)list). - r_big_sep_list R Phi (MAP f xs) == - r_big_sep_list R (\x:C. Phi (f x)) xs + r_equiv + R + (r_big_sep_list R Phi (MAP f xs)) + (r_big_sep_list R (\x:C. Phi (f x)) xs) `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = GEN_TAC(body, "f"); - body = GEN_TAC(body, "xs"); - gnode_list cases = INDUCT_TAC(body, `xs:(C)list`); - - CONV_TAC( - cases[0], - rewrite_conv(THM_LIST( - get_theorem_by_name("MAP"), - R_BIG_SEP_LIST_NIL))); - gnode step = CONV_WITH_ASMP_TAC( - cases[1], - rewrite_conv, - THM_LIST( - get_theorem_by_name("MAP"), - R_BIG_SEP_LIST_CONS)); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_big_sep_list R (Phi:B->A->bool) + (MAP (f:C->B) (xs:(C)list))`, + `r_big_sep_list R + (\x:C. (Phi:B->A->bool) ((f:C->B) x)) + (xs:(C)list)`), + R_EQUIV_OF_EQ_BIG_SEP), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `Phi:B->A->bool`, + `f:C->B`, + `xs:(C)list`), + R_BIG_SEP_LIST_MAP_EQ))); return gnode_prove(root); } PROOF thm R_BIG_SEP_LIST_MAP = prove_r_big_sep_list_map(); -PROOF static thm prove_r_big_sep_list_emp(void) { - gnode root = gnode_new_with_ccl(` - forall (R:(A)ra) (xs:(B)list). - r_big_sep_list R (\x:B. r_emp R) xs == r_emp R - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "xs"); - gnode_list cases = INDUCT_TAC(body, `xs:(B)list`); - - CONV_TAC( - cases[0], - rewrite_conv(THM_LIST(R_BIG_SEP_LIST_NIL))); - gnode step = CONV_WITH_ASMP_TAC( - cases[1], - rewrite_conv, - THM_LIST( - R_BIG_SEP_LIST_CONS, - R_SEP_EMP_L)); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LIST_EMP = - prove_r_big_sep_list_emp(); - PROOF static thm prove_r_big_sep_list_sep(void) { gnode root = gnode_new_with_ccl(` forall @@ -849,2098 +630,58 @@ PROOF static thm prove_r_big_sep_list_sep(void) { (Phi:B->A->bool) (Psi:B->A->bool) (xs:(B)list). - r_big_sep_list - R - (\x:B. r_sep R (Phi x) (Psi x)) - xs == - r_sep + r_equiv R - (r_big_sep_list R Phi xs) - (r_big_sep_list R Psi xs) + (r_big_sep_list + R + (\x:B. r_sep R (Phi x) (Psi x)) + xs) + (r_sep R + (r_big_sep_list R Phi xs) + (r_big_sep_list R Psi xs)) `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = GEN_TAC(body, "Psi"); - body = GEN_TAC(body, "xs"); - gnode_list cases = INDUCT_TAC(body, `xs:(B)list`); - - CONV_TAC( - cases[0], - rewrite_conv(THM_LIST( - R_BIG_SEP_LIST_NIL, - R_SEP_EMP_L))); - - gnode step = CONV_WITH_ASMP_TAC( - cases[1], - pure_rewrite_conv, - THM_LIST(R_BIG_SEP_LIST_CONS)); - step = CONV_TAC( - step, - depth_conv(get_conversion_by_name("BETA_CONV"))); + gnode body = AUTO_INTROS_TAC(root); ACCEPT_TAC( - step, - ac_rule(R_SEP_AC, goal_ccl(step->g))); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LIST_SEP = - prove_r_big_sep_list_sep(); - -/* ------------------------------------------------------------------------- */ -/* Finite-set binders */ -/* ------------------------------------------------------------------------- */ - -PROOF static thm prove_r_sep_neutral_for_big_sep(void) { - gnode root = gnode_new_with_ccl(` - forall R:(A)ra. - neutral (r_sep R) == r_emp R - `); - gnode body = GEN_TAC(root, "R"); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST( - get_theorem_by_name("neutral")))); - body = MATCH_MP_TAC( - body, - get_theorem_by_name("SELECT_UNIQUE")); - body = GEN_TAC(body, "P"); - gnode_list directions = EQ_TAC(body); - - gnode forward = DISCH_TAC(directions[0], "Hunit"); - thm unit_at_emp = spec_rule( - `r_emp (R:(A)ra)`, - beta_rule(assume_rule(gnode_get_asmps( - forward, - CONST_STRING_LIST("Hunit"))[0]))); - thm sep_p_emp_is_emp = conjunct1_rule(unit_at_emp); - thm sep_p_emp_is_p = ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `P:A->bool`), - R_SEP_EMP_R); - ACCEPT_TAC( - forward, - trans_rule( - gsym_rule(sep_p_emp_is_p), - sep_p_emp_is_emp)); - - gnode reverse = DISCH_TAC(directions[1], "Heq"); - reverse = CONV_TAC( - reverse, - depth_conv(get_conversion_by_name("BETA_CONV"))); - reverse = GEN_TAC(reverse, "Q"); - CONV_WITH_ASMP_TAC( - reverse, - rewrite_conv, - THM_LIST( - R_SEP_EMP_L, - R_SEP_EMP_R)); - return gnode_prove(root); -} - -PROOF static thm R_SEP_NEUTRAL_FOR_BIG_SEP = - prove_r_sep_neutral_for_big_sep(); - -PROOF static thm prove_r_sep_monoidal_for_big_sep(void) { - gnode root = gnode_new_with_ccl(` - forall R:(A)ra. - monoidal (r_sep R) - `); - gnode body = GEN_TAC(root, "R"); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST( - get_theorem_by_name("monoidal"), - R_SEP_NEUTRAL_FOR_BIG_SEP))); - gnode_list outer = CONJ_TAC(body); - ACCEPT_TAC( - outer[0], - ispec_rule(`R:(A)ra`, R_SEP_COMM)); - - gnode_list inner = CONJ_TAC(outer[1]); - term P = `P:A->bool`; - term Q = `Q:A->bool`; - term S = `S:A->bool`; - thm associate = gsym_rule(ispecl_rule( - TERM_LIST( - `R:(A)ra`, - P, - Q, - S), - R_SEP_ASSOC)); - associate = gen_rule(S, associate); - associate = gen_rule(Q, associate); - associate = gen_rule(P, associate); - ACCEPT_TAC(inner[0], associate); - ACCEPT_TAC( - inner[1], - ispec_rule(`R:(A)ra`, R_SEP_EMP_L)); - return gnode_prove(root); -} - -PROOF static thm R_SEP_MONOIDAL_FOR_BIG_SEP = - prove_r_sep_monoidal_for_big_sep(); - -PROOF static thm prove_r_big_sep_set_empty(void) { - gnode root = gnode_new_with_ccl(` - forall (R:(A)ra) (Phi:B->A->bool). - r_big_sep_set R Phi ({}:B->bool) == r_emp R - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(r_big_sep_set_def))); - thm clauses = mp_rule( - ispec_rule( - `r_sep (R:(A)ra)`, - freshen_iterate_index_type( - get_theorem_by_name("ITERATE_CLAUSES"))), - ispec_rule( - `R:(A)ra`, - R_SEP_MONOIDAL_FOR_BIG_SEP)); - thm empty = ispec_rule( - `Phi:B->A->bool`, - conjunct1_rule(clauses)); - ACCEPT_TAC( - body, - trans_rule( - empty, - ispec_rule( - `R:(A)ra`, - R_SEP_NEUTRAL_FOR_BIG_SEP))); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_SET_EMPTY = - prove_r_big_sep_set_empty(); - -PROOF static thm prove_r_big_sep_set_insert(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:B->A->bool) - (x:B) - (s:B->bool). - FINITE s ==> - ~(x IN s) ==> - r_big_sep_set R Phi (x INSERT s) == - r_sep R (Phi x) (r_big_sep_set R Phi s) - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = GEN_TAC(body, "x"); - body = GEN_TAC(body, "s"); - body = DISCH_TAC(body, "Hfinite"); - body = DISCH_TAC(body, "Hfresh"); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(r_big_sep_set_def))); - thm clauses = mp_rule( - ispec_rule( - `r_sep (R:(A)ra)`, - freshen_iterate_index_type( - get_theorem_by_name("ITERATE_CLAUSES"))), - ispec_rule( - `R:(A)ra`, - R_SEP_MONOIDAL_FOR_BIG_SEP)); - thm inserted = ispecl_rule( - TERM_LIST( - `Phi:B->A->bool`, - `x:B`, - `s:B->bool`), - conjunct2_rule(clauses)); - inserted = mp_rule( - inserted, - assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Hfinite"))[0])); - inserted = rewrite_rule( - THM_LIST(assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Hfresh"))[0])), - inserted); - ACCEPT_TAC(body, inserted); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_SET_INSERT = - prove_r_big_sep_set_insert(); - -PROOF static thm prove_r_big_sep_set_singleton(void) { - gnode root = gnode_new_with_ccl(` - forall (R:(A)ra) (Phi:B->A->bool) (x:B). - r_big_sep_set R Phi {x} == Phi x - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = GEN_TAC(body, "x"); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(r_big_sep_set_def))); - thm singleton = mp_rule( - ispec_rule( - `r_sep (R:(A)ra)`, - freshen_iterate_index_type( - get_theorem_by_name("ITERATE_SING"))), - ispec_rule( - `R:(A)ra`, - R_SEP_MONOIDAL_FOR_BIG_SEP)); - singleton = ispecl_rule( - TERM_LIST( - `Phi:B->A->bool`, - `x:B`), - singleton); - ACCEPT_TAC(body, singleton); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_SET_SINGLETON = - prove_r_big_sep_set_singleton(); - -PROOF static thm prove_r_big_sep_set_union(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:B->A->bool) - (left:B->bool) - (right:B->bool). - FINITE left /\ FINITE right /\ DISJOINT left right ==> - r_big_sep_set R Phi (left UNION right) == - r_sep - R - (r_big_sep_set R Phi left) - (r_big_sep_set R Phi right) - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = GEN_TAC(body, "left"); - body = GEN_TAC(body, "right"); - body = DISCH_TAC(body, "Hsets"); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(r_big_sep_set_def))); - thm union_fold = mp_rule( - ispec_rule( - `r_sep (R:(A)ra)`, - freshen_iterate_index_type( - get_theorem_by_name("ITERATE_UNION"))), - ispec_rule( - `R:(A)ra`, - R_SEP_MONOIDAL_FOR_BIG_SEP)); - union_fold = ispecl_rule( - TERM_LIST( - `Phi:B->A->bool`, - `left:B->bool`, - `right:B->bool`), - union_fold); - ACCEPT_TAC( - body, - mp_rule( - union_fold, - assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Hsets"))[0]))); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_SET_UNION = - prove_r_big_sep_set_union(); - -PROOF static thm prove_r_big_sep_set_eq(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:B->A->bool) - (Psi:B->A->bool) - (s:B->bool). - (forall x:B. x IN s ==> Phi x == Psi x) ==> - r_big_sep_set R Phi s == r_big_sep_set R Psi s - `); - gnode body = AUTO_INTROS_TAC(root); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(r_big_sep_set_def))); - thm iterate_eq = mp_rule( - ispec_rule( - `r_sep (R:(A)ra)`, - freshen_iterate_index_type( - get_theorem_by_name("ITERATE_EQ"))), - ispec_rule( - `R:(A)ra`, - R_SEP_MONOIDAL_FOR_BIG_SEP)); - iterate_eq = ispecl_rule( - TERM_LIST( - `Phi:B->A->bool`, - `Psi:B->A->bool`, - `s:B->bool`), - iterate_eq); - ACCEPT_TAC( - body, - mp_rule( - iterate_eq, - assume_rule(` - forall x:B. - x IN (s:B->bool) ==> - (Phi:B->A->bool) x == (Psi:B->A->bool) x - `))); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_SET_EQ = - prove_r_big_sep_set_eq(); - -PROOF static thm prove_r_entails_iterate_related(void) { - gnode root = gnode_new_with_ccl(` - forall R:(A)ra. - r_entails - R - (neutral (r_sep R)) - (neutral (r_sep R)) /\ - (forall - (P1:A->bool) - (Q1:A->bool) - (P2:A->bool) - (Q2:A->bool). - r_entails R P1 P2 /\ r_entails R Q1 Q2 ==> - r_entails - R - (r_sep R P1 Q1) - (r_sep R P2 Q2)) - `); - gnode body = GEN_TAC(root, "R"); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST( - R_SEP_NEUTRAL_FOR_BIG_SEP))); - gnode_list laws = CONJ_TAC(body); - ACCEPT_TAC( - laws[0], - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `r_emp (R:(A)ra)`), - R_ENTAILS_REFL)); - - gnode closure = GEN_TAC(laws[1], "P1"); - closure = GEN_TAC(closure, "Q1"); - closure = GEN_TAC(closure, "P2"); - closure = GEN_TAC(closure, "Q2"); - closure = DISCH_TAC(closure, "Hboth"); - closure = ASMP_CONJ_TAC( - closure, - "Hboth", - "Hleft", - "Hright"); - thm monotone = ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `P1:A->bool`, - `P2:A->bool`, - `Q1:A->bool`, - `Q2:A->bool`), - R_SEP_MONO); - monotone = mp_rule( - monotone, - assume_rule(gnode_get_asmps( - closure, - CONST_STRING_LIST("Hleft"))[0])); - monotone = mp_rule( - monotone, - assume_rule(gnode_get_asmps( - closure, - CONST_STRING_LIST("Hright"))[0])); - ACCEPT_TAC(closure, monotone); - return gnode_prove(root); -} - -PROOF static thm R_ENTAILS_ITERATE_RELATED = - prove_r_entails_iterate_related(); - -PROOF static thm prove_r_big_sep_set_mono(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:B->A->bool) - (Psi:B->A->bool) - (s:B->bool). - FINITE s ==> - (forall x:B. - x IN s ==> - r_entails R (Phi x) (Psi x)) ==> - r_entails - R - (r_big_sep_set R Phi s) - (r_big_sep_set R Psi s) - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = GEN_TAC(body, "Psi"); - body = GEN_TAC(body, "s"); - body = DISCH_TAC(body, "Hfinite"); - body = DISCH_TAC(body, "Hpointwise"); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(r_big_sep_set_def))); - - thm related = mp_rule( - ispec_rule( - `r_sep (R:(A)ra)`, - freshen_iterate_index_type( - get_theorem_by_name("ITERATE_RELATED"))), - ispec_rule( - `R:(A)ra`, - R_SEP_MONOIDAL_FOR_BIG_SEP)); - related = ispec_rule( - `r_entails (R:(A)ra)`, - related); - related = mp_rule( - related, - ispec_rule( - `R:(A)ra`, - R_ENTAILS_ITERATE_RELATED)); - related = ispecl_rule( - TERM_LIST( - `Phi:B->A->bool`, - `Psi:B->A->bool`, - `s:B->bool`), - related); - thm premises = conj_rule( - assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Hfinite"))[0]), - assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Hpointwise"))[0])); - ACCEPT_TAC(body, mp_rule(related, premises)); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_SET_MONO = - prove_r_big_sep_set_mono(); - -PROOF static thm prove_r_big_sep_set_equiv(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:B->A->bool) - (Psi:B->A->bool) - (s:B->bool). - FINITE s ==> - (forall x:B. - x IN s ==> - r_equiv R (Phi x) (Psi x)) ==> - r_equiv - R - (r_big_sep_set R Phi s) - (r_big_sep_set R Psi s) - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = GEN_TAC(body, "Psi"); - body = GEN_TAC(body, "s"); - body = DISCH_TAC(body, "Hfinite"); - body = DISCH_TAC(body, "Hpointwise"); - - thm pointwise_equiv = assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Hpointwise"))[0]); - term x = `x:B`; - term member_tm = `x IN (s:B->bool)`; - thm member = assume_rule(member_tm); - thm at_x = mp_rule( - spec_rule(x, pointwise_equiv), - member); - thm both_at_x = rewrite_rule( - THM_LIST(r_equiv_def), - at_x); - thm forward_pointwise = gen_rule( - x, - disch_rule( - member_tm, - conjunct1_rule(both_at_x))); - thm reverse_pointwise = gen_rule( - x, - disch_rule( - member_tm, - conjunct2_rule(both_at_x))); - thm finite = assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Hfinite"))[0]); - - thm forward = ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `Phi:B->A->bool`, - `Psi:B->A->bool`, - `s:B->bool`), - R_BIG_SEP_SET_MONO); - forward = mp_rule(mp_rule(forward, finite), forward_pointwise); - thm reverse = ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `Psi:B->A->bool`, - `Phi:B->A->bool`, - `s:B->bool`), - R_BIG_SEP_SET_MONO); - reverse = mp_rule(mp_rule(reverse, finite), reverse_pointwise); - thm result = ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `r_big_sep_set - (R:(A)ra) - (Phi:B->A->bool) - (s:B->bool)`, - `r_big_sep_set - (R:(A)ra) - (Psi:B->A->bool) - (s:B->bool)`), - R_EQUIV_INTRO); - result = mp_rule(mp_rule(result, forward), reverse); - ACCEPT_TAC(body, result); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_SET_EQUIV = - prove_r_big_sep_set_equiv(); - -PROOF static thm prove_r_big_sep_set_emp(void) { - gnode root = gnode_new_with_ccl(` - forall (R:(A)ra) (s:B->bool). - r_big_sep_set R (\x:B. r_emp R) s == r_emp R - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "s"); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(r_big_sep_set_def))); - thm neutral = ispec_rule( - `R:(A)ra`, - R_SEP_NEUTRAL_FOR_BIG_SEP); - term x = `x:B`; - term member = `x IN (s:B->bool)`; - thm all_neutral = gen_rule( - x, - disch_rule( - member, - gsym_rule(neutral))); - thm all_emp = mp_rule( - ispec_rule( - `r_sep (R:(A)ra)`, - freshen_iterate_index_type( - get_theorem_by_name("ITERATE_EQ_NEUTRAL"))), - ispec_rule( - `R:(A)ra`, - R_SEP_MONOIDAL_FOR_BIG_SEP)); - all_emp = ispecl_rule( - TERM_LIST( - `\x:B. r_emp (R:(A)ra)`, - `s:B->bool`), - all_emp); - all_emp = beta_rule(all_emp); - ACCEPT_TAC( - body, - trans_rule( - mp_rule(all_emp, all_neutral), - neutral)); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_SET_EMP = - prove_r_big_sep_set_emp(); - -PROOF static thm prove_r_big_sep_set_sep(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:B->A->bool) - (Psi:B->A->bool) - (s:B->bool). - FINITE s ==> - r_big_sep_set - R - (\x:B. r_sep R (Phi x) (Psi x)) - s == - r_sep - R - (r_big_sep_set R Phi s) - (r_big_sep_set R Psi s) - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = GEN_TAC(body, "Psi"); - body = GEN_TAC(body, "s"); - body = DISCH_TAC(body, "Hfinite"); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(r_big_sep_set_def))); - thm distribute = mp_rule( - ispec_rule( - `r_sep (R:(A)ra)`, - freshen_iterate_index_type( - get_theorem_by_name("ITERATE_OP"))), - ispec_rule( - `R:(A)ra`, - R_SEP_MONOIDAL_FOR_BIG_SEP)); - distribute = ispecl_rule( - TERM_LIST( - `Phi:B->A->bool`, - `Psi:B->A->bool`, - `s:B->bool`), - distribute); - ACCEPT_TAC( - body, - mp_rule( - distribute, - assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Hfinite"))[0]))); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_SET_SEP = - prove_r_big_sep_set_sep(); - -/* ------------------------------------------------------------------------- */ -/* Finite-map binders */ -/* ------------------------------------------------------------------------- */ - -PROOF static thm prove_r_big_sep_map_value(void) { - gnode root = gnode_new_with_ccl(` - forall - (m:(K,V)finmap) - (key:K) - (value:V). - finmap_lookup m key == SOME value ==> - r_big_sep_map_value m key == value - `); - gnode body = GEN_TAC(root, "m"); - body = GEN_TAC(body, "key"); - body = GEN_TAC(body, "value"); - body = DISCH_TAC(body, "Hlookup"); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST( - r_big_sep_map_value_def))); - - term predicate = ` - \candidate:V. - finmap_lookup (m:(K,V)finmap) (key:K) == SOME candidate - `; - thm selected = ispecl_rule( - TERM_LIST( - predicate, - `value:V`), - get_theorem_by_name("SELECT_AX")); - selected = beta_rule(selected); - selected = mp_rule( - selected, - assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Hlookup"))[0])); - thm selected_some = trans_rule( - gsym_rule(selected), - assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Hlookup"))[0])); - thm selected_value = rewrite_rule( - THM_LIST(get_theorem_by_name("option_INJ")), - selected_some); - ACCEPT_TAC(body, selected_value); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_MAP_VALUE = - prove_r_big_sep_map_value(); - -PROOF static thm prove_r_big_sep_map_value_lookup(void) { - gnode root = gnode_new_with_ccl(` - forall (m:(K,V)finmap) (key:K). - key IN finmap_dom m ==> - finmap_lookup m key == - SOME (r_big_sep_map_value m key) - `); - gnode body = GEN_TAC(root, "m"); - body = GEN_TAC(body, "key"); - body = DISCH_TAC(body, "Hdom"); - thm payload_exists = eq_mp_rule( - ispecl_rule( - TERM_LIST( - `key:K`, - `m:(K,V)finmap`), - FINMAP_IN_DOM_SOME), - assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Hdom"))[0])); - body = ASSUME_TAC(body, payload_exists, "Hpayload"); - body = ASMP_EXISTS_TAC(body, "Hpayload", "value"); - - thm lookup = assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Hpayload"))[0]); - thm picked = mp_rule( - ispecl_rule( - TERM_LIST( - `m:(K,V)finmap`, - `key:K`, - `value:V`), - R_BIG_SEP_MAP_VALUE), - lookup); - thm picked_some = ap_term_rule( - `SOME:V->V option`, - picked); - ACCEPT_TAC( - body, - trans_rule( - lookup, - gsym_rule(picked_some))); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_MAP_VALUE_LOOKUP = - prove_r_big_sep_map_value_lookup(); - -PROOF static thm prove_r_big_sep_map_empty(void) { - gnode root = gnode_new_with_ccl(` - forall (R:(A)ra) (Phi:K->V->A->bool). - r_big_sep_map - R - Phi - (finmap_empty:(K,V)finmap) == - r_emp R - `); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - r_big_sep_map_def, - FINMAP_DOM_EMPTY, - R_BIG_SEP_SET_EMPTY))); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_MAP_EMPTY = - prove_r_big_sep_map_empty(); - -PROOF static thm prove_not_equal_of_member_not_member(void) { - gnode root = gnode_new_with_ccl(` - forall (s:K->bool) (absent:K) (present:K). - ~(absent IN s) ==> - present IN s ==> - ~(present == absent) - `); - gnode body = GEN_TAC(root, "s"); - body = GEN_TAC(body, "absent"); - body = GEN_TAC(body, "present"); - body = DISCH_TAC(body, "Habsent"); - body = DISCH_TAC(body, "Hpresent"); - body = DISCH_TAC(body, "Heq"); - thm member_eq = ap_term_rule( - `\key:K. key IN (s:K->bool)`, - assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Heq"))[0])); - member_eq = beta_rule(member_eq); - thm absent_member = eq_mp_rule( - member_eq, - assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Hpresent"))[0])); - thm contradiction = not_elim_rule( - assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Habsent"))[0]), - absent_member); - CONTR_TAC(body, contradiction); - return gnode_prove(root); -} - -PROOF static thm NOT_EQUAL_OF_MEMBER_NOT_MEMBER = - prove_not_equal_of_member_not_member(); - -PROOF static thm prove_r_big_sep_map_insert(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:K->V->A->bool) - (key:K) - (value:V) - (m:(K,V)finmap). - finmap_lookup m key == NONE ==> - r_big_sep_map R Phi (finmap_insert key value m) == - r_sep - R - (Phi key value) - (r_big_sep_map R Phi m) - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = GEN_TAC(body, "key"); - body = GEN_TAC(body, "value"); - body = GEN_TAC(body, "m"); - body = DISCH_TAC(body, "Hfresh_lookup"); - - thm fresh_lookup = assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Hfresh_lookup"))[0]); - thm fresh_key = eq_mp_rule( - gsym_rule(ispecl_rule( - TERM_LIST( - `key:K`, - `m:(K,V)finmap`), - FINMAP_NOT_IN_DOM)), - fresh_lookup); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST( - r_big_sep_map_def, - FINMAP_DOM_INSERT))); - - term inserted_family = ` - \current:K. - (Phi:K->V->A->bool) - current - (r_big_sep_map_value - (finmap_insert - (key:K) - (value:V) - (m:(K,V)finmap)) - current) - `; - term old_family = ` - \current:K. - (Phi:K->V->A->bool) - current - (r_big_sep_map_value (m:(K,V)finmap) current) - `; - thm insert_fold = ispecl_rule( - TERM_LIST( - `R:(A)ra`, - inserted_family, - `key:K`, - `finmap_dom (m:(K,V)finmap)`), - R_BIG_SEP_SET_INSERT); - insert_fold = mp_rule( - insert_fold, - ispec_rule( - `m:(K,V)finmap`, - FINMAP_DOM_FINITE)); - insert_fold = mp_rule(insert_fold, fresh_key); - insert_fold = beta_rule(insert_fold); - - thm inserted_at_key = ispecl_rule( - TERM_LIST( - `key:K`, - `value:V`, - `m:(K,V)finmap`), - FINMAP_INSERT_LOOKUP_EQ); - thm head_value = mp_rule( - ispecl_rule( - TERM_LIST( - `finmap_insert - (key:K) - (value:V) - (m:(K,V)finmap)`, - `key:K`, - `value:V`), - R_BIG_SEP_MAP_VALUE), - inserted_at_key); - - term current = `current:K`; - term current_member_tm = ` - current IN finmap_dom (m:(K,V)finmap) - `; - thm current_member = assume_rule(current_member_tm); - thm current_ne_key = mp_rule( - mp_rule( - ispecl_rule( - TERM_LIST( - `finmap_dom (m:(K,V)finmap)`, - `key:K`, - current), - NOT_EQUAL_OF_MEMBER_NOT_MEMBER), - fresh_key), - current_member); - thm same_lookup = mp_rule( - ispecl_rule( - TERM_LIST( - `key:K`, - `value:V`, - `m:(K,V)finmap`, - current), - FINMAP_INSERT_LOOKUP_NE), - current_ne_key); - thm old_selected_lookup = mp_rule( - ispecl_rule( - TERM_LIST( - `m:(K,V)finmap`, - current), - R_BIG_SEP_MAP_VALUE_LOOKUP), - current_member); - thm inserted_selected_lookup = trans_rule( - same_lookup, - old_selected_lookup); - thm same_value = mp_rule( - ispecl_rule( - TERM_LIST( - `finmap_insert - (key:K) - (value:V) - (m:(K,V)finmap)`, - current, - `r_big_sep_map_value - (m:(K,V)finmap) - (current:K)`), - R_BIG_SEP_MAP_VALUE), - inserted_selected_lookup); - thm same_assertion = ap_term_rule( - `\selected:V. - (Phi:K->V->A->bool) (current:K) selected`, - same_value); - same_assertion = beta_rule(same_assertion); - thm tail_pointwise = gen_rule( - current, - disch_rule( - current_member_tm, - same_assertion)); - thm tail_lift = ispecl_rule( - TERM_LIST( - `R:(A)ra`, - inserted_family, - old_family, - `finmap_dom (m:(K,V)finmap)`), - R_BIG_SEP_SET_EQ); - tail_lift = beta_rule(tail_lift); - thm tail_fold = mp_rule( - tail_lift, - tail_pointwise); - tail_fold = beta_rule(tail_fold); - - thm result = rewrite_rule( - THM_LIST( - head_value, - tail_fold), - insert_fold); - ACCEPT_TAC(body, result); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_MAP_INSERT = - prove_r_big_sep_map_insert(); - -PROOF static thm prove_r_big_sep_map_singleton(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:K->V->A->bool) - (key:K) - (value:V). - r_big_sep_map R Phi (finmap_singleton key value) == - Phi key value - `); - gnode body = AUTO_INTROS_TAC(root); - thm singleton = mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `Phi:K->V->A->bool`, - `key:K`, - `value:V`, - `finmap_empty:(K,V)finmap`), - R_BIG_SEP_MAP_INSERT), - ispec_rule( - `key:K`, - FINMAP_EMPTY_LOOKUP)); - singleton = rewrite_rule( - THM_LIST( - FINMAP_INSERT_EMPTY, - R_BIG_SEP_MAP_EMPTY, - R_SEP_EMP_R), - singleton); - ACCEPT_TAC(body, singleton); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_MAP_SINGLETON = - prove_r_big_sep_map_singleton(); - -PROOF static thm prove_r_big_sep_map_delete(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:K->V->A->bool) - (m:(K,V)finmap) - (key:K) - (value:V). - finmap_lookup m key == SOME value ==> - r_big_sep_map R Phi m == - r_sep - R - (Phi key value) - (r_big_sep_map R Phi (finmap_delete key m)) - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = GEN_TAC(body, "m"); - body = GEN_TAC(body, "key"); - body = GEN_TAC(body, "value"); - body = DISCH_TAC(body, "Hlookup"); - thm lookup = assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Hlookup"))[0]); - thm extracted = mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `Phi:K->V->A->bool`, - `key:K`, - `value:V`, - `finmap_delete (key:K) (m:(K,V)finmap)`), - R_BIG_SEP_MAP_INSERT), - ispecl_rule( - TERM_LIST( - `key:K`, - `m:(K,V)finmap`), - FINMAP_DELETE_LOOKUP_EQ)); - thm decomposed = mp_rule( - ispecl_rule( - TERM_LIST( - `key:K`, - `value:V`, - `m:(K,V)finmap`), - FINMAP_DECOMPOSE), - lookup); - thm same_fold = ap_term_rule( - `\map:(K,V)finmap. - r_big_sep_map - (R:(A)ra) - (Phi:K->V->A->bool) - map`, - decomposed); - same_fold = beta_rule(same_fold); - ACCEPT_TAC( - body, - trans_rule( - gsym_rule(same_fold), - extracted)); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_MAP_DELETE = - prove_r_big_sep_map_delete(); - -PROOF static thm prove_r_big_sep_map_eq(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:K->V->A->bool) - (Psi:K->V->A->bool) - (m:(K,V)finmap). - (forall (key:K) (value:V). - finmap_lookup m key == SOME value ==> - Phi key value == Psi key value) ==> - r_big_sep_map R Phi m == r_big_sep_map R Psi m - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = GEN_TAC(body, "Psi"); - body = GEN_TAC(body, "m"); - body = DISCH_TAC(body, "Hpointwise"); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(r_big_sep_map_def))); - - thm pointwise = assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Hpointwise"))[0]); - term key = `key:K`; - term member_tm = `key IN finmap_dom (m:(K,V)finmap)`; - thm member = assume_rule(member_tm); - thm selected_lookup = mp_rule( - ispecl_rule( - TERM_LIST( - `m:(K,V)finmap`, - key), - R_BIG_SEP_MAP_VALUE_LOOKUP), - member); - thm at_key = spec_rule(key, pointwise); - at_key = spec_rule( - `r_big_sep_map_value (m:(K,V)finmap) (key:K)`, - at_key); - at_key = mp_rule(at_key, selected_lookup); - thm on_domain = gen_rule( - key, - disch_rule(member_tm, at_key)); - - term phi_family = ` - \key:K. - (Phi:K->V->A->bool) - key - (r_big_sep_map_value (m:(K,V)finmap) key) - `; - term psi_family = ` - \key:K. - (Psi:K->V->A->bool) - key - (r_big_sep_map_value (m:(K,V)finmap) key) - `; - thm lift = ispecl_rule( - TERM_LIST( - `R:(A)ra`, - phi_family, - psi_family, - `finmap_dom (m:(K,V)finmap)`), - R_BIG_SEP_SET_EQ); - lift = beta_rule(lift); - ACCEPT_TAC(body, mp_rule(lift, on_domain)); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_MAP_EQ = - prove_r_big_sep_map_eq(); - -PROOF static thm prove_r_big_sep_map_mono(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:K->V->A->bool) - (Psi:K->V->A->bool) - (m:(K,V)finmap). - (forall (key:K) (value:V). - finmap_lookup m key == SOME value ==> - r_entails R (Phi key value) (Psi key value)) ==> - r_entails - R - (r_big_sep_map R Phi m) - (r_big_sep_map R Psi m) - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = GEN_TAC(body, "Psi"); - body = GEN_TAC(body, "m"); - body = DISCH_TAC(body, "Hpointwise"); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(r_big_sep_map_def))); - - thm pointwise = assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Hpointwise"))[0]); - term key = `key:K`; - term member_tm = `key IN finmap_dom (m:(K,V)finmap)`; - thm member = assume_rule(member_tm); - thm selected_lookup = mp_rule( - ispecl_rule( - TERM_LIST( - `m:(K,V)finmap`, - key), - R_BIG_SEP_MAP_VALUE_LOOKUP), - member); - thm at_key = spec_rule(key, pointwise); - at_key = spec_rule( - `r_big_sep_map_value (m:(K,V)finmap) (key:K)`, - at_key); - at_key = mp_rule(at_key, selected_lookup); - thm on_domain = gen_rule( - key, - disch_rule(member_tm, at_key)); - - term phi_family = ` - \key:K. - (Phi:K->V->A->bool) - key - (r_big_sep_map_value (m:(K,V)finmap) key) - `; - term psi_family = ` - \key:K. - (Psi:K->V->A->bool) - key - (r_big_sep_map_value (m:(K,V)finmap) key) - `; - thm lift = ispecl_rule( - TERM_LIST( - `R:(A)ra`, - phi_family, - psi_family, - `finmap_dom (m:(K,V)finmap)`), - R_BIG_SEP_SET_MONO); - lift = beta_rule(lift); - lift = mp_rule( - lift, - ispec_rule( - `m:(K,V)finmap`, - FINMAP_DOM_FINITE)); - ACCEPT_TAC(body, mp_rule(lift, on_domain)); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_MAP_MONO = - prove_r_big_sep_map_mono(); - -PROOF static thm prove_r_big_sep_map_equiv(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:K->V->A->bool) - (Psi:K->V->A->bool) - (m:(K,V)finmap). - (forall (key:K) (value:V). - finmap_lookup m key == SOME value ==> - r_equiv R (Phi key value) (Psi key value)) ==> - r_equiv - R - (r_big_sep_map R Phi m) - (r_big_sep_map R Psi m) - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = GEN_TAC(body, "Psi"); - body = GEN_TAC(body, "m"); - body = DISCH_TAC(body, "Hpointwise"); - - thm pointwise_equiv = assume_rule(gnode_get_asmps( - body, - CONST_STRING_LIST("Hpointwise"))[0]); - term key = `key:K`; - term value = `value:V`; - term lookup_tm = ` - finmap_lookup (m:(K,V)finmap) (key:K) == SOME (value:V) - `; - thm lookup = assume_rule(lookup_tm); - thm at_binding = spec_rule(key, pointwise_equiv); - at_binding = spec_rule(value, at_binding); - at_binding = mp_rule(at_binding, lookup); - thm both_at_binding = rewrite_rule( - THM_LIST(r_equiv_def), - at_binding); - thm forward_binding = gen_rule( - key, - gen_rule( - value, - disch_rule( - lookup_tm, - conjunct1_rule(both_at_binding)))); - thm reverse_binding = gen_rule( - key, - gen_rule( - value, - disch_rule( - lookup_tm, - conjunct2_rule(both_at_binding)))); - - thm forward = mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `Phi:K->V->A->bool`, - `Psi:K->V->A->bool`, - `m:(K,V)finmap`), - R_BIG_SEP_MAP_MONO), - forward_binding); - thm reverse = mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `Psi:K->V->A->bool`, - `Phi:K->V->A->bool`, - `m:(K,V)finmap`), - R_BIG_SEP_MAP_MONO), - reverse_binding); - thm result = ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `r_big_sep_map - (R:(A)ra) - (Phi:K->V->A->bool) - (m:(K,V)finmap)`, - `r_big_sep_map - (R:(A)ra) - (Psi:K->V->A->bool) - (m:(K,V)finmap)`), - R_EQUIV_INTRO); - result = mp_rule(mp_rule(result, forward), reverse); - ACCEPT_TAC(body, result); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_MAP_EQUIV = - prove_r_big_sep_map_equiv(); - -PROOF static thm prove_r_big_sep_map_emp(void) { - gnode root = gnode_new_with_ccl(` - forall (R:(A)ra) (m:(K,V)finmap). - r_big_sep_map R (\key:K. \value:V. r_emp R) m == - r_emp R - `); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - r_big_sep_map_def, - R_BIG_SEP_SET_EMP))); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_MAP_EMP = - prove_r_big_sep_map_emp(); - -PROOF static thm prove_r_big_sep_map_sep(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:K->V->A->bool) - (Psi:K->V->A->bool) - (m:(K,V)finmap). - r_big_sep_map - R - (\key:K. \value:V. - r_sep R (Phi key value) (Psi key value)) - m == - r_sep - R - (r_big_sep_map R Phi m) - (r_big_sep_map R Psi m) - `); - gnode body = AUTO_INTROS_TAC(root); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(r_big_sep_map_def))); - body = CONV_TAC( - body, - depth_conv(get_conversion_by_name("BETA_CONV"))); - term phi_family = ` - \key:K. - (Phi:K->V->A->bool) - key - (r_big_sep_map_value (m:(K,V)finmap) key) - `; - term psi_family = ` - \key:K. - (Psi:K->V->A->bool) - key - (r_big_sep_map_value (m:(K,V)finmap) key) - `; - thm distribute = ispecl_rule( - TERM_LIST( - `R:(A)ra`, - phi_family, - psi_family, - `finmap_dom (m:(K,V)finmap)`), - R_BIG_SEP_SET_SEP); - distribute = beta_rule(distribute); - distribute = mp_rule( - distribute, - ispec_rule( - `m:(K,V)finmap`, - FINMAP_DOM_FINITE)); - ACCEPT_TAC(body, distribute); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_MAP_SEP = - prove_r_big_sep_map_sep(); - -PROOF static thm prove_r_big_sep_listi_nil(void) { - gnode root = gnode_new_with_ccl(` - forall (R:(A)ra) (Phi:num->B->A->bool). - r_big_sep_listi R Phi ([]:(B)list) == r_emp R - `); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - r_big_sep_listi_def, - conjunct1_rule(r_big_sep_listi_from_def)))); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LISTI_NIL = - prove_r_big_sep_listi_nil(); - -PROOF static thm prove_r_big_sep_listi_cons(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:num->B->A->bool) - (x:B) - (xs:(B)list). - r_big_sep_listi R Phi (x :: xs) == - r_sep - R - (Phi 0 x) - (r_big_sep_listi_from R Phi 1 xs) - `); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - r_big_sep_listi_def, - r_big_sep_listi_from_def, - get_theorem_by_name("ONE")))); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LISTI_CONS = - prove_r_big_sep_listi_cons(); - -PROOF static thm prove_r_big_sep_listi_from_append(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:num->B->A->bool) - (left:(B)list) - (offset:num) - (right:(B)list). - r_big_sep_listi_from R Phi offset (APPEND left right) == - r_sep - R - (r_big_sep_listi_from R Phi offset left) - (r_big_sep_listi_from - R - Phi - (offset + LENGTH left) - right) - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = GEN_TAC(body, "left"); - gnode_list cases = INDUCT_TAC(body, `left:(B)list`); - - gnode base = AUTO_INTROS_TAC(cases[0]); - CONV_TAC( - base, - rewrite_conv(THM_LIST( - HOL_APPEND, - HOL_LENGTH, - r_big_sep_listi_from_def, - get_theorem_by_name("ADD_CLAUSES"), - R_SEP_EMP_L))); - - gnode step = AUTO_INTROS_TAC(cases[1]); - CONV_WITH_ASMP_TAC( - step, - rewrite_conv, - THM_LIST( - HOL_APPEND, - HOL_LENGTH, - r_big_sep_listi_from_def, - get_theorem_by_name("ADD_CLAUSES"), - R_SEP_ASSOC)); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LISTI_FROM_APPEND = - prove_r_big_sep_listi_from_append(); - -PROOF static thm prove_r_big_sep_listi_append(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:num->B->A->bool) - (left:(B)list) - (right:(B)list). - r_big_sep_listi R Phi (APPEND left right) == - r_sep - R - (r_big_sep_listi R Phi left) - (r_big_sep_listi_from R Phi (LENGTH left) right) - `); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - r_big_sep_listi_def, - R_BIG_SEP_LISTI_FROM_APPEND, - get_theorem_by_name("ADD_CLAUSES")))); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LISTI_APPEND = - prove_r_big_sep_listi_append(); - -PROOF static thm prove_r_big_sep_listi_singleton(void) { - gnode root = gnode_new_with_ccl(` - forall (R:(A)ra) (Phi:num->B->A->bool) (x:B). - r_big_sep_listi R Phi (x :: []) == Phi 0 x - `); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - R_BIG_SEP_LISTI_CONS, - r_big_sep_listi_from_def, - R_SEP_EMP_R))); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LISTI_SINGLETON = - prove_r_big_sep_listi_singleton(); - -/* A private two-offset form makes the public shift law an immediate - * specialization at the second offset `0`. */ -PROOF static thm prove_r_big_sep_listi_from_compose(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:num->B->A->bool) - (xs:(B)list) - (base:num) - (offset:num). - r_big_sep_listi_from R Phi (base + offset) xs == - r_big_sep_listi_from - R - (\index:num. \x:B. Phi (base + index) x) - offset - xs - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = GEN_TAC(body, "xs"); - gnode_list cases = INDUCT_TAC(body, `xs:(B)list`); - - gnode base_case = AUTO_INTROS_TAC(cases[0]); - base_case = CONV_TAC( - base_case, - pure_rewrite_conv(THM_LIST(r_big_sep_listi_from_def))); - RULE_TAC(base_case, prove_reflexive_equality_goal); - - gnode step = AUTO_INTROS_TAC(cases[1]); - step = CONV_TAC( - step, - pure_rewrite_conv(THM_LIST(r_big_sep_listi_from_def))); - step = CONV_TAC( - step, - depth_conv(get_conversion_by_name("BETA_CONV"))); - - thm add_suc = ispecl_rule( - TERM_LIST(`base:num`, `offset:num`), - conjunct2_rule(conjunct2_rule(conjunct2_rule( - get_theorem_by_name("ADD_CLAUSES"))))); - thm align_offset = beta_rule(ap_term_rule( - `\index:num. - r_big_sep_listi_from - (R:(A)ra) - (Phi:num->B->A->bool) - index - (a1:(B)list)`, - gsym_rule(add_suc))); - thm induction_at_successor = spec_rule( - `SUC (offset:num)`, - spec_rule( - `base:num`, - assume_rule(` - forall base offset. - r_big_sep_listi_from - (R:(A)ra) - (Phi:num->B->A->bool) - (base + offset) - (a1:(B)list) == - r_big_sep_listi_from - R - (\index:num. \x:B. Phi (base + index) x) - offset - a1 - `))); - thm tail_equality = trans_rule( - align_offset, - induction_at_successor); - thm result = beta_rule(ap_term_rule( - `\tail:A->bool. - r_sep - (R:(A)ra) - ((Phi:num->B->A->bool) - ((base:num) + (offset:num)) - (a0:B)) - tail`, - tail_equality)); - ACCEPT_TAC(step, result); - return gnode_prove(root); -} - -PROOF static thm R_BIG_SEP_LISTI_FROM_COMPOSE = - prove_r_big_sep_listi_from_compose(); - -PROOF static thm prove_r_big_sep_listi_from_shift(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:num->B->A->bool) - (offset:num) - (xs:(B)list). - r_big_sep_listi_from R Phi offset xs == - r_big_sep_listi - R - (\index:num. \x:B. Phi (offset + index) x) - xs - `); - gnode body = AUTO_INTROS_TAC(root); - body = CONV_TAC( body, - pure_rewrite_conv(THM_LIST(r_big_sep_listi_def))); - thm result = ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `Phi:num->B->A->bool`, - `xs:(B)list`, - `offset:num`, - `0`), - R_BIG_SEP_LISTI_FROM_COMPOSE); - result = rewrite_rule( - THM_LIST(get_theorem_by_name("ADD_CLAUSES")), - result); - ACCEPT_TAC(body, result); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LISTI_FROM_SHIFT = - prove_r_big_sep_listi_from_shift(); - -PROOF static thm prove_r_big_sep_listi_cons_shift(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:num->B->A->bool) - (x:B) - (xs:(B)list). - r_big_sep_listi R Phi (x :: xs) == - r_sep - R - (Phi 0 x) - (r_big_sep_listi - R - (\index:num. \y:B. Phi (SUC index) y) - xs) - `); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - R_BIG_SEP_LISTI_CONS, - R_BIG_SEP_LISTI_FROM_SHIFT, - get_theorem_by_name("ONE"), - get_theorem_by_name("ADD_CLAUSES")))); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LISTI_CONS_SHIFT = - prove_r_big_sep_listi_cons_shift(); - -PROOF static thm prove_r_big_sep_listi_append_shift(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:num->B->A->bool) - (left:(B)list) - (right:(B)list). - r_big_sep_listi R Phi (APPEND left right) == - r_sep - R - (r_big_sep_listi R Phi left) - (r_big_sep_listi - R - (\index:num. \x:B. - Phi (LENGTH left + index) x) - right) - `); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - R_BIG_SEP_LISTI_APPEND, - R_BIG_SEP_LISTI_FROM_SHIFT))); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LISTI_APPEND_SHIFT = - prove_r_big_sep_listi_append_shift(); - -PROOF static thm prove_r_big_sep_listi_from_mono(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:num->B->A->bool) - (Psi:num->B->A->bool) - (xs:(B)list) - (offset:num). - (forall index:num. forall x:B. - r_entails R (Phi index x) (Psi index x)) ==> - r_entails - R - (r_big_sep_listi_from R Phi offset xs) - (r_big_sep_listi_from R Psi offset xs) - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = GEN_TAC(body, "Psi"); - body = GEN_TAC(body, "xs"); - gnode_list cases = INDUCT_TAC(body, `xs:(B)list`); - - gnode base_case = GEN_TAC(cases[0], "offset"); - base_case = DISCH_TAC(base_case, "Hpointwise"); - base_case = CONV_TAC( - base_case, - pure_rewrite_conv(THM_LIST(r_big_sep_listi_from_def))); - ACCEPT_TAC( - base_case, - ispecl_rule( - TERM_LIST(`R:(A)ra`, `r_emp (R:(A)ra)`), - R_ENTAILS_REFL)); - - gnode step = GEN_TAC(cases[1], "offset"); - step = DISCH_TAC(step, "Hpointwise"); - step = CONV_TAC( - step, - pure_rewrite_conv(THM_LIST(r_big_sep_listi_from_def))); - thm pointwise = assume_rule(` - forall index:num. forall x:B. - r_entails - (R:(A)ra) - ((Phi:num->B->A->bool) index x) - ((Psi:num->B->A->bool) index x) - `); - thm head_entails = spec_rule( - `a0:B`, - spec_rule(`offset:num`, pointwise)); - thm tail_entails = mp_rule( - spec_rule( - `SUC (offset:num)`, - assume_rule(` - forall offset:num. - (forall index:num. forall x:B. - r_entails - (R:(A)ra) - ((Phi:num->B->A->bool) index x) - ((Psi:num->B->A->bool) index x)) ==> - r_entails - R - (r_big_sep_listi_from R Phi offset (a1:(B)list)) - (r_big_sep_listi_from R Psi offset a1) - `)), - pointwise); - thm result = mp_rule( mp_rule( ispecl_rule( TERM_LIST( `R:(A)ra`, - `(Phi:num->B->A->bool) (offset:num) (a0:B)`, - `(Psi:num->B->A->bool) (offset:num) (a0:B)`, - `r_big_sep_listi_from - (R:(A)ra) - (Phi:num->B->A->bool) - (SUC (offset:num)) - (a1:(B)list)`, - `r_big_sep_listi_from - (R:(A)ra) - (Psi:num->B->A->bool) - (SUC (offset:num)) - (a1:(B)list)`), - R_SEP_MONO), - head_entails), - tail_entails); - ACCEPT_TAC(step, result); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LISTI_FROM_MONO = - prove_r_big_sep_listi_from_mono(); - -PROOF static thm prove_r_big_sep_listi_mono(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:num->B->A->bool) - (Psi:num->B->A->bool) - (xs:(B)list). - (forall index:num. forall x:B. - r_entails R (Phi index x) (Psi index x)) ==> - r_entails - R - (r_big_sep_listi R Phi xs) - (r_big_sep_listi R Psi xs) - `); - gnode body = AUTO_INTROS_TAC(root); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(r_big_sep_listi_def))); - thm result = mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `Phi:num->B->A->bool`, - `Psi:num->B->A->bool`, - `xs:(B)list`, - `0`), - R_BIG_SEP_LISTI_FROM_MONO), - assume_rule(` - forall index:num. forall x:B. - r_entails - (R:(A)ra) - ((Phi:num->B->A->bool) index x) - ((Psi:num->B->A->bool) index x) - `)); - ACCEPT_TAC(body, result); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LISTI_MONO = - prove_r_big_sep_listi_mono(); - -PROOF static thm prove_r_big_sep_listi_from_equiv(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:num->B->A->bool) - (Psi:num->B->A->bool) - (xs:(B)list) - (offset:num). - (forall index:num. forall x:B. - r_equiv R (Phi index x) (Psi index x)) ==> - r_equiv - R - (r_big_sep_listi_from R Phi offset xs) - (r_big_sep_listi_from R Psi offset xs) - `); - gnode body = AUTO_INTROS_TAC(root); - thm pointwise_equiv = assume_rule(` - forall index:num. forall x:B. - r_equiv - (R:(A)ra) - ((Phi:num->B->A->bool) index x) - ((Psi:num->B->A->bool) index x) - `); - term index = `index:num`; - term x = `x:B`; - thm at_x = spec_rule( - x, - spec_rule(index, pointwise_equiv)); - thm both_at_x = rewrite_rule( - THM_LIST(r_equiv_def), - at_x); - thm forward_pointwise = gen_rule( - index, - gen_rule(x, conjunct1_rule(both_at_x))); - thm reverse_pointwise = gen_rule( - index, - gen_rule(x, conjunct2_rule(both_at_x))); - thm forward = mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `Phi:num->B->A->bool`, - `Psi:num->B->A->bool`, - `xs:(B)list`, - `offset:num`), - R_BIG_SEP_LISTI_FROM_MONO), - forward_pointwise); - thm reverse = mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `Psi:num->B->A->bool`, - `Phi:num->B->A->bool`, - `xs:(B)list`, - `offset:num`), - R_BIG_SEP_LISTI_FROM_MONO), - reverse_pointwise); - thm result = mp_rule( - mp_rule( + `r_big_sep_list + R + (\x:B. + r_sep R + ((Phi:B->A->bool) x) + ((Psi:B->A->bool) x)) + (xs:(B)list)`, + `r_sep (R:(A)ra) + (r_big_sep_list R Phi (xs:(B)list)) + (r_big_sep_list R Psi (xs:(B)list))`), + R_EQUIV_OF_EQ_BIG_SEP), ispecl_rule( TERM_LIST( `R:(A)ra`, - `r_big_sep_listi_from - (R:(A)ra) - (Phi:num->B->A->bool) - (offset:num) - (xs:(B)list)`, - `r_big_sep_listi_from - (R:(A)ra) - (Psi:num->B->A->bool) - (offset:num) - (xs:(B)list)`), - R_EQUIV_INTRO), - forward), - reverse); - ACCEPT_TAC(body, result); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LISTI_FROM_EQUIV = - prove_r_big_sep_listi_from_equiv(); - -PROOF static thm prove_r_big_sep_listi_equiv(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:num->B->A->bool) - (Psi:num->B->A->bool) - (xs:(B)list). - (forall index:num. forall x:B. - r_equiv R (Phi index x) (Psi index x)) ==> - r_equiv - R - (r_big_sep_listi R Phi xs) - (r_big_sep_listi R Psi xs) - `); - gnode body = AUTO_INTROS_TAC(root); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST(r_big_sep_listi_def))); - thm result = mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `Phi:num->B->A->bool`, - `Psi:num->B->A->bool`, - `xs:(B)list`, - `0`), - R_BIG_SEP_LISTI_FROM_EQUIV), - assume_rule(` - forall index:num. forall x:B. - r_equiv - (R:(A)ra) - ((Phi:num->B->A->bool) index x) - ((Psi:num->B->A->bool) index x) - `)); - ACCEPT_TAC(body, result); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LISTI_EQUIV = - prove_r_big_sep_listi_equiv(); - -PROOF static thm prove_r_big_sep_listi_from_sep(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:num->B->A->bool) - (Psi:num->B->A->bool) - (xs:(B)list) - (offset:num). - r_big_sep_listi_from - R - (\index:num. \x:B. - r_sep R (Phi index x) (Psi index x)) - offset - xs == - r_sep - R - (r_big_sep_listi_from R Phi offset xs) - (r_big_sep_listi_from R Psi offset xs) - `); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "Phi"); - body = GEN_TAC(body, "Psi"); - body = GEN_TAC(body, "xs"); - gnode_list cases = INDUCT_TAC(body, `xs:(B)list`); - - gnode base_case = GEN_TAC(cases[0], "offset"); - CONV_TAC( - base_case, - rewrite_conv(THM_LIST( - r_big_sep_listi_from_def, - R_SEP_EMP_L))); - - gnode step = GEN_TAC(cases[1], "offset"); - step = CONV_WITH_ASMP_TAC( - step, - pure_rewrite_conv, - THM_LIST(r_big_sep_listi_from_def)); - step = CONV_TAC( - step, - depth_conv(get_conversion_by_name("BETA_CONV"))); - ACCEPT_TAC( - step, - ac_rule(R_SEP_AC, goal_ccl(step->g))); - return gnode_prove(root); -} - -PROOF thm R_BIG_SEP_LISTI_FROM_SEP = - prove_r_big_sep_listi_from_sep(); - -PROOF static thm prove_r_big_sep_listi_sep(void) { - gnode root = gnode_new_with_ccl(` - forall - (R:(A)ra) - (Phi:num->B->A->bool) - (Psi:num->B->A->bool) - (xs:(B)list). - r_big_sep_listi - R - (\index:num. \x:B. - r_sep R (Phi index x) (Psi index x)) - xs == - r_sep - R - (r_big_sep_listi R Phi xs) - (r_big_sep_listi R Psi xs) - `); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - r_big_sep_listi_def, - R_BIG_SEP_LISTI_FROM_SEP))); + `Phi:B->A->bool`, + `Psi:B->A->bool`, + `xs:(B)list`), + R_BIG_SEP_LIST_SEP_EQ))); return gnode_prove(root); } -PROOF thm R_BIG_SEP_LISTI_SEP = - prove_r_big_sep_listi_sep(); +PROOF thm R_BIG_SEP_LIST_SEP = + prove_r_big_sep_list_sep(); PROOF static int audit_big_sep(void) { thm_list public_theorems = THM_LIST( - r_big_sep_listi_from_def, - r_big_sep_listi_def, r_big_sep_list_def, - r_big_sep_set_def, - r_big_sep_map_value_def, - r_big_sep_map_def, - r_big_sep_def, - R_BIG_SEP_NIL, - R_BIG_SEP_CONS, - R_BIG_SEP_SINGLETON, - R_BIG_SEP_APPEND, - R_BIG_SEP_SNOC, - R_BIG_SEP_REVERSE, - R_BIG_SEP_SWAP_HEAD, R_BIG_SEP_LIST_NIL, R_BIG_SEP_LIST_CONS, R_BIG_SEP_LIST_SINGLETON, R_BIG_SEP_LIST_APPEND, - R_BIG_SEP_LIST_REVERSE, - R_BIG_SEP_LIST_SWAP_HEAD, R_BIG_SEP_LIST_MONO, - R_BIG_SEP_LIST_MONO_ON, R_BIG_SEP_LIST_EQUIV, - R_BIG_SEP_LIST_EQUIV_ON, R_BIG_SEP_LIST_MAP, - R_BIG_SEP_LIST_EMP, - R_BIG_SEP_LIST_SEP, - R_BIG_SEP_SET_EMPTY, - R_BIG_SEP_SET_INSERT, - R_BIG_SEP_SET_SINGLETON, - R_BIG_SEP_SET_UNION, - R_BIG_SEP_SET_EQ, - R_BIG_SEP_SET_MONO, - R_BIG_SEP_SET_EQUIV, - R_BIG_SEP_SET_EMP, - R_BIG_SEP_SET_SEP, - R_BIG_SEP_MAP_VALUE, - R_BIG_SEP_MAP_VALUE_LOOKUP, - R_BIG_SEP_MAP_EMPTY, - R_BIG_SEP_MAP_INSERT, - R_BIG_SEP_MAP_SINGLETON, - R_BIG_SEP_MAP_DELETE, - R_BIG_SEP_MAP_EQ, - R_BIG_SEP_MAP_MONO, - R_BIG_SEP_MAP_EQUIV, - R_BIG_SEP_MAP_EMP, - R_BIG_SEP_MAP_SEP, - R_BIG_SEP_LISTI_NIL, - R_BIG_SEP_LISTI_CONS, - R_BIG_SEP_LISTI_FROM_APPEND, - R_BIG_SEP_LISTI_APPEND, - R_BIG_SEP_LISTI_SINGLETON, - R_BIG_SEP_LISTI_FROM_SHIFT, - R_BIG_SEP_LISTI_CONS_SHIFT, - R_BIG_SEP_LISTI_APPEND_SHIFT, - R_BIG_SEP_LISTI_FROM_MONO, - R_BIG_SEP_LISTI_MONO, - R_BIG_SEP_LISTI_FROM_EQUIV, - R_BIG_SEP_LISTI_EQUIV, - R_BIG_SEP_LISTI_FROM_SEP, - R_BIG_SEP_LISTI_SEP); - + R_BIG_SEP_LIST_SEP); for (size_t i = 0; i < vector_size(public_theorems); ++i) { ENSURE_COND( !IS_NULL(public_theorems[i]), diff --git a/theory/logic/big_sep.h b/theory/logic/big_sep.h index 5a2bf1b..f12828b 100644 --- a/theory/logic/big_sep.h +++ b/theory/logic/big_sep.h @@ -1,372 +1,27 @@ #pragma once -/* - * Iterated separating conjunction for resource propositions. - * - * There are five public views of the construction: - * - * r_big_sep R Ps - * folds a list of assertions `Ps:(A->bool)list` with `r_sep R`, using - * `r_emp R` for the empty list; - * - * r_big_sep_list R Phi xs - * folds the assertions `Phi x` for `x` in `xs`; - * - * r_big_sep_listi R Phi xs - * is the Iris-style indexed variant and folds `Phi i x`, where `i` - * is the zero-based position of `x` in `xs`. - * - * r_big_sep_set R Phi s - * folds `Phi x` over a finite set `s`. This view uses HOL's generic - * commutative-monoid iteration, so it is independent of any enumeration - * of the set. - * - * r_big_sep_map R Phi m - * folds `Phi key value` over the bindings of a finite map `m`. - * - * The unindexed fold is kept primitive so that its `NIL` and `CONS` equations - * are definitional. `r_big_sep_listi_from` is the offset form used to state - * composition laws - * without hiding index arithmetic. Thus - * - * r_big_sep_listi R Phi xs = r_big_sep_listi_from R Phi 0 xs. - * - * As in `resource_prop.h`, all equalities below are extensional equality of - * assertions. They are consequently stronger than `r_equiv`. - */ +/* Core iterated separating conjunction. The stable API is intentionally + * list-only; set/map/indexed variants are not part of this module's public + * surface. */ -#include "proof/theory/logic/finmap.h" +#include "proof/theory/data/list.h" #include "proof/theory/logic/resource_prop.h" -/* ------------------------------------------------------------------------- */ -/* Definitions */ -/* ------------------------------------------------------------------------- */ - -/* - * r_big_sep_listi_from R Phi offset [] = r_emp R - * - * r_big_sep_listi_from R Phi offset (x :: xs) = - * r_sep R - * (Phi offset x) - * (r_big_sep_listi_from R Phi (SUC offset) xs) - */ -PROOF extern thm r_big_sep_listi_from_def; - -/* `r_big_sep_listi R Phi xs = r_big_sep_listi_from R Phi 0 xs`. */ -PROOF extern thm r_big_sep_listi_def; - -/* - * r_big_sep R [] = r_emp R - * - * r_big_sep R (P :: Ps) = r_sep R P (r_big_sep R Ps) - */ -PROOF extern thm r_big_sep_def; - -/* `r_big_sep_list R Phi xs = r_big_sep R (MAP Phi xs)`. */ +/* Direct right fold: + * r_big_sep_list R Phi [] = r_emp R + * r_big_sep_list R Phi (x::xs) = + * r_sep R (Phi x) (r_big_sep_list R Phi xs). */ PROOF extern thm r_big_sep_list_def; -/* `r_big_sep_set R Phi s = iterate (r_sep R) s Phi`. */ -PROOF extern thm r_big_sep_set_def; - -/* - * A total value selector used only at keys in `finmap_dom m`. - * Outside the domain its result is deliberately unspecified. - */ -PROOF extern thm r_big_sep_map_value_def; - -/* - * `r_big_sep_map R Phi m` is the finite-set fold of - * `Phi key (r_big_sep_map_value m key)` over `finmap_dom m`. - */ -PROOF extern thm r_big_sep_map_def; - -/* ------------------------------------------------------------------------- */ -/* Literal lists of assertions */ -/* ------------------------------------------------------------------------- */ - -/* `r_big_sep R [] == r_emp R`. */ -PROOF extern thm R_BIG_SEP_NIL; - -/* `r_big_sep R (P :: Ps) == r_sep R P (r_big_sep R Ps)`. */ -PROOF extern thm R_BIG_SEP_CONS; - -/* `r_big_sep R [P] == P`. */ -PROOF extern thm R_BIG_SEP_SINGLETON; - -/* - * `r_big_sep R (left ++ right) == - * r_sep R (r_big_sep R left) (r_big_sep R right)`. - */ -PROOF extern thm R_BIG_SEP_APPEND; - -/* `r_big_sep R (Ps ++ [P]) == r_sep R (r_big_sep R Ps) P`. */ -PROOF extern thm R_BIG_SEP_SNOC; - -/* `r_big_sep R (REVERSE Ps) == r_big_sep R Ps`. */ -PROOF extern thm R_BIG_SEP_REVERSE; - -/* - * Adjacent assertions may be swapped: - * `r_big_sep R (P :: Q :: Ps) == r_big_sep R (Q :: P :: Ps)`. - * Together with congruence under a common prefix, this is the generator for - * permutation invariance of the unindexed fold. - */ -PROOF extern thm R_BIG_SEP_SWAP_HEAD; - -/* ------------------------------------------------------------------------- */ -/* Unindexed list binders */ -/* ------------------------------------------------------------------------- */ - -/* `r_big_sep_list R Phi [] == r_emp R`. */ +/* All assertion-algebra equations are exposed as `r_equiv`. */ PROOF extern thm R_BIG_SEP_LIST_NIL; - -/* - * `r_big_sep_list R Phi (x :: xs) == - * r_sep R (Phi x) (r_big_sep_list R Phi xs)`. - */ PROOF extern thm R_BIG_SEP_LIST_CONS; - -/* `r_big_sep_list R Phi [x] == Phi x`. */ PROOF extern thm R_BIG_SEP_LIST_SINGLETON; - -/* - * `r_big_sep_list R Phi (left ++ right) == - * r_sep R - * (r_big_sep_list R Phi left) - * (r_big_sep_list R Phi right)`. - */ PROOF extern thm R_BIG_SEP_LIST_APPEND; -/* - * `r_big_sep_list R Phi (REVERSE xs) == - * r_big_sep_list R Phi xs`. - */ -PROOF extern thm R_BIG_SEP_LIST_REVERSE; - -/* - * `r_big_sep_list R Phi (x :: y :: xs) == - * r_big_sep_list R Phi (y :: x :: xs)`. - */ -PROOF extern thm R_BIG_SEP_LIST_SWAP_HEAD; - -/* ------------------------------------------------------------------------- */ -/* Logical laws for unindexed list binders */ -/* ------------------------------------------------------------------------- */ - -/* - * Pointwise entailment lifts through big separation: - * - * (forall x. Phi x |-R Psi x) ==> - * r_big_sep_list R Phi xs |-R r_big_sep_list R Psi xs. - */ +/* Member-restricted logical lifting. */ PROOF extern thm R_BIG_SEP_LIST_MONO; - -/* - * Member-restricted monotonicity. Unlike the global rule above, no proof is - * required for values that do not occur in `xs`: - * - * (forall x. MEM x xs ==> Phi x |-R Psi x) ==> - * bigsep[x in xs] Phi x |-R bigsep[x in xs] Psi x. - */ -PROOF extern thm R_BIG_SEP_LIST_MONO_ON; - -/* - * Pointwise resource-proposition equivalence lifts through big separation: - * - * (forall x. Phi x =R= Psi x) ==> - * r_big_sep_list R Phi xs =R= r_big_sep_list R Psi xs. - */ PROOF extern thm R_BIG_SEP_LIST_EQUIV; -/* Member-restricted pointwise equivalence lifts through big separation. */ -PROOF extern thm R_BIG_SEP_LIST_EQUIV_ON; - -/* - * Mapping the data list is the same as composing the assertion family: - * - * bigsep[y in MAP f xs] Phi y == bigsep[x in xs] Phi (f x). - */ PROOF extern thm R_BIG_SEP_LIST_MAP; - -/* `bigsep[x in xs] emp == emp`. */ -PROOF extern thm R_BIG_SEP_LIST_EMP; - -/* - * Iteration distributes over pointwise separating conjunction: - * - * bigsep[x in xs] (Phi x * Psi x) == - * (bigsep[x in xs] Phi x) * (bigsep[x in xs] Psi x). - */ PROOF extern thm R_BIG_SEP_LIST_SEP; - -/* ------------------------------------------------------------------------- */ -/* Finite-set binders */ -/* ------------------------------------------------------------------------- */ - -/* `r_big_sep_set R Phi {} == r_emp R`. */ -PROOF extern thm R_BIG_SEP_SET_EMPTY; - -/* - * Fresh insertion: - * - * FINITE s ==> ~(x IN s) ==> - * bigsep[x in x INSERT s] Phi x == - * Phi x * bigsep[y in s] Phi y. - */ -PROOF extern thm R_BIG_SEP_SET_INSERT; - -/* `r_big_sep_set R Phi {x} == Phi x`. */ -PROOF extern thm R_BIG_SEP_SET_SINGLETON; - -/* - * A disjoint union factors into separating conjunction: - * - * FINITE left /\ FINITE right /\ DISJOINT left right ==> - * bigsep[x in left UNION right] Phi x == - * bigsep[x in left] Phi x * bigsep[x in right] Phi x. - */ -PROOF extern thm R_BIG_SEP_SET_UNION; - -/* Pointwise equality on the set gives equality of the two folds. */ -PROOF extern thm R_BIG_SEP_SET_EQ; - -/* - * Member-restricted pointwise entailment lifts through a finite-set fold. - */ -PROOF extern thm R_BIG_SEP_SET_MONO; - -/* - * Member-restricted pointwise resource-proposition equivalence lifts through - * a finite-set fold. - */ -PROOF extern thm R_BIG_SEP_SET_EQUIV; - -/* `bigsep[x in s] emp == emp`, including for infinite `s`. */ -PROOF extern thm R_BIG_SEP_SET_EMP; - -/* - * On a finite set, iteration distributes over pointwise separating - * conjunction. - */ -PROOF extern thm R_BIG_SEP_SET_SEP; - -/* ------------------------------------------------------------------------- */ -/* Finite-map binders */ -/* ------------------------------------------------------------------------- */ - -/* A successful lookup determines the selected value. */ -PROOF extern thm R_BIG_SEP_MAP_VALUE; - -/* Every key in the domain looks up to its selected value. */ -PROOF extern thm R_BIG_SEP_MAP_VALUE_LOOKUP; - -/* `r_big_sep_map R Phi finmap_empty == r_emp R`. */ -PROOF extern thm R_BIG_SEP_MAP_EMPTY; - -/* - * Fresh insertion: - * - * finmap_lookup m key == NONE ==> - * bigsep[map] (finmap_insert key value m) Phi == - * Phi key value * bigsep[map] m Phi. - */ -PROOF extern thm R_BIG_SEP_MAP_INSERT; - -/* `r_big_sep_map R Phi (finmap_singleton key value) == Phi key value`. */ -PROOF extern thm R_BIG_SEP_MAP_SINGLETON; - -/* - * Extract a present binding and fold the remaining map: - * - * finmap_lookup m key == SOME value ==> - * bigsep[map] m Phi == - * Phi key value * bigsep[map] (finmap_delete key m) Phi. - */ -PROOF extern thm R_BIG_SEP_MAP_DELETE; - -/* Pointwise equality on present bindings gives equality of map folds. */ -PROOF extern thm R_BIG_SEP_MAP_EQ; - -/* Pointwise entailment on present bindings lifts through a map fold. */ -PROOF extern thm R_BIG_SEP_MAP_MONO; - -/* Pointwise equivalence on present bindings lifts through a map fold. */ -PROOF extern thm R_BIG_SEP_MAP_EQUIV; - -/* `bigsep[key |-> value in m] emp == emp`. */ -PROOF extern thm R_BIG_SEP_MAP_EMP; - -/* Map iteration distributes over pointwise separating conjunction. */ -PROOF extern thm R_BIG_SEP_MAP_SEP; - -/* ------------------------------------------------------------------------- */ -/* Indexed list binders */ -/* ------------------------------------------------------------------------- */ - -/* `r_big_sep_listi R Phi [] == r_emp R`. */ -PROOF extern thm R_BIG_SEP_LISTI_NIL; - -/* - * `r_big_sep_listi R Phi (x :: xs) == - * r_sep R - * (Phi 0 x) - * (r_big_sep_listi_from R Phi 1 xs)`. - */ -PROOF extern thm R_BIG_SEP_LISTI_CONS; - -/* - * Offset-aware append law: - * - * r_big_sep_listi_from R Phi offset (left ++ right) == - * r_sep R - * (r_big_sep_listi_from R Phi offset left) - * (r_big_sep_listi_from R Phi (offset + LENGTH left) right). - */ -PROOF extern thm R_BIG_SEP_LISTI_FROM_APPEND; - -/* - * Zero-based append law. The right segment starts at `LENGTH left`: - * - * r_big_sep_listi R Phi (left ++ right) == - * r_sep R - * (r_big_sep_listi R Phi left) - * (r_big_sep_listi_from R Phi (LENGTH left) right). - */ -PROOF extern thm R_BIG_SEP_LISTI_APPEND; - -/* `r_big_sep_listi R Phi [x] == Phi 0 x`. */ -PROOF extern thm R_BIG_SEP_LISTI_SINGLETON; - -/* - * Starting at an offset is the same as shifting the index predicate: - * - * r_big_sep_listi_from R Phi offset xs == - * r_big_sep_listi R (\index x. Phi (offset + index) x) xs. - */ -PROOF extern thm R_BIG_SEP_LISTI_FROM_SHIFT; - -/* Iris-style `CONS` equation with the tail predicate shifted by one. */ -PROOF extern thm R_BIG_SEP_LISTI_CONS_SHIFT; - -/* Iris-style append equation with the right predicate shifted by length. */ -PROOF extern thm R_BIG_SEP_LISTI_APPEND_SHIFT; - -/* - * Pointwise entailment at every index lifts through an offset big separation. - */ -PROOF extern thm R_BIG_SEP_LISTI_FROM_MONO; - -/* Pointwise indexed entailment lifts through zero-based big separation. */ -PROOF extern thm R_BIG_SEP_LISTI_MONO; - -/* Pointwise indexed equivalence lifts through an offset big separation. */ -PROOF extern thm R_BIG_SEP_LISTI_FROM_EQUIV; - -/* Pointwise indexed equivalence lifts through zero-based big separation. */ -PROOF extern thm R_BIG_SEP_LISTI_EQUIV; - -/* Offset-indexed iteration distributes over pointwise `r_sep`. */ -PROOF extern thm R_BIG_SEP_LISTI_FROM_SEP; - -/* Zero-based indexed iteration distributes over pointwise `r_sep`. */ -PROOF extern thm R_BIG_SEP_LISTI_SEP; diff --git a/theory/logic/excl_ra.c b/theory/logic/excl_ra.c index 89483e0..77c70ac 100644 --- a/theory/logic/excl_ra.c +++ b/theory/logic/excl_ra.c @@ -480,7 +480,11 @@ PROOF static thm prove_excl_ra_exclusive(void) { root, once_rewrite_conv(THM_LIST(ra_exclusive_def))); body = GEN_TAC(body, "a"); - body = GEN_TAC(body, "frame"); + gnode_list exclusive = CONJ_TAC(body); + ACCEPT_TAC( + exclusive[0], + ispec_rule(`a:A`, EXCL_RA_VALID_OWNED)); + body = GEN_TAC(exclusive[1], "frame"); gnode_list frame_cases = CASES_TAC( body, `frame:(A)excl`, @@ -770,20 +774,6 @@ PROOF static thm prove_excl_ra_included_invalid_iff(void) { PROOF thm EXCL_RA_INCLUDED_INVALID_IFF = prove_excl_ra_included_invalid_iff(); -/* Invalid sources have no compatible frame, hence are exclusive vacuously. */ -PROOF static thm prove_excl_ra_exclusive_invalid(void) { - return mp_rule( - ispecl_rule( - TERM_LIST( - `excl_ra:((A)excl)ra`, - `ExclInvalid:(A)excl`), - RA_INVALID_EXCLUSIVE), - EXCL_RA_INVALID); -} - -PROOF thm EXCL_RA_EXCLUSIVE_INVALID = - prove_excl_ra_exclusive_invalid(); - /* Exclusive composition is cancellative on valid sources. Explicit cases * keep the proof local: an owned common frame admits only ExclUnit on the * source side, while an invalid common frame admits no valid source at all. */ @@ -978,22 +968,6 @@ PROOF static thm prove_excl_ra_update_owned_iff(void) { PROOF thm EXCL_RA_UPDATE_OWNED_IFF = prove_excl_ra_update_owned_iff(); -/* Every update from the invalid source is vacuous. */ -PROOF static thm prove_excl_ra_update_invalid(void) { - term x = `x:(A)excl`; - thm result = ispecl_rule( - TERM_LIST( - `excl_ra:((A)excl)ra`, - `ExclInvalid:(A)excl`, - x), - RA_UPDATE_INVALID); - result = mp_rule(result, EXCL_RA_INVALID); - return gen_rule(x, result); -} - -PROOF thm EXCL_RA_UPDATE_INVALID = - prove_excl_ra_update_invalid(); - /* The generic exclusive local update gives full owned replacement directly. */ PROOF static thm prove_excl_ra_local_update_valid(void) { term goal_tm = ` @@ -1001,8 +975,10 @@ PROOF static thm prove_excl_ra_local_update_valid(void) { ra_valid (excl_ra:((A)excl)ra) x ==> ra_local_update excl_ra - (Excl a,Excl a) - (x,x) + (Excl a) + (Excl a) + x + x `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); @@ -1032,8 +1008,10 @@ PROOF static thm prove_excl_ra_local_update_iff(void) { forall (a:A) (x:(A)excl). ra_local_update (excl_ra:((A)excl)ra) - (Excl a,Excl a) - (x,x) <=> + (Excl a) + (Excl a) + x + x <=> ra_valid excl_ra x `; gnode root = gnode_new_with_ccl(goal_tm); @@ -1044,22 +1022,21 @@ PROOF static thm prove_excl_ra_local_update_iff(void) { thm applied = ispecl_rule( TERM_LIST( `excl_ra:((A)excl)ra`, - `((Excl (a:A):(A)excl),(Excl (a:A):(A)excl))`, - `((x:(A)excl),(x:(A)excl))`, + `Excl (a:A):(A)excl`, + `Excl (a:A):(A)excl`, + `x:(A)excl`, + `x:(A)excl`, `ExclUnit:(A)excl`), RA_LOCAL_UPDATE_APPLY); - applied = pure_rewrite_rule( - THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")), - applied); applied = mp_rule( applied, assume_rule(` ra_local_update (excl_ra:((A)excl)ra) - ((Excl (a:A):(A)excl),(Excl (a:A):(A)excl)) - ((x:(A)excl),(x:(A)excl)) + (Excl (a:A)) + (Excl (a:A)) + (x:(A)excl) + x `)); applied = mp_rule( applied, @@ -1118,12 +1095,10 @@ PROOF static int audit_excl_ra(void) { EXCL_RA_INCLUDED_OWNED, EXCL_RA_INCLUDED_OWNED_IFF, EXCL_RA_INCLUDED_INVALID_IFF, - EXCL_RA_EXCLUSIVE_INVALID, EXCL_RA_CANCELLATIVE, EXCL_RA_UPDATE, EXCL_RA_UPDATE_VALID, EXCL_RA_UPDATE_OWNED_IFF, - EXCL_RA_UPDATE_INVALID, EXCL_RA_LOCAL_UPDATE_VALID, EXCL_RA_LOCAL_UPDATE_IFF); diff --git a/theory/logic/excl_ra.h b/theory/logic/excl_ra.h index 32e61ab..745b942 100644 --- a/theory/logic/excl_ra.h +++ b/theory/logic/excl_ra.h @@ -1,191 +1,16 @@ #pragma once -/* - * `excl_ra:((A)excl)ra` is a unital exclusive resource algebra. Its carrier - * has an empty value `ExclUnit`, owned values `Excl a`, and the inconsistent - * value `ExclInvalid`. `ExclUnit` is the unit; combining two owned values - * produces `ExclInvalid`; exactly the unit and owned values are valid. - * - * Only semantic client rules are exposed here. The datatype handle, raw - * recursive definitions, construction laws, and `ra_abs` projection - * equations live in `excl_ra_internal.h` for the implementation of dependent - * constructions such as `auth_ra`. - */ +/* Exclusive resource algebra. Invalid-source vacuum rules are not public. */ #include "proof/theory/logic/local_update.h" -/* ------------------------------------------------------------------------- */ -/* Core representation */ -/* ------------------------------------------------------------------------- */ - -/* `ra_unit excl_ra == (ExclUnit:(A)excl)`. */ PROOF extern thm EXCL_RA_UNIT; - -/* - * Owned constructor injectivity: - * - * forall a b:A. - * ((Excl a:(A)excl) == Excl b) <=> a == b - */ -PROOF extern thm EXCL_RA_OWNED_INJ; - -/* `forall a:A. ~((Excl a:(A)excl) == ExclUnit)`. */ -PROOF extern thm EXCL_RA_OWNED_NE_UNIT; - -/* `~((ExclInvalid:(A)excl) == ExclUnit)`. */ -PROOF extern thm EXCL_RA_INVALID_NE_UNIT; - -/* `forall a:A. ~((ExclInvalid:(A)excl) == Excl a)`. */ -PROOF extern thm EXCL_RA_INVALID_NE_OWNED; - -/* - * `forall a b:A. - * ra_op excl_ra (Excl a) (Excl b) == - * (ExclInvalid:(A)excl)` - */ PROOF extern thm EXCL_RA_OWNED_CONFLICT; - -/* ------------------------------------------------------------------------- */ -/* Validity */ -/* ------------------------------------------------------------------------- */ - -/* `ra_valid excl_ra (ExclUnit:(A)excl)`. */ PROOF extern thm EXCL_RA_VALID_UNIT; - -/* `forall a:A. ra_valid excl_ra (Excl a)`. */ PROOF extern thm EXCL_RA_VALID_OWNED; - -/* `~(ra_valid excl_ra (ExclInvalid:(A)excl))`. */ PROOF extern thm EXCL_RA_INVALID; - -/* - * Complete validity characterization: - * - * forall x:(A)excl. - * ra_valid excl_ra x <=> ~(x == ExclInvalid) - */ -PROOF extern thm EXCL_RA_VALID_IFF; - -/* ------------------------------------------------------------------------- */ -/* Laws */ -/* ------------------------------------------------------------------------- */ - -/* - * `EXCL_RA_OWNED_CONFLICT` is the characteristic domain law: no valid - * composition can contain two owned exclusive values. - */ - -/* - * Inclusion between two owned values forces equality of their payloads: - * - * forall a b:A. - * ra_included excl_ra (Excl a) (Excl b) <=> a == b - * - * The only frame compatible with an owned exclusive value is `ExclUnit`. - * This rule is the public abstraction boundary used by authoritative - * protocols to recover agreement between an authority and a fragment. - */ PROOF extern thm EXCL_RA_INCLUDED_OWNED; - -/* - * Complete target characterization for an owned source: - * - * forall (a:A) (x:(A)excl). - * ra_included excl_ra (Excl a) x <=> - * x == Excl a \/ x == ExclInvalid - * - * Inclusion is an algebraic extension relation and does not require the - * target to be valid; composing with another owned value explains the - * `ExclInvalid` branch. - */ -PROOF extern thm EXCL_RA_INCLUDED_OWNED_IFF; - -/* - * Complete target characterization for the invalid source: - * - * forall x:(A)excl. - * ra_included excl_ra ExclInvalid x <=> x == ExclInvalid - */ -PROOF extern thm EXCL_RA_INCLUDED_INVALID_IFF; - -/* ------------------------------------------------------------------------- */ -/* Exclusive elements */ -/* ------------------------------------------------------------------------- */ - -/* `forall a:A. ra_exclusive excl_ra (Excl a)`. */ PROOF extern thm EXCL_RA_EXCLUSIVE; - -/* - * The invalid element is exclusive vacuously: - * - * ra_exclusive excl_ra (ExclInvalid:(A)excl) - * - * `ra_exclusive` constrains compatible frames but does not imply source - * validity. Clients that need a usable resource must carry validity too. - */ -PROOF extern thm EXCL_RA_EXCLUSIVE_INVALID; - -/* ------------------------------------------------------------------------- */ -/* Laws: optional algebraic properties */ -/* ------------------------------------------------------------------------- */ - -/* Exclusive composition is cancellative: `ra_cancellative excl_ra`. */ PROOF extern thm EXCL_RA_CANCELLATIVE; - -/* ------------------------------------------------------------------------- */ -/* Updates */ -/* ------------------------------------------------------------------------- */ - -/* - * `forall a b:A. ra_update excl_ra (Excl a) (Excl b)`. - * - * This is the instance of `RA_EXCLUSIVE_UPDATE` for an exclusive owned - * source and a valid owned target. - */ -PROOF extern thm EXCL_RA_UPDATE; - -/* - * An owned source may be replaced by any valid target: - * - * forall (a:A) (x:(A)excl). - * ra_valid excl_ra x ==> - * ra_update excl_ra (Excl a) x - */ -PROOF extern thm EXCL_RA_UPDATE_VALID; - -/* - * The validity premise above is exact: - * - * forall (a:A) (x:(A)excl). - * ra_update excl_ra (Excl a) x <=> ra_valid excl_ra x - */ PROOF extern thm EXCL_RA_UPDATE_OWNED_IFF; - -/* - * An invalid source admits every update vacuously: - * - * forall x:(A)excl. - * ra_update excl_ra ExclInvalid x - */ -PROOF extern thm EXCL_RA_UPDATE_INVALID; - -/* - * Full ownership of an owned value supports replacement by any valid target: - * - * forall (a:A) (x:(A)excl). - * ra_valid excl_ra x ==> - * ra_local_update excl_ra (Excl a,Excl a) (x,x) - */ -PROOF extern thm EXCL_RA_LOCAL_UPDATE_VALID; - -/* - * The validity premise is also necessary for full owned replacement: - * - * forall (a:A) (x:(A)excl). - * ra_local_update excl_ra (Excl a,Excl a) (x,x) <=> - * ra_valid excl_ra x - * - * Necessity follows by selecting the unit residual in the local-update - * definition; sufficiency is `EXCL_RA_LOCAL_UPDATE_VALID`. - */ PROOF extern thm EXCL_RA_LOCAL_UPDATE_IFF; diff --git a/theory/logic/excl_ra_internal.h b/theory/logic/excl_ra_internal.h index 99e4bbb..27c30ab 100644 --- a/theory/logic/excl_ra_internal.h +++ b/theory/logic/excl_ra_internal.h @@ -39,3 +39,7 @@ PROOF extern thm EXCL_INVALID_NE_UNIT; /** Projection equation: `⊢ ra_op excl_ra = excl_op`. */ PROOF extern thm EXCL_RA_OP_FN; + +/* Internal whole-descriptor replacement rule used by the physical-memory + * constructor. Protocol clients use EXCL_RA_UPDATE_OWNED_IFF instead. */ +PROOF extern thm EXCL_RA_UPDATE; diff --git a/theory/logic/frac_ra.c b/theory/logic/frac_ra.c index d79df6b..3f45028 100644 --- a/theory/logic/frac_ra.c +++ b/theory/logic/frac_ra.c @@ -1,5 +1,6 @@ #include "proof/theory/logic/frac_ra.h" #include "proof/theory/logic/ra_builder.h" +#include "proof/theory/logic/ra_internal.h" #include "proof/proof_backward.h" #require "proof/proof_backward.c" @@ -774,7 +775,7 @@ PROOF static thm prove_frac_ra_own_inj(void) { return gnode_prove(root); } -PROOF thm FRAC_RA_OWN_INJ = +PROOF static thm FRAC_RA_OWN_INJ = prove_frac_ra_own_inj(); PROOF static thm prove_frac_ra_own_ne_empty(void) { @@ -792,7 +793,7 @@ PROOF static thm prove_frac_ra_own_ne_empty(void) { return gnode_prove(root); } -PROOF thm FRAC_RA_OWN_NE_EMPTY = +PROOF static thm FRAC_RA_OWN_NE_EMPTY = prove_frac_ra_own_ne_empty(); PROOF static thm prove_frac_ra_full_inj(void) { @@ -816,7 +817,7 @@ PROOF static thm prove_frac_ra_full_inj(void) { return gnode_prove(root); } -PROOF thm FRAC_RA_FULL_INJ = +PROOF static thm FRAC_RA_FULL_INJ = prove_frac_ra_full_inj(); PROOF static thm prove_frac_ra_full_ne_empty(void) { @@ -833,7 +834,7 @@ PROOF static thm prove_frac_ra_full_ne_empty(void) { return gnode_prove(root); } -PROOF thm FRAC_RA_FULL_NE_EMPTY = +PROOF static thm FRAC_RA_FULL_NE_EMPTY = prove_frac_ra_full_ne_empty(); PROOF static thm prove_frac_ra_valid_empty(void) { @@ -853,7 +854,7 @@ PROOF static thm prove_frac_ra_valid_empty(void) { return gnode_prove(root); } -PROOF thm FRAC_RA_VALID_EMPTY = +PROOF static thm FRAC_RA_VALID_EMPTY = prove_frac_ra_valid_empty(); PROOF static thm prove_frac_ra_valid_own(void) { @@ -928,7 +929,7 @@ PROOF static thm prove_frac_ra_valid_full(void) { return gnode_prove(root); } -PROOF thm FRAC_RA_VALID_FULL = +PROOF static thm FRAC_RA_VALID_FULL = prove_frac_ra_valid_full(); /* ------------------------------------------------------------------------- */ @@ -955,7 +956,7 @@ PROOF static thm prove_frac_ra_included_empty(void) { return gnode_prove(root); } -PROOF thm FRAC_RA_INCLUDED_EMPTY = +PROOF static thm FRAC_RA_INCLUDED_EMPTY = prove_frac_ra_included_empty(); PROOF static thm prove_frac_ra_included_own(void) { @@ -1188,7 +1189,7 @@ PROOF static thm prove_frac_ra_included_own(void) { return gnode_prove(root); } -PROOF thm FRAC_RA_INCLUDED_OWN = +PROOF static thm FRAC_RA_INCLUDED_OWN = prove_frac_ra_included_own(); PROOF static thm prove_frac_ra_not_included_own_empty(void) { @@ -1239,7 +1240,7 @@ PROOF static thm prove_frac_ra_not_included_own_empty(void) { return gnode_prove(root); } -PROOF thm FRAC_RA_NOT_INCLUDED_OWN_EMPTY = +PROOF static thm FRAC_RA_NOT_INCLUDED_OWN_EMPTY = prove_frac_ra_not_included_own_empty(); PROOF static thm prove_frac_ra_included_full(void) { @@ -1274,7 +1275,7 @@ PROOF static thm prove_frac_ra_included_full(void) { return gnode_prove(root); } -PROOF thm FRAC_RA_INCLUDED_FULL = +PROOF static thm FRAC_RA_INCLUDED_FULL = prove_frac_ra_included_full(); /* ------------------------------------------------------------------------- */ @@ -1289,6 +1290,7 @@ PROOF thm FRAC_RA_INCLUDED_FULL = PROOF static thm prove_frac_ra_exclusive_full(void) { term goal_tm = ` forall (R:(A)ra) (a:A). + ra_valid R a ==> ra_exclusive (frac_ra R) (frac_full a) @@ -1298,8 +1300,18 @@ PROOF static thm prove_frac_ra_exclusive_full(void) { root, once_rewrite_conv(THM_LIST(ra_exclusive_def))); body = AUTO_INTROS_TAC(body); + gnode_list exclusive_parts = CONJ_TAC(body); + + thm full_valid = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + FRAC_RA_VALID_FULL)), + assume_rule(`ra_valid (R:(A)ra) (a:A)`)); + ACCEPT_TAC(exclusive_parts[0], full_valid); + + gnode frames = AUTO_INTROS_TAC(exclusive_parts[1]); gnode_list frame_cases = CASES_TAC( - body, `frame:(A)frac`, NULL); + frames, `frame:(A)frac`, NULL); thm frame_is_unit = assume_rule(` (frame:(A)frac) == FracUnit @@ -1687,7 +1699,7 @@ PROOF static thm prove_frac_ra_cancellative(void) { return gnode_prove(root); } -PROOF thm FRAC_RA_CANCELLATIVE = +PROOF static thm FRAC_RA_CANCELLATIVE = prove_frac_ra_cancellative(); /* ------------------------------------------------------------------------- */ @@ -1741,7 +1753,12 @@ PROOF static thm prove_frac_ra_update_weaken(void) { body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(ra_update_def))); + pure_rewrite_conv(THM_LIST( + ra_update_def, + ra_updateP_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); body = AUTO_INTROS_TAC(body); gnode_list frame_cases = CASES_TAC( body, `frame:(A)frac`, NULL); @@ -1788,8 +1805,14 @@ PROOF static thm prove_frac_ra_update_weaken(void) { conj_rule( assume_rule(`(q:real) <= (p:real)`), conjunct1_rule(source_unit))); + gnode unit_result = EXISTS_TAC( + frame_cases[0], `frac_own (q:real) (b:A)`); + gnode_list unit_parts = CONJ_TAC(unit_result); + ACCEPT_TAC( + unit_parts[0], + refl_rule(`frac_own (q:real) (b:A)`)); gnode target_unit = CONV_TAC( - frame_cases[0], + unit_parts[1], rewrite_conv(THM_LIST( assume_rule(` (frame:(A)frac) == FracUnit @@ -1828,13 +1851,18 @@ PROOF static thm prove_frac_ra_update_weaken(void) { (frac_own (p:real) (a:A)) (frame:(A)frac)) `)); - thm base_update = pure_once_rewrite_rule( - THM_LIST(ra_update_def), - assume_rule(` - ra_update (R:(A)ra) (a:A) (b:A) - `)); thm target_owned_payload = mp_rule( - spec_rule(`a1:A`, base_update), + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `b:A`, + `a1:A`), + RA_UPDATE_APPLY), + assume_rule(` + ra_update (R:(A)ra) (a:A) (b:A) + `)), conjunct2_rule(source_owned)); thm weakened_sum = eq_mp_rule( sym_rule(ispecl_rule( @@ -1854,8 +1882,14 @@ PROOF static thm prove_frac_ra_update_weaken(void) { conj_rule( weakened_sum, conjunct1_rule(source_owned))); + gnode owned_result = EXISTS_TAC( + frame_cases[1], `frac_own (q:real) (b:A)`); + gnode_list owned_parts = CONJ_TAC(owned_result); + ACCEPT_TAC( + owned_parts[0], + refl_rule(`frac_own (q:real) (b:A)`)); gnode target_owned = CONV_TAC( - frame_cases[1], + owned_parts[1], rewrite_conv(THM_LIST( assume_rule(` (frame:(A)frac) == Frac a0 a1 @@ -1880,10 +1914,10 @@ PROOF thm FRAC_RA_UPDATE_WEAKEN = prove_frac_ra_update_weaken(); /* - * The ND rule selects a base result separately for each source-compatible + * The predicate-update rule selects a base result separately for each source-compatible * fractional frame, while exposing only the exact fixed-weight image of P. */ -PROOF static thm prove_frac_ra_update_weaken_nd(void) { +PROOF static thm prove_frac_ra_updateP_weaken(void) { term goal_tm = ` forall (R:(A)ra) @@ -1893,8 +1927,8 @@ PROOF static thm prove_frac_ra_update_weaken_nd(void) { (P:A->bool). &0 < q ==> q <= p ==> - ra_update_nd R a P ==> - ra_update_nd + ra_updateP R a P ==> + ra_updateP (frac_ra R) (frac_own p a) (\x:(A)frac. @@ -1927,7 +1961,7 @@ PROOF static thm prove_frac_ra_update_weaken_nd(void) { body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); + once_rewrite_conv(THM_LIST(ra_updateP_def))); body = CONV_TAC( body, depth_conv(get_conversion_by_name("BETA_CONV"))); @@ -1962,9 +1996,9 @@ PROOF static thm prove_frac_ra_update_weaken_nd(void) { `R:(A)ra`, `a:A`, `P:A->bool`), - RA_UPDATE_ND_VALID), + RA_UPDATEP_VALID), assume_rule(` - ra_update_nd + ra_updateP (R:(A)ra) (a:A) (P:A->bool) @@ -2044,9 +2078,9 @@ PROOF static thm prove_frac_ra_update_weaken_nd(void) { (frame:(A)frac)) `)); thm base_update = pure_once_rewrite_rule( - THM_LIST(ra_update_nd_def), + THM_LIST(ra_updateP_def), assume_rule(` - ra_update_nd + ra_updateP (R:(A)ra) (a:A) (P:A->bool) @@ -2121,51 +2155,8 @@ PROOF static thm prove_frac_ra_update_weaken_nd(void) { return gnode_prove(root); } -PROOF thm FRAC_RA_UPDATE_WEAKEN_ND = - prove_frac_ra_update_weaken_nd(); - -PROOF static thm prove_frac_ra_update_full(void) { - term goal_tm = ` - forall - (R:(A)ra) - (a:A) - (b:A). - ra_valid R (b:A) ==> - ra_update - (frac_ra R) - (frac_full (a:A)) - (frac_full (b:A)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - thm target_full_valid = eq_mp_rule( - sym_rule(ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `b:A`), - FRAC_RA_VALID_FULL)), - assume_rule(`ra_valid (R:(A)ra) (b:A)`)); - thm update = ispecl_rule( - TERM_LIST( - `frac_ra (R:(A)ra)`, - `frac_full (a:A)`, - `frac_full (b:A)`), - RA_EXCLUSIVE_UPDATE); - update = mp_rule( - update, - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `a:A`), - FRAC_RA_EXCLUSIVE_FULL)); - ACCEPT_TAC( - body, - mp_rule(update, target_full_valid)); - return gnode_prove(root); -} - -PROOF thm FRAC_RA_UPDATE_FULL = - prove_frac_ra_update_full(); +PROOF thm FRAC_RA_UPDATEP_WEAKEN = + prove_frac_ra_updateP_weaken(); PROOF static thm prove_frac_ra_update_full_iff(void) { term goal_tm = ` @@ -2178,233 +2169,134 @@ PROOF static thm prove_frac_ra_update_full_iff(void) { `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); - thm exact = mp_rule( - ispecl_rule( - TERM_LIST( - `frac_ra (R:(A)ra)`, - `frac_full (a:A)`, - `frac_full (b:A)`), - RA_EXCLUSIVE_UPDATE_IFF), - ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`), - FRAC_RA_EXCLUSIVE_FULL)); - exact = rewrite_rule( - THM_LIST(FRAC_RA_VALID_FULL), - exact); - ACCEPT_TAC(body, exact); - return gnode_prove(root); -} + gnode_list directions = EQ_TAC(body); -PROOF thm FRAC_RA_UPDATE_FULL_IFF = - prove_frac_ra_update_full_iff(); + gnode forward = DISCH_TAC(directions[0], "Hupdate"); + forward = DISCH_TAC(forward, "Hsource_valid"); + thm source_full_valid = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + FRAC_RA_VALID_FULL)), + assume_rule(`ra_valid (R:(A)ra) (a:A)`)); + thm target_full_valid = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `frac_ra (R:(A)ra)`, + `frac_full (a:A)`, + `frac_full (b:A)`), + RA_UPDATE_VALID), + assume_rule(` + ra_update + (frac_ra (R:(A)ra)) + (frac_full (a:A)) + (frac_full (b:A)) + `)), + source_full_valid); + ACCEPT_TAC( + forward, + eq_mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `b:A`), + FRAC_RA_VALID_FULL), + target_full_valid)); -PROOF static thm prove_frac_ra_update_full_nd(void) { - term goal_tm = ` - forall (R:(A)ra) (a:A) (P:A->bool). - (exists b:A. P b && ra_valid R b) ==> - ra_update_nd - (frac_ra R) - (frac_full a) - (\x:(A)frac. - exists b:A. - P b && x == frac_full b) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - body = ASMP_EXISTS_TAC(body, "H", "b"); - body = ASMP_CONJ_TAC( - body, - "H", - "HP", - "Hvalid_b"); + gnode reverse = DISCH_TAC(directions[1], "Hvalid"); + reverse = CONV_TAC( + reverse, + pure_rewrite_conv(THM_LIST( + ra_update_def, + ra_updateP_def))); + reverse = CONV_TAC( + reverse, + depth_conv(get_conversion_by_name("BETA_CONV"))); + reverse = AUTO_INTROS_TAC(reverse); - thm deterministic = mp_rule( + thm source_parts = mp_rule( ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `a:A`, - `b:A`), - FRAC_RA_UPDATE_FULL), - assume_rule(`ra_valid (R:(A)ra) (b:A)`)); - thm singleton = eq_mp_rule( - sym_rule(ispecl_rule( TERM_LIST( `frac_ra (R:(A)ra)`, `frac_full (a:A)`, - `frac_full (b:A)`), - RA_UPDATE_ND_SINGLETON)), - deterministic); - - term singleton_pred = ` - \x:(A)frac. x == frac_full (b:A) - `; - term image_pred = ` - \x:(A)frac. - exists c:A. - (P:A->bool) c && - x == frac_full c - `; - thm monotone = ispecl_rule( - TERM_LIST( - `frac_ra (R:(A)ra)`, - `frac_full (a:A)`, - singleton_pred, - image_pred), - RA_UPDATE_ND_MONO); - monotone = mp_rule(monotone, singleton); - monotone = conv_rule( - depth_conv(get_conversion_by_name("BETA_CONV")), - monotone); - - term source_eq = ` - (x:(A)frac) == frac_full (b:A) - `; - term image_at_x = ` - exists c:A. - (P:A->bool) c && - (x:(A)frac) == frac_full c - `; - thm exact_image = exists_rule( - image_at_x, - `b:A`, - conj_rule( - assume_rule(`(P:A->bool) (b:A)`), - assume_rule(source_eq))); - exact_image = disch_rule(source_eq, exact_image); - exact_image = gen_rule( - `x:(A)frac`, - exact_image); - - ACCEPT_TAC( - body, - mp_rule(monotone, exact_image)); - return gnode_prove(root); -} - -PROOF thm FRAC_RA_UPDATE_FULL_ND = - prove_frac_ra_update_full_nd(); - -PROOF static thm prove_frac_ra_full_image_valid_iff(void) { - term goal_tm = ` - forall (R:(A)ra) (P:A->bool). - ((exists x:(A)frac. - (exists b:A. - P b && x == frac_full b) && - ra_valid (frac_ra R) x) <=> - (exists b:A. P b && ra_valid R b)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - gnode_list directions = EQ_TAC(body); - - gnode forward = DISCH_TAC( - directions[0], "Hresult"); - forward = ASMP_EXISTS_TAC( - forward, "Hresult", "x"); - forward = ASMP_CONJ_TAC( - forward, - "Hresult", - "Himage", - "Hvalid"); - forward = ASMP_EXISTS_TAC( - forward, "Himage", "b"); - forward = ASMP_CONJ_TAC( - forward, - "Himage", - "HP_b", - "Hx"); - forward = EXISTS_TAC(forward, `b:A`); - gnode_list forward_parts = CONJ_TAC(forward); - ACCEPT_TAC( - forward_parts[0], - assume_rule(`(P:A->bool) (b:A)`)); - thm base_valid = rewrite_rule( - THM_LIST( - assume_rule(`(x:(A)frac) == frac_full (b:A)`), - FRAC_RA_VALID_FULL), + `frame:(A)frac`), + RA_VALID_OP), assume_rule(` ra_valid (frac_ra (R:(A)ra)) - (x:(A)frac) + (ra_op + (frac_ra R) + (frac_full (a:A)) + (frame:(A)frac)) `)); - ACCEPT_TAC(forward_parts[1], base_valid); - - gnode reverse = DISCH_TAC( - directions[1], "Hresult"); - reverse = ASMP_EXISTS_TAC( - reverse, "Hresult", "b"); - reverse = ASMP_CONJ_TAC( - reverse, - "Hresult", - "HP_b", - "Hvalid_b"); - reverse = EXISTS_TAC( - reverse, `frac_full (b:A)`); - gnode_list reverse_parts = CONJ_TAC(reverse); - gnode image = EXISTS_TAC( - reverse_parts[0], `b:A`); - gnode_list image_parts = CONJ_TAC(image); - ACCEPT_TAC( - image_parts[0], - assume_rule(`(P:A->bool) (b:A)`)); - ACCEPT_TAC( - image_parts[1], - refl_rule(`frac_full (b:A)`)); - thm full_valid = eq_mp_rule( + thm source_base_valid = eq_mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + FRAC_RA_VALID_FULL), + conjunct1_rule(source_parts)); + thm target_base_valid = mp_rule( + assume_rule(` + ra_valid (R:(A)ra) (a:A) ==> + ra_valid R (b:A) + `), + source_base_valid); + thm reverse_target_full_valid = eq_mp_rule( gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `b:A`), FRAC_RA_VALID_FULL)), - assume_rule(`ra_valid (R:(A)ra) (b:A)`)); - ACCEPT_TAC(reverse_parts[1], full_valid); - return gnode_prove(root); -} - -PROOF static thm FRAC_RA_FULL_IMAGE_VALID_IFF = - prove_frac_ra_full_image_valid_iff(); + target_base_valid); -PROOF static thm prove_frac_ra_update_full_nd_iff(void) { - term goal_tm = ` - forall (R:(A)ra) (a:A) (P:A->bool). - (ra_update_nd - (frac_ra R) - (frac_full a) - (\x:(A)frac. - exists b:A. - P b && x == frac_full b) <=> - (ra_valid R a ==> - exists b:A. P b && ra_valid R b)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - term image = ` - \x:(A)frac. - exists b:A. - (P:A->bool) b && x == frac_full b - `; - thm exact = mp_rule( - ispecl_rule( - TERM_LIST( - `frac_ra (R:(A)ra)`, - `frac_full (a:A)`, - image), - RA_EXCLUSIVE_UPDATE_ND_IFF), + thm exclusive = mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), - FRAC_RA_EXCLUSIVE_FULL)); - exact = conv_rule( - depth_conv(get_conversion_by_name("BETA_CONV")), - exact); - exact = rewrite_rule( - THM_LIST( - FRAC_RA_VALID_FULL, - FRAC_RA_FULL_IMAGE_VALID_IFF), - exact); - ACCEPT_TAC(body, exact); + FRAC_RA_EXCLUSIVE_FULL), + source_base_valid); + thm frame_is_unit = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `frac_ra (R:(A)ra)`, + `frac_full (a:A)`, + `frame:(A)frac`), + RA_EXCLUSIVE_APPLY), + exclusive), + assume_rule(` + ra_valid + (frac_ra (R:(A)ra)) + (ra_op + (frac_ra R) + (frac_full (a:A)) + (frame:(A)frac)) + `)); + + thm target_unit_eq = ispecl_rule( + TERM_LIST( + `frac_ra (R:(A)ra)`, + `frac_full (b:A)`), + RA_UNIT_R); + thm target_with_unit = eq_mp_rule( + gsym_rule(beta_rule(ap_term_rule( + `\x:(A)frac. + ra_valid (frac_ra (R:(A)ra)) x`, + target_unit_eq))), + reverse_target_full_valid); + thm target_frame_eq = beta_rule(ap_term_rule( + `\x:(A)frac. + ra_valid + (frac_ra (R:(A)ra)) + (ra_op (frac_ra R) (frac_full (b:A)) x)`, + frame_is_unit)); + thm target_with_frame = eq_mp_rule( + gsym_rule(target_frame_eq), + target_with_unit); + + reverse = EXISTS_TAC(reverse, `frac_full (b:A)`); + gnode_list result = CONJ_TAC(reverse); + ACCEPT_TAC(result[0], refl_rule(`frac_full (b:A)`)); + ACCEPT_TAC(result[1], target_with_frame); return gnode_prove(root); } -PROOF thm FRAC_RA_UPDATE_FULL_ND_IFF = - prove_frac_ra_update_full_nd_iff(); +PROOF thm FRAC_RA_UPDATE_FULL_IFF = + prove_frac_ra_update_full_iff(); PROOF static int audit_frac_ra(void) { thm_list audited_theorems = THM_LIST( @@ -2455,12 +2347,8 @@ PROOF static int audit_frac_ra(void) { FRAC_RA_EXCLUSIVE_FULL, FRAC_RA_CANCELLATIVE, FRAC_RA_UPDATE_WEAKEN, - FRAC_RA_UPDATE_WEAKEN_ND, - FRAC_RA_UPDATE_FULL, - FRAC_RA_UPDATE_FULL_IFF, - FRAC_RA_UPDATE_FULL_ND, - FRAC_RA_FULL_IMAGE_VALID_IFF, - FRAC_RA_UPDATE_FULL_ND_IFF); + FRAC_RA_UPDATEP_WEAKEN, + FRAC_RA_UPDATE_FULL_IFF); for (size_t i = 0; i < vector_size(audited_theorems); diff --git a/theory/logic/frac_ra.h b/theory/logic/frac_ra.h index aa5af21..d3a1150 100644 --- a/theory/logic/frac_ra.h +++ b/theory/logic/frac_ra.h @@ -1,311 +1,68 @@ #pragma once /* - * Positive fractional ownership over a base resource algebra. + * Optional positive-fraction RA construction. * - * `frac_ra R : ((A)frac)ra` has carrier `(A)frac`, unit `frac_empty`, and - * positive-weight owned tokens. Two owned tokens compose by adding weights - * and composing payloads in `R`; a positive token `(p,a)` is valid exactly - * when `p <= &1` and `a` is valid in `R`. The public smart constructors are: - * - * frac_empty : (A)frac - * frac_own : real -> A -> (A)frac - * frac_full : A -> (A)frac - * - * `frac_own p a` is intended for `&0 < p`; every computation rule involving - * this constructor carries that premise explicitly. `frac_full a` is the - * canonical weight-one token. The positive-real subtype, datatype - * constructors, raw operation/validity functions, RA law proof, and - * abstraction projections are private to `frac_ra.c`. + * `frac_ra R : ((A)frac)ra` contains an empty unit and positive-share tokens + * `frac_own p a`. Shares compose by addition while payloads compose in `R`; + * validity bounds the total share by one. This module is an optional extra, + * not part of the foundational RA construction dependency graph. */ #include "proof/theory/logic/ra.h" -/* ------------------------------------------------------------------------- */ -/* Core representation and constructors */ -/* ------------------------------------------------------------------------- */ - -/* - * `forall R:(A)ra. - * ra_unit (frac_ra R) == (frac_empty:(A)frac)` - */ +/* `forall R:(A)ra. ra_unit (frac_ra R) == (frac_empty:(A)frac)`. */ PROOF extern thm FRAC_RA_UNIT; -/* - * Full ownership is the canonical weight-one token: - * - * `forall a:A. - * frac_full a == frac_own (&1) a` - */ +/* `forall a:A. frac_full a == frac_own (&1) a`. */ PROOF extern thm FRAC_RA_FULL; /* - * Positive owned tokens compose by adding weights and composing payloads: + * Positive shares join (and, by symmetry, split) exactly: * * `forall (R:(A)ra) (p q:real) (a b:A). - * &0 < p ==> - * &0 < q ==> + * &0 < p ==> &0 < q ==> * ra_op (frac_ra R) (frac_own p a) (frac_own q b) == - * frac_own (p + q) (ra_op R a b)` + * frac_own (p + q) (ra_op R a b)`. */ PROOF extern thm FRAC_RA_OWN_OP; /* - * Positive smart constructors are injective in both their weight and payload: - * - * `forall (p:real) (q:real) (a:A) (b:A). - * &0 < p ==> - * &0 < q ==> - * (frac_own p a == frac_own q b <=> - * p == q && a == b)` - * - * The positivity premises are essential: outside the intended smart- - * constructor domain, `frac_weight_abs` need not represent its argument. - */ -PROOF extern thm FRAC_RA_OWN_INJ; - -/* - * Owned and empty constructors are distinct, even for a nonpositive argument: - * - * `forall (p:real) (a:A). - * ~(frac_own p a == (frac_empty:(A)frac))` - */ -PROOF extern thm FRAC_RA_OWN_NE_EMPTY; - -/* - * `forall (a:A) (b:A). - * frac_full a == frac_full b <=> a == b` - */ -PROOF extern thm FRAC_RA_FULL_INJ; - -/* - * `forall a:A. - * ~(frac_full a == (frac_empty:(A)frac))` - */ -PROOF extern thm FRAC_RA_FULL_NE_EMPTY; - -/* ------------------------------------------------------------------------- */ -/* Validity */ -/* ------------------------------------------------------------------------- */ - -/* - * `forall R:(A)ra. - * ra_valid (frac_ra R) (frac_empty:(A)frac)` - */ -PROOF extern thm FRAC_RA_VALID_EMPTY; - -/* - * A positive owned token is valid exactly when its weight is at most one and - * its base payload is valid: - * * `forall (R:(A)ra) (p:real) (a:A). * &0 < p ==> * (ra_valid (frac_ra R) (frac_own p a) <=> - * p <= &1 && ra_valid R a)` + * p <= &1 && ra_valid R a)`. */ PROOF extern thm FRAC_RA_VALID_OWN; /* - * Full-token validity: - * - * `forall (R:(A)ra) (a:A). - * ra_valid (frac_ra R) (frac_full a) <=> - * ra_valid R a` - */ -PROOF extern thm FRAC_RA_VALID_FULL; - -/* ------------------------------------------------------------------------- */ -/* Inclusion */ -/* ------------------------------------------------------------------------- */ - -/* - * The empty token is the unit and hence is included in every token: - * - * `forall (R:(A)ra) (x:(A)frac). - * ra_included (frac_ra R) frac_empty x` - */ -PROOF extern thm FRAC_RA_INCLUDED_EMPTY; - -/* - * Exact inclusion between positive owned tokens: - * - * `forall (R:(A)ra) (p:real) (q:real) (a:A) (b:A). - * &0 < p ==> - * &0 < q ==> - * (ra_included - * (frac_ra R) - * (frac_own p a) - * (frac_own q b) <=> - * (p == q && a == b) || - * (p < q && ra_included R a b))` - * - * Equal weights leave only the empty frame. A nonempty frame contributes a - * strictly positive weight, producing the strict second alternative. - */ -PROOF extern thm FRAC_RA_INCLUDED_OWN; - -/* - * A positive owned token cannot be extended to the empty token: - * - * `forall (R:(A)ra) (p:real) (a:A). - * &0 < p ==> - * ~(ra_included - * (frac_ra R) - * (frac_own p a) - * frac_empty)` - */ -PROOF extern thm FRAC_RA_NOT_INCLUDED_OWN_EMPTY; - -/* - * Full-token inclusion collapses to payload equality: - * - * `forall (R:(A)ra) (a:A) (b:A). - * ra_included - * (frac_ra R) - * (frac_full a) - * (frac_full b) <=> - * a == b` - */ -PROOF extern thm FRAC_RA_INCLUDED_FULL; - -/* ------------------------------------------------------------------------- */ -/* Exclusive elements */ -/* ------------------------------------------------------------------------- */ - -/* - * Full ownership admits no compatible nonempty fractional frame: - * * `forall (R:(A)ra) (a:A). - * ra_exclusive (frac_ra R) (frac_full a)` - * - * Any owned frame has strictly positive weight, so composing it with weight - * one would exceed the validity bound. The payload need not itself be valid: - * as in the generic definition, exclusivity may hold vacuously for an invalid - * source. + * ra_valid R a ==> ra_exclusive (frac_ra R) (frac_full a)`. */ PROOF extern thm FRAC_RA_EXCLUSIVE_FULL; -/* ------------------------------------------------------------------------- */ -/* Laws: optional algebraic properties */ -/* ------------------------------------------------------------------------- */ - /* - * Fractional ownership preserves cancellativity of the base RA: - * - * `forall R:(A)ra. - * ra_cancellative R ==> - * ra_cancellative (frac_ra R)` - * - * Positivity of every owned weight excludes cancellation between an empty - * and an owned target. When both targets are owned, equality of the composed - * weights cancels their common frame weight, and base cancellativity cancels - * the common payload frame. - */ -PROOF extern thm FRAC_RA_CANCELLATIVE; - -/* ------------------------------------------------------------------------- */ -/* Updates: weight weakening and lifted payload updates */ -/* ------------------------------------------------------------------------- */ - -/* - * A base frame-preserving update lifts through fractional ownership while - * the owned weight is weakened. The assumptions `&0 < q` and `q <= p` - * imply `&0 < p`, so no redundant positivity premise for `p` is needed: - * * `forall (R:(A)ra) (p q:real) (a b:A). - * &0 < q ==> - * q <= p ==> - * ra_update R a b ==> - * ra_update - * (frac_ra R) - * (frac_own p a) - * (frac_own q b)` - * - * Every frame compatible with weight `p` remains compatible after replacing - * it by the no-larger weight `q`; the base update preserves the framed - * payload validity. + * &0 < q ==> q <= p ==> ra_update R a b ==> + * ra_update (frac_ra R) (frac_own p a) (frac_own q b)`. */ PROOF extern thm FRAC_RA_UPDATE_WEAKEN; /* - * Exact-image nondeterministic weight weakening: + * Predicate-update weakening with an exact fixed-share image: * * `forall (R:(A)ra) (p q:real) (a:A) (P:A->bool). - * &0 < q ==> - * q <= p ==> - * ra_update_nd R a P ==> - * ra_update_nd + * &0 < q ==> q <= p ==> ra_updateP R a P ==> + * ra_updateP * (frac_ra R) * (frac_own p a) - * (\x:(A)frac. - * exists b:A. - * P b && x == frac_own q b)` - * - * The selected base result may depend on the source-compatible frame, as - * allowed by `ra_update_nd`, but every exposed result has exactly weight `q` - * and a payload satisfying `P`. + * (\x. exists b. P b && x == frac_own q b)`. */ -PROOF extern thm FRAC_RA_UPDATE_WEAKEN_ND; - -/* ------------------------------------------------------------------------- */ -/* Updates: full ownership */ -/* ------------------------------------------------------------------------- */ +PROOF extern thm FRAC_RA_UPDATEP_WEAKEN; /* - * A full token has no compatible nonempty fractional frame. Consequently - * any valid payload is a frame-preserving deterministic target: - * * `forall (R:(A)ra) (a b:A). - * ra_valid R b ==> - * ra_update - * (frac_ra R) - * (frac_full a) - * (frac_full b)` - * - * This is the instance of `RA_EXCLUSIVE_UPDATE` obtained from - * `FRAC_RA_EXCLUSIVE_FULL` and `FRAC_RA_VALID_FULL`. - */ -PROOF extern thm FRAC_RA_UPDATE_FULL; - -/* - * Exact deterministic full-update characterization, including the vacuous - * invalid-source boundary: - * - * `forall (R:(A)ra) (a:A) (b:A). - * (ra_update - * (frac_ra R) - * (frac_full a) - * (frac_full b) <=> - * (ra_valid R a ==> ra_valid R b))` + * (ra_update (frac_ra R) (frac_full a) (frac_full b) <=> + * (ra_valid R a ==> ra_valid R b))`. */ PROOF extern thm FRAC_RA_UPDATE_FULL_IFF; - -/* - * Exact-image nondeterministic full update: - * - * `forall (R:(A)ra) (a:A) (P:A->bool). - * (exists b:A. P b && ra_valid R b) ==> - * ra_update_nd - * (frac_ra R) - * (frac_full a) - * (\x:(A)frac. - * exists b:A. P b && x == frac_full b)` - * - * The result predicate admits precisely full tokens whose payload satisfies - * `P`; it does not admit arbitrary fractional resources. - */ -PROOF extern thm FRAC_RA_UPDATE_FULL_ND; - -/* - * Exact-image nondeterministic full update, with the source-validity guard: - * - * `forall (R:(A)ra) (a:A) (P:A->bool). - * (ra_update_nd - * (frac_ra R) - * (frac_full a) - * (\x:(A)frac. - * exists b:A. P b && x == frac_full b) <=> - * (ra_valid R a ==> - * exists b:A. P b && ra_valid R b))` - */ -PROOF extern thm FRAC_RA_UPDATE_FULL_ND_IFF; diff --git a/theory/logic/ghost_heap.c b/theory/logic/ghost_heap.c deleted file mode 100644 index 86175f9..0000000 --- a/theory/logic/ghost_heap.c +++ /dev/null @@ -1,584 +0,0 @@ -#include "proof/theory/logic/ghost_heap.h" - -#include "proof/proof_backward.h" -#require "proof/proof_backward.c" -#require "proof/theory/logic/gmap_ra.c" - -PROOF static size_t GHOST_HEAP_AXIOMS_BEFORE = - vector_size(get_all_axioms()); - -PROOF thm ghost_heap_ra_def = new_fun_definition(` - ghost_heap_ra (G:(A)ra) : ((num,A)finmap)ra = - gmap_ra G -`); - -PROOF static thm prove_ghost_heap_unit(void) { - term goal_tm = ` - forall G:(A)ra. - ra_unit (ghost_heap_ra G) == - (finmap_empty:(num,A)finmap) - `; - gnode root = gnode_new_with_ccl(goal_tm); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - ghost_heap_ra_def, - GMAP_RA_UNIT))); - return gnode_prove(root); -} - -PROOF thm GHOST_HEAP_UNIT = - prove_ghost_heap_unit(); - -PROOF static thm prove_ghost_heap_op_lookup(void) { - term goal_tm = ` - forall - (G:(A)ra) - (h:(num,A)finmap) - (k:(num,A)finmap) - (name:num). - finmap_lookup - (ra_op (ghost_heap_ra G) h k) - name == - ra_op - (option_ra G) - (finmap_lookup h name) - (finmap_lookup k name) - `; - gnode root = gnode_new_with_ccl(goal_tm); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - ghost_heap_ra_def, - GMAP_RA_OP_LOOKUP))); - return gnode_prove(root); -} - -PROOF thm GHOST_HEAP_OP_LOOKUP = - prove_ghost_heap_op_lookup(); - -PROOF static thm prove_ghost_heap_valid(void) { - term goal_tm = ` - forall (G:(A)ra) (h:(num,A)finmap). - ra_valid (ghost_heap_ra G) h <=> - forall name:num. - ra_valid - (option_ra G) - (finmap_lookup h name) - `; - gnode root = gnode_new_with_ccl(goal_tm); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - ghost_heap_ra_def, - GMAP_RA_VALID))); - return gnode_prove(root); -} - -PROOF thm GHOST_HEAP_VALID = - prove_ghost_heap_valid(); - -PROOF static thm prove_ghost_heap_singleton_op(void) { - term goal_tm = ` - forall (G:(A)ra) (name:num) (a:A) (b:A). - ra_op - (ghost_heap_ra G) - (finmap_singleton name a) - (finmap_singleton name b) == - finmap_singleton name (ra_op G a b) - `; - gnode root = gnode_new_with_ccl(goal_tm); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - ghost_heap_ra_def, - GMAP_RA_SINGLETON_OP))); - return gnode_prove(root); -} - -PROOF thm GHOST_HEAP_SINGLETON_OP = - prove_ghost_heap_singleton_op(); - -PROOF static thm prove_ghost_heap_valid_singleton(void) { - term goal_tm = ` - forall (G:(A)ra) (name:num) (a:A). - ra_valid - (ghost_heap_ra G) - (finmap_singleton name a) <=> - ra_valid G a - `; - gnode root = gnode_new_with_ccl(goal_tm); - CONV_TAC( - root, - rewrite_conv(THM_LIST( - ghost_heap_ra_def, - GMAP_RA_VALID_SINGLETON))); - return gnode_prove(root); -} - -PROOF thm GHOST_HEAP_VALID_SINGLETON = - prove_ghost_heap_valid_singleton(); - -PROOF static thm prove_ghost_heap_singleton_unit_ne_empty(void) { - term goal_tm = ` - forall (G:(A)ra) (name:num). - ~(finmap_singleton name (ra_unit G) == - (finmap_empty:(num,A)finmap)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = GEN_TAC(root, "G"); - body = GEN_TAC(body, "name"); - body = DISCH_TAC(body, "Heq"); - thm lookup_eq = ap_term_rule( - `\h:(num,A)finmap. finmap_lookup h (name:num)`, - assume_rule(` - finmap_singleton (name:num) (ra_unit (G:(A)ra)) == - (finmap_empty:(num,A)finmap) - `)); - lookup_eq = rewrite_rule( - THM_LIST( - FINMAP_SINGLETON_LOOKUP, - FINMAP_EMPTY_LOOKUP, - get_theorem_by_name("option_DISTINCT")), - lookup_eq); - CONTR_TAC(body, lookup_eq); - return gnode_prove(root); -} - -PROOF thm GHOST_HEAP_SINGLETON_UNIT_NE_EMPTY = - prove_ghost_heap_singleton_unit_ne_empty(); - -PROOF static thm prove_ghost_heap_update_singleton(void) { - term goal_tm = ` - forall (G:(A)ra) (name:num) (a:A) (b:A). - ra_update G a b ==> - ra_update - (ghost_heap_ra G) - (finmap_singleton name a) - (finmap_singleton name b) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - body = CONV_TAC( - body, - once_rewrite_conv(THM_LIST(ghost_heap_ra_def))); - thm lifted = mp_rule( - ispecl_rule( - TERM_LIST( - `G:(A)ra`, - `name:num`, - `a:A`, - `b:A`), - GMAP_RA_UPDATE_SINGLETON), - assume_rule(`ra_update (G:(A)ra) (a:A) (b:A)`)); - ACCEPT_TAC(body, lifted); - return gnode_prove(root); -} - -PROOF thm GHOST_HEAP_UPDATE_SINGLETON = - prove_ghost_heap_update_singleton(); - -PROOF static thm prove_ghost_heap_update_singleton_nd(void) { - term goal_tm = ` - forall - (G:(A)ra) - (name:num) - (a:A) - (P:A->bool). - ra_update_nd G a P ==> - ra_update_nd - (ghost_heap_ra G) - (finmap_singleton name a) - (\h:(num,A)finmap. - exists b:A. - P b && h == finmap_singleton name b) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - body = CONV_TAC( - body, - once_rewrite_conv(THM_LIST(ghost_heap_ra_def))); - thm lifted = mp_rule( - ispecl_rule( - TERM_LIST( - `G:(A)ra`, - `name:num`, - `a:A`, - `P:A->bool`), - GMAP_RA_UPDATE_SINGLETON_ND), - assume_rule(` - ra_update_nd (G:(A)ra) (a:A) (P:A->bool) - `)); - ACCEPT_TAC(body, lifted); - return gnode_prove(root); -} - -PROOF thm GHOST_HEAP_UPDATE_SINGLETON_ND = - prove_ghost_heap_update_singleton_nd(); - -PROOF static thm prove_ghost_heap_dealloc(void) { - term goal_tm = ` - forall (G:(A)ra) (name:num) (a:A). - ra_update - (ghost_heap_ra G) - (finmap_singleton name a) - (finmap_empty:(num,A)finmap) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - thm release = ispecl_rule( - TERM_LIST( - `ghost_heap_ra (G:(A)ra)`, - `finmap_singleton (name:num) (a:A)`), - RA_UPDATE_UNIT); - release = pure_once_rewrite_rule( - THM_LIST(GHOST_HEAP_UNIT), - release); - ACCEPT_TAC(body, release); - thm proved = gnode_prove(root); - ENSURE_COND( - equals_term(concl(proved), goal_tm), - "GHOST_HEAP_DEALLOC does not exactly match its documented statement"); - return proved; -err: - ERR_FUN_PUTS("prove_ghost_heap_dealloc"); - return empty_theorem; -} - -PROOF thm GHOST_HEAP_DEALLOC = - prove_ghost_heap_dealloc(); - -PROOF static thm prove_ghost_heap_fresh(void) { - term goal_tm = ` - forall h:(num,A)finmap. - exists name:num. - finmap_lookup h name == NONE - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = GEN_TAC(root, "h"); - thm avoid = mp_rule( - ispec_rule( - `finmap_dom (h:(num,A)finmap)`, - get_theorem_by_name("num_FINITE_AVOID")), - ispec_rule( - `h:(num,A)finmap`, - FINMAP_DOM_FINITE)); - body = ASSUME_TAC(body, avoid, "Hfresh"); - body = ASMP_EXISTS_TAC(body, "Hfresh", "name"); - body = EXISTS_TAC(body, `name:num`); - thm fresh = rewrite_rule( - THM_LIST( - finmap_dom_def, - get_theorem_by_name("IN_ELIM_THM"), - get_theorem_by_name("NOT_CLAUSES")), - assume_rule(` - ~((name:num) IN finmap_dom (h:(num,A)finmap)) - `)); - ACCEPT_TAC(body, fresh); - return gnode_prove(root); -} - -PROOF thm GHOST_HEAP_FRESH = - prove_ghost_heap_fresh(); - -PROOF static thm prove_ghost_heap_fresh_pair(void) { - term goal_tm = ` - forall - (h:(num,A)finmap) - (frame:(num,A)finmap). - exists name:num. - finmap_lookup h name == NONE && - finmap_lookup frame name == NONE - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - term h_dom = `finmap_dom (h:(num,A)finmap)`; - term frame_dom = `finmap_dom (frame:(num,A)finmap)`; - term union_dom = ` - finmap_dom (h:(num,A)finmap) UNION - finmap_dom (frame:(num,A)finmap) - `; - thm union_finite = eq_mp_rule( - gsym_rule(ispecl_rule( - TERM_LIST(h_dom, frame_dom), - get_theorem_by_name("FINITE_UNION"))), - conj_rule( - ispec_rule( - `h:(num,A)finmap`, - FINMAP_DOM_FINITE), - ispec_rule( - `frame:(num,A)finmap`, - FINMAP_DOM_FINITE))); - thm avoid = mp_rule( - ispec_rule( - union_dom, - get_theorem_by_name("num_FINITE_AVOID")), - union_finite); - body = ASSUME_TAC(body, avoid, "Hfresh"); - body = ASMP_EXISTS_TAC(body, "Hfresh", "name"); - body = EXISTS_TAC(body, `name:num`); - thm fresh = rewrite_rule( - THM_LIST( - get_theorem_by_name("IN_UNION"), - finmap_dom_def, - get_theorem_by_name("IN_ELIM_THM"), - get_theorem_by_name("DE_MORGAN_THM"), - get_theorem_by_name("NOT_CLAUSES")), - assume_rule(` - ~((name:num) IN - (finmap_dom (h:(num,A)finmap) UNION - finmap_dom (frame:(num,A)finmap))) - `)); - ACCEPT_TAC(body, fresh); - return gnode_prove(root); -} - -PROOF thm GHOST_HEAP_FRESH_PAIR = - prove_ghost_heap_fresh_pair(); - -PROOF static thm prove_ghost_heap_alloc(void) { - term goal_tm = ` - forall - (G:(A)ra) - (h:(num,A)finmap) - (a:A). - ra_valid G a ==> - ra_update_nd - (ghost_heap_ra G) - h - (\result:(num,A)finmap. - exists name:num. - finmap_lookup h name == NONE && - result == - ra_op - (ghost_heap_ra G) - h - (finmap_singleton name a)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = CONV_TAC( - root, - pure_rewrite_conv(THM_LIST( - ghost_heap_ra_def, - ra_update_nd_def))); - body = CONV_TAC( - body, - depth_conv(get_conversion_by_name("BETA_CONV"))); - body = AUTO_INTROS_TAC(body); - - thm source_all = eq_mp_rule( - ispecl_rule( - TERM_LIST( - `G:(A)ra`, - `ra_op - (gmap_ra (G:(A)ra)) - (h:(num,A)finmap) - (frame:(num,A)finmap)`), - GMAP_RA_VALID), - assume_rule(` - ra_valid - (gmap_ra (G:(A)ra)) - (ra_op - (gmap_ra G) - (h:(num,A)finmap) - (frame:(num,A)finmap)) - `)); - thm fresh = ispecl_rule( - TERM_LIST( - `h:(num,A)finmap`, - `frame:(num,A)finmap`), - GHOST_HEAP_FRESH_PAIR); - body = ASSUME_TAC(body, fresh, "Hfresh"); - body = ASMP_EXISTS_TAC(body, "Hfresh", "name"); - body = ASMP_CONJ_TAC( - body, - "Hfresh", - "Hheap_fresh", - "Hframe_fresh"); - body = EXISTS_TAC( - body, - `ra_op - (gmap_ra (G:(A)ra)) - (h:(num,A)finmap) - (finmap_singleton (name:num) (a:A))`); - gnode_list result_parts = CONJ_TAC(body); - - gnode image = EXISTS_TAC(result_parts[0], `name:num`); - gnode_list image_parts = CONJ_TAC(image); - ACCEPT_TAC( - image_parts[0], - assume_rule(` - finmap_lookup (h:(num,A)finmap) (name:num) == NONE - `)); - ACCEPT_TAC( - image_parts[1], - refl_rule(` - ra_op - (gmap_ra (G:(A)ra)) - (h:(num,A)finmap) - (finmap_singleton (name:num) (a:A)) - `)); - - gnode validity = CONV_TAC( - result_parts[1], - once_rewrite_conv(THM_LIST(GMAP_RA_VALID))); - validity = GEN_TAC(validity, "query"); - thm source_at = spec_rule(`query:num`, source_all); - source_at = rewrite_rule( - THM_LIST(GMAP_RA_OP_LOOKUP), - source_at); - gnode_list cases = BOOL_CASES_TAC( - validity, - `(query:num) == (name:num)`, - "Hname"); - - thm heap_fresh = assume_rule(` - finmap_lookup (h:(num,A)finmap) (name:num) == NONE - `); - thm frame_fresh = assume_rule(` - finmap_lookup (frame:(num,A)finmap) (name:num) == NONE - `); - thm equal_name = assume_rule(`query:num == name`); - gnode at_name = CONV_TAC( - cases[0], - rewrite_conv(THM_LIST( - equal_name, - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP, - heap_fresh, - frame_fresh, - OPTION_RA_OP_NONE_L, - OPTION_RA_OP_NONE_R, - OPTION_RA_VALID_SOME))); - ACCEPT_TAC( - at_name, - assume_rule(`ra_valid (G:(A)ra) (a:A)`)); - - thm unequal_name = assume_rule(`~(query:num == name)`); - gnode away = CONV_TAC( - cases[1], - rewrite_conv(THM_LIST( - unequal_name, - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP, - OPTION_RA_OP_NONE_R))); - ACCEPT_TAC(away, source_at); - return gnode_prove(root); -} - -PROOF thm GHOST_HEAP_ALLOC = - prove_ghost_heap_alloc(); - -PROOF static thm prove_ghost_heap_alloc_empty(void) { - term goal_tm = ` - forall (G:(A)ra) (a:A). - ra_valid G a ==> - ra_update_nd - (ghost_heap_ra G) - (finmap_empty:(num,A)finmap) - (\result:(num,A)finmap. - exists name:num. - result == finmap_singleton name a) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - - term source_pred = ` - \result:(num,A)finmap. - exists name:num. - finmap_lookup - (finmap_empty:(num,A)finmap) - name == NONE && - result == - ra_op - (ghost_heap_ra (G:(A)ra)) - finmap_empty - (finmap_singleton name (a:A)) - `; - term target_pred = ` - \result:(num,A)finmap. - exists name:num. - result == finmap_singleton name (a:A) - `; - thm allocated = mp_rule( - ispecl_rule( - TERM_LIST( - `G:(A)ra`, - `finmap_empty:(num,A)finmap`, - `a:A`), - GHOST_HEAP_ALLOC), - assume_rule(`ra_valid (G:(A)ra) (a:A)`)); - thm monotone = ispecl_rule( - TERM_LIST( - `ghost_heap_ra (G:(A)ra)`, - `finmap_empty:(num,A)finmap`, - source_pred, - target_pred), - RA_UPDATE_ND_MONO); - monotone = mp_rule(monotone, allocated); - monotone = conv_rule( - depth_conv(get_conversion_by_name("BETA_CONV")), - monotone); - body = MATCH_MP_TAC(body, monotone); - body = GEN_TAC(body, "result"); - body = DISCH_TAC(body, "Hresult"); - body = ASMP_EXISTS_TAC(body, "Hresult", "name"); - body = ASMP_CONJ_TAC( - body, - "Hresult", - "Hempty", - "Hresult_eq"); - body = EXISTS_TAC(body, `name:num`); - thm empty_as_unit = gsym_rule(ispec_rule( - `G:(A)ra`, - GHOST_HEAP_UNIT)); - thm result_eq = rewrite_rule( - THM_LIST( - empty_as_unit, - RA_UNIT_L), - assume_rule(` - (result:(num,A)finmap) == - ra_op - (ghost_heap_ra (G:(A)ra)) - (finmap_empty:(num,A)finmap) - (finmap_singleton (name:num) (a:A)) - `)); - ACCEPT_TAC(body, result_eq); - return gnode_prove(root); -} - -PROOF thm GHOST_HEAP_ALLOC_EMPTY = - prove_ghost_heap_alloc_empty(); - -PROOF static int audit_ghost_heap(void) { - thm_list public_theorems = THM_LIST( - ghost_heap_ra_def, - GHOST_HEAP_UNIT, - GHOST_HEAP_OP_LOOKUP, - GHOST_HEAP_VALID, - GHOST_HEAP_SINGLETON_OP, - GHOST_HEAP_VALID_SINGLETON, - GHOST_HEAP_SINGLETON_UNIT_NE_EMPTY, - GHOST_HEAP_UPDATE_SINGLETON, - GHOST_HEAP_UPDATE_SINGLETON_ND, - GHOST_HEAP_DEALLOC, - GHOST_HEAP_FRESH, - GHOST_HEAP_FRESH_PAIR, - GHOST_HEAP_ALLOC, - GHOST_HEAP_ALLOC_EMPTY); - - for (size_t i = 0; i < vector_size(public_theorems); ++i) { - ENSURE_COND(!IS_NULL(public_theorems[i]), - "ghost-heap theorem %zu is empty", i); - ENSURE_COND(vector_size(hyp(public_theorems[i])) == 0, - "ghost-heap theorem %zu has hypotheses", i); - } - ENSURE_COND(vector_size(get_all_axioms()) == GHOST_HEAP_AXIOMS_BEFORE, - "ghost-heap theory introduced an axiom"); - return 0; -err: - ERR_FUN_PUTS("audit_ghost_heap"); - return -1; -} - -PROOF static int _GHOST_HEAP_AUDIT = audit_ghost_heap(); diff --git a/theory/logic/ghost_heap.h b/theory/logic/ghost_heap.h deleted file mode 100644 index 7d18dbc..0000000 --- a/theory/logic/ghost_heap.h +++ /dev/null @@ -1,131 +0,0 @@ -#pragma once - -/* - * Named ghost heaps over `G=(|G|,ε_G,·_G,valid_G)`, where `G:(A)ra` - * and `|G|=A`. - * - * The carrier is `(num,A)finmap` and - * `ghost_heap_ra G = gmap_ra G`. Consequently each name is interpreted in - * `option_ra G`: `NONE` is unallocated and `SOME a` is allocated with payload - * `a`. In particular, `SOME (ra_unit G)` is not absence. - */ - -#include "proof/theory/logic/gmap_ra.h" - -/* ------------------------------------------------------------------------- */ -/* Core representation */ -/* ------------------------------------------------------------------------- */ - -/* `ghost_heap_ra (G:(A)ra) : ((num,A)finmap)ra = gmap_ra G`. */ -PROOF extern thm ghost_heap_ra_def; - -/* ------------------------------------------------------------------------- */ -/* Constructors and laws */ -/* ------------------------------------------------------------------------- */ - -/* `ra_unit (ghost_heap_ra G) == (finmap_empty:(num,A)finmap)`. */ -PROOF extern thm GHOST_HEAP_UNIT; - -/* - * `finmap_lookup (ra_op (ghost_heap_ra G) h k) name == - * ra_op (option_ra G) (finmap_lookup h name) (finmap_lookup k name)`. - */ -PROOF extern thm GHOST_HEAP_OP_LOOKUP; - -/* ------------------------------------------------------------------------- */ -/* Validity */ -/* ------------------------------------------------------------------------- */ - -/* - * `ra_valid (ghost_heap_ra G) h <=> - * forall name. ra_valid (option_ra G) (finmap_lookup h name)`. - */ -PROOF extern thm GHOST_HEAP_VALID; - -/* ------------------------------------------------------------------------- */ -/* Laws */ -/* ------------------------------------------------------------------------- */ - -/* - * `ra_op (ghost_heap_ra G) (finmap_singleton name a) - * (finmap_singleton name b) == - * finmap_singleton name (ra_op G a b)`. - */ -PROOF extern thm GHOST_HEAP_SINGLETON_OP; - -/* - * `ra_valid (ghost_heap_ra G) (finmap_singleton name a) <=> - * ra_valid G a`. - */ -PROOF extern thm GHOST_HEAP_VALID_SINGLETON; - -/* - * An allocated unit cell is not the heap unit: - * `~(finmap_singleton name (ra_unit G) == finmap_empty)`. - */ -PROOF extern thm GHOST_HEAP_SINGLETON_UNIT_NE_EMPTY; - -/* ------------------------------------------------------------------------- */ -/* Updates */ -/* ------------------------------------------------------------------------- */ - -/* - * `ra_update G a b ==> - * ra_update (ghost_heap_ra G) - * (finmap_singleton name a) (finmap_singleton name b)`. - */ -PROOF extern thm GHOST_HEAP_UPDATE_SINGLETON; - -/* - * `ra_update_nd G a P ==> - * ra_update_nd (ghost_heap_ra G) (finmap_singleton name a) - * (\h. exists b. P b && h == finmap_singleton name b)`. - */ -PROOF extern thm GHOST_HEAP_UPDATE_SINGLETON_ND; - -/* - * Release one completely owned singleton entry: - * - * forall (G:(A)ra) (name:num) (a:A). - * ra_update - * (ghost_heap_ra G) - * (finmap_singleton name a) - * finmap_empty - * - * Compatible hidden frames are retained. In particular, a frame may still - * own another compatible fragment at `name`; only this singleton resource is - * changed to the ghost-heap unit. - */ -PROOF extern thm GHOST_HEAP_DEALLOC; - -/* `forall h. exists name. finmap_lookup h name == NONE`. */ -PROOF extern thm GHOST_HEAP_FRESH; - -/* - * `forall h frame. exists name. - * finmap_lookup h name == NONE && finmap_lookup frame name == NONE`. - */ -PROOF extern thm GHOST_HEAP_FRESH_PAIR; - -/* - * `ra_valid G a ==> - * ra_update_nd (ghost_heap_ra G) h - * (\result. exists name. - * finmap_lookup h name == NONE && - * result == ra_op (ghost_heap_ra G) h - * (finmap_singleton name a))`. - * - * The selected `name` may depend on the hidden frame. The proof can choose it - * absent from both `h` and that frame in order to establish framed validity, - * but the public result predicate exposes only `finmap_lookup h name == NONE` - * and the result equation above; it does not expose frame freshness to a - * caller. - */ -PROOF extern thm GHOST_HEAP_ALLOC; - -/* - * `ra_valid G a ==> - * ra_update_nd (ghost_heap_ra G) finmap_empty - * (\result. exists name. result == finmap_singleton name a)`. - */ -PROOF extern thm GHOST_HEAP_ALLOC_EMPTY; diff --git a/theory/logic/ghost_own.c b/theory/logic/ghost_own.c deleted file mode 100644 index ad74c66..0000000 --- a/theory/logic/ghost_own.c +++ /dev/null @@ -1,225 +0,0 @@ -#include "proof/theory/logic/ghost_own.h" - -#include "proof/proof_backward.h" -#require "proof/proof_backward.c" -#require "proof/theory/logic/ghost_heap.c" -#require "proof/theory/logic/resource_prop.c" - -PROOF static size_t GHOST_OWN_AXIOMS_BEFORE = - vector_size(get_all_axioms()); - -PROOF thm ghost_own_def = new_fun_definition(` - ghost_own - (G:(A)ra) - (name:num) - (a:A) - (heap:(num,A)finmap) <=> - r_own - (ghost_heap_ra G) - (finmap_singleton name a) - heap -`); - -PROOF static thm prove_ghost_own_as_r_own(void) { - term goal_tm = ` - forall (G:(A)ra) (name:num) (a:A). - ghost_own G name a == - r_own - (ghost_heap_ra G) - (finmap_singleton name a) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - thm funext = ispecl_rule( - TERM_LIST( - `ghost_own - (G:(A)ra) - (name:num) - (a:A)`, - `r_own - (ghost_heap_ra (G:(A)ra)) - (finmap_singleton (name:num) (a:A))`), - get_theorem_by_name("FUN_EQ_THM")); - body = CONV_TAC( - body, - once_rewrite_conv(THM_LIST(funext))); - body = GEN_TAC(body, "heap"); - CONV_TAC( - body, - rewrite_conv(THM_LIST(ghost_own_def))); - return gnode_prove(root); -} - -PROOF thm GHOST_OWN_AS_R_OWN = - prove_ghost_own_as_r_own(); - -PROOF static thm prove_ghost_own_op(void) { - term goal_tm = ` - forall (G:(A)ra) (name:num) (a:A) (b:A). - r_sep - (ghost_heap_ra G) - (ghost_own G name a) - (ghost_own G name b) == - ghost_own G name (ra_op G a b) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - - thm own_a = ispecl_rule( - TERM_LIST( - `G:(A)ra`, - `name:num`, - `a:A`), - GHOST_OWN_AS_R_OWN); - thm own_b = ispecl_rule( - TERM_LIST( - `G:(A)ra`, - `name:num`, - `b:A`), - GHOST_OWN_AS_R_OWN); - thm own_combined = ispecl_rule( - TERM_LIST( - `G:(A)ra`, - `name:num`, - `ra_op (G:(A)ra) (a:A) (b:A)`), - GHOST_OWN_AS_R_OWN); - - thm replace_left = beta_rule(ap_term_rule( - `\left_pred:(num,A)finmap->bool. - r_sep - (ghost_heap_ra (G:(A)ra)) - left_pred - (ghost_own G (name:num) (b:A))`, - own_a)); - thm replace_right = beta_rule(ap_term_rule( - `\right_pred:(num,A)finmap->bool. - r_sep - (ghost_heap_ra (G:(A)ra)) - (r_own - (ghost_heap_ra G) - (finmap_singleton (name:num) (a:A))) - right_pred`, - own_b)); - - thm exact_op = gsym_rule(ispecl_rule( - TERM_LIST( - `ghost_heap_ra (G:(A)ra)`, - `finmap_singleton (name:num) (a:A)`, - `finmap_singleton (name:num) (b:A)`), - R_OWN_OP)); - thm heap_op = ispecl_rule( - TERM_LIST( - `G:(A)ra`, - `name:num`, - `a:A`, - `b:A`), - GHOST_HEAP_SINGLETON_OP); - thm replace_owned = beta_rule(ap_term_rule( - `\owned:(num,A)finmap. - r_own (ghost_heap_ra (G:(A)ra)) owned`, - heap_op)); - - thm result = trans_rule( - replace_left, - trans_rule( - replace_right, - trans_rule( - exact_op, - trans_rule( - replace_owned, - gsym_rule(own_combined))))); - ACCEPT_TAC(body, result); - return gnode_prove(root); -} - -PROOF thm GHOST_OWN_OP = - prove_ghost_own_op(); - -PROOF static thm prove_ghost_own_valid(void) { - term goal_tm = ` - forall (G:(A)ra) (name:num) (a:A). - r_entails - (ghost_heap_ra G) - (ghost_own G name a) - (r_and - (ghost_heap_ra G) - (r_pure - (ghost_heap_ra G) - (ra_valid G a)) - (ghost_own G name a)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = CONV_TAC( - root, - pure_rewrite_conv(THM_LIST( - r_entails_def, - ghost_own_def, - r_own_def, - r_and_def, - r_pure_def))); - body = GEN_TAC(body, "G"); - body = GEN_TAC(body, "name"); - body = GEN_TAC(body, "a"); - body = GEN_TAC(body, "heap"); - body = DISCH_TAC(body, "Hvalid_heap"); - body = DISCH_TAC(body, "Howned"); - gnode_list result = CONJ_TAC(body); - - thm validity_eq = ap_term_rule( - `ra_valid - (ghost_heap_ra (G:(A)ra)): - (num,A)finmap->bool`, - assume_rule(` - (heap:(num,A)finmap) == - finmap_singleton (name:num) (a:A) - `)); - thm valid_singleton = eq_mp_rule( - validity_eq, - assume_rule(` - ra_valid - (ghost_heap_ra (G:(A)ra)) - (heap:(num,A)finmap) - `)); - thm singleton_valid_iff = ispecl_rule( - TERM_LIST( - `G:(A)ra`, - `name:num`, - `a:A`), - GHOST_HEAP_VALID_SINGLETON); - ACCEPT_TAC( - result[0], - eq_mp_rule(singleton_valid_iff, valid_singleton)); - ACCEPT_TAC( - result[1], - assume_rule(` - (heap:(num,A)finmap) == - finmap_singleton (name:num) (a:A) - `)); - return gnode_prove(root); -} - -PROOF thm GHOST_OWN_VALID = - prove_ghost_own_valid(); - -PROOF static int audit_ghost_own(void) { - thm_list public_theorems = THM_LIST( - ghost_own_def, - GHOST_OWN_AS_R_OWN, - GHOST_OWN_OP, - GHOST_OWN_VALID); - - for (size_t i = 0; i < vector_size(public_theorems); ++i) { - ENSURE_COND(!IS_NULL(public_theorems[i]), - "ghost ownership theorem %zu is null", i); - ENSURE_COND(vector_size(hyp(public_theorems[i])) == 0, - "ghost ownership theorem %zu has hypotheses", i); - } - ENSURE_COND(vector_size(get_all_axioms()) == GHOST_OWN_AXIOMS_BEFORE, - "ghost ownership theory introduced an axiom"); - return 0; -err: - ERR_FUN_PUTS("audit_ghost_own"); - return -1; -} - -PROOF static int _GHOST_OWN_AUDIT = audit_ghost_own(); diff --git a/theory/logic/ghost_own.h b/theory/logic/ghost_own.h deleted file mode 100644 index 9ba144c..0000000 --- a/theory/logic/ghost_own.h +++ /dev/null @@ -1,42 +0,0 @@ -#pragma once - -/* - * Exact ownership of one named ghost cell. - * - * `ghost_own G name a` is an assertion over `ghost_heap_ra G`; it owns exactly - * `finmap_singleton name a`. It neither absorbs unrelated cells nor turns a - * unit payload into `r_emp`. - */ - -#include "proof/theory/logic/ghost_heap.h" -#include "proof/theory/logic/resource_prop.h" - -/* ------------------------------------------------------------------------- */ -/* Ownership */ -/* ------------------------------------------------------------------------- */ - -/* - * `ghost_own G name a heap <=> - * r_own (ghost_heap_ra G) (finmap_singleton name a) heap`. - */ -PROOF extern thm ghost_own_def; - -/* - * `ghost_own G name a == - * r_own (ghost_heap_ra G) (finmap_singleton name a)`. - */ -PROOF extern thm GHOST_OWN_AS_R_OWN; - -/* - * `r_sep (ghost_heap_ra G) (ghost_own G name a) (ghost_own G name b) == - * ghost_own G name (ra_op G a b)`. - */ -PROOF extern thm GHOST_OWN_OP; - -/* - * `ghost_own G name a ⊢_(ghost_heap_ra G) - * r_and (ghost_heap_ra G) - * (r_pure (ghost_heap_ra G) (ra_valid G a)) - * (ghost_own G name a)`. - */ -PROOF extern thm GHOST_OWN_VALID; diff --git a/theory/logic/ghost_update.c b/theory/logic/ghost_update.c deleted file mode 100644 index e05e85b..0000000 --- a/theory/logic/ghost_update.c +++ /dev/null @@ -1,537 +0,0 @@ -#include "proof/theory/logic/ghost_update.h" - -#include "proof/proof_backward.h" -#require "proof/proof_backward.c" -#require "proof/theory/logic/basic_update.c" -#require "proof/theory/logic/ghost_heap.c" -#require "proof/theory/logic/ghost_own.c" - -PROOF static size_t GHOST_UPDATE_AXIOMS_BEFORE = - vector_size(get_all_axioms()); - -PROOF static thm prove_ghost_own_update(void) { - term goal_tm = ` - forall (G:(A)ra) (name:num) (a:A) (b:A). - ra_update G a b ==> - r_viewshift - (ghost_heap_ra G) - (ghost_own G name a) - (ghost_own G name b) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - - thm heap_update = mp_rule( - ispecl_rule( - TERM_LIST( - `G:(A)ra`, - `name:num`, - `a:A`, - `b:A`), - GHOST_HEAP_UPDATE_SINGLETON), - assume_rule(`ra_update (G:(A)ra) (a:A) (b:A)`)); - thm logical_update = mp_rule( - ispecl_rule( - TERM_LIST( - `ghost_heap_ra (G:(A)ra)`, - `finmap_singleton (name:num) (a:A)`, - `finmap_singleton (name:num) (b:A)`), - R_OWN_UPDATE), - heap_update); - - thm own_a = gsym_rule(ispecl_rule( - TERM_LIST( - `G:(A)ra`, - `name:num`, - `a:A`), - GHOST_OWN_AS_R_OWN)); - thm pre_eq = beta_rule(ap_term_rule( - `\pre:(num,A)finmap->bool. - r_viewshift - (ghost_heap_ra (G:(A)ra)) - pre - (r_own - (ghost_heap_ra G) - (finmap_singleton (name:num) (b:A)))`, - own_a)); - thm pre_changed = eq_mp_rule(pre_eq, logical_update); - - thm own_b = gsym_rule(ispecl_rule( - TERM_LIST( - `G:(A)ra`, - `name:num`, - `b:A`), - GHOST_OWN_AS_R_OWN)); - thm post_eq = beta_rule(ap_term_rule( - `\post:(num,A)finmap->bool. - r_viewshift - (ghost_heap_ra (G:(A)ra)) - (ghost_own G (name:num) (a:A)) - post`, - own_b)); - ACCEPT_TAC(body, eq_mp_rule(post_eq, pre_changed)); - return gnode_prove(root); -} - -PROOF thm GHOST_OWN_UPDATE = - prove_ghost_own_update(); - -PROOF static thm prove_ghost_own_update_nd(void) { - term goal_tm = ` - forall - (G:(A)ra) - (name:num) - (a:A) - (result_pred:A->bool). - ra_update_nd G a result_pred ==> - r_viewshift - (ghost_heap_ra G) - (ghost_own G name a) - (r_exists - (ghost_heap_ra G) - (\selected:A. - r_and - (ghost_heap_ra G) - (r_pure - (ghost_heap_ra G) - (result_pred selected)) - (ghost_own G name selected))) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = CONV_TAC( - root, - pure_rewrite_conv(THM_LIST( - r_viewshift_def, - r_entails_def, - r_bupd_def, - ghost_own_def, - r_own_def, - r_exists_def, - r_and_def, - r_pure_def))); - body = CONV_TAC( - body, - depth_conv(get_conversion_by_name("BETA_CONV"))); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST( - ghost_own_def, - r_own_def))); - body = CONV_TAC( - body, - depth_conv(get_conversion_by_name("BETA_CONV"))); - body = GEN_TAC(body, "G"); - body = GEN_TAC(body, "name"); - body = GEN_TAC(body, "a"); - body = GEN_TAC(body, "result_pred"); - body = DISCH_TAC(body, "Hlocal_update"); - body = GEN_TAC(body, "owned_heap"); - body = DISCH_TAC(body, "Hvalid_owned_heap"); - body = DISCH_TAC(body, "Howned"); - body = CONV_TAC( - body, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); - body = GEN_TAC(body, "frame"); - body = DISCH_TAC(body, "Hvalid_source"); - - thm heap_update = mp_rule( - ispecl_rule( - TERM_LIST( - `G:(A)ra`, - `name:num`, - `a:A`, - `result_pred:A->bool`), - GHOST_HEAP_UPDATE_SINGLETON_ND), - assume_rule(` - ra_update_nd - (G:(A)ra) - (a:A) - (result_pred:A->bool) - `)); - thm unfolded_heap_update = rewrite_rule( - THM_LIST(ra_update_nd_def), - heap_update); - - thm replace_owned = beta_rule(ap_term_rule( - `\base:(num,A)finmap. - ra_op - (ghost_heap_ra (G:(A)ra)) - base - (frame:(num,A)finmap)`, - assume_rule(` - (owned_heap:(num,A)finmap) == - finmap_singleton (name:num) (a:A) - `))); - thm source_validity_eq = ap_term_rule( - `ra_valid - (ghost_heap_ra (G:(A)ra)): - (num,A)finmap->bool`, - replace_owned); - thm valid_singleton_source = eq_mp_rule( - source_validity_eq, - assume_rule(` - ra_valid - (ghost_heap_ra (G:(A)ra)) - (ra_op - (ghost_heap_ra G) - (owned_heap:(num,A)finmap) - (frame:(num,A)finmap)) - `)); - thm selected = mp_rule( - spec_rule(`frame:(num,A)finmap`, unfolded_heap_update), - valid_singleton_source); - body = ASSUME_TAC(body, selected, "Hselected"); - body = ASMP_EXISTS_TAC(body, "Hselected", "result_heap"); - body = ASMP_CONJ_TAC( - body, - "Hselected", - "Hresult", - "Hvalid_result"); - - body = EXISTS_TAC(body, `result_heap:(num,A)finmap`); - gnode_list result = CONJ_TAC(body); - gnode post = CONV_TAC( - result[0], - pure_rewrite_conv(THM_LIST( - r_exists_def, - r_and_def, - r_pure_def, - ghost_own_def, - r_own_def))); - post = CONV_TAC( - post, - depth_conv(get_conversion_by_name("BETA_CONV"))); - post = CONV_TAC( - post, - pure_rewrite_conv(THM_LIST( - r_and_def, - r_pure_def, - ghost_own_def, - r_own_def))); - post = CONV_TAC( - post, - depth_conv(get_conversion_by_name("BETA_CONV"))); - ACCEPT_TAC( - post, - assume_rule(` - exists selected:A. - (result_pred:A->bool) selected && - (result_heap:(num,A)finmap) == - finmap_singleton (name:num) selected - `)); - ACCEPT_TAC( - result[1], - assume_rule(` - ra_valid - (ghost_heap_ra (G:(A)ra)) - (ra_op - (ghost_heap_ra G) - (result_heap:(num,A)finmap) - (frame:(num,A)finmap)) - `)); - return gnode_prove(root); -} - -PROOF thm GHOST_OWN_UPDATE_ND = - prove_ghost_own_update_nd(); - -PROOF static thm prove_ghost_own_alloc_empty(void) { - term goal_tm = ` - forall (G:(A)ra) (a:A). - ra_valid G a ==> - r_viewshift - (ghost_heap_ra G) - (r_emp (ghost_heap_ra G)) - (r_exists - (ghost_heap_ra G) - (\name:num. - ghost_own G name a)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = CONV_TAC( - root, - pure_rewrite_conv(THM_LIST( - r_viewshift_def, - r_entails_def, - r_bupd_def, - r_emp_def, - r_exists_def, - ghost_own_def, - r_own_def))); - body = CONV_TAC( - body, - depth_conv(get_conversion_by_name("BETA_CONV"))); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST( - ghost_own_def, - r_own_def))); - body = CONV_TAC( - body, - depth_conv(get_conversion_by_name("BETA_CONV"))); - body = GEN_TAC(body, "G"); - body = GEN_TAC(body, "a"); - body = DISCH_TAC(body, "Hvalid_a"); - body = GEN_TAC(body, "owned_heap"); - body = DISCH_TAC(body, "Hvalid_owned_heap"); - body = DISCH_TAC(body, "Hemp"); - body = CONV_TAC( - body, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); - body = GEN_TAC(body, "frame"); - body = DISCH_TAC(body, "Hvalid_source"); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST( - r_exists_def, - ghost_own_def, - r_own_def))); - body = CONV_TAC( - body, - depth_conv(get_conversion_by_name("BETA_CONV"))); - body = CONV_TAC( - body, - pure_rewrite_conv(THM_LIST( - ghost_own_def, - r_own_def))); - body = CONV_TAC( - body, - depth_conv(get_conversion_by_name("BETA_CONV"))); - - thm allocation = mp_rule( - ispecl_rule( - TERM_LIST( - `G:(A)ra`, - `a:A`), - GHOST_HEAP_ALLOC_EMPTY), - assume_rule(`ra_valid (G:(A)ra) (a:A)`)); - thm unfolded_allocation = rewrite_rule( - THM_LIST(ra_update_nd_def), - allocation); - - thm owned_eq_empty = trans_rule( - assume_rule(` - (owned_heap:(num,A)finmap) == - ra_unit (ghost_heap_ra (G:(A)ra)) - `), - ispec_rule(`G:(A)ra`, GHOST_HEAP_UNIT)); - thm replace_owned = beta_rule(ap_term_rule( - `\base:(num,A)finmap. - ra_op - (ghost_heap_ra (G:(A)ra)) - base - (frame:(num,A)finmap)`, - owned_eq_empty)); - thm source_validity_eq = ap_term_rule( - `ra_valid - (ghost_heap_ra (G:(A)ra)): - (num,A)finmap->bool`, - replace_owned); - thm valid_empty_source = eq_mp_rule( - source_validity_eq, - assume_rule(` - ra_valid - (ghost_heap_ra (G:(A)ra)) - (ra_op - (ghost_heap_ra G) - (owned_heap:(num,A)finmap) - (frame:(num,A)finmap)) - `)); - thm selected = mp_rule( - spec_rule( - `frame:(num,A)finmap`, - unfolded_allocation), - valid_empty_source); - ACCEPT_TAC(body, selected); - return gnode_prove(root); -} - -PROOF thm GHOST_OWN_ALLOC_EMPTY = - prove_ghost_own_alloc_empty(); - -PROOF static thm prove_ghost_own_alloc(void) { - term goal_tm = ` - forall - (G:(A)ra) - (a:A) - (P:(num,A)finmap->bool). - ra_valid G a ==> - r_viewshift - (ghost_heap_ra G) - P - (r_exists - (ghost_heap_ra G) - (\name:num. - r_sep - (ghost_heap_ra G) - (ghost_own G name a) - P)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = CONV_TAC( - root, - pure_rewrite_conv(THM_LIST( - r_viewshift_def, - r_entails_def, - r_bupd_def, - r_exists_def, - r_sep_def, - ghost_own_def, - r_own_def))); - body = CONV_TAC( - body, - depth_conv(get_conversion_by_name("BETA_CONV"))); - body = GEN_TAC(body, "G"); - body = GEN_TAC(body, "a"); - body = GEN_TAC(body, "P"); - body = DISCH_TAC(body, "Hvalid_a"); - body = GEN_TAC(body, "owned_heap"); - body = DISCH_TAC(body, "Hvalid_owned_heap"); - body = DISCH_TAC(body, "HP"); - body = CONV_TAC( - body, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); - body = GEN_TAC(body, "frame"); - body = DISCH_TAC(body, "Hvalid_source"); - - thm allocation = mp_rule( - ispecl_rule( - TERM_LIST( - `G:(A)ra`, - `owned_heap:(num,A)finmap`, - `a:A`), - GHOST_HEAP_ALLOC), - assume_rule(`ra_valid (G:(A)ra) (a:A)`)); - thm unfolded_allocation = rewrite_rule( - THM_LIST(ra_update_nd_def), - allocation); - thm selected = mp_rule( - spec_rule( - `frame:(num,A)finmap`, - unfolded_allocation), - assume_rule(` - ra_valid - (ghost_heap_ra (G:(A)ra)) - (ra_op - (ghost_heap_ra G) - (owned_heap:(num,A)finmap) - (frame:(num,A)finmap)) - `)); - body = ASSUME_TAC(body, selected, "Hselected"); - body = ASMP_EXISTS_TAC(body, "Hselected", "result_heap"); - body = ASMP_CONJ_TAC( - body, - "Hselected", - "Hallocated", - "Hvalid_result"); - body = ASMP_EXISTS_TAC(body, "Hallocated", "name"); - body = ASMP_CONJ_TAC( - body, - "Hallocated", - "Hfresh", - "Hresult_eq"); - - body = EXISTS_TAC(body, `result_heap:(num,A)finmap`); - gnode_list result = CONJ_TAC(body); - - gnode post = CONV_TAC( - result[0], - pure_rewrite_conv(THM_LIST( - r_exists_def, - r_sep_def, - ghost_own_def, - r_own_def))); - post = CONV_TAC( - post, - depth_conv(get_conversion_by_name("BETA_CONV"))); - post = CONV_TAC( - post, - pure_rewrite_conv(THM_LIST( - r_sep_def, - ghost_own_def, - r_own_def))); - post = CONV_TAC( - post, - depth_conv(get_conversion_by_name("BETA_CONV"))); - post = CONV_TAC( - post, - pure_rewrite_conv(THM_LIST( - ghost_own_def, - r_own_def))); - post = CONV_TAC( - post, - depth_conv(get_conversion_by_name("BETA_CONV"))); - post = EXISTS_TAC(post, `name:num`); - post = EXISTS_TAC( - post, - `finmap_singleton (name:num) (a:A)`); - post = EXISTS_TAC( - post, - `owned_heap:(num,A)finmap`); - gnode_list post1 = CONJ_TAC(post); - - thm result_eq = assume_rule(` - (result_heap:(num,A)finmap) == - ra_op - (ghost_heap_ra (G:(A)ra)) - (owned_heap:(num,A)finmap) - (finmap_singleton (name:num) (a:A)) - `); - thm op_commuted = trans_rule( - result_eq, - ispecl_rule( - TERM_LIST( - `ghost_heap_ra (G:(A)ra)`, - `owned_heap:(num,A)finmap`, - `finmap_singleton (name:num) (a:A)`), - RA_COMM)); - ACCEPT_TAC(post1[0], op_commuted); - gnode_list post2 = CONJ_TAC(post1[1]); - ACCEPT_TAC( - post2[0], - refl_rule(`finmap_singleton (name:num) (a:A)`)); - ACCEPT_TAC( - post2[1], - assume_rule(` - (P:(num,A)finmap->bool) - (owned_heap:(num,A)finmap) - `)); - - ACCEPT_TAC( - result[1], - assume_rule(` - ra_valid - (ghost_heap_ra (G:(A)ra)) - (ra_op - (ghost_heap_ra G) - (result_heap:(num,A)finmap) - (frame:(num,A)finmap)) - `)); - return gnode_prove(root); -} - -PROOF thm GHOST_OWN_ALLOC = - prove_ghost_own_alloc(); - -PROOF static int audit_ghost_update(void) { - thm_list public_theorems = THM_LIST( - GHOST_OWN_UPDATE, - GHOST_OWN_UPDATE_ND, - GHOST_OWN_ALLOC_EMPTY, - GHOST_OWN_ALLOC); - - for (size_t i = 0; i < vector_size(public_theorems); ++i) { - ENSURE_COND(!IS_NULL(public_theorems[i]), - "ghost-update theorem %zu is null", i); - ENSURE_COND(vector_size(hyp(public_theorems[i])) == 0, - "ghost-update theorem %zu has hypotheses", i); - } - ENSURE_COND(vector_size(get_all_axioms()) == GHOST_UPDATE_AXIOMS_BEFORE, - "ghost-update theory introduced an axiom"); - return 0; -err: - ERR_FUN_PUTS("audit_ghost_update"); - return -1; -} - -PROOF static int _GHOST_UPDATE_AUDIT = audit_ghost_update(); diff --git a/theory/logic/ghost_update.h b/theory/logic/ghost_update.h deleted file mode 100644 index 7ea7b5a..0000000 --- a/theory/logic/ghost_update.h +++ /dev/null @@ -1,50 +0,0 @@ -#pragma once - -/* - * View-shift rules for named ghost ownership. - * - * Every conclusion below is a view shift `P ⇛_(ghost_heap_ra G) Q`. - * Fixed-name rules preserve the name. Allocation existentially returns a - * `num` selected after the hidden frame is known and exposes ownership at that - * name; its target contains no separate pure freshness proposition. - */ - -#include "proof/theory/logic/basic_update.h" -#include "proof/theory/logic/ghost_heap.h" -#include "proof/theory/logic/ghost_own.h" - -/* ------------------------------------------------------------------------- */ -/* Ownership updates */ -/* ------------------------------------------------------------------------- */ - -/* - * `ra_update G a b ==> - * r_viewshift (ghost_heap_ra G) - * (ghost_own G name a) (ghost_own G name b)`. - */ -PROOF extern thm GHOST_OWN_UPDATE; - -/* - * `ra_update_nd G a P ==> - * r_viewshift (ghost_heap_ra G) (ghost_own G name a) - * (r_exists (ghost_heap_ra G) - * (\b. r_and (ghost_heap_ra G) - * (r_pure (ghost_heap_ra G) (P b)) - * (ghost_own G name b)))`. - */ -PROOF extern thm GHOST_OWN_UPDATE_ND; - -/* - * `ra_valid G a ==> - * r_viewshift (ghost_heap_ra G) (r_emp (ghost_heap_ra G)) - * (r_exists (ghost_heap_ra G) (\name. ghost_own G name a))`. - */ -PROOF extern thm GHOST_OWN_ALLOC_EMPTY; - -/* - * `ra_valid G a ==> - * r_viewshift (ghost_heap_ra G) P - * (r_exists (ghost_heap_ra G) - * (\name. r_sep (ghost_heap_ra G) (ghost_own G name a) P))`. - */ -PROOF extern thm GHOST_OWN_ALLOC; diff --git a/theory/logic/gmap_ra.c b/theory/logic/gmap_ra.c index e5b105e..2b38734 100644 --- a/theory/logic/gmap_ra.c +++ b/theory/logic/gmap_ra.c @@ -1,5 +1,7 @@ #include "proof/theory/logic/gmap_ra.h" +#include "proof/theory/logic/option_ra_internal.h" #include "proof/theory/logic/ra_builder.h" +#include "proof/theory/logic/ra_internal.h" #include "proof/proof_backward.h" #require "proof/proof_backward.c" @@ -328,14 +330,15 @@ PROOF static thm prove_gmap_valid_op_l(void) { source_valid = rewrite_rule( THM_LIST(GMAP_OP_LOOKUP), source_valid); - thm left_valid = mp_rule( + thm both_valid = mp_rule( ispecl_rule( TERM_LIST( `option_ra (R:(V)ra)`, `finmap_lookup (m:(K,V)finmap) (k:K)`, `finmap_lookup (n:(K,V)finmap) (k:K)`), - RA_VALID_OP_L), + RA_VALID_OP), source_valid); + thm left_valid = conjunct1_rule(both_valid); ACCEPT_TAC(body, left_valid); return gnode_prove(root); } @@ -1985,324 +1988,6 @@ PROOF static thm prove_gmap_ra_included_dom(void) { PROOF thm GMAP_RA_INCLUDED_DOM = prove_gmap_ra_included_dom(); -PROOF static thm prove_gmap_ra_local_update_singleton(void) { - term goal_tm = ` - forall - (R:(V)ra) - (key:K) - (a:V) - (f:V) - (b:V) - (g:V). - ra_local_update R (a,f) (b,g) ==> - ra_local_update - (gmap_ra R) - (finmap_singleton key a,finmap_singleton key f) - (finmap_singleton key b,finmap_singleton key g) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - body = CONV_TAC( - body, - once_rewrite_conv(THM_LIST(ra_local_update_def))); - body = CONV_TAC( - body, - rewrite_conv(THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")))); - body = AUTO_INTROS_TAC(body); - - thm source_all = eq_mp_rule( - ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `finmap_singleton (key:K) (a:V)`), - GMAP_RA_VALID), - assume_rule(` - ra_valid - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) - (finmap_singleton (key:K) (a:V)) - `)); - thm source_key_valid = rewrite_rule( - THM_LIST(FINMAP_SINGLETON_LOOKUP), - spec_rule(`key:K`, source_all)); - - thm source_key_eq = beta_rule(ap_term_rule( - `\m:(K,V)finmap. finmap_lookup m (key:K)`, - assume_rule(` - (finmap_singleton (key:K) (a:V)) == - ra_op - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) - (finmap_singleton key (f:V)) - (frame:(K,V)finmap) - `))); - source_key_eq = rewrite_rule( - THM_LIST( - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP), - source_key_eq); - - thm option_local = mp_rule( - ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `a:V`, - `f:V`, - `b:V`, - `g:V`), - OPTION_RA_LOCAL_UPDATE_SOME), - assume_rule(` - ra_local_update - (R:(V)ra) - ((a:V),(f:V)) - ((b:V),(g:V)) - `)); - thm option_apply = rewrite_rule( - THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")), - ispecl_rule( - TERM_LIST( - `option_ra (R:(V)ra)`, - `(SOME (a:V),SOME (f:V))`, - `(SOME (b:V),SOME (g:V))`, - `finmap_lookup - (frame:(K,V)finmap) - (key:K)`), - RA_LOCAL_UPDATE_APPLY)); - thm option_result = mp_rule( - mp_rule( - mp_rule( - option_apply, - option_local), - source_key_valid), - source_key_eq); - body = ASSUME_TAC( - body, - conjunct1_rule(option_result), - "Htarget_key_valid"); - body = ASSUME_TAC( - body, - conjunct2_rule(option_result), - "Htarget_key_eq"); - - gnode_list result = CONJ_TAC(body); - - gnode target_valid = CONV_TAC( - result[0], - once_rewrite_conv(THM_LIST(GMAP_RA_VALID))); - target_valid = GEN_TAC(target_valid, "query"); - gnode_list valid_cases = BOOL_CASES_TAC( - target_valid, `(query:K) == (key:K)`, "Hkey"); - for (size_t i = 0; i < vector_size(valid_cases); ++i) { - thm branch = i == 0 - ? assume_rule(`(query:K) == (key:K)`) - : assume_rule(`~((query:K) == (key:K))`); - gnode reduced = CONV_TAC( - valid_cases[i], - rewrite_conv(THM_LIST( - branch, - FINMAP_SINGLETON_LOOKUP))); - if (i == 0) { - ACCEPT_TAC( - reduced, - assume_rule(` - ra_valid - (option_ra (R:(V)ra)) - (SOME (b:V)) - `)); - } else { - ACCEPT_TAC( - reduced, - ispec_rule(`R:(V)ra`, OPTION_RA_VALID_NONE)); - } - } - - gnode target_eq = CONV_TAC( - result[1], - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); - target_eq = GEN_TAC(target_eq, "query"); - gnode_list eq_cases = BOOL_CASES_TAC( - target_eq, `(query:K) == (key:K)`, "Hkey"); - for (size_t i = 0; i < vector_size(eq_cases); ++i) { - thm branch = i == 0 - ? assume_rule(`(query:K) == (key:K)`) - : assume_rule(`~((query:K) == (key:K))`); - gnode reduced = CONV_TAC( - eq_cases[i], - rewrite_conv(THM_LIST( - branch, - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP, - OPTION_RA_OP_NONE_L))); - if (i == 0) { - thm target_key_eq = rewrite_rule( - THM_LIST(branch), - assume_rule(` - SOME (b:V) == - ra_op - (option_ra (R:(V)ra)) - (SOME (g:V)) - (finmap_lookup - (frame:(K,V)finmap) - (key:K)) - `)); - ACCEPT_TAC(reduced, target_key_eq); - } else { - thm source_at = beta_rule(ap_term_rule( - `\m:(K,V)finmap. finmap_lookup m (query:K)`, - assume_rule(` - (finmap_singleton (key:K) (a:V)) == - ra_op - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) - (finmap_singleton key (f:V)) - (frame:(K,V)finmap) - `))); - source_at = rewrite_rule( - THM_LIST( - branch, - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP, - OPTION_RA_OP_NONE_L), - source_at); - ACCEPT_TAC(reduced, source_at); - } - } - return gnode_prove(root); -} - -PROOF thm GMAP_RA_LOCAL_UPDATE_SINGLETON = - prove_gmap_ra_local_update_singleton(); - -PROOF static thm prove_gmap_ra_local_update_singleton_iff(void) { - term goal_tm = ` - forall - (R:(V)ra) - (key:K) - (a:V) - (f:V) - (b:V) - (g:V). - ra_local_update - (gmap_ra R) - (finmap_singleton key a,finmap_singleton key f) - (finmap_singleton key b,finmap_singleton key g) <=> - ra_local_update R (a,f) (b,g) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - gnode_list directions = EQ_TAC(body); - - gnode forward = DISCH_TAC(directions[0], "Hmap_local"); - forward = CONV_TAC( - forward, - once_rewrite_conv(THM_LIST(ra_local_update_def))); - forward = CONV_TAC( - forward, - rewrite_conv(THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")))); - forward = AUTO_INTROS_TAC(forward); - - thm source_map_valid = eq_mp_rule( - gsym_rule(ispecl_rule( - TERM_LIST(`R:(V)ra`, `key:K`, `a:V`), - GMAP_RA_VALID_SINGLETON)), - assume_rule(`ra_valid (R:(V)ra) (a:V)`)); - thm source_singleton_eq = beta_rule(ap_term_rule( - `\x:V. finmap_singleton (key:K) x`, - assume_rule(` - (a:V) == ra_op (R:(V)ra) (f:V) (frame:V) - `))); - thm source_op = ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `f:V`, - `frame:V`), - GMAP_RA_SINGLETON_OP); - thm source_map_eq = trans_rule( - source_singleton_eq, - gsym_rule(source_op)); - - thm map_apply = rewrite_rule( - THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")), - ispecl_rule( - TERM_LIST( - `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, - `(finmap_singleton (key:K) (a:V), - finmap_singleton key (f:V))`, - `(finmap_singleton (key:K) (b:V), - finmap_singleton key (g:V))`, - `finmap_singleton (key:K) (frame:V)`), - RA_LOCAL_UPDATE_APPLY)); - thm map_result = mp_rule( - mp_rule( - mp_rule( - map_apply, - assume_rule(` - ra_local_update - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) - (finmap_singleton (key:K) (a:V), - finmap_singleton key (f:V)) - (finmap_singleton key (b:V), - finmap_singleton key (g:V)) - `)), - source_map_valid), - source_map_eq); - - thm target_base_valid = eq_mp_rule( - ispecl_rule( - TERM_LIST(`R:(V)ra`, `key:K`, `b:V`), - GMAP_RA_VALID_SINGLETON), - conjunct1_rule(map_result)); - thm target_lookup_eq = beta_rule(ap_term_rule( - `\m:(K,V)finmap. finmap_lookup m (key:K)`, - conjunct2_rule(map_result))); - target_lookup_eq = rewrite_rule( - THM_LIST( - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP, - OPTION_RA_OP_SOME_SOME), - target_lookup_eq); - thm target_base_eq = eq_mp_rule( - ispecl_rule( - TERM_LIST( - `b:V`, - `ra_op (R:(V)ra) (g:V) (frame:V)`), - OPTION_RA_SOME_INJ), - target_lookup_eq); - ACCEPT_TAC( - forward, - conj_rule(target_base_valid, target_base_eq)); - - gnode reverse = DISCH_TAC(directions[1], "Hbase_local"); - ACCEPT_TAC( - reverse, - mp_rule( - ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `a:V`, - `f:V`, - `b:V`, - `g:V`), - GMAP_RA_LOCAL_UPDATE_SINGLETON), - assume_rule(` - ra_local_update - (R:(V)ra) - ((a:V),(f:V)) - ((b:V),(g:V)) - `))); - return gnode_prove(root); -} - -PROOF thm GMAP_RA_LOCAL_UPDATE_SINGLETON_IFF = - prove_gmap_ra_local_update_singleton_iff(); - /* Lift an existing-key base local update while retaining the original map at * every other key. The proof applies the option local update to the selected * lookup and reuses the source decomposition pointwise elsewhere. */ @@ -2315,11 +2000,13 @@ PROOF static thm prove_gmap_ra_local_update_at(void) { (b:V) (g:V) (m:(K,V)finmap). finmap_lookup m key == SOME a ==> - ra_local_update R (a,f) (b,g) ==> + ra_local_update R a f b g ==> ra_local_update (gmap_ra R) - (m,finmap_singleton key f) - (finmap_insert key b m,finmap_singleton key g) + m + (finmap_singleton key f) + (finmap_insert key b m) + (finmap_singleton key g) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); @@ -2355,7 +2042,7 @@ PROOF static thm prove_gmap_ra_local_update_at(void) { ra_op ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) (finmap_singleton (key:K) (f:V)) - (frame:(K,V)finmap) + (residual:(K,V)finmap) `))); source_key_eq = rewrite_rule( THM_LIST( @@ -2366,34 +2053,34 @@ PROOF static thm prove_gmap_ra_local_update_at(void) { FINMAP_SINGLETON_LOOKUP), source_key_eq); - thm option_local = mp_rule( - ispecl_rule( + thm option_local = eq_mp_rule( + gsym_rule(ispecl_rule( TERM_LIST( `R:(V)ra`, `a:V`, `f:V`, `b:V`, `g:V`), - OPTION_RA_LOCAL_UPDATE_SOME), + OPTION_RA_LOCAL_UPDATE_IFF)), assume_rule(` ra_local_update (R:(V)ra) - ((a:V),(f:V)) - ((b:V),(g:V)) + (a:V) + (f:V) + (b:V) + (g:V) `)); - thm option_apply = rewrite_rule( - THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")), - ispecl_rule( - TERM_LIST( - `option_ra (R:(V)ra)`, - `(SOME (a:V),SOME (f:V))`, - `(SOME (b:V),SOME (g:V))`, - `finmap_lookup - (frame:(K,V)finmap) - (key:K)`), - RA_LOCAL_UPDATE_APPLY)); + thm option_apply = ispecl_rule( + TERM_LIST( + `option_ra (R:(V)ra)`, + `SOME (a:V)`, + `SOME (f:V)`, + `SOME (b:V)`, + `SOME (g:V)`, + `finmap_lookup + (residual:(K,V)finmap) + (key:K)`), + RA_LOCAL_UPDATE_APPLY); thm option_result = mp_rule( mp_rule( mp_rule(option_apply, option_local), @@ -2461,7 +2148,7 @@ PROOF static thm prove_gmap_ra_local_update_at(void) { ra_op ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) (finmap_singleton (key:K) (f:V)) - (frame:(K,V)finmap) + (residual:(K,V)finmap) `))); source_at = rewrite_rule( THM_LIST( @@ -2479,245 +2166,6 @@ PROOF static thm prove_gmap_ra_local_update_at(void) { PROOF thm GMAP_RA_LOCAL_UPDATE_AT = prove_gmap_ra_local_update_at(); -/* Reify one arbitrary base residual as a map residual: it occupies the - * selected key, while the deleted source map supplies every other lookup. */ -PROOF static thm prove_gmap_ra_local_source_frame(void) { - term goal_tm = ` - forall - (R:(V)ra) - (key:K) - (a:V) (f:V) - (m:(K,V)finmap) - (frame:V). - finmap_lookup m key == SOME a ==> - a == ra_op R f frame ==> - m == - ra_op - (gmap_ra R) - (finmap_singleton key f) - (finmap_insert key frame (finmap_delete key m)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - body = CONV_TAC( - body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); - body = GEN_TAC(body, "query"); - gnode_list query_cases = BOOL_CASES_TAC( - body, `(query:K) == (key:K)`, "Hkey"); - for (size_t i = 0; i < vector_size(query_cases); ++i) { - thm branch = i == 0 - ? assume_rule(`(query:K) == (key:K)`) - : assume_rule(`~((query:K) == (key:K))`); - CONV_WITH_ASMP_TAC( - query_cases[i], - rewrite_conv, - THM_LIST( - branch, - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP, - FINMAP_INSERT_LOOKUP, - FINMAP_DELETE_LOOKUP, - OPTION_RA_OP_NONE_L, - OPTION_RA_OP_SOME_SOME)); - } - return gnode_prove(root); -} - -PROOF static thm GMAP_RA_LOCAL_SOURCE_FRAME = - prove_gmap_ra_local_source_frame(); - -/* The converse exposes the validity boundary of local updates. For a valid - * map source, every base residual can be embedded as the selected lookup of a - * map residual. For an invalid source, the map local update is vacuous. */ -PROOF static thm prove_gmap_ra_local_update_at_iff(void) { - term goal_tm = ` - forall - (R:(V)ra) - (key:K) - (a:V) (f:V) - (b:V) (g:V) - (m:(K,V)finmap). - finmap_lookup m key == SOME a ==> - (ra_local_update - (gmap_ra R) - (m,finmap_singleton key f) - (finmap_insert key b m,finmap_singleton key g) <=> - (ra_valid (gmap_ra R) m ==> - ra_local_update R (a,f) (b,g))) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - gnode_list directions = EQ_TAC(body); - - gnode forward = DISCH_TAC(directions[0], "Hmap_local"); - forward = DISCH_TAC(forward, "Hvalid_map"); - forward = CONV_TAC( - forward, - once_rewrite_conv(THM_LIST(ra_local_update_def))); - forward = CONV_TAC( - forward, - rewrite_conv(THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")))); - forward = AUTO_INTROS_TAC(forward); - - term map_frame = ` - finmap_insert - (key:K) - (frame:V) - (finmap_delete key (m:(K,V)finmap)) - `; - thm source_map_eq = ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `a:V`, - `f:V`, - `m:(K,V)finmap`, - `frame:V`), - GMAP_RA_LOCAL_SOURCE_FRAME); - source_map_eq = mp_rule( - source_map_eq, - assume_rule(` - finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) - `)); - source_map_eq = mp_rule( - source_map_eq, - assume_rule(` - (a:V) == ra_op (R:(V)ra) (f:V) (frame:V) - `)); - - thm map_apply = rewrite_rule( - THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")), - ispecl_rule( - TERM_LIST( - `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, - `((m:(K,V)finmap),finmap_singleton (key:K) (f:V))`, - `(finmap_insert (key:K) (b:V) (m:(K,V)finmap), - finmap_singleton key (g:V))`, - map_frame), - RA_LOCAL_UPDATE_APPLY)); - thm map_result = mp_rule( - mp_rule( - mp_rule( - map_apply, - assume_rule(` - ra_local_update - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) - ((m:(K,V)finmap),finmap_singleton (key:K) (f:V)) - (finmap_insert key (b:V) m, - finmap_singleton key (g:V)) - `)), - assume_rule(` - ra_valid - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) - (m:(K,V)finmap) - `)), - source_map_eq); - - thm target_base_valid = ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `b:V`, - `finmap_insert (key:K) (b:V) (m:(K,V)finmap)`), - GMAP_RA_VALID_LOOKUP); - target_base_valid = mp_rule( - target_base_valid, - conjunct1_rule(map_result)); - target_base_valid = mp_rule( - target_base_valid, - ispecl_rule( - TERM_LIST(`key:K`, `b:V`, `m:(K,V)finmap`), - FINMAP_INSERT_LOOKUP_EQ)); - - thm target_lookup_eq = beta_rule(ap_term_rule( - `\whole:(K,V)finmap. finmap_lookup whole (key:K)`, - conjunct2_rule(map_result))); - target_lookup_eq = rewrite_rule( - THM_LIST( - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP, - FINMAP_INSERT_LOOKUP, - OPTION_RA_OP_SOME_SOME), - target_lookup_eq); - thm target_base_eq = eq_mp_rule( - ispecl_rule( - TERM_LIST( - `b:V`, - `ra_op (R:(V)ra) (g:V) (frame:V)`), - OPTION_RA_SOME_INJ), - target_lookup_eq); - ACCEPT_TAC( - forward, - conj_rule(target_base_valid, target_base_eq)); - - gnode reverse = DISCH_TAC(directions[1], "Hbase_guard"); - gnode_list validity_cases = BOOL_CASES_TAC( - reverse, - `ra_valid - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) - (m:(K,V)finmap)`, - "Hvalid_map"); - - thm base_local = mp_rule( - assume_rule(` - ra_valid - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) - (m:(K,V)finmap) ==> - ra_local_update - (R:(V)ra) - ((a:V),(f:V)) - ((b:V),(g:V)) - `), - assume_rule(` - ra_valid - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) - (m:(K,V)finmap) - `)); - thm lifted = ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `a:V`, - `f:V`, - `b:V`, - `g:V`, - `m:(K,V)finmap`), - GMAP_RA_LOCAL_UPDATE_AT); - lifted = mp_rule( - lifted, - assume_rule(` - finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) - `)); - lifted = mp_rule(lifted, base_local); - ACCEPT_TAC(validity_cases[0], lifted); - - thm invalid_local = ispecl_rule( - TERM_LIST( - `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, - `m:(K,V)finmap`, - `finmap_singleton (key:K) (f:V)`, - `finmap_insert (key:K) (b:V) (m:(K,V)finmap)`, - `finmap_singleton (key:K) (g:V)`), - RA_LOCAL_UPDATE_INVALID); - invalid_local = mp_rule( - invalid_local, - assume_rule(` - ~(ra_valid - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) - (m:(K,V)finmap)) - `)); - ACCEPT_TAC(validity_cases[1], invalid_local); - return gnode_prove(root); -} - -PROOF thm GMAP_RA_LOCAL_UPDATE_AT_IFF = - prove_gmap_ra_local_update_at_iff(); - /* * Lift a deterministic base update through SOME at the selected key. At all * other keys both source and target singletons contribute NONE, so the source @@ -2736,8 +2184,21 @@ PROOF static thm prove_gmap_ra_update_singleton(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(ra_update_def))); + pure_rewrite_conv(THM_LIST( + ra_update_def, + ra_updateP_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); body = AUTO_INTROS_TAC(body); + body = EXISTS_TAC( + body, + `finmap_singleton (key:K) (b:V)`); + gnode_list update_result = CONJ_TAC(body); + ACCEPT_TAC( + update_result[0], + refl_rule(`finmap_singleton (key:K) (b:V)`)); + body = update_result[1]; thm source_valid_rule = ispecl_rule( TERM_LIST( @@ -2766,9 +2227,6 @@ PROOF static thm prove_gmap_ra_update_singleton(void) { `b:V`), OPTION_RA_UPDATE), assume_rule(`ra_update (R:(V)ra) (a:V) (b:V)`)); - option_update = pure_once_rewrite_rule( - THM_LIST(ra_update_def), - option_update); body = CONV_TAC( body, @@ -2797,10 +2255,16 @@ PROOF static thm prove_gmap_ra_update_singleton(void) { OPTION_RA_OP_NONE_L))); if (i == 0) { thm updated = mp_rule( - spec_rule( - `finmap_lookup - (frame:(K,V)finmap) - (key:K)`, + mp_rule( + ispecl_rule( + TERM_LIST( + `(option_ra (R:(V)ra)):((V)option)ra`, + `SOME (a:V):(V)option`, + `SOME (b:V):(V)option`, + `finmap_lookup + (frame:(K,V)finmap) + (key:K)`), + RA_UPDATE_APPLY), option_update), normalized_source); ACCEPT_TAC(reduced_goal, updated); @@ -2814,92 +2278,6 @@ PROOF static thm prove_gmap_ra_update_singleton(void) { PROOF thm GMAP_RA_UPDATE_SINGLETON = prove_gmap_ra_update_singleton(); -PROOF static thm prove_gmap_ra_update_singleton_iff(void) { - term goal_tm = ` - forall (R:(V)ra) (key:K) (a:V) (b:V). - ra_update - (gmap_ra R) - (finmap_singleton key a) - (finmap_singleton key b) <=> - ra_update R a b - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - gnode_list directions = EQ_TAC(body); - - gnode forward = DISCH_TAC(directions[0], "Hmap_update"); - forward = CONV_TAC( - forward, - once_rewrite_conv(THM_LIST(ra_update_def))); - forward = AUTO_INTROS_TAC(forward); - - thm source_singleton_valid = eq_mp_rule( - gsym_rule(ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `ra_op (R:(V)ra) (a:V) (frame:V)`), - GMAP_RA_VALID_SINGLETON)), - assume_rule(` - ra_valid - (R:(V)ra) - (ra_op R (a:V) (frame:V)) - `)); - thm source_op = ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `a:V`, - `frame:V`), - GMAP_RA_SINGLETON_OP); - thm source_validity_eq = beta_rule(ap_term_rule( - `\m:(K,V)finmap. - ra_valid - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) - m`, - source_op)); - thm source_map_valid = eq_mp_rule( - gsym_rule(source_validity_eq), - source_singleton_valid); - - thm map_update = rewrite_rule( - THM_LIST(ra_update_def), - assume_rule(` - ra_update - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) - (finmap_singleton (key:K) (a:V)) - (finmap_singleton key (b:V)) - `)); - thm target_map_valid = mp_rule( - spec_rule( - `finmap_singleton (key:K) (frame:V)`, - map_update), - source_map_valid); - thm target_base_valid = rewrite_rule( - THM_LIST( - GMAP_RA_SINGLETON_OP, - GMAP_RA_VALID_SINGLETON), - target_map_valid); - ACCEPT_TAC(forward, target_base_valid); - - gnode reverse = DISCH_TAC(directions[1], "Hbase_update"); - ACCEPT_TAC( - reverse, - mp_rule( - ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `a:V`, - `b:V`), - GMAP_RA_UPDATE_SINGLETON), - assume_rule(`ra_update (R:(V)ra) (a:V) (b:V)`))); - return gnode_prove(root); -} - -PROOF thm GMAP_RA_UPDATE_SINGLETON_IFF = - prove_gmap_ra_update_singleton_iff(); - /* Factor an inserted map into a singleton and the deleted remainder, frame * the singleton update, and normalize both factorizations back to inserts. */ PROOF static thm prove_gmap_ra_update_insert(void) { @@ -2932,12 +2310,10 @@ PROOF static thm prove_gmap_ra_update_insert(void) { TERM_LIST( `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, `finmap_singleton (key:K) (a:V)`, - `finmap_singleton (key:K) (b:V)`), + `finmap_singleton (key:K) (b:V)`, + `finmap_delete (key:K) (m:(K,V)finmap)`), RA_UPDATE_FRAME), singleton_update); - framed_update = spec_rule( - `finmap_delete (key:K) (m:(K,V)finmap)`, - framed_update); thm source_factorization = ispecl_rule( TERM_LIST( `R:(V)ra`, @@ -2980,216 +2356,38 @@ PROOF static thm prove_gmap_ra_update_at(void) { m (finmap_insert key b m) `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - thm inserted_update = mp_rule( - ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `a:V`, - `b:V`, - `m:(K,V)finmap`), - GMAP_RA_UPDATE_INSERT), - assume_rule(`ra_update (R:(V)ra) (a:V) (b:V)`)); - thm source_identity = mp_rule( - ispecl_rule( - TERM_LIST( - `key:K`, - `a:V`, - `m:(K,V)finmap`), - FINMAP_INSERT_ID), - assume_rule(` - finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) - `)); - ACCEPT_TAC( - body, - rewrite_rule(THM_LIST(source_identity), inserted_update)); - return gnode_prove(root); -} - -PROOF thm GMAP_RA_UPDATE_AT = - prove_gmap_ra_update_at(); - -/* A singleton hidden frame observes exactly the base frame at the selected - * key. Valid surrounding bindings are supplied by deleting that key from - * the valid source map. */ -PROOF static thm prove_gmap_ra_update_at_iff(void) { - term goal_tm = ` - forall - (R:(V)ra) - (key:K) - (a:V) - (b:V) - (m:(K,V)finmap). - finmap_lookup m key == SOME a ==> - (ra_update - (gmap_ra R) - m - (finmap_insert key b m) <=> - (ra_valid (gmap_ra R) m ==> - ra_update R a b)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - gnode_list directions = EQ_TAC(body); - - gnode forward = DISCH_TAC(directions[0], "Hmap_update"); - forward = DISCH_TAC(forward, "Hvalid_map"); - forward = CONV_TAC( - forward, - once_rewrite_conv(THM_LIST(ra_update_def))); - forward = AUTO_INTROS_TAC(forward); - - thm deleted_valid = mp_rule( + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm inserted_update = mp_rule( ispecl_rule( TERM_LIST( `R:(V)ra`, `key:K`, + `a:V`, + `b:V`, `m:(K,V)finmap`), - GMAP_RA_VALID_DELETE), - assume_rule(` - ra_valid - (gmap_ra (R:(V)ra)) - (m:(K,V)finmap) - `)); - thm inserted_source_valid = eq_mp_rule( - gsym_rule(ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `ra_op (R:(V)ra) (a:V) (frame:V)`, - `m:(K,V)finmap`), - GMAP_RA_VALID_INSERT)), - conj_rule( - assume_rule(` - ra_valid - (R:(V)ra) - (ra_op R (a:V) (frame:V)) - `), - deleted_valid)); - thm source_op = mp_rule( + GMAP_RA_UPDATE_INSERT), + assume_rule(`ra_update (R:(V)ra) (a:V) (b:V)`)); + thm source_identity = mp_rule( ispecl_rule( TERM_LIST( - `R:(V)ra`, `key:K`, `a:V`, - `frame:V`, `m:(K,V)finmap`), - GMAP_RA_OP_SINGLETON_AT), - assume_rule(` - finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) - `)); - thm source_map_valid = eq_mp_rule( - ap_term_rule( - `ra_valid - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra)`, - gsym_rule(source_op)), - inserted_source_valid); - - term map_frame = `finmap_singleton (key:K) (frame:V)`; - term target_map = `finmap_insert (key:K) (b:V) (m:(K,V)finmap)`; - thm target_map_valid = ispecl_rule( - TERM_LIST( - `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, - `m:(K,V)finmap`, - target_map, - map_frame), - RA_UPDATE_APPLY); - target_map_valid = mp_rule( - target_map_valid, - assume_rule(` - ra_update - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) - (m:(K,V)finmap) - (finmap_insert (key:K) (b:V) m) - `)); - target_map_valid = mp_rule(target_map_valid, source_map_valid); - - thm target_lookup = ispecl_rule( - TERM_LIST( - `R:(V)ra`, - target_map, - map_frame, - `key:K`), - GMAP_RA_OP_LOOKUP); - target_lookup = rewrite_rule( - THM_LIST( - FINMAP_INSERT_LOOKUP_EQ, - FINMAP_SINGLETON_LOOKUP, - OPTION_RA_OP_SOME_SOME), - target_lookup); - thm target_base_valid = ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `ra_op (R:(V)ra) (b:V) (frame:V)`, - `ra_op - (gmap_ra (R:(V)ra)) - (finmap_insert (key:K) (b:V) (m:(K,V)finmap)) - (finmap_singleton key (frame:V))`), - GMAP_RA_VALID_LOOKUP); - target_base_valid = mp_rule(target_base_valid, target_map_valid); - target_base_valid = mp_rule(target_base_valid, target_lookup); - ACCEPT_TAC(forward, target_base_valid); - - gnode reverse = DISCH_TAC(directions[1], "Hbase_guard"); - gnode_list validity_cases = BOOL_CASES_TAC( - reverse, - `ra_valid - (gmap_ra (R:(V)ra)) - (m:(K,V)finmap)`, - "Hvalid_map"); - - thm base_update = mp_rule( - assume_rule(` - ra_valid - (gmap_ra (R:(V)ra)) - (m:(K,V)finmap) ==> - ra_update (R:(V)ra) (a:V) (b:V) - `), - assume_rule(` - ra_valid - (gmap_ra (R:(V)ra)) - (m:(K,V)finmap) - `)); - thm lifted = ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `a:V`, - `b:V`, - `m:(K,V)finmap`), - GMAP_RA_UPDATE_AT); - lifted = mp_rule( - lifted, + FINMAP_INSERT_ID), assume_rule(` finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) `)); - lifted = mp_rule(lifted, base_update); - ACCEPT_TAC(validity_cases[0], lifted); - - thm invalid_update = ispecl_rule( - TERM_LIST( - `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, - `m:(K,V)finmap`, - `finmap_insert (key:K) (b:V) (m:(K,V)finmap)`), - RA_UPDATE_INVALID); - invalid_update = mp_rule( - invalid_update, - assume_rule(` - ~(ra_valid - (gmap_ra (R:(V)ra)) - (m:(K,V)finmap)) - `)); - ACCEPT_TAC(validity_cases[1], invalid_update); + ACCEPT_TAC( + body, + rewrite_rule(THM_LIST(source_identity), inserted_update)); return gnode_prove(root); } -PROOF thm GMAP_RA_UPDATE_AT_IFF = - prove_gmap_ra_update_at_iff(); +PROOF thm GMAP_RA_UPDATE_AT = + prove_gmap_ra_update_at(); -PROOF static thm prove_gmap_ra_update_delete(void) { +PROOF static thm prove_gmap_ra_drop_at(void) { term goal_tm = ` forall (R:(V)ra) @@ -3220,19 +2418,19 @@ PROOF static thm prove_gmap_ra_update_delete(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_UPDATE_DELETE = - prove_gmap_ra_update_delete(); +PROOF thm GMAP_RA_DROP_AT = + prove_gmap_ra_drop_at(); /* * The nondeterministic lift selects an exact SOME payload at the chosen key - * using OPTION_RA_UPDATE_ND, then packages that payload as an exact singleton + * using OPTION_RA_UPDATEP, then packages that payload as an exact singleton * map. Other keys again retain the source frame validity unchanged. */ -PROOF static thm prove_gmap_ra_update_singleton_nd(void) { +PROOF static thm prove_gmap_ra_updatep_singleton(void) { term goal_tm = ` forall (R:(V)ra) (key:K) (a:V) (P:V->bool). - ra_update_nd R a P ==> - ra_update_nd + ra_updateP R a P ==> + ra_updateP (gmap_ra R) (finmap_singleton key a) (\m:(K,V)finmap. @@ -3243,7 +2441,7 @@ PROOF static thm prove_gmap_ra_update_singleton_nd(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); + once_rewrite_conv(THM_LIST(ra_updateP_def))); body = CONV_TAC( body, depth_conv(get_conversion_by_name("BETA_CONV"))); @@ -3280,12 +2478,12 @@ PROOF static thm prove_gmap_ra_update_singleton_nd(void) { `R:(V)ra`, `a:V`, `P:V->bool`), - OPTION_RA_UPDATE_ND), + OPTION_RA_UPDATEP), assume_rule(` - ra_update_nd (R:(V)ra) (a:V) (P:V->bool) + ra_updateP (R:(V)ra) (a:V) (P:V->bool) `)); option_update = pure_once_rewrite_rule( - THM_LIST(ra_update_nd_def), + THM_LIST(ra_updateP_def), option_update); option_update = beta_rule(option_update); thm selected = mp_rule( @@ -3386,140 +2584,13 @@ PROOF static thm prove_gmap_ra_update_singleton_nd(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_UPDATE_SINGLETON_ND = - prove_gmap_ra_update_singleton_nd(); - -PROOF static thm prove_gmap_ra_update_singleton_nd_iff(void) { - term goal_tm = ` - forall (R:(V)ra) (key:K) (a:V) (P:V->bool). - ra_update_nd - (gmap_ra R) - (finmap_singleton key a) - (\m:(K,V)finmap. - exists b:V. - P b && m == finmap_singleton key b) <=> - ra_update_nd R a P - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - gnode_list directions = EQ_TAC(body); - - gnode forward = DISCH_TAC(directions[0], "Hmap_update"); - forward = CONV_TAC( - forward, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); - forward = AUTO_INTROS_TAC(forward); - - thm source_singleton_valid = eq_mp_rule( - gsym_rule(ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `ra_op (R:(V)ra) (a:V) (frame:V)`), - GMAP_RA_VALID_SINGLETON)), - assume_rule(` - ra_valid - (R:(V)ra) - (ra_op R (a:V) (frame:V)) - `)); - thm source_op = ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `a:V`, - `frame:V`), - GMAP_RA_SINGLETON_OP); - thm source_validity_eq = beta_rule(ap_term_rule( - `\m:(K,V)finmap. - ra_valid - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) - m`, - source_op)); - thm source_map_valid = eq_mp_rule( - gsym_rule(source_validity_eq), - source_singleton_valid); - - thm map_update = rewrite_rule( - THM_LIST(ra_update_nd_def), - assume_rule(` - ra_update_nd - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) - (finmap_singleton (key:K) (a:V)) - (\m:(K,V)finmap. - exists b:V. - (P:V->bool) b && - m == finmap_singleton key b) - `)); - thm selected = mp_rule( - spec_rule( - `finmap_singleton (key:K) (frame:V)`, - map_update), - source_map_valid); - selected = beta_rule(selected); - forward = ASSUME_TAC(forward, selected, "Hselected"); - forward = ASMP_EXISTS_TAC(forward, "Hselected", "result"); - forward = ASMP_CONJ_TAC( - forward, - "Hselected", - "Hresult_image", - "Hresult_valid"); - forward = ASMP_EXISTS_TAC(forward, "Hresult_image", "b"); - forward = ASMP_CONJ_TAC( - forward, - "Hresult_image", - "HP_b", - "Hresult_singleton"); - - thm target_base_valid = rewrite_rule( - THM_LIST( - assume_rule(` - (result:(K,V)finmap) == - finmap_singleton (key:K) (b:V) - `), - GMAP_RA_SINGLETON_OP, - GMAP_RA_VALID_SINGLETON), - assume_rule(` - ra_valid - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) - (ra_op - (gmap_ra R) - (result:(K,V)finmap) - (finmap_singleton (key:K) (frame:V))) - `)); - forward = EXISTS_TAC(forward, `b:V`); - gnode_list result_parts = CONJ_TAC(forward); - ACCEPT_TAC( - result_parts[0], - assume_rule(`(P:V->bool) (b:V)`)); - ACCEPT_TAC(result_parts[1], target_base_valid); - - gnode reverse = DISCH_TAC(directions[1], "Hbase_update"); - ACCEPT_TAC( - reverse, - mp_rule( - ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `a:V`, - `P:V->bool`), - GMAP_RA_UPDATE_SINGLETON_ND), - assume_rule(` - ra_update_nd - (R:(V)ra) - (a:V) - (P:V->bool) - `))); - return gnode_prove(root); -} - -PROOF thm GMAP_RA_UPDATE_SINGLETON_ND_IFF = - prove_gmap_ra_update_singleton_nd_iff(); +PROOF thm GMAP_RA_UPDATEP_SINGLETON = + prove_gmap_ra_updatep_singleton(); /* Frame the exact singleton image by the deleted remainder. ND * monotonicity then normalizes each selected singleton back to an insertion; * the selected payload remains free to depend on the hidden frame. */ -PROOF static thm prove_gmap_ra_update_insert_nd(void) { +PROOF static thm prove_gmap_ra_updatep_insert(void) { term goal_tm = ` forall (R:(V)ra) @@ -3527,8 +2598,8 @@ PROOF static thm prove_gmap_ra_update_insert_nd(void) { (a:V) (P:V->bool) (m:(K,V)finmap). - ra_update_nd R a P ==> - ra_update_nd + ra_updateP R a P ==> + ra_updateP (gmap_ra R) (finmap_insert key a m) (\result:(K,V)finmap. @@ -3571,21 +2642,19 @@ PROOF static thm prove_gmap_ra_update_insert_nd(void) { `key:K`, `a:V`, `P:V->bool`), - GMAP_RA_UPDATE_SINGLETON_ND), + GMAP_RA_UPDATEP_SINGLETON), assume_rule(` - ra_update_nd (R:(V)ra) (a:V) (P:V->bool) + ra_updateP (R:(V)ra) (a:V) (P:V->bool) `)); thm framed_update = mp_rule( ispecl_rule( TERM_LIST( `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, `finmap_singleton (key:K) (a:V)`, - singleton_image), - RA_UPDATE_ND_FRAME), + singleton_image, + `finmap_delete (key:K) (m:(K,V)finmap)`), + RA_UPDATEP_FRAME), singleton_update); - framed_update = spec_rule( - `finmap_delete (key:K) (m:(K,V)finmap)`, - framed_update); framed_update = beta_rule(framed_update); thm source_factorization = ispecl_rule( @@ -3605,7 +2674,7 @@ PROOF static thm prove_gmap_ra_update_insert_nd(void) { `finmap_insert (key:K) (a:V) (m:(K,V)finmap)`, framed_image, insert_image), - RA_UPDATE_ND_MONO); + RA_UPDATEP_MONO); weakened = mp_rule(weakened, framed_update); weakened = beta_rule(weakened); body = MATCH_MP_TAC(body, weakened); @@ -3656,10 +2725,10 @@ PROOF static thm prove_gmap_ra_update_insert_nd(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_UPDATE_INSERT_ND = - prove_gmap_ra_update_insert_nd(); +PROOF thm GMAP_RA_UPDATEP_INSERT = + prove_gmap_ra_updatep_insert(); -PROOF static thm prove_gmap_ra_update_at_nd(void) { +PROOF static thm prove_gmap_ra_updatep_at(void) { term goal_tm = ` forall (R:(V)ra) @@ -3668,8 +2737,8 @@ PROOF static thm prove_gmap_ra_update_at_nd(void) { (P:V->bool) (m:(K,V)finmap). finmap_lookup m key == SOME a ==> - ra_update_nd R a P ==> - ra_update_nd + ra_updateP R a P ==> + ra_updateP (gmap_ra R) m (\result:(K,V)finmap. @@ -3686,9 +2755,9 @@ PROOF static thm prove_gmap_ra_update_at_nd(void) { `a:V`, `P:V->bool`, `m:(K,V)finmap`), - GMAP_RA_UPDATE_INSERT_ND), + GMAP_RA_UPDATEP_INSERT), assume_rule(` - ra_update_nd (R:(V)ra) (a:V) (P:V->bool) + ra_updateP (R:(V)ra) (a:V) (P:V->bool) `)); thm source_identity = mp_rule( ispecl_rule( @@ -3706,254 +2775,8 @@ PROOF static thm prove_gmap_ra_update_at_nd(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_UPDATE_AT_ND = - prove_gmap_ra_update_at_nd(); - -/* The exact insertion image lets a selected map result be projected back to - * its payload at `key`. As in the deterministic characterization, source - * validity is needed only for this reverse projection; an invalid map admits - * every ND update vacuously. */ -PROOF static thm prove_gmap_ra_update_at_nd_iff(void) { - term goal_tm = ` - forall - (R:(V)ra) - (key:K) - (a:V) - (P:V->bool) - (m:(K,V)finmap). - finmap_lookup m key == SOME a ==> - (ra_update_nd - (gmap_ra R) - m - (\result:(K,V)finmap. - exists b:V. - P b && result == finmap_insert key b m) <=> - (ra_valid (gmap_ra R) m ==> - ra_update_nd R a P)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - gnode_list directions = EQ_TAC(body); - - gnode forward = DISCH_TAC(directions[0], "Hmap_update"); - forward = DISCH_TAC(forward, "Hvalid_map"); - forward = CONV_TAC( - forward, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); - forward = AUTO_INTROS_TAC(forward); - - thm deleted_valid = mp_rule( - ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `m:(K,V)finmap`), - GMAP_RA_VALID_DELETE), - assume_rule(` - ra_valid - (gmap_ra (R:(V)ra)) - (m:(K,V)finmap) - `)); - thm inserted_source_valid = eq_mp_rule( - gsym_rule(ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `ra_op (R:(V)ra) (a:V) (frame:V)`, - `m:(K,V)finmap`), - GMAP_RA_VALID_INSERT)), - conj_rule( - assume_rule(` - ra_valid - (R:(V)ra) - (ra_op R (a:V) (frame:V)) - `), - deleted_valid)); - thm source_op = mp_rule( - ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `a:V`, - `frame:V`, - `m:(K,V)finmap`), - GMAP_RA_OP_SINGLETON_AT), - assume_rule(` - finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) - `)); - thm source_map_valid = eq_mp_rule( - ap_term_rule( - `ra_valid - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra)`, - gsym_rule(source_op)), - inserted_source_valid); - - term map_image = ` - \result:(K,V)finmap. - exists b:V. - (P:V->bool) b && - result == - finmap_insert - (key:K) - b - (m:(K,V)finmap) - `; - term map_frame = `finmap_singleton (key:K) (frame:V)`; - thm selected_map = ispecl_rule( - TERM_LIST( - `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, - `m:(K,V)finmap`, - map_image, - map_frame), - RA_UPDATE_ND_APPLY); - selected_map = mp_rule( - selected_map, - assume_rule(` - ra_update_nd - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) - (m:(K,V)finmap) - (\result:(K,V)finmap. - exists b:V. - (P:V->bool) b && - result == - finmap_insert - (key:K) - b - (m:(K,V)finmap)) - `)); - selected_map = mp_rule(selected_map, source_map_valid); - selected_map = beta_rule(selected_map); - forward = ASSUME_TAC(forward, selected_map, "Hselected_map"); - forward = ASMP_EXISTS_TAC( - forward, "Hselected_map", "result"); - forward = ASMP_CONJ_TAC( - forward, - "Hselected_map", - "Hresult_image", - "Hresult_valid"); - forward = ASMP_EXISTS_TAC( - forward, "Hresult_image", "selected"); - forward = ASMP_CONJ_TAC( - forward, - "Hresult_image", - "HP_selected", - "Hresult_insert"); - forward = EXISTS_TAC(forward, `selected:V`); - gnode_list selected_parts = CONJ_TAC(forward); - ACCEPT_TAC( - selected_parts[0], - assume_rule(`(P:V->bool) (selected:V)`)); - - thm target_map_valid = rewrite_rule( - THM_LIST(assume_rule(` - (result:(K,V)finmap) == - finmap_insert - (key:K) - (selected:V) - (m:(K,V)finmap) - `)), - assume_rule(` - ra_valid - ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) - (ra_op - (gmap_ra R) - (result:(K,V)finmap) - (finmap_singleton (key:K) (frame:V))) - `)); - term target_map = ` - finmap_insert - (key:K) - (selected:V) - (m:(K,V)finmap) - `; - thm target_lookup = ispecl_rule( - TERM_LIST( - `R:(V)ra`, - target_map, - map_frame, - `key:K`), - GMAP_RA_OP_LOOKUP); - target_lookup = rewrite_rule( - THM_LIST( - FINMAP_INSERT_LOOKUP_EQ, - FINMAP_SINGLETON_LOOKUP, - OPTION_RA_OP_SOME_SOME), - target_lookup); - thm target_base_valid = ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `ra_op (R:(V)ra) (selected:V) (frame:V)`, - `ra_op - (gmap_ra (R:(V)ra)) - (finmap_insert - (key:K) - (selected:V) - (m:(K,V)finmap)) - (finmap_singleton key (frame:V))`), - GMAP_RA_VALID_LOOKUP); - target_base_valid = mp_rule(target_base_valid, target_map_valid); - target_base_valid = mp_rule(target_base_valid, target_lookup); - ACCEPT_TAC(selected_parts[1], target_base_valid); - - gnode reverse = DISCH_TAC(directions[1], "Hbase_guard"); - gnode_list validity_cases = BOOL_CASES_TAC( - reverse, - `ra_valid - (gmap_ra (R:(V)ra)) - (m:(K,V)finmap)`, - "Hvalid_map"); - - thm base_update = mp_rule( - assume_rule(` - ra_valid - (gmap_ra (R:(V)ra)) - (m:(K,V)finmap) ==> - ra_update_nd - (R:(V)ra) - (a:V) - (P:V->bool) - `), - assume_rule(` - ra_valid - (gmap_ra (R:(V)ra)) - (m:(K,V)finmap) - `)); - thm lifted = ispecl_rule( - TERM_LIST( - `R:(V)ra`, - `key:K`, - `a:V`, - `P:V->bool`, - `m:(K,V)finmap`), - GMAP_RA_UPDATE_AT_ND); - lifted = mp_rule( - lifted, - assume_rule(` - finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) - `)); - lifted = mp_rule(lifted, base_update); - ACCEPT_TAC(validity_cases[0], lifted); - - thm invalid_update = ispecl_rule( - TERM_LIST( - `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, - `m:(K,V)finmap`, - map_image), - RA_UPDATE_ND_INVALID); - invalid_update = mp_rule( - invalid_update, - assume_rule(` - ~(ra_valid - (gmap_ra (R:(V)ra)) - (m:(K,V)finmap)) - `)); - ACCEPT_TAC(validity_cases[1], invalid_update); - return gnode_prove(root); -} - -PROOF thm GMAP_RA_UPDATE_AT_ND_IFF = - prove_gmap_ra_update_at_nd_iff(); +PROOF thm GMAP_RA_UPDATEP_AT = + prove_gmap_ra_updatep_at(); /* Pick the fresh key only after the hidden map frame has been introduced. * The common-freshness theorem is precisely where infinitude is used: both @@ -3970,7 +2793,7 @@ PROOF static thm prove_gmap_ra_alloc_strong_dep(void) { key IN candidates ==> finmap_lookup m key == NONE ==> ra_valid R (payload key)) ==> - ra_update_nd + ra_updateP (gmap_ra R) m (\result:(K,V)finmap. @@ -3982,7 +2805,7 @@ PROOF static thm prove_gmap_ra_alloc_strong_dep(void) { gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - pure_rewrite_conv(THM_LIST(ra_update_nd_def))); + pure_rewrite_conv(THM_LIST(ra_updateP_def))); body = CONV_TAC( body, depth_conv(get_conversion_by_name("BETA_CONV"))); @@ -4121,7 +2944,7 @@ PROOF static thm prove_gmap_ra_alloc_strong(void) { (a:V). INFINITE candidates ==> ra_valid R a ==> - ra_update_nd + ra_updateP (gmap_ra R) m (\result:(K,V)finmap. @@ -4162,7 +2985,7 @@ PROOF static thm prove_gmap_ra_alloc(void) { (a:V). INFINITE (UNIV:K->bool) ==> ra_valid R a ==> - ra_update_nd + ra_updateP (gmap_ra R) m (\result:(K,V)finmap. @@ -4205,7 +3028,7 @@ PROOF static thm prove_gmap_ra_alloc_cofinite(void) { INFINITE (UNIV:K->bool) ==> FINITE forbidden ==> ra_valid R a ==> - ra_update_nd + ra_updateP (gmap_ra R) m (\result:(K,V)finmap. @@ -4253,7 +3076,7 @@ PROOF static thm prove_gmap_ra_alloc_empty(void) { forall (R:(V)ra) (a:V). INFINITE (UNIV:K->bool) ==> ra_valid R a ==> - ra_update_nd + ra_updateP (gmap_ra R) (finmap_empty:(K,V)finmap) (\result:(K,V)finmap. @@ -4332,22 +3155,14 @@ PROOF static int audit_gmap_ra(void) { GMAP_RA_INCLUDED_DELETE, GMAP_RA_INCLUDED_LOOKUP_SOME, GMAP_RA_INCLUDED_DOM, - GMAP_RA_LOCAL_UPDATE_SINGLETON, - GMAP_RA_LOCAL_UPDATE_SINGLETON_IFF, GMAP_RA_LOCAL_UPDATE_AT, - GMAP_RA_LOCAL_SOURCE_FRAME, - GMAP_RA_LOCAL_UPDATE_AT_IFF, GMAP_RA_UPDATE_SINGLETON, - GMAP_RA_UPDATE_SINGLETON_IFF, GMAP_RA_UPDATE_INSERT, GMAP_RA_UPDATE_AT, - GMAP_RA_UPDATE_AT_IFF, - GMAP_RA_UPDATE_DELETE, - GMAP_RA_UPDATE_SINGLETON_ND, - GMAP_RA_UPDATE_SINGLETON_ND_IFF, - GMAP_RA_UPDATE_INSERT_ND, - GMAP_RA_UPDATE_AT_ND, - GMAP_RA_UPDATE_AT_ND_IFF, + GMAP_RA_DROP_AT, + GMAP_RA_UPDATEP_SINGLETON, + GMAP_RA_UPDATEP_INSERT, + GMAP_RA_UPDATEP_AT, GMAP_RA_ALLOC_STRONG_DEP, GMAP_RA_ALLOC_STRONG, GMAP_RA_ALLOC, diff --git a/theory/logic/gmap_ra.h b/theory/logic/gmap_ra.h index a2451f9..1c9508f 100644 --- a/theory/logic/gmap_ra.h +++ b/theory/logic/gmap_ra.h @@ -1,765 +1,58 @@ #pragma once /* - * `gmap_ra R:((K,V)finmap)ra` lifts `R:(V)ra` pointwise to finite maps. - * Its carrier is `(K,V)finmap`, unit is `finmap_empty`, operation is - * pointwise composition in `option_ra R`, and a map is valid exactly when - * every optional lookup is valid. + * Pointwise finite-map resource algebras. * - * This client interface hides the raw finite-support construction and all - * `ra_abs` projection equations. + * `gmap_ra R:((K,V)finmap)ra` uses `option_ra R` at every key. The + * representation and support machinery stay private; clients observe maps + * through `finmap_lookup`, validity, inclusion, and the update rules below. */ #include "proof/theory/logic/finmap.h" +#include "proof/theory/logic/local_update.h" #include "proof/theory/logic/option_ra.h" -/* ------------------------------------------------------------------------- */ -/* Core representation */ -/* ------------------------------------------------------------------------- */ - -/* - * `forall R:(V)ra. - * ra_unit (gmap_ra R) == (finmap_empty:(K,V)finmap)` - */ +/* `ra_unit (gmap_ra R) == finmap_empty`. */ PROOF extern thm GMAP_RA_UNIT; -/* - * `forall - * (R:(V)ra) - * (m:(K,V)finmap) - * (n:(K,V)finmap) - * (k:K). - * finmap_lookup (ra_op (gmap_ra R) m n) k == - * ra_op - * (option_ra R) - * (finmap_lookup m k) - * (finmap_lookup n k)` - */ +/* Pointwise operation through `option_ra R`. */ PROOF extern thm GMAP_RA_OP_LOOKUP; -/* - * Singleton composition at the same key: - * - * forall (R:(V)ra) (key:K) (a:V) (b:V). - * ra_op - * (gmap_ra R) - * (finmap_singleton key a) - * (finmap_singleton key b) == - * finmap_singleton key (ra_op R a b) - */ -PROOF extern thm GMAP_RA_SINGLETON_OP; - -/* - * Composition with a singleton frame updates an existing binding pointwise: - * - * forall - * (R:(V)ra) - * (key:K) - * (a:V) - * (frame:V) - * (m:(K,V)finmap). - * finmap_lookup m key == SOME a ==> - * ra_op - * (gmap_ra R) - * m - * (finmap_singleton key frame) == - * finmap_insert key (ra_op R a frame) m - * - * Away from `key`, the singleton contributes `NONE`; at `key`, option - * composition reduces to `SOME (a · frame)`. - */ -PROOF extern thm GMAP_RA_OP_SINGLETON_AT; - -/* - * Composition distributes through insertion at the same key: - * - * forall - * (R:(V)ra) - * (key:K) - * (a:V) - * (b:V) - * (m:(K,V)finmap) - * (n:(K,V)finmap). - * ra_op - * (gmap_ra R) - * (finmap_insert key a m) - * (finmap_insert key b n) == - * finmap_insert - * key - * (ra_op R a b) - * (ra_op (gmap_ra R) m n) - */ -PROOF extern thm GMAP_RA_OP_INSERT_INSERT; - -/* - * Deleting the same key commutes with map composition: - * - * forall - * (R:(V)ra) - * (key:K) - * (m:(K,V)finmap) - * (n:(K,V)finmap). - * ra_op - * (gmap_ra R) - * (finmap_delete key m) - * (finmap_delete key n) == - * finmap_delete key (ra_op (gmap_ra R) m n) - */ -PROOF extern thm GMAP_RA_OP_DELETE; - -/* - * A singleton composes with a map missing its key by insertion: - * - * forall - * (R:(V)ra) - * (key:K) - * (a:V) - * (m:(K,V)finmap). - * finmap_lookup m key == NONE ==> - * ra_op (gmap_ra R) (finmap_singleton key a) m == - * finmap_insert key a m - */ -PROOF extern thm GMAP_RA_SINGLETON_OP_FRESH; - -/* - * A present entry splits off as a singleton resource: - * - * forall - * (R:(V)ra) - * (key:K) - * (a:V) - * (m:(K,V)finmap). - * finmap_lookup m key == SOME a ==> - * m == - * ra_op - * (gmap_ra R) - * (finmap_singleton key a) - * (finmap_delete key m) - */ -PROOF extern thm GMAP_RA_DECOMPOSE; - -/* - * Inserting a payload is exactly composition of its singleton resource with - * the map from which that key has been removed: - * - * forall - * (R:(V)ra) - * (key:K) - * (a:V) - * (m:(K,V)finmap). - * ra_op - * (gmap_ra R) - * (finmap_singleton key a) - * (finmap_delete key m) == - * finmap_insert key a m - */ -PROOF extern thm GMAP_RA_SINGLETON_OP_DELETE; - -/* - * forall - * (R:(V)ra) - * (m:(K,V)finmap) - * (n:(K,V)finmap). - * finmap_dom (ra_op (gmap_ra R) m n) == - * finmap_dom m UNION finmap_dom n - */ -PROOF extern thm GMAP_RA_DOM_OP; - -/* ------------------------------------------------------------------------- */ -/* Validity */ -/* ------------------------------------------------------------------------- */ - -/* - * `forall (R:(V)ra) (m:(K,V)finmap). - * ra_valid (gmap_ra R) m <=> - * forall k:K. - * ra_valid (option_ra R) (finmap_lookup m k)` - */ +/* Pointwise validity. */ PROOF extern thm GMAP_RA_VALID; -/* - * Singleton validity is exactly payload validity: - * - * forall (R:(V)ra) (key:K) (a:V). - * ra_valid (gmap_ra R) (finmap_singleton key a) <=> - * ra_valid R a - */ +/* Singleton validity is exactly payload validity. */ PROOF extern thm GMAP_RA_VALID_SINGLETON; -/* - * Validity splits exactly into the selected optional lookup and the map with - * that lookup removed: - * - * forall (R:(V)ra) (key:K) (m:(K,V)finmap). - * ra_valid (gmap_ra R) m <=> - * ra_valid (option_ra R) (finmap_lookup m key) && - * ra_valid (gmap_ra R) (finmap_delete key m) - */ -PROOF extern thm GMAP_RA_VALID_LOOKUP_DELETE; - -/* - * Payload-facing form of the same deletion split: - * - * forall - * (R:(V)ra) - * (key:K) - * (a:V) - * (m:(K,V)finmap). - * finmap_lookup m key == SOME a ==> - * (ra_valid (gmap_ra R) m <=> - * ra_valid R a && - * ra_valid (gmap_ra R) (finmap_delete key m)) - */ -PROOF extern thm GMAP_RA_VALID_DELETE_SOME; - -/* - * A present lookup of a valid map contains a valid payload: - * - * forall - * (R:(V)ra) - * (key:K) - * (a:V) - * (m:(K,V)finmap). - * ra_valid (gmap_ra R) m ==> - * finmap_lookup m key == SOME a ==> - * ra_valid R a - */ +/* A present lookup in a valid map has a valid payload. */ PROOF extern thm GMAP_RA_VALID_LOOKUP; -/* - * Deleting any key preserves validity: - * - * forall (R:(V)ra) (key:K) (m:(K,V)finmap). - * ra_valid (gmap_ra R) m ==> - * ra_valid (gmap_ra R) (finmap_delete key m) - */ -PROOF extern thm GMAP_RA_VALID_DELETE; - -/* - * Insertion validity ignores the overwritten entry and checks exactly the - * new payload and the remaining map: - * - * forall (R:(V)ra) (key:K) (a:V) (m:(K,V)finmap). - * ra_valid (gmap_ra R) (finmap_insert key a m) <=> - * ra_valid R a && - * ra_valid (gmap_ra R) (finmap_delete key m) - */ -PROOF extern thm GMAP_RA_VALID_INSERT; - -/* - * Valid payload and valid surrounding map imply valid insertion: - * - * forall (R:(V)ra) (key:K) (a:V) (m:(K,V)finmap). - * ra_valid R a ==> - * ra_valid (gmap_ra R) m ==> - * ra_valid (gmap_ra R) (finmap_insert key a m) - */ -PROOF extern thm GMAP_RA_VALID_INSERT_OF_VALID; - -/* - * At a fresh key, insertion validity factors into payload and map validity: - * - * forall (R:(V)ra) (key:K) (a:V) (m:(K,V)finmap). - * finmap_lookup m key == NONE ==> - * (ra_valid (gmap_ra R) (finmap_insert key a m) <=> - * ra_valid R a && ra_valid (gmap_ra R) m) - */ -PROOF extern thm GMAP_RA_VALID_INSERT_FRESH; - -/* ------------------------------------------------------------------------- */ -/* Order */ -/* ------------------------------------------------------------------------- */ - -/* - * Finite-map inclusion implies pointwise option-RA inclusion: - * - * forall - * (R:(V)ra) - * (m:(K,V)finmap) - * (n:(K,V)finmap). - * ra_included (gmap_ra R) m n ==> - * forall k:K. - * ra_included - * (option_ra R) - * (finmap_lookup m k) - * (finmap_lookup n k) - * - * This direction projects a global finite-map witness to each lookup. The - * converse below reconstructs the global inclusion by finite-map induction. - */ -PROOF extern thm GMAP_RA_INCLUDED_LOOKUP; - -/* - * Pointwise option inclusion constructs a finite-map inclusion witness: - * - * forall - * (R:(V)ra) - * (m:(K,V)finmap) - * (n:(K,V)finmap). - * (forall k:K. - * ra_included - * (option_ra R) - * (finmap_lookup m k) - * (finmap_lookup n k)) ==> - * ra_included (gmap_ra R) m n - */ -PROOF extern thm GMAP_RA_INCLUDED_OF_LOOKUP; - -/* - * Finite-map inclusion is exactly pointwise option inclusion: - * - * forall - * (R:(V)ra) - * (m:(K,V)finmap) - * (n:(K,V)finmap). - * ra_included (gmap_ra R) m n <=> - * forall k:K. - * ra_included - * (option_ra R) - * (finmap_lookup m k) - * (finmap_lookup n k) - */ +/* Inclusion is characterized pointwise. */ PROOF extern thm GMAP_RA_INCLUDED_LOOKUP_IFF; -/* - * Deleting a binding produces a subresource of the original map: - * - * forall (R:(V)ra) (key:K) (m:(K,V)finmap). - * ra_included - * (gmap_ra R) - * (finmap_delete key m) - * m - */ -PROOF extern thm GMAP_RA_INCLUDED_DELETE; - -/* - * Payload-facing characterization: - * - * forall - * (R:(V)ra) - * (m:(K,V)finmap) - * (n:(K,V)finmap). - * ra_included (gmap_ra R) m n <=> - * forall (key:K) (a:V). - * finmap_lookup m key == SOME a ==> - * exists b:V. - * finmap_lookup n key == SOME b && - * ra_included R a b - */ -PROOF extern thm GMAP_RA_INCLUDED_LOOKUP_SOME; - -/* - * Inclusion grows support: - * - * forall - * (R:(V)ra) - * (m:(K,V)finmap) - * (n:(K,V)finmap). - * ra_included (gmap_ra R) m n ==> - * finmap_dom m SUBSET finmap_dom n - */ +/* Inclusion can only grow the finite domain. */ PROOF extern thm GMAP_RA_INCLUDED_DOM; -/* - * Inclusion between singleton maps at the same key is exactly base inclusion: - * - * forall (R:(V)ra) (key:K) (a:V) (b:V). - * ra_included - * (gmap_ra R) - * (finmap_singleton key a) - * (finmap_singleton key b) <=> - * ra_included R a b - */ -PROOF extern thm GMAP_RA_INCLUDED_SINGLETON; - -/* ------------------------------------------------------------------------- */ -/* Laws */ -/* ------------------------------------------------------------------------- */ - -/* Generic reflexivity, transitivity, and validity descent come from `ra.h`. */ - -/* ------------------------------------------------------------------------- */ -/* Updates */ -/* ------------------------------------------------------------------------- */ - -/* - * A base local update lifts pointwise to singleton maps at a fixed key: - * - * forall - * (R:(V)ra) - * (key:K) - * (a:V) (f:V) - * (b:V) (g:V). - * ra_local_update R (a,f) (b,g) ==> - * ra_local_update - * (gmap_ra R) - * (finmap_singleton key a,finmap_singleton key f) - * (finmap_singleton key b,finmap_singleton key g) - * - * The hidden map residual may contain no entries away from `key`, because it - * must reconstruct the singleton source whole. At `key`, the proof is - * exactly `OPTION_RA_LOCAL_UPDATE_SOME`. - */ -PROOF extern thm GMAP_RA_LOCAL_UPDATE_SINGLETON; - -/* - * Singleton-map local updates are exactly base local updates: - * - * forall - * (R:(V)ra) - * (key:K) - * (a:V) (f:V) - * (b:V) (g:V). - * ra_local_update - * (gmap_ra R) - * (finmap_singleton key a,finmap_singleton key f) - * (finmap_singleton key b,finmap_singleton key g) <=> - * ra_local_update R (a,f) (b,g) - */ -PROOF extern thm GMAP_RA_LOCAL_UPDATE_SINGLETON_IFF; +/* Extract a present binding as a singleton RA fragment. */ +PROOF extern thm GMAP_RA_DECOMPOSE; -/* - * Lift a local update at an existing binding while preserving every other - * binding of the whole map: - * - * forall - * (R:(V)ra) - * (key:K) - * (a:V) (f:V) - * (b:V) (g:V) - * (m:(K,V)finmap). - * finmap_lookup m key == SOME a ==> - * ra_local_update R (a,f) (b,g) ==> - * ra_local_update - * (gmap_ra R) - * (m,finmap_singleton key f) - * (finmap_insert key b m,finmap_singleton key g) - * - * The hidden map residual is preserved pointwise. At `key` the obligation - * is the supplied base local update; away from `key` both singleton-owned - * maps contribute `NONE`, so the original bindings are unchanged. - */ +/* Lift a payload local update at an existing key. */ PROOF extern thm GMAP_RA_LOCAL_UPDATE_AT; -/* - * Exact characterization of an existing-binding local update: - * - * forall - * (R:(V)ra) - * (key:K) - * (a:V) (f:V) - * (b:V) (g:V) - * (m:(K,V)finmap). - * finmap_lookup m key == SOME a ==> - * (ra_local_update - * (gmap_ra R) - * (m,finmap_singleton key f) - * (finmap_insert key b m,finmap_singleton key g) <=> - * (ra_valid (gmap_ra R) m ==> - * ra_local_update R (a,f) (b,g))) - * - * The validity guard is essential: `ra_local_update` is vacuous when its - * source whole is invalid, including when invalidity occurs at another key. - */ -PROOF extern thm GMAP_RA_LOCAL_UPDATE_AT_IFF; - -/* - * A deterministic payload update lifts at a fixed singleton key: - * - * forall (R:(V)ra) (key:K) (a:V) (b:V). - * ra_update R a b ==> - * ra_update - * (gmap_ra R) - * (finmap_singleton key a) - * (finmap_singleton key b) - */ -PROOF extern thm GMAP_RA_UPDATE_SINGLETON; - -/* - * Singleton-map deterministic updates are exactly base updates: - * - * forall (R:(V)ra) (key:K) (a:V) (b:V). - * ra_update - * (gmap_ra R) - * (finmap_singleton key a) - * (finmap_singleton key b) <=> - * ra_update R a b - */ -PROOF extern thm GMAP_RA_UPDATE_SINGLETON_IFF; - -/* - * A deterministic payload update lifts under insertion into an arbitrary - * surrounding map: - * - * forall - * (R:(V)ra) - * (key:K) - * (a:V) - * (b:V) - * (m:(K,V)finmap). - * ra_update R a b ==> - * ra_update - * (gmap_ra R) - * (finmap_insert key a m) - * (finmap_insert key b m) - */ -PROOF extern thm GMAP_RA_UPDATE_INSERT; - -/* - * Updating an existing entry changes only that entry: - * - * forall - * (R:(V)ra) - * (key:K) - * (a:V) - * (b:V) - * (m:(K,V)finmap). - * finmap_lookup m key == SOME a ==> - * ra_update R a b ==> - * ra_update (gmap_ra R) m (finmap_insert key b m) - */ +/* Lift a deterministic payload update at an existing key. */ PROOF extern thm GMAP_RA_UPDATE_AT; -/* - * Exact deterministic characterization at an existing binding: - * - * forall - * (R:(V)ra) - * (key:K) - * (a:V) - * (b:V) - * (m:(K,V)finmap). - * finmap_lookup m key == SOME a ==> - * (ra_update - * (gmap_ra R) - * m - * (finmap_insert key b m) <=> - * (ra_valid (gmap_ra R) m ==> - * ra_update R a b)) - * - * The guard is necessary: every update from an invalid source map is - * vacuous, even when `a ~~> b` does not hold in the base RA. - */ -PROOF extern thm GMAP_RA_UPDATE_AT_IFF; - -/* - * Deleting any binding is an unconditional deterministic update: - * - * forall (R:(V)ra) (key:K) (m:(K,V)finmap). - * ra_update - * (gmap_ra R) - * m - * (finmap_delete key m) - */ -PROOF extern thm GMAP_RA_UPDATE_DELETE; +/* Lift a predicate payload update at an existing key. */ +PROOF extern thm GMAP_RA_UPDATEP_AT; -/* - * A nondeterministic payload update lifts to the exact singleton-map image: - * - * forall (R:(V)ra) (key:K) (a:V) (P:V->bool). - * ra_update_nd R a P ==> - * ra_update_nd - * (gmap_ra R) - * (finmap_singleton key a) - * (\m:(K,V)finmap. - * exists b:V. - * P b && m == finmap_singleton key b) - * - * The selected payload may depend on the ambient map frame, while every - * result map has exactly the original singleton support. - */ -PROOF extern thm GMAP_RA_UPDATE_SINGLETON_ND; +/* Drop this fragment's contribution at one key. */ +PROOF extern thm GMAP_RA_DROP_AT; -/* - * Exact ND characterization for results restricted to singleton maps at the - * same key: - * - * forall (R:(V)ra) (key:K) (a:V) (P:V->bool). - * ra_update_nd - * (gmap_ra R) - * (finmap_singleton key a) - * (\m:(K,V)finmap. - * exists b:V. - * P b && m == finmap_singleton key b) <=> - * ra_update_nd R a P - */ -PROOF extern thm GMAP_RA_UPDATE_SINGLETON_ND_IFF; - -/* - * A nondeterministic payload update lifts under insertion into an arbitrary - * surrounding map: - * - * forall - * (R:(V)ra) - * (key:K) - * (a:V) - * (P:V->bool) - * (m:(K,V)finmap). - * ra_update_nd R a P ==> - * ra_update_nd - * (gmap_ra R) - * (finmap_insert key a m) - * (\result:(K,V)finmap. - * exists b:V. - * P b && result == finmap_insert key b m) - */ -PROOF extern thm GMAP_RA_UPDATE_INSERT_ND; - -/* - * A nondeterministic update of an existing entry preserves every other - * binding of the original map: - * - * forall - * (R:(V)ra) - * (key:K) - * (a:V) - * (P:V->bool) - * (m:(K,V)finmap). - * finmap_lookup m key == SOME a ==> - * ra_update_nd R a P ==> - * ra_update_nd - * (gmap_ra R) - * m - * (\result:(K,V)finmap. - * exists b:V. - * P b && result == finmap_insert key b m) - */ -PROOF extern thm GMAP_RA_UPDATE_AT_ND; - -/* - * Exact ND characterization for the insertion image at an existing binding: - * - * forall - * (R:(V)ra) - * (key:K) - * (a:V) - * (P:V->bool) - * (m:(K,V)finmap). - * finmap_lookup m key == SOME a ==> - * (ra_update_nd - * (gmap_ra R) - * m - * (\result:(K,V)finmap. - * exists b:V. - * P b && result == finmap_insert key b m) <=> - * (ra_valid (gmap_ra R) m ==> - * ra_update_nd R a P)) - * - * The result predicate is deliberately the exact insertion image. Arbitrary - * map predicates cannot in general be projected to a base payload predicate. - * The validity guard is essential because every ND update from an invalid - * source map holds vacuously. - */ -PROOF extern thm GMAP_RA_UPDATE_AT_ND_IFF; - -/* ------------------------------------------------------------------------- */ -/* Fresh allocation for infinite key spaces */ -/* ------------------------------------------------------------------------- */ - -/* - * Strong dependent fresh allocation. The allocated payload may depend on - * the selected key, and allocation is restricted to an arbitrary infinite - * candidate set: - * - * forall - * (R:(V)ra) - * (candidates:K->bool) - * (payload:K->V) - * (m:(K,V)finmap). - * INFINITE candidates ==> - * (forall key:K. - * key IN candidates ==> - * finmap_lookup m key == NONE ==> - * ra_valid R (payload key)) ==> - * ra_update_nd - * (gmap_ra R) - * m - * (\result:(K,V)finmap. - * exists key:K. - * key IN candidates && - * finmap_lookup m key == NONE && - * result == finmap_insert key (payload key) m) - * - * The selected key may depend on the hidden RA frame. This quantifier order - * is essential: a key known to be absent only from `m` may still be occupied - * by that frame. - */ +/* Fresh allocation with key-dependent payload and candidate set. */ PROOF extern thm GMAP_RA_ALLOC_STRONG_DEP; -/* - * Strong fresh allocation of one fixed valid payload inside `candidates`: - * - * forall - * (R:(V)ra) - * (candidates:K->bool) - * (m:(K,V)finmap) - * (a:V). - * INFINITE candidates ==> - * ra_valid R a ==> - * ra_update_nd - * (gmap_ra R) - * m - * (\result:(K,V)finmap. - * exists key:K. - * key IN candidates && - * finmap_lookup m key == NONE && - * result == finmap_insert key a m) - */ -PROOF extern thm GMAP_RA_ALLOC_STRONG; - -/* - * Fresh allocation when the entire key type is infinite: - * - * forall - * (R:(V)ra) - * (m:(K,V)finmap) - * (a:V). - * INFINITE (UNIV:K->bool) ==> - * ra_valid R a ==> - * ra_update_nd - * (gmap_ra R) - * m - * (\result:(K,V)finmap. - * exists key:K. - * finmap_lookup m key == NONE && - * result == finmap_insert key a m) - */ +/* Fresh allocation on an infinite key type. */ PROOF extern thm GMAP_RA_ALLOC; -/* - * Cofinite fresh allocation: the selected key additionally avoids any - * caller-supplied finite forbidden set: - * - * forall - * (R:(V)ra) - * (forbidden:K->bool) - * (m:(K,V)finmap) - * (a:V). - * INFINITE (UNIV:K->bool) ==> - * FINITE forbidden ==> - * ra_valid R a ==> - * ra_update_nd - * (gmap_ra R) - * m - * (\result:(K,V)finmap. - * exists key:K. - * ~(key IN forbidden) && - * finmap_lookup m key == NONE && - * result == finmap_insert key a m) - */ +/* Fresh allocation while avoiding a finite forbidden set. */ PROOF extern thm GMAP_RA_ALLOC_COFINITE; - -/* - * Allocate a valid payload into the empty map at some fresh key: - * - * forall (R:(V)ra) (a:V). - * INFINITE (UNIV:K->bool) ==> - * ra_valid R a ==> - * ra_update_nd - * (gmap_ra R) - * (finmap_empty:(K,V)finmap) - * (\result:(K,V)finmap. - * exists key:K. - * result == finmap_singleton key a) - */ -PROOF extern thm GMAP_RA_ALLOC_EMPTY; diff --git a/theory/logic/gmap_ra_internal.h b/theory/logic/gmap_ra_internal.h new file mode 100644 index 0000000..11e6c01 --- /dev/null +++ b/theory/logic/gmap_ra_internal.h @@ -0,0 +1,11 @@ +#pragma once + +/* Constructor/adapter-only helpers for the pointwise finite-map RA. */ + +#include "proof/theory/logic/gmap_ra.h" + +PROOF extern thm GMAP_RA_SINGLETON_OP; +PROOF extern thm GMAP_RA_SINGLETON_OP_FRESH; +PROOF extern thm GMAP_RA_UPDATE_SINGLETON; +PROOF extern thm GMAP_RA_UPDATEP_SINGLETON; +PROOF extern thm GMAP_RA_ALLOC_STRONG; diff --git a/theory/logic/local_update.c b/theory/logic/local_update.c index 9cdb6cf..9d44aa1 100644 --- a/theory/logic/local_update.c +++ b/theory/logic/local_update.c @@ -1,4 +1,5 @@ #include "proof/theory/logic/local_update.h" +#include "proof/theory/logic/ra_internal.h" #include "proof/proof_backward.h" #require "proof/proof_backward.c" @@ -8,30 +9,21 @@ PROOF static size_t LOCAL_UPDATE_AXIOMS_BEFORE = vector_size(get_all_axioms()); PROOF thm ra_local_update_def = new_fun_definition(` - ra_local_update - (R:(A)ra) - (source:A#A) - (target:A#A) <=> - forall frame:A. - ra_valid R (FST source) ==> - FST source == ra_op R (SND source) frame ==> - ra_valid R (FST target) && - FST target == ra_op R (SND target) frame + ra_local_update (R:(A)ra) (a:A) (f:A) (b:A) (g:A) <=> + forall residual:A. + ra_valid R a ==> + a == ra_op R f residual ==> + ra_valid R b && b == ra_op R g residual `); /* The public eliminator avoids unfolding the relation at each call site. */ PROOF static thm prove_ra_local_update_apply(void) { term goal_tm = ` - forall - (R:(A)ra) - (source:A#A) - (target:A#A) - (frame:A). - ra_local_update R source target ==> - ra_valid R (FST source) ==> - FST source == ra_op R (SND source) frame ==> - ra_valid R (FST target) && - FST target == ra_op R (SND target) frame + forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A) (residual:A). + ra_local_update R a f b g ==> + ra_valid R a ==> + a == ra_op R f residual ==> + ra_valid R b && b == ra_op R g residual `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( @@ -41,20 +33,17 @@ PROOF static thm prove_ra_local_update_apply(void) { thm result = mp_rule( mp_rule( spec_rule( - `frame:A`, + `residual:A`, assume_rule(` - forall frame:A. - ra_valid (R:(A)ra) (FST (source:A#A)) ==> - FST source == ra_op R (SND source) frame ==> - ra_valid R (FST (target:A#A)) && - FST target == ra_op R (SND target) frame + forall residual:A. + ra_valid (R:(A)ra) (a:A) ==> + a == ra_op R (f:A) residual ==> + ra_valid R (b:A) && + b == ra_op R (g:A) residual `)), - assume_rule(` - ra_valid (R:(A)ra) (FST (source:A#A)) - `)), + assume_rule(`ra_valid (R:(A)ra) (a:A)`)), assume_rule(` - FST (source:A#A) == - ra_op (R:(A)ra) (SND source) (frame:A) + (a:A) == ra_op (R:(A)ra) (f:A) (residual:A) `)); ACCEPT_TAC(body, result); return gnode_prove(root); @@ -65,8 +54,8 @@ PROOF thm RA_LOCAL_UPDATE_APPLY = PROOF static thm prove_ra_local_update_refl(void) { term goal_tm = ` - forall (R:(A)ra) (source:A#A). - ra_local_update R source source + forall (R:(A)ra) (a:A) (f:A). + ra_local_update R a f a f `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( @@ -76,12 +65,11 @@ PROOF static thm prove_ra_local_update_refl(void) { gnode_list result = CONJ_TAC(body); ACCEPT_TAC( result[0], - assume_rule(`ra_valid (R:(A)ra) (FST (source:A#A))`)); + assume_rule(`ra_valid (R:(A)ra) (a:A)`)); ACCEPT_TAC( result[1], assume_rule(` - FST (source:A#A) == - ra_op (R:(A)ra) (SND source) (frame:A) + (a:A) == ra_op (R:(A)ra) (f:A) (residual:A) `)); return gnode_prove(root); } @@ -89,44 +77,12 @@ PROOF static thm prove_ra_local_update_refl(void) { PROOF thm RA_LOCAL_UPDATE_REFL = prove_ra_local_update_refl(); -/* The source-validity guard in the definition makes an invalid whole admit - * every local update, independently of either owned component. */ -PROOF static thm prove_ra_local_update_invalid(void) { - term goal_tm = ` - forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). - ~(ra_valid R a) ==> - ra_local_update R (a,f) (b,g) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = CONV_TAC( - root, - once_rewrite_conv(THM_LIST(ra_local_update_def))); - body = CONV_TAC( - body, - rewrite_conv(THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")))); - body = AUTO_INTROS_TAC(body); - thm contradiction = not_elim_rule( - assume_rule(`~(ra_valid (R:(A)ra) (a:A))`), - assume_rule(`ra_valid (R:(A)ra) (a:A)`)); - CONTR_TAC(body, contradiction); - return gnode_prove(root); -} - -PROOF thm RA_LOCAL_UPDATE_INVALID = - prove_ra_local_update_invalid(); - PROOF static thm prove_ra_local_update_trans(void) { term goal_tm = ` - forall - (R:(A)ra) - (source:A#A) - (middle:A#A) - (target:A#A). - ra_local_update R source middle ==> - ra_local_update R middle target ==> - ra_local_update R source target + forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A) (c:A) (h:A). + ra_local_update R a f b g ==> + ra_local_update R b g c h ==> + ra_local_update R a f c h `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( @@ -137,31 +93,28 @@ PROOF static thm prove_ra_local_update_trans(void) { thm middle_result = mp_rule( mp_rule( spec_rule( - `frame:A`, + `residual:A`, assume_rule(` - forall frame:A. - ra_valid (R:(A)ra) (FST (source:A#A)) ==> - FST source == ra_op R (SND source) frame ==> - ra_valid R (FST (middle:A#A)) && - FST middle == ra_op R (SND middle) frame + forall residual:A. + ra_valid (R:(A)ra) (a:A) ==> + a == ra_op R (f:A) residual ==> + ra_valid R (b:A) && + b == ra_op R (g:A) residual `)), - assume_rule(` - ra_valid (R:(A)ra) (FST (source:A#A)) - `)), + assume_rule(`ra_valid (R:(A)ra) (a:A)`)), assume_rule(` - FST (source:A#A) == - ra_op (R:(A)ra) (SND source) (frame:A) + (a:A) == ra_op (R:(A)ra) (f:A) (residual:A) `)); thm target_result = mp_rule( mp_rule( spec_rule( - `frame:A`, + `residual:A`, assume_rule(` - forall frame:A. - ra_valid (R:(A)ra) (FST (middle:A#A)) ==> - FST middle == ra_op R (SND middle) frame ==> - ra_valid R (FST (target:A#A)) && - FST target == ra_op R (SND target) frame + forall residual:A. + ra_valid (R:(A)ra) (b:A) ==> + b == ra_op R (g:A) residual ==> + ra_valid R (c:A) && + c == ra_op R (h:A) residual `)), conjunct1_rule(middle_result)), conjunct2_rule(middle_result)); @@ -179,19 +132,13 @@ PROOF static thm prove_ra_local_update_frame(void) { (a:A) (f:A) (b:A) (g:A) (extra:A). - ra_local_update R (a,f) (b,g) ==> - ra_local_update - R - (a,ra_op R f extra) - (b,ra_op R g extra) + ra_local_update R a f b g ==> + ra_local_update R a (ra_op R f extra) b (ra_op R g extra) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - pure_rewrite_conv(THM_LIST( - ra_local_update_def, - get_theorem_by_name("FST"), - get_theorem_by_name("SND")))); + pure_rewrite_conv(THM_LIST(ra_local_update_def))); body = AUTO_INTROS_TAC(body); thm source_reassociated = trans_rule( @@ -200,21 +147,21 @@ PROOF static thm prove_ra_local_update_frame(void) { ra_op (R:(A)ra) (ra_op R (f:A) (extra:A)) - (frame:A) + (residual:A) `), ispecl_rule( - TERM_LIST(`R:(A)ra`, `f:A`, `extra:A`, `frame:A`), + TERM_LIST(`R:(A)ra`, `f:A`, `extra:A`, `residual:A`), RA_ASSOC)); thm updated = mp_rule( mp_rule( spec_rule( - `ra_op (R:(A)ra) (extra:A) (frame:A)`, + `ra_op (R:(A)ra) (extra:A) (residual:A)`, assume_rule(` - forall frame:A. + forall residual:A. ra_valid (R:(A)ra) (a:A) ==> - a == ra_op R (f:A) frame ==> + a == ra_op R (f:A) residual ==> ra_valid R (b:A) && - b == ra_op R (g:A) frame + b == ra_op R (g:A) residual `)), assume_rule(`ra_valid (R:(A)ra) (a:A)`)), source_reassociated); @@ -224,7 +171,7 @@ PROOF static thm prove_ra_local_update_frame(void) { thm target_reassociated = trans_rule( conjunct2_rule(updated), gsym_rule(ispecl_rule( - TERM_LIST(`R:(A)ra`, `g:A`, `extra:A`, `frame:A`), + TERM_LIST(`R:(A)ra`, `g:A`, `extra:A`, `residual:A`), RA_ASSOC))); ACCEPT_TAC(result[1], target_reassociated); return gnode_prove(root); @@ -240,7 +187,7 @@ PROOF static thm prove_ra_local_update_preserves_included(void) { (a:A) (f:A) (b:A) (g:A) (external:A). - ra_local_update R (a,f) (b,g) ==> + ra_local_update R a f b g ==> ra_valid R a ==> ra_included R (ra_op R f external) a ==> ra_valid R b && @@ -271,27 +218,20 @@ PROOF static thm prove_ra_local_update_preserves_included(void) { ispecl_rule( TERM_LIST(`R:(A)ra`, `f:A`, `external:A`, `slack:A`), RA_ASSOC)); - thm local_at_residual = rewrite_rule( - THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")), - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `((a:A),(f:A))`, - `((b:A),(g:A))`, - `ra_op (R:(A)ra) (external:A) (slack:A)`), - RA_LOCAL_UPDATE_APPLY)); + thm local_at_residual = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `f:A`, + `b:A`, + `g:A`, + `ra_op (R:(A)ra) (external:A) (slack:A)`), + RA_LOCAL_UPDATE_APPLY); thm updated = mp_rule( mp_rule( mp_rule( local_at_residual, - assume_rule(` - ra_local_update - (R:(A)ra) - ((a:A),(f:A)) - ((b:A),(g:A)) - `)), + assume_rule(`ra_local_update (R:(A)ra) (a:A) (f:A) (b:A) (g:A)`)), assume_rule(`ra_valid (R:(A)ra) (a:A)`)), source_reassociated); @@ -314,65 +254,17 @@ PROOF static thm prove_ra_local_update_preserves_included(void) { PROOF thm RA_LOCAL_UPDATE_PRESERVES_INCLUDED = prove_ra_local_update_preserves_included(); -/* Choose the base unit as the explicit external resource. Unit - * normalization turns the framed inclusion result back into g <= b. */ -PROOF static thm prove_ra_local_update_valid_included(void) { - term goal_tm = ` - forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). - ra_local_update R (a,f) (b,g) ==> - ra_valid R a ==> - ra_included R f a ==> - ra_valid R b && ra_included R g b - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - thm unit_rule = rewrite_rule( - THM_LIST(RA_UNIT_R), - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `a:A`, - `f:A`, - `b:A`, - `g:A`, - `ra_unit (R:(A)ra)`), - RA_LOCAL_UPDATE_PRESERVES_INCLUDED)); - thm preserved = mp_rule( - mp_rule( - mp_rule( - unit_rule, - assume_rule(` - ra_local_update - (R:(A)ra) - ((a:A),(f:A)) - ((b:A),(g:A)) - `)), - assume_rule(`ra_valid (R:(A)ra) (a:A)`)), - assume_rule(`ra_included (R:(A)ra) (f:A) (a:A)`)); - ACCEPT_TAC(body, preserved); - return gnode_prove(root); -} - -PROOF thm RA_LOCAL_UPDATE_VALID_INCLUDED = - prove_ra_local_update_valid_included(); - PROOF static thm prove_ra_local_update_op(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (f:A) (piece:A). (ra_valid R a ==> ra_valid R (ra_op R a piece)) ==> - ra_local_update - R - (a,f) - (ra_op R a piece,ra_op R f piece) + ra_local_update R a f (ra_op R a piece) (ra_op R f piece) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - pure_rewrite_conv(THM_LIST( - ra_local_update_def, - get_theorem_by_name("FST"), - get_theorem_by_name("SND")))); + pure_rewrite_conv(THM_LIST(ra_local_update_def))); body = AUTO_INTROS_TAC(body); gnode_list result = CONJ_TAC(body); ACCEPT_TAC( @@ -388,26 +280,23 @@ PROOF static thm prove_ra_local_update_op(void) { `\x:A. ra_op (R:(A)ra) x (piece:A)`, assume_rule(` (a:A) == - ra_op (R:(A)ra) (f:A) (frame:A) + ra_op (R:(A)ra) (f:A) (residual:A) `))); thm swapped = ispecl_rule( - TERM_LIST(`R:(A)ra`, `f:A`, `frame:A`, `piece:A`), + TERM_LIST(`R:(A)ra`, `f:A`, `residual:A`, `piece:A`), RA_OP_SWAP_RIGHT); ACCEPT_TAC(result[1], trans_rule(lifted_source, swapped)); return gnode_prove(root); } -PROOF thm RA_LOCAL_UPDATE_OP = +PROOF static thm RA_LOCAL_UPDATE_OP = prove_ra_local_update_op(); PROOF static thm prove_ra_local_update_alloc(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (f:A) (piece:A). ra_valid R (ra_op R a piece) ==> - ra_local_update - R - (a,f) - (ra_op R a piece,ra_op R f piece) + ra_local_update R a f (ra_op R a piece) (ra_op R f piece) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); @@ -435,15 +324,12 @@ PROOF static thm prove_ra_local_update_exclusive(void) { forall (R:(A)ra) (a:A) (f:A) (b:A). ra_exclusive R f ==> ra_valid R b ==> - ra_local_update R (a,f) (b,b) + ra_local_update R a f b b `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - pure_rewrite_conv(THM_LIST( - ra_local_update_def, - get_theorem_by_name("FST"), - get_theorem_by_name("SND")))); + pure_rewrite_conv(THM_LIST(ra_local_update_def))); body = AUTO_INTROS_TAC(body); thm source_valid = eq_mp_rule( @@ -451,14 +337,15 @@ PROOF static thm prove_ra_local_update_exclusive(void) { `ra_valid (R:(A)ra)`, assume_rule(` (a:A) == - ra_op (R:(A)ra) (f:A) (frame:A) + ra_op (R:(A)ra) (f:A) (residual:A) `)), assume_rule(`ra_valid (R:(A)ra) (a:A)`)); thm exclusive = rewrite_rule( THM_LIST(ra_exclusive_def), assume_rule(`ra_exclusive (R:(A)ra) (f:A)`)); + exclusive = conjunct2_rule(exclusive); thm frame_is_unit = mp_rule( - spec_rule(`frame:A`, exclusive), + spec_rule(`residual:A`, exclusive), source_valid); gnode_list result = CONJ_TAC(body); @@ -483,18 +370,12 @@ PROOF static thm prove_ra_local_update_cancel(void) { term goal_tm = ` forall (R:(A)ra) (common:A) (a:A) (f:A). ra_cancellative R ==> - ra_local_update - R - (ra_op R common a,ra_op R common f) - (a,f) + ra_local_update R (ra_op R common a) (ra_op R common f) a f `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - pure_rewrite_conv(THM_LIST( - ra_local_update_def, - get_theorem_by_name("FST"), - get_theorem_by_name("SND")))); + pure_rewrite_conv(THM_LIST(ra_local_update_def))); body = AUTO_INTROS_TAC(body); gnode_list result = CONJ_TAC(body); ACCEPT_TAC( @@ -514,10 +395,10 @@ PROOF static thm prove_ra_local_update_cancel(void) { ra_op (R:(A)ra) (common:A) (a:A) == ra_op R (ra_op R common (f:A)) - (frame:A) + (residual:A) `), ispecl_rule( - TERM_LIST(`R:(A)ra`, `common:A`, `f:A`, `frame:A`), + TERM_LIST(`R:(A)ra`, `common:A`, `f:A`, `residual:A`), RA_ASSOC)); thm cancelled = mp_rule( mp_rule( @@ -527,7 +408,7 @@ PROOF static thm prove_ra_local_update_cancel(void) { `R:(A)ra`, `common:A`, `a:A`, - `ra_op (R:(A)ra) (f:A) (frame:A)`), + `ra_op (R:(A)ra) (f:A) (residual:A)`), RA_CANCELLATIVE_APPLY), assume_rule(`ra_cancellative (R:(A)ra)`)), assume_rule(` @@ -547,10 +428,7 @@ PROOF static thm prove_ra_local_update_cancel_unit(void) { term goal_tm = ` forall (R:(A)ra) (common:A) (a:A). ra_cancellative R ==> - ra_local_update - R - (ra_op R common a,common) - (a,ra_unit R) + ra_local_update R (ra_op R common a) common a (ra_unit R) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); @@ -571,7 +449,7 @@ PROOF static thm prove_ra_local_update_cancel_unit(void) { return gnode_prove(root); } -PROOF thm RA_LOCAL_UPDATE_CANCEL_UNIT = +PROOF static thm RA_LOCAL_UPDATE_CANCEL_UNIT = prove_ra_local_update_cancel_unit(); PROOF static thm prove_ra_local_update_cancellative(void) { @@ -579,10 +457,7 @@ PROOF static thm prove_ra_local_update_cancellative(void) { forall (R:(A)ra) (a:A) (b:A) (common:A). ra_cancellative R ==> ra_valid R (ra_op R b common) ==> - ra_local_update - R - (ra_op R a common,a) - (ra_op R b common,b) + ra_local_update R (ra_op R a common) a (ra_op R b common) b `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); @@ -616,10 +491,12 @@ PROOF static thm prove_ra_local_update_cancellative(void) { ispecl_rule( TERM_LIST( `R:(A)ra`, - `((ra_op (R:(A)ra) (a:A) (common:A)),(a:A))`, - `((common:A),(ra_unit (R:(A)ra)))`, - `((ra_op (R:(A)ra) (common:A) (b:A)), - (ra_op R (ra_unit R) b))`), + `ra_op (R:(A)ra) (a:A) (common:A)`, + `a:A`, + `common:A`, + `ra_unit (R:(A)ra)`, + `ra_op (R:(A)ra) (common:A) (b:A)`, + `ra_op (R:(A)ra) (ra_unit R) (b:A)`), RA_LOCAL_UPDATE_TRANS), cancelled), allocated); @@ -640,16 +517,12 @@ PROOF static int audit_local_update(void) { ra_local_update_def, RA_LOCAL_UPDATE_APPLY, RA_LOCAL_UPDATE_REFL, - RA_LOCAL_UPDATE_INVALID, RA_LOCAL_UPDATE_TRANS, RA_LOCAL_UPDATE_FRAME, RA_LOCAL_UPDATE_PRESERVES_INCLUDED, - RA_LOCAL_UPDATE_VALID_INCLUDED, - RA_LOCAL_UPDATE_OP, RA_LOCAL_UPDATE_ALLOC, RA_LOCAL_UPDATE_EXCLUSIVE, RA_LOCAL_UPDATE_CANCEL, - RA_LOCAL_UPDATE_CANCEL_UNIT, RA_LOCAL_UPDATE_CANCELLATIVE); for (size_t i = 0; i < vector_size(public_theorems); ++i) { diff --git a/theory/logic/local_update.h b/theory/logic/local_update.h index 46f6f47..ac22c55 100644 --- a/theory/logic/local_update.h +++ b/theory/logic/local_update.h @@ -1,196 +1,16 @@ #pragma once -/* - * Iris-style local updates for discrete unital resource algebras. - * - * A pair `(whole, owned)` describes a resource together with the part owned - * locally. A hidden residual `frame` completes the local part to the whole: - * - * whole == ra_op R owned frame. - * - * A local update changes both visible components while preserving that same - * hidden residual. Unlike `ra_update`, this relation is intended primarily - * as the algebraic premise of constructor-specific update rules (notably the - * authoritative RA). - */ +/* Five-argument local updates preserving one unknown residual resource. */ #include "proof/theory/logic/ra.h" -/* ------------------------------------------------------------------------- */ -/* Definition and direct application */ -/* ------------------------------------------------------------------------- */ - -/* - * forall (R:(A)ra) (source:A#A) (target:A#A). - * ra_local_update R source target <=> - * forall frame:A. - * ra_valid R (FST source) ==> - * FST source == ra_op R (SND source) frame ==> - * ra_valid R (FST target) && - * FST target == ra_op R (SND target) frame - */ PROOF extern thm ra_local_update_def; - -/* - * forall - * (R:(A)ra) - * (source:A#A) - * (target:A#A) - * (frame:A). - * ra_local_update R source target ==> - * ra_valid R (FST source) ==> - * FST source == ra_op R (SND source) frame ==> - * ra_valid R (FST target) && - * FST target == ra_op R (SND target) frame - */ PROOF extern thm RA_LOCAL_UPDATE_APPLY; - -/* ------------------------------------------------------------------------- */ -/* Structural laws */ -/* ------------------------------------------------------------------------- */ - -/* - * forall (R:(A)ra) (source:A#A). - * ra_local_update R source source - */ PROOF extern thm RA_LOCAL_UPDATE_REFL; - -/* - * A local update from an invalid whole is vacuous: - * - * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). - * ~(ra_valid R a) ==> - * ra_local_update R (a,f) (b,g) - */ -PROOF extern thm RA_LOCAL_UPDATE_INVALID; - -/* - * forall (R:(A)ra) (source:A#A) (middle:A#A) (target:A#A). - * ra_local_update R source middle ==> - * ra_local_update R middle target ==> - * ra_local_update R source target - */ PROOF extern thm RA_LOCAL_UPDATE_TRANS; - -/* - * Add the same visible frame to the local component on both sides: - * - * forall - * (R:(A)ra) - * (a:A) (f:A) - * (b:A) (g:A) - * (extra:A). - * ra_local_update R (a,f) (b,g) ==> - * ra_local_update - * R - * (a,ra_op R f extra) - * (b,ra_op R g extra) - */ PROOF extern thm RA_LOCAL_UPDATE_FRAME; - -/* - * A local update preserves every externally framed inclusion: - * - * forall - * (R:(A)ra) - * (a:A) (f:A) - * (b:A) (g:A) - * (external:A). - * ra_local_update R (a,f) (b,g) ==> - * ra_valid R a ==> - * ra_included R (ra_op R f external) a ==> - * ra_valid R b && - * ra_included R (ra_op R g external) b - */ PROOF extern thm RA_LOCAL_UPDATE_PRESERVES_INCLUDED; - -/* - * Preserve validity and ownership inclusion without exposing a residual: - * - * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). - * ra_local_update R (a,f) (b,g) ==> - * ra_valid R a ==> - * ra_included R f a ==> - * ra_valid R b && ra_included R g b - * - * This is `RA_LOCAL_UPDATE_PRESERVES_INCLUDED` at the unit external frame. - */ -PROOF extern thm RA_LOCAL_UPDATE_VALID_INCLUDED; - -/* ------------------------------------------------------------------------- */ -/* Allocation and cancellation */ -/* ------------------------------------------------------------------------- */ - -/* - * Extend the whole and the locally owned part by the same piece, provided - * the extension preserves validity whenever the source whole is valid: - * - * forall (R:(A)ra) (a:A) (f:A) (piece:A). - * (ra_valid R a ==> - * ra_valid R (ra_op R a piece)) ==> - * ra_local_update - * R - * (a,f) - * (ra_op R a piece,ra_op R f piece) - */ -PROOF extern thm RA_LOCAL_UPDATE_OP; - -/* - * Extend the whole and the locally owned part by the same piece: - * - * forall (R:(A)ra) (a:A) (f:A) (piece:A). - * ra_valid R (ra_op R a piece) ==> - * ra_local_update - * R - * (a,f) - * (ra_op R a piece,ra_op R f piece) - */ PROOF extern thm RA_LOCAL_UPDATE_ALLOC; - -/* - * An exclusive local component leaves only the unit as hidden residual, so - * it permits replacement by any valid whole owned in full: - * - * forall (R:(A)ra) (a:A) (f:A) (b:A). - * ra_exclusive R f ==> - * ra_valid R b ==> - * ra_local_update R (a,f) (b,b) - */ PROOF extern thm RA_LOCAL_UPDATE_EXCLUSIVE; - -/* - * Cancel a common prefix from the whole and local components: - * - * forall (R:(A)ra) (common:A) (a:A) (f:A). - * ra_cancellative R ==> - * ra_local_update - * R - * (ra_op R common a,ra_op R common f) - * (a,f) - */ PROOF extern thm RA_LOCAL_UPDATE_CANCEL; - -/* - * Cancel the entire common local component: - * - * forall (R:(A)ra) (common:A) (a:A). - * ra_cancellative R ==> - * ra_local_update - * R - * (ra_op R common a,common) - * (a,ra_unit R) - */ -PROOF extern thm RA_LOCAL_UPDATE_CANCEL_UNIT; - -/* - * Synchronized replacement in a cancellative RA: - * - * forall (R:(A)ra) (a:A) (b:A) (common:A). - * ra_cancellative R ==> - * ra_valid R (ra_op R b common) ==> - * ra_local_update - * R - * (ra_op R a common,a) - * (ra_op R b common,b) - */ PROOF extern thm RA_LOCAL_UPDATE_CANCELLATIVE; diff --git a/theory/logic/max_nat_ra.c b/theory/logic/max_nat_ra.c index 12ca846..2554547 100644 --- a/theory/logic/max_nat_ra.c +++ b/theory/logic/max_nat_ra.c @@ -3,7 +3,6 @@ #include "proof/proof_backward.h" #require "proof/proof_backward.c" -#require "proof/theory/logic/local_update.c" #require "proof/theory/logic/ra.c" PROOF static size_t MAX_NAT_RA_AXIOMS_BEFORE = @@ -368,7 +367,7 @@ PROOF static thm prove_max_nat_ra_included_zero(void) { return gnode_prove(root); } -PROOF thm MAX_NAT_RA_INCLUDED_ZERO = +PROOF static thm MAX_NAT_RA_INCLUDED_ZERO = prove_max_nat_ra_included_zero(); PROOF static thm prove_max_nat_ra_included_op(void) { @@ -391,7 +390,7 @@ PROOF static thm prove_max_nat_ra_included_op(void) { return gnode_prove(root); } -PROOF thm MAX_NAT_RA_INCLUDED_OP = +PROOF static thm MAX_NAT_RA_INCLUDED_OP = prove_max_nat_ra_included_op(); PROOF static thm prove_max_nat_ra_idempotent(void) { @@ -440,7 +439,7 @@ PROOF static thm prove_max_nat_ra_op_eq_right(void) { return gnode_prove(root); } -PROOF thm MAX_NAT_RA_OP_EQ_RIGHT = +PROOF static thm MAX_NAT_RA_OP_EQ_RIGHT = prove_max_nat_ra_op_eq_right(); PROOF static thm prove_max_nat_ra_op_eq_left(void) { @@ -472,7 +471,7 @@ PROOF static thm prove_max_nat_ra_op_eq_left(void) { return gnode_prove(root); } -PROOF thm MAX_NAT_RA_OP_EQ_LEFT = +PROOF static thm MAX_NAT_RA_OP_EQ_LEFT = prove_max_nat_ra_op_eq_left(); /* All frames are compatible because validity is total; choosing frame one @@ -487,6 +486,7 @@ PROOF static thm prove_max_nat_ra_not_exclusive(void) { thm exclusive = rewrite_rule( THM_LIST(ra_exclusive_def), assume_rule(`ra_exclusive max_nat_ra (n:num)`)); + exclusive = conjunct2_rule(exclusive); thm frame_is_unit = mp_rule( spec_rule(`1`, exclusive), ispec_rule( @@ -502,7 +502,7 @@ PROOF static thm prove_max_nat_ra_not_exclusive(void) { return gnode_prove(root); } -PROOF thm MAX_NAT_RA_NOT_EXCLUSIVE = +PROOF static thm MAX_NAT_RA_NOT_EXCLUSIVE = prove_max_nat_ra_not_exclusive(); /* The common frame one absorbs both zero and one, witnessing failure of @@ -542,7 +542,7 @@ PROOF static thm prove_max_nat_ra_not_cancellative(void) { return gnode_prove(root); } -PROOF thm MAX_NAT_RA_NOT_CANCELLATIVE = +PROOF static thm MAX_NAT_RA_NOT_CANCELLATIVE = prove_max_nat_ra_not_cancellative(); PROOF static thm prove_max_nat_ra_included_mono_right(void) { @@ -586,91 +586,13 @@ PROOF static thm prove_max_nat_ra_included_mono_right(void) { return gnode_prove(root); } -PROOF thm MAX_NAT_RA_INCLUDED_MONO_RIGHT = +PROOF static thm MAX_NAT_RA_INCLUDED_MONO_RIGHT = prove_max_nat_ra_included_mono_right(); /* ------------------------------------------------------------------------- */ /* Frame-preserving updates */ /* ------------------------------------------------------------------------- */ -/* Preserving an empty local component exposes the source whole itself as a - * residual, forcing the target whole to be unchanged. */ -PROOF static thm prove_max_nat_ra_local_update_unit_iff(void) { - term goal_tm = ` - forall old new:num. - ra_local_update max_nat_ra (old,0) (new,0) <=> - old == new - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - gnode_list directions = EQ_TAC(body); - - gnode forward = DISCH_TAC(directions[0], "Hlocal"); - thm applied = ispecl_rule( - TERM_LIST( - `max_nat_ra`, - `((old:num),0)`, - `((new:num),0)`, - `old:num`), - RA_LOCAL_UPDATE_APPLY); - applied = rewrite_rule( - THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")), - applied); - applied = mp_rule( - applied, - assume_rule(` - ra_local_update - max_nat_ra - ((old:num),0) - ((new:num),0) - `)); - applied = mp_rule( - applied, - ispec_rule(`old:num`, MAX_NAT_RA_VALID)); - thm source_unit = ispecl_rule( - TERM_LIST(`max_nat_ra`, `old:num`), - RA_UNIT_L); - source_unit = rewrite_rule( - THM_LIST(MAX_NAT_RA_UNIT), - source_unit); - applied = mp_rule(applied, gsym_rule(source_unit)); - thm target_unit = ispecl_rule( - TERM_LIST(`max_nat_ra`, `old:num`), - RA_UNIT_L); - target_unit = rewrite_rule( - THM_LIST(MAX_NAT_RA_UNIT), - target_unit); - ACCEPT_TAC( - forward, - gsym_rule(trans_rule( - conjunct2_rule(applied), - target_unit))); - - gnode reverse = DISCH_TAC(directions[1], "Heq"); - thm target_pair_eq = ap_term_rule( - `\x:num. (x,0)`, - assume_rule(`(old:num) == (new:num)`)); - thm target_transport = beta_rule(ap_term_rule( - `\target:num#num. - ra_local_update - max_nat_ra - ((old:num),0) - target`, - target_pair_eq)); - thm reflexive = ispecl_rule( - TERM_LIST( - `max_nat_ra`, - `((old:num),0)`), - RA_LOCAL_UPDATE_REFL); - ACCEPT_TAC(reverse, eq_mp_rule(target_transport, reflexive)); - return gnode_prove(root); -} - -PROOF thm MAX_NAT_RA_LOCAL_UPDATE_UNIT_IFF = - prove_max_nat_ra_local_update_unit_iff(); - PROOF static thm prove_max_nat_ra_update(void) { term goal_tm = ` forall old new:num. @@ -679,13 +601,18 @@ PROOF static thm prove_max_nat_ra_update(void) { gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - once_rewrite_conv(THM_LIST(ra_update_def))); - body = GEN_TAC(body, "old"); - body = GEN_TAC(body, "new"); - body = GEN_TAC(body, "frame"); - body = DISCH_TAC(body, "Hsource_valid"); - ACCEPT_TAC( + pure_rewrite_conv(THM_LIST( + ra_update_def, + ra_updateP_def))); + body = CONV_TAC( body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = AUTO_INTROS_TAC(body); + body = EXISTS_TAC(body, `new:num`); + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC(result[0], refl_rule(`new:num`)); + ACCEPT_TAC( + result[1], spec_rule( `ra_op max_nat_ra (new:num) (frame:num)`, MAX_NAT_RA_VALID)); @@ -695,11 +622,11 @@ PROOF static thm prove_max_nat_ra_update(void) { PROOF thm MAX_NAT_RA_UPDATE = prove_max_nat_ra_update(); -PROOF static thm prove_max_nat_ra_update_nd(void) { +PROOF static thm prove_max_nat_ra_updateP(void) { term goal_tm = ` forall (old:num) (P:num->bool). (exists new:num. P new) ==> - ra_update_nd max_nat_ra old P + ra_updateP max_nat_ra old P `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = GEN_TAC(root, "old"); @@ -711,7 +638,7 @@ PROOF static thm prove_max_nat_ra_update_nd(void) { "new"); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); + once_rewrite_conv(THM_LIST(ra_updateP_def))); body = GEN_TAC(body, "frame"); body = DISCH_TAC(body, "Hsource_valid"); body = EXISTS_TAC(body, `new:num`); @@ -727,13 +654,13 @@ PROOF static thm prove_max_nat_ra_update_nd(void) { return gnode_prove(root); } -PROOF thm MAX_NAT_RA_UPDATE_ND = - prove_max_nat_ra_update_nd(); +PROOF static thm MAX_NAT_RA_UPDATEP = + prove_max_nat_ra_updateP(); -PROOF static thm prove_max_nat_ra_update_nd_iff(void) { +PROOF static thm prove_max_nat_ra_updateP_iff(void) { term goal_tm = ` forall (old:num) (P:num->bool). - ra_update_nd max_nat_ra old P <=> + ra_updateP max_nat_ra old P <=> exists new:num. P new `; gnode root = gnode_new_with_ccl(goal_tm); @@ -747,11 +674,11 @@ PROOF static thm prove_max_nat_ra_update_nd_iff(void) { `max_nat_ra:(num)ra`, `old:num`, `P:num->bool`), - RA_UPDATE_ND_VALID); + RA_UPDATEP_VALID); selected = mp_rule( selected, assume_rule(` - ra_update_nd + ra_updateP max_nat_ra (old:num) (P:num->bool) @@ -780,13 +707,13 @@ PROOF static thm prove_max_nat_ra_update_nd_iff(void) { mp_rule( ispecl_rule( TERM_LIST(`old:num`, `P:num->bool`), - MAX_NAT_RA_UPDATE_ND), + MAX_NAT_RA_UPDATEP), assume_rule(`exists new:num. (P:num->bool) new`))); return gnode_prove(root); } -PROOF thm MAX_NAT_RA_UPDATE_ND_IFF = - prove_max_nat_ra_update_nd_iff(); +PROOF static thm MAX_NAT_RA_UPDATEP_IFF = + prove_max_nat_ra_updateP_iff(); /* ------------------------------------------------------------------------- */ /* Construction audit */ @@ -818,10 +745,9 @@ PROOF static int audit_max_nat_ra(void) { MAX_NAT_RA_NOT_EXCLUSIVE, MAX_NAT_RA_NOT_CANCELLATIVE, MAX_NAT_RA_INCLUDED_MONO_RIGHT, - MAX_NAT_RA_LOCAL_UPDATE_UNIT_IFF, MAX_NAT_RA_UPDATE, - MAX_NAT_RA_UPDATE_ND, - MAX_NAT_RA_UPDATE_ND_IFF); + MAX_NAT_RA_UPDATEP, + MAX_NAT_RA_UPDATEP_IFF); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { ENSURE_COND(!IS_NULL(audited_theorems[i]), diff --git a/theory/logic/max_nat_ra.h b/theory/logic/max_nat_ra.h index 0eaa3aa..493f3d4 100644 --- a/theory/logic/max_nat_ra.h +++ b/theory/logic/max_nat_ra.h @@ -3,158 +3,28 @@ /* * Natural-number maximum resource algebra. * - * `max_nat_ra:(num)ra` has carrier `num`, uses `0` as the unit, `MAX` as - * composition, and regards every natural number as valid. Its extension - * order is ordinary - * natural-number order: - * - * ra_included max_nat_ra n m <=> n <= m. - * - * The construction is useful as the fragment algebra below an authoritative - * monotonically increasing natural number. Notice that the *base* RA has no - * validity conflicts, so its frame-preserving update relation is universal. - * Monotonicity is enforced when an authoritative value must continue to - * include every compatible fragment, not by base validity. - * - * The raw descriptor, its law proof, and the `ra_abs` projection equations - * remain private to `max_nat_ra.c`. + * `max_nat_ra:(num)ra` has unit `0`, operation `MAX`, and total validity. + * It is a useful idempotent fragment algebra; monotone authority protocols + * are obtained by placing it under `auth_ra`, not by restricting this base + * RA's universal frame-preserving update relation. */ -#include "proof/theory/logic/local_update.h" - -/* ------------------------------------------------------------------------- */ -/* Core representation */ -/* ------------------------------------------------------------------------- */ +#include "proof/theory/logic/ra.h" /* `ra_unit max_nat_ra == 0`. */ PROOF extern thm MAX_NAT_RA_UNIT; -/* `forall n m:num. ra_op max_nat_ra n m == MAX n m`. */ +/* `forall a b:num. ra_op max_nat_ra a b == MAX a b`. */ PROOF extern thm MAX_NAT_RA_OP; -/* ------------------------------------------------------------------------- */ -/* Validity */ -/* ------------------------------------------------------------------------- */ - /* `forall n:num. ra_valid max_nat_ra n`. */ PROOF extern thm MAX_NAT_RA_VALID; -/* ------------------------------------------------------------------------- */ -/* Order and laws */ -/* ------------------------------------------------------------------------- */ - -/* `forall n m:num. ra_included max_nat_ra n m <=> n <= m`. */ +/* `forall a b:num. ra_included max_nat_ra a b <=> a <= b`. */ PROOF extern thm MAX_NAT_RA_INCLUDED; -/* `forall n:num. ra_included max_nat_ra 0 n`. */ -PROOF extern thm MAX_NAT_RA_INCLUDED_ZERO; - -/* - * Inclusion of a composed fragment: - * - * `forall n m bound:num. - * ra_included max_nat_ra (ra_op max_nat_ra n m) bound <=> - * n <= bound && m <= bound` - */ -PROOF extern thm MAX_NAT_RA_INCLUDED_OP; - /* `forall n:num. ra_op max_nat_ra n n == n`. */ PROOF extern thm MAX_NAT_RA_IDEMPOTENT; -/* - * `forall n m:num. - * n <= m ==> ra_op max_nat_ra n m == m` - */ -PROOF extern thm MAX_NAT_RA_OP_EQ_RIGHT; - -/* - * `forall n m:num. - * m <= n ==> ra_op max_nat_ra n m == n` - */ -PROOF extern thm MAX_NAT_RA_OP_EQ_LEFT; - -/* ------------------------------------------------------------------------- */ -/* Negative optional laws */ -/* ------------------------------------------------------------------------- */ - -/* - * Every max-nat element admits the compatible non-unit frame `1`: - * - * forall n:num. ~(ra_exclusive max_nat_ra n) - */ -PROOF extern thm MAX_NAT_RA_NOT_EXCLUSIVE; - -/* - * Idempotence prevents cancellation: - * - * ~(ra_cancellative max_nat_ra) - */ -PROOF extern thm MAX_NAT_RA_NOT_CANCELLATIVE; - -/* ------------------------------------------------------------------------- */ -/* Order: authority-ready monotonicity */ -/* ------------------------------------------------------------------------- */ - -/* - * Raising an upper bound preserves every fragment already included in it: - * - * `forall old new fragment:num. - * old <= new ==> - * ra_included max_nat_ra fragment old ==> - * ra_included max_nat_ra fragment new` - * - * `AUTH_RA_UPDATE_BOTH_INCLUDED` packages this fact when the locally owned - * fragment is unchanged. It remains the basic compatibility step in a direct - * `AUTH_RA_UPDATE_FRAMEWISE` proof when authority and fragment change - * together. Raising a max-nat authority is generally not a base - * `ra_local_update` with an unchanged local fragment. The theorem mentions - * no `auth_ra`, keeping this base construction independent of the - * authoritative construction. - */ -PROOF extern thm MAX_NAT_RA_INCLUDED_MONO_RIGHT; - -/* ------------------------------------------------------------------------- */ -/* Updates */ -/* ------------------------------------------------------------------------- */ - -/* - * With an unchanged unit-owned component, max-nat local update admits no - * authority growth: - * - * forall old new:num. - * ra_local_update max_nat_ra (old,0) (new,0) <=> old == new - * - * This is the precise mismatch between universal base `ra_update` below and - * the stricter residual-preserving relation used by `auth_ra`. - */ -PROOF extern thm MAX_NAT_RA_LOCAL_UPDATE_UNIT_IFF; - -/* - * All deterministic base updates are frame preserving: - * - * `forall old new:num. ra_update max_nat_ra old new` - * - * This strong rule is sound because every framed target is valid. Clients - * needing a monotone counter should place this RA under `auth_ra` and use the - * inclusion theorem above, rather than treating this base update as the - * counter protocol. - */ +/* `forall a b:num. ra_update max_nat_ra a b`. */ PROOF extern thm MAX_NAT_RA_UPDATE; - -/* - * Every inhabited result predicate admits a nondeterministic base update: - * - * `forall old:num. forall P:num->bool. - * (exists new:num. P new) ==> - * ra_update_nd max_nat_ra old P` - */ -PROOF extern thm MAX_NAT_RA_UPDATE_ND; - -/* - * Exact nondeterministic update characterization: - * - * `forall (old:num) (P:num->bool). - * ra_update_nd max_nat_ra old P <=> - * exists new:num. P new` - */ -PROOF extern thm MAX_NAT_RA_UPDATE_ND_IFF; diff --git a/theory/logic/named_logic.c b/theory/logic/named_logic.c new file mode 100644 index 0000000..8a2f539 --- /dev/null +++ b/theory/logic/named_logic.c @@ -0,0 +1,452 @@ +#include "proof/theory/logic/named_logic.h" +#include "proof/theory/logic/gmap_ra_internal.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/basic_update.c" +#require "proof/theory/logic/named_ra.c" + +PROOF static size_t NAMED_LOGIC_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF thm named_own_def = new_fun_definition(` + named_own + (R:(A)ra) + (name:num) + (a:A) : (num,A)finmap->bool = + r_own (named_ra R) (finmap_singleton name a) +`); + +PROOF static thm prove_named_own_op(void) { + term goal_tm = ` + forall (R:(A)ra) (name:num) (a:A) (b:A). + r_equiv + (named_ra R) + (named_own R name (ra_op R a b)) + (r_sep + (named_ra R) + (named_own R name a) + (named_own R name b)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(named_own_def))); + thm result = ispecl_rule( + TERM_LIST( + `named_ra (R:(A)ra)`, + `finmap_singleton (name:num) (a:A)`, + `finmap_singleton (name:num) (b:A)`), + R_OWN_OP); + result = rewrite_rule( + THM_LIST(NAMED_RA_SINGLETON_OP), + result); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm NAMED_OWN_OP = prove_named_own_op(); + +PROOF static thm prove_named_own_valid(void) { + term goal_tm = ` + forall (R:(A)ra) (name:num) (a:A). + r_entails + (named_ra R) + (named_own R name a) + (r_sep + (named_ra R) + (r_fact (named_ra R) (ra_valid R a)) + (named_own R name a)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(named_own_def))); + thm result = ispecl_rule( + TERM_LIST( + `named_ra (R:(A)ra)`, + `finmap_singleton (name:num) (a:A)`), + R_OWN_VALID); + result = rewrite_rule( + THM_LIST(NAMED_RA_VALID_SINGLETON), + result); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm NAMED_OWN_VALID = prove_named_own_valid(); + +PROOF static thm prove_named_own_update(void) { + term goal_tm = ` + forall (R:(A)ra) (name:num) (a:A) (b:A). + ra_update R a b ==> + r_viewshift + (named_ra R) + (named_own R name a) + (named_own R name b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(named_own_def))); + thm map_update = mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `name:num`, `a:A`, `b:A`), + NAMED_RA_UPDATE_SINGLETON), + assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); + thm result = mp_rule( + ispecl_rule( + TERM_LIST( + `named_ra (R:(A)ra)`, + `finmap_singleton (name:num) (a:A)`, + `finmap_singleton (name:num) (b:A)`), + R_OWN_UPDATE), + map_update); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm NAMED_OWN_UPDATE = prove_named_own_update(); + +PROOF static thm prove_named_own_updatep(void) { + term goal_tm = ` + forall (R:(A)ra) (name:num) (a:A) (P:A->bool). + ra_updateP R a P ==> + r_viewshift + (named_ra R) + (named_own R name a) + (r_exists + (named_ra R) + (\b:A. + r_sep + (named_ra R) + (r_fact (named_ra R) (P b)) + (named_own R name b))) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_viewshift_def, + r_entails_def, + r_bupd_def, + named_own_def, + r_own_def, + r_exists_def, + r_sep_def, + r_fact_def, + ra_updateP_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "name"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "P"); + body = DISCH_TAC(body, "Hpayload_update"); + body = GEN_TAC(body, "owned"); + body = DISCH_TAC(body, "Hvalid_owned"); + body = DISCH_TAC(body, "Howned"); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hvalid_source"); + + term_list payload_terms = gnode_get_asmps( + body, + CONST_STRING_LIST("Hpayload_update")); + thm payload_update = eq_mp_rule( + gsym_rule(inst_rule( + TERM_PAIR_LIST( + (term_pair){`P:A->bool`, `result:A->bool`}), + ra_updateP_def)), + assume_rule(payload_terms[0])); + thm map_update = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `name:num`, + `a:A`, + `P:A->bool`), + NAMED_RA_UPDATEP_SINGLETON), + payload_update); + thm unfolded = rewrite_rule(THM_LIST(ra_updateP_def), map_update); + thm source_eq = beta_rule(ap_term_rule( + `\base:(num,A)finmap. + ra_valid + (named_ra (R:(A)ra)) + (ra_op (named_ra R) base (frame:(num,A)finmap))`, + assume_rule(` + (owned:(num,A)finmap) == + finmap_singleton (name:num) (a:A) + `))); + thm source_valid = eq_mp_rule( + source_eq, + assume_rule(` + ra_valid + (named_ra (R:(A)ra)) + (ra_op + (named_ra R) + (owned:(num,A)finmap) + (frame:(num,A)finmap)) + `)); + thm selected = mp_rule( + spec_rule(`frame:(num,A)finmap`, unfolded), + source_valid); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "selected"); + body = ASMP_CONJ_TAC(body, "Hselected", "Himage", "Hvalid_selected"); + body = ASMP_EXISTS_TAC(body, "Himage", "b"); + body = ASMP_CONJ_TAC(body, "Himage", "HP", "Hselected_eq"); + + body = EXISTS_TAC(body, `selected:(num,A)finmap`); + gnode_list update_result = CONJ_TAC(body); + gnode post = EXISTS_TAC(update_result[0], `b:A`); + post = CONV_TAC( + post, + pure_rewrite_conv(THM_LIST(r_sep_def, r_fact_def, r_own_def))); + post = CONV_TAC( + post, + depth_conv(get_conversion_by_name("BETA_CONV"))); + post = EXISTS_TAC(post, `ra_unit (named_ra (R:(A)ra))`); + post = EXISTS_TAC(post, `selected:(num,A)finmap`); + gnode_list split = CONJ_TAC(post); + ACCEPT_TAC( + split[0], + gsym_rule(ispecl_rule( + TERM_LIST(`named_ra (R:(A)ra)`, `selected:(num,A)finmap`), + RA_UNIT_L))); + gnode_list predicates = CONJ_TAC(split[1]); + gnode_list fact = CONJ_TAC(predicates[0]); + ACCEPT_TAC(fact[0], assume_rule(`(P:A->bool) (b:A)`)); + ACCEPT_TAC(fact[1], refl_rule(`ra_unit (named_ra (R:(A)ra))`)); + ACCEPT_TAC( + predicates[1], + assume_rule(` + (selected:(num,A)finmap) == + finmap_singleton (name:num) (b:A) + `)); + ACCEPT_TAC( + update_result[1], + assume_rule(` + ra_valid + (named_ra (R:(A)ra)) + (ra_op + (named_ra R) + (selected:(num,A)finmap) + (frame:(num,A)finmap)) + `)); + return gnode_prove(root); +} + +PROOF thm NAMED_OWN_UPDATEP = prove_named_own_updatep(); + +PROOF static thm prove_named_own_drop(void) { + term goal_tm = ` + forall (R:(A)ra) (name:num) (a:A). + r_viewshift + (named_ra R) + (named_own R name a) + (r_emp (named_ra R)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(named_own_def))); + thm dropped = ispecl_rule( + TERM_LIST(`R:(A)ra`, `name:num`, `a:A`), + NAMED_RA_DROP); + thm own_update = mp_rule( + ispecl_rule( + TERM_LIST( + `named_ra (R:(A)ra)`, + `finmap_singleton (name:num) (a:A)`, + `finmap_empty:(num,A)finmap`), + R_OWN_UPDATE), + dropped); + thm own_unit = ispec_rule(`named_ra (R:(A)ra)`, R_OWN_UNIT); + own_unit = rewrite_rule(THM_LIST(NAMED_RA_UNIT, r_equiv_def), own_unit); + thm post_entails = conjunct1_rule(own_unit); + thm consequence = ispecl_rule( + TERM_LIST( + `named_ra (R:(A)ra)`, + `r_own (named_ra (R:(A)ra)) + (finmap_singleton (name:num) (a:A))`, + `r_own (named_ra (R:(A)ra)) + (finmap_singleton (name:num) (a:A))`, + `r_own (named_ra (R:(A)ra)) + (finmap_empty:(num,A)finmap)`, + `r_emp (named_ra (R:(A)ra))`), + R_VIEWSHIFT_MONO); + consequence = mp_rule( + consequence, + ispecl_rule( + TERM_LIST( + `named_ra (R:(A)ra)`, + `r_own (named_ra (R:(A)ra)) + (finmap_singleton (name:num) (a:A))`), + R_ENTAILS_REFL)); + consequence = mp_rule(consequence, own_update); + consequence = mp_rule(consequence, post_entails); + ACCEPT_TAC(body, consequence); + return gnode_prove(root); +} + +PROOF thm NAMED_OWN_DROP = prove_named_own_drop(); + +PROOF static thm prove_named_own_alloc(void) { + term goal_tm = ` + forall + (R:(A)ra) + (a:A) + (P:(num,A)finmap->bool). + ra_valid R a ==> + r_viewshift + (named_ra R) + P + (r_exists + (named_ra R) + (\name:num. + r_sep + (named_ra R) + (named_own R name a) + P)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_viewshift_def, + r_entails_def, + r_bupd_def, + r_exists_def, + r_sep_def, + named_own_def, + r_own_def, + ra_updateP_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "P"); + body = DISCH_TAC(body, "Hvalid_a"); + body = GEN_TAC(body, "owned"); + body = DISCH_TAC(body, "Hvalid_owned"); + body = DISCH_TAC(body, "HP"); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hvalid_source"); + term_list valid_a_terms = gnode_get_asmps( + body, + CONST_STRING_LIST("Hvalid_a")); + term_list source_pred_terms = gnode_get_asmps( + body, + CONST_STRING_LIST("HP")); + thm source_pred = assume_rule(source_pred_terms[0]); + + thm allocation = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `owned:(num,A)finmap`, + `a:A`), + NAMED_RA_ALLOC), + assume_rule(valid_a_terms[0])); + allocation = rewrite_rule(THM_LIST(ra_updateP_def), allocation); + thm selected = mp_rule( + spec_rule(`frame:(num,A)finmap`, allocation), + assume_rule(` + ra_valid + (named_ra (R:(A)ra)) + (ra_op + (named_ra R) + (owned:(num,A)finmap) + (frame:(num,A)finmap)) + `)); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "result"); + body = ASMP_CONJ_TAC(body, "Hselected", "Hallocated", "Hvalid_result"); + body = ASMP_EXISTS_TAC(body, "Hallocated", "name"); + body = ASMP_CONJ_TAC(body, "Hallocated", "Hfresh", "Hresult_eq"); + + body = EXISTS_TAC(body, `result:(num,A)finmap`); + gnode_list update_result = CONJ_TAC(body); + gnode post = EXISTS_TAC(update_result[0], `name:num`); + post = CONV_TAC( + post, + pure_rewrite_conv(THM_LIST(r_sep_def, named_own_def, r_own_def))); + post = CONV_TAC( + post, + depth_conv(get_conversion_by_name("BETA_CONV"))); + post = EXISTS_TAC(post, `finmap_singleton (name:num) (a:A)`); + post = EXISTS_TAC(post, `owned:(num,A)finmap`); + gnode_list split = CONJ_TAC(post); + thm op_fresh = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `name:num`, + `a:A`, + `owned:(num,A)finmap`), + GMAP_RA_SINGLETON_OP_FRESH), + assume_rule(` + finmap_lookup (owned:(num,A)finmap) (name:num) == NONE + `)); + thm named_eq = gsym_rule(named_ra_def); + op_fresh = rewrite_rule(THM_LIST(named_eq), op_fresh); + ACCEPT_TAC( + split[0], + trans_rule( + assume_rule(` + (result:(num,A)finmap) == + finmap_insert (name:num) (a:A) (owned:(num,A)finmap) + `), + gsym_rule(op_fresh))); + gnode_list predicates = CONJ_TAC(split[1]); + ACCEPT_TAC( + predicates[0], + refl_rule(`finmap_singleton (name:num) (a:A)`)); + ACCEPT_TAC( + predicates[1], + source_pred); + ACCEPT_TAC( + update_result[1], + assume_rule(` + ra_valid + (named_ra (R:(A)ra)) + (ra_op + (named_ra R) + (result:(num,A)finmap) + (frame:(num,A)finmap)) + `)); + return gnode_prove(root); +} + +PROOF thm NAMED_OWN_ALLOC = prove_named_own_alloc(); + +PROOF static int audit_named_logic(void) { + thm_list public_theorems = THM_LIST( + named_own_def, + NAMED_OWN_OP, + NAMED_OWN_VALID, + NAMED_OWN_UPDATE, + NAMED_OWN_UPDATEP, + NAMED_OWN_DROP, + NAMED_OWN_ALLOC); + for (size_t i = 0; i < vector_size(public_theorems); ++i) { + ENSURE_COND(!IS_NULL(public_theorems[i]), + "named logic theorem %zu is empty", i); + ENSURE_COND(vector_size(hyp(public_theorems[i])) == 0, + "named logic theorem %zu has hypotheses", i); + } + ENSURE_COND(vector_size(get_all_axioms()) == NAMED_LOGIC_AXIOMS_BEFORE, + "named logic introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_named_logic"); + return -1; +} + +PROOF static int _NAMED_LOGIC_AUDIT = audit_named_logic(); diff --git a/theory/logic/named_logic.h b/theory/logic/named_logic.h new file mode 100644 index 0000000..1390996 --- /dev/null +++ b/theory/logic/named_logic.h @@ -0,0 +1,14 @@ +#pragma once + +/* Generic separation logic over one numerically named RA. */ + +#include "proof/theory/logic/basic_update.h" +#include "proof/theory/logic/named_ra.h" + +PROOF extern thm named_own_def; +PROOF extern thm NAMED_OWN_OP; +PROOF extern thm NAMED_OWN_VALID; +PROOF extern thm NAMED_OWN_UPDATE; +PROOF extern thm NAMED_OWN_UPDATEP; +PROOF extern thm NAMED_OWN_DROP; +PROOF extern thm NAMED_OWN_ALLOC; diff --git a/theory/logic/named_ra.c b/theory/logic/named_ra.c new file mode 100644 index 0000000..86feae3 --- /dev/null +++ b/theory/logic/named_ra.c @@ -0,0 +1,191 @@ +#include "proof/theory/logic/named_ra.h" +#include "proof/theory/logic/gmap_ra_internal.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/gmap_ra.c" + +PROOF static size_t NAMED_RA_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF thm named_ra_def = new_fun_definition(` + named_ra (R:(A)ra) : ((num,A)finmap)ra = gmap_ra R +`); + +PROOF static thm prove_named_ra_unit(void) { + term goal_tm = ` + forall R:(A)ra. + ra_unit (named_ra R) == (finmap_empty:(num,A)finmap) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC(root, rewrite_conv(THM_LIST(named_ra_def, GMAP_RA_UNIT))); + return gnode_prove(root); +} + +PROOF thm NAMED_RA_UNIT = prove_named_ra_unit(); + +PROOF static thm prove_named_ra_singleton_op(void) { + term goal_tm = ` + forall (R:(A)ra) (name:num) (a:A) (b:A). + ra_op + (named_ra R) + (finmap_singleton name a) + (finmap_singleton name b) == + finmap_singleton name (ra_op R a b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST(named_ra_def, GMAP_RA_SINGLETON_OP))); + return gnode_prove(root); +} + +PROOF thm NAMED_RA_SINGLETON_OP = + prove_named_ra_singleton_op(); + +PROOF static thm prove_named_ra_valid_singleton(void) { + term goal_tm = ` + forall (R:(A)ra) (name:num) (a:A). + ra_valid (named_ra R) (finmap_singleton name a) <=> + ra_valid R a + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST(named_ra_def, GMAP_RA_VALID_SINGLETON))); + return gnode_prove(root); +} + +PROOF thm NAMED_RA_VALID_SINGLETON = + prove_named_ra_valid_singleton(); + +PROOF static thm prove_named_ra_update_singleton(void) { + term goal_tm = ` + forall (R:(A)ra) (name:num) (a:A) (b:A). + ra_update R a b ==> + ra_update + (named_ra R) + (finmap_singleton name a) + (finmap_singleton name b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC(body, once_rewrite_conv(THM_LIST(named_ra_def))); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `name:num`, `a:A`, `b:A`), + GMAP_RA_UPDATE_SINGLETON), + assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`))); + return gnode_prove(root); +} + +PROOF thm NAMED_RA_UPDATE_SINGLETON = + prove_named_ra_update_singleton(); + +PROOF static thm prove_named_ra_updatep_singleton(void) { + term goal_tm = ` + forall (R:(A)ra) (name:num) (a:A) (P:A->bool). + ra_updateP R a P ==> + ra_updateP + (named_ra R) + (finmap_singleton name a) + (\m:(num,A)finmap. + exists b:A. P b && m == finmap_singleton name b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC(body, once_rewrite_conv(THM_LIST(named_ra_def))); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `name:num`, + `a:A`, + `P:A->bool`), + GMAP_RA_UPDATEP_SINGLETON), + assume_rule(`ra_updateP (R:(A)ra) (a:A) (P:A->bool)`))); + return gnode_prove(root); +} + +PROOF thm NAMED_RA_UPDATEP_SINGLETON = + prove_named_ra_updatep_singleton(); + +PROOF static thm prove_named_ra_drop(void) { + term R = `R:(A)ra`; + term name = `name:num`; + term a = `a:A`; + term source = `finmap_singleton (name:num) (a:A)`; + term target = `finmap_empty:(num,A)finmap`; + thm included = ispecl_rule( + TERM_LIST(`named_ra (R:(A)ra)`, source), + RA_INCLUDED_UNIT); + included = rewrite_rule(THM_LIST(NAMED_RA_UNIT), included); + thm dropped = mp_rule( + ispecl_rule( + TERM_LIST(`named_ra (R:(A)ra)`, source, target), + RA_UPDATE_INCLUDED), + included); + dropped = gen_rule(a, dropped); + dropped = gen_rule(name, dropped); + return gen_rule(R, dropped); +} + +PROOF thm NAMED_RA_DROP = prove_named_ra_drop(); + +PROOF static thm prove_named_ra_alloc(void) { + term goal_tm = ` + forall (R:(A)ra) (m:(num,A)finmap) (a:A). + ra_valid R a ==> + ra_updateP + (named_ra R) + m + (\result:(num,A)finmap. + exists name:num. + finmap_lookup m name == NONE && + result == finmap_insert name a m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC(body, once_rewrite_conv(THM_LIST(named_ra_def))); + thm allocated = ispecl_rule( + TERM_LIST(`R:(A)ra`, `m:(num,A)finmap`, `a:A`), + GMAP_RA_ALLOC); + allocated = mp_rule(allocated, get_theorem_by_name("num_INFINITE")); + allocated = mp_rule( + allocated, + assume_rule(`ra_valid (R:(A)ra) (a:A)`)); + ACCEPT_TAC(body, allocated); + return gnode_prove(root); +} + +PROOF thm NAMED_RA_ALLOC = prove_named_ra_alloc(); + +PROOF static int audit_named_ra(void) { + thm_list public_theorems = THM_LIST( + named_ra_def, + NAMED_RA_UNIT, + NAMED_RA_SINGLETON_OP, + NAMED_RA_VALID_SINGLETON, + NAMED_RA_UPDATE_SINGLETON, + NAMED_RA_UPDATEP_SINGLETON, + NAMED_RA_DROP, + NAMED_RA_ALLOC); + for (size_t i = 0; i < vector_size(public_theorems); ++i) { + ENSURE_COND(!IS_NULL(public_theorems[i]), + "named RA theorem %zu is empty", i); + ENSURE_COND(vector_size(hyp(public_theorems[i])) == 0, + "named RA theorem %zu has hypotheses", i); + } + ENSURE_COND(vector_size(get_all_axioms()) == NAMED_RA_AXIOMS_BEFORE, + "named RA introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_named_ra"); + return -1; +} + +PROOF static int _NAMED_RA_AUDIT = audit_named_ra(); diff --git a/theory/logic/named_ra.h b/theory/logic/named_ra.h new file mode 100644 index 0000000..aea5d83 --- /dev/null +++ b/theory/logic/named_ra.h @@ -0,0 +1,16 @@ +#pragma once + +/* Optional numeric naming for ghost resources. */ + +#include "proof/theory/logic/gmap_ra.h" + +/* `named_ra R == (gmap_ra R:((num,A)finmap)ra)`. */ +PROOF extern thm named_ra_def; + +PROOF extern thm NAMED_RA_UNIT; +PROOF extern thm NAMED_RA_SINGLETON_OP; +PROOF extern thm NAMED_RA_VALID_SINGLETON; +PROOF extern thm NAMED_RA_UPDATE_SINGLETON; +PROOF extern thm NAMED_RA_UPDATEP_SINGLETON; +PROOF extern thm NAMED_RA_DROP; +PROOF extern thm NAMED_RA_ALLOC; diff --git a/theory/logic/option_ra.c b/theory/logic/option_ra.c index 0547f9c..c7ca450 100644 --- a/theory/logic/option_ra.c +++ b/theory/logic/option_ra.c @@ -1,5 +1,6 @@ #include "proof/theory/logic/option_ra.h" #include "proof/theory/logic/ra_builder.h" +#include "proof/theory/logic/ra_internal.h" #include "proof/proof_backward.h" #require "proof/proof_backward.c" @@ -396,6 +397,22 @@ PROOF static thm prove_option_ra_some_ne_none(void) { PROOF thm OPTION_RA_SOME_NE_NONE = prove_option_ra_some_ne_none(); +PROOF static thm prove_option_ra_some_unit_ne_none(void) { + term goal_tm = ` + forall R:(A)ra. + ~((SOME (ra_unit R):A option) == NONE) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + get_theorem_by_name("option_DISTINCT")))); + return gnode_prove(root); +} + +PROOF thm OPTION_RA_SOME_UNIT_NE_NONE = + prove_option_ra_some_unit_ne_none(); + PROOF static thm prove_option_ra_valid_none(void) { term goal_tm = ` forall R:(A)ra. @@ -632,139 +649,6 @@ PROOF static thm prove_option_ra_not_included_some_none(void) { PROOF thm OPTION_RA_NOT_INCLUDED_SOME_NONE = prove_option_ra_not_included_some_none(); -/* A valid SOME payload always admits the non-unit frame SOME(unit), so it is - * not exclusive. An invalid payload has no compatible frame at all. */ -PROOF static thm prove_option_ra_exclusive_some_iff(void) { - term goal_tm = ` - forall (R:(A)ra) (a:A). - ra_exclusive (option_ra R) (SOME a) <=> - ~(ra_valid R a) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - gnode_list directions = EQ_TAC(body); - - gnode forward = DISCH_TAC(directions[0], "Hexclusive"); - forward = DISCH_TAC(forward, "Hvalid"); - thm valid_some = eq_mp_rule( - gsym_rule(ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`), - OPTION_RA_VALID_SOME)), - assume_rule(`ra_valid (R:(A)ra) (a:A)`)); - thm framed_eq = trans_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `a:A`, - `ra_unit (R:(A)ra)`), - OPTION_RA_OP_SOME_SOME), - ap_term_rule( - `SOME:A->A option`, - ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`), - RA_UNIT_R))); - thm framed_valid = eq_mp_rule( - gsym_rule(ap_term_rule( - `ra_valid (option_ra (R:(A)ra)):A option->bool`, - framed_eq)), - valid_some); - thm exclusive = rewrite_rule( - THM_LIST(ra_exclusive_def), - assume_rule(` - ra_exclusive - (option_ra (R:(A)ra)) - (SOME (a:A)) - `)); - thm frame_is_unit = mp_rule( - spec_rule(`SOME (ra_unit (R:(A)ra))`, exclusive), - framed_valid); - frame_is_unit = rewrite_rule( - THM_LIST(OPTION_RA_UNIT), - frame_is_unit); - thm contradiction = not_elim_rule( - ispec_rule(`ra_unit (R:(A)ra)`, OPTION_RA_SOME_NE_NONE), - frame_is_unit); - CONTR_TAC(forward, contradiction); - - gnode reverse = DISCH_TAC(directions[1], "Hinvalid"); - reverse = CONV_TAC( - reverse, - once_rewrite_conv(THM_LIST(ra_exclusive_def))); - reverse = GEN_TAC(reverse, "frame"); - reverse = DISCH_TAC(reverse, "Hcombined"); - thm source_valid = mp_rule( - ispecl_rule( - TERM_LIST( - `option_ra (R:(A)ra)`, - `SOME (a:A)`, - `frame:A option`), - RA_VALID_OP_L), - assume_rule(` - ra_valid - (option_ra (R:(A)ra)) - (ra_op - (option_ra R) - (SOME (a:A)) - (frame:A option)) - `)); - thm base_valid = eq_mp_rule( - ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`), - OPTION_RA_VALID_SOME), - source_valid); - thm contradiction2 = not_elim_rule( - assume_rule(`~(ra_valid (R:(A)ra) (a:A))`), - base_valid); - CONTR_TAC(reverse, contradiction2); - return gnode_prove(root); -} - -PROOF thm OPTION_RA_EXCLUSIVE_SOME_IFF = - prove_option_ra_exclusive_some_iff(); - -PROOF static thm prove_option_ra_not_exclusive_none(void) { - term goal_tm = ` - forall R:(A)ra. - ~(ra_exclusive (option_ra R) (NONE:A option)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = GEN_TAC(root, "R"); - body = DISCH_TAC(body, "Hexclusive"); - thm exclusive = rewrite_rule( - THM_LIST(ra_exclusive_def), - assume_rule(` - ra_exclusive - (option_ra (R:(A)ra)) - (NONE:A option) - `)); - thm frame_valid = eq_mp_rule( - gsym_rule(ispecl_rule( - TERM_LIST(`R:(A)ra`, `ra_unit (R:(A)ra)`), - OPTION_RA_VALID_SOME)), - ispec_rule(`R:(A)ra`, RA_VALID_UNIT)); - thm combined_valid = pure_once_rewrite_rule( - THM_LIST(gsym_rule(ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `SOME (ra_unit (R:(A)ra))`), - OPTION_RA_OP_NONE_L))), - frame_valid); - thm frame_is_unit = mp_rule( - spec_rule(`SOME (ra_unit (R:(A)ra))`, exclusive), - combined_valid); - frame_is_unit = rewrite_rule( - THM_LIST(OPTION_RA_UNIT), - frame_is_unit); - thm contradiction = not_elim_rule( - ispec_rule(`ra_unit (R:(A)ra)`, OPTION_RA_SOME_NE_NONE), - frame_is_unit); - CONTR_TAC(body, contradiction); - return gnode_prove(root); -} - -PROOF thm OPTION_RA_NOT_EXCLUSIVE_NONE = - prove_option_ra_not_exclusive_none(); - PROOF static thm prove_option_ra_not_cancellative(void) { term goal_tm = ` forall R:(A)ra. ~(ra_cancellative (option_ra R)) @@ -835,11 +719,13 @@ PROOF thm OPTION_RA_NOT_CANCELLATIVE = PROOF static thm prove_option_ra_local_update_some(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). - ra_local_update R (a,f) (b,g) ==> + ra_local_update R a f b g ==> ra_local_update (option_ra R) - (SOME a,SOME f) - (SOME b,SOME g) + (SOME a) + (SOME f) + (SOME b) + (SOME g) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); @@ -847,42 +733,39 @@ PROOF static thm prove_option_ra_local_update_some(void) { body, once_rewrite_conv(THM_LIST(ra_local_update_def))); body = AUTO_INTROS_TAC(body); - gnode_list frame_cases = CASES_TAC( - body, `frame:A option`, "Hframe"); - - for (size_t i = 0; i < vector_size(frame_cases); ++i) { - term frame_eq_tm = gnode_get_asmps( - frame_cases[i], - CONST_STRING_LIST("Hframe"))[0]; - thm frame_eq = assume_rule(frame_eq_tm); + gnode_list residual_cases = CASES_TAC( + body, `residual:A option`, "Hresidual"); + + for (size_t i = 0; i < vector_size(residual_cases); ++i) { + term residual_eq_tm = gnode_get_asmps( + residual_cases[i], + CONST_STRING_LIST("Hresidual"))[0]; + thm residual_eq = assume_rule(residual_eq_tm); thm source_valid = rewrite_rule( THM_LIST( - get_theorem_by_name("FST"), OPTION_RA_VALID_SOME), assume_rule(` ra_valid (option_ra (R:(A)ra)) - (FST ((SOME (a:A)),(SOME (f:A)))) + (SOME (a:A)) `)); thm source_decomposition = rewrite_rule( THM_LIST( - frame_eq, - get_theorem_by_name("FST"), - get_theorem_by_name("SND"), + residual_eq, OPTION_RA_OP_NONE_R, OPTION_RA_OP_SOME_SOME, get_theorem_by_name("option_INJ")), assume_rule(` - FST ((SOME (a:A)),(SOME (f:A))) == + SOME (a:A) == ra_op (option_ra (R:(A)ra)) - (SND ((SOME (a:A)),(SOME (f:A)))) - (frame:A option) + (SOME (f:A)) + (residual:A option) `)); - term residual = i == 0 + term base_residual = i == 0 ? `ra_unit (R:(A)ra)` - : dest_comb(dest_eq(frame_eq_tm).tm2).tm2; + : dest_comb(dest_eq(residual_eq_tm).tm2).tm2; if (i == 0) { source_decomposition = trans_rule( source_decomposition, @@ -894,22 +777,21 @@ PROOF static thm prove_option_ra_local_update_some(void) { thm updated = ispecl_rule( TERM_LIST( `R:(A)ra`, - `((a:A),(f:A))`, - `((b:A),(g:A))`, - residual), + `a:A`, + `f:A`, + `b:A`, + `g:A`, + base_residual), RA_LOCAL_UPDATE_APPLY); - updated = rewrite_rule( - THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")), - updated); updated = mp_rule( updated, assume_rule(` ra_local_update (R:(A)ra) - ((a:A),(f:A)) - ((b:A),(g:A)) + (a:A) + (f:A) + (b:A) + (g:A) `)); updated = mp_rule(updated, source_valid); updated = mp_rule(updated, source_decomposition); @@ -918,12 +800,10 @@ PROOF static thm prove_option_ra_local_update_some(void) { updated); gnode target = CONV_WITH_ASMP_TAC( - frame_cases[i], + residual_cases[i], rewrite_conv, THM_LIST( - frame_eq, - get_theorem_by_name("FST"), - get_theorem_by_name("SND"), + residual_eq, OPTION_RA_OP_NONE_R, OPTION_RA_OP_SOME_SOME, OPTION_RA_VALID_SOME, @@ -934,17 +814,19 @@ PROOF static thm prove_option_ra_local_update_some(void) { return gnode_prove(root); } -PROOF thm OPTION_RA_LOCAL_UPDATE_SOME = +PROOF static thm OPTION_RA_LOCAL_UPDATE_SOME = prove_option_ra_local_update_some(); -PROOF static thm prove_option_ra_local_update_some_iff(void) { +PROOF static thm prove_option_ra_local_update_iff(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). ra_local_update (option_ra R) - (SOME a,SOME f) - (SOME b,SOME g) <=> - ra_local_update R (a,f) (b,g) + (SOME a) + (SOME f) + (SOME b) + (SOME g) <=> + ra_local_update R a f b g `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); @@ -955,11 +837,6 @@ PROOF static thm prove_option_ra_local_update_some_iff(void) { forward = CONV_TAC( forward, once_rewrite_conv(THM_LIST(ra_local_update_def))); - forward = CONV_TAC( - forward, - rewrite_conv(THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")))); forward = AUTO_INTROS_TAC(forward); thm source_valid = eq_mp_rule( @@ -969,7 +846,7 @@ PROOF static thm prove_option_ra_local_update_some_iff(void) { assume_rule(`ra_valid (R:(A)ra) (a:A)`)); thm base_decomposition = assume_rule(` (a:A) == - ra_op (R:(A)ra) (f:A) (frame:A) + ra_op (R:(A)ra) (f:A) (residual:A) `); thm lifted_decomposition = beta_rule(ap_term_rule( `\x:A. SOME x`, @@ -980,35 +857,32 @@ PROOF static thm prove_option_ra_local_update_some_iff(void) { TERM_LIST( `R:(A)ra`, `f:A`, - `frame:A`), + `residual:A`), OPTION_RA_OP_SOME_SOME))); thm updated = ispecl_rule( TERM_LIST( `option_ra (R:(A)ra)`, - `((SOME (a:A)),(SOME (f:A)))`, - `((SOME (b:A)),(SOME (g:A)))`, - `SOME (frame:A)`), + `SOME (a:A):A option`, + `SOME (f:A):A option`, + `SOME (b:A):A option`, + `SOME (g:A):A option`, + `SOME (residual:A)`), RA_LOCAL_UPDATE_APPLY); - updated = rewrite_rule( - THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")), - updated); updated = mp_rule( updated, assume_rule(` ra_local_update (option_ra (R:(A)ra)) - ((SOME (a:A)),(SOME (f:A))) - ((SOME (b:A)),(SOME (g:A))) + (SOME (a:A)) + (SOME (f:A)) + (SOME (b:A)) + (SOME (g:A)) `)); updated = mp_rule(updated, source_valid); updated = mp_rule(updated, lifted_decomposition); updated = rewrite_rule( THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND"), OPTION_RA_VALID_SOME, OPTION_RA_OP_SOME_SOME, get_theorem_by_name("option_INJ")), @@ -1031,14 +905,16 @@ PROOF static thm prove_option_ra_local_update_some_iff(void) { assume_rule(` ra_local_update (R:(A)ra) - ((a:A),(f:A)) - ((b:A),(g:A)) + (a:A) + (f:A) + (b:A) + (g:A) `))); return gnode_prove(root); } -PROOF thm OPTION_RA_LOCAL_UPDATE_SOME_IFF = - prove_option_ra_local_update_some_iff(); +PROOF thm OPTION_RA_LOCAL_UPDATE_IFF = + prove_option_ra_local_update_iff(); /* * A base update lifts through SOME. The option frame is inspected @@ -1056,6 +932,12 @@ PROOF static thm prove_option_ra_update(void) { body = CONV_TAC( body, once_rewrite_conv(THM_LIST(ra_update_def))); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_updateP_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); body = AUTO_INTROS_TAC(body); gnode_list frame_cases = CASES_TAC( body, `frame:A option`, "Hframe"); @@ -1063,6 +945,10 @@ PROOF static thm prove_option_ra_update(void) { term frame_none_eq = gnode_get_asmps( frame_cases[0], CONST_STRING_LIST("Hframe"))[0]; + gnode none_result = EXISTS_TAC( + frame_cases[0], `SOME (b:A)`); + gnode_list none_parts = CONJ_TAC(none_result); + ACCEPT_TAC(none_parts[0], refl_rule(`SOME (b:A)`)); thm source_none = rewrite_rule( THM_LIST( @@ -1088,7 +974,7 @@ PROOF static thm prove_option_ra_update(void) { assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)), source_none); gnode target_none_goal = CONV_TAC( - frame_cases[0], + none_parts[1], rewrite_conv(THM_LIST( assume_rule(frame_none_eq), OPTION_RA_OP_NONE_R, @@ -1100,6 +986,10 @@ PROOF static thm prove_option_ra_update(void) { CONST_STRING_LIST("Hframe"))[0]; term base_frame = dest_comb( dest_eq(frame_some_eq).tm2).tm2; + gnode some_result = EXISTS_TAC( + frame_cases[1], `SOME (b:A)`); + gnode_list some_parts = CONJ_TAC(some_result); + ACCEPT_TAC(some_parts[0], refl_rule(`SOME (b:A)`)); thm source_some = rewrite_rule( THM_LIST( assume_rule(frame_some_eq), @@ -1113,14 +1003,20 @@ PROOF static thm prove_option_ra_update(void) { (SOME (a:A)) (frame:A option)) `)); - thm base_update = pure_once_rewrite_rule( - THM_LIST(ra_update_def), + thm framed_update = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `a:A`, + `b:A`, + base_frame), + RA_UPDATE_FRAME), assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); thm target_some = mp_rule( - spec_rule(base_frame, base_update), + match_mp_rule(RA_UPDATE_VALID, framed_update), source_some); gnode target_some_goal = CONV_TAC( - frame_cases[1], + some_parts[1], rewrite_conv(THM_LIST( assume_rule(frame_some_eq), OPTION_RA_OP_SOME_SOME, @@ -1150,7 +1046,16 @@ PROOF static thm prove_option_ra_update_iff(void) { forward = CONV_TAC( forward, once_rewrite_conv(THM_LIST(ra_update_def))); + forward = CONV_TAC( + forward, + once_rewrite_conv(THM_LIST(ra_updateP_def))); + forward = CONV_TAC( + forward, + depth_conv(get_conversion_by_name("BETA_CONV"))); forward = AUTO_INTROS_TAC(forward); + forward = EXISTS_TAC(forward, `b:A`); + gnode_list result = CONJ_TAC(forward); + ACCEPT_TAC(result[0], refl_rule(`b:A`)); thm source_valid = eq_mp_rule( gsym_rule(ispecl_rule( TERM_LIST( @@ -1172,8 +1077,14 @@ PROOF static thm prove_option_ra_update_iff(void) { `frame:A`), OPTION_RA_OP_SOME_SOME))), source_valid); - thm option_update = pure_once_rewrite_rule( - THM_LIST(ra_update_def), + thm framed_update = mp_rule( + ispecl_rule( + TERM_LIST( + `option_ra (R:(A)ra)`, + `SOME (a:A):A option`, + `SOME (b:A):A option`, + `SOME (frame:A):A option`), + RA_UPDATE_FRAME), assume_rule(` ra_update (option_ra (R:(A)ra)) @@ -1181,14 +1092,14 @@ PROOF static thm prove_option_ra_update_iff(void) { (SOME (b:A)) `)); thm target_valid = mp_rule( - spec_rule(`SOME (frame:A)`, option_update), + match_mp_rule(RA_UPDATE_VALID, framed_update), source_valid); target_valid = rewrite_rule( THM_LIST( OPTION_RA_OP_SOME_SOME, OPTION_RA_VALID_SOME), target_valid); - ACCEPT_TAC(forward, target_valid); + ACCEPT_TAC(result[1], target_valid); gnode reverse = DISCH_TAC( directions[1], "Hbase_update"); @@ -1210,16 +1121,12 @@ PROOF static thm prove_option_ra_update_iff(void) { PROOF thm OPTION_RA_UPDATE_IFF = prove_option_ra_update_iff(); -/* - * The nondeterministic rule keeps the base result witness and embeds it with - * SOME. Its result predicate is the exact image of P, rather than an - * arbitrary predicate that merely contains that image. - */ -PROOF static thm prove_option_ra_update_nd(void) { +/* Predicate updates lift to the exact SOME image. */ +PROOF static thm prove_option_ra_updateP(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (P:A->bool). - ra_update_nd R a P ==> - ra_update_nd + ra_updateP R a P ==> + ra_updateP (option_ra R) (SOME a) (\x:A option. exists b:A. P b && x == SOME b) @@ -1228,7 +1135,7 @@ PROOF static thm prove_option_ra_update_nd(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); + once_rewrite_conv(THM_LIST(ra_updateP_def))); body = CONV_TAC( body, depth_conv(get_conversion_by_name("BETA_CONV"))); @@ -1265,9 +1172,9 @@ PROOF static thm prove_option_ra_update_nd(void) { `R:(A)ra`, `a:A`, `P:A->bool`), - RA_UPDATE_ND_VALID), + RA_UPDATEP_VALID), assume_rule(` - ra_update_nd + ra_updateP (R:(A)ra) (a:A) (P:A->bool) @@ -1275,9 +1182,9 @@ PROOF static thm prove_option_ra_update_nd(void) { source_valid); } else { thm base_update = pure_once_rewrite_rule( - THM_LIST(ra_update_nd_def), + THM_LIST(ra_updateP_def), assume_rule(` - ra_update_nd + ra_updateP (R:(A)ra) (a:A) (P:A->bool) @@ -1327,18 +1234,18 @@ PROOF static thm prove_option_ra_update_nd(void) { return gnode_prove(root); } -PROOF thm OPTION_RA_UPDATE_ND = - prove_option_ra_update_nd(); +PROOF thm OPTION_RA_UPDATEP = + prove_option_ra_updateP(); -PROOF static thm prove_option_ra_update_nd_iff(void) { +PROOF static thm prove_option_ra_updateP_iff(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (P:A->bool). - (ra_update_nd + (ra_updateP (option_ra R) (SOME a) (\x:A option. exists b:A. P b && x == SOME b) <=> - ra_update_nd R a P) + ra_updateP R a P) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); @@ -1348,7 +1255,7 @@ PROOF static thm prove_option_ra_update_nd_iff(void) { directions[0], "Hoption_update"); forward = CONV_TAC( forward, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); + once_rewrite_conv(THM_LIST(ra_updateP_def))); forward = AUTO_INTROS_TAC(forward); thm source_valid = eq_mp_rule( @@ -1374,9 +1281,9 @@ PROOF static thm prove_option_ra_update_nd_iff(void) { source_valid); thm option_update = pure_once_rewrite_rule( - THM_LIST(ra_update_nd_def), + THM_LIST(ra_updateP_def), assume_rule(` - ra_update_nd + ra_updateP (option_ra (R:(A)ra)) (SOME (a:A)) (\x:A option. @@ -1435,9 +1342,9 @@ PROOF static thm prove_option_ra_update_nd_iff(void) { `R:(A)ra`, `a:A`, `P:A->bool`), - OPTION_RA_UPDATE_ND), + OPTION_RA_UPDATEP), assume_rule(` - ra_update_nd + ra_updateP (R:(A)ra) (a:A) (P:A->bool) @@ -1445,8 +1352,8 @@ PROOF static thm prove_option_ra_update_nd_iff(void) { return gnode_prove(root); } -PROOF thm OPTION_RA_UPDATE_ND_IFF = - prove_option_ra_update_nd_iff(); +PROOF thm OPTION_RA_UPDATEP_IFF = + prove_option_ra_updateP_iff(); PROOF static int audit_option_ra(void) { thm_list audited_theorems = THM_LIST( @@ -1468,20 +1375,19 @@ PROOF static int audit_option_ra(void) { OPTION_RA_OP_SOME_SOME, OPTION_RA_SOME_INJ, OPTION_RA_SOME_NE_NONE, + OPTION_RA_SOME_UNIT_NE_NONE, OPTION_RA_VALID_NONE, OPTION_RA_VALID_SOME, OPTION_RA_INCLUDED_NONE, OPTION_RA_INCLUDED_SOME_SOME, OPTION_RA_NOT_INCLUDED_SOME_NONE, - OPTION_RA_EXCLUSIVE_SOME_IFF, - OPTION_RA_NOT_EXCLUSIVE_NONE, OPTION_RA_NOT_CANCELLATIVE, OPTION_RA_LOCAL_UPDATE_SOME, - OPTION_RA_LOCAL_UPDATE_SOME_IFF, + OPTION_RA_LOCAL_UPDATE_IFF, OPTION_RA_UPDATE, OPTION_RA_UPDATE_IFF, - OPTION_RA_UPDATE_ND, - OPTION_RA_UPDATE_ND_IFF); + OPTION_RA_UPDATEP, + OPTION_RA_UPDATEP_IFF); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { ENSURE_COND(!IS_NULL(audited_theorems[i]), diff --git a/theory/logic/option_ra.h b/theory/logic/option_ra.h index e8980bc..30f621d 100644 --- a/theory/logic/option_ra.h +++ b/theory/logic/option_ra.h @@ -1,204 +1,19 @@ #pragma once -/* - * `option_ra R:((A)option)ra` adjoins a fresh unit `NONE` to `R:(A)ra`. - * Its carrier is `A option`; `NONE` is the unit; `SOME a` and `SOME b` - * compose to `SOME (ra_op R a b)`; `NONE` is valid and `SOME a` is valid - * exactly when `a` is valid in `R`. - * - * This client interface exposes only equations stated directly with - * `ra_unit`, `ra_op`, and `ra_valid`. The recursive implementation and the - * `ra_abs` projection equations remain private to `option_ra.c`. - */ +/* Option/lift resource algebra. `NONE` is the freshly added unit. */ #include "proof/theory/logic/local_update.h" -/* ------------------------------------------------------------------------- */ -/* Core representation */ -/* ------------------------------------------------------------------------- */ - -/* `forall R:(A)ra. ra_unit (option_ra R) == (NONE:A option)`. */ PROOF extern thm OPTION_RA_UNIT; - -/* - * `forall (R:(A)ra) (x:A option). - * ra_op (option_ra R) NONE x == x` - */ PROOF extern thm OPTION_RA_OP_NONE_L; - -/* - * `forall (R:(A)ra) (x:A option). - * ra_op (option_ra R) x NONE == x` - */ -PROOF extern thm OPTION_RA_OP_NONE_R; - -/* - * `forall (R:(A)ra) (a:A) (b:A). - * ra_op (option_ra R) (SOME a) (SOME b) == - * SOME (ra_op R a b)` - */ PROOF extern thm OPTION_RA_OP_SOME_SOME; - -/* ------------------------------------------------------------------------- */ -/* Constructor equality and distinction */ -/* ------------------------------------------------------------------------- */ - -/* - * forall (a:A) (b:A). - * (SOME a:A option) == SOME b <=> a == b - */ -PROOF extern thm OPTION_RA_SOME_INJ; - -/* `forall a:A. ~((SOME a:A option) == NONE)`. */ -PROOF extern thm OPTION_RA_SOME_NE_NONE; - -/* ------------------------------------------------------------------------- */ -/* Validity */ -/* ------------------------------------------------------------------------- */ - -/* `forall R:(A)ra. ra_valid (option_ra R) (NONE:A option)`. */ PROOF extern thm OPTION_RA_VALID_NONE; - -/* - * `forall (R:(A)ra) (a:A). - * ra_valid (option_ra R) (SOME a) <=> ra_valid R a` - */ PROOF extern thm OPTION_RA_VALID_SOME; - -/* ------------------------------------------------------------------------- */ -/* Order */ -/* ------------------------------------------------------------------------- */ - -/* - * The freshly adjoined unit is included in every option resource: - * - * forall (R:(A)ra) (x:A option). - * ra_included (option_ra R) NONE x - */ PROOF extern thm OPTION_RA_INCLUDED_NONE; - -/* - * Inclusion between present resources is exactly base inclusion: - * - * forall (R:(A)ra) (a:A) (b:A). - * ra_included (option_ra R) (SOME a) (SOME b) <=> - * ra_included R a b - */ PROOF extern thm OPTION_RA_INCLUDED_SOME_SOME; - -/* - * No present resource is included in the freshly adjoined unit: - * - * forall (R:(A)ra) (a:A). - * ~(ra_included (option_ra R) (SOME a) NONE) - */ PROOF extern thm OPTION_RA_NOT_INCLUDED_SOME_NONE; - -/* ------------------------------------------------------------------------- */ -/* Exclusive and cancellative laws */ -/* ------------------------------------------------------------------------- */ - -/* - * A present option resource is exclusive exactly when its base payload is - * invalid (and hence exclusivity is vacuous): - * - * forall (R:(A)ra) (a:A). - * ra_exclusive (option_ra R) (SOME a) <=> ~(ra_valid R a) - */ -PROOF extern thm OPTION_RA_EXCLUSIVE_SOME_IFF; - -/* `forall R:(A)ra. ~(ra_exclusive (option_ra R) (NONE:A option))`. */ -PROOF extern thm OPTION_RA_NOT_EXCLUSIVE_NONE; - -/* - * Adjoining a fresh unit destroys cancellativity, independently of the base - * RA: `NONE` and `SOME (ra_unit R)` become equal after framing by the latter. - * - * forall R:(A)ra. ~(ra_cancellative (option_ra R)) - */ +PROOF extern thm OPTION_RA_SOME_UNIT_NE_NONE; PROOF extern thm OPTION_RA_NOT_CANCELLATIVE; - -/* ------------------------------------------------------------------------- */ -/* Laws */ -/* ------------------------------------------------------------------------- */ - -/* - * Associativity, commutativity, unit laws, and downward closure are inherited - * through the intrinsic RA interface in `ra.h`. - */ - -/* ------------------------------------------------------------------------- */ -/* Updates */ -/* ------------------------------------------------------------------------- */ - -/* - * Base local updates lift pointwise through `SOME`: - * - * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). - * ra_local_update R (a,f) (b,g) ==> - * ra_local_update - * (option_ra R) - * (SOME a,SOME f) - * (SOME b,SOME g) - * - * The `NONE` residual case corresponds to the base residual `ra_unit R`; - * a `SOME frame` residual corresponds directly to `frame`. - */ -PROOF extern thm OPTION_RA_LOCAL_UPDATE_SOME; - -/* - * Local updates between present pairs are exactly base local updates: - * - * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). - * ra_local_update - * (option_ra R) - * (SOME a,SOME f) - * (SOME b,SOME g) <=> - * ra_local_update R (a,f) (b,g) - * - * For the reverse projection, the option residual `SOME frame` exposes every - * base residual `frame`. - */ -PROOF extern thm OPTION_RA_LOCAL_UPDATE_SOME_IFF; - -/* - * Deterministic base update lifting: - * - * forall (R:(A)ra) (a:A) (b:A). - * ra_update R a b ==> - * ra_update (option_ra R) (SOME a) (SOME b) - */ -PROOF extern thm OPTION_RA_UPDATE; - -/* - * Deterministic updates between present values are exactly base updates: - * - * forall (R:(A)ra) (a:A) (b:A). - * ra_update (option_ra R) (SOME a) (SOME b) <=> - * ra_update R a b - */ +PROOF extern thm OPTION_RA_UPDATEP_IFF; PROOF extern thm OPTION_RA_UPDATE_IFF; - -/* - * Nondeterministic base update lifting to the exact SOME image: - * - * forall (R:(A)ra) (a:A) (P:A->bool). - * ra_update_nd R a P ==> - * ra_update_nd - * (option_ra R) - * (SOME a) - * (\x:A option. exists b:A. P b && x == SOME b) - */ -PROOF extern thm OPTION_RA_UPDATE_ND; - -/* - * Exact-SOME-image nondeterministic updates are exactly base ND updates: - * - * forall (R:(A)ra) (a:A) (P:A->bool). - * (ra_update_nd - * (option_ra R) - * (SOME a) - * (\x:A option. exists b:A. P b && x == SOME b) <=> - * ra_update_nd R a P) - */ -PROOF extern thm OPTION_RA_UPDATE_ND_IFF; +PROOF extern thm OPTION_RA_LOCAL_UPDATE_IFF; diff --git a/theory/logic/option_ra_internal.h b/theory/logic/option_ra_internal.h new file mode 100644 index 0000000..aa18d66 --- /dev/null +++ b/theory/logic/option_ra_internal.h @@ -0,0 +1,9 @@ +#pragma once + +/* Private option-RA normalization/lifting rules for container constructors. */ + +#include "proof/theory/logic/option_ra.h" + +PROOF extern thm OPTION_RA_OP_NONE_R; +PROOF extern thm OPTION_RA_UPDATE; +PROOF extern thm OPTION_RA_UPDATEP; diff --git a/theory/logic/prod_ra.c b/theory/logic/prod_ra.c index 6b4e640..e3c3491 100644 --- a/theory/logic/prod_ra.c +++ b/theory/logic/prod_ra.c @@ -1,5 +1,6 @@ #include "proof/theory/logic/prod_ra.h" #include "proof/theory/logic/ra_builder.h" +#include "proof/theory/logic/ra_internal.h" #include "proof/proof_backward.h" #require "proof/proof_backward.c" @@ -406,7 +407,26 @@ PROOF static thm prove_prod_ra_exclusive(void) { body = CONV_TAC( body, once_rewrite_conv(THM_LIST(ra_exclusive_def))); - body = AUTO_INTROS_TAC(body); + gnode_list exclusive = CONJ_TAC(body); + + thm left_exclusive = rewrite_rule( + THM_LIST(ra_exclusive_def), + assume_rule(`ra_exclusive (R1:(A)ra) (FST (x:A#B))`)); + thm right_exclusive = rewrite_rule( + THM_LIST(ra_exclusive_def), + assume_rule(`ra_exclusive (R2:(B)ra) (SND (x:A#B))`)); + thm source_components = conj_rule( + conjunct1_rule(left_exclusive), + conjunct1_rule(right_exclusive)); + thm source_validity = ispecl_rule( + TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), + PROD_RA_VALID); + ACCEPT_TAC( + exclusive[0], + eq_mp_rule(gsym_rule(source_validity), source_components)); + + body = GEN_TAC(exclusive[1], "frame"); + body = DISCH_TAC(body, "Hcompatible"); thm product_validity = ispecl_rule( TERM_LIST( @@ -434,26 +454,14 @@ PROOF static thm prove_prod_ra_exclusive(void) { get_theorem_by_name("SND")), components); - thm left_frame = ispecl_rule( - TERM_LIST( - `R1:(A)ra`, - `FST (x:A#B)`, - `FST (frame:A#B)`), - RA_EXCLUSIVE_APPLY); - left_frame = mp_rule( - left_frame, - assume_rule(`ra_exclusive (R1:(A)ra) (FST (x:A#B))`)); + thm left_frame = spec_rule( + `FST (frame:A#B)`, + conjunct2_rule(left_exclusive)); left_frame = mp_rule(left_frame, conjunct1_rule(components)); - thm right_frame = ispecl_rule( - TERM_LIST( - `R2:(B)ra`, - `SND (x:A#B)`, - `SND (frame:A#B)`), - RA_EXCLUSIVE_APPLY); - right_frame = mp_rule( - right_frame, - assume_rule(`ra_exclusive (R2:(B)ra) (SND (x:A#B))`)); + thm right_frame = spec_rule( + `SND (frame:A#B)`, + conjunct2_rule(right_exclusive)); right_frame = mp_rule(right_frame, conjunct2_rule(components)); thm pair_components = eq_mp_rule( @@ -496,13 +504,16 @@ PROOF static thm prove_prod_ra_exclusive_elim_left(void) { body = CONV_TAC( body, once_rewrite_conv(THM_LIST(ra_exclusive_def))); - body = AUTO_INTROS_TAC(body); + gnode_list exclusive = CONJ_TAC(body); thm source_components = eq_mp_rule( ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), PROD_RA_VALID), assume_rule(`ra_valid (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + ACCEPT_TAC(exclusive[0], conjunct1_rule(source_components)); + body = GEN_TAC(exclusive[1], "frame"); + body = DISCH_TAC(body, "Hcompatible"); thm right_unit = ispecl_rule( TERM_LIST(`R2:(B)ra`, `SND (x:A#B)`), RA_UNIT_R); @@ -556,15 +567,12 @@ PROOF static thm prove_prod_ra_exclusive_elim_left(void) { gsym_rule(framed_op)), framed_pair_valid); - thm unit_frame = ispecl_rule( - TERM_LIST( - `prod_ra (R1:(A)ra) (R2:(B)ra)`, - `x:A#B`, - product_frame), - RA_EXCLUSIVE_APPLY); - unit_frame = mp_rule( - unit_frame, + thm product_exclusive = rewrite_rule( + THM_LIST(ra_exclusive_def), assume_rule(`ra_exclusive (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + thm unit_frame = spec_rule( + product_frame, + conjunct2_rule(product_exclusive)); unit_frame = mp_rule(unit_frame, framed_valid); thm projected = ap_term_rule(`FST:(A#B)->A`, unit_frame); projected = pure_rewrite_rule( @@ -592,13 +600,16 @@ PROOF static thm prove_prod_ra_exclusive_elim_right(void) { body = CONV_TAC( body, once_rewrite_conv(THM_LIST(ra_exclusive_def))); - body = AUTO_INTROS_TAC(body); + gnode_list exclusive = CONJ_TAC(body); thm source_components = eq_mp_rule( ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), PROD_RA_VALID), assume_rule(`ra_valid (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + ACCEPT_TAC(exclusive[0], conjunct2_rule(source_components)); + body = GEN_TAC(exclusive[1], "frame"); + body = DISCH_TAC(body, "Hcompatible"); thm left_unit = ispecl_rule( TERM_LIST(`R1:(A)ra`, `FST (x:A#B)`), RA_UNIT_R); @@ -652,15 +663,12 @@ PROOF static thm prove_prod_ra_exclusive_elim_right(void) { gsym_rule(framed_op)), framed_pair_valid); - thm unit_frame = ispecl_rule( - TERM_LIST( - `prod_ra (R1:(A)ra) (R2:(B)ra)`, - `x:A#B`, - product_frame), - RA_EXCLUSIVE_APPLY); - unit_frame = mp_rule( - unit_frame, + thm product_exclusive = rewrite_rule( + THM_LIST(ra_exclusive_def), assume_rule(`ra_exclusive (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + thm unit_frame = spec_rule( + product_frame, + conjunct2_rule(product_exclusive)); unit_frame = mp_rule(unit_frame, framed_valid); thm projected = ap_term_rule(`SND:(A#B)->B`, unit_frame); projected = pure_rewrite_rule( @@ -678,7 +686,6 @@ PROOF thm PROD_RA_EXCLUSIVE_ELIM_RIGHT = PROOF static thm prove_prod_ra_exclusive_iff(void) { term goal_tm = ` forall (R1:(A)ra) (R2:(B)ra) (x:A#B). - ra_valid (prod_ra R1 R2) x ==> (ra_exclusive (prod_ra R1 R2) x <=> ra_exclusive R1 (FST x) && ra_exclusive R2 (SND x)) @@ -688,13 +695,16 @@ PROOF static thm prove_prod_ra_exclusive_iff(void) { gnode_list directions = EQ_TAC(body); gnode forward = DISCH_TAC(directions[0], "Hexclusive"); + thm product_exclusive = rewrite_rule( + THM_LIST(ra_exclusive_def), + assume_rule(`ra_exclusive (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); gnode_list components = CONJ_TAC(forward); thm left = ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), PROD_RA_EXCLUSIVE_ELIM_LEFT); left = mp_rule( left, - assume_rule(`ra_valid (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + conjunct1_rule(product_exclusive)); left = mp_rule( left, assume_rule(`ra_exclusive (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); @@ -705,7 +715,7 @@ PROOF static thm prove_prod_ra_exclusive_iff(void) { PROD_RA_EXCLUSIVE_ELIM_RIGHT); right = mp_rule( right, - assume_rule(`ra_valid (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + conjunct1_rule(product_exclusive)); right = mp_rule( right, assume_rule(`ra_exclusive (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); @@ -1158,13 +1168,13 @@ PROOF thm PROD_RA_CANCELLATIVE_IFF = * an exact existential pair, rather than weakened to projections of an * otherwise unconstrained product value. */ -PROOF static thm prove_prod_ra_update_nd(void) { +PROOF static thm prove_prod_ra_updateP(void) { term goal_tm = ` forall (R1:(A)ra) (R2:(B)ra) (a1:A) (a2:B) (P1:A->bool) (P2:B->bool). - ra_update_nd R1 a1 P1 ==> - ra_update_nd R2 a2 P2 ==> - ra_update_nd + ra_updateP R1 a1 P1 ==> + ra_updateP R2 a2 P2 ==> + ra_updateP (prod_ra R1 R2) (a1,a2) (\x:A#B. @@ -1175,7 +1185,7 @@ PROOF static thm prove_prod_ra_update_nd(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); + once_rewrite_conv(THM_LIST(ra_updateP_def))); body = CONV_TAC( body, depth_conv(get_conversion_by_name("BETA_CONV"))); @@ -1214,9 +1224,9 @@ PROOF static thm prove_prod_ra_update_nd(void) { source_components); thm left_update = pure_once_rewrite_rule( - THM_LIST(ra_update_nd_def), + THM_LIST(ra_updateP_def), assume_rule(` - ra_update_nd (R1:(A)ra) (a1:A) (P1:A->bool) + ra_updateP (R1:(A)ra) (a1:A) (P1:A->bool) `)); thm left_selected = mp_rule( spec_rule(`FST (frame:A#B)`, left_update), @@ -1230,9 +1240,9 @@ PROOF static thm prove_prod_ra_update_nd(void) { "Hb1_valid"); thm right_update = pure_once_rewrite_rule( - THM_LIST(ra_update_nd_def), + THM_LIST(ra_updateP_def), assume_rule(` - ra_update_nd (R2:(B)ra) (a2:B) (P2:B->bool) + ra_updateP (R2:(B)ra) (a2:B) (P2:B->bool) `)); thm right_selected = mp_rule( spec_rule(`SND (frame:A#B)`, right_update), @@ -1322,7 +1332,7 @@ PROOF static thm prove_prod_ra_update_nd(void) { return gnode_prove(root); } -PROOF thm PROD_RA_UPDATE_ND = prove_prod_ra_update_nd(); +PROOF thm PROD_RA_UPDATEP = prove_prod_ra_updateP(); /* Deterministic component updates preserve every product frame pointwise. */ PROOF static thm prove_prod_ra_update(void) { @@ -1338,7 +1348,16 @@ PROOF static thm prove_prod_ra_update(void) { body = CONV_TAC( body, once_rewrite_conv(THM_LIST(ra_update_def))); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_updateP_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); body = AUTO_INTROS_TAC(body); + body = EXISTS_TAC(body, `((b1:A),(b2:B))`); + gnode_list update_result = CONJ_TAC(body); + ACCEPT_TAC(update_result[0], refl_rule(`((b1:A),(b2:B))`)); thm source_valid = assume_rule(` ra_valid @@ -1372,17 +1391,29 @@ PROOF static thm prove_prod_ra_update(void) { get_theorem_by_name("SND")), source_components); - thm left_update = pure_once_rewrite_rule( - THM_LIST(ra_update_def), + thm left_update = mp_rule( + ispecl_rule( + TERM_LIST( + `R1:(A)ra`, + `a1:A`, + `b1:A`, + `FST (frame:A#B)`), + RA_UPDATE_FRAME), assume_rule(`ra_update (R1:(A)ra) (a1:A) (b1:A)`)); thm left_valid = mp_rule( - spec_rule(`FST (frame:A#B)`, left_update), + match_mp_rule(RA_UPDATE_VALID, left_update), conjunct1_rule(source_components)); - thm right_update = pure_once_rewrite_rule( - THM_LIST(ra_update_def), + thm right_update = mp_rule( + ispecl_rule( + TERM_LIST( + `R2:(B)ra`, + `a2:B`, + `b2:B`, + `SND (frame:A#B)`), + RA_UPDATE_FRAME), assume_rule(`ra_update (R2:(B)ra) (a2:B) (b2:B)`)); thm right_valid = mp_rule( - spec_rule(`SND (frame:A#B)`, right_update), + match_mp_rule(RA_UPDATE_VALID, right_update), conjunct2_rule(source_components)); thm result_valid_rule = ispecl_rule( @@ -1425,7 +1456,7 @@ PROOF static thm prove_prod_ra_update(void) { `ra_valid (R2:(B)ra):B->bool`, result_snd); ACCEPT_TAC( - body, + update_result[1], eq_mp_rule( gsym_rule(result_valid_rule), conj_rule( @@ -1452,7 +1483,16 @@ PROOF static thm prove_prod_ra_update_elim_left(void) { body = CONV_TAC( body, once_rewrite_conv(THM_LIST(ra_update_def))); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_updateP_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); body = AUTO_INTROS_TAC(body); + body = EXISTS_TAC(body, `b1:A`); + gnode_list update_result = CONJ_TAC(body); + ACCEPT_TAC(update_result[0], refl_rule(`b1:A`)); thm right_unit = ispecl_rule( TERM_LIST(`R2:(B)ra`, `a2:B`), @@ -1500,22 +1540,23 @@ PROOF static thm prove_prod_ra_update_elim_left(void) { gsym_rule(source_op)), source_explicit_valid); - thm target_valid = ispecl_rule( - TERM_LIST( - `prod_ra (R1:(A)ra) (R2:(B)ra)`, - `((a1:A),(a2:B))`, - `((b1:A),(b2:B))`, - product_frame), - RA_UPDATE_APPLY); - target_valid = mp_rule( - target_valid, + thm framed_update = mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra (R1:(A)ra) (R2:(B)ra)`, + `((a1:A),(a2:B))`, + `((b1:A),(b2:B))`, + product_frame), + RA_UPDATE_FRAME), assume_rule(` ra_update (prod_ra (R1:(A)ra) (R2:(B)ra)) ((a1:A),(a2:B)) ((b1:A),(b2:B)) `)); - target_valid = mp_rule(target_valid, source_valid); + thm target_valid = mp_rule( + match_mp_rule(RA_UPDATE_VALID, framed_update), + source_valid); thm target_components = eq_mp_rule( ispecl_rule( @@ -1534,7 +1575,7 @@ PROOF static thm prove_prod_ra_update_elim_left(void) { get_theorem_by_name("FST"), get_theorem_by_name("SND")), target_components); - ACCEPT_TAC(body, conjunct1_rule(target_components)); + ACCEPT_TAC(update_result[1], conjunct1_rule(target_components)); return gnode_prove(root); } @@ -1554,7 +1595,16 @@ PROOF static thm prove_prod_ra_update_elim_right(void) { body = CONV_TAC( body, once_rewrite_conv(THM_LIST(ra_update_def))); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ra_updateP_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); body = AUTO_INTROS_TAC(body); + body = EXISTS_TAC(body, `b2:B`); + gnode_list update_result = CONJ_TAC(body); + ACCEPT_TAC(update_result[0], refl_rule(`b2:B`)); thm left_unit = ispecl_rule( TERM_LIST(`R1:(A)ra`, `a1:A`), @@ -1602,22 +1652,23 @@ PROOF static thm prove_prod_ra_update_elim_right(void) { gsym_rule(source_op)), source_explicit_valid); - thm target_valid = ispecl_rule( - TERM_LIST( - `prod_ra (R1:(A)ra) (R2:(B)ra)`, - `((a1:A),(a2:B))`, - `((b1:A),(b2:B))`, - product_frame), - RA_UPDATE_APPLY); - target_valid = mp_rule( - target_valid, + thm framed_update = mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra (R1:(A)ra) (R2:(B)ra)`, + `((a1:A),(a2:B))`, + `((b1:A),(b2:B))`, + product_frame), + RA_UPDATE_FRAME), assume_rule(` ra_update (prod_ra (R1:(A)ra) (R2:(B)ra)) ((a1:A),(a2:B)) ((b1:A),(b2:B)) `)); - target_valid = mp_rule(target_valid, source_valid); + thm target_valid = mp_rule( + match_mp_rule(RA_UPDATE_VALID, framed_update), + source_valid); thm target_components = eq_mp_rule( ispecl_rule( @@ -1636,7 +1687,7 @@ PROOF static thm prove_prod_ra_update_elim_right(void) { get_theorem_by_name("FST"), get_theorem_by_name("SND")), target_components); - ACCEPT_TAC(body, conjunct2_rule(target_components)); + ACCEPT_TAC(update_result[1], conjunct2_rule(target_components)); return gnode_prove(root); } @@ -1757,12 +1808,12 @@ PROOF static thm PROD_RA_LEFT_IMAGE_IMP = * Update only the left component by combining the requested ND update with * right-side ND reflexivity, then normalize the exact product image. */ -PROOF static thm prove_prod_ra_update_left_nd(void) { +PROOF static thm prove_prod_ra_update_leftP(void) { term goal_tm = ` forall (R1:(A)ra) (R2:(B)ra) (a1:A) (a2:B) (P:A->bool). - ra_update_nd R1 a1 P ==> - ra_update_nd + ra_updateP R1 a1 P ==> + ra_updateP (prod_ra R1 R2) (a1,a2) (\x:A#B. exists b1:A. P b1 && x == (b1,a2)) @@ -1793,17 +1844,17 @@ PROOF static thm prove_prod_ra_update_left_nd(void) { `a2:B`, `P:A->bool`, fixed_right), - PROD_RA_UPDATE_ND); + PROD_RA_UPDATEP); combined = mp_rule( combined, assume_rule(` - ra_update_nd (R1:(A)ra) (a1:A) (P:A->bool) + ra_updateP (R1:(A)ra) (a1:A) (P:A->bool) `)); combined = mp_rule( combined, ispecl_rule( TERM_LIST(`R2:(B)ra`, `a2:B`), - RA_UPDATE_ND_REFL)); + RA_UPDATEP_REFL)); combined = conv_rule( depth_conv(get_conversion_by_name("BETA_CONV")), combined); @@ -1814,7 +1865,7 @@ PROOF static thm prove_prod_ra_update_left_nd(void) { `((a1:A),(a2:B))`, combined_predicate, left_image), - RA_UPDATE_ND_MONO); + RA_UPDATEP_MONO); weakened = mp_rule(weakened, combined); weakened = conv_rule( depth_conv(get_conversion_by_name("BETA_CONV")), @@ -1828,7 +1879,7 @@ PROOF static thm prove_prod_ra_update_left_nd(void) { return gnode_prove(root); } -PROOF thm PROD_RA_UPDATE_LEFT_ND = prove_prod_ra_update_left_nd(); +PROOF static thm PROD_RA_UPDATE_LEFTP = prove_prod_ra_update_leftP(); /* The deterministic one-sided rule is product update plus reflexivity. */ PROOF static thm prove_prod_ra_update_left(void) { @@ -1902,12 +1953,12 @@ PROOF static thm PROD_RA_RIGHT_IMAGE_IMP = prove_prod_ra_right_image_imp(); /* Combine left-side ND reflexivity with the requested right update. */ -PROOF static thm prove_prod_ra_update_right_nd(void) { +PROOF static thm prove_prod_ra_update_rightP(void) { term goal_tm = ` forall (R1:(A)ra) (R2:(B)ra) (a1:A) (a2:B) (P:B->bool). - ra_update_nd R2 a2 P ==> - ra_update_nd + ra_updateP R2 a2 P ==> + ra_updateP (prod_ra R1 R2) (a1,a2) (\x:A#B. exists b2:B. P b2 && x == (a1,b2)) @@ -1938,16 +1989,16 @@ PROOF static thm prove_prod_ra_update_right_nd(void) { `a2:B`, fixed_left, `P:B->bool`), - PROD_RA_UPDATE_ND); + PROD_RA_UPDATEP); combined = mp_rule( combined, ispecl_rule( TERM_LIST(`R1:(A)ra`, `a1:A`), - RA_UPDATE_ND_REFL)); + RA_UPDATEP_REFL)); combined = mp_rule( combined, assume_rule(` - ra_update_nd (R2:(B)ra) (a2:B) (P:B->bool) + ra_updateP (R2:(B)ra) (a2:B) (P:B->bool) `)); combined = conv_rule( depth_conv(get_conversion_by_name("BETA_CONV")), @@ -1959,7 +2010,7 @@ PROOF static thm prove_prod_ra_update_right_nd(void) { `((a1:A),(a2:B))`, combined_predicate, right_image), - RA_UPDATE_ND_MONO); + RA_UPDATEP_MONO); weakened = mp_rule(weakened, combined); weakened = conv_rule( depth_conv(get_conversion_by_name("BETA_CONV")), @@ -1973,7 +2024,7 @@ PROOF static thm prove_prod_ra_update_right_nd(void) { return gnode_prove(root); } -PROOF thm PROD_RA_UPDATE_RIGHT_ND = prove_prod_ra_update_right_nd(); +PROOF static thm PROD_RA_UPDATE_RIGHTP = prove_prod_ra_update_rightP(); /* The deterministic right-only rule is product update plus reflexivity. */ PROOF static thm prove_prod_ra_update_right(void) { @@ -2016,23 +2067,20 @@ PROOF static thm prove_prod_ra_local_update(void) { forall (R1:(A)ra) (R2:(B)ra) (a1:A) (f1:A) (b1:A) (g1:A) (a2:B) (f2:B) (b2:B) (g2:B). - ra_local_update R1 (a1,f1) (b1,g1) ==> - ra_local_update R2 (a2,f2) (b2,g2) ==> + ra_local_update R1 a1 f1 b1 g1 ==> + ra_local_update R2 a2 f2 b2 g2 ==> ra_local_update (prod_ra R1 R2) - ((a1,a2),(f1,f2)) - ((b1,b2),(g1,g2)) + (a1,a2) + (f1,f2) + (b1,b2) + (g1,g2) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, once_rewrite_conv(THM_LIST(ra_local_update_def))); - body = CONV_TAC( - body, - rewrite_conv(THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")))); body = AUTO_INTROS_TAC(body); thm source_validity = ispecl_rule( @@ -2059,7 +2107,7 @@ PROOF static thm prove_prod_ra_local_update(void) { ra_op (prod_ra (R1:(A)ra) (R2:(B)ra)) ((f1:A),(f2:B)) - (frame:A#B) + (residual:A#B) `); thm left_extension = ap_term_rule(`FST:(A#B)->A`, source_extension); left_extension = pure_rewrite_rule( @@ -2079,22 +2127,21 @@ PROOF static thm prove_prod_ra_local_update(void) { thm left_result = ispecl_rule( TERM_LIST( `R1:(A)ra`, - `((a1:A),(f1:A))`, - `((b1:A),(g1:A))`, - `FST (frame:A#B)`), + `a1:A`, + `f1:A`, + `b1:A`, + `g1:A`, + `FST (residual:A#B)`), RA_LOCAL_UPDATE_APPLY); - left_result = pure_rewrite_rule( - THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")), - left_result); left_result = mp_rule( left_result, assume_rule(` ra_local_update (R1:(A)ra) - ((a1:A),(f1:A)) - ((b1:A),(g1:A)) + (a1:A) + (f1:A) + (b1:A) + (g1:A) `)); left_result = mp_rule(left_result, conjunct1_rule(source_components)); left_result = mp_rule(left_result, left_extension); @@ -2102,22 +2149,21 @@ PROOF static thm prove_prod_ra_local_update(void) { thm right_result = ispecl_rule( TERM_LIST( `R2:(B)ra`, - `((a2:B),(f2:B))`, - `((b2:B),(g2:B))`, - `SND (frame:A#B)`), + `a2:B`, + `f2:B`, + `b2:B`, + `g2:B`, + `SND (residual:A#B)`), RA_LOCAL_UPDATE_APPLY); - right_result = pure_rewrite_rule( - THM_LIST( - get_theorem_by_name("FST"), - get_theorem_by_name("SND")), - right_result); right_result = mp_rule( right_result, assume_rule(` ra_local_update (R2:(B)ra) - ((a2:B),(f2:B)) - ((b2:B),(g2:B)) + (a2:B) + (f2:B) + (b2:B) + (g2:B) `)); right_result = mp_rule(right_result, conjunct2_rule(source_components)); right_result = mp_rule(right_result, right_extension); @@ -2147,8 +2193,8 @@ PROOF static thm prove_prod_ra_local_update(void) { TERM_LIST( `b1:A`, `b2:B`, - `ra_op (R1:(A)ra) (g1:A) (FST (frame:A#B))`, - `ra_op (R2:(B)ra) (g2:B) (SND (frame:A#B))`), + `ra_op (R1:(A)ra) (g1:A) (FST (residual:A#B))`, + `ra_op (R2:(B)ra) (g2:B) (SND (residual:A#B))`), get_theorem_by_name("PAIR_EQ"))), conj_rule( conjunct2_rule(left_result), @@ -2158,7 +2204,7 @@ PROOF static thm prove_prod_ra_local_update(void) { `R1:(A)ra`, `R2:(B)ra`, `((g1:A),(g2:B))`, - `frame:A#B`), + `residual:A#B`), PROD_RA_OP); target_op = pure_rewrite_rule( THM_LIST( @@ -2180,11 +2226,13 @@ PROOF static thm prove_prod_ra_local_update_left(void) { forall (R1:(A)ra) (R2:(B)ra) (a1:A) (f1:A) (b1:A) (g1:A) (a2:B) (f2:B). - ra_local_update R1 (a1,f1) (b1,g1) ==> + ra_local_update R1 a1 f1 b1 g1 ==> ra_local_update (prod_ra R1 R2) - ((a1,a2),(f1,f2)) - ((b1,a2),(g1,f2)) + (a1,a2) + (f1,f2) + (b1,a2) + (g1,f2) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); @@ -2199,19 +2247,21 @@ PROOF static thm prove_prod_ra_local_update_left(void) { assume_rule(` ra_local_update (R1:(A)ra) - ((a1:A),(f1:A)) - ((b1:A),(g1:A)) + (a1:A) + (f1:A) + (b1:A) + (g1:A) `)); result = mp_rule( result, ispecl_rule( - TERM_LIST(`R2:(B)ra`, `((a2:B),(f2:B))`), + TERM_LIST(`R2:(B)ra`, `a2:B`, `f2:B`), RA_LOCAL_UPDATE_REFL)); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm PROD_RA_LOCAL_UPDATE_LEFT = +PROOF static thm PROD_RA_LOCAL_UPDATE_LEFT = prove_prod_ra_local_update_left(); PROOF static thm prove_prod_ra_local_update_right(void) { @@ -2219,11 +2269,13 @@ PROOF static thm prove_prod_ra_local_update_right(void) { forall (R1:(A)ra) (R2:(B)ra) (a1:A) (f1:A) (a2:B) (f2:B) (b2:B) (g2:B). - ra_local_update R2 (a2,f2) (b2,g2) ==> + ra_local_update R2 a2 f2 b2 g2 ==> ra_local_update (prod_ra R1 R2) - ((a1,a2),(f1,f2)) - ((a1,b2),(f1,g2)) + (a1,a2) + (f1,f2) + (a1,b2) + (f1,g2) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); @@ -2236,23 +2288,217 @@ PROOF static thm prove_prod_ra_local_update_right(void) { result = mp_rule( result, ispecl_rule( - TERM_LIST(`R1:(A)ra`, `((a1:A),(f1:A))`), + TERM_LIST(`R1:(A)ra`, `a1:A`, `f1:A`), RA_LOCAL_UPDATE_REFL)); result = mp_rule( result, assume_rule(` ra_local_update (R2:(B)ra) - ((a2:B),(f2:B)) - ((b2:B),(g2:B)) + (a2:B) + (f2:B) + (b2:B) + (g2:B) `)); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm PROD_RA_LOCAL_UPDATE_RIGHT = +PROOF static thm PROD_RA_LOCAL_UPDATE_RIGHT = prove_prod_ra_local_update_right(); +/* ------------------------------------------------------------------------- */ +/* Canonical embeddings */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prod_inl_raw_def = new_fun_definition(` + prod_inl (R:(A)ra) (S:(B)ra) (a:A) : A#B = + (a,ra_unit S) +`); + +PROOF static thm prove_prod_inl_def(void) { + term R = `R:(A)ra`; + term S = `S:(B)ra`; + term a = `a:A`; + return gen_rule(R, gen_rule(S, gen_rule(a, prod_inl_raw_def))); +} + +PROOF thm prod_inl_def = prove_prod_inl_def(); + +PROOF static thm prod_inr_raw_def = new_fun_definition(` + prod_inr (R:(A)ra) (S:(B)ra) (b:B) : A#B = + (ra_unit R,b) +`); + +PROOF static thm prove_prod_inr_def(void) { + term R = `R:(A)ra`; + term S = `S:(B)ra`; + term b = `b:B`; + return gen_rule(R, gen_rule(S, gen_rule(b, prod_inr_raw_def))); +} + +PROOF thm prod_inr_def = prove_prod_inr_def(); + +PROOF static thm prove_prod_inl_op(void) { + term goal_tm = ` + forall (R:(A)ra) (S:(B)ra) (a:A) (b:A). + prod_inl R S (ra_op R a b) == + ra_op (prod_ra R S) (prod_inl R S a) (prod_inl R S b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + prod_inl_def, + PROD_RA_OP, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + RA_UNIT_L))); + return gnode_prove(root); +} + +PROOF thm PROD_INL_OP = prove_prod_inl_op(); + +PROOF static thm prove_prod_inr_op(void) { + term goal_tm = ` + forall (R:(A)ra) (S:(B)ra) (a:B) (b:B). + prod_inr R S (ra_op S a b) == + ra_op (prod_ra R S) (prod_inr R S a) (prod_inr R S b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + prod_inr_def, + PROD_RA_OP, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + RA_UNIT_L))); + return gnode_prove(root); +} + +PROOF thm PROD_INR_OP = prove_prod_inr_op(); + +PROOF static thm prove_prod_inl_updateP(void) { + term goal_tm = ` + forall (R:(A)ra) (S:(B)ra) (a:A) (P:A->bool). + ra_updateP R a P ==> + ra_updateP + (prod_ra R S) + (prod_inl R S a) + (\x:A#B. exists b:A. P b && x == prod_inl R S b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm lifted = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `S:(B)ra`, + `a:A`, + `ra_unit (S:(B)ra)`, + `P:A->bool`), + PROD_RA_UPDATE_LEFTP), + assume_rule(`ra_updateP (R:(A)ra) (a:A) (P:A->bool)`)); + body = CONV_TAC( + body, + rewrite_conv(THM_LIST(prod_inl_def))); + ACCEPT_TAC(body, lifted); + return gnode_prove(root); +} + +PROOF thm PROD_INL_UPDATEP = prove_prod_inl_updateP(); + +PROOF static thm prove_prod_inr_updateP(void) { + term goal_tm = ` + forall (R:(A)ra) (S:(B)ra) (a:B) (P:B->bool). + ra_updateP S a P ==> + ra_updateP + (prod_ra R S) + (prod_inr R S a) + (\x:A#B. exists b:B. P b && x == prod_inr R S b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm lifted = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `S:(B)ra`, + `ra_unit (R:(A)ra)`, + `a:B`, + `P:B->bool`), + PROD_RA_UPDATE_RIGHTP), + assume_rule(`ra_updateP (S:(B)ra) (a:B) (P:B->bool)`)); + body = CONV_TAC( + body, + rewrite_conv(THM_LIST(prod_inr_def))); + ACCEPT_TAC(body, lifted); + return gnode_prove(root); +} + +PROOF thm PROD_INR_UPDATEP = prove_prod_inr_updateP(); + +PROOF static thm prove_prod_inl_update(void) { + term goal_tm = ` + forall (R:(A)ra) (S:(B)ra) (a:A) (b:A). + ra_update R a b ==> + ra_update + (prod_ra R S) + (prod_inl R S a) + (prod_inl R S b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm lifted = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `S:(B)ra`, + `a:A`, + `ra_unit (S:(B)ra)`, + `b:A`), + PROD_RA_UPDATE_LEFT), + assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); + body = CONV_TAC( + body, + rewrite_conv(THM_LIST(prod_inl_def))); + ACCEPT_TAC(body, lifted); + return gnode_prove(root); +} + +PROOF thm PROD_INL_UPDATE = prove_prod_inl_update(); + +PROOF static thm prove_prod_inr_update(void) { + term goal_tm = ` + forall (R:(A)ra) (S:(B)ra) (a:B) (b:B). + ra_update S a b ==> + ra_update + (prod_ra R S) + (prod_inr R S a) + (prod_inr R S b) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm lifted = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `S:(B)ra`, + `ra_unit (R:(A)ra)`, + `a:B`, + `b:B`), + PROD_RA_UPDATE_RIGHT), + assume_rule(`ra_update (S:(B)ra) (a:B) (b:B)`)); + body = CONV_TAC( + body, + rewrite_conv(THM_LIST(prod_inr_def))); + ACCEPT_TAC(body, lifted); + return gnode_prove(root); +} + +PROOF thm PROD_INR_UPDATE = prove_prod_inr_update(); + PROOF static int audit_prod_ra(void) { thm_list source_theorems = THM_LIST( prod_ra_op_def, @@ -2273,20 +2519,30 @@ PROOF static int audit_prod_ra(void) { PROD_RA_CANCELLATIVE_ELIM_LEFT, PROD_RA_CANCELLATIVE_ELIM_RIGHT, PROD_RA_CANCELLATIVE_IFF, - PROD_RA_UPDATE_ND, + PROD_RA_UPDATEP, PROD_RA_UPDATE, PROD_RA_UPDATE_ELIM_LEFT, PROD_RA_UPDATE_ELIM_RIGHT, PROD_RA_UPDATE_IFF, PROD_RA_LEFT_IMAGE_IMP, - PROD_RA_UPDATE_LEFT_ND, + PROD_RA_UPDATE_LEFTP, PROD_RA_UPDATE_LEFT, PROD_RA_RIGHT_IMAGE_IMP, - PROD_RA_UPDATE_RIGHT_ND, + PROD_RA_UPDATE_RIGHTP, PROD_RA_UPDATE_RIGHT, PROD_RA_LOCAL_UPDATE, PROD_RA_LOCAL_UPDATE_LEFT, - PROD_RA_LOCAL_UPDATE_RIGHT); + PROD_RA_LOCAL_UPDATE_RIGHT, + prod_inl_raw_def, + prod_inl_def, + prod_inr_raw_def, + prod_inr_def, + PROD_INL_OP, + PROD_INR_OP, + PROD_INL_UPDATEP, + PROD_INR_UPDATEP, + PROD_INL_UPDATE, + PROD_INR_UPDATE); for (size_t i = 0; i < vector_size(source_theorems); ++i) { ENSURE_COND(!IS_NULL(source_theorems[i]), diff --git a/theory/logic/prod_ra.h b/theory/logic/prod_ra.h index d390540..3d2d300 100644 --- a/theory/logic/prod_ra.h +++ b/theory/logic/prod_ra.h @@ -1,299 +1,33 @@ #pragma once -/* - * Binary product resource algebras: public client API. - * - * For `R1=(|R1|,ε_R1,·_R1,valid_R1)` with `|R1|=A` and - * `R2=(|R2|,ε_R2,·_R2,valid_R2)` with `|R2|=B`, - * `prod_ra R1 R2 : (A#B)ra` has carrier `A#B`, unit `(ε_R1,ε_R2)`, - * pointwise operation, and conjunctive - * validity. - * The raw descriptor, its law proof, and the abstraction projection equations - * are implementation details. Clients should use only the direct rules below. - */ +/* Binary product resource algebra and its canonical component embeddings. */ #include "proof/theory/logic/local_update.h" -/* ------------------------------------------------------------------------- */ -/* Core representation */ -/* ------------------------------------------------------------------------- */ - -/* - * Product unit: - * - * forall (R1:(A)ra) (R2:(B)ra). - * ra_unit (prod_ra R1 R2) == (ra_unit R1,ra_unit R2) - */ PROOF extern thm PROD_RA_UNIT; - -/* - * Pointwise composition: - * - * forall (R1:(A)ra) (R2:(B)ra) (x:A#B) (y:A#B). - * ra_op (prod_ra R1 R2) x y == - * (ra_op R1 (FST x) (FST y), - * ra_op R2 (SND x) (SND y)) - */ PROOF extern thm PROD_RA_OP; - -/* - * Componentwise validity: - * - * forall (R1:(A)ra) (R2:(B)ra) (x:A#B). - * ra_valid (prod_ra R1 R2) x <=> - * ra_valid R1 (FST x) && ra_valid R2 (SND x) - */ PROOF extern thm PROD_RA_VALID; - -/* ------------------------------------------------------------------------- */ -/* Order and optional laws */ -/* ------------------------------------------------------------------------- */ - -/* - * Inclusion is componentwise: - * - * forall (R1:(A)ra) (R2:(B)ra) (x:A#B) (y:A#B). - * ra_included (prod_ra R1 R2) x y <=> - * ra_included R1 (FST x) (FST y) && - * ra_included R2 (SND x) (SND y) - * - * Each direction preserves the exact extension frame: a product frame - * projects to the two component frames, and two component frames combine - * into exactly their pair. - */ PROOF extern thm PROD_RA_INCLUDED; - -/* - * Compatible-frame exclusivity lifts when both components are exclusive: - * - * forall (R1:(A)ra) (R2:(B)ra) (x:A#B). - * ra_exclusive R1 (FST x) ==> - * ra_exclusive R2 (SND x) ==> - * ra_exclusive (prod_ra R1 R2) x - * - * Requiring both sides is essential for this library's `ra_exclusive`, which - * permits the unit frame. Iris's class named `Exclusive` instead rules out - * every valid frame, so its product instance can be obtained from one side; - * that is a different predicate. - */ -PROOF extern thm PROD_RA_EXCLUSIVE; - -/* - * A valid exclusive product has an exclusive left projection: - * - * forall (R1:(A)ra) (R2:(B)ra) (x:A#B). - * ra_valid (prod_ra R1 R2) x ==> - * ra_exclusive (prod_ra R1 R2) x ==> - * ra_exclusive R1 (FST x) - * - * Source validity is necessary: an invalid component can otherwise make the - * whole product exclusive vacuously. - */ -PROOF extern thm PROD_RA_EXCLUSIVE_ELIM_LEFT; - -/* - * A valid exclusive product has an exclusive right projection: - * - * forall (R1:(A)ra) (R2:(B)ra) (x:A#B). - * ra_valid (prod_ra R1 R2) x ==> - * ra_exclusive (prod_ra R1 R2) x ==> - * ra_exclusive R2 (SND x) - */ -PROOF extern thm PROD_RA_EXCLUSIVE_ELIM_RIGHT; - -/* - * Exact characterization for valid products: - * - * forall (R1:(A)ra) (R2:(B)ra) (x:A#B). - * ra_valid (prod_ra R1 R2) x ==> - * (ra_exclusive (prod_ra R1 R2) x <=> - * ra_exclusive R1 (FST x) && ra_exclusive R2 (SND x)) - */ -PROOF extern thm PROD_RA_EXCLUSIVE_IFF; - -/* - * Cancellativity lifts componentwise: - * - * forall (R1:(A)ra) (R2:(B)ra). - * ra_cancellative R1 ==> - * ra_cancellative R2 ==> - * ra_cancellative (prod_ra R1 R2) - * - * As in the generic definition, only the source composition is required to - * be valid; product validity supplies exactly the two component premises. - */ -PROOF extern thm PROD_RA_CANCELLATIVE; - -/* - * Product cancellativity is exact: - * - * forall (R1:(A)ra) (R2:(B)ra). - * ra_cancellative (prod_ra R1 R2) <=> - * ra_cancellative R1 && ra_cancellative R2 - * - * The reverse direction is `PROD_RA_CANCELLATIVE`; each forward projection - * embeds the other component at its valid unit. - */ PROOF extern thm PROD_RA_CANCELLATIVE_IFF; +PROOF extern thm PROD_RA_EXCLUSIVE_IFF; -/* ------------------------------------------------------------------------- */ -/* Product updates */ -/* ------------------------------------------------------------------------- */ - -/* - * Independent nondeterministic updates combine: - * - * forall (R1:(A)ra) (R2:(B)ra) - * (a1:A) (a2:B) (P1:A->bool) (P2:B->bool). - * ra_update_nd R1 a1 P1 ==> - * ra_update_nd R2 a2 P2 ==> - * ra_update_nd - * (prod_ra R1 R2) - * (a1,a2) - * (\x:A#B. exists b1:A. exists b2:B. - * P1 b1 && P2 b2 && x == (b1,b2)) - * - * The existential predicate describes exactly the pairs selected by the two - * component updates; it does not admit unrelated product values. - */ -PROOF extern thm PROD_RA_UPDATE_ND; - -/* - * Independent deterministic updates combine: - * - * forall (R1:(A)ra) (R2:(B)ra) - * (a1:A) (a2:B) (b1:A) (b2:B). - * ra_update R1 a1 b1 ==> - * ra_update R2 a2 b2 ==> - * ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) - */ -PROOF extern thm PROD_RA_UPDATE; - -/* - * A product update induces its left component update when the unchanged - * source context on the right is valid: - * - * forall (R1:(A)ra) (R2:(B)ra) - * (a1:A) (a2:B) (b1:A) (b2:B). - * ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) ==> - * ra_valid R2 a2 ==> - * ra_update R1 a1 b1 - */ -PROOF extern thm PROD_RA_UPDATE_ELIM_LEFT; - -/* - * A product update induces its right component update when the left source - * component is valid: - * - * forall (R1:(A)ra) (R2:(B)ra) - * (a1:A) (a2:B) (b1:A) (b2:B). - * ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) ==> - * ra_valid R1 a1 ==> - * ra_update R2 a2 b2 - */ -PROOF extern thm PROD_RA_UPDATE_ELIM_RIGHT; - -/* - * Exact deterministic update characterization for a valid source: - * - * forall (R1:(A)ra) (R2:(B)ra) - * (a1:A) (a2:B) (b1:A) (b2:B). - * ra_valid R1 a1 ==> - * ra_valid R2 a2 ==> - * (ra_update (prod_ra R1 R2) (a1,a2) (b1,b2) <=> - * ra_update R1 a1 b1 && ra_update R2 a2 b2) - */ -PROOF extern thm PROD_RA_UPDATE_IFF; - -/* - * A nondeterministic update of the left component preserves the right one: - * - * forall (R1:(A)ra) (R2:(B)ra) - * (a1:A) (a2:B) (P:A->bool). - * ra_update_nd R1 a1 P ==> - * ra_update_nd - * (prod_ra R1 R2) - * (a1,a2) - * (\x:A#B. exists b1:A. P b1 && x == (b1,a2)) - */ -PROOF extern thm PROD_RA_UPDATE_LEFT_ND; +/* Componentwise predicate update. */ +PROOF extern thm PROD_RA_UPDATEP; -/* - * A deterministic update of the left component preserves the right one: - * - * forall (R1:(A)ra) (R2:(B)ra) - * (a1:A) (a2:B) (b1:A). - * ra_update R1 a1 b1 ==> - * ra_update (prod_ra R1 R2) (a1,a2) (b1,a2) - */ +/* Deterministic one-coordinate updates. */ PROOF extern thm PROD_RA_UPDATE_LEFT; - -/* - * A nondeterministic update of the right component preserves the left one: - * - * forall (R1:(A)ra) (R2:(B)ra) - * (a1:A) (a2:B) (P:B->bool). - * ra_update_nd R2 a2 P ==> - * ra_update_nd - * (prod_ra R1 R2) - * (a1,a2) - * (\x:A#B. exists b2:B. P b2 && x == (a1,b2)) - */ -PROOF extern thm PROD_RA_UPDATE_RIGHT_ND; - -/* - * A deterministic update of the right component preserves the left one: - * - * forall (R1:(A)ra) (R2:(B)ra) - * (a1:A) (a2:B) (b2:B). - * ra_update R2 a2 b2 ==> - * ra_update (prod_ra R1 R2) (a1,a2) (a1,b2) - */ PROOF extern thm PROD_RA_UPDATE_RIGHT; -/* ------------------------------------------------------------------------- */ -/* Product local updates */ -/* ------------------------------------------------------------------------- */ - -/* - * Independent component local updates combine pointwise: - * - * forall (R1:(A)ra) (R2:(B)ra) - * (a1:A) (f1:A) (b1:A) (g1:A) - * (a2:B) (f2:B) (b2:B) (g2:B). - * ra_local_update R1 (a1,f1) (b1,g1) ==> - * ra_local_update R2 (a2,f2) (b2,g2) ==> - * ra_local_update - * (prod_ra R1 R2) - * ((a1,a2),(f1,f2)) - * ((b1,b2),(g1,g2)) - */ +/* Componentwise five-argument local update. */ PROOF extern thm PROD_RA_LOCAL_UPDATE; -/* - * A left local update preserves both visible components on the right: - * - * forall (R1:(A)ra) (R2:(B)ra) - * (a1:A) (f1:A) (b1:A) (g1:A) - * (a2:B) (f2:B). - * ra_local_update R1 (a1,f1) (b1,g1) ==> - * ra_local_update - * (prod_ra R1 R2) - * ((a1,a2),(f1,f2)) - * ((b1,a2),(g1,f2)) - */ -PROOF extern thm PROD_RA_LOCAL_UPDATE_LEFT; +/* `prod_inl R S a == (a,ra_unit S)` and its right-hand dual. */ +PROOF extern thm prod_inl_def; +PROOF extern thm prod_inr_def; -/* - * A right local update preserves both visible components on the left: - * - * forall (R1:(A)ra) (R2:(B)ra) - * (a1:A) (f1:A) - * (a2:B) (f2:B) (b2:B) (g2:B). - * ra_local_update R2 (a2,f2) (b2,g2) ==> - * ra_local_update - * (prod_ra R1 R2) - * ((a1,a2),(f1,f2)) - * ((a1,b2),(f1,g2)) - */ -PROOF extern thm PROD_RA_LOCAL_UPDATE_RIGHT; +PROOF extern thm PROD_INL_OP; +PROOF extern thm PROD_INR_OP; +PROOF extern thm PROD_INL_UPDATEP; +PROOF extern thm PROD_INR_UPDATEP; +PROOF extern thm PROD_INL_UPDATE; +PROOF extern thm PROD_INR_UPDATE; diff --git a/theory/logic/prod_ra_internal.h b/theory/logic/prod_ra_internal.h new file mode 100644 index 0000000..34cc77d --- /dev/null +++ b/theory/logic/prod_ra_internal.h @@ -0,0 +1,8 @@ +#pragma once + +/* Private product-RA rules used while implementing dependent constructors. */ + +#include "proof/theory/logic/prod_ra.h" + +/* One-way constructor rule used by `auth_ra.c`; clients use the public iff. */ +PROOF extern thm PROD_RA_CANCELLATIVE; diff --git a/theory/logic/product_resource.c b/theory/logic/product_resource.c new file mode 100644 index 0000000..3ab2154 --- /dev/null +++ b/theory/logic/product_resource.c @@ -0,0 +1,2074 @@ +#include "proof/theory/logic/product_resource.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#require "proof/theory/logic/prod_ra.c" +#require "proof/theory/logic/resource_prop.c" + +PROOF static size_t PRODUCT_RESOURCE_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF static thm prove_r_equiv_of_eq(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (P:A->bool) (Q:A->bool). + P == Q ==> r_equiv R P Q + `); + gnode body = AUTO_INTROS_TAC(root); + thm lifted = beta_rule(ap_term_rule( + `\X:A->bool. r_equiv (R:(A)ra) (P:A->bool) X`, + assume_rule(`(P:A->bool) == (Q:A->bool)`))); + ACCEPT_TAC( + body, + eq_mp_rule( + lifted, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `P:A->bool`), + R_EQUIV_REFL))); + return gnode_prove(root); +} + +PROOF static thm R_EQUIV_OF_EQ_PRODUCT = + prove_r_equiv_of_eq(); + +PROOF thm r_lift_left_def = new_fun_definition(` + r_lift_left + (R:(A)ra) + (S:(B)ra) + (P:A->bool) + (resource:A#B) <=> + P (FST resource) && + SND resource == ra_unit S +`); + +PROOF thm r_lift_right_def = new_fun_definition(` + r_lift_right + (R:(A)ra) + (S:(B)ra) + (Q:B->bool) + (resource:A#B) <=> + FST resource == ra_unit R && + Q (SND resource) +`); + +PROOF thm r_bupd_right_def = new_fun_definition(` + r_bupd_right + (R:(A)ra) + (S:(B)ra) + (Q:(A#B)->bool) + (resource:A#B) <=> + ra_updateP + S + (SND resource) + (\right':B. Q (FST resource,right')) +`); + +PROOF thm r_viewshift_right_def = new_fun_definition(` + r_viewshift_right + (R:(A)ra) + (S:(B)ra) + (P:(A#B)->bool) + (Q:(A#B)->bool) <=> + r_entails (prod_ra R S) P (r_bupd_right R S Q) +`); + +PROOF static thm prove_r_lift_left_emp_eq(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (S:(B)ra). + r_lift_left R S (r_emp R) == + r_emp (prod_ra R S) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ispecl_rule( + TERM_LIST( + `r_lift_left (R:(A)ra) (S:(B)ra) (r_emp R)`, + `r_emp (prod_ra (R:(A)ra) (S:(B)ra))`), + get_theorem_by_name("FUN_EQ_THM"))))); + body = GEN_TAC(body, "resource"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST( + r_lift_left_def, + r_emp_def, + PROD_RA_UNIT))); + thm pair_components = ispecl_rule( + TERM_LIST( + `FST (resource:A#B)`, + `SND (resource:A#B)`, + `ra_unit (R:(A)ra)`, + `ra_unit (S:(B)ra)`), + get_theorem_by_name("PAIR_EQ")); + thm resource_eta = ispec_rule( + `resource:A#B`, + get_theorem_by_name("PAIR")); + thm resource_eq_pair = beta_rule(ap_term_rule( + `\candidate:A#B. + candidate == + (ra_unit (R:(A)ra),ra_unit (S:(B)ra))`, + resource_eta)); + ACCEPT_TAC( + body, + trans_rule(gsym_rule(pair_components), resource_eq_pair)); + return gnode_prove(root); +} + +PROOF thm R_LIFT_LEFT_EMP_EQ = + prove_r_lift_left_emp_eq(); + +PROOF static thm prove_r_lift_right_emp_eq(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (S:(B)ra). + r_lift_right R S (r_emp S) == + r_emp (prod_ra R S) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ispecl_rule( + TERM_LIST( + `r_lift_right (R:(A)ra) (S:(B)ra) (r_emp S)`, + `r_emp (prod_ra (R:(A)ra) (S:(B)ra))`), + get_theorem_by_name("FUN_EQ_THM"))))); + body = GEN_TAC(body, "resource"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST( + r_lift_right_def, + r_emp_def, + PROD_RA_UNIT))); + thm pair_components = ispecl_rule( + TERM_LIST( + `FST (resource:A#B)`, + `SND (resource:A#B)`, + `ra_unit (R:(A)ra)`, + `ra_unit (S:(B)ra)`), + get_theorem_by_name("PAIR_EQ")); + thm resource_eta = ispec_rule( + `resource:A#B`, + get_theorem_by_name("PAIR")); + thm resource_eq_pair = beta_rule(ap_term_rule( + `\candidate:A#B. + candidate == + (ra_unit (R:(A)ra),ra_unit (S:(B)ra))`, + resource_eta)); + ACCEPT_TAC( + body, + trans_rule(gsym_rule(pair_components), resource_eq_pair)); + return gnode_prove(root); +} + +PROOF thm R_LIFT_RIGHT_EMP_EQ = + prove_r_lift_right_emp_eq(); + +PROOF static thm prove_r_lift_left_emp(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (S:(B)ra). + r_equiv + (prod_ra R S) + (r_lift_left R S (r_emp R)) + (r_emp (prod_ra R S)) + `); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `r_lift_left (R:(A)ra) (S:(B)ra) (r_emp R)`, + `r_emp (prod_ra (R:(A)ra) (S:(B)ra))`), + R_EQUIV_OF_EQ_PRODUCT), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `S:(B)ra`), + R_LIFT_LEFT_EMP_EQ))); + return gnode_prove(root); +} + +PROOF thm R_LIFT_LEFT_EMP = + prove_r_lift_left_emp(); + +PROOF static thm prove_r_lift_right_emp(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (S:(B)ra). + r_equiv + (prod_ra R S) + (r_lift_right R S (r_emp S)) + (r_emp (prod_ra R S)) + `); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `r_lift_right (R:(A)ra) (S:(B)ra) (r_emp S)`, + `r_emp (prod_ra (R:(A)ra) (S:(B)ra))`), + R_EQUIV_OF_EQ_PRODUCT), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `S:(B)ra`), + R_LIFT_RIGHT_EMP_EQ))); + return gnode_prove(root); +} + +PROOF thm R_LIFT_RIGHT_EMP = + prove_r_lift_right_emp(); + +PROOF static thm prove_r_lift_left_entails(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (S:(B)ra) + (P:A->bool) + (Q:A->bool). + r_entails R P Q ==> + r_entails + (prod_ra R S) + (r_lift_left R S P) + (r_lift_left R S Q) + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_lift_left_def))); + body = AUTO_INTROS_TAC(body); + thm components = eq_mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `S:(B)ra`, `resource:A#B`), + PROD_RA_VALID), + assume_rule(` + ra_valid + (prod_ra (R:(A)ra) (S:(B)ra)) + (resource:A#B) + `)); + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC( + result[0], + mp_rule( + mp_rule( + spec_rule( + `FST (resource:A#B)`, + assume_rule(` + forall owned:A. + ra_valid (R:(A)ra) owned ==> + (P:A->bool) owned ==> + (Q:A->bool) owned + `)), + conjunct1_rule(components)), + conjunct1_rule(assume_rule(` + (P:A->bool) (FST (resource:A#B)) && + SND resource == ra_unit (S:(B)ra) + `)))); + ACCEPT_TAC( + result[1], + conjunct2_rule(assume_rule(` + (P:A->bool) (FST (resource:A#B)) && + SND resource == ra_unit (S:(B)ra) + `))); + return gnode_prove(root); +} + +PROOF thm R_LIFT_LEFT_ENTAILS = + prove_r_lift_left_entails(); + +PROOF static thm prove_r_lift_right_entails(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (S:(B)ra) + (P:B->bool) + (Q:B->bool). + r_entails S P Q ==> + r_entails + (prod_ra R S) + (r_lift_right R S P) + (r_lift_right R S Q) + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_lift_right_def))); + body = AUTO_INTROS_TAC(body); + thm components = eq_mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `S:(B)ra`, `resource:A#B`), + PROD_RA_VALID), + assume_rule(` + ra_valid + (prod_ra (R:(A)ra) (S:(B)ra)) + (resource:A#B) + `)); + gnode_list result = CONJ_TAC(body); + ACCEPT_TAC( + result[0], + conjunct1_rule(assume_rule(` + FST (resource:A#B) == ra_unit (R:(A)ra) && + (P:B->bool) (SND resource) + `))); + ACCEPT_TAC( + result[1], + mp_rule( + mp_rule( + spec_rule( + `SND (resource:A#B)`, + assume_rule(` + forall owned:B. + ra_valid (S:(B)ra) owned ==> + (P:B->bool) owned ==> + (Q:B->bool) owned + `)), + conjunct2_rule(components)), + conjunct2_rule(assume_rule(` + FST (resource:A#B) == ra_unit (R:(A)ra) && + (P:B->bool) (SND resource) + `)))); + return gnode_prove(root); +} + +PROOF thm R_LIFT_RIGHT_ENTAILS = + prove_r_lift_right_entails(); + +PROOF static thm prove_r_lift_left_sep_eq(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (S:(B)ra) + (P:A->bool) + (Q:A->bool). + r_lift_left R S (r_sep R P Q) == + r_sep + (prod_ra R S) + (r_lift_left R S P) + (r_lift_left R S Q) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ispecl_rule( + TERM_LIST( + `r_lift_left (R:(A)ra) (S:(B)ra) + (r_sep R (P:A->bool) (Q:A->bool))`, + `r_sep (prod_ra (R:(A)ra) (S:(B)ra)) + (r_lift_left (R:(A)ra) (S:(B)ra) (P:A->bool)) + (r_lift_left (R:(A)ra) (S:(B)ra) (Q:A->bool))`), + get_theorem_by_name("FUN_EQ_THM"))))); + body = GEN_TAC(body, "resource"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(r_lift_left_def, r_sep_def))); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hsource"); + forward = ASMP_CONJ_TAC( + forward, "Hsource", "Hcomponent_sep", "Hright_unit"); + forward = ASMP_EXISTS_TAC( + forward, "Hcomponent_sep", "component_left"); + forward = ASMP_EXISTS_TAC( + forward, "Hcomponent_sep", "component_right"); + forward = ASMP_CONJ_TAC( + forward, "Hcomponent_sep", "Hcomponent_split", "Hcomponent_preds"); + forward = ASMP_CONJ_TAC( + forward, "Hcomponent_preds", "HP", "HQ"); + forward = EXISTS_TAC( + forward, + `((component_left:A),(ra_unit (S:(B)ra)))`); + forward = EXISTS_TAC( + forward, + `((component_right:A),(ra_unit (S:(B)ra)))`); + gnode_list forward1 = CONJ_TAC(forward); + thm pair_components = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `FST (resource:A#B)`, + `SND (resource:A#B)`, + `ra_op R (component_left:A) (component_right:A)`, + `ra_unit (S:(B)ra)`), + get_theorem_by_name("PAIR_EQ"))), + conj_rule( + assume_rule(` + FST (resource:A#B) == + ra_op (R:(A)ra) (component_left:A) (component_right:A) + `), + assume_rule(`SND (resource:A#B) == ra_unit (S:(B)ra)`))); + thm resource_pair = trans_rule( + gsym_rule(ispec_rule( + `resource:A#B`, + get_theorem_by_name("PAIR"))), + pair_components); + thm combined_op = ispecl_rule( + TERM_LIST( + `R:(A)ra`, `S:(B)ra`, + `((component_left:A),(ra_unit (S:(B)ra)))`, + `((component_right:A),(ra_unit (S:(B)ra)))`), + PROD_RA_OP); + combined_op = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + RA_UNIT_L), + combined_op); + ACCEPT_TAC( + forward1[0], + trans_rule(resource_pair, gsym_rule(combined_op))); + gnode_list forward2 = CONJ_TAC(forward1[1]); + gnode_list left_lift = CONJ_TAC(forward2[0]); + gnode left_pred = CONV_TAC( + left_lift[0], + rewrite_conv(THM_LIST(get_theorem_by_name("FST")))); + ACCEPT_TAC(left_pred, assume_rule(`(P:A->bool) (component_left:A)`)); + CONV_TAC( + left_lift[1], + rewrite_conv(THM_LIST(get_theorem_by_name("SND")))); + gnode_list right_lift = CONJ_TAC(forward2[1]); + gnode right_pred = CONV_TAC( + right_lift[0], + rewrite_conv(THM_LIST(get_theorem_by_name("FST")))); + ACCEPT_TAC(right_pred, assume_rule(`(Q:A->bool) (component_right:A)`)); + CONV_TAC( + right_lift[1], + rewrite_conv(THM_LIST(get_theorem_by_name("SND")))); + + gnode reverse = DISCH_TAC(directions[1], "Hcombined"); + reverse = ASMP_EXISTS_TAC(reverse, "Hcombined", "left"); + reverse = ASMP_EXISTS_TAC(reverse, "Hcombined", "right"); + reverse = ASMP_CONJ_TAC( + reverse, "Hcombined", "Hsplit", "Hlifts"); + reverse = ASMP_CONJ_TAC(reverse, "Hlifts", "Hleft", "Hright"); + reverse = ASMP_CONJ_TAC(reverse, "Hleft", "HP", "Hleft_unit"); + reverse = ASMP_CONJ_TAC(reverse, "Hright", "HQ", "Hright_unit"); + gnode_list reverse_parts = CONJ_TAC(reverse); + gnode component_sep = EXISTS_TAC(reverse_parts[0], `FST (left:A#B)`); + component_sep = EXISTS_TAC(component_sep, `FST (right:A#B)`); + gnode_list component_parts = CONJ_TAC(component_sep); + thm fst_split = ap_term_rule( + `FST:(A#B)->A`, + assume_rule(` + (resource:A#B) == + ra_op + (prod_ra (R:(A)ra) (S:(B)ra)) + (left:A#B) (right:A#B) + `)); + fst_split = pure_rewrite_rule( + THM_LIST(PROD_RA_OP, get_theorem_by_name("FST")), + fst_split); + ACCEPT_TAC(component_parts[0], fst_split); + gnode_list component_preds = CONJ_TAC(component_parts[1]); + ACCEPT_TAC(component_preds[0], assume_rule(`(P:A->bool) (FST (left:A#B))`)); + ACCEPT_TAC(component_preds[1], assume_rule(`(Q:A->bool) (FST (right:A#B))`)); + thm snd_split = ap_term_rule( + `SND:(A#B)->B`, + assume_rule(` + (resource:A#B) == + ra_op + (prod_ra (R:(A)ra) (S:(B)ra)) + (left:A#B) (right:A#B) + `)); + snd_split = pure_rewrite_rule( + THM_LIST( + PROD_RA_OP, + get_theorem_by_name("SND"), + assume_rule(`SND (left:A#B) == ra_unit (S:(B)ra)`), + assume_rule(`SND (right:A#B) == ra_unit (S:(B)ra)`), + RA_UNIT_L), + snd_split); + ACCEPT_TAC(reverse_parts[1], snd_split); + return gnode_prove(root); +} + +PROOF thm R_LIFT_LEFT_SEP_EQ = + prove_r_lift_left_sep_eq(); + +PROOF static thm prove_r_lift_right_sep_eq(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (S:(B)ra) + (P:B->bool) + (Q:B->bool). + r_lift_right R S (r_sep S P Q) == + r_sep + (prod_ra R S) + (r_lift_right R S P) + (r_lift_right R S Q) + `); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(ispecl_rule( + TERM_LIST( + `r_lift_right (R:(A)ra) (S:(B)ra) + (r_sep S (P:B->bool) (Q:B->bool))`, + `r_sep (prod_ra (R:(A)ra) (S:(B)ra)) + (r_lift_right (R:(A)ra) (S:(B)ra) (P:B->bool)) + (r_lift_right (R:(A)ra) (S:(B)ra) (Q:B->bool))`), + get_theorem_by_name("FUN_EQ_THM"))))); + body = GEN_TAC(body, "resource"); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(r_lift_right_def, r_sep_def))); + gnode_list directions = EQ_TAC(body); + + gnode forward = DISCH_TAC(directions[0], "Hsource"); + forward = ASMP_CONJ_TAC( + forward, "Hsource", "Hleft_unit", "Hcomponent_sep"); + forward = ASMP_EXISTS_TAC( + forward, "Hcomponent_sep", "component_left"); + forward = ASMP_EXISTS_TAC( + forward, "Hcomponent_sep", "component_right"); + forward = ASMP_CONJ_TAC( + forward, "Hcomponent_sep", "Hcomponent_split", "Hcomponent_preds"); + forward = ASMP_CONJ_TAC( + forward, "Hcomponent_preds", "HP", "HQ"); + forward = EXISTS_TAC( + forward, + `((ra_unit (R:(A)ra)),(component_left:B))`); + forward = EXISTS_TAC( + forward, + `((ra_unit (R:(A)ra)),(component_right:B))`); + gnode_list forward1 = CONJ_TAC(forward); + thm pair_components = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `FST (resource:A#B)`, + `SND (resource:A#B)`, + `ra_unit (R:(A)ra)`, + `ra_op S (component_left:B) (component_right:B)`), + get_theorem_by_name("PAIR_EQ"))), + conj_rule( + assume_rule(`FST (resource:A#B) == ra_unit (R:(A)ra)`), + assume_rule(` + SND (resource:A#B) == + ra_op (S:(B)ra) (component_left:B) (component_right:B) + `))); + thm resource_pair = trans_rule( + gsym_rule(ispec_rule( + `resource:A#B`, + get_theorem_by_name("PAIR"))), + pair_components); + thm combined_op = ispecl_rule( + TERM_LIST( + `R:(A)ra`, `S:(B)ra`, + `((ra_unit (R:(A)ra)),(component_left:B))`, + `((ra_unit (R:(A)ra)),(component_right:B))`), + PROD_RA_OP); + combined_op = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + RA_UNIT_L), + combined_op); + ACCEPT_TAC( + forward1[0], + trans_rule(resource_pair, gsym_rule(combined_op))); + gnode_list forward2 = CONJ_TAC(forward1[1]); + gnode_list left_lift = CONJ_TAC(forward2[0]); + CONV_TAC( + left_lift[0], + rewrite_conv(THM_LIST(get_theorem_by_name("FST")))); + gnode left_pred = CONV_TAC( + left_lift[1], + rewrite_conv(THM_LIST(get_theorem_by_name("SND")))); + ACCEPT_TAC(left_pred, assume_rule(`(P:B->bool) (component_left:B)`)); + gnode_list right_lift = CONJ_TAC(forward2[1]); + CONV_TAC( + right_lift[0], + rewrite_conv(THM_LIST(get_theorem_by_name("FST")))); + gnode right_pred = CONV_TAC( + right_lift[1], + rewrite_conv(THM_LIST(get_theorem_by_name("SND")))); + ACCEPT_TAC(right_pred, assume_rule(`(Q:B->bool) (component_right:B)`)); + + gnode reverse = DISCH_TAC(directions[1], "Hcombined"); + reverse = ASMP_EXISTS_TAC(reverse, "Hcombined", "left"); + reverse = ASMP_EXISTS_TAC(reverse, "Hcombined", "right"); + reverse = ASMP_CONJ_TAC( + reverse, "Hcombined", "Hsplit", "Hlifts"); + reverse = ASMP_CONJ_TAC(reverse, "Hlifts", "Hleft", "Hright"); + reverse = ASMP_CONJ_TAC(reverse, "Hleft", "Hleft_unit", "HP"); + reverse = ASMP_CONJ_TAC(reverse, "Hright", "Hright_unit", "HQ"); + gnode_list reverse_parts = CONJ_TAC(reverse); + thm fst_split = ap_term_rule( + `FST:(A#B)->A`, + assume_rule(` + (resource:A#B) == + ra_op + (prod_ra (R:(A)ra) (S:(B)ra)) + (left:A#B) (right:A#B) + `)); + fst_split = pure_rewrite_rule( + THM_LIST( + PROD_RA_OP, + get_theorem_by_name("FST"), + assume_rule(`FST (left:A#B) == ra_unit (R:(A)ra)`), + assume_rule(`FST (right:A#B) == ra_unit (R:(A)ra)`), + RA_UNIT_L), + fst_split); + ACCEPT_TAC(reverse_parts[0], fst_split); + gnode component_sep = EXISTS_TAC(reverse_parts[1], `SND (left:A#B)`); + component_sep = EXISTS_TAC(component_sep, `SND (right:A#B)`); + gnode_list component_parts = CONJ_TAC(component_sep); + thm snd_split = ap_term_rule( + `SND:(A#B)->B`, + assume_rule(` + (resource:A#B) == + ra_op + (prod_ra (R:(A)ra) (S:(B)ra)) + (left:A#B) (right:A#B) + `)); + snd_split = pure_rewrite_rule( + THM_LIST(PROD_RA_OP, get_theorem_by_name("SND")), + snd_split); + ACCEPT_TAC(component_parts[0], snd_split); + gnode_list component_preds = CONJ_TAC(component_parts[1]); + ACCEPT_TAC(component_preds[0], assume_rule(`(P:B->bool) (SND (left:A#B))`)); + ACCEPT_TAC(component_preds[1], assume_rule(`(Q:B->bool) (SND (right:A#B))`)); + return gnode_prove(root); +} + +PROOF thm R_LIFT_RIGHT_SEP_EQ = + prove_r_lift_right_sep_eq(); + +PROOF static thm prove_r_lift_left_sep(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (S:(B)ra) (P:A->bool) (Q:A->bool). + r_equiv + (prod_ra R S) + (r_lift_left R S (r_sep R P Q)) + (r_sep (prod_ra R S) + (r_lift_left R S P) + (r_lift_left R S Q)) + `); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `r_lift_left (R:(A)ra) (S:(B)ra) + (r_sep R (P:A->bool) (Q:A->bool))`, + `r_sep (prod_ra (R:(A)ra) (S:(B)ra)) + (r_lift_left R S (P:A->bool)) + (r_lift_left R S (Q:A->bool))`), + R_EQUIV_OF_EQ_PRODUCT), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `S:(B)ra`, `P:A->bool`, `Q:A->bool`), + R_LIFT_LEFT_SEP_EQ))); + return gnode_prove(root); +} + +PROOF thm R_LIFT_LEFT_SEP = + prove_r_lift_left_sep(); + +PROOF static thm prove_r_lift_right_sep(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (S:(B)ra) (P:B->bool) (Q:B->bool). + r_equiv + (prod_ra R S) + (r_lift_right R S (r_sep S P Q)) + (r_sep (prod_ra R S) + (r_lift_right R S P) + (r_lift_right R S Q)) + `); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `r_lift_right (R:(A)ra) (S:(B)ra) + (r_sep S (P:B->bool) (Q:B->bool))`, + `r_sep (prod_ra (R:(A)ra) (S:(B)ra)) + (r_lift_right R S (P:B->bool)) + (r_lift_right R S (Q:B->bool))`), + R_EQUIV_OF_EQ_PRODUCT), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `S:(B)ra`, `P:B->bool`, `Q:B->bool`), + R_LIFT_RIGHT_SEP_EQ))); + return gnode_prove(root); +} + +PROOF thm R_LIFT_RIGHT_SEP = + prove_r_lift_right_sep(); + +PROOF static thm prove_r_bupd_right_intro(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool). + r_entails (prod_ra R S) P (r_bupd_right R S P) + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_bupd_right_def, + ra_updateP_def))); + body = AUTO_INTROS_TAC(body); + body = EXISTS_TAC(body, `SND (resource:A#B)`); + gnode_list result = CONJ_TAC(body); + gnode post = CONV_TAC( + result[0], + get_conversion_by_name("BETA_CONV")); + thm eta = ispec_rule( + `resource:A#B`, + get_theorem_by_name("PAIR")); + thm pred_eta = ap_term_rule(`P:(A#B)->bool`, eta); + ACCEPT_TAC( + post, + eq_mp_rule( + gsym_rule(pred_eta), + assume_rule(`(P:(A#B)->bool) (resource:A#B)`))); + ACCEPT_TAC( + result[1], + assume_rule(` + ra_valid + (S:(B)ra) + (ra_op S (SND (resource:A#B)) (frame:B)) + `)); + return gnode_prove(root); +} + +PROOF thm R_BUPD_RIGHT_INTRO = + prove_r_bupd_right_intro(); + +PROOF static thm prove_r_bupd_right_mono(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (S:(B)ra) + (P:(A#B)->bool) + (Q:(A#B)->bool). + r_entails (prod_ra R S) P Q ==> + r_entails + (prod_ra R S) + (r_bupd_right R S P) + (r_bupd_right R S Q) + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_bupd_right_def, + ra_updateP_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "S"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = DISCH_TAC(body, "Hmono"); + body = GEN_TAC(body, "owned"); + body = DISCH_TAC(body, "Hvalid_owned"); + body = DISCH_TAC(body, "Hupdate"); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hvalid_source"); + + thm selected = mp_rule( + spec_rule( + `frame:B`, + assume_rule(` + forall frame:B. + ra_valid + (S:(B)ra) + (ra_op S (SND (owned:A#B)) frame) ==> + exists selected:B. + (P:(A#B)->bool) (FST owned,selected) && + ra_valid S (ra_op S selected frame) + `)), + assume_rule(` + ra_valid + (S:(B)ra) + (ra_op S (SND (owned:A#B)) (frame:B)) + `)); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "selected"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "HP", + "Hvalid_selected_frame"); + + thm owned_components = eq_mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `S:(B)ra`, `owned:A#B`), + PROD_RA_VALID), + assume_rule(` + ra_valid (prod_ra (R:(A)ra) (S:(B)ra)) (owned:A#B) + `)); + thm selected_valid = conjunct1_rule(mp_rule( + ispecl_rule( + TERM_LIST(`S:(B)ra`, `selected:B`, `frame:B`), + RA_VALID_OP), + assume_rule(` + ra_valid + (S:(B)ra) + (ra_op S (selected:B) (frame:B)) + `))); + thm selected_pair_rule = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `S:(B)ra`, + `((FST (owned:A#B)),(selected:B))`), + PROD_RA_VALID); + selected_pair_rule = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + selected_pair_rule); + thm selected_pair_valid = eq_mp_rule( + gsym_rule(selected_pair_rule), + conj_rule(conjunct1_rule(owned_components), selected_valid)); + thm q_selected = mp_rule( + mp_rule( + spec_rule( + `((FST (owned:A#B)),(selected:B))`, + assume_rule(` + forall resource:A#B. + ra_valid (prod_ra (R:(A)ra) (S:(B)ra)) resource ==> + (P:(A#B)->bool) resource ==> + (Q:(A#B)->bool) resource + `)), + selected_pair_valid), + assume_rule(` + (P:(A#B)->bool) (FST (owned:A#B),selected:B) + `)); + + body = EXISTS_TAC(body, `selected:B`); + gnode_list result = CONJ_TAC(body); + gnode post = result[0]; + ACCEPT_TAC(post, q_selected); + ACCEPT_TAC( + result[1], + assume_rule(` + ra_valid + (S:(B)ra) + (ra_op S (selected:B) (frame:B)) + `)); + return gnode_prove(root); +} + +PROOF thm R_BUPD_RIGHT_MONO = + prove_r_bupd_right_mono(); + +PROOF static thm prove_r_bupd_right_idem(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool). + r_entails + (prod_ra R S) + (r_bupd_right R S (r_bupd_right R S P)) + (r_bupd_right R S P) + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_bupd_right_def, + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "S"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "owned"); + body = DISCH_TAC(body, "Hvalid_owned"); + body = DISCH_TAC(body, "Houter_update"); + + term post = ` + \selected:B. (P:(A#B)->bool) (FST (owned:A#B),selected) + `; + term middle_post = ` + \middle:B. ra_updateP (S:(B)ra) middle + (\selected:B. (P:(A#B)->bool) (FST (owned:A#B),selected)) + `; + thm composed = ispecl_rule( + TERM_LIST( + `S:(B)ra`, + `SND (owned:A#B)`, + middle_post, + post), + RA_UPDATEP_TRANS); + term_list outer_terms = gnode_get_asmps( + body, + CONST_STRING_LIST("Houter_update")); + composed = mp_rule(composed, assume_rule(outer_terms[0])); + composed = conv_rule( + depth_conv(get_conversion_by_name("BETA_CONV")), + composed); + + term middle_update = ` + ra_updateP + (S:(B)ra) + (middle:B) + (\selected:B. (P:(A#B)->bool) (FST (owned:A#B),selected)) + `; + thm step = assume_rule(middle_update); + step = disch_rule(middle_update, step); + step = gen_rule(`middle:B`, step); + composed = mp_rule(composed, step); + ACCEPT_TAC(body, composed); + return gnode_prove(root); +} + +PROOF thm R_BUPD_RIGHT_IDEM = + prove_r_bupd_right_idem(); + +PROOF static thm prove_r_bupd_right_frame(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (S:(B)ra) + (P:(A#B)->bool) + (Frame:(A#B)->bool). + r_entails + (prod_ra R S) + (r_sep (prod_ra R S) (r_bupd_right R S P) Frame) + (r_bupd_right R S (r_sep (prod_ra R S) P Frame)) + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_entails_def, + r_sep_def, + r_bupd_right_def, + ra_updateP_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "S"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Frame"); + body = GEN_TAC(body, "owned_total"); + body = DISCH_TAC(body, "Hvalid_owned_total"); + body = DISCH_TAC(body, "Hsep"); + body = ASMP_EXISTS_TAC(body, "Hsep", "updated"); + body = ASMP_EXISTS_TAC(body, "Hsep", "explicit_frame"); + body = ASMP_CONJ_TAC( + body, + "Hsep", + "Hsplit", + "Hpreds"); + body = ASMP_CONJ_TAC( + body, + "Hpreds", + "Hupdate", + "Hframe_pred"); + body = GEN_TAC(body, "hidden"); + body = DISCH_TAC(body, "Hvalid_with_hidden"); + + thm snd_split = ap_term_rule( + `SND:(A#B)->B`, + assume_rule(` + (owned_total:A#B) == + ra_op + (prod_ra (R:(A)ra) (S:(B)ra)) + (updated:A#B) + (explicit_frame:A#B) + `)); + snd_split = pure_rewrite_rule( + THM_LIST( + PROD_RA_OP, + get_theorem_by_name("SND")), + snd_split); + thm split_with_hidden = beta_rule(ap_term_rule( + `\base:B. ra_op (S:(B)ra) base (hidden:B)`, + snd_split)); + thm source_validity_eq = ap_term_rule( + `ra_valid (S:(B)ra):B->bool`, + split_with_hidden); + thm valid_grouped_left = eq_mp_rule( + source_validity_eq, + assume_rule(` + ra_valid + (S:(B)ra) + (ra_op S (SND (owned_total:A#B)) (hidden:B)) + `)); + thm source_assoc = ispecl_rule( + TERM_LIST( + `S:(B)ra`, + `SND (updated:A#B)`, + `SND (explicit_frame:A#B)`, + `hidden:B`), + RA_ASSOC); + thm source_assoc_validity = ap_term_rule( + `ra_valid (S:(B)ra):B->bool`, + source_assoc); + thm valid_normalized = eq_mp_rule( + source_assoc_validity, + valid_grouped_left); + + thm selected = mp_rule( + spec_rule( + `ra_op + (S:(B)ra) + (SND (explicit_frame:A#B)) + (hidden:B)`, + assume_rule(` + forall frame:B. + ra_valid + (S:(B)ra) + (ra_op S (SND (updated:A#B)) frame) ==> + exists selected:B. + (P:(A#B)->bool) (FST updated,selected) && + ra_valid S (ra_op S selected frame) + `)), + valid_normalized); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "selected"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "HP", + "Hvalid_selected"); + + body = EXISTS_TAC( + body, + `ra_op + (S:(B)ra) + (selected:B) + (SND (explicit_frame:A#B))`); + gnode_list result = CONJ_TAC(body); + gnode post = CONV_TAC( + result[0], + pure_rewrite_conv(THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + post = CONV_TAC( + post, + depth_conv(get_conversion_by_name("BETA_CONV"))); + post = EXISTS_TAC(post, `((FST (updated:A#B)),(selected:B))`); + post = EXISTS_TAC(post, `explicit_frame:A#B`); + gnode_list post1 = CONJ_TAC(post); + + thm fst_split = ap_term_rule( + `FST:(A#B)->A`, + assume_rule(` + (owned_total:A#B) == + ra_op + (prod_ra (R:(A)ra) (S:(B)ra)) + (updated:A#B) + (explicit_frame:A#B) + `)); + fst_split = pure_rewrite_rule( + THM_LIST( + PROD_RA_OP, + get_theorem_by_name("FST")), + fst_split); + thm pair_rule = ispecl_rule( + TERM_LIST( + `FST (owned_total:A#B)`, + `ra_op S (selected:B) (SND (explicit_frame:A#B))`, + `ra_op R (FST (updated:A#B)) (FST (explicit_frame:A#B))`, + `ra_op S (selected:B) (SND (explicit_frame:A#B))`), + get_theorem_by_name("PAIR_EQ")); + thm lhs_to_components = eq_mp_rule( + gsym_rule(pair_rule), + conj_rule( + fst_split, + refl_rule(` + ra_op + (S:(B)ra) + (selected:B) + (SND (explicit_frame:A#B)) + `))); + thm combined_op = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `S:(B)ra`, + `((FST (updated:A#B)),(selected:B))`, + `explicit_frame:A#B`), + PROD_RA_OP); + combined_op = pure_rewrite_rule( + THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")), + combined_op); + ACCEPT_TAC( + post1[0], + trans_rule(lhs_to_components, gsym_rule(combined_op))); + gnode_list post2 = CONJ_TAC(post1[1]); + ACCEPT_TAC( + post2[0], + assume_rule(` + (P:(A#B)->bool) (FST (updated:A#B),selected:B) + `)); + ACCEPT_TAC( + post2[1], + assume_rule(`(Frame:(A#B)->bool) (explicit_frame:A#B)`)); + + thm result_assoc = ispecl_rule( + TERM_LIST( + `S:(B)ra`, + `selected:B`, + `SND (explicit_frame:A#B)`, + `hidden:B`), + RA_ASSOC); + thm result_assoc_validity = ap_term_rule( + `ra_valid (S:(B)ra):B->bool`, + gsym_rule(result_assoc)); + ACCEPT_TAC( + result[1], + eq_mp_rule( + result_assoc_validity, + assume_rule(` + ra_valid + (S:(B)ra) + (ra_op + S + (selected:B) + (ra_op + S + (SND (explicit_frame:A#B)) + (hidden:B))) + `))); + return gnode_prove(root); +} + +PROOF thm R_BUPD_RIGHT_FRAME = + prove_r_bupd_right_frame(); + +PROOF static thm prove_r_viewshift_right_refl(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (S:(B)ra) + (P:(A#B)->bool). + r_viewshift_right R S P P + `); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(r_viewshift_right_def))); + body = AUTO_INTROS_TAC(body); + ACCEPT_TAC( + body, + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `S:(B)ra`, + `P:(A#B)->bool`), + R_BUPD_RIGHT_INTRO)); + return gnode_prove(root); +} + +PROOF thm R_VIEWSHIFT_RIGHT_REFL = + prove_r_viewshift_right_refl(); + +PROOF static thm prove_r_viewshift_right_entails(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (S:(B)ra) + (P:(A#B)->bool) + (Q:(A#B)->bool). + r_entails (prod_ra R S) P Q ==> + r_viewshift_right R S P Q + `); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(r_viewshift_right_def))); + body = AUTO_INTROS_TAC(body); + thm result = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `P:(A#B)->bool`, + `Q:(A#B)->bool`, + `r_bupd_right R S (Q:(A#B)->bool)`), + R_ENTAILS_TRANS), + assume_rule(` + r_entails + (prod_ra (R:(A)ra) (S:(B)ra)) + (P:(A#B)->bool) + (Q:(A#B)->bool) + `)), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `S:(B)ra`, + `Q:(A#B)->bool`), + R_BUPD_RIGHT_INTRO)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_VIEWSHIFT_RIGHT_ENTAILS = + prove_r_viewshift_right_entails(); + +PROOF static thm prove_r_viewshift_right_trans(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (S:(B)ra) + (P:(A#B)->bool) + (Q:(A#B)->bool) + (U:(A#B)->bool). + r_viewshift_right R S P Q ==> + r_viewshift_right R S Q U ==> + r_viewshift_right R S P U + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(r_viewshift_right_def))); + body = AUTO_INTROS_TAC(body); + thm lifted_second = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `S:(B)ra`, + `Q:(A#B)->bool`, + `r_bupd_right R S (U:(A#B)->bool)`), + R_BUPD_RIGHT_MONO), + assume_rule(` + r_entails + (prod_ra (R:(A)ra) (S:(B)ra)) + (Q:(A#B)->bool) + (r_bupd_right R S (U:(A#B)->bool)) + `)); + thm collapsed = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `r_bupd_right R S (Q:(A#B)->bool)`, + `r_bupd_right R S + (r_bupd_right R S (U:(A#B)->bool))`, + `r_bupd_right R S (U:(A#B)->bool)`), + R_ENTAILS_TRANS), + lifted_second), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `S:(B)ra`, `U:(A#B)->bool`), + R_BUPD_RIGHT_IDEM)); + ACCEPT_TAC( + body, + mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `P:(A#B)->bool`, + `r_bupd_right R S (Q:(A#B)->bool)`, + `r_bupd_right R S (U:(A#B)->bool)`), + R_ENTAILS_TRANS), + assume_rule(` + r_entails + (prod_ra (R:(A)ra) (S:(B)ra)) + (P:(A#B)->bool) + (r_bupd_right R S (Q:(A#B)->bool)) + `)), + collapsed)); + return gnode_prove(root); +} + +PROOF thm R_VIEWSHIFT_RIGHT_TRANS = + prove_r_viewshift_right_trans(); + +PROOF static thm prove_r_viewshift_right_frame(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (S:(B)ra) + (P:(A#B)->bool) + (Q:(A#B)->bool) + (Frame:(A#B)->bool). + r_viewshift_right R S P Q ==> + r_viewshift_right + R S + (r_sep (prod_ra R S) P Frame) + (r_sep (prod_ra R S) Q Frame) + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(r_viewshift_right_def))); + body = AUTO_INTROS_TAC(body); + thm explicit_frame = mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `P:(A#B)->bool`, + `r_bupd_right R S (Q:(A#B)->bool)`, + `Frame:(A#B)->bool`), + R_SEP_FRAME_L), + assume_rule(` + r_entails + (prod_ra (R:(A)ra) (S:(B)ra)) + (P:(A#B)->bool) + (r_bupd_right R S (Q:(A#B)->bool)) + `)); + ACCEPT_TAC( + body, + mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `r_sep (prod_ra R S) + (P:(A#B)->bool) + (Frame:(A#B)->bool)`, + `r_sep (prod_ra R S) + (r_bupd_right R S (Q:(A#B)->bool)) + (Frame:(A#B)->bool)`, + `r_bupd_right R S + (r_sep (prod_ra R S) + (Q:(A#B)->bool) + (Frame:(A#B)->bool))`), + R_ENTAILS_TRANS), + explicit_frame), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `S:(B)ra`, + `Q:(A#B)->bool`, + `Frame:(A#B)->bool`), + R_BUPD_RIGHT_FRAME))); + return gnode_prove(root); +} + +PROOF thm R_VIEWSHIFT_RIGHT_FRAME = + prove_r_viewshift_right_frame(); + +PROOF static thm prove_r_viewshift_right_mono(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (S:(B)ra) + (P2:(A#B)->bool) + (P:(A#B)->bool) + (Q:(A#B)->bool) + (Q2:(A#B)->bool). + r_entails (prod_ra R S) P2 P ==> + r_viewshift_right R S P Q ==> + r_entails (prod_ra R S) Q Q2 ==> + r_viewshift_right R S P2 Q2 + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(r_viewshift_right_def))); + body = AUTO_INTROS_TAC(body); + thm lifted_post = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, `S:(B)ra`, + `Q:(A#B)->bool`, `Q2:(A#B)->bool`), + R_BUPD_RIGHT_MONO), + assume_rule(` + r_entails + (prod_ra (R:(A)ra) (S:(B)ra)) + (Q:(A#B)->bool) + (Q2:(A#B)->bool) + `)); + thm changed_post = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `P:(A#B)->bool`, + `r_bupd_right R S (Q:(A#B)->bool)`, + `r_bupd_right R S (Q2:(A#B)->bool)`), + R_ENTAILS_TRANS), + assume_rule(` + r_entails + (prod_ra (R:(A)ra) (S:(B)ra)) + (P:(A#B)->bool) + (r_bupd_right R S (Q:(A#B)->bool)) + `)), + lifted_post); + ACCEPT_TAC( + body, + mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `P2:(A#B)->bool`, + `P:(A#B)->bool`, + `r_bupd_right R S (Q2:(A#B)->bool)`), + R_ENTAILS_TRANS), + assume_rule(` + r_entails + (prod_ra (R:(A)ra) (S:(B)ra)) + (P2:(A#B)->bool) + (P:(A#B)->bool) + `)), + changed_post)); + return gnode_prove(root); +} + +PROOF thm R_VIEWSHIFT_RIGHT_MONO = + prove_r_viewshift_right_mono(); + +PROOF static thm prove_r_viewshift_right_sep(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (S:(B)ra) + (P1:(A#B)->bool) + (Q1:(A#B)->bool) + (P2:(A#B)->bool) + (Q2:(A#B)->bool). + r_viewshift_right R S P1 Q1 ==> + r_viewshift_right R S P2 Q2 ==> + r_viewshift_right + R S + (r_sep (prod_ra R S) P1 P2) + (r_sep (prod_ra R S) Q1 Q2) + `); + gnode body = AUTO_INTROS_TAC(root); + thm first_framed = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, `S:(B)ra`, + `P1:(A#B)->bool`, `Q1:(A#B)->bool`, + `P2:(A#B)->bool`), + R_VIEWSHIFT_RIGHT_FRAME), + assume_rule(` + r_viewshift_right + (R:(A)ra) (S:(B)ra) + (P1:(A#B)->bool) (Q1:(A#B)->bool) + `)); + thm second_framed = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, `S:(B)ra`, + `P2:(A#B)->bool`, `Q2:(A#B)->bool`, + `Q1:(A#B)->bool`), + R_VIEWSHIFT_RIGHT_FRAME), + assume_rule(` + r_viewshift_right + (R:(A)ra) (S:(B)ra) + (P2:(A#B)->bool) (Q2:(A#B)->bool) + `)); + thm source_commute = conjunct1_rule(rewrite_rule( + THM_LIST(r_equiv_def), + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `Q1:(A#B)->bool`, + `P2:(A#B)->bool`), + R_SEP_COMM))); + thm target_commute = conjunct1_rule(rewrite_rule( + THM_LIST(r_equiv_def), + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `Q2:(A#B)->bool`, + `Q1:(A#B)->bool`), + R_SEP_COMM))); + thm second_aligned = mp_rule( + mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, `S:(B)ra`, + `r_sep (prod_ra R S) + (Q1:(A#B)->bool) (P2:(A#B)->bool)`, + `r_sep (prod_ra R S) + (P2:(A#B)->bool) (Q1:(A#B)->bool)`, + `r_sep (prod_ra R S) + (Q2:(A#B)->bool) (Q1:(A#B)->bool)`, + `r_sep (prod_ra R S) + (Q1:(A#B)->bool) (Q2:(A#B)->bool)`), + /* Consequence follows by unfolding the right view shift. */ + R_VIEWSHIFT_RIGHT_MONO), + source_commute), + second_framed), + target_commute); + ACCEPT_TAC( + body, + mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, `S:(B)ra`, + `r_sep (prod_ra R S) + (P1:(A#B)->bool) (P2:(A#B)->bool)`, + `r_sep (prod_ra R S) + (Q1:(A#B)->bool) (P2:(A#B)->bool)`, + `r_sep (prod_ra R S) + (Q1:(A#B)->bool) (Q2:(A#B)->bool)`), + R_VIEWSHIFT_RIGHT_TRANS), + first_framed), + second_aligned)); + return gnode_prove(root); +} + +PROOF thm R_VIEWSHIFT_RIGHT_SEP = + prove_r_viewshift_right_sep(); + +PROOF static thm prove_r_viewshift_right_fact(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (S:(B)ra) + (guard:bool) + (P:(A#B)->bool) + (Q:(A#B)->bool). + (guard ==> r_viewshift_right R S P Q) ==> + r_viewshift_right + R S + (r_sep + (prod_ra R S) + (r_fact (prod_ra R S) guard) + P) + (r_sep + (prod_ra R S) + (r_fact (prod_ra R S) guard) + Q) + `); + gnode body = CONV_TAC( + root, + once_rewrite_conv(THM_LIST(r_viewshift_right_def))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "S"); + body = GEN_TAC(body, "guard"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = DISCH_TAC(body, "Hconditional"); + body = MATCH_MP_TAC( + body, + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `guard:bool`, + `P:(A#B)->bool`, + `r_bupd_right + R S + (r_sep + (prod_ra R S) + (r_fact (prod_ra R S) (guard:bool)) + (Q:(A#B)->bool))`), + R_FACT_ELIM)); + body = DISCH_TAC(body, "Hguard"); + + term_list conditional_terms = gnode_get_asmps( + body, + CONST_STRING_LIST("Hconditional")); + thm change = mp_rule( + assume_rule(conditional_terms[0]), + assume_rule(`guard:bool`)); + change = pure_rewrite_rule( + THM_LIST(r_viewshift_right_def), + change); + + thm post_inclusion = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `guard:bool`, + `Q:(A#B)->bool`, + `Q:(A#B)->bool`), + R_FACT_INTRO), + assume_rule(`guard:bool`)), + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `Q:(A#B)->bool`), + R_ENTAILS_REFL)); + thm lifted_post = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `S:(B)ra`, + `Q:(A#B)->bool`, + `r_sep + (prod_ra R S) + (r_fact (prod_ra R S) (guard:bool)) + (Q:(A#B)->bool)`), + R_BUPD_RIGHT_MONO), + post_inclusion); + ACCEPT_TAC( + body, + mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `P:(A#B)->bool`, + `r_bupd_right R S (Q:(A#B)->bool)`, + `r_bupd_right + R S + (r_sep + (prod_ra R S) + (r_fact + (prod_ra R S) + (guard:bool)) + (Q:(A#B)->bool))`), + R_ENTAILS_TRANS), + change), + lifted_post)); + return gnode_prove(root); +} + +PROOF thm R_VIEWSHIFT_RIGHT_FACT = + prove_r_viewshift_right_fact(); + +PROOF static thm prove_r_viewshift_right_exists_l(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (S:(B)ra) + (P:C->(A#B)->bool) + (Q:(A#B)->bool). + (forall witness:C. + r_viewshift_right R S (P witness) Q) ==> + r_viewshift_right + R S + (r_exists (prod_ra R S) (\bound:C. P bound)) + Q + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(r_viewshift_right_def))); + body = AUTO_INTROS_TAC(body); + thm result = mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `P:C->(A#B)->bool`, + `r_bupd_right R S (Q:(A#B)->bool)`), + R_EXISTS_ELIM), + assume_rule(` + forall witness:C. + r_entails + (prod_ra (R:(A)ra) (S:(B)ra)) + ((P:C->(A#B)->bool) witness) + (r_bupd_right R S (Q:(A#B)->bool)) + `)); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF static thm R_VIEWSHIFT_RIGHT_EXISTS_L = + prove_r_viewshift_right_exists_l(); + +PROOF static thm prove_r_viewshift_right_exists_r(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (S:(B)ra) + (P:(A#B)->bool) + (Q:C->(A#B)->bool) + (witness:C). + r_viewshift_right R S P (Q witness) ==> + r_viewshift_right + R S P + (r_exists (prod_ra R S) (\bound:C. Q bound)) + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(r_viewshift_right_def))); + body = AUTO_INTROS_TAC(body); + thm post_inclusion = ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `Q:C->(A#B)->bool`, + `witness:C`), + R_EXISTS_INTRO); + thm lifted_post = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `S:(B)ra`, + `(Q:C->(A#B)->bool) (witness:C)`, + `r_exists + (prod_ra R S) + (\bound:C. (Q:C->(A#B)->bool) bound)`), + R_BUPD_RIGHT_MONO), + post_inclusion); + thm result = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `P:(A#B)->bool`, + `r_bupd_right + R S + ((Q:C->(A#B)->bool) (witness:C))`, + `r_bupd_right + R S + (r_exists + (prod_ra R S) + (\bound:C. (Q:C->(A#B)->bool) bound))`), + R_ENTAILS_TRANS), + assume_rule(` + r_entails + (prod_ra (R:(A)ra) (S:(B)ra)) + (P:(A#B)->bool) + (r_bupd_right + R S + ((Q:C->(A#B)->bool) (witness:C))) + `)), + lifted_post); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF static thm R_VIEWSHIFT_RIGHT_EXISTS_R = + prove_r_viewshift_right_exists_r(); + +PROOF static thm prove_r_viewshift_right_exists(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (S:(B)ra) + (P:C->(A#B)->bool) + (Q:C->(A#B)->bool). + (forall witness:C. + r_viewshift_right R S (P witness) (Q witness)) ==> + r_viewshift_right + R S + (r_exists (prod_ra R S) (\bound:C. P bound)) + (r_exists (prod_ra R S) (\bound:C. Q bound)) + `); + gnode body = GEN_TAC(root, "R"); + body = GEN_TAC(body, "S"); + body = GEN_TAC(body, "P"); + body = GEN_TAC(body, "Q"); + body = DISCH_TAC(body, "Hall"); + body = MATCH_MP_TAC( + body, + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `S:(B)ra`, + `P:C->(A#B)->bool`, + `r_exists + (prod_ra R S) + (\bound:C. (Q:C->(A#B)->bool) bound)`), + R_VIEWSHIFT_RIGHT_EXISTS_L)); + body = GEN_TAC(body, "witness"); + thm selected = spec_rule( + `witness:C`, + assume_rule(` + forall witness:C. + r_viewshift_right + (R:(A)ra) (S:(B)ra) + ((P:C->(A#B)->bool) witness) + ((Q:C->(A#B)->bool) witness) + `)); + thm result = mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `S:(B)ra`, + `(P:C->(A#B)->bool) (witness:C)`, + `Q:C->(A#B)->bool`, + `witness:C`), + R_VIEWSHIFT_RIGHT_EXISTS_R), + selected); + ACCEPT_TAC(body, result); + return gnode_prove(root); +} + +PROOF thm R_VIEWSHIFT_RIGHT_EXISTS = + prove_r_viewshift_right_exists(); + +PROOF static thm prove_r_right_own_update(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (S:(B)ra) + (a:B) + (b:B). + ra_update S a b ==> + r_viewshift_right + R S + (r_lift_right R S (r_own S a)) + (r_lift_right R S (r_own S b)) + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_viewshift_right_def, + r_entails_def, + r_bupd_right_def, + ra_updateP_def, + ra_update_def, + r_lift_right_def, + r_own_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "S"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "b"); + body = DISCH_TAC(body, "Hupdate"); + body = GEN_TAC(body, "owned"); + body = DISCH_TAC(body, "Hvalid_owned"); + body = DISCH_TAC(body, "Hsource"); + body = ASMP_CONJ_TAC( + body, + "Hsource", + "Hleft_unit", + "Hright_owned"); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hvalid_source"); + thm replace_right = beta_rule(ap_term_rule( + `\right:B. ra_op (S:(B)ra) right (frame:B)`, + assume_rule(`SND (owned:A#B) == (a:B)`))); + thm valid_a_frame = eq_mp_rule( + ap_term_rule(`ra_valid (S:(B)ra):B->bool`, replace_right), + assume_rule(` + ra_valid + (S:(B)ra) + (ra_op S (SND (owned:A#B)) (frame:B)) + `)); + thm selected = mp_rule( + spec_rule( + `frame:B`, + assume_rule(` + forall hidden:B. + ra_valid (S:(B)ra) (ra_op S (a:B) hidden) ==> + exists selected:B. + selected == (b:B) && + ra_valid S (ra_op S selected hidden) + `)), + valid_a_frame); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "selected"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "Hselected_b", + "Hvalid_selected"); + body = EXISTS_TAC(body, `selected:B`); + gnode_list result = CONJ_TAC(body); + gnode post = CONV_TAC( + result[0], + pure_rewrite_conv(THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + post = CONV_TAC( + post, + depth_conv(get_conversion_by_name("BETA_CONV"))); + gnode_list post_parts = CONJ_TAC(post); + term_list left_unit_terms = gnode_get_asmps( + post_parts[0], + CONST_STRING_LIST("Hleft_unit")); + ACCEPT_TAC( + post_parts[0], + assume_rule(left_unit_terms[0])); + + term_list selected_b_terms = gnode_get_asmps( + post_parts[1], + CONST_STRING_LIST("Hselected_b")); + ACCEPT_TAC( + post_parts[1], + assume_rule(selected_b_terms[0])); + ACCEPT_TAC( + result[1], + assume_rule(` + ra_valid + (S:(B)ra) + (ra_op S (selected:B) (frame:B)) + `)); + return gnode_prove(root); +} + +PROOF thm R_RIGHT_OWN_UPDATE = + prove_r_right_own_update(); + +PROOF static thm prove_r_right_own_updatep(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (S:(B)ra) + (a:B) + (P:B->bool). + ra_updateP S a P ==> + r_viewshift_right + R S + (r_lift_right R S (r_own S a)) + (r_exists + (prod_ra R S) + (\b:B. + r_sep + (prod_ra R S) + (r_fact (prod_ra R S) (P b)) + (r_lift_right R S (r_own S b)))) + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST( + r_viewshift_right_def, + r_entails_def, + r_bupd_right_def, + ra_updateP_def, + r_lift_right_def, + r_own_def, + r_exists_def, + r_sep_def, + r_fact_def))); + body = CONV_TAC( + body, + depth_conv(get_conversion_by_name("BETA_CONV"))); + body = GEN_TAC(body, "R"); + body = GEN_TAC(body, "S"); + body = GEN_TAC(body, "a"); + body = GEN_TAC(body, "P"); + body = DISCH_TAC(body, "Hupdate"); + body = GEN_TAC(body, "owned"); + body = DISCH_TAC(body, "Hvalid_owned"); + body = DISCH_TAC(body, "Hsource"); + body = ASMP_CONJ_TAC( + body, + "Hsource", + "Hleft_unit", + "Hright_owned"); + body = GEN_TAC(body, "frame"); + body = DISCH_TAC(body, "Hvalid_source"); + thm replace_right = beta_rule(ap_term_rule( + `\right:B. ra_op (S:(B)ra) right (frame:B)`, + assume_rule(`SND (owned:A#B) == (a:B)`))); + thm valid_a_frame = eq_mp_rule( + ap_term_rule(`ra_valid (S:(B)ra):B->bool`, replace_right), + assume_rule(` + ra_valid + (S:(B)ra) + (ra_op S (SND (owned:A#B)) (frame:B)) + `)); + thm selected = mp_rule( + spec_rule( + `frame:B`, + assume_rule(` + forall hidden:B. + ra_valid (S:(B)ra) (ra_op S (a:B) hidden) ==> + exists selected:B. + (P:B->bool) selected && + ra_valid S (ra_op S selected hidden) + `)), + valid_a_frame); + body = ASSUME_TAC(body, selected, "Hselected"); + body = ASMP_EXISTS_TAC(body, "Hselected", "selected"); + body = ASMP_CONJ_TAC( + body, + "Hselected", + "HP", + "Hvalid_selected"); + + body = EXISTS_TAC(body, `selected:B`); + gnode_list result = CONJ_TAC(body); + gnode post = CONV_TAC( + result[0], + pure_rewrite_conv(THM_LIST( + r_sep_def, + r_fact_def, + r_lift_right_def, + r_own_def))); + post = CONV_TAC( + post, + depth_conv(get_conversion_by_name("BETA_CONV"))); + post = EXISTS_TAC(post, `selected:B`); + post = EXISTS_TAC(post, `ra_unit (prod_ra (R:(A)ra) (S:(B)ra))`); + post = EXISTS_TAC(post, `((ra_unit (R:(A)ra)),(selected:B))`); + post = CONV_TAC( + post, + pure_rewrite_conv(THM_LIST( + get_theorem_by_name("FST"), + get_theorem_by_name("SND")))); + gnode_list post1 = CONJ_TAC(post); + thm target_pair = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `FST (owned:A#B)`, + `selected:B`, + `ra_unit (R:(A)ra)`, + `selected:B`), + get_theorem_by_name("PAIR_EQ"))), + conj_rule( + assume_rule(`FST (owned:A#B) == ra_unit (R:(A)ra)`), + refl_rule(`selected:B`))); + ACCEPT_TAC( + post1[0], + trans_rule( + target_pair, + gsym_rule(ispecl_rule( + TERM_LIST( + `prod_ra (R:(A)ra) (S:(B)ra)`, + `((ra_unit (R:(A)ra)),(selected:B))`), + RA_UNIT_L)))); + gnode_list post2 = CONJ_TAC(post1[1]); + gnode_list fact_parts = CONJ_TAC(post2[0]); + ACCEPT_TAC( + fact_parts[0], + assume_rule(`(P:B->bool) (selected:B)`)); + ACCEPT_TAC( + fact_parts[1], + refl_rule(`ra_unit (prod_ra (R:(A)ra) (S:(B)ra))`)); + gnode_list lifted_own = CONJ_TAC(post2[1]); + ACCEPT_TAC( + lifted_own[0], + refl_rule(`ra_unit (R:(A)ra)`)); + ACCEPT_TAC(lifted_own[1], refl_rule(`selected:B`)); + ACCEPT_TAC( + result[1], + assume_rule(` + ra_valid + (S:(B)ra) + (ra_op S (selected:B) (frame:B)) + `)); + return gnode_prove(root); +} + +PROOF thm R_RIGHT_OWN_UPDATEP = + prove_r_right_own_updatep(); + +PROOF static int audit_product_resource(void) { + thm_list exported_theorems = THM_LIST( + r_lift_left_def, + r_lift_right_def, + R_LIFT_LEFT_EMP, + R_LIFT_RIGHT_EMP, + R_LIFT_LEFT_SEP, + R_LIFT_RIGHT_SEP, + R_LIFT_LEFT_ENTAILS, + R_LIFT_RIGHT_ENTAILS, + r_bupd_right_def, + r_viewshift_right_def, + R_BUPD_RIGHT_INTRO, + R_BUPD_RIGHT_MONO, + R_BUPD_RIGHT_IDEM, + R_BUPD_RIGHT_FRAME, + R_VIEWSHIFT_RIGHT_REFL, + R_VIEWSHIFT_RIGHT_ENTAILS, + R_VIEWSHIFT_RIGHT_TRANS, + R_VIEWSHIFT_RIGHT_MONO, + R_VIEWSHIFT_RIGHT_FRAME, + R_VIEWSHIFT_RIGHT_SEP, + R_VIEWSHIFT_RIGHT_FACT, + R_VIEWSHIFT_RIGHT_EXISTS, + R_RIGHT_OWN_UPDATE, + R_RIGHT_OWN_UPDATEP, + R_LIFT_LEFT_EMP_EQ, + R_LIFT_RIGHT_EMP_EQ, + R_LIFT_LEFT_SEP_EQ, + R_LIFT_RIGHT_SEP_EQ); + for (size_t i = 0; i < vector_size(exported_theorems); ++i) { + ENSURE_COND( + !IS_NULL(exported_theorems[i]), + "product resource theorem %zu is null", + i); + ENSURE_COND( + vector_size(hyp(exported_theorems[i])) == 0, + "product resource theorem %zu has hypotheses", + i); + } + ENSURE_COND( + vector_size(get_all_axioms()) == PRODUCT_RESOURCE_AXIOMS_BEFORE, + "product resource theory introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_product_resource"); + return -1; +} + +PROOF static int _PRODUCT_RESOURCE_AUDIT = + audit_product_resource(); diff --git a/theory/logic/product_resource.h b/theory/logic/product_resource.h new file mode 100644 index 0000000..cf56c6f --- /dev/null +++ b/theory/logic/product_resource.h @@ -0,0 +1,37 @@ +#pragma once + +/* Exact assertion lifts and right-only updates for product resources. */ + +#include "proof/theory/logic/prod_ra.h" +#include "proof/theory/logic/resource_prop.h" + +PROOF extern thm r_lift_left_def; +PROOF extern thm r_lift_right_def; + +PROOF extern thm R_LIFT_LEFT_EMP; +PROOF extern thm R_LIFT_RIGHT_EMP; +PROOF extern thm R_LIFT_LEFT_SEP; +PROOF extern thm R_LIFT_RIGHT_SEP; +PROOF extern thm R_LIFT_LEFT_ENTAILS; +PROOF extern thm R_LIFT_RIGHT_ENTAILS; + +/* Only the right component may change. */ +PROOF extern thm r_bupd_right_def; +PROOF extern thm r_viewshift_right_def; + +PROOF extern thm R_BUPD_RIGHT_INTRO; +PROOF extern thm R_BUPD_RIGHT_MONO; +PROOF extern thm R_BUPD_RIGHT_IDEM; +PROOF extern thm R_BUPD_RIGHT_FRAME; + +PROOF extern thm R_VIEWSHIFT_RIGHT_REFL; +PROOF extern thm R_VIEWSHIFT_RIGHT_ENTAILS; +PROOF extern thm R_VIEWSHIFT_RIGHT_TRANS; +PROOF extern thm R_VIEWSHIFT_RIGHT_MONO; +PROOF extern thm R_VIEWSHIFT_RIGHT_FRAME; +PROOF extern thm R_VIEWSHIFT_RIGHT_SEP; +PROOF extern thm R_VIEWSHIFT_RIGHT_FACT; +PROOF extern thm R_VIEWSHIFT_RIGHT_EXISTS; + +PROOF extern thm R_RIGHT_OWN_UPDATE; +PROOF extern thm R_RIGHT_OWN_UPDATEP; diff --git a/theory/logic/product_resource_internal.h b/theory/logic/product_resource_internal.h new file mode 100644 index 0000000..2235b47 --- /dev/null +++ b/theory/logic/product_resource_internal.h @@ -0,0 +1,14 @@ +#pragma once + +/* + * Raw assertion-function equalities used by implementation adapters. + * The public product-resource interface exposes the corresponding laws only + * through validity-sensitive `r_equiv` theorems. + */ + +#include "proof/theory/logic/product_resource.h" + +PROOF extern thm R_LIFT_LEFT_EMP_EQ; +PROOF extern thm R_LIFT_RIGHT_EMP_EQ; +PROOF extern thm R_LIFT_LEFT_SEP_EQ; +PROOF extern thm R_LIFT_RIGHT_SEP_EQ; diff --git a/theory/logic/ra.c b/theory/logic/ra.c index 92402a6..b8fddeb 100644 --- a/theory/logic/ra.c +++ b/theory/logic/ra.c @@ -228,33 +228,36 @@ PROOF thm RA_TYPE_BIJECTION = new_type_bijection_definition( "ra", "ra_abs", "ra_rep", RA_REP_EXISTS); /* Public projections from the abstract descriptor. */ -PROOF thm ra_unit_def = new_fun_definition(` +PROOF static thm ra_unit_def = new_fun_definition(` ra_unit (R:(A)ra) : A = FST (ra_rep R) `); -PROOF thm ra_op_def = new_fun_definition(` +PROOF static thm ra_op_def = new_fun_definition(` ra_op (R:(A)ra) : A->A->A = FST (SND (ra_rep R)) `); -PROOF thm ra_valid_def = new_fun_definition(` +PROOF static thm ra_valid_def = new_fun_definition(` ra_valid (R:(A)ra) : A->bool = SND (SND (ra_rep R)) `); /* * Generic extension and frame-preserving update relations. * - * The nondeterministic update returns any element selected by `result`. - * The deterministic relation is stated directly rather than through a - * singleton predicate so that its common proof rules reduce to first-order - * implications without existential elimination. + * Predicate update returns any element selected by `result`; deterministic + * update is only its singleton specialization. */ +PROOF thm ra_compatible_def = new_fun_definition(` + ra_compatible (R:(A)ra) (a:A) (b:A) <=> + ra_valid R (ra_op R a b) +`); + PROOF thm ra_included_def = new_fun_definition(` ra_included (R:(A)ra) (a:A) (b:A) <=> exists frame:A. b == ra_op R a frame `); -PROOF thm ra_update_nd_def = new_fun_definition(` - ra_update_nd (R:(A)ra) (a:A) (result:A->bool) <=> +PROOF thm ra_updateP_def = new_fun_definition(` + ra_updateP (R:(A)ra) (a:A) (result:A->bool) <=> forall frame:A. ra_valid R (ra_op R a frame) ==> exists b:A. @@ -263,9 +266,7 @@ PROOF thm ra_update_nd_def = new_fun_definition(` PROOF thm ra_update_def = new_fun_definition(` ra_update (R:(A)ra) (a:A) (b:A) <=> - forall frame:A. - ra_valid R (ra_op R a frame) ==> - ra_valid R (ra_op R b frame) + ra_updateP R a (\x:A. x == b) `); /* @@ -282,15 +283,16 @@ PROOF thm ra_cancellative_def = new_fun_definition(` `); /* - * An element is exclusive when every frame compatible with it is the unit. - * This frame formulation is strong enough to justify replacement by any - * valid target, including in non-cancellative resource algebras. + * An exclusive element is valid and every compatible frame is the unit. The + * frame formulation justifies replacement by any valid target, including in + * non-cancellative resource algebras. */ PROOF thm ra_exclusive_def = new_fun_definition(` ra_exclusive (R:(A)ra) (a:A) <=> - forall frame:A. - ra_valid R (ra_op R a frame) ==> - frame == ra_unit R + ra_valid R a && + (forall frame:A. + ra_valid R (ra_op R a frame) ==> + frame == ra_unit R) `); /* @@ -499,6 +501,40 @@ PROOF static thm prove_ra_valid_op(void) { PROOF thm RA_VALID_OP = prove_ra_valid_op(); +PROOF static thm prove_ra_compat_comm(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A) (b:A). + ra_compatible R a b <=> ra_compatible R b a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + ra_compatible_def, + RA_COMM))); + return gnode_prove(root); +} + +PROOF thm RA_COMPAT_COMM = prove_ra_compat_comm(); + +PROOF static thm prove_ra_compat_unit(void) { + term goal_tm = ` + forall (R:(A)ra) (a:A). + ra_compatible R a (ra_unit R) <=> ra_valid R a + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + ra_compatible_def, + RA_UNIT_R))); + return gnode_prove(root); +} + +PROOF thm RA_COMPAT_UNIT = prove_ra_compat_unit(); + /* * Apply the optional cancellativity property without exposing its quantified * definition to client proofs. The proof specializes each operand and @@ -553,6 +589,7 @@ PROOF static thm prove_ra_exclusive_apply(void) { thm exclusive = rewrite_rule( THM_LIST(ra_exclusive_def), assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); + exclusive = conjunct2_rule(exclusive); thm result = mp_rule( spec_rule(`frame:A`, exclusive), assume_rule(` @@ -577,34 +614,51 @@ PROOF static thm prove_ra_update_apply(void) { gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); thm update = rewrite_rule( - THM_LIST(ra_update_def), + THM_LIST(ra_update_def, ra_updateP_def), assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); - thm result = mp_rule( + update = conv_rule( + depth_conv(get_conversion_by_name("BETA_CONV")), + update); + thm candidates = mp_rule( spec_rule(`frame:A`, update), assume_rule(` ra_valid (R:(A)ra) (ra_op R (a:A) (frame:A)) `)); - ACCEPT_TAC(body, result); + body = ASSUME_TAC(body, candidates, "Hcandidate"); + body = ASMP_EXISTS_TAC(body, "Hcandidate", "candidate"); + body = ASMP_CONJ_TAC( + body, + "Hcandidate", + "Hcandidate_eq", + "Hcandidate_valid"); + thm selected_valid = rewrite_rule( + THM_LIST(assume_rule(`candidate:A == (b:A)`)), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (candidate:A) (frame:A)) + `)); + ACCEPT_TAC(body, selected_valid); return gnode_prove(root); } PROOF thm RA_UPDATE_APPLY = prove_ra_update_apply(); -PROOF static thm prove_ra_update_nd_apply(void) { +PROOF static thm prove_ra_updateP_apply(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (P:A->bool) (frame:A). - ra_update_nd R a P ==> + ra_updateP R a P ==> ra_valid R (ra_op R a frame) ==> exists b:A. P b && ra_valid R (ra_op R b frame) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); thm update = rewrite_rule( - THM_LIST(ra_update_nd_def), - assume_rule(`ra_update_nd (R:(A)ra) (a:A) (P:A->bool)`)); + THM_LIST(ra_updateP_def), + assume_rule(`ra_updateP (R:(A)ra) (a:A) (P:A->bool)`)); thm result = mp_rule( spec_rule(`frame:A`, update), assume_rule(` @@ -616,8 +670,8 @@ PROOF static thm prove_ra_update_nd_apply(void) { return gnode_prove(root); } -PROOF thm RA_UPDATE_ND_APPLY = - prove_ra_update_nd_apply(); +PROOF thm RA_UPDATEP_APPLY = + prove_ra_updateP_apply(); /* * Inclusion is reflexive: choose the unit as the missing frame. @@ -1098,6 +1152,7 @@ PROOF static thm prove_ra_exclusive_included(void) { thm exclusive = rewrite_rule( THM_LIST(ra_exclusive_def), assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); + exclusive = conjunct2_rule(exclusive); thm frame_is_unit = mp_rule( spec_rule(`frame:A`, exclusive), framed_valid); @@ -1118,134 +1173,6 @@ PROOF static thm prove_ra_exclusive_included(void) { PROOF thm RA_EXCLUSIVE_INCLUDED = prove_ra_exclusive_included(); -/* - * The converse maximality argument needs cancellation: maximality shows - * a = a · frame, and cancellation of the common a then identifies frame - * with the unit. - */ -PROOF static thm prove_ra_exclusive_iff_included(void) { - term goal_tm = ` - forall (R:(A)ra) (a:A). - ra_cancellative R ==> - (ra_exclusive R a <=> - forall b:A. - ra_valid R b ==> - ra_included R a b ==> - a == b) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = GEN_TAC(root, "R"); - body = GEN_TAC(body, "a"); - body = DISCH_TAC(body, "Hcancellative"); - gnode_list directions = EQ_TAC(body); - - gnode forward = DISCH_TAC(directions[0], "Hexclusive"); - forward = GEN_TAC(forward, "b"); - forward = DISCH_TAC(forward, "Hvalid_b"); - forward = DISCH_TAC(forward, "Hincluded"); - thm maximal = ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`, `b:A`), - RA_EXCLUSIVE_INCLUDED); - maximal = mp_rule( - maximal, - assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); - maximal = mp_rule( - maximal, - assume_rule(`ra_valid (R:(A)ra) (b:A)`)); - maximal = mp_rule( - maximal, - assume_rule(`ra_included (R:(A)ra) (a:A) (b:A)`)); - ACCEPT_TAC(forward, maximal); - - gnode reverse = DISCH_TAC(directions[1], "Hmaximal"); - reverse = CONV_TAC( - reverse, - once_rewrite_conv(THM_LIST(ra_exclusive_def))); - reverse = GEN_TAC(reverse, "frame"); - reverse = DISCH_TAC(reverse, "Hframed_valid"); - - thm extension_maximal = spec_rule( - `ra_op (R:(A)ra) (a:A) (frame:A)`, - assume_rule(` - forall b:A. - ra_valid (R:(A)ra) b ==> - ra_included R (a:A) b ==> - a == b - `)); - extension_maximal = mp_rule( - extension_maximal, - assume_rule(` - ra_valid - (R:(A)ra) - (ra_op R (a:A) (frame:A)) - `)); - extension_maximal = mp_rule( - extension_maximal, - ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`, `frame:A`), - RA_INCLUDED_OP_L)); - - thm cancel_eq = trans_rule( - gsym_rule(extension_maximal), - gsym_rule(ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`), - RA_UNIT_R))); - thm frame_is_unit = ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `a:A`, - `frame:A`, - `ra_unit (R:(A)ra)`), - RA_CANCELLATIVE_APPLY); - frame_is_unit = mp_rule( - frame_is_unit, - assume_rule(`ra_cancellative (R:(A)ra)`)); - frame_is_unit = mp_rule( - frame_is_unit, - assume_rule(` - ra_valid - (R:(A)ra) - (ra_op R (a:A) (frame:A)) - `)); - frame_is_unit = mp_rule(frame_is_unit, cancel_eq); - ACCEPT_TAC(reverse, frame_is_unit); - return gnode_prove(root); -} - -PROOF thm RA_EXCLUSIVE_IFF_INCLUDED = - prove_ra_exclusive_iff_included(); - -/* Invalidity rules out every compatible frame by downward validity, hence - * exclusivity holds vacuously. */ -PROOF static thm prove_ra_invalid_exclusive(void) { - term goal_tm = ` - forall (R:(A)ra) (a:A). - ~(ra_valid R a) ==> ra_exclusive R a - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = CONV_TAC( - root, - once_rewrite_conv(THM_LIST(ra_exclusive_def))); - body = AUTO_INTROS_TAC(body); - thm valid_source = mp_rule( - ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`, `frame:A`), - RA_VALID_OP_L), - assume_rule(` - ra_valid - (R:(A)ra) - (ra_op R (a:A) (frame:A)) - `)); - thm contradiction = not_elim_rule( - assume_rule(`~(ra_valid (R:(A)ra) (a:A))`), - valid_source); - CONTR_TAC(body, contradiction); - return gnode_prove(root); -} - -PROOF thm RA_INVALID_EXCLUSIVE = - prove_ra_invalid_exclusive(); - /* For an exclusive source, compatibility is exactly ordinary source * validity together with the unit frame. */ PROOF static thm prove_ra_exclusive_valid_op_iff(void) { @@ -1307,29 +1234,41 @@ PROOF static thm prove_ra_exclusive_valid_op_iff(void) { PROOF thm RA_EXCLUSIVE_VALID_OP_IFF = prove_ra_exclusive_valid_op_iff(); -/* - * A predicate-valued update to a singleton is equivalent to the deterministic - * update relation. Both directions are kept explicit so this bridge remains - * independent of simplifier search. - */ -PROOF static thm prove_ra_update_nd_singleton(void) { +/* Deterministic update is definitionally the singleton specialization. */ +PROOF static thm prove_ra_updateP_singleton(void) { + term R = `R:(A)ra`; + term a = `a:A`; + term b = `b:A`; + thm result = sym_rule(ra_update_def); + result = gen_rule(b, result); + result = gen_rule(a, result); + return gen_rule(R, result); +} + +PROOF thm RA_UPDATEP_SINGLETON = prove_ra_updateP_singleton(); + +/* Internal first-order view of the singleton update. */ +PROOF static thm prove_ra_update_direct(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (b:A). - ra_update_nd R a (\x:A. x == b) <=> ra_update R a b + ra_update R a b <=> + forall frame:A. + ra_valid R (ra_op R a frame) ==> + ra_valid R (ra_op R b frame) `; gnode root = gnode_new_with_ccl(goal_tm); gnode unfolded = CONV_TAC( root, pure_rewrite_conv(THM_LIST( - ra_update_nd_def, - ra_update_def))); - gnode beta_normal = CONV_TAC( + ra_update_def, + ra_updateP_def))); + gnode body = CONV_TAC( unfolded, depth_conv(get_conversion_by_name("BETA_CONV"))); - gnode equivalence = AUTO_INTROS_TAC(beta_normal); - gnode_list directions = EQ_TAC(equivalence); + body = AUTO_INTROS_TAC(body); + gnode_list directions = EQ_TAC(body); - gnode left = AUTO_INTROS_TAC(directions[0]); + gnode forward = AUTO_INTROS_TAC(directions[0]); thm candidates = mp_rule( spec_rule( `frame:A`, @@ -1343,51 +1282,58 @@ PROOF static thm prove_ra_update_nd_singleton(void) { assume_rule(` ra_valid (R:(A)ra) (ra_op R (a:A) (frame:A)) `)); - left = ASSUME_TAC(left, candidates, "Hcandidate"); - left = ASMP_EXISTS_TAC(left, "Hcandidate", "candidate"); - left = ASMP_CONJ_TAC( - left, "Hcandidate", "Hcandidate_eq", "Hcandidate_valid"); - thm selected_valid = rewrite_rule( - THM_LIST(assume_rule(`candidate:A == (b:A)`)), - assume_rule(` - ra_valid (R:(A)ra) (ra_op R (candidate:A) (frame:A)) - `)); - ACCEPT_TAC(left, selected_valid); + forward = ASSUME_TAC(forward, candidates, "Hcandidate"); + forward = ASMP_EXISTS_TAC(forward, "Hcandidate", "candidate"); + forward = ASMP_CONJ_TAC( + forward, + "Hcandidate", + "Hcandidate_eq", + "Hcandidate_valid"); + ACCEPT_TAC( + forward, + rewrite_rule( + THM_LIST(assume_rule(`candidate:A == (b:A)`)), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (candidate:A) (frame:A)) + `))); - gnode right = AUTO_INTROS_TAC(directions[1]); - right = EXISTS_TAC(right, `b:A`); - gnode_list result_parts = CONJ_TAC(right); + gnode reverse = AUTO_INTROS_TAC(directions[1]); + reverse = EXISTS_TAC(reverse, `b:A`); + gnode_list result_parts = CONJ_TAC(reverse); CONV_TAC(result_parts[0], rewrite_conv(THM_LIST())); - thm updated_valid = mp_rule( - spec_rule( - `frame:A`, + ACCEPT_TAC( + result_parts[1], + mp_rule( + spec_rule( + `frame:A`, + assume_rule(` + forall frame:A. + ra_valid (R:(A)ra) (ra_op R (a:A) frame) ==> + ra_valid R (ra_op R (b:A) frame) + `)), assume_rule(` - forall frame:A. - ra_valid (R:(A)ra) (ra_op R (a:A) frame) ==> - ra_valid R (ra_op R (b:A) frame) - `)), - assume_rule(` - ra_valid (R:(A)ra) (ra_op R (a:A) (frame:A)) - `)); - ACCEPT_TAC(result_parts[1], updated_valid); + ra_valid (R:(A)ra) (ra_op R (a:A) (frame:A)) + `))); return gnode_prove(root); } -PROOF thm RA_UPDATE_ND_SINGLETON = prove_ra_update_nd_singleton(); +PROOF static thm RA_UPDATE_DIRECT = prove_ra_update_direct(); /* * Nondeterministic update is reflexive. Select the source itself and retain * the assumed frame-validity fact. */ -PROOF static thm prove_ra_update_nd_refl(void) { +PROOF static thm prove_ra_updateP_refl(void) { term goal_tm = ` forall (R:(A)ra) (a:A). - ra_update_nd R a (\x:A. x == a) + ra_updateP R a (\x:A. x == a) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); + once_rewrite_conv(THM_LIST(ra_updateP_def))); body = CONV_TAC( body, depth_conv(get_conversion_by_name("BETA_CONV"))); @@ -1403,33 +1349,33 @@ PROOF static thm prove_ra_update_nd_refl(void) { return gnode_prove(root); } -PROOF thm RA_UPDATE_ND_REFL = - prove_ra_update_nd_refl(); +PROOF thm RA_UPDATEP_REFL = + prove_ra_updateP_refl(); /* * Predicate-valued updates compose by selecting the intermediate result and * then applying the second update to that result. */ -PROOF static thm prove_ra_update_nd_trans(void) { +PROOF static thm prove_ra_updateP_trans(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (P:A->bool) (Q:A->bool). - ra_update_nd R a P ==> - (forall b:A. P b ==> ra_update_nd R b Q) ==> - ra_update_nd R a Q + ra_updateP R a P ==> + (forall b:A. P b ==> ra_updateP R b Q) ==> + ra_updateP R a Q `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); + once_rewrite_conv(THM_LIST(ra_updateP_def))); body = AUTO_INTROS_TAC(body); thm intermediate = ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`, `P:A->bool`, `frame:A`), - RA_UPDATE_ND_APPLY); + RA_UPDATEP_APPLY); intermediate = mp_rule( intermediate, - assume_rule(`ra_update_nd (R:(A)ra) (a:A) (P:A->bool)`)); + assume_rule(`ra_updateP (R:(A)ra) (a:A) (P:A->bool)`)); intermediate = mp_rule( intermediate, assume_rule(` @@ -1446,12 +1392,12 @@ PROOF static thm prove_ra_update_nd_trans(void) { assume_rule(` forall b:A. (P:A->bool) b ==> - ra_update_nd (R:(A)ra) b (Q:A->bool) + ra_updateP (R:(A)ra) b (Q:A->bool) `)), assume_rule(`(P:A->bool) (middle:A)`)); thm result = ispecl_rule( TERM_LIST(`R:(A)ra`, `middle:A`, `Q:A->bool`, `frame:A`), - RA_UPDATE_ND_APPLY); + RA_UPDATEP_APPLY); result = mp_rule(result, middle_update); result = mp_rule( result, @@ -1462,22 +1408,22 @@ PROOF static thm prove_ra_update_nd_trans(void) { return gnode_prove(root); } -PROOF thm RA_UPDATE_ND_TRANS = prove_ra_update_nd_trans(); +PROOF thm RA_UPDATEP_TRANS = prove_ra_updateP_trans(); /* - * Enlarging the allowed result set preserves a nondeterministic update. + * Enlarging the allowed result set preserves a predicate update. */ -PROOF static thm prove_ra_update_nd_mono(void) { +PROOF static thm prove_ra_updateP_mono(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (P:A->bool) (Q:A->bool). - ra_update_nd R a P ==> + ra_updateP R a P ==> (forall b:A. P b ==> Q b) ==> - ra_update_nd R a Q + ra_updateP R a Q `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - pure_rewrite_conv(THM_LIST(ra_update_nd_def))); + pure_rewrite_conv(THM_LIST(ra_updateP_def))); body = AUTO_INTROS_TAC(body); thm selected = mp_rule( @@ -1516,20 +1462,20 @@ PROOF static thm prove_ra_update_nd_mono(void) { return gnode_prove(root); } -PROOF thm RA_UPDATE_ND_MONO = - prove_ra_update_nd_mono(); +PROOF thm RA_UPDATEP_MONO = + prove_ra_updateP_mono(); /* - * A deterministic result can be embedded into any ND postcondition that - * contains it. The singleton bridge supplies the exact result, and ND + * A deterministic result can be embedded into any predicate postcondition + * that contains it. The singleton bridge supplies the exact result, and * monotonicity widens that singleton to P. */ -PROOF static thm prove_ra_update_nd_of_update(void) { +PROOF static thm prove_ra_updateP_of_update(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (b:A) (P:A->bool). ra_update R a b ==> P b ==> - ra_update_nd R a P + ra_updateP R a P `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); @@ -1540,7 +1486,7 @@ PROOF static thm prove_ra_update_nd_of_update(void) { `R:(A)ra`, `a:A`, `b:A`), - RA_UPDATE_ND_SINGLETON)), + RA_UPDATEP_SINGLETON)), assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); term singleton_pred = `\x:A. x == (b:A)`; thm weakened = ispecl_rule( @@ -1549,7 +1495,7 @@ PROOF static thm prove_ra_update_nd_of_update(void) { `a:A`, singleton_pred, `P:A->bool`), - RA_UPDATE_ND_MONO); + RA_UPDATEP_MONO); weakened = mp_rule(weakened, singleton); weakened = conv_rule( depth_conv(get_conversion_by_name("BETA_CONV")), @@ -1568,18 +1514,18 @@ PROOF static thm prove_ra_update_nd_of_update(void) { return gnode_prove(root); } -PROOF thm RA_UPDATE_ND_OF_UPDATE = - prove_ra_update_nd_of_update(); +PROOF thm RA_UPDATEP_OF_UPDATE = + prove_ra_updateP_of_update(); /* - * Applying an ND update to a valid source yields at least one valid selected + * Applying a predicate update to a valid source yields a valid selected * result. Instantiate the update with the unit frame and eliminate that * frame using the right-unit law. */ -PROOF static thm prove_ra_update_nd_valid(void) { +PROOF static thm prove_ra_updateP_valid(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (P:A->bool). - ra_update_nd R a P ==> + ra_updateP R a P ==> ra_valid R a ==> exists b:A. P b && ra_valid R b `; @@ -1601,10 +1547,10 @@ PROOF static thm prove_ra_update_nd_valid(void) { `a:A`, `P:A->bool`, `ra_unit (R:(A)ra)`), - RA_UPDATE_ND_APPLY); + RA_UPDATEP_APPLY); selected = mp_rule( selected, - assume_rule(`ra_update_nd (R:(A)ra) (a:A) (P:A->bool)`)); + assume_rule(`ra_updateP (R:(A)ra) (a:A) (P:A->bool)`)); selected = mp_rule(selected, source_with_unit); body = ASSUME_TAC(body, selected, "Hselected"); body = ASMP_EXISTS_TAC(body, "Hselected", "selected"); @@ -1636,40 +1582,8 @@ PROOF static thm prove_ra_update_nd_valid(void) { return gnode_prove(root); } -PROOF thm RA_UPDATE_ND_VALID = - prove_ra_update_nd_valid(); - -/* If the source is invalid then no source/frame composition can be valid, - * so the quantified ND obligation has no cases. */ -PROOF static thm prove_ra_update_nd_invalid(void) { - term goal_tm = ` - forall (R:(A)ra) (a:A) (P:A->bool). - ~(ra_valid R a) ==> ra_update_nd R a P - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = CONV_TAC( - root, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); - body = AUTO_INTROS_TAC(body); - thm valid_source = mp_rule( - ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`, `frame:A`), - RA_VALID_OP_L), - assume_rule(` - ra_valid - (R:(A)ra) - (ra_op R (a:A) (frame:A)) - `)); - CONTR_TAC( - body, - not_elim_rule( - assume_rule(`~(ra_valid (R:(A)ra) (a:A))`), - valid_source)); - return gnode_prove(root); -} - -PROOF thm RA_UPDATE_ND_INVALID = - prove_ra_update_nd_invalid(); +PROOF thm RA_UPDATEP_VALID = + prove_ra_updateP_valid(); /* * General exclusive update: a source-compatible frame is the unit, so a @@ -1685,7 +1599,7 @@ PROOF static thm prove_ra_exclusive_update(void) { gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - once_rewrite_conv(THM_LIST(ra_update_def))); + once_rewrite_conv(THM_LIST(RA_UPDATE_DIRECT))); body = GEN_TAC(body, "R"); body = GEN_TAC(body, "a"); body = GEN_TAC(body, "b"); @@ -1738,7 +1652,7 @@ PROOF static thm prove_ra_update_refl(void) { gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - once_rewrite_conv(THM_LIST(ra_update_def))); + once_rewrite_conv(THM_LIST(RA_UPDATE_DIRECT))); body = AUTO_INTROS_TAC(body); ACCEPT_TAC( body, @@ -1750,38 +1664,6 @@ PROOF static thm prove_ra_update_refl(void) { PROOF thm RA_UPDATE_REFL = prove_ra_update_refl(); -/* Deterministic updates have the same vacuous-invalid-source boundary as ND - * updates. A valid composition would contradict downward validity. */ -PROOF static thm prove_ra_update_invalid(void) { - term goal_tm = ` - forall (R:(A)ra) (a:A) (b:A). - ~(ra_valid R a) ==> ra_update R a b - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = CONV_TAC( - root, - once_rewrite_conv(THM_LIST(ra_update_def))); - body = AUTO_INTROS_TAC(body); - thm valid_source = mp_rule( - ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`, `frame:A`), - RA_VALID_OP_L), - assume_rule(` - ra_valid - (R:(A)ra) - (ra_op R (a:A) (frame:A)) - `)); - CONTR_TAC( - body, - not_elim_rule( - assume_rule(`~(ra_valid (R:(A)ra) (a:A))`), - valid_source)); - return gnode_prove(root); -} - -PROOF thm RA_UPDATE_INVALID = - prove_ra_update_invalid(); - /* * A larger resource may always update to one of its included parts: every * frame compatible with the larger source is compatible with the smaller @@ -1796,7 +1678,7 @@ PROOF static thm prove_ra_update_included(void) { gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - once_rewrite_conv(THM_LIST(ra_update_def))); + once_rewrite_conv(THM_LIST(RA_UPDATE_DIRECT))); body = AUTO_INTROS_TAC(body); thm result = ispecl_rule( TERM_LIST( @@ -1852,7 +1734,7 @@ PROOF static thm prove_ra_update_trans(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(ra_update_def))); + once_rewrite_conv(THM_LIST(RA_UPDATE_DIRECT))); body = AUTO_INTROS_TAC(body); thm b_valid = ispecl_rule( @@ -1911,7 +1793,7 @@ PROOF thm RA_UPDATE_TARGET_INCLUDED = /* * A deterministic update maps a valid source to a valid result. As for the - * ND rule above, the unit is the frame witnessing ordinary validity. + * predicate-update rule above, the unit witnesses ordinary validity. */ PROOF static thm prove_ra_update_valid(void) { term goal_tm = ` @@ -1959,80 +1841,20 @@ PROOF static thm prove_ra_update_valid(void) { PROOF thm RA_UPDATE_VALID = prove_ra_update_valid(); -/* Exclusive sources admit exactly the validity-preserving deterministic - * updates. The validity guard accounts for the vacuous invalid-source case. */ -PROOF static thm prove_ra_exclusive_update_iff(void) { - term goal_tm = ` - forall (R:(A)ra) (a:A) (b:A). - ra_exclusive R a ==> - (ra_update R a b <=> - (ra_valid R a ==> ra_valid R b)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - gnode_list directions = EQ_TAC(body); - - gnode forward = DISCH_TAC(directions[0], "Hupdate"); - forward = DISCH_TAC(forward, "Hvalid_source"); - thm valid_target = ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`, `b:A`), - RA_UPDATE_VALID); - valid_target = mp_rule( - valid_target, - assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); - valid_target = mp_rule( - valid_target, - assume_rule(`ra_valid (R:(A)ra) (a:A)`)); - ACCEPT_TAC(forward, valid_target); - - gnode reverse = DISCH_TAC(directions[1], "Hvalidity_guard"); - gnode_list validity_cases = BOOL_CASES_TAC( - reverse, - `ra_valid (R:(A)ra) (a:A)`, - "Hvalid_source"); - - thm target_valid = mp_rule( - assume_rule(` - ra_valid (R:(A)ra) (a:A) ==> - ra_valid R (b:A) - `), - assume_rule(`ra_valid (R:(A)ra) (a:A)`)); - thm exclusive_update = ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`, `b:A`), - RA_EXCLUSIVE_UPDATE); - exclusive_update = mp_rule( - exclusive_update, - assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); - exclusive_update = mp_rule(exclusive_update, target_valid); - ACCEPT_TAC(validity_cases[0], exclusive_update); - - thm invalid_update = mp_rule( - ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`, `b:A`), - RA_UPDATE_INVALID), - assume_rule(`~(ra_valid (R:(A)ra) (a:A))`)); - ACCEPT_TAC(validity_cases[1], invalid_update); - return gnode_prove(root); -} - -PROOF thm RA_EXCLUSIVE_UPDATE_IFF = - prove_ra_exclusive_update_iff(); - /* * A deterministic update remains valid after appending the same resource to * both sides. The only algebraic fact used here is associativity. */ PROOF static thm prove_ra_update_frame(void) { term goal_tm = ` - forall (R:(A)ra) (a:A) (b:A). + forall (R:(A)ra) (a:A) (b:A) (extra:A). ra_update R a b ==> - forall extra:A. - ra_update R (ra_op R a extra) (ra_op R b extra) + ra_update R (ra_op R a extra) (ra_op R b extra) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - pure_rewrite_conv(THM_LIST(ra_update_def))); + pure_rewrite_conv(THM_LIST(RA_UPDATE_DIRECT))); body = AUTO_INTROS_TAC(body); thm source_assoc = specl_rule( @@ -2092,17 +1914,15 @@ PROOF static thm prove_ra_update_op(void) { thm first_step = mp_rule( ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`, `b:A`), + TERM_LIST(`R:(A)ra`, `a:A`, `b:A`, `c:A`), RA_UPDATE_FRAME), assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); - first_step = spec_rule(`c:A`, first_step); thm second_step = mp_rule( ispecl_rule( - TERM_LIST(`R:(A)ra`, `c:A`, `d:A`), + TERM_LIST(`R:(A)ra`, `c:A`, `d:A`, `b:A`), RA_UPDATE_FRAME), assume_rule(`ra_update (R:(A)ra) (c:A) (d:A)`)); - second_step = spec_rule(`b:A`, second_step); second_step = rewrite_rule( THM_LIST( ispecl_rule( @@ -2129,22 +1949,21 @@ PROOF static thm prove_ra_update_op(void) { PROOF thm RA_UPDATE_OP = prove_ra_update_op(); -PROOF static thm prove_ra_update_nd_frame(void) { +PROOF static thm prove_ra_updateP_frame(void) { term goal_tm = ` - forall (R:(A)ra) (a:A) (P:A->bool). - ra_update_nd R a P ==> - forall extra:A. - ra_update_nd - R - (ra_op R a extra) - (\x:A. - exists b:A. - P b && x == ra_op R b extra) + forall (R:(A)ra) (a:A) (P:A->bool) (extra:A). + ra_updateP R a P ==> + ra_updateP + R + (ra_op R a extra) + (\x:A. + exists b:A. + P b && x == ra_op R b extra) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - pure_rewrite_conv(THM_LIST(ra_update_nd_def))); + pure_rewrite_conv(THM_LIST(ra_updateP_def))); body = CONV_TAC( body, depth_conv(get_conversion_by_name("BETA_CONV"))); @@ -2225,16 +2044,16 @@ PROOF static thm prove_ra_update_nd_frame(void) { return gnode_prove(root); } -PROOF thm RA_UPDATE_ND_FRAME = - prove_ra_update_nd_frame(); +PROOF thm RA_UPDATEP_FRAME = + prove_ra_updateP_frame(); /* - * Combine two independent ND updates. The first update sees c · frame as + * Combine two independent predicate updates. The first sees c · frame as * its hidden frame and selects b. The second then sees b · frame and selects * d. Associativity and commutativity transport the intermediate validity * facts to exactly those two frame shapes. */ -PROOF static thm prove_ra_update_nd_op(void) { +PROOF static thm prove_ra_updateP_op(void) { term goal_tm = ` forall (R:(A)ra) @@ -2242,9 +2061,9 @@ PROOF static thm prove_ra_update_nd_op(void) { (c:A) (P:A->bool) (Q:A->bool). - ra_update_nd R a P ==> - ra_update_nd R c Q ==> - ra_update_nd + ra_updateP R a P ==> + ra_updateP R c Q ==> + ra_updateP R (ra_op R a c) (\x:A. @@ -2256,7 +2075,7 @@ PROOF static thm prove_ra_update_nd_op(void) { gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - pure_rewrite_conv(THM_LIST(ra_update_nd_def))); + pure_rewrite_conv(THM_LIST(ra_updateP_def))); body = CONV_TAC( body, depth_conv(get_conversion_by_name("BETA_CONV"))); @@ -2403,88 +2222,8 @@ PROOF static thm prove_ra_update_nd_op(void) { return gnode_prove(root); } -PROOF thm RA_UPDATE_ND_OP = - prove_ra_update_nd_op(); - -/* The ND analogue of RA_EXCLUSIVE_UPDATE_IFF: for a valid exclusive source, - * choosing one valid postcondition witness is necessary and sufficient. */ -PROOF static thm prove_ra_exclusive_update_nd_iff(void) { - term goal_tm = ` - forall (R:(A)ra) (a:A) (P:A->bool). - ra_exclusive R a ==> - (ra_update_nd R a P <=> - (ra_valid R a ==> - exists b:A. P b && ra_valid R b)) - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - gnode_list directions = EQ_TAC(body); - - gnode forward = DISCH_TAC(directions[0], "Hupdate"); - forward = DISCH_TAC(forward, "Hvalid_source"); - thm selected = ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`, `P:A->bool`), - RA_UPDATE_ND_VALID); - selected = mp_rule( - selected, - assume_rule(`ra_update_nd (R:(A)ra) (a:A) (P:A->bool)`)); - selected = mp_rule( - selected, - assume_rule(`ra_valid (R:(A)ra) (a:A)`)); - ACCEPT_TAC(forward, selected); - - gnode reverse = DISCH_TAC(directions[1], "Hvalidity_guard"); - gnode_list validity_cases = BOOL_CASES_TAC( - reverse, - `ra_valid (R:(A)ra) (a:A)`, - "Hvalid_source"); - - thm candidates = mp_rule( - assume_rule(` - ra_valid (R:(A)ra) (a:A) ==> - exists b:A. (P:A->bool) b && ra_valid R b - `), - assume_rule(`ra_valid (R:(A)ra) (a:A)`)); - gnode valid_case = ASSUME_TAC( - validity_cases[0], - candidates, - "Hcandidate"); - valid_case = ASMP_EXISTS_TAC(valid_case, "Hcandidate", "candidate"); - valid_case = ASMP_CONJ_TAC( - valid_case, - "Hcandidate", - "HP_candidate", - "Hvalid_candidate"); - - thm replacement = ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`, `candidate:A`), - RA_EXCLUSIVE_UPDATE); - replacement = mp_rule( - replacement, - assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); - replacement = mp_rule( - replacement, - assume_rule(`ra_valid (R:(A)ra) (candidate:A)`)); - thm nd_replacement = ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`, `candidate:A`, `P:A->bool`), - RA_UPDATE_ND_OF_UPDATE); - nd_replacement = mp_rule(nd_replacement, replacement); - nd_replacement = mp_rule( - nd_replacement, - assume_rule(`(P:A->bool) (candidate:A)`)); - ACCEPT_TAC(valid_case, nd_replacement); - - thm invalid_update = mp_rule( - ispecl_rule( - TERM_LIST(`R:(A)ra`, `a:A`, `P:A->bool`), - RA_UPDATE_ND_INVALID), - assume_rule(`~(ra_valid (R:(A)ra) (a:A))`)); - ACCEPT_TAC(validity_cases[1], invalid_update); - return gnode_prove(root); -} - -PROOF thm RA_EXCLUSIVE_UPDATE_ND_IFF = - prove_ra_exclusive_update_nd_iff(); +PROOF thm RA_UPDATEP_OP = + prove_ra_updateP_op(); /* * Abstraction computes to the supplied descriptor only when that descriptor @@ -2614,11 +2353,9 @@ PROOF thm RA_ABS_ETA = prove_ra_abs_eta(); PROOF static int audit_ra_core(void) { thm_list public_definitions = THM_LIST( - ra_unit_def, - ra_op_def, - ra_valid_def, + ra_compatible_def, ra_included_def, - ra_update_nd_def, + ra_updateP_def, ra_update_def, ra_cancellative_def, ra_exclusive_def); @@ -2626,53 +2363,36 @@ PROOF static int audit_ra_core(void) { RA_LAWS, RA_ASSOC, RA_COMM, - RA_OP_SWAP_RIGHT, RA_UNIT_L, RA_UNIT_R, RA_VALID_UNIT, - RA_VALID_OP_L, - RA_VALID_OP_R, RA_VALID_OP, - RA_CANCELLATIVE_APPLY, - RA_EXCLUSIVE_APPLY, - RA_UPDATE_APPLY, - RA_UPDATE_ND_APPLY, + RA_COMPAT_COMM, + RA_COMPAT_UNIT, RA_INCLUDED_REFL, RA_INCLUDED_UNIT, RA_INCLUDED_OP_L, RA_INCLUDED_OP_R, RA_INCLUDED_TRANS, - RA_INCLUDED_OP_MONO_L, - RA_INCLUDED_OP_MONO_R, RA_INCLUDED_OP_MONO, RA_INCLUDED_VALID, - RA_INCLUDED_VALID_FRAME, - RA_INCLUDED_CANCEL_L, - RA_EXCLUSIVE_INCLUDED, - RA_EXCLUSIVE_IFF_INCLUDED, - RA_INVALID_EXCLUSIVE, - RA_EXCLUSIVE_VALID_OP_IFF, - RA_UPDATE_ND_SINGLETON, - RA_UPDATE_ND_REFL, - RA_UPDATE_ND_TRANS, - RA_UPDATE_ND_MONO, - RA_UPDATE_ND_OF_UPDATE, - RA_UPDATE_ND_VALID, - RA_UPDATE_ND_INVALID, - RA_UPDATE_ND_FRAME, - RA_UPDATE_ND_OP, - RA_EXCLUSIVE_UPDATE_ND_IFF, - RA_EXCLUSIVE_UPDATE, + RA_UPDATEP_SINGLETON, + RA_UPDATEP_REFL, + RA_UPDATEP_MONO, + RA_UPDATEP_TRANS, + RA_UPDATEP_VALID, + RA_UPDATEP_FRAME, + RA_UPDATEP_OP, RA_UPDATE_REFL, - RA_UPDATE_INVALID, - RA_UPDATE_INCLUDED, - RA_UPDATE_UNIT, RA_UPDATE_TRANS, + RA_UPDATE_FRAME, + RA_UPDATE_OP, + RA_UPDATE_INCLUDED, RA_UPDATE_TARGET_INCLUDED, RA_UPDATE_VALID, - RA_EXCLUSIVE_UPDATE_IFF, - RA_UPDATE_FRAME, - RA_UPDATE_OP); + RA_EXCLUSIVE_INCLUDED, + RA_EXCLUSIVE_UPDATE, + RA_CANCELLATIVE_APPLY); thm_list builder_theorems = THM_LIST( ra_laws_def, RA_TYPE_BIJECTION, diff --git a/theory/logic/ra.h b/theory/logic/ra.h index 8166748..b76b4ca 100644 --- a/theory/logic/ra.h +++ b/theory/logic/ra.h @@ -1,633 +1,69 @@ #pragma once /* - * Generic discrete unital resource algebras: public client API. + * Discrete unital resource algebras: stable client API. * - * `(A)ra` is a genuine unary HOL type constructor. A value `R:(A)ra` - * bundles a unit, a commutative associative operation, and a validity - * predicate. The type contains only lawful descriptors, so every theorem - * below is unconditional in `R`: clients never carry a separate - * well-formedness premise. + * `(A)ra` is an abstract HOL type whose values bundle a unit, a commutative + * associative operation, and a downward-closed validity predicate. Lawful + * construction is handled by `ra_builder.h`; clients only see the projections + * and the algebraic interface below. * - * We write `R=(|R|, ε_R, ·_R, valid_R)`, with `R:(A)ra` and `|R|=A`, - * and use - * - * a ≼ b iff exists c. b == ra_op R a c, - * a ↝ B iff ra_update_nd R a B. - * - * Thus the first relation is `ra_included`; the second is the - * nondeterministic frame-preserving update whose result may depend on the - * hidden frame. - * - * Exact theorem contracts in `proof/theory/logic` use C* surface spelling so - * that they can be pasted into proof terms: `==` is object-level HOL equality, - * `==>` is implication, and `<=>` is Boolean equivalence. Documentation-only - * metanotation instead uses `=`, `⇒`, and `⇔`; `≃_R` is resource-proposition - * equivalence and must not be read as raw HOL equality. - * - * This header deliberately hides the representation, `ra_abs`, `ra_rep`, and - * the type-bijection theorem. Code defining a new RA instance should include - * `proof/theory/logic/ra_builder.h` in addition to this client interface. + * Predicate update is primitive. A deterministic update is exactly its + * singleton specialization. Exclusivity includes source validity, so an + * invalid element is never exclusive merely by vacuity. */ #include "proof/proof_kernel.h" -/* ------------------------------------------------------------------------- */ -/* Core representation */ -/* ------------------------------------------------------------------------- */ - -/* - * `ra_unit R : A` - * - * Definition theorem shape: - * `forall R:(A)ra. ra_unit R == FST (ra_rep R)`. - */ -PROOF extern thm ra_unit_def; - -/* - * `ra_op R : A -> A -> A` - * - * Definition theorem shape: - * `forall R:(A)ra. ra_op R == FST (SND (ra_rep R))`. - * Application is written `ra_op R a b`. - */ -PROOF extern thm ra_op_def; - -/* - * `ra_valid R : A -> bool` - * - * Definition theorem shape: - * `forall R:(A)ra. ra_valid R == SND (SND (ra_rep R))`. - */ -PROOF extern thm ra_valid_def; - -/* ------------------------------------------------------------------------- */ -/* Order */ -/* ------------------------------------------------------------------------- */ - -/* - * Inclusion / extension order (`a ≼ b`): - * - * forall (R:(A)ra) (a:A) (b:A). - * ra_included R a b <=> - * exists frame:A. b == ra_op R a frame - * - * Thus `a` is included in `b` when `b` can be obtained by framing `a`. - * This is an extension preorder, not in general a partial order: group-like - * commutative monoids can make distinct elements mutually included. Neither - * unitality nor `ra_cancellative R` alone supplies antisymmetry. - */ +/* Definitions. */ +PROOF extern thm ra_compatible_def; PROOF extern thm ra_included_def; - -/* ------------------------------------------------------------------------- */ -/* Updates */ -/* ------------------------------------------------------------------------- */ - -/* - * Nondeterministic frame-preserving update: - * - * forall (R:(A)ra) (a:A) (P:A->bool). - * ra_update_nd R a P <=> - * forall frame:A. - * ra_valid R (ra_op R a frame) ==> - * exists b:A. P b && ra_valid R (ra_op R b frame) - * - * A result may depend on the frame, but must satisfy `P` and remain valid - * with that same frame. - */ -PROOF extern thm ra_update_nd_def; - -/* - * Deterministic frame-preserving update: - * - * forall (R:(A)ra) (a:A) (b:A). - * ra_update R a b <=> - * forall frame:A. - * ra_valid R (ra_op R a frame) ==> - * ra_valid R (ra_op R b frame) - * - * This is intentionally a direct definition, rather than an abbreviation for - * an ND update to a singleton. Its backward proofs therefore expose only an - * implication, with no administrative existential witness. - */ +PROOF extern thm ra_updateP_def; PROOF extern thm ra_update_def; - -/* ------------------------------------------------------------------------- */ -/* Laws: optional algebraic properties */ -/* ------------------------------------------------------------------------- */ - -/* - * Left cancellativity on valid compositions: - * - * forall R:(A)ra. - * ra_cancellative R <=> - * forall (frame:A) (a:A) (b:A). - * ra_valid R (ra_op R frame a) ==> - * ra_op R frame a == ra_op R frame b ==> - * a == b - * - * Cancellativity is deliberately not part of `ra_laws`: many useful resource - * algebras are not cancellative. Instance modules may establish this property - * when their operation supports cancellation. - */ PROOF extern thm ra_cancellative_def; - -/* - * Compatible-frame exclusivity: - * - * forall (R:(A)ra) (a:A). - * ra_exclusive R a <=> - * forall frame:A. - * ra_valid R (ra_op R a frame) ==> - * frame == ra_unit R - * - * Thus a valid composition containing `a` has no frame other than the unit. - * The definition deliberately talks about compatible frames rather than raw - * inclusion: `ra_included` also permits invalid extensions. - * It does not assert `ra_valid R a`; an invalid element with no compatible - * frame may therefore be exclusive vacuously. - */ PROOF extern thm ra_exclusive_def; -/* - * Direct cancellativity application rule: - * - * forall (R:(A)ra) (frame:A) (a:A) (b:A). - * ra_cancellative R ==> - * ra_valid R (ra_op R frame a) ==> - * ra_op R frame a == ra_op R frame b ==> - * a == b - * - * All operands are explicit so backward proofs can specialize this rule - * without unfolding the property definition. - */ -PROOF extern thm RA_CANCELLATIVE_APPLY; - -/* - * Direct compatible-frame exclusivity elimination: - * - * forall (R:(A)ra) (a:A) (frame:A). - * ra_exclusive R a ==> - * ra_valid R (ra_op R a frame) ==> - * frame == ra_unit R - */ -PROOF extern thm RA_EXCLUSIVE_APPLY; - -/* ------------------------------------------------------------------------- */ -/* Direct update elimination */ -/* ------------------------------------------------------------------------- */ - -/* - * Direct deterministic-update elimination: - * - * forall (R:(A)ra) (a:A) (b:A) (frame:A). - * ra_update R a b ==> - * ra_valid R (ra_op R a frame) ==> - * ra_valid R (ra_op R b frame) - */ -PROOF extern thm RA_UPDATE_APPLY; - -/* - * Direct nondeterministic-update elimination: - * - * forall (R:(A)ra) (a:A) (P:A->bool) (frame:A). - * ra_update_nd R a P ==> - * ra_valid R (ra_op R a frame) ==> - * exists b:A. P b && ra_valid R (ra_op R b frame) - */ -PROOF extern thm RA_UPDATE_ND_APPLY; - -/* ------------------------------------------------------------------------- */ -/* Laws and validity */ -/* ------------------------------------------------------------------------- */ - -/* - * The bundled descriptor satisfies the complete raw law predicate: - * - * forall R:(A)ra. ra_laws (ra_unit R) (ra_op R) (ra_valid R) - * - * Ordinary clients should prefer the projected rules below. `RA_LAWS` - * exists as the compact interface theorem and as a bridge for generic - * construction proofs. - */ +/* Intrinsic RA laws. */ PROOF extern thm RA_LAWS; - -/* - * forall (R:(A)ra) (a:A) (b:A) (c:A). - * ra_op R (ra_op R a b) c == ra_op R a (ra_op R b c) - */ PROOF extern thm RA_ASSOC; - -/* - * forall (R:(A)ra) (a:A) (b:A). - * ra_op R a b == ra_op R b a - */ PROOF extern thm RA_COMM; - -/* - * Swap the final two factors while retaining a stable left prefix: - * - * forall (R:(A)ra) (a:A) (b:A) (c:A). - * ra_op R (ra_op R a b) c == - * ra_op R (ra_op R a c) b - */ -PROOF extern thm RA_OP_SWAP_RIGHT; - -/* - * forall (R:(A)ra) (a:A). ra_op R (ra_unit R) a == a - */ PROOF extern thm RA_UNIT_L; - -/* - * forall (R:(A)ra) (a:A). ra_op R a (ra_unit R) == a - */ PROOF extern thm RA_UNIT_R; - -/* `forall R:(A)ra. ra_valid R (ra_unit R)`. */ PROOF extern thm RA_VALID_UNIT; - -/* - * forall (R:(A)ra) (a:A) (b:A). - * ra_valid R (ra_op R a b) ==> ra_valid R a - */ -PROOF extern thm RA_VALID_OP_L; - -/* - * forall (R:(A)ra) (a:A) (b:A). - * ra_valid R (ra_op R a b) ==> ra_valid R b - */ -PROOF extern thm RA_VALID_OP_R; - -/* - * Both components of a valid composition are valid: - * - * forall (R:(A)ra) (a:A) (b:A). - * ra_valid R (ra_op R a b) ==> - * ra_valid R a && ra_valid R b - * - * The converse is not valid for a general RA: individually valid resources - * need not be compatible with one another. - */ PROOF extern thm RA_VALID_OP; -/* ------------------------------------------------------------------------- */ -/* Order laws */ -/* ------------------------------------------------------------------------- */ +/* Compatibility. */ +PROOF extern thm RA_COMPAT_COMM; +PROOF extern thm RA_COMPAT_UNIT; -/* `forall (R:(A)ra) (a:A). ra_included R a a`. */ +/* Inclusion. */ PROOF extern thm RA_INCLUDED_REFL; - -/* - * Unit minimum: - * `forall (R:(A)ra) (a:A). ra_included R (ra_unit R) a`. - */ PROOF extern thm RA_INCLUDED_UNIT; - -/* - * Left injection: - * `forall (R:(A)ra) (a:A) (b:A). ra_included R a (ra_op R a b)`. - */ PROOF extern thm RA_INCLUDED_OP_L; - -/* - * Right injection: - * `forall (R:(A)ra) (a:A) (b:A). ra_included R b (ra_op R a b)`. - */ PROOF extern thm RA_INCLUDED_OP_R; - -/* - * Transitivity: - * - * forall (R:(A)ra) (a:A) (b:A) (c:A). - * ra_included R a b ==> - * ra_included R b c ==> - * ra_included R a c - */ PROOF extern thm RA_INCLUDED_TRANS; - -/* - * Inclusion is monotone under composition in the left operand: - * - * forall (R:(A)ra) (a1:A) (a2:A) (b:A). - * ra_included R a1 a2 ==> - * ra_included R (ra_op R a1 b) (ra_op R a2 b) - */ -PROOF extern thm RA_INCLUDED_OP_MONO_L; - -/* - * Inclusion is monotone under composition in the right operand: - * - * forall (R:(A)ra) (a1:A) (a2:A) (b:A). - * ra_included R a1 a2 ==> - * ra_included R (ra_op R b a1) (ra_op R b a2) - */ -PROOF extern thm RA_INCLUDED_OP_MONO_R; - -/* - * Inclusion is monotone in both operands: - * - * forall (R:(A)ra) (a1:A) (a2:A) (b1:A) (b2:A). - * ra_included R a1 a2 ==> - * ra_included R b1 b2 ==> - * ra_included R (ra_op R a1 b1) (ra_op R a2 b2) - */ PROOF extern thm RA_INCLUDED_OP_MONO; - -/* - * Validity is downward closed under inclusion: - * - * forall (R:(A)ra) (a:A) (b:A). - * ra_included R a b ==> ra_valid R b ==> ra_valid R a - */ PROOF extern thm RA_INCLUDED_VALID; -/* - * Every frame compatible with a larger resource is compatible with an - * included resource: - * - * forall (R:(A)ra) (a:A) (b:A) (frame:A). - * ra_included R a b ==> - * ra_valid R (ra_op R b frame) ==> - * ra_valid R (ra_op R a frame) - */ -PROOF extern thm RA_INCLUDED_VALID_FRAME; - -/* - * Cancel a common prefix from an inclusion between valid compositions: - * - * forall (R:(A)ra) (common:A) (a:A) (b:A). - * ra_cancellative R ==> - * ra_valid R (ra_op R common b) ==> - * ra_included - * R - * (ra_op R common a) - * (ra_op R common b) ==> - * ra_included R a b - * - * The validity premise is the one required by `ra_cancellative`; raw - * inclusion may otherwise pass through invalid extensions. Commutativity - * makes a separate right-cancellation theorem unnecessary. - */ -PROOF extern thm RA_INCLUDED_CANCEL_L; - -/* ------------------------------------------------------------------------- */ -/* Exclusive elements */ -/* ------------------------------------------------------------------------- */ - -/* - * An exclusive element has no proper valid extension: - * - * forall (R:(A)ra) (a:A) (b:A). - * ra_exclusive R a ==> - * ra_valid R b ==> - * ra_included R a b ==> - * a == b - * - * The validity premise is essential because inclusion itself permits invalid - * extensions. For example, an owned element of `excl_ra` is included in - * `ExclInvalid`. - */ -PROOF extern thm RA_EXCLUSIVE_INCLUDED; - -/* - * In a cancellative RA, compatible-frame exclusivity is equivalent to - * maximality among valid extensions: - * - * forall (R:(A)ra) (a:A). - * ra_cancellative R ==> - * (ra_exclusive R a <=> - * forall b:A. - * ra_valid R b ==> - * ra_included R a b ==> - * a == b) - * - * Without cancellativity, maximality alone need not force the witnessing - * frame to equal the unit: a non-unit frame may be absorbed by `a`. - */ -PROOF extern thm RA_EXCLUSIVE_IFF_INCLUDED; - -/* - * Invalid elements are exclusive vacuously because validity is downward - * closed through composition: - * - * forall (R:(A)ra) (a:A). - * ~(ra_valid R a) ==> ra_exclusive R a - */ -PROOF extern thm RA_INVALID_EXCLUSIVE; - -/* - * Exact compatibility characterization for an exclusive element: - * - * forall (R:(A)ra) (a:A) (frame:A). - * ra_exclusive R a ==> - * (ra_valid R (ra_op R a frame) <=> - * ra_valid R a && frame == ra_unit R) - * - * This theorem makes the deliberate vacuity of `ra_exclusive` explicit: - * if `a` is invalid, both sides are false for every frame. - */ -PROOF extern thm RA_EXCLUSIVE_VALID_OP_IFF; - -/* ------------------------------------------------------------------------- */ -/* Nondeterministic frame-preserving update rules */ -/* ------------------------------------------------------------------------- */ - -/* - * Singleton bridge: - * - * forall (R:(A)ra) (a:A) (b:A). - * ra_update_nd R a (\x:A. x == b) <=> ra_update R a b - */ -PROOF extern thm RA_UPDATE_ND_SINGLETON; - -/* - * ND reflexivity: - * `forall (R:(A)ra) (a:A). ra_update_nd R a (\x:A. x == a)`. - */ -PROOF extern thm RA_UPDATE_ND_REFL; - -/* - * ND sequencing: - * - * forall (R:(A)ra) (a:A) (P:A->bool) (Q:A->bool). - * ra_update_nd R a P ==> - * (forall b:A. P b ==> ra_update_nd R b Q) ==> - * ra_update_nd R a Q - */ -PROOF extern thm RA_UPDATE_ND_TRANS; - -/* - * Result-predicate weakening: - * - * forall (R:(A)ra) (a:A) (P:A->bool) (Q:A->bool). - * ra_update_nd R a P ==> - * (forall b:A. P b ==> Q b) ==> - * ra_update_nd R a Q - */ -PROOF extern thm RA_UPDATE_ND_MONO; +/* Primitive predicate updates. */ +PROOF extern thm RA_UPDATEP_SINGLETON; +PROOF extern thm RA_UPDATEP_REFL; +PROOF extern thm RA_UPDATEP_MONO; +PROOF extern thm RA_UPDATEP_TRANS; +PROOF extern thm RA_UPDATEP_VALID; +PROOF extern thm RA_UPDATEP_FRAME; +PROOF extern thm RA_UPDATEP_OP; -/* - * Embed a deterministic update into any result predicate containing its - * target: - * - * forall (R:(A)ra) (a:A) (b:A) (P:A->bool). - * ra_update R a b ==> P b ==> ra_update_nd R a P - */ -PROOF extern thm RA_UPDATE_ND_OF_UPDATE; - -/* - * An ND update of a valid source selects a valid result: - * - * forall (R:(A)ra) (a:A) (P:A->bool). - * ra_update_nd R a P ==> ra_valid R a ==> - * exists b:A. P b && ra_valid R b - */ -PROOF extern thm RA_UPDATE_ND_VALID; - -/* - * Every ND update from an invalid source holds vacuously: - * - * forall (R:(A)ra) (a:A) (P:A->bool). - * ~(ra_valid R a) ==> ra_update_nd R a P - */ -PROOF extern thm RA_UPDATE_ND_INVALID; - -/* - * Framing an ND update: - * - * forall (R:(A)ra) (a:A) (P:A->bool). - * ra_update_nd R a P ==> - * forall extra:A. - * ra_update_nd R (ra_op R a extra) - * (\x:A. exists b:A. P b && x == ra_op R b extra) - */ -PROOF extern thm RA_UPDATE_ND_FRAME; - -/* - * Compose two independent nondeterministic updates: - * - * forall - * (R:(A)ra) - * (a:A) (c:A) - * (P:A->bool) (Q:A->bool). - * ra_update_nd R a P ==> - * ra_update_nd R c Q ==> - * ra_update_nd R (ra_op R a c) - * (\x:A. exists b d:A. P b && Q d && x == ra_op R b d) - */ -PROOF extern thm RA_UPDATE_ND_OP; - -/* - * For an exclusive source, ND update reduces exactly to finding an ordinary - * valid result satisfying the postcondition (guarded by source validity): - * - * forall (R:(A)ra) (a:A) (P:A->bool). - * ra_exclusive R a ==> - * (ra_update_nd R a P <=> - * (ra_valid R a ==> - * exists b:A. P b && ra_valid R b)) - */ -PROOF extern thm RA_EXCLUSIVE_UPDATE_ND_IFF; - -/* ------------------------------------------------------------------------- */ -/* Deterministic frame-preserving update rules */ -/* ------------------------------------------------------------------------- */ - -/* - * General exclusive update law: - * - * forall (R:(A)ra) (a:A) (b:A). - * ra_exclusive R a ==> - * ra_valid R b ==> - * ra_update R a b - * - * Every frame compatible with `a` is the unit, so ordinary validity of `b` - * suffices for validity of the framed target. - */ -PROOF extern thm RA_EXCLUSIVE_UPDATE; - -/* `forall (R:(A)ra) (a:A). ra_update R a a`. */ +/* Deterministic singleton updates. */ PROOF extern thm RA_UPDATE_REFL; - -/* - * Every deterministic update from an invalid source holds vacuously: - * - * forall (R:(A)ra) (a:A) (b:A). - * ~(ra_valid R a) ==> ra_update R a b - */ -PROOF extern thm RA_UPDATE_INVALID; - -/* - * Discard an extension while preserving every compatible frame: - * - * forall (R:(A)ra) (a:A) (b:A). - * ra_included R b a ==> ra_update R a b - */ -PROOF extern thm RA_UPDATE_INCLUDED; - -/* - * Discard the owned component while preserving every compatible frame: - * - * forall (R:(A)ra) (a:A). - * ra_update R a (ra_unit R) - * - * This is the `b = unit` corollary of `RA_UPDATE_INCLUDED` and - * `RA_INCLUDED_UNIT`. - */ -PROOF extern thm RA_UPDATE_UNIT; - -/* - * forall (R:(A)ra) (a:A) (b:A) (c:A). - * ra_update R a b ==> ra_update R b c ==> ra_update R a c - */ PROOF extern thm RA_UPDATE_TRANS; - -/* - * A deterministic result may be weakened to any included part: - * - * forall (R:(A)ra) (a:A) (b:A) (c:A). - * ra_update R a b ==> - * ra_included R c b ==> - * ra_update R a c - */ +PROOF extern thm RA_UPDATE_FRAME; +PROOF extern thm RA_UPDATE_OP; +PROOF extern thm RA_UPDATE_INCLUDED; PROOF extern thm RA_UPDATE_TARGET_INCLUDED; - -/* - * Updating a valid source preserves validity: - * - * forall (R:(A)ra) (a:A) (b:A). - * ra_update R a b ==> ra_valid R a ==> ra_valid R b - */ PROOF extern thm RA_UPDATE_VALID; -/* - * Exact deterministic update criterion for an exclusive source: - * - * forall (R:(A)ra) (a:A) (b:A). - * ra_exclusive R a ==> - * (ra_update R a b <=> - * (ra_valid R a ==> ra_valid R b)) - * - * The guard is essential: updates from invalid sources are vacuous. - */ -PROOF extern thm RA_EXCLUSIVE_UPDATE_IFF; - -/* - * Framing a deterministic update: - * - * forall (R:(A)ra) (a:A) (b:A). - * ra_update R a b ==> - * forall extra:A. - * ra_update R (ra_op R a extra) (ra_op R b extra) - */ -PROOF extern thm RA_UPDATE_FRAME; - -/* - * Compose two independent deterministic updates: - * - * forall (R:(A)ra) (a:A) (b:A) (c:A) (d:A). - * ra_update R a b ==> - * ra_update R c d ==> - * ra_update R (ra_op R a c) (ra_op R b d) - */ -PROOF extern thm RA_UPDATE_OP; +/* Optional algebraic properties. */ +PROOF extern thm RA_EXCLUSIVE_INCLUDED; +PROOF extern thm RA_EXCLUSIVE_UPDATE; +PROOF extern thm RA_CANCELLATIVE_APPLY; diff --git a/theory/logic/ra_builder.h b/theory/logic/ra_builder.h index 60ca6af..784cf24 100644 --- a/theory/logic/ra_builder.h +++ b/theory/logic/ra_builder.h @@ -1,110 +1,14 @@ #pragma once -/* - * Generic resource algebras: instance-construction API. - * - * This header is for modules that define a new `(A)ra`. A raw descriptor is - * represented by the nested pair - * - * (e,(op,valid)) : A # ((A -> A -> A) # (A -> bool)). - * - * Prove `ra_laws e op valid`, construct `ra_abs (e,(op,valid))`, and use the - * projection theorems below to establish the public computation rules of the - * instance. There is deliberately no `ra_pack` synonym: it added neither a - * law check nor any semantic abstraction over `ra_abs`. - * - * Ordinary RA clients should include only `proof/theory/logic/ra.h`. - */ +/* Constructor-author API for defining lawful `(A)ra` instances. */ #include "proof/theory/logic/ra.h" -/* ------------------------------------------------------------------------- */ -/* Core representation */ -/* ------------------------------------------------------------------------- */ - -/* - * ra_laws e op valid <=> - * (forall a b c. op (op a b) c == op a (op b c)) && - * (forall a b. op a b == op b a) && - * (forall a. op e a == a) && - * valid e && - * (forall a b. valid (op a b) ==> valid a) - */ PROOF extern thm ra_laws_def; - -/* ------------------------------------------------------------------------- */ -/* Constructors */ -/* ------------------------------------------------------------------------- */ - -/* - * Type-bijection theorem for - * `ra_abs:(A#((A->A->A)#(A->bool)))->(A)ra` and - * `ra_rep:(A)ra->A#((A->A->A)#(A->bool))`: - * - * (forall R. ra_abs (ra_rep R) == R) /\ - * (forall d. - * ra_laws (FST d) (FST (SND d)) (SND (SND d)) <=> - * ra_rep (ra_abs d) == d). - * - * Prefer `RA_ABS_REP` and the projection rules below; direct rewrites with - * the full bijection should normally remain confined to infrastructure. - */ PROOF extern thm RA_TYPE_BIJECTION; - -/* - * Every representation selected by the abstract type satisfies `ra_laws`: - * - * forall R:(A)ra. - * ra_laws (FST (ra_rep R)) - * (FST (SND (ra_rep R))) - * (SND (SND (ra_rep R))). - * - * This is the representation-level source of the public `RA_LAWS` theorem. - */ PROOF extern thm RA_REP_LAWS; - -/* ------------------------------------------------------------------------- */ -/* Laws: lawful `ra_abs` computation rules */ -/* ------------------------------------------------------------------------- */ - -/* - * Representation round trip for a lawful descriptor: - * - * ra_laws e op valid ==> - * ra_rep (ra_abs (e,(op,valid))) == (e,(op,valid)) - * - * `ra_abs` is total in HOL. The premise is essential: no corresponding - * representation equation is available for an unlawful descriptor. - */ PROOF extern thm RA_ABS_REP; - -/* - * Unit projection: - * - * ra_laws e op valid ==> - * ra_unit (ra_abs (e,(op,valid))) == e - */ PROOF extern thm RA_UNIT_ABS; - -/* - * Operation projection: - * - * ra_laws e op valid ==> - * ra_op (ra_abs (e,(op,valid))) == op - */ PROOF extern thm RA_OP_ABS; - -/* - * Validity projection: - * - * ra_laws e op valid ==> - * ra_valid (ra_abs (e,(op,valid))) == valid - */ PROOF extern thm RA_VALID_ABS; - -/* - * Abstract eta law: - * - * ra_abs (ra_unit R,(ra_op R,ra_valid R)) == R - */ PROOF extern thm RA_ABS_ETA; diff --git a/theory/logic/ra_internal.h b/theory/logic/ra_internal.h new file mode 100644 index 0000000..68c61a3 --- /dev/null +++ b/theory/logic/ra_internal.h @@ -0,0 +1,25 @@ +#pragma once + +/* + * Derived proof helpers for RA implementation modules. + * + * These rules intentionally do not belong to the stable client surface in + * `ra.h`. Constructor and local-update implementations may include this + * header to avoid repeatedly unfolding core definitions. + */ + +#include "proof/theory/logic/ra.h" + +PROOF extern thm RA_OP_SWAP_RIGHT; +PROOF extern thm RA_VALID_OP_L; +PROOF extern thm RA_VALID_OP_R; +PROOF extern thm RA_EXCLUSIVE_APPLY; +PROOF extern thm RA_UPDATE_APPLY; +PROOF extern thm RA_UPDATEP_APPLY; +PROOF extern thm RA_INCLUDED_OP_MONO_L; +PROOF extern thm RA_INCLUDED_OP_MONO_R; +PROOF extern thm RA_INCLUDED_VALID_FRAME; +PROOF extern thm RA_INCLUDED_CANCEL_L; +PROOF extern thm RA_EXCLUSIVE_VALID_OP_IFF; +PROOF extern thm RA_UPDATEP_OF_UPDATE; +PROOF extern thm RA_UPDATE_UNIT; diff --git a/theory/logic/resource_prop.c b/theory/logic/resource_prop.c index d4224d7..423b874 100644 --- a/theory/logic/resource_prop.c +++ b/theory/logic/resource_prop.c @@ -403,6 +403,31 @@ PROOF static thm prove_r_equiv_refl(void) { PROOF thm R_EQUIV_REFL = prove_r_equiv_refl(); +/* Raw function equality is useful inside implementations, but the public + * connective API is validity-sensitive equivalence. */ +PROOF static thm prove_r_equiv_of_eq(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (P:A->bool) (Q:A->bool). + P == Q ==> + r_equiv R P Q + `); + gnode body = AUTO_INTROS_TAC(root); + thm lifted = beta_rule(ap_term_rule( + `\X:A->bool. r_equiv (R:(A)ra) (P:A->bool) X`, + assume_rule(`(P:A->bool) == (Q:A->bool)`))); + ACCEPT_TAC( + body, + eq_mp_rule( + lifted, + ispecl_rule( + TERM_LIST(`R:(A)ra`, `P:A->bool`), + R_EQUIV_REFL))); + return gnode_prove(root); +} + +PROOF static thm R_EQUIV_OF_EQ = + prove_r_equiv_of_eq(); + PROOF static thm prove_r_equiv_sym(void) { term goal_tm = ` forall @@ -510,6 +535,38 @@ PROOF static thm prove_r_equiv_trans(void) { PROOF thm R_EQUIV_TRANS = prove_r_equiv_trans(); +PROOF static thm prove_r_top_intro(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (P:A->bool). + r_entails R P (r_top R) + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(r_entails_def, r_top_def))); + body = AUTO_INTROS_TAC(body); + ACCEPT_TAC(body, eqt_elim_rule(refl_rule(mk_true()))); + return gnode_prove(root); +} + +PROOF thm R_TOP_INTRO = + prove_r_top_intro(); + +PROOF static thm prove_r_bottom_elim(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (P:A->bool). + r_entails R (r_bottom R) P + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(r_entails_def, r_bottom_def))); + body = AUTO_INTROS_TAC(body); + CONTR_TAC(body, assume_rule(`F`)); + return gnode_prove(root); +} + +PROOF thm R_BOTTOM_ELIM = + prove_r_bottom_elim(); + PROOF static thm prove_r_sep_comm(void) { term goal_tm = ` forall @@ -583,9 +640,33 @@ PROOF static thm prove_r_sep_comm(void) { return gnode_prove(root); } -PROOF thm R_SEP_COMM = +PROOF thm R_SEP_COMM_EQ = prove_r_sep_comm(); +PROOF static thm prove_r_sep_comm_equiv(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (P:A->bool) (Q:A->bool). + r_equiv R (r_sep R P Q) (r_sep R Q P) + `); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_sep (R:(A)ra) (P:A->bool) (Q:A->bool)`, + `r_sep (R:(A)ra) (Q:A->bool) (P:A->bool)`), + R_EQUIV_OF_EQ), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `P:A->bool`, `Q:A->bool`), + R_SEP_COMM_EQ))); + return gnode_prove(root); +} + +PROOF thm R_SEP_COMM = + prove_r_sep_comm_equiv(); + PROOF static thm prove_r_sep_emp_l(void) { term goal_tm = ` forall @@ -673,9 +754,33 @@ PROOF static thm prove_r_sep_emp_l(void) { return gnode_prove(root); } -PROOF thm R_SEP_EMP_L = +PROOF thm R_SEP_EMP_L_EQ = prove_r_sep_emp_l(); +PROOF static thm prove_r_sep_emp_l_equiv(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (P:A->bool). + r_equiv R (r_sep R (r_emp R) P) P + `); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_sep (R:(A)ra) (r_emp R) (P:A->bool)`, + `P:A->bool`), + R_EQUIV_OF_EQ), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `P:A->bool`), + R_SEP_EMP_L_EQ))); + return gnode_prove(root); +} + +PROOF thm R_SEP_EMP_L = + prove_r_sep_emp_l_equiv(); + PROOF static thm prove_r_sep_emp_r(void) { term R = `R:(A)ra`; term P = `P:A->bool`; @@ -684,18 +789,42 @@ PROOF static thm prove_r_sep_emp_r(void) { R, P, `r_emp (R:(A)ra)`), - R_SEP_COMM); + R_SEP_COMM_EQ); thm left_unit = ispecl_rule( TERM_LIST(R, P), - R_SEP_EMP_L); + R_SEP_EMP_L_EQ); thm result = trans_rule(commute, left_unit); result = gen_rule(P, result); return gen_rule(R, result); } -PROOF thm R_SEP_EMP_R = +PROOF thm R_SEP_EMP_R_EQ = prove_r_sep_emp_r(); +PROOF static thm prove_r_sep_emp_r_equiv(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (P:A->bool). + r_equiv R (r_sep R P (r_emp R)) P + `); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_sep (R:(A)ra) (P:A->bool) (r_emp R)`, + `P:A->bool`), + R_EQUIV_OF_EQ), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `P:A->bool`), + R_SEP_EMP_R_EQ))); + return gnode_prove(root); +} + +PROOF thm R_SEP_EMP_R = + prove_r_sep_emp_r_equiv(); + PROOF static thm prove_r_sep_assoc(void) { term goal_tm = ` forall @@ -874,9 +1003,41 @@ PROOF static thm prove_r_sep_assoc(void) { return gnode_prove(root); } -PROOF thm R_SEP_ASSOC = +PROOF thm R_SEP_ASSOC_EQ = prove_r_sep_assoc(); +PROOF static thm prove_r_sep_assoc_equiv(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). + r_equiv + R + (r_sep R (r_sep R P Q) S) + (r_sep R P (r_sep R Q S)) + `); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_sep (R:(A)ra) + (r_sep R (P:A->bool) (Q:A->bool)) + (S:A->bool)`, + `r_sep (R:(A)ra) + (P:A->bool) + (r_sep R (Q:A->bool) (S:A->bool))`), + R_EQUIV_OF_EQ), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, `P:A->bool`, `Q:A->bool`, `S:A->bool`), + R_SEP_ASSOC_EQ))); + return gnode_prove(root); +} + +PROOF thm R_SEP_ASSOC = + prove_r_sep_assoc_equiv(); + PROOF static thm prove_r_sep_mono(void) { term goal_tm = ` forall @@ -930,22 +1091,16 @@ PROOF static thm prove_r_sep_mono(void) { thm valid_pair = eq_mp_rule( valid_eq, assume_rule(`ra_valid (R:(A)ra) (resource:A)`)); - thm valid_left = mp_rule( - ispecl_rule( - TERM_LIST( - `R:(A)ra`, - `left:A`, - `right:A`), - RA_VALID_OP_L), - valid_pair); - thm valid_right = mp_rule( + thm valid_parts = mp_rule( ispecl_rule( TERM_LIST( `R:(A)ra`, `left:A`, `right:A`), - RA_VALID_OP_R), + RA_VALID_OP), valid_pair); + thm valid_left = conjunct1_rule(valid_parts); + thm valid_right = conjunct2_rule(valid_parts); thm p2_left = mp_rule( mp_rule( @@ -1072,7 +1227,7 @@ PROOF static thm prove_r_sep_exists_l(void) { (R:(A)ra) (P:B->A->bool) (Q:A->bool). - r_sep R (r_exists R (\witness:B. P witness)) Q == + r_sep R (r_exists R (\x:B. P x)) Q == r_exists R (\witness:B. r_sep R (P witness) Q) `; gnode root = gnode_new_with_ccl(goal_tm); @@ -1081,7 +1236,7 @@ PROOF static thm prove_r_sep_exists_l(void) { term_list funext_arguments = TERM_LIST( `r_sep (R:(A)ra) - (r_exists R (\witness:B. (P:B->A->bool) witness)) + (r_exists R (\x:B. (P:B->A->bool) x)) (Q:A->bool)`, `r_exists (R:(A)ra) @@ -1186,16 +1341,46 @@ PROOF static thm prove_r_sep_exists_l(void) { return result; } -PROOF thm R_SEP_EXISTS_L = +PROOF thm R_SEP_EXISTS_L_EQ = prove_r_sep_exists_l(); +PROOF static thm prove_r_sep_exists_l_equiv(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (P:B->A->bool) (Q:A->bool). + r_equiv + R + (r_sep R (r_exists R (\x:B. P x)) Q) + (r_exists R (\x:B. r_sep R (P x) Q)) + `); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_sep (R:(A)ra) + (r_exists R (\x:B. (P:B->A->bool) x)) + (Q:A->bool)`, + `r_exists (R:(A)ra) + (\x:B. r_sep R ((P:B->A->bool) x) (Q:A->bool))`), + R_EQUIV_OF_EQ), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `P:B->A->bool`, `Q:A->bool`), + R_SEP_EXISTS_L_EQ))); + return gnode_prove(root); +} + +PROOF thm R_SEP_EXISTS_L = + prove_r_sep_exists_l_equiv(); + PROOF static thm prove_r_sep_exists_r(void) { term goal_tm = ` forall (R:(A)ra) (P:A->bool) (Q:B->A->bool). - r_sep R P (r_exists R (\witness:B. Q witness)) == + r_sep R P (r_exists R (\x:B. Q x)) == r_exists R (\witness:B. r_sep R P (Q witness)) `; gnode root = gnode_new_with_ccl(goal_tm); @@ -1205,7 +1390,7 @@ PROOF static thm prove_r_sep_exists_r(void) { `r_sep (R:(A)ra) (P:A->bool) - (r_exists R (\witness:B. (Q:B->A->bool) witness))`, + (r_exists R (\x:B. (Q:B->A->bool) x))`, `r_exists (R:(A)ra) (\witness:B. @@ -1309,9 +1494,39 @@ PROOF static thm prove_r_sep_exists_r(void) { return result; } -PROOF thm R_SEP_EXISTS_R = +PROOF thm R_SEP_EXISTS_R_EQ = prove_r_sep_exists_r(); +PROOF static thm prove_r_sep_exists_r_equiv(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (P:A->bool) (Q:B->A->bool). + r_equiv + R + (r_sep R P (r_exists R (\x:B. Q x))) + (r_exists R (\x:B. r_sep R P (Q x))) + `); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_sep (R:(A)ra) + (P:A->bool) + (r_exists R (\x:B. (Q:B->A->bool) x))`, + `r_exists (R:(A)ra) + (\x:B. r_sep R (P:A->bool) ((Q:B->A->bool) x))`), + R_EQUIV_OF_EQ), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `P:A->bool`, `Q:B->A->bool`), + R_SEP_EXISTS_R_EQ))); + return gnode_prove(root); +} + +PROOF thm R_SEP_EXISTS_R = + prove_r_sep_exists_r_equiv(); + PROOF static thm prove_r_and_intro(void) { term goal_tm = ` forall @@ -1738,13 +1953,11 @@ PROOF static thm prove_r_forall_elim(void) { forall (R:(A)ra) (P:B->A->bool) - (Q:A->bool) (witness:B). - r_entails R (P witness) Q ==> r_entails R - (r_forall R (\bound:B. P bound)) - Q + (r_forall R P) + (P witness) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( @@ -1752,46 +1965,67 @@ PROOF static thm prove_r_forall_elim(void) { pure_rewrite_conv(THM_LIST( r_entails_def, r_forall_def))); - /* Contract only `(\bound. P bound) selected`, beneath the universal source - * introduced by the eta-long theorem schema. */ - conv beta = get_conversion_by_name("BETA_CONV"); - conv generated_redex = binder_conv(binder_conv(binder_conv(binder_conv( - rand_conv(binder_conv(rand_conv(land_conv( - binder_conv(rator_conv(beta)))))))))); - body = CONV_TAC(body, generated_redex); - body = GEN_TAC(body, "R"); - body = GEN_TAC(body, "P"); - body = GEN_TAC(body, "Q"); - body = GEN_TAC(body, "witness"); - body = DISCH_TAC(body, "Hselected"); - body = GEN_TAC(body, "resource"); - body = DISCH_TAC(body, "Hvalid"); - body = DISCH_TAC(body, "Hall"); - - thm selected_resource = mp_rule( - mp_rule( - spec_rule( - `resource:A`, - assume_rule(` - forall resource:A. - ra_valid (R:(A)ra) resource ==> - (P:B->A->bool) (witness:B) resource ==> - (Q:A->bool) resource - `)), - assume_rule(`ra_valid (R:(A)ra) (resource:A)`)), + body = AUTO_INTROS_TAC(body); + ACCEPT_TAC( + body, spec_rule( `witness:B`, assume_rule(` - forall witness:B. - (P:B->A->bool) witness (resource:A) + forall selected:B. + (P:B->A->bool) selected (resource:A) `))); - ACCEPT_TAC(body, selected_resource); return gnode_prove(root); } PROOF thm R_FORALL_ELIM = prove_r_forall_elim(); +PROOF static thm prove_r_forall_elim_cont(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (P:B->A->bool) + (Q:A->bool) + (witness:B). + r_entails R (P witness) Q ==> + r_entails + R + (r_forall R (\x:B. P x)) + Q + `); + gnode body = AUTO_INTROS_TAC(root); + thm selected = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `\x:B. (P:B->A->bool) x`, + `witness:B`), + R_FORALL_ELIM); + selected = conv_rule( + depth_conv(get_conversion_by_name("BETA_CONV")), + selected); + thm composed = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_forall R (\x:B. (P:B->A->bool) x)`, + `(P:B->A->bool) (witness:B)`, + `Q:A->bool`), + R_ENTAILS_TRANS); + composed = mp_rule(composed, selected); + composed = mp_rule( + composed, + assume_rule(` + r_entails + (R:(A)ra) + ((P:B->A->bool) (witness:B)) + (Q:A->bool) + `)); + ACCEPT_TAC(body, composed); + return gnode_prove(root); +} + +PROOF thm R_FORALL_ELIM_CONT = + prove_r_forall_elim_cont(); + PROOF static thm prove_r_pure_and_intro(void) { term goal_tm = ` forall @@ -1921,9 +2155,37 @@ PROOF static thm prove_r_fact_as_pure_and_emp(void) { return gnode_prove(root); } -PROOF thm R_FACT_AS_PURE_AND_EMP = +PROOF thm R_FACT_AS_PURE_AND_EMP_EQ = prove_r_fact_as_pure_and_emp(); +PROOF static thm prove_r_fact_as_pure_and_emp_equiv(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (phi:bool). + r_equiv R + (r_fact R phi) + (r_and R (r_pure R phi) (r_emp R)) + `); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_fact (R:(A)ra) (phi:bool)`, + `r_and (R:(A)ra) + (r_pure R (phi:bool)) + (r_emp R)`), + R_EQUIV_OF_EQ), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `phi:bool`), + R_FACT_AS_PURE_AND_EMP_EQ))); + return gnode_prove(root); +} + +PROOF thm R_FACT_AS_PURE_AND_EMP = + prove_r_fact_as_pure_and_emp_equiv(); + PROOF static thm prove_r_fact_true(void) { term goal_tm = ` forall R:(A)ra. @@ -1949,9 +2211,31 @@ PROOF static thm prove_r_fact_true(void) { return gnode_prove(root); } -PROOF thm R_FACT_TRUE = +PROOF thm R_FACT_TRUE_EQ = prove_r_fact_true(); +PROOF static thm prove_r_fact_true_equiv(void) { + gnode root = gnode_new_with_ccl(` + forall R:(A)ra. + r_equiv R (r_fact R T) (r_emp R) + `); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_fact (R:(A)ra) T`, + `r_emp (R:(A)ra)`), + R_EQUIV_OF_EQ), + spec_rule(`R:(A)ra`, R_FACT_TRUE_EQ))); + return gnode_prove(root); +} + +PROOF thm R_FACT_TRUE = + prove_r_fact_true_equiv(); + PROOF static thm prove_r_fact_false(void) { term goal_tm = ` forall R:(A)ra. @@ -1977,9 +2261,31 @@ PROOF static thm prove_r_fact_false(void) { return gnode_prove(root); } -PROOF thm R_FACT_FALSE = +PROOF thm R_FACT_FALSE_EQ = prove_r_fact_false(); +PROOF static thm prove_r_fact_false_equiv(void) { + gnode root = gnode_new_with_ccl(` + forall R:(A)ra. + r_equiv R (r_fact R F) (r_bottom R) + `); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_fact (R:(A)ra) F`, + `r_bottom (R:(A)ra)`), + R_EQUIV_OF_EQ), + spec_rule(`R:(A)ra`, R_FACT_FALSE_EQ))); + return gnode_prove(root); +} + +PROOF thm R_FACT_FALSE = + prove_r_fact_false_equiv(); + PROOF static thm prove_r_fact_sep_l(void) { term goal_tm = ` forall @@ -2087,9 +2393,39 @@ PROOF static thm prove_r_fact_sep_l(void) { return gnode_prove(root); } -PROOF thm R_FACT_SEP_L = +PROOF thm R_FACT_SEP_L_EQ = prove_r_fact_sep_l(); +PROOF static thm prove_r_fact_sep_l_equiv(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (phi:bool) (P:A->bool). + r_equiv R + (r_sep R (r_fact R phi) P) + (r_and R (r_pure R phi) P) + `); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_sep (R:(A)ra) + (r_fact R (phi:bool)) + (P:A->bool)`, + `r_and (R:(A)ra) + (r_pure R (phi:bool)) + (P:A->bool)`), + R_EQUIV_OF_EQ), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `phi:bool`, `P:A->bool`), + R_FACT_SEP_L_EQ))); + return gnode_prove(root); +} + +PROOF thm R_FACT_SEP_L = + prove_r_fact_sep_l_equiv(); + PROOF static thm prove_r_fact_sep_r(void) { term R = `R:(A)ra`; term phi = `phi:bool`; @@ -2099,19 +2435,49 @@ PROOF static thm prove_r_fact_sep_r(void) { R, P, `r_fact (R:(A)ra) (phi:bool)`), - R_SEP_COMM); + R_SEP_COMM_EQ); thm bridge = ispecl_rule( TERM_LIST(R, phi, P), - R_FACT_SEP_L); + R_FACT_SEP_L_EQ); thm result = trans_rule(commute, bridge); result = gen_rule(P, result); result = gen_rule(phi, result); return gen_rule(R, result); } -PROOF thm R_FACT_SEP_R = +PROOF thm R_FACT_SEP_R_EQ = prove_r_fact_sep_r(); +PROOF static thm prove_r_fact_sep_r_equiv(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (phi:bool) (P:A->bool). + r_equiv R + (r_sep R P (r_fact R phi)) + (r_and R (r_pure R phi) P) + `); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_sep (R:(A)ra) + (P:A->bool) + (r_fact R (phi:bool))`, + `r_and (R:(A)ra) + (r_pure R (phi:bool)) + (P:A->bool)`), + R_EQUIV_OF_EQ), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `phi:bool`, `P:A->bool`), + R_FACT_SEP_R_EQ))); + return gnode_prove(root); +} + +PROOF thm R_FACT_SEP_R = + prove_r_fact_sep_r_equiv(); + PROOF static thm prove_r_fact_intro(void) { term goal_tm = ` forall @@ -2147,7 +2513,7 @@ PROOF static thm prove_r_fact_intro(void) { `R:(A)ra`, `phi:bool`, `Q:A->bool`), - R_FACT_SEP_L); + R_FACT_SEP_L_EQ); thm target_eq = beta_rule(ap_term_rule( `\target:A->bool. r_entails (R:(A)ra) (P:A->bool) target`, @@ -2193,7 +2559,7 @@ PROOF static thm prove_r_fact_elim(void) { `R:(A)ra`, `phi:bool`, `P:A->bool`), - R_FACT_SEP_L); + R_FACT_SEP_L_EQ); thm source_eq = beta_rule(ap_term_rule( `\source:A->bool. r_entails (R:(A)ra) source (Q:A->bool)`, @@ -2288,9 +2654,31 @@ PROOF static thm prove_r_own_unit(void) { return gnode_prove(root); } -PROOF thm R_OWN_UNIT = +PROOF thm R_OWN_UNIT_EQ = prove_r_own_unit(); +PROOF static thm prove_r_own_unit_equiv(void) { + gnode root = gnode_new_with_ccl(` + forall R:(A)ra. + r_equiv R (r_own R (ra_unit R)) (r_emp R) + `); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_own (R:(A)ra) (ra_unit R)`, + `r_emp (R:(A)ra)`), + R_EQUIV_OF_EQ), + spec_rule(`R:(A)ra`, R_OWN_UNIT_EQ))); + return gnode_prove(root); +} + +PROOF thm R_OWN_UNIT = + prove_r_own_unit_equiv(); + PROOF static thm prove_r_own_op(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (b:A). @@ -2365,18 +2753,46 @@ PROOF static thm prove_r_own_op(void) { return gnode_prove(root); } -PROOF thm R_OWN_OP = +PROOF thm R_OWN_OP_EQ = prove_r_own_op(); +PROOF static thm prove_r_own_op_equiv(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (a:A) (b:A). + r_equiv R + (r_own R (ra_op R a b)) + (r_sep R (r_own R a) (r_own R b)) + `); + gnode body = AUTO_INTROS_TAC(root); + ACCEPT_TAC( + body, + mp_rule( + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_own (R:(A)ra) (ra_op R (a:A) (b:A))`, + `r_sep (R:(A)ra) + (r_own R (a:A)) + (r_own R (b:A))`), + R_EQUIV_OF_EQ), + ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`, `b:A`), + R_OWN_OP_EQ))); + return gnode_prove(root); +} + +PROOF thm R_OWN_OP = + prove_r_own_op_equiv(); + PROOF static thm prove_r_own_valid(void) { term goal_tm = ` forall (R:(A)ra) (a:A). r_entails R (r_own R a) - (r_and + (r_sep R - (r_pure R (ra_valid R a)) + (r_fact R (ra_valid R a)) (r_own R a)) `; gnode root = gnode_new_with_ccl(goal_tm); @@ -2385,26 +2801,34 @@ PROOF static thm prove_r_own_valid(void) { pure_rewrite_conv(THM_LIST( r_entails_def, r_own_def, - r_and_def, - r_pure_def))); + r_sep_def, + r_fact_def))); body = GEN_TAC(body, "R"); body = GEN_TAC(body, "a"); body = GEN_TAC(body, "resource"); body = DISCH_TAC(body, "Hvalid"); body = DISCH_TAC(body, "Howned"); - gnode_list result = CONJ_TAC(body); - thm validity_eq = ap_term_rule( `ra_valid (R:(A)ra):A->bool`, assume_rule(`(resource:A) == (a:A)`)); + thm valid_a = eq_mp_rule( + validity_eq, + assume_rule(`ra_valid (R:(A)ra) (resource:A)`)); + body = EXISTS_TAC(body, `ra_unit (R:(A)ra)`); + body = EXISTS_TAC(body, `a:A`); + gnode_list result1 = CONJ_TAC(body); ACCEPT_TAC( - result[0], - eq_mp_rule( - validity_eq, - assume_rule(`ra_valid (R:(A)ra) (resource:A)`))); - ACCEPT_TAC( - result[1], - assume_rule(`(resource:A) == (a:A)`)); + result1[0], + trans_rule( + assume_rule(`(resource:A) == (a:A)`), + gsym_rule(ispecl_rule( + TERM_LIST(`R:(A)ra`, `a:A`), + RA_UNIT_L)))); + gnode_list result2 = CONJ_TAC(result1[1]); + gnode_list fact = CONJ_TAC(result2[0]); + ACCEPT_TAC(fact[0], valid_a); + ACCEPT_TAC(fact[1], refl_rule(`ra_unit (R:(A)ra)`)); + ACCEPT_TAC(result2[1], refl_rule(`a:A`)); return gnode_prove(root); } @@ -2600,14 +3024,14 @@ PROOF static thm prove_r_wand_adjunction(void) { thm valid_pair = eq_mp_rule( validity_eq, assume_rule(`ra_valid (R:(A)ra) (resource:A)`)); - thm valid_left = mp_rule( + thm valid_left = conjunct1_rule(mp_rule( ispecl_rule( TERM_LIST( `R:(A)ra`, `left:A`, `right:A`), - RA_VALID_OP_L), - valid_pair); + RA_VALID_OP), + valid_pair)); thm wand_left = mp_rule( mp_rule( spec_rule( @@ -2643,6 +3067,112 @@ PROOF static thm prove_r_wand_adjunction(void) { PROOF thm R_WAND_ADJUNCTION = prove_r_wand_adjunction(); +PROOF static thm prove_r_wand_elim(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (P:A->bool) (Q:A->bool). + r_entails R (r_sep R (r_wand R P Q) P) Q + `); + gnode body = AUTO_INTROS_TAC(root); + thm adjunction = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_wand (R:(A)ra) (P:A->bool) (Q:A->bool)`, + `P:A->bool`, + `Q:A->bool`), + R_WAND_ADJUNCTION); + ACCEPT_TAC( + body, + eq_mp_rule( + gsym_rule(adjunction), + ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `r_wand (R:(A)ra) (P:A->bool) (Q:A->bool)`), + R_ENTAILS_REFL))); + return gnode_prove(root); +} + +PROOF thm R_WAND_ELIM = + prove_r_wand_elim(); + +PROOF static thm prove_r_wand_mono(void) { + gnode root = gnode_new_with_ccl(` + forall + (R:(A)ra) + (P2:A->bool) + (P:A->bool) + (Q:A->bool) + (Q2:A->bool). + r_entails R P2 P ==> + r_entails R Q Q2 ==> + r_entails R (r_wand R P Q) (r_wand R P2 Q2) + `); + gnode body = CONV_TAC( + root, + pure_rewrite_conv(THM_LIST(r_entails_def, r_wand_def))); + body = AUTO_INTROS_TAC(body); + thm valid_frame = conjunct2_rule(mp_rule( + ispecl_rule( + TERM_LIST(`R:(A)ra`, `resource:A`, `frame:A`), + RA_VALID_OP), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (resource:A) (frame:A)) + `))); + thm p_frame = mp_rule( + mp_rule( + spec_rule( + `frame:A`, + assume_rule(` + forall owned:A. + ra_valid (R:(A)ra) owned ==> + (P2:A->bool) owned ==> + (P:A->bool) owned + `)), + valid_frame), + assume_rule(`(P2:A->bool) (frame:A)`)); + thm q_total = mp_rule( + mp_rule( + spec_rule( + `frame:A`, + assume_rule(` + forall hidden:A. + ra_valid + (R:(A)ra) + (ra_op R (resource:A) hidden) ==> + (P:A->bool) hidden ==> + (Q:A->bool) (ra_op R resource hidden) + `)), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (resource:A) (frame:A)) + `)), + p_frame); + thm q2_total = mp_rule( + mp_rule( + spec_rule( + `ra_op (R:(A)ra) (resource:A) (frame:A)`, + assume_rule(` + forall owned:A. + ra_valid (R:(A)ra) owned ==> + (Q:A->bool) owned ==> + (Q2:A->bool) owned + `)), + assume_rule(` + ra_valid + (R:(A)ra) + (ra_op R (resource:A) (frame:A)) + `)), + q_total); + ACCEPT_TAC(body, q2_total); + return gnode_prove(root); +} + +PROOF thm R_WAND_MONO = + prove_r_wand_mono(); + PROOF static thm prove_r_sep_and_forward_r(void) { term goal_tm = ` forall @@ -2834,6 +3364,8 @@ PROOF static int audit_resource_prop(void) { R_EQUIV_REFL, R_EQUIV_SYM, R_EQUIV_TRANS, + R_TOP_INTRO, + R_BOTTOM_ELIM, R_SEP_ASSOC, R_SEP_COMM, R_SEP_EMP_L, @@ -2869,6 +3401,8 @@ PROOF static int audit_resource_prop(void) { R_OWN_VALID, R_IMPL_ADJUNCTION, R_WAND_ADJUNCTION, + R_WAND_ELIM, + R_WAND_MONO, R_SEP_AND_FORWARD_R, R_SEP_AND_FORWARD_L); diff --git a/theory/logic/resource_prop.h b/theory/logic/resource_prop.h index 243bd71..97ce919 100644 --- a/theory/logic/resource_prop.h +++ b/theory/logic/resource_prop.h @@ -1,246 +1,99 @@ #pragma once -/* - * Resource propositions over `R=(|R|, ε_R, ·_R, valid_R)`, where - * `R:(A)ra` and `|R|=A`. - * - * The carrier of assertions is `A->bool`. In the formulas below - * - * P ⊢_R Q abbreviates `r_entails R P Q`, - * P ≃_R Q abbreviates `r_equiv R P Q`, and - * P * Q abbreviates `r_sep R P Q`. - * - * Entailment observes valid resources only. Connectives are nevertheless - * defined on every carrier value and own exact resources: this theory assumes - * neither affinity, persistence, nor cancellativity. - * This is a pure proof-stdlib theory: loading it registers no QCP descriptor, - * parser interface, or symbolic state. - */ +/* Strict linear BI over an arbitrary resource algebra. Assertions are + * predicates on the RA carrier; entailment and equivalence observe valid + * resources only. `r_pure` deliberately remains resource-independent, + * while `r_fact` is the exact-unit embedding used in spatial rules. */ #include "proof/theory/logic/ra.h" -/* ------------------------------------------------------------------------- */ -/* Core representation */ -/* ------------------------------------------------------------------------- */ - -/* `r_entails R P Q <=> forall a. ra_valid R a ==> P a ==> Q a`. */ +/* Core observation relations. */ PROOF extern thm r_entails_def; - -/* `r_equiv R P Q <=> r_entails R P Q && r_entails R Q P`. */ PROOF extern thm r_equiv_def; -/* ------------------------------------------------------------------------- */ -/* Constructors */ -/* ------------------------------------------------------------------------- */ - -/* `r_emp R a <=> a == ra_unit R`. */ +/* Assertion constructors. */ PROOF extern thm r_emp_def; - -/* - * `r_sep R P Q a <=> - * exists x y. a == ra_op R x y && P x && Q y`. - */ PROOF extern thm r_sep_def; - -/* `r_own R owned a <=> a == owned`. */ +PROOF extern thm r_wand_def; PROOF extern thm r_own_def; - -/* `r_top R a <=> T`. */ PROOF extern thm r_top_def; - -/* `r_bottom R a <=> F`. */ PROOF extern thm r_bottom_def; - -/* `r_and R P Q a <=> P a && Q a`. */ PROOF extern thm r_and_def; - -/* `r_or R P Q a <=> P a || Q a`. */ PROOF extern thm r_or_def; - -/* `r_impl R P Q a <=> (P a ==> Q a)`. */ PROOF extern thm r_impl_def; - -/* `r_exists R P a <=> exists x:B. P x a`, for `P:B->A->bool`. */ PROOF extern thm r_exists_def; - -/* `r_forall R P a <=> forall x:B. P x a`, for `P:B->A->bool`. */ PROOF extern thm r_forall_def; -/* `r_pure R phi a <=> phi`. */ +/* `r_pure R phi resource <=> phi`. */ PROOF extern thm r_pure_def; -/* `r_fact R phi a <=> phi && a == ra_unit R`. */ +/* `r_fact R phi resource <=> phi && resource == ra_unit R`. */ PROOF extern thm r_fact_def; -/* - * `r_wand R P Q a <=> - * forall frame. ra_valid R (ra_op R a frame) ==> - * P frame ==> Q (ra_op R a frame)`. - */ -PROOF extern thm r_wand_def; - -/* ------------------------------------------------------------------------- */ -/* Laws: entailment and equivalence */ -/* ------------------------------------------------------------------------- */ - -/* `forall R P. r_entails R P P`. */ +/* Entailment and validity-sensitive equivalence. */ PROOF extern thm R_ENTAILS_REFL; - -/* `P ⊢_R Q ==> Q ⊢_R S ==> P ⊢_R S`. */ PROOF extern thm R_ENTAILS_TRANS; - -/* `(forall a. P a ==> Q a) ==> P ⊢_R Q`. */ PROOF extern thm R_ENTAILS_POINTWISE; - -/* `P ≃_R Q <=> forall a. ra_valid R a ==> (P a <=> Q a)`. */ PROOF extern thm R_EQUIV_POINTWISE; - -/* `P ⊢_R Q ==> Q ⊢_R P ==> P ≃_R Q`. */ PROOF extern thm R_EQUIV_INTRO; - -/* `forall R P. r_equiv R P P`. */ PROOF extern thm R_EQUIV_REFL; - -/* `P ≃_R Q ==> Q ≃_R P`. */ PROOF extern thm R_EQUIV_SYM; - -/* `P ≃_R Q ==> Q ≃_R S ==> P ≃_R S`. */ PROOF extern thm R_EQUIV_TRANS; -/* ------------------------------------------------------------------------- */ -/* Laws: separating conjunction */ -/* ------------------------------------------------------------------------- */ +/* Additive truth and falsehood. */ +PROOF extern thm R_TOP_INTRO; +PROOF extern thm R_BOTTOM_ELIM; -/* `r_sep R (r_sep R P Q) S == r_sep R P (r_sep R Q S)`. */ +/* Separating conjunction. Algebraic laws expose `r_equiv`, never raw + * assertion-function equality. */ PROOF extern thm R_SEP_ASSOC; - -/* `r_sep R P Q == r_sep R Q P`. */ PROOF extern thm R_SEP_COMM; - -/* `r_sep R (r_emp R) P == P`. */ PROOF extern thm R_SEP_EMP_L; - -/* `r_sep R P (r_emp R) == P`. */ PROOF extern thm R_SEP_EMP_R; - -/* `P ⊢_R P2 ==> Q ⊢_R Q2 ==> P*Q ⊢_R P2*Q2`. */ PROOF extern thm R_SEP_MONO; - -/* `P ⊢_R Q ==> F*P ⊢_R F*Q`. */ PROOF extern thm R_SEP_FRAME_L; - -/* `P ⊢_R Q ==> P*F ⊢_R Q*F`. */ PROOF extern thm R_SEP_FRAME_R; - -/* `r_sep R (r_exists R (\x. P x)) Q == - * r_exists R (\x. r_sep R (P x) Q)`. */ PROOF extern thm R_SEP_EXISTS_L; - -/* `r_sep R P (r_exists R (\x. Q x)) == - * r_exists R (\x. r_sep R P (Q x))`. */ PROOF extern thm R_SEP_EXISTS_R; -/* ------------------------------------------------------------------------- */ -/* Laws: additive connectives and quantification */ -/* ------------------------------------------------------------------------- */ - -/* `P ⊢_R Q ==> P ⊢_R S ==> P ⊢_R r_and R Q S`. */ +/* Additive connectives and quantifiers. */ +PROOF extern thm R_IMPL_ADJUNCTION; PROOF extern thm R_AND_INTRO; - -/* `r_and R P Q ⊢_R P`. */ PROOF extern thm R_AND_ELIM_L; - -/* `r_and R P Q ⊢_R Q`. */ PROOF extern thm R_AND_ELIM_R; - -/* `P ⊢_R r_or R P Q`. */ PROOF extern thm R_OR_INTRO_L; - -/* `Q ⊢_R r_or R P Q`. */ PROOF extern thm R_OR_INTRO_R; - -/* `P ⊢_R S ==> Q ⊢_R S ==> r_or R P Q ⊢_R S`. */ PROOF extern thm R_OR_ELIM; - -/* `P witness ⊢_R r_exists R (\x. P x)`. */ PROOF extern thm R_EXISTS_INTRO; - -/* `(forall x:B. P x ⊢_R Q) ==> - * r_exists R (\x. P x) ⊢_R Q`. */ PROOF extern thm R_EXISTS_ELIM; - -/* `(forall x:B. P x ⊢_R Q x) ==> - * r_exists R (\x. P x) ⊢_R r_exists R (\x. Q x)`. */ PROOF extern thm R_EXISTS_MONO; - -/* `(forall x:B. P ⊢_R Q x) ==> P ⊢_R r_forall R (\x. Q x)`. */ PROOF extern thm R_FORALL_INTRO; - -/* `P witness ⊢_R Q ==> r_forall R (\x. P x) ⊢_R Q`. */ PROOF extern thm R_FORALL_ELIM; -/* ------------------------------------------------------------------------- */ -/* Laws: pure propositions and exact-unit facts */ -/* ------------------------------------------------------------------------- */ +/* Magic wand. */ +PROOF extern thm R_WAND_ADJUNCTION; +PROOF extern thm R_WAND_ELIM; +PROOF extern thm R_WAND_MONO; -/* `phi ==> P ⊢_R Q ==> P ⊢_R r_and R (r_pure R phi) Q`. */ +/* Resource-independent pure propositions. */ PROOF extern thm R_PURE_AND_INTRO; - -/* `(phi ==> P ⊢_R Q) ==> r_and R (r_pure R phi) P ⊢_R Q`. */ PROOF extern thm R_PURE_AND_ELIM; -/* `r_fact R phi == r_and R (r_pure R phi) (r_emp R)`. */ +/* Exact-unit facts. Equational laws below are `r_equiv` statements. */ PROOF extern thm R_FACT_AS_PURE_AND_EMP; - -/* `r_fact R T == r_emp R`. */ PROOF extern thm R_FACT_TRUE; - -/* `r_fact R F == r_bottom R`. */ PROOF extern thm R_FACT_FALSE; - -/* `r_sep R (r_fact R phi) P == r_and R (r_pure R phi) P`. */ PROOF extern thm R_FACT_SEP_L; - -/* `r_sep R P (r_fact R phi) == r_and R (r_pure R phi) P`. */ PROOF extern thm R_FACT_SEP_R; - -/* `phi ==> P ⊢_R Q ==> P ⊢_R r_sep R (r_fact R phi) Q`. */ PROOF extern thm R_FACT_INTRO; - -/* `(phi ==> P ⊢_R Q) ==> r_sep R (r_fact R phi) P ⊢_R Q`. */ PROOF extern thm R_FACT_ELIM; - -/* `r_fact R phi ⊢_R r_sep R (r_fact R phi) (r_fact R phi)`. */ PROOF extern thm R_FACT_DUP; -/* ------------------------------------------------------------------------- */ -/* Ownership and adjunction laws */ -/* ------------------------------------------------------------------------- */ - -/* `r_own R (ra_unit R) == r_emp R`. */ +/* Exact ownership. */ PROOF extern thm R_OWN_UNIT; - -/* `r_own R (ra_op R a b) == r_sep R (r_own R a) (r_own R b)`. */ PROOF extern thm R_OWN_OP; - -/* `r_own R a ⊢_R r_and R (r_pure R (ra_valid R a)) (r_own R a)`. */ PROOF extern thm R_OWN_VALID; -/* `r_and R P Q ⊢_R S <=> P ⊢_R r_impl R Q S`. */ -PROOF extern thm R_IMPL_ADJUNCTION; - -/* `r_sep R P Q ⊢_R S <=> P ⊢_R r_wand R Q S`. */ -PROOF extern thm R_WAND_ADJUNCTION; - -/* - * `r_sep R P (r_and R Q S) ⊢_R - * r_and R (r_sep R P Q) (r_sep R P S)`. - */ +/* Sound one-way distribution through additive conjunction. */ PROOF extern thm R_SEP_AND_FORWARD_R; - -/* - * `r_sep R (r_and R Q S) P ⊢_R - * r_and R (r_sep R Q P) (r_sep R S P)`. - * No converse is derivable in general. - */ PROOF extern thm R_SEP_AND_FORWARD_L; diff --git a/theory/logic/resource_prop_internal.h b/theory/logic/resource_prop_internal.h new file mode 100644 index 0000000..3ac6e20 --- /dev/null +++ b/theory/logic/resource_prop_internal.h @@ -0,0 +1,28 @@ +#pragma once + +/* + * Raw assertion-function equalities used by logic implementations and + * adapters. Client proofs should include resource_prop.h and use the public + * validity-sensitive `r_equiv` laws instead. + */ + +#include "proof/theory/logic/resource_prop.h" + +PROOF extern thm R_SEP_COMM_EQ; +PROOF extern thm R_SEP_EMP_L_EQ; +PROOF extern thm R_SEP_EMP_R_EQ; +PROOF extern thm R_SEP_ASSOC_EQ; +PROOF extern thm R_SEP_EXISTS_L_EQ; +PROOF extern thm R_SEP_EXISTS_R_EQ; + +/* Adapter schema derived from the public projection-style R_FORALL_ELIM. */ +PROOF extern thm R_FORALL_ELIM_CONT; + +PROOF extern thm R_FACT_AS_PURE_AND_EMP_EQ; +PROOF extern thm R_FACT_TRUE_EQ; +PROOF extern thm R_FACT_FALSE_EQ; +PROOF extern thm R_FACT_SEP_L_EQ; +PROOF extern thm R_FACT_SEP_R_EQ; + +PROOF extern thm R_OWN_UNIT_EQ; +PROOF extern thm R_OWN_OP_EQ; diff --git a/theory/logic/unit_ra.c b/theory/logic/unit_ra.c index 8d27093..dd56c88 100644 --- a/theory/logic/unit_ra.c +++ b/theory/logic/unit_ra.c @@ -178,7 +178,11 @@ PROOF static thm prove_unit_ra_exclusive(void) { root, once_rewrite_conv(THM_LIST(ra_exclusive_def))); body = GEN_TAC(body, "a"); - body = GEN_TAC(body, "frame"); + gnode_list exclusive = CONJ_TAC(body); + ACCEPT_TAC( + exclusive[0], + ispec_rule(`a:1`, UNIT_RA_VALID)); + body = GEN_TAC(exclusive[1], "frame"); body = DISCH_TAC(body, "Hcompatible"); thm frame_is_one = spec_rule( `frame:1`, @@ -192,71 +196,17 @@ PROOF static thm prove_unit_ra_exclusive(void) { PROOF thm UNIT_RA_EXCLUSIVE = prove_unit_ra_exclusive(); -/* Every two values of the singleton carrier are equal, independently of the - * common frame. The validity and operation-equality premises of generic - * cancellativity are therefore unnecessary after introduction. */ -PROOF static thm prove_unit_ra_cancellative(void) { - term goal_tm = `ra_cancellative unit_ra`; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = CONV_TAC( - root, - once_rewrite_conv(THM_LIST(ra_cancellative_def))); - body = AUTO_INTROS_TAC(body); - thm a_is_one = spec_rule( - `a:1`, - get_theorem_by_name("one")); - thm b_is_one = spec_rule( - `b:1`, - get_theorem_by_name("one")); - ACCEPT_TAC( - body, - trans_rule(a_is_one, gsym_rule(b_is_one))); - return gnode_prove(root); -} - -PROOF thm UNIT_RA_CANCELLATIVE = - prove_unit_ra_cancellative(); - -/* All deterministic singleton updates are reflexive up to carrier equality. */ -PROOF static thm prove_unit_ra_update(void) { - term goal_tm = ` - forall a b:1. ra_update unit_ra a b - `; - gnode root = gnode_new_with_ccl(goal_tm); - gnode body = AUTO_INTROS_TAC(root); - thm a_is_one = spec_rule( - `a:1`, - get_theorem_by_name("one")); - thm b_is_one = spec_rule( - `b:1`, - get_theorem_by_name("one")); - thm equal = trans_rule(a_is_one, gsym_rule(b_is_one)); - thm result = ispecl_rule( - TERM_LIST(`unit_ra`, `a:1`), - RA_UPDATE_REFL); - ACCEPT_TAC( - body, - eq_mp_rule( - beta_rule(ap_term_rule( - `\target:1. ra_update unit_ra (a:1) target`, - equal)), - result)); - return gnode_prove(root); -} - -PROOF thm UNIT_RA_UPDATE = prove_unit_ra_update(); - -/* ND update has exactly one possible result, namely `one`. */ -PROOF static thm prove_unit_ra_update_nd_iff(void) { +/* Predicate update has exactly one possible result, namely `one`. */ +PROOF static thm prove_unit_ra_updateP_iff(void) { term goal_tm = ` forall (a:1) (P:1->bool). - ra_update_nd unit_ra a P <=> P one + ra_updateP unit_ra a P <=> P one `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(ra_update_nd_def))); + once_rewrite_conv(THM_LIST(ra_updateP_def))); gnode_list directions = EQ_TAC(body); gnode forward = DISCH_TAC(directions[0], "Hupdate"); @@ -303,14 +253,14 @@ PROOF static thm prove_unit_ra_update_nd_iff(void) { return gnode_prove(root); } -PROOF thm UNIT_RA_UPDATE_ND_IFF = - prove_unit_ra_update_nd_iff(); +PROOF thm UNIT_RA_UPDATEP_IFF = + prove_unit_ra_updateP_iff(); /* Local-update obligations normalize completely in the singleton carrier. */ PROOF static thm prove_unit_ra_local_update(void) { term goal_tm = ` - forall source target:1#1. - ra_local_update unit_ra source target + forall a f b g:1. + ra_local_update unit_ra a f b g `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( @@ -320,12 +270,12 @@ PROOF static thm prove_unit_ra_local_update(void) { gnode_list result = CONJ_TAC(body); ACCEPT_TAC( result[0], - ispec_rule(`FST (target:1#1)`, UNIT_RA_VALID)); + ispec_rule(`b:1`, UNIT_RA_VALID)); thm target_is_one = spec_rule( - `FST (target:1#1)`, + `b:1`, get_theorem_by_name("one")); thm extension_is_one = ispecl_rule( - TERM_LIST(`SND (target:1#1)`, `frame:1`), + TERM_LIST(`g:1`, `residual:1`), UNIT_RA_OP); ACCEPT_TAC( result[1], @@ -349,9 +299,7 @@ PROOF static int audit_unit_ra(void) { UNIT_RA_VALID, UNIT_RA_INCLUDED, UNIT_RA_EXCLUSIVE, - UNIT_RA_CANCELLATIVE, - UNIT_RA_UPDATE, - UNIT_RA_UPDATE_ND_IFF, + UNIT_RA_UPDATEP_IFF, UNIT_RA_LOCAL_UPDATE); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { diff --git a/theory/logic/unit_ra.h b/theory/logic/unit_ra.h index 3a27805..d5ac9d5 100644 --- a/theory/logic/unit_ra.h +++ b/theory/logic/unit_ra.h @@ -1,101 +1,26 @@ #pragma once -/* - * `unit_ra:(1)ra` is the resource algebra over HOL Light's singleton type - * `1`: carrier `1`, unit `one`, operation `\a b. one`, and validity - * `\a. T`. - * - * This is the complete client interface. The raw operation, raw validity - * predicate, construction laws, and `ra_abs` projection equations are - * intentionally private to `unit_ra.c`. - */ +/* Singleton resource algebra. This is the complete v2 client interface. */ #include "proof/theory/logic/local_update.h" -/* ------------------------------------------------------------------------- */ -/* Core representation */ -/* ------------------------------------------------------------------------- */ - /* `ra_unit unit_ra == (one:1)`. */ PROOF extern thm UNIT_RA_UNIT; /* `forall a b:1. ra_op unit_ra a b == one`. */ PROOF extern thm UNIT_RA_OP; -/* ------------------------------------------------------------------------- */ -/* Validity */ -/* ------------------------------------------------------------------------- */ - /* `forall a:1. ra_valid unit_ra a`. */ PROOF extern thm UNIT_RA_VALID; -/* ------------------------------------------------------------------------- */ -/* Order */ -/* ------------------------------------------------------------------------- */ - -/* - * Every singleton value includes every other singleton value: - * - * forall a b:1. ra_included unit_ra a b - * - * This is stronger than generic reflexivity only syntactically: every value - * of the carrier is equal to `one`. - */ +/* `forall a b:1. ra_included unit_ra a b`. */ PROOF extern thm UNIT_RA_INCLUDED; -/* ------------------------------------------------------------------------- */ -/* Exclusive elements */ -/* ------------------------------------------------------------------------- */ - -/* - * Every singleton resource is exclusive: - * `forall a:1. ra_exclusive unit_ra a`. - */ +/* `forall a:1. ra_exclusive unit_ra a`. */ PROOF extern thm UNIT_RA_EXCLUSIVE; -/* ------------------------------------------------------------------------- */ -/* Laws */ -/* ------------------------------------------------------------------------- */ - -/* - * No unit-specific domain theorem is needed: all carrier values are equal to - * `one`, and the generic laws from `ra.h` apply directly. - */ - -/* ------------------------------------------------------------------------- */ -/* Laws: optional algebraic properties */ -/* ------------------------------------------------------------------------- */ - -/* Singleton composition is cancellative: `ra_cancellative unit_ra`. */ -PROOF extern thm UNIT_RA_CANCELLATIVE; - -/* ------------------------------------------------------------------------- */ -/* Updates */ -/* ------------------------------------------------------------------------- */ - -/* - * Every deterministic update is possible: - * - * forall a b:1. ra_update unit_ra a b - */ -PROOF extern thm UNIT_RA_UPDATE; - -/* - * An ND update is possible exactly when its predicate contains the unique - * result: - * - * forall (a:1) (P:1->bool). - * ra_update_nd unit_ra a P <=> P one - */ -PROOF extern thm UNIT_RA_UPDATE_ND_IFF; +/* `forall (a:1) (P:1->bool). ra_updateP unit_ra a P <=> P one`. */ +PROOF extern thm UNIT_RA_UPDATEP_IFF; -/* - * Every local update between singleton pairs is possible: - * - * forall source target:1#1. - * ra_local_update unit_ra source target - * - * Both pairs are necessarily the same pair `(one,one)`, so this is the - * generic reflexive local update after singleton elimination. - */ +/* `forall a f b g:1. ra_local_update unit_ra a f b g`. */ PROOF extern thm UNIT_RA_LOCAL_UPDATE; -- Gitee From 00718b6f7b36a40cf42ec53cead03982c29e601b Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Mon, 10 Aug 2026 18:02:41 +0800 Subject: [PATCH 30/35] refactor: use lowercase RA theorem handles --- adapter/ra_sl.c | 60 +-- adapter/ra_sl.h | 38 +- adapter/ra_sl_scope.h | 24 +- adapter/ra_sl_scope_internal.h | 29 +- docs/LITHIUM_AUTOMATION.md | 2 +- docs/RA_SL_THEORY_SUMMARY.md | 158 +++--- test/auth_ra_regression.c | 40 +- test/auth_ra_structure_regression.c | 56 +- test/basic_ra_constructors_regression.c | 132 ++--- test/c_resource_v2_regression.c | 24 +- test/dependency_v2_regression.sh | 29 +- test/gmap_ra_regression.c | 40 +- test/named_ra_regression.c | 52 +- test/ra_core_regression.c | 76 +-- test/sl_v2_regression.c | 16 +- test/value_ra_constructors_regression.c | 156 +++--- theory/c_program_logic/c_basic_update.c | 8 +- theory/c_program_logic/c_basic_update.h | 29 +- theory/c_program_logic/c_fnspec.h | 15 +- theory/c_program_logic/c_ghost.c | 108 ++-- theory/c_program_logic/c_ghost.h | 59 ++- theory/c_program_logic/c_integer.c | 6 +- theory/c_program_logic/c_integer.h | 2 +- theory/c_program_logic/c_memory.c | 100 ++-- theory/c_program_logic/c_memory.h | 123 +++-- theory/c_program_logic/c_resource.c | 18 +- theory/c_program_logic/c_resource.h | 47 +- theory/c_program_logic/mem_own.h | 10 +- theory/c_program_logic/mem_ra.c | 66 +-- theory/c_program_logic/mem_ra.h | 28 +- theory/c_program_logic/mem_value.c | 138 ++--- theory/c_program_logic/mem_value.h | 101 ++-- theory/logic/agree_ra.c | 210 ++++---- theory/logic/agree_ra.h | 68 ++- theory/logic/auth_ra.c | 518 +++++++++--------- theory/logic/auth_ra.h | 134 ++++- theory/logic/basic_update.c | 122 ++--- theory/logic/basic_update.h | 55 +- theory/logic/big_sep.c | 120 ++--- theory/logic/big_sep.h | 46 +- theory/logic/excl_ra.c | 226 ++++---- theory/logic/excl_ra.h | 61 ++- theory/logic/excl_ra_internal.h | 52 +- theory/logic/finmap.c | 362 ++++++------- theory/logic/finmap.h | 90 ++-- theory/logic/frac_ra.c | 374 ++++++------- theory/logic/frac_ra.h | 30 +- theory/logic/gmap_ra.c | 634 +++++++++++------------ theory/logic/gmap_ra.h | 93 ++-- theory/logic/gmap_ra_internal.h | 22 +- theory/logic/local_update.c | 78 +-- theory/logic/local_update.h | 61 ++- theory/logic/max_nat_ra.c | 174 +++---- theory/logic/max_nat_ra.h | 28 +- theory/logic/named_logic.c | 58 +-- theory/logic/named_logic.h | 12 +- theory/logic/named_ra.c | 50 +- theory/logic/named_ra.h | 54 +- theory/logic/option_ra.c | 268 +++++----- theory/logic/option_ra.h | 74 ++- theory/logic/option_ra_internal.h | 14 +- theory/logic/prod_ra.c | 374 ++++++------- theory/logic/prod_ra.h | 83 ++- theory/logic/prod_ra_internal.h | 14 +- theory/logic/product_resource.c | 232 ++++----- theory/logic/product_resource.h | 73 ++- theory/logic/product_resource_internal.h | 21 +- theory/logic/ra.c | 374 ++++++------- theory/logic/ra.h | 185 +++++-- theory/logic/ra_builder.h | 45 +- theory/logic/ra_internal.h | 63 ++- theory/logic/resource_prop.c | 372 ++++++------- theory/logic/resource_prop.h | 158 +++--- theory/logic/resource_prop_internal.h | 50 +- theory/logic/unit_ra.c | 70 +-- theory/logic/unit_ra.h | 27 +- 76 files changed, 4431 insertions(+), 3588 deletions(-) diff --git a/adapter/ra_sl.c b/adapter/ra_sl.c index 3e69099..3a2b077 100644 --- a/adapter/ra_sl.c +++ b/adapter/ra_sl.c @@ -86,36 +86,36 @@ PROOF int ra_sl_build(const term R, sl_theory *out) { /* The ACU and existential-distribution laws are exact predicate equalities; * logical antisymmetry is deliberately installed as `r_equiv` instead. */ - theory.sep_emp_left = ispec_rule(R, R_SEP_EMP_L_EQ); - theory.sep_emp_right = ispec_rule(R, R_SEP_EMP_R_EQ); - theory.sep_assoc = ispec_rule(R, R_SEP_ASSOC_EQ); - theory.sep_comm = ispec_rule(R, R_SEP_COMM_EQ); - theory.sep_mono = ispec_rule(R, R_SEP_MONO); - theory.wand_sep_adjoint = ispec_rule(R, R_WAND_ADJUNCTION); - - theory.and_intro = ispec_rule(R, R_AND_INTRO); - theory.and_elim1 = ispec_rule(R, R_AND_ELIM_L); - theory.and_elim2 = ispec_rule(R, R_AND_ELIM_R); - theory.or_intro1 = ispec_rule(R, R_OR_INTRO_L); - theory.or_intro2 = ispec_rule(R, R_OR_INTRO_R); - theory.or_elim = ispec_rule(R, R_OR_ELIM); - - theory.exists_intro = ispec_rule(R, R_EXISTS_INTRO); - theory.exists_elim = ispec_rule(R, R_EXISTS_ELIM); - theory.exists_mono = ispec_rule(R, R_EXISTS_MONO); - theory.sep_exists_left = ispec_rule(R, R_SEP_EXISTS_L_EQ); - theory.sep_exists_right = ispec_rule(R, R_SEP_EXISTS_R_EQ); - theory.forall_intro = ispec_rule(R, R_FORALL_INTRO); - theory.forall_elim = ispec_rule(R, R_FORALL_ELIM_CONT); - - theory.ent_refl = ispec_rule(R, R_ENTAILS_REFL); - theory.ent_trans = ispec_rule(R, R_ENTAILS_TRANS); - theory.equiv_intro = ispec_rule(R, R_EQUIV_INTRO); - - theory.fact_intro = ispec_rule(R, R_FACT_INTRO); - theory.fact_elim = ispec_rule(R, R_FACT_ELIM); - theory.fact_dup = ispec_rule(R, R_FACT_DUP); - theory.fact_true_emp = ispec_rule(R, R_FACT_TRUE_EQ); + theory.sep_emp_left = ispec_rule(R, r_sep_emp_l_eq); + theory.sep_emp_right = ispec_rule(R, r_sep_emp_r_eq); + theory.sep_assoc = ispec_rule(R, r_sep_assoc_eq); + theory.sep_comm = ispec_rule(R, r_sep_comm_eq); + theory.sep_mono = ispec_rule(R, r_sep_mono); + theory.wand_sep_adjoint = ispec_rule(R, r_wand_adjunction); + + theory.and_intro = ispec_rule(R, r_and_intro); + theory.and_elim1 = ispec_rule(R, r_and_elim_l); + theory.and_elim2 = ispec_rule(R, r_and_elim_r); + theory.or_intro1 = ispec_rule(R, r_or_intro_l); + theory.or_intro2 = ispec_rule(R, r_or_intro_r); + theory.or_elim = ispec_rule(R, r_or_elim); + + theory.exists_intro = ispec_rule(R, r_exists_intro); + theory.exists_elim = ispec_rule(R, r_exists_elim); + theory.exists_mono = ispec_rule(R, r_exists_mono); + theory.sep_exists_left = ispec_rule(R, r_sep_exists_l_eq); + theory.sep_exists_right = ispec_rule(R, r_sep_exists_r_eq); + theory.forall_intro = ispec_rule(R, r_forall_intro); + theory.forall_elim = ispec_rule(R, r_forall_elim_cont); + + theory.ent_refl = ispec_rule(R, r_entails_refl); + theory.ent_trans = ispec_rule(R, r_entails_trans); + theory.equiv_intro = ispec_rule(R, r_equiv_intro); + + theory.fact_intro = ispec_rule(R, r_fact_intro); + theory.fact_elim = ispec_rule(R, r_fact_elim); + theory.fact_dup = ispec_rule(R, r_fact_dup); + theory.fact_true_emp = ispec_rule(R, r_fact_true_eq); *out = theory; return 0; diff --git a/adapter/ra_sl.h b/adapter/ra_sl.h index a609de4..4fe20cc 100644 --- a/adapter/ra_sl.h +++ b/adapter/ra_sl.h @@ -1,16 +1,27 @@ /** * @file ra_sl.h - * @brief Build an SL theory from generic resource propositions. + * @brief Adapt generic resource propositions to the installable SL signature. * - * `ra_sl_build R` specializes `r_emp`, `r_sep`, `r_wand`, the - * additive connectives, entailment, equivalence, facts, and their primitive - * laws at one closed monomorphic resource algebra `R:(A)ra`. Assertions in - * the resulting model consequently have type `A->bool`. + * For a closed monomorphic algebra `R:(A)ra`, `ra_sl_build` specializes the + * language-independent BI operators at `R`; the resulting assertion type is + * `A->bool`. Entailment and logical equivalence observe valid resources. * - * This adapter constructs only the language-independent BI assertion theory. - * It contains no basic-update modality, C memory semantics, symbolic-state - * storage, or dependency on the legacy heap-assertion model. Installation and - * parser activation belong to the concrete assertion-model adapter. + * The underlying theory intentionally has two proposition embeddings: + * + * - `r_pure R phi a <=> phi` is independent of the owned resource; + * - `r_fact R phi a <=> phi /\ a = ra_unit R` is exact-unit and spatial. + * + * `sl_theory` exposes the latter as its `fact` operator. A selected alias scope + * adds `pure` separately; see `ra_sl_scope.h`. + * + * Public resource-proposition laws state connective algebra through `r_equiv`. + * The generic proof engine additionally needs a few exact predicate equalities + * for certified SEP normalization. This adapter is the boundary that selects + * those private equalities; clients should not depend on them directly. + * + * This module constructs only the base BI signature. It does not install it, + * select parser notation, add update modalities, or provide C memory and + * symbolic-state semantics. */ #pragma once @@ -21,9 +32,12 @@ /** * Build the generic resource-proposition proof bundle specialized at `R`. * - * `R` must be a closed monomorphic unary RA term. The returned operators are - * the direct applications `r_emp R`, `r_sep R`, ... and the primitive rules - * use those same heads. This function does not mutate the active SL theory. + * `R` must be a nonempty, closed, monomorphic term whose type is exactly a + * unary RA application `(A)ra`. The returned operators are the direct + * applications `r_emp R`, `r_sep R`, and so on, and every theorem in the + * bundle uses those same heads. This function does not mutate the active SL + * theory or any parser interface. + * * `out` must be non-null and remains owned by the caller; its term and theorem * handles refer to prover-global immutable HOL objects. * diff --git a/adapter/ra_sl_scope.h b/adapter/ra_sl_scope.h index d8bff81..a424964 100644 --- a/adapter/ra_sl_scope.h +++ b/adapter/ra_sl_scope.h @@ -1,6 +1,11 @@ /** * @file ra_sl_scope.h - * @brief Stable closed SL aliases for one selected resource algebra. + * @brief Closed, stable aliases for one selected resource algebra. + * + * A scope gives polymorphic resource-proposition operators fixed HOL constant + * heads suitable for a parser, theorem registry, and runtime descriptor. Scope + * construction and activation are installer internals; this header exposes + * only the immutable result shared with a concrete logic installer. */ #pragma once @@ -10,13 +15,24 @@ /** * Conservative alias layer over one specialized resource proposition theory. - * Each definition has shape `alias = direct_operator`; primitive rules in - * `theory` have already been folded to the alias heads. + * + * Each definition has shape `alias = direct_operator`. The terms and theorem + * handles in `theory` use the alias heads already, so clients never need to + * unfold the definitions merely to use a proof rule. + * + * `theory.fact` is the exact-unit embedding: `fact(phi)` owns only the RA unit. + * `pure` is kept separate because `pure(phi)` is true at every resource when + * `phi` holds. Conflating these operators would make linear ownership + * silently discardable. */ PROOF typedef struct { + /** Alias-backed BI signature and its folded primitive laws. */ sl_theory theory; + + /** Resource-independent `r_pure` alias; not part of `sl_theory`. */ term pure; + /* Conservative definitions for the operators in `theory`. */ thm emp_def; thm sep_def; thm wand_def; @@ -27,5 +43,7 @@ PROOF typedef struct { thm entails_def; thm equiv_def; thm fact_def; + + /** Conservative definition for `pure`. */ thm pure_def; } ra_sl_scope; diff --git a/adapter/ra_sl_scope_internal.h b/adapter/ra_sl_scope_internal.h index 694e00b..cdfaea1 100644 --- a/adapter/ra_sl_scope_internal.h +++ b/adapter/ra_sl_scope_internal.h @@ -2,27 +2,50 @@ * @file ra_sl_scope_internal.h * @brief Internal construction phases for selected-resource installers. * - * These operations let the C logic installer construct and validate all - * aliases and extra modalities before it crosses runtime/parser commit - * boundaries. They are not a standalone public installation API. + * These operations let a concrete logic installer prepare and validate all + * aliases before crossing runtime or parser commit boundaries. HOL constant + * definitions and parser mutations are process-global and cannot be rolled + * back, so callers must treat a later error as initialization fail-stop. + * + * This is not a standalone public installation API. In particular, preparing + * a scope does not install its base theory, and installing the theory does not + * activate its parser notation. */ #pragma once #include "proof/adapter/ra_sl_scope.h" +/** Return whether `scope_name` is a nonempty ASCII `[A-Za-z0-9_]` string. */ PROOF bool sl_scope_name_is_valid(const char* scope_name); +/** + * Define `cstar_sl____ = direct`. + * + * `direct` must be closed and both output pointers must be non-null. On + * success, `alias` is the newly selected constant head and `alias_def` is its + * conservative definition. Defining the HOL constant is nontransactional. + */ PROOF int sl_define_scope_alias(const char* scope_name, const char* suffix, const term direct, term* alias, thm* alias_def); +/** Build all base BI aliases and folded laws without installing them. */ PROOF int ra_sl_scope_prepare(const char* scope_name, const term R, ra_sl_scope* out); +/** Rewrite one direct resource-proposition theorem to `scope`'s alias heads. */ PROOF thm ra_sl_scope_fold(const ra_sl_scope* scope, const thm direct_rule); +/** Install `scope->theory` as the active base SL signature. */ PROOF int ra_sl_scope_install(const ra_sl_scope* scope); +/** + * Activate notation for an already-installed matching scope. + * + * This verifies that `scope->theory` is active before mutating parser and + * interface state. It installs distinct source spellings for logical + * equivalence (`-||-`) and raw assertion equality (`-|-`). + */ PROOF int ra_sl_scope_activate(const ra_sl_scope* scope); diff --git a/docs/LITHIUM_AUTOMATION.md b/docs/LITHIUM_AUTOMATION.md index 421ae50..9feaede 100644 --- a/docs/LITHIUM_AUTOMATION.md +++ b/docs/LITHIUM_AUTOMATION.md @@ -167,7 +167,7 @@ non-monotone predicates `A -> bool`, so the pointwise definition laws. The adapter therefore maps Lithium-style pure side conditions to `r_fact`, -using `R_FACT_INTRO`, `R_FACT_ELIM`, `R_FACT_DUP`, and the fact/separation laws. +using `r_fact_intro`, `r_fact_elim`, `r_fact_dup`, and the fact/separation laws. Treating `r_pure` as an interchangeable zero-resource fact would be unsound. ### Persistence and modalities diff --git a/docs/RA_SL_THEORY_SUMMARY.md b/docs/RA_SL_THEORY_SUMMARY.md index b24f6ec..76f3744 100644 --- a/docs/RA_SL_THEORY_SUMMARY.md +++ b/docs/RA_SL_THEORY_SUMMARY.md @@ -29,8 +29,9 @@ v2 固定以下边界： 暗中加入的一层； - 释放当前 fragment 的操作统一称为 `drop`；它不声称隐藏 frame 中不存在同名 资源； -- theorem handles 保持现有命名风格：定义定理使用实际的小写标识符，其余公开 - 定理继续使用大写标识符； +- theorem handles 统一使用 `lower_snake_case`；若名称嵌入了本理论中原本带 + 大写字母的 object-language constant，则保留该 constant 的拼写，例如 + `ra_updateP_refl` 与 `pmem_c_address_ok_Tuint64`； - big separation 继续由同一个 `big_sep.{h,c}` 模块提供，不拆文件或子模块。 核心依赖关系如下： @@ -80,11 +81,11 @@ ra_laws e op valid <=> ``` `(A)ra` 是只收纳 lawful descriptor 的 abstract HOL type。普通 client 使用 -`RA_LAWS`、`RA_ASSOC`、`RA_COMM`、`RA_UNIT_L`、`RA_UNIT_R`、 -`RA_VALID_UNIT` 和 `RA_VALID_OP`，无需重复携带 laws premise。只有 constructor -author 需要 `ra_builder.h` 中的 `ra_laws_def`、`RA_TYPE_BIJECTION`、 -`RA_REP_LAWS`、`RA_ABS_REP`、`RA_UNIT_ABS`、`RA_OP_ABS`、`RA_VALID_ABS` -与 `RA_ABS_ETA`。 +`ra_laws`、`ra_assoc`、`ra_comm`、`ra_unit_l`、`ra_unit_r`、 +`ra_valid_unit` 和 `ra_valid_op`，无需重复携带 laws premise。只有 constructor +author 需要 `ra_builder.h` 中的 `ra_laws_def`、`ra_type_bijection`、 +`ra_rep_laws`、`ra_abs_rep`、`ra_unit_abs`、`ra_op_abs`、`ra_valid_abs` +与 `ra_abs_eta`。 ### 2.1 核心关系 @@ -111,17 +112,17 @@ ra_update R a b <=> 公开更新定理分为两组： -- predicate update：`RA_UPDATEP_SINGLETON`、`RA_UPDATEP_REFL`、 - `RA_UPDATEP_MONO`、`RA_UPDATEP_TRANS`、`RA_UPDATEP_VALID`、 - `RA_UPDATEP_FRAME`、`RA_UPDATEP_OP`； -- deterministic update：`RA_UPDATE_REFL`、`RA_UPDATE_TRANS`、 - `RA_UPDATE_FRAME`、`RA_UPDATE_OP`、`RA_UPDATE_INCLUDED`、 - `RA_UPDATE_TARGET_INCLUDED`、`RA_UPDATE_VALID`。 +- predicate update：`ra_updateP_singleton`、`ra_updateP_refl`、 + `ra_updateP_mono`、`ra_updateP_trans`、`ra_updateP_valid`、 + `ra_updateP_frame`、`ra_updateP_op`； +- deterministic update：`ra_update_refl`、`ra_update_trans`、 + `ra_update_frame`、`ra_update_op`、`ra_update_included`、 + `ra_update_target_included`、`ra_update_valid`。 包含关系是 extension preorder，不承诺反对称。公开规则为 -`RA_INCLUDED_REFL`、`RA_INCLUDED_UNIT`、`RA_INCLUDED_OP_L`、 -`RA_INCLUDED_OP_R`、`RA_INCLUDED_TRANS`、`RA_INCLUDED_OP_MONO`、 -`RA_INCLUDED_VALID`。兼容性公开 `RA_COMPAT_COMM` 和 `RA_COMPAT_UNIT`。 +`ra_included_refl`、`ra_included_unit`、`ra_included_op_l`、 +`ra_included_op_r`、`ra_included_trans`、`ra_included_op_mono`、 +`ra_included_valid`。兼容性公开 `ra_compat_comm` 和 `ra_compat_unit`。 ### 2.2 cancellative 与 exclusive @@ -140,8 +141,8 @@ ra_exclusive R a <=> ``` 因此 `ra_exclusive R a` 本身就能推出 `ra_valid R a`。公开使用 -`RA_EXCLUSIVE_INCLUDED`、`RA_EXCLUSIVE_UPDATE` 与 -`RA_CANCELLATIVE_APPLY`；invalid-source 的真空特例不属于稳定 client API。 +`ra_exclusive_included`、`ra_exclusive_update` 与 +`ra_cancellative_apply`；invalid-source 的真空特例不属于稳定 client API。 ### 2.3 五参数 local update @@ -161,15 +162,15 @@ ra_local_update R a f b g <=> product 中。公开规则为： ```text -RA_LOCAL_UPDATE_APPLY -RA_LOCAL_UPDATE_REFL -RA_LOCAL_UPDATE_TRANS -RA_LOCAL_UPDATE_FRAME -RA_LOCAL_UPDATE_PRESERVES_INCLUDED -RA_LOCAL_UPDATE_ALLOC -RA_LOCAL_UPDATE_EXCLUSIVE -RA_LOCAL_UPDATE_CANCEL -RA_LOCAL_UPDATE_CANCELLATIVE +ra_local_update_apply +ra_local_update_refl +ra_local_update_trans +ra_local_update_frame +ra_local_update_preserves_included +ra_local_update_alloc +ra_local_update_exclusive +ra_local_update_cancel +ra_local_update_cancellative ``` ## 3. RA 构造子 @@ -194,18 +195,18 @@ prod_inl R S a == (a, ra_unit S) prod_inr R S b == (ra_unit R, b) ``` -`PROD_INL_OP`/`PROD_INR_OP` 保持 operation； -`PROD_INL_UPDATEP`/`PROD_INR_UPDATEP` 和 -`PROD_INL_UPDATE`/`PROD_INR_UPDATE` 把分量更新提升到完整产品。它们用于用 +`prod_inl_op`/`prod_inr_op` 保持 operation； +`prod_inl_updateP`/`prod_inr_updateP` 和 +`prod_inl_update`/`prod_inr_update` 把分量更新提升到完整产品。它们用于用 普通嵌套 product 组合多个 global ghost protocol，无需异构 registry。 ### 3.2 finite map 与 naming `gmap_ra R` 对每个 key 通过 `option_ra R` 逐点解释，finite-map representation -和 support 细节保持私有。client 通过 `GMAP_RA_OP_LOOKUP`、`GMAP_RA_VALID`、 -`GMAP_RA_VALID_LOOKUP`、`GMAP_RA_INCLUDED_LOOKUP_IFF`、 -`GMAP_RA_DECOMPOSE`、`GMAP_RA_LOCAL_UPDATE_AT`、`GMAP_RA_UPDATE_AT`、 -`GMAP_RA_UPDATEP_AT`、`GMAP_RA_DROP_AT` 与 allocation rules 操作它。 +和 support 细节保持私有。client 通过 `gmap_ra_op_lookup`、`gmap_ra_valid`、 +`gmap_ra_valid_lookup`、`gmap_ra_included_lookup_iff`、 +`gmap_ra_decompose`、`gmap_ra_local_update_at`、`gmap_ra_update_at`、 +`gmap_ra_updateP_at`、`gmap_ra_drop_at` 与 allocation rules 操作它。 numeric naming 是一个显式薄层： @@ -217,16 +218,16 @@ named_ra R == (gmap_ra R : ((num,A)finmap)ra) ```text named_ra_def -NAMED_RA_UNIT -NAMED_RA_SINGLETON_OP -NAMED_RA_VALID_SINGLETON -NAMED_RA_UPDATE_SINGLETON -NAMED_RA_UPDATEP_SINGLETON -NAMED_RA_DROP -NAMED_RA_ALLOC +named_ra_unit +named_ra_singleton_op +named_ra_valid_singleton +named_ra_update_singleton +named_ra_updateP_singleton +named_ra_drop +named_ra_alloc ``` -`DROP` 只表示将当前持有的 singleton fragment 更新到 unit；它不证明同名 key +`drop` 只表示将当前持有的 singleton fragment 更新到 unit；它不证明同名 key 未出现在未知 frame 中。fresh allocation 由 finite support 与无限 `num` key space 保证。 @@ -275,8 +276,8 @@ r_wand R P Q resource <=> 此外提供 `r_top`、`r_bottom`、`r_and`、`r_or`、`r_impl`、`r_exists`、 `r_forall`。这是 linear 逻辑：没有一般的资源 weakening 或 contraction。 -`R_SEP_ASSOC`、`R_SEP_COMM`、`R_SEP_EMP_L`、`R_SEP_EMP_R`、 -`R_SEP_EXISTS_L`、`R_SEP_EXISTS_R` 的结论都是 `r_equiv`。 +`r_sep_assoc`、`r_sep_comm`、`r_sep_emp_l`、`r_sep_emp_r`、 +`r_sep_exists_l`、`r_sep_exists_r` 的结论都是 `r_equiv`。 ### 4.3 `r_pure` 与 `r_fact` 必须区分 @@ -307,13 +308,13 @@ r_fact R condition ** exact ownership 而不是用一个资源无关 proposition 偷偷消费或制造空间资源。相关公开规则是： ```text -R_PURE_AND_INTRO R_PURE_AND_ELIM -R_FACT_AS_PURE_AND_EMP R_FACT_TRUE -R_FACT_FALSE R_FACT_SEP_L -R_FACT_SEP_R R_FACT_INTRO -R_FACT_ELIM R_FACT_DUP -R_OWN_UNIT R_OWN_OP -R_OWN_VALID +r_pure_and_intro r_pure_and_elim +r_fact_as_pure_and_emp r_fact_true +r_fact_false r_fact_sep_l +r_fact_sep_r r_fact_intro +r_fact_elim r_fact_dup +r_own_unit r_own_op +r_own_valid ``` ## 5. Basic update 与 view shift @@ -331,8 +332,8 @@ r_viewshift R P Q <=> ``` generic modality 可以更新完整的 `R`。公开组合律包括 intro、mono、idem、frame、 -viewshift refl/trans/mono/frame/sep/exists，以及 `R_OWN_UPDATE` 和 -`R_OWN_UPDATEP`。其中 predicate-update ownership rule 的后置条件显式给出 +viewshift refl/trans/mono/frame/sep/exists，以及 `r_own_update` 和 +`r_own_updateP`。其中 predicate-update ownership rule 的后置条件显式给出 witness、`r_fact R (P witness)` 与 exact ownership。 ### 5.2 产品 assertion lift 与右分量 update @@ -364,8 +365,8 @@ r_viewshift_right R S P Q <=> ``` 结果始终复用源的 `FST resource`，只有 `SND` 可以变化。公开 API 提供 -`R_BUPD_RIGHT_*`、`R_VIEWSHIFT_RIGHT_*`、`R_RIGHT_OWN_UPDATE` 和 -`R_RIGHT_OWN_UPDATEP`，用于 C 层以及其他需要固定左投影的产品逻辑。 +`r_bupd_right_*`、`r_viewshift_right_*`、`r_right_own_update` 和 +`r_right_own_updateP`，用于 C 层以及其他需要固定左投影的产品逻辑。 ## 6. Big separation @@ -384,14 +385,14 @@ r_big_sep_list R Phi (x::xs) = ```text r_big_sep_list_def -R_BIG_SEP_LIST_NIL -R_BIG_SEP_LIST_CONS -R_BIG_SEP_LIST_SINGLETON -R_BIG_SEP_LIST_APPEND -R_BIG_SEP_LIST_MONO -R_BIG_SEP_LIST_EQUIV -R_BIG_SEP_LIST_MAP -R_BIG_SEP_LIST_SEP +r_big_sep_list_nil +r_big_sep_list_cons +r_big_sep_list_singleton +r_big_sep_list_append +r_big_sep_list_mono +r_big_sep_list_equiv +r_big_sep_list_map +r_big_sep_list_sep ``` set/map/indexed binder 不进入稳定核心 surface；这不意味着拆分现有 big-sep @@ -406,12 +407,12 @@ named_own R name a = r_own (named_ra R) (finmap_singleton name a) ``` -公开规则为 `NAMED_OWN_OP`、`NAMED_OWN_VALID`、`NAMED_OWN_UPDATE`、 -`NAMED_OWN_UPDATEP`、`NAMED_OWN_DROP`、`NAMED_OWN_ALLOC`。其中： +公开规则为 `named_own_op`、`named_own_valid`、`named_own_update`、 +`named_own_updateP`、`named_own_drop`、`named_own_alloc`。其中： -- `NAMED_OWN_OP` 的结论是 `r_equiv`； -- `NAMED_OWN_VALID` 把 payload validity 放入 exact-unit `r_fact`； -- `NAMED_OWN_UPDATEP` 的后置条件是 witness、`r_fact` 与更新后的 exact +- `named_own_op` 的结论是 `r_equiv`； +- `named_own_valid` 把 payload validity 放入 exact-unit `r_fact`； +- `named_own_updateP` 的后置条件是 witness、`r_fact` 与更新后的 exact ownership； - allocation 返回 fresh numeric name；drop 只丢弃当前 fragment。 @@ -478,23 +479,23 @@ c_bupd G = r_bupd_right mem_ra G c_viewshift G = r_viewshift_right mem_ra G ``` -`C_BUPD_PRESERVES_PHYS` 明确证明所有 observable result 的 physical projection +`c_bupd_preserves_phys` 明确证明所有 observable result 的 physical projection 与 source 相同。这是 generic update 和 C program-level update 之间不可越过的 安全边界。 [`c_ghost.h`](../theory/c_program_logic/c_ghost.h) 为任意 complete `G` 公开： ```text -C_GHOST_OWN_OP -C_GHOST_OWN_VALID -C_GHOST_OWN_UPDATE -C_GHOST_OWN_UPDATEP -C_GHOST_OWN_DROP +c_ghost_own_op +c_ghost_own_valid +c_ghost_own_update +c_ghost_own_updateP +c_ghost_own_drop ``` 当 complete global RA 恰为 `named_ra R` 时，`c_named_own` 提供 convenience -层，并公开 `C_NAMED_OWN_OP`、`C_NAMED_OWN_VALID`、`C_NAMED_OWN_UPDATE`、 -`C_NAMED_OWN_UPDATEP`、`C_NAMED_OWN_DROP`、`C_NAMED_OWN_ALLOC`。这只是显式 +层，并公开 `c_named_own_op`、`c_named_own_valid`、`c_named_own_update`、 +`c_named_own_updateP`、`c_named_own_drop`、`c_named_own_alloc`。这只是显式 specialization，不改变 `c_resource_ra` 的定义。 ## 9. Adapter 与安装边界 @@ -509,7 +510,7 @@ naming 时，它显式选择 `named_ra R`。安装过程不依赖历史接口的 adapter 为满足 runtime theorem schema 可能使用 internal raw-equality theorem； 这不会扩大 public logical API。client-facing 推理仍通过 `r_entails`、`r_equiv` -和对应 uppercase theorem handles。 +和对应的 lowercase theorem handles。 ## 10. 稳定 API 与实现私有 API @@ -556,4 +557,5 @@ public laws。 - C update 不能改变 physical projection； - C resource 不隐式增加 naming layer； - big-sep 仍是单一 `big_sep.{h,c}` 模块； -- theorem handle 的既有大小写风格保持不变。 +- theorem handles 使用 `lower_snake_case`，并仅保留嵌入 constant 原名中的 + mixed-case 片段（当前包括 `updateP`、`Tuint64`、`leftP`、`rightP`）。 diff --git a/test/auth_ra_regression.c b/test/auth_ra_regression.c index 8846144..3756ff3 100644 --- a/test/auth_ra_regression.c +++ b/test/auth_ra_regression.c @@ -60,7 +60,7 @@ PROOF static int audit_auth_ra_v2_regressions(void) { check_auth_theorem( ispecl_rule( TERM_LIST(R, a, f, b, g, residual), - RA_LOCAL_UPDATE_APPLY), + ra_local_update_apply), `ra_local_update (excl_ra:((num)excl)ra) (a:(num)excl) @@ -75,19 +75,19 @@ PROOF static int audit_auth_ra_v2_regressions(void) { (residual:(num)excl) ==> ra_valid (excl_ra:((num)excl)ra) b && b == ra_op (excl_ra:((num)excl)ra) g residual`, - "RA_LOCAL_UPDATE_APPLY"); + "ra_local_update_apply"); check_auth_theorem( - ispec_rule(R, AUTH_RA_CANCELLATIVE_IFF), + ispec_rule(R, auth_ra_cancellative_iff), `ra_cancellative (auth_ra (excl_ra:((num)excl)ra)) <=> ra_cancellative (excl_ra:((num)excl)ra)`, - "AUTH_RA_CANCELLATIVE_IFF"); + "auth_ra_cancellative_iff"); check_auth_theorem( ispecl_rule( TERM_LIST(R, a, f, b, g), - AUTH_RA_UPDATE_FRAMEWISE_IFF), + auth_ra_update_framewise_iff), `ra_update (auth_ra (excl_ra:((num)excl)ra)) (auth_both (a:(num)excl) (f:(num)excl)) @@ -103,10 +103,10 @@ PROOF static int audit_auth_ra_v2_regressions(void) { (excl_ra:((num)excl)ra) (ra_op (excl_ra:((num)excl)ra) g external) b`, - "AUTH_RA_UPDATE_FRAMEWISE_IFF"); + "auth_ra_update_framewise_iff"); check_auth_theorem( - ispecl_rule(TERM_LIST(R, a, f, b, g), AUTH_RA_UPDATE_LOCAL), + ispecl_rule(TERM_LIST(R, a, f, b, g), auth_ra_update_local), `ra_local_update (excl_ra:((num)excl)ra) (a:(num)excl) @@ -117,10 +117,10 @@ PROOF static int audit_auth_ra_v2_regressions(void) { (auth_ra (excl_ra:((num)excl)ra)) (auth_both a f) (auth_both b g)`, - "AUTH_RA_UPDATE_LOCAL"); + "auth_ra_update_local"); check_auth_theorem( - ispecl_rule(TERM_LIST(R, a, b), AUTH_RA_UPDATE_AUTH_IFF), + ispecl_rule(TERM_LIST(R, a, b), auth_ra_update_auth_iff), `ra_update (auth_ra (excl_ra:((num)excl)ra)) (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) @@ -128,10 +128,10 @@ PROOF static int audit_auth_ra_v2_regressions(void) { (ra_valid (excl_ra:((num)excl)ra) a ==> ra_valid (excl_ra:((num)excl)ra) b && ra_included (excl_ra:((num)excl)ra) a b)`, - "AUTH_RA_UPDATE_AUTH_IFF"); + "auth_ra_update_auth_iff"); check_auth_theorem( - ispecl_rule(TERM_LIST(R, a, b, g), AUTH_RA_UPDATE_ALLOC), + ispecl_rule(TERM_LIST(R, a, b, g), auth_ra_update_alloc), `ra_local_update (excl_ra:((num)excl)ra) (a:(num)excl) @@ -142,28 +142,28 @@ PROOF static int audit_auth_ra_v2_regressions(void) { (auth_ra (excl_ra:((num)excl)ra)) (auth_auth (excl_ra:((num)excl)ra) a) (auth_both b g)`, - "AUTH_RA_UPDATE_ALLOC"); + "auth_ra_update_alloc"); check_auth_theorem( - ispecl_rule(TERM_LIST(R, a, f), AUTH_RA_UPDATE_DROP_LOCAL), + ispecl_rule(TERM_LIST(R, a, f), auth_ra_update_drop_local), `ra_update (auth_ra (excl_ra:((num)excl)ra)) (auth_both (a:(num)excl) (f:(num)excl)) (auth_auth (excl_ra:((num)excl)ra) a)`, - "AUTH_RA_UPDATE_DROP_LOCAL"); + "auth_ra_update_drop_local"); check_auth_theorem( - ispecl_rule(TERM_LIST(R, a, f), AUTH_RA_UPDATE_DROP_AUTH), + ispecl_rule(TERM_LIST(R, a, f), auth_ra_update_drop_auth), `ra_update (auth_ra (excl_ra:((num)excl)ra)) (auth_both (a:(num)excl) (f:(num)excl)) (auth_frag f)`, - "AUTH_RA_UPDATE_DROP_AUTH"); + "auth_ra_update_drop_auth"); check_auth_theorem( ispecl_rule( TERM_LIST(R, a, f, g), - AUTH_RA_UPDATE_WEAKEN_FRAG), + auth_ra_update_weaken_frag), `ra_included (excl_ra:((num)excl)ra) (g:(num)excl) @@ -172,10 +172,10 @@ PROOF static int audit_auth_ra_v2_regressions(void) { (auth_ra (excl_ra:((num)excl)ra)) (auth_both (a:(num)excl) f) (auth_both a g)`, - "AUTH_RA_UPDATE_WEAKEN_FRAG"); + "auth_ra_update_weaken_frag"); check_auth_theorem( - ispecl_rule(TERM_LIST(R, a, piece), AUTH_RA_ALLOC), + ispecl_rule(TERM_LIST(R, a, piece), auth_ra_alloc), `ra_valid (excl_ra:((num)excl)ra) (ra_op @@ -188,7 +188,7 @@ PROOF static int audit_auth_ra_v2_regressions(void) { (auth_both (ra_op (excl_ra:((num)excl)ra) a piece) piece)`, - "AUTH_RA_ALLOC"); + "auth_ra_alloc"); return 0; err: diff --git a/test/auth_ra_structure_regression.c b/test/auth_ra_structure_regression.c index 3eed6aa..4131b67 100644 --- a/test/auth_ra_structure_regression.c +++ b/test/auth_ra_structure_regression.c @@ -28,32 +28,32 @@ PROOF static int audit_auth_ra_structure_v2(void) { term frame = `frame:((num)excl)excl#(num)excl`; check_auth_structure_theorem( - ispec_rule(R, AUTH_RA_UNIT), + ispec_rule(R, auth_ra_unit), `ra_unit (auth_ra (excl_ra:((num)excl)ra)) == auth_frag (ra_unit (excl_ra:((num)excl)ra))`, - "AUTH_RA_UNIT"); + "auth_ra_unit"); check_auth_structure_theorem( - ispecl_rule(TERM_LIST(R, a, f), AUTH_RA_AUTH_FRAG), + ispecl_rule(TERM_LIST(R, a, f), auth_ra_auth_frag), `ra_op (auth_ra (excl_ra:((num)excl)ra)) (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) (auth_frag (f:(num)excl)) == auth_both a f`, - "AUTH_RA_AUTH_FRAG"); + "auth_ra_auth_frag"); check_auth_structure_theorem( - ispecl_rule(TERM_LIST(R, f, g), AUTH_RA_FRAG_FRAG), + ispecl_rule(TERM_LIST(R, f, g), auth_ra_frag_frag), `ra_op (auth_ra (excl_ra:((num)excl)ra)) (auth_frag (f:(num)excl)) (auth_frag (g:(num)excl)) == auth_frag (ra_op (excl_ra:((num)excl)ra) f g)`, - "AUTH_RA_FRAG_FRAG"); + "auth_ra_frag_frag"); check_auth_structure_theorem( - ispecl_rule(TERM_LIST(R, a, f, g), AUTH_RA_BOTH_FRAG), + ispecl_rule(TERM_LIST(R, a, f, g), auth_ra_both_frag), `ra_op (auth_ra (excl_ra:((num)excl)ra)) (auth_both (a:(num)excl) (f:(num)excl)) @@ -61,37 +61,37 @@ PROOF static int audit_auth_ra_structure_v2(void) { auth_both a (ra_op (excl_ra:((num)excl)ra) f g)`, - "AUTH_RA_BOTH_FRAG"); + "auth_ra_both_frag"); check_auth_structure_theorem( - ispecl_rule(TERM_LIST(R, f), AUTH_RA_VALID_FRAG), + ispecl_rule(TERM_LIST(R, f), auth_ra_valid_frag), `ra_valid (auth_ra (excl_ra:((num)excl)ra)) (auth_frag (f:(num)excl)) <=> ra_valid (excl_ra:((num)excl)ra) f`, - "AUTH_RA_VALID_FRAG"); + "auth_ra_valid_frag"); check_auth_structure_theorem( - ispecl_rule(TERM_LIST(R, a, f), AUTH_RA_VALID_BOTH), + ispecl_rule(TERM_LIST(R, a, f), auth_ra_valid_both), `ra_valid (auth_ra (excl_ra:((num)excl)ra)) (auth_both (a:(num)excl) (f:(num)excl)) <=> ra_valid (excl_ra:((num)excl)ra) a && ra_included (excl_ra:((num)excl)ra) f a`, - "AUTH_RA_VALID_BOTH"); + "auth_ra_valid_both"); check_auth_structure_theorem( - ispecl_rule(TERM_LIST(R, a), AUTH_RA_VALID_AUTH), + ispecl_rule(TERM_LIST(R, a), auth_ra_valid_auth), `ra_valid (auth_ra (excl_ra:((num)excl)ra)) (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) <=> ra_valid (excl_ra:((num)excl)ra) a`, - "AUTH_RA_VALID_AUTH"); + "auth_ra_valid_auth"); check_auth_structure_theorem( ispecl_rule( TERM_LIST(R, a, f, frame), - AUTH_RA_VALID_BOTH_FRAME), + auth_ra_valid_both_frame), `ra_valid (auth_ra (excl_ra:((num)excl)ra)) (ra_op @@ -105,69 +105,69 @@ PROOF static int audit_auth_ra_structure_v2(void) { (excl_ra:((num)excl)ra) (ra_op (excl_ra:((num)excl)ra) f external) a`, - "AUTH_RA_VALID_BOTH_FRAME"); + "auth_ra_valid_both_frame"); check_auth_structure_theorem( - ispecl_rule(TERM_LIST(R, a, b), AUTH_RA_AUTH_CONFLICT), + ispecl_rule(TERM_LIST(R, a, b), auth_ra_auth_conflict), `~(ra_compatible (auth_ra (excl_ra:((num)excl)ra)) (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) (auth_auth (excl_ra:((num)excl)ra) (b:(num)excl)))`, - "AUTH_RA_AUTH_CONFLICT"); + "auth_ra_auth_conflict"); check_auth_structure_theorem( - ispecl_rule(TERM_LIST(R, f, g), AUTH_RA_INCLUDED_FRAG_FRAG), + ispecl_rule(TERM_LIST(R, f, g), auth_ra_included_frag_frag), `ra_included (auth_ra (excl_ra:((num)excl)ra)) (auth_frag (f:(num)excl)) (auth_frag (g:(num)excl)) <=> ra_included (excl_ra:((num)excl)ra) f g`, - "AUTH_RA_INCLUDED_FRAG_FRAG"); + "auth_ra_included_frag_frag"); check_auth_structure_theorem( ispecl_rule( TERM_LIST(R, f, a, g), - AUTH_RA_INCLUDED_FRAG_BOTH), + auth_ra_included_frag_both), `ra_included (auth_ra (excl_ra:((num)excl)ra)) (auth_frag (f:(num)excl)) (auth_both (a:(num)excl) (g:(num)excl)) <=> ra_included (excl_ra:((num)excl)ra) f g`, - "AUTH_RA_INCLUDED_FRAG_BOTH"); + "auth_ra_included_frag_both"); check_auth_structure_theorem( ispecl_rule( TERM_LIST(R, a, b), - AUTH_RA_INCLUDED_AUTH_AUTH), + auth_ra_included_auth_auth), `ra_included (auth_ra (excl_ra:((num)excl)ra)) (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) (auth_auth (excl_ra:((num)excl)ra) (b:(num)excl)) <=> a == b`, - "AUTH_RA_INCLUDED_AUTH_AUTH"); + "auth_ra_included_auth_auth"); check_auth_structure_theorem( ispecl_rule( TERM_LIST(R, a, b, g), - AUTH_RA_INCLUDED_AUTH_BOTH), + auth_ra_included_auth_both), `ra_included (auth_ra (excl_ra:((num)excl)ra)) (auth_auth (excl_ra:((num)excl)ra) (a:(num)excl)) (auth_both (b:(num)excl) (g:(num)excl)) <=> a == b`, - "AUTH_RA_INCLUDED_AUTH_BOTH"); + "auth_ra_included_auth_both"); check_auth_structure_theorem( ispecl_rule( TERM_LIST(R, a, f, b, g), - AUTH_RA_INCLUDED_BOTH_BOTH), + auth_ra_included_both_both), `ra_included (auth_ra (excl_ra:((num)excl)ra)) (auth_both (a:(num)excl) (f:(num)excl)) (auth_both (b:(num)excl) (g:(num)excl)) <=> a == b && ra_included (excl_ra:((num)excl)ra) f g`, - "AUTH_RA_INCLUDED_BOTH_BOTH"); + "auth_ra_included_both_both"); return 0; err: diff --git a/test/basic_ra_constructors_regression.c b/test/basic_ra_constructors_regression.c index f4bcd7e..f945786 100644 --- a/test/basic_ra_constructors_regression.c +++ b/test/basic_ra_constructors_regression.c @@ -34,34 +34,34 @@ err: PROOF static int audit_unit_ra_regressions(void) { check_basic_ra_theorem( - UNIT_RA_UNIT, + unit_ra_unit, `ra_unit unit_ra == (one:1)`, - "UNIT_RA_UNIT"); + "unit_ra_unit"); check_basic_ra_theorem( - UNIT_RA_OP, + unit_ra_op, `forall a b:1. ra_op unit_ra a b == one`, - "UNIT_RA_OP"); + "unit_ra_op"); check_basic_ra_theorem( - UNIT_RA_VALID, + unit_ra_valid, `forall a:1. ra_valid unit_ra a`, - "UNIT_RA_VALID"); + "unit_ra_valid"); check_basic_ra_theorem( - UNIT_RA_INCLUDED, + unit_ra_included, `forall a b:1. ra_included unit_ra a b`, - "UNIT_RA_INCLUDED"); + "unit_ra_included"); check_basic_ra_theorem( - UNIT_RA_EXCLUSIVE, + unit_ra_exclusive, `forall a:1. ra_exclusive unit_ra a`, - "UNIT_RA_EXCLUSIVE"); + "unit_ra_exclusive"); check_basic_ra_theorem( - UNIT_RA_UPDATEP_IFF, + unit_ra_updateP_iff, `forall (a:1) (P:1->bool). ra_updateP unit_ra a P <=> P one`, - "UNIT_RA_UPDATEP_IFF"); + "unit_ra_updateP_iff"); check_basic_ra_theorem( - UNIT_RA_LOCAL_UPDATE, + unit_ra_local_update, `forall a f b g:1. ra_local_update unit_ra a f b g`, - "UNIT_RA_LOCAL_UPDATE"); + "unit_ra_local_update"); return 0; err: ERR_FUN_PUTS("audit_unit_ra_regressions"); @@ -74,55 +74,55 @@ PROOF static int audit_excl_ra_regressions(void) { term x = `x:(num)excl`; check_basic_ra_theorem( - basic_ra_at_num(EXCL_RA_UNIT), + basic_ra_at_num(excl_ra_unit), `ra_unit (excl_ra:((num)excl)ra) == ExclUnit`, - "EXCL_RA_UNIT"); + "excl_ra_unit"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(a, b), EXCL_RA_OWNED_CONFLICT), + ispecl_rule(TERM_LIST(a, b), excl_ra_owned_conflict), `ra_op (excl_ra:((num)excl)ra) (Excl (a:num)) (Excl (b:num)) == ExclInvalid`, - "EXCL_RA_OWNED_CONFLICT"); + "excl_ra_owned_conflict"); check_basic_ra_theorem( - basic_ra_at_num(EXCL_RA_VALID_UNIT), + basic_ra_at_num(excl_ra_valid_unit), `ra_valid (excl_ra:((num)excl)ra) ExclUnit`, - "EXCL_RA_VALID_UNIT"); + "excl_ra_valid_unit"); check_basic_ra_theorem( - ispec_rule(a, EXCL_RA_VALID_OWNED), + ispec_rule(a, excl_ra_valid_owned), `ra_valid (excl_ra:((num)excl)ra) (Excl (a:num))`, - "EXCL_RA_VALID_OWNED"); + "excl_ra_valid_owned"); check_basic_ra_theorem( - basic_ra_at_num(EXCL_RA_INVALID), + basic_ra_at_num(excl_ra_invalid), `~(ra_valid (excl_ra:((num)excl)ra) ExclInvalid)`, - "EXCL_RA_INVALID"); + "excl_ra_invalid"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(a, b), EXCL_RA_INCLUDED_OWNED), + ispecl_rule(TERM_LIST(a, b), excl_ra_included_owned), `ra_included (excl_ra:((num)excl)ra) (Excl (a:num)) (Excl (b:num)) <=> a == b`, - "EXCL_RA_INCLUDED_OWNED"); + "excl_ra_included_owned"); check_basic_ra_theorem( - ispec_rule(a, EXCL_RA_EXCLUSIVE), + ispec_rule(a, excl_ra_exclusive), `ra_exclusive (excl_ra:((num)excl)ra) (Excl (a:num))`, - "EXCL_RA_EXCLUSIVE"); + "excl_ra_exclusive"); check_basic_ra_theorem( - basic_ra_at_num(EXCL_RA_CANCELLATIVE), + basic_ra_at_num(excl_ra_cancellative), `ra_cancellative (excl_ra:((num)excl)ra)`, - "EXCL_RA_CANCELLATIVE"); + "excl_ra_cancellative"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(a, x), EXCL_RA_UPDATE_OWNED_IFF), + ispecl_rule(TERM_LIST(a, x), excl_ra_update_owned_iff), `ra_update (excl_ra:((num)excl)ra) (Excl (a:num)) (x:(num)excl) <=> ra_valid excl_ra x`, - "EXCL_RA_UPDATE_OWNED_IFF"); + "excl_ra_update_owned_iff"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(a, x), EXCL_RA_LOCAL_UPDATE_IFF), + ispecl_rule(TERM_LIST(a, x), excl_ra_local_update_iff), `ra_local_update (excl_ra:((num)excl)ra) (Excl (a:num)) @@ -130,7 +130,7 @@ PROOF static int audit_excl_ra_regressions(void) { (x:(num)excl) x <=> ra_valid excl_ra x`, - "EXCL_RA_LOCAL_UPDATE_IFF"); + "excl_ra_local_update_iff"); return 0; err: ERR_FUN_PUTS("audit_excl_ra_regressions"); @@ -154,54 +154,54 @@ PROOF static int audit_prod_ra_regressions(void) { term P2 = `P2:(num)excl->bool`; check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R, S), PROD_RA_UNIT), + ispecl_rule(TERM_LIST(R, S), prod_ra_unit), `ra_unit (prod_ra unit_ra (excl_ra:((num)excl)ra)) == (ra_unit unit_ra,ra_unit excl_ra)`, - "PROD_RA_UNIT"); + "prod_ra_unit"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R, S, x, y), PROD_RA_OP), + ispecl_rule(TERM_LIST(R, S, x, y), prod_ra_op), `ra_op (prod_ra unit_ra (excl_ra:((num)excl)ra)) (x:1#(num)excl) (y:1#(num)excl) == (ra_op unit_ra (FST x) (FST y), ra_op excl_ra (SND x) (SND y))`, - "PROD_RA_OP"); + "prod_ra_op"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R, S, x), PROD_RA_VALID), + ispecl_rule(TERM_LIST(R, S, x), prod_ra_valid), `ra_valid (prod_ra unit_ra (excl_ra:((num)excl)ra)) (x:1#(num)excl) <=> ra_valid unit_ra (FST x) && ra_valid excl_ra (SND x)`, - "PROD_RA_VALID"); + "prod_ra_valid"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R, S, x, y), PROD_RA_INCLUDED), + ispecl_rule(TERM_LIST(R, S, x, y), prod_ra_included), `ra_included (prod_ra unit_ra (excl_ra:((num)excl)ra)) (x:1#(num)excl) (y:1#(num)excl) <=> ra_included unit_ra (FST x) (FST y) && ra_included excl_ra (SND x) (SND y)`, - "PROD_RA_INCLUDED"); + "prod_ra_included"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R, S), PROD_RA_CANCELLATIVE_IFF), + ispecl_rule(TERM_LIST(R, S), prod_ra_cancellative_iff), `ra_cancellative (prod_ra unit_ra (excl_ra:((num)excl)ra)) <=> ra_cancellative unit_ra && ra_cancellative (excl_ra:((num)excl)ra)`, - "PROD_RA_CANCELLATIVE_IFF"); + "prod_ra_cancellative_iff"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R, S, x), PROD_RA_EXCLUSIVE_IFF), + ispecl_rule(TERM_LIST(R, S, x), prod_ra_exclusive_iff), `ra_exclusive (prod_ra unit_ra (excl_ra:((num)excl)ra)) (x:1#(num)excl) <=> ra_exclusive unit_ra (FST x) && ra_exclusive excl_ra (SND x)`, - "PROD_RA_EXCLUSIVE_IFF"); + "prod_ra_exclusive_iff"); check_basic_ra_theorem( ispecl_rule( TERM_LIST(R, S, a1, a2, P1, P2), - PROD_RA_UPDATEP), + prod_ra_updateP), `ra_updateP unit_ra (a1:1) (P1:1->bool) ==> ra_updateP excl_ra (a2:(num)excl) (P2:(num)excl->bool) ==> ra_updateP @@ -210,28 +210,28 @@ PROOF static int audit_prod_ra_regressions(void) { (\x:1#(num)excl. exists b1:1. exists b2:(num)excl. P1 b1 && P2 b2 && x == (b1,b2))`, - "PROD_RA_UPDATEP"); + "prod_ra_updateP"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R, S, a1, a2, b1), PROD_RA_UPDATE_LEFT), + ispecl_rule(TERM_LIST(R, S, a1, a2, b1), prod_ra_update_left), `ra_update unit_ra (a1:1) (b1:1) ==> ra_update (prod_ra unit_ra (excl_ra:((num)excl)ra)) (a1,(a2:(num)excl)) (b1,a2)`, - "PROD_RA_UPDATE_LEFT"); + "prod_ra_update_left"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R, S, a1, a2, b2), PROD_RA_UPDATE_RIGHT), + ispecl_rule(TERM_LIST(R, S, a1, a2, b2), prod_ra_update_right), `ra_update excl_ra (a2:(num)excl) (b2:(num)excl) ==> ra_update (prod_ra unit_ra excl_ra) ((a1:1),a2) (a1,b2)`, - "PROD_RA_UPDATE_RIGHT"); + "prod_ra_update_right"); check_basic_ra_theorem( ispecl_rule( TERM_LIST(R, S, a1, f1, b1, g1, a2, f2, b2, g2), - PROD_RA_LOCAL_UPDATE), + prod_ra_local_update), `ra_local_update unit_ra (a1:1) (f1:1) (b1:1) (g1:1) ==> ra_local_update excl_ra (a2:(num)excl) (f2:(num)excl) (b2:(num)excl) (g2:(num)excl) ==> ra_local_update (prod_ra unit_ra excl_ra) (a1,a2) (f1,f2) (b1,b2) (g1,g2)`, - "PROD_RA_LOCAL_UPDATE"); + "prod_ra_local_update"); check_basic_ra_theorem( ispecl_rule(TERM_LIST(R, S, a1), prod_inl_def), @@ -244,51 +244,51 @@ PROOF static int audit_prod_ra_regressions(void) { (ra_unit unit_ra,a2)`, "prod_inr_def"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R, S, a1, b1), PROD_INL_OP), + ispecl_rule(TERM_LIST(R, S, a1, b1), prod_inl_op), `prod_inl unit_ra (excl_ra:((num)excl)ra) (ra_op unit_ra (a1:1) (b1:1)) == ra_op (prod_ra unit_ra (excl_ra:((num)excl)ra)) (prod_inl unit_ra (excl_ra:((num)excl)ra) a1) (prod_inl unit_ra (excl_ra:((num)excl)ra) b1)`, - "PROD_INL_OP"); + "prod_inl_op"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R, S, a2, b2), PROD_INR_OP), + ispecl_rule(TERM_LIST(R, S, a2, b2), prod_inr_op), `prod_inr unit_ra excl_ra (ra_op excl_ra (a2:(num)excl) (b2:(num)excl)) == ra_op (prod_ra unit_ra excl_ra) (prod_inr unit_ra excl_ra a2) (prod_inr unit_ra excl_ra b2)`, - "PROD_INR_OP"); + "prod_inr_op"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R, S, a1, P1), PROD_INL_UPDATEP), + ispecl_rule(TERM_LIST(R, S, a1, P1), prod_inl_updateP), `ra_updateP unit_ra (a1:1) (P1:1->bool) ==> ra_updateP (prod_ra unit_ra (excl_ra:((num)excl)ra)) (prod_inl unit_ra (excl_ra:((num)excl)ra) a1) (\x:1#(num)excl. exists b:1. P1 b && x == prod_inl unit_ra (excl_ra:((num)excl)ra) b)`, - "PROD_INL_UPDATEP"); + "prod_inl_updateP"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R, S, a2, P2), PROD_INR_UPDATEP), + ispecl_rule(TERM_LIST(R, S, a2, P2), prod_inr_updateP), `ra_updateP excl_ra (a2:(num)excl) (P2:(num)excl->bool) ==> ra_updateP (prod_ra unit_ra excl_ra) (prod_inr unit_ra excl_ra a2) (\x:1#(num)excl. exists b:(num)excl. P2 b && x == prod_inr unit_ra excl_ra b)`, - "PROD_INR_UPDATEP"); + "prod_inr_updateP"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R, S, a1, b1), PROD_INL_UPDATE), + ispecl_rule(TERM_LIST(R, S, a1, b1), prod_inl_update), `ra_update unit_ra (a1:1) (b1:1) ==> ra_update (prod_ra unit_ra (excl_ra:((num)excl)ra)) (prod_inl unit_ra (excl_ra:((num)excl)ra) a1) (prod_inl unit_ra (excl_ra:((num)excl)ra) b1)`, - "PROD_INL_UPDATE"); + "prod_inl_update"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R, S, a2, b2), PROD_INR_UPDATE), + ispecl_rule(TERM_LIST(R, S, a2, b2), prod_inr_update), `ra_update excl_ra (a2:(num)excl) (b2:(num)excl) ==> ra_update (prod_ra unit_ra excl_ra) (prod_inr unit_ra excl_ra a2) (prod_inr unit_ra excl_ra b2)`, - "PROD_INR_UPDATE"); + "prod_inr_update"); return 0; err: ERR_FUN_PUTS("audit_prod_ra_regressions"); diff --git a/test/c_resource_v2_regression.c b/test/c_resource_v2_regression.c index 1bb6585..94e343f 100644 --- a/test/c_resource_v2_regression.c +++ b/test/c_resource_v2_regression.c @@ -61,7 +61,7 @@ PROOF static int audit_c_resource_v2_regressions(void) { "c_lift_ghost is the exact right lift"); check_c_resource_v2_theorem( - ispecl_rule(TERM_LIST(G, c_post, resource), C_BUPD_PRESERVES_PHYS), + ispecl_rule(TERM_LIST(G, c_post, resource), c_bupd_preserves_phys), `ra_valid (c_resource_ra (G:(num)ra)) (resource:((int,(pmem_byte_state)excl)finmap)#num) ==> @@ -69,13 +69,13 @@ PROOF static int audit_c_resource_v2_regressions(void) { (Q:(((int,(pmem_byte_state)excl)finmap)#num)->bool) resource ==> exists ghost':num. Q (FST resource,ghost')`, - "C_BUPD_PRESERVES_PHYS keeps the physical projection"); + "c_bupd_preserves_phys keeps the physical projection"); /* `sl_v2_regression.c` separately locks r_fact to `phi && a == unit`. * This exact statement therefore makes validity consume an exact-unit * fact, rather than admitting the resource-independent r_pure assertion. */ check_c_resource_v2_theorem( - ispecl_rule(TERM_LIST(G, ghost), C_GHOST_OWN_VALID), + ispecl_rule(TERM_LIST(G, ghost), c_ghost_own_valid), `r_entails (c_resource_ra (G:(num)ra)) (c_ghost_own G (ghost:num)) @@ -83,12 +83,12 @@ PROOF static int audit_c_resource_v2_regressions(void) { (c_resource_ra G) (r_fact (c_resource_ra G) (ra_valid G ghost)) (c_ghost_own G ghost))`, - "C_GHOST_OWN_VALID exposes validity through exact-unit fact"); + "c_ghost_own_valid exposes validity through exact-unit fact"); check_c_resource_v2_theorem( ispecl_rule( TERM_LIST(G, ghost, result_pred), - C_GHOST_OWN_UPDATEP), + c_ghost_own_updateP), `ra_updateP (G:(num)ra) (ghost:num) @@ -105,7 +105,7 @@ PROOF static int audit_c_resource_v2_regressions(void) { (c_resource_ra G) (result_pred selected)) (c_ghost_own G selected)))`, - "C_GHOST_OWN_UPDATEP returns an exact-unit result witness"); + "c_ghost_own_updateP returns an exact-unit result witness"); term R = `R:(num)ra`; term name = `name:num`; @@ -118,7 +118,7 @@ PROOF static int audit_c_resource_v2_regressions(void) { check_c_resource_v2_theorem( ispecl_rule( TERM_LIST(R, name, payload, named_result_pred), - C_NAMED_OWN_UPDATEP), + c_named_own_updateP), `ra_updateP (R:(num)ra) (payload:num) @@ -135,22 +135,22 @@ PROOF static int audit_c_resource_v2_regressions(void) { (c_resource_ra (named_ra R)) (named_result_pred selected)) (c_named_own R name selected)))`, - "C_NAMED_OWN_UPDATEP preserves the result witness"); + "c_named_own_updateP preserves the result witness"); /* DROP is unconditional. In particular, its exact conclusion contains no * freshness token or premise that could make later reuse of `name` illegal. */ check_c_resource_v2_theorem( - ispecl_rule(TERM_LIST(R, name, payload), C_NAMED_OWN_DROP), + ispecl_rule(TERM_LIST(R, name, payload), c_named_own_drop), `c_viewshift (named_ra (R:(num)ra)) (c_named_own R (name:num) (payload:num)) (r_emp (c_resource_ra (named_ra R)))`, - "C_NAMED_OWN_DROP is unconditional and freshness-free"); + "c_named_own_drop is unconditional and freshness-free"); check_c_resource_v2_theorem( ispecl_rule( TERM_LIST(R, payload, named_assertion), - C_NAMED_OWN_ALLOC), + c_named_own_alloc), `ra_valid (R:(num)ra) (payload:num) ==> c_viewshift (named_ra R) @@ -163,7 +163,7 @@ PROOF static int audit_c_resource_v2_regressions(void) { (c_resource_ra (named_ra R)) (c_named_own R allocated payload) P_named))`, - "C_NAMED_OWN_ALLOC allocates into the complete named global RA"); + "c_named_own_alloc allocates into the complete named global RA"); return 0; err: diff --git a/test/dependency_v2_regression.sh b/test/dependency_v2_regression.sh index b33c668..6ab92bf 100755 --- a/test/dependency_v2_regression.sh +++ b/test/dependency_v2_regression.sh @@ -88,18 +88,43 @@ reject_matches \ reject_matches \ "public header exposes an invalid-source vacuity theorem" \ - '^PROOF[[:space:]]+extern[[:space:]]+thm[[:space:]]+[A-Z0-9_]*(RA_UPDATE_INVALID|RA_UPDATEP_INVALID|RA_INVALID_EXCLUSIVE)[A-Z0-9_]*;' \ + '^PROOF[[:space:]]+extern[[:space:]]+thm[[:space:]]+[[:alnum:]_]*(ra_update_invalid|ra_updateP_invalid|ra_invalid_exclusive)[[:alnum:]_]*;' \ "${public_headers[@]}" reject_matches \ "public assertion header exposes a raw-equality theorem handle" \ - '^PROOF[[:space:]]+extern[[:space:]]+thm[[:space:]]+R_[A-Z0-9_]*_EQ;' \ + '^PROOF[[:space:]]+extern[[:space:]]+thm[[:space:]]+r_[[:alnum:]_]*_eq;' \ "$logic_dir/resource_prop.h" \ "$logic_dir/basic_update.h" \ "$logic_dir/big_sep.h" \ "$logic_dir/product_resource.h" \ "$logic_dir/named_logic.h" +# Theorem handles use lower_snake_case. Mixed case is permitted only where a +# handle embeds the spelling of an object-language constant that is itself +# mixed case; semantic qualifiers such as none/some/map remain lowercase. +theorem_handles=$(rg --no-filename \ + '^PROOF[[:space:]]+((extern|static)[[:space:]]+)?thm[[:space:]]+[[:alnum:]_]+([[:space:]]*=|;)' \ + "$logic_dir" "$theory_dir/c_program_logic" 2>/dev/null | sed -E \ + 's/^PROOF[[:space:]]+((extern|static)[[:space:]]+)?thm[[:space:]]+([[:alnum:]_]+).*/\3/' || true) + +while IFS= read -r handle; do + [ -n "$handle" ] || continue + normalized=$handle + normalized=${normalized//updateP/updatep} + normalized=${normalized//Tuint64/tuint64} + normalized=${normalized//leftP/leftp} + normalized=${normalized//rightP/rightp} + case "$normalized" in + [!a-z]*|*[A-Z]*) + echo "dependency_v2_regression: theorem handle is not lower_snake_case: $handle" >&2 + failed=1 + ;; + esac +done <bool`; check_gmap_theorem( - gmap_key_at_num(ispec_rule(R, GMAP_RA_UNIT)), + gmap_key_at_num(ispec_rule(R, gmap_ra_unit)), `ra_unit (gmap_ra (excl_ra:((num)excl)ra)) == (finmap_empty:(num,(num)excl)finmap)`, - "GMAP_RA_UNIT"); + "gmap_ra_unit"); check_gmap_theorem( - ispecl_rule(TERM_LIST(R, key, a), GMAP_RA_VALID_SINGLETON), + ispecl_rule(TERM_LIST(R, key, a), gmap_ra_valid_singleton), `ra_valid (gmap_ra (excl_ra:((num)excl)ra)) (finmap_singleton (key:num) (a:(num)excl)) <=> ra_valid (excl_ra:((num)excl)ra) a`, - "GMAP_RA_VALID_SINGLETON"); + "gmap_ra_valid_singleton"); check_gmap_theorem( - ispecl_rule(TERM_LIST(R, key, a, m), GMAP_RA_DECOMPOSE), + ispecl_rule(TERM_LIST(R, key, a, m), gmap_ra_decompose), `finmap_lookup (m:(num,(num)excl)finmap) (key:num) == SOME (a:(num)excl) ==> @@ -87,10 +87,10 @@ PROOF static int audit_gmap_v2_regressions(void) { (gmap_ra (excl_ra:((num)excl)ra)) (finmap_singleton key a) (finmap_delete key m)`, - "GMAP_RA_DECOMPOSE"); + "gmap_ra_decompose"); check_gmap_theorem( - ispecl_rule(TERM_LIST(R, m, n), GMAP_RA_INCLUDED_LOOKUP_IFF), + ispecl_rule(TERM_LIST(R, m, n), gmap_ra_included_lookup_iff), `ra_included (gmap_ra (excl_ra:((num)excl)ra)) (m:(num,(num)excl)finmap) @@ -100,11 +100,11 @@ PROOF static int audit_gmap_v2_regressions(void) { (option_ra (excl_ra:((num)excl)ra)) (finmap_lookup m query) (finmap_lookup n query)`, - "GMAP_RA_INCLUDED_LOOKUP_IFF"); + "gmap_ra_included_lookup_iff"); check_gmap_theorem( ispecl_rule(TERM_LIST(R, key, a, f, b, g, m), - GMAP_RA_LOCAL_UPDATE_AT), + gmap_ra_local_update_at), `finmap_lookup (m:(num,(num)excl)finmap) (key:num) == SOME (a:(num)excl) ==> @@ -117,10 +117,10 @@ PROOF static int audit_gmap_v2_regressions(void) { (finmap_singleton key f) (finmap_insert key b m) (finmap_singleton key g)`, - "GMAP_RA_LOCAL_UPDATE_AT"); + "gmap_ra_local_update_at"); check_gmap_theorem( - ispecl_rule(TERM_LIST(R, key, a, b, m), GMAP_RA_UPDATE_AT), + ispecl_rule(TERM_LIST(R, key, a, b, m), gmap_ra_update_at), `finmap_lookup (m:(num,(num)excl)finmap) (key:num) == SOME (a:(num)excl) ==> @@ -131,10 +131,10 @@ PROOF static int audit_gmap_v2_regressions(void) { (gmap_ra (excl_ra:((num)excl)ra)) m (finmap_insert key b m)`, - "GMAP_RA_UPDATE_AT"); + "gmap_ra_update_at"); check_gmap_theorem( - ispecl_rule(TERM_LIST(R, key, a, P, m), GMAP_RA_UPDATEP_AT), + ispecl_rule(TERM_LIST(R, key, a, P, m), gmap_ra_updateP_at), `finmap_lookup (m:(num,(num)excl)finmap) (key:num) == SOME (a:(num)excl) ==> @@ -148,17 +148,17 @@ PROOF static int audit_gmap_v2_regressions(void) { exists selected:(num)excl. P selected && result == finmap_insert key selected m)`, - "GMAP_RA_UPDATEP_AT"); + "gmap_ra_updateP_at"); /* Drop only removes this fragment's binding. It has no freshness premise * and makes no claim that this name remains unavailable to later allocs. */ check_gmap_theorem( - ispecl_rule(TERM_LIST(R, key, m), GMAP_RA_DROP_AT), + ispecl_rule(TERM_LIST(R, key, m), gmap_ra_drop_at), `ra_update (gmap_ra (excl_ra:((num)excl)ra)) (m:(num,(num)excl)finmap) (finmap_delete (key:num) m)`, - "GMAP_RA_DROP_AT"); + "gmap_ra_drop_at"); /* The existential result is inside the universal frame quantifier. This * is the semantic regression that permits allocation's chosen fresh key to @@ -187,7 +187,7 @@ PROOF static int audit_gmap_v2_regressions(void) { check_gmap_theorem( ispecl_rule( TERM_LIST(R, candidates, payload, m), - GMAP_RA_ALLOC_STRONG_DEP), + gmap_ra_alloc_strong_dep), `INFINITE (candidates:num->bool) ==> (forall candidate:num. candidate IN candidates ==> @@ -206,11 +206,11 @@ PROOF static int audit_gmap_v2_regressions(void) { finmap_lookup m candidate == NONE && result == finmap_insert candidate (payload candidate) m)`, - "GMAP_RA_ALLOC_STRONG_DEP"); + "gmap_ra_alloc_strong_dep"); check_gmap_theorem( ispecl_rule(TERM_LIST(R, forbidden, m, a), - GMAP_RA_ALLOC_COFINITE), + gmap_ra_alloc_cofinite), `INFINITE (UNIV:num->bool) ==> FINITE (forbidden:num->bool) ==> ra_valid (excl_ra:((num)excl)ra) (a:(num)excl) ==> @@ -222,7 +222,7 @@ PROOF static int audit_gmap_v2_regressions(void) { ~(candidate IN forbidden) && finmap_lookup m candidate == NONE && result == finmap_insert candidate a m)`, - "GMAP_RA_ALLOC_COFINITE"); + "gmap_ra_alloc_cofinite"); return 0; err: diff --git a/test/named_ra_regression.c b/test/named_ra_regression.c index 7dd0deb..0ace52e 100644 --- a/test/named_ra_regression.c +++ b/test/named_ra_regression.c @@ -44,13 +44,13 @@ PROOF static int audit_named_v2_regressions(void) { term assertion = `Q:(num,(num)excl)finmap->bool`; check_named_theorem( - ispec_rule(R, NAMED_RA_UNIT), + ispec_rule(R, named_ra_unit), `ra_unit (named_ra (excl_ra:((num)excl)ra)) == (finmap_empty:(num,(num)excl)finmap)`, - "NAMED_RA_UNIT"); + "named_ra_unit"); check_named_theorem( - ispecl_rule(TERM_LIST(R, name, a, b), NAMED_RA_SINGLETON_OP), + ispecl_rule(TERM_LIST(R, name, a, b), named_ra_singleton_op), `ra_op (named_ra (excl_ra:((num)excl)ra)) (finmap_singleton (name:num) (a:(num)excl)) @@ -58,18 +58,18 @@ PROOF static int audit_named_v2_regressions(void) { finmap_singleton name (ra_op (excl_ra:((num)excl)ra) a b)`, - "NAMED_RA_SINGLETON_OP"); + "named_ra_singleton_op"); check_named_theorem( - ispecl_rule(TERM_LIST(R, name, a), NAMED_RA_VALID_SINGLETON), + ispecl_rule(TERM_LIST(R, name, a), named_ra_valid_singleton), `ra_valid (named_ra (excl_ra:((num)excl)ra)) (finmap_singleton (name:num) (a:(num)excl)) <=> ra_valid (excl_ra:((num)excl)ra) a`, - "NAMED_RA_VALID_SINGLETON"); + "named_ra_valid_singleton"); check_named_theorem( - ispecl_rule(TERM_LIST(R, name, a, b), NAMED_RA_UPDATE_SINGLETON), + ispecl_rule(TERM_LIST(R, name, a, b), named_ra_update_singleton), `ra_update (excl_ra:((num)excl)ra) (a:(num)excl) @@ -78,12 +78,12 @@ PROOF static int audit_named_v2_regressions(void) { (named_ra (excl_ra:((num)excl)ra)) (finmap_singleton (name:num) a) (finmap_singleton name b)`, - "NAMED_RA_UPDATE_SINGLETON"); + "named_ra_update_singleton"); check_named_theorem( ispecl_rule( TERM_LIST(R, name, a, P), - NAMED_RA_UPDATEP_SINGLETON), + named_ra_updateP_singleton), `ra_updateP (excl_ra:((num)excl)ra) (a:(num)excl) @@ -95,20 +95,20 @@ PROOF static int audit_named_v2_regressions(void) { exists selected:(num)excl. P selected && result == finmap_singleton name selected)`, - "NAMED_RA_UPDATEP_SINGLETON"); + "named_ra_updateP_singleton"); /* Dropping ownership produces the unit. There is intentionally no * persistent tombstone or freshness conclusion. */ check_named_theorem( - ispecl_rule(TERM_LIST(R, name, a), NAMED_RA_DROP), + ispecl_rule(TERM_LIST(R, name, a), named_ra_drop), `ra_update (named_ra (excl_ra:((num)excl)ra)) (finmap_singleton (name:num) (a:(num)excl)) (finmap_empty:(num,(num)excl)finmap)`, - "NAMED_RA_DROP"); + "named_ra_drop"); check_named_theorem( - ispecl_rule(TERM_LIST(R, m, a), NAMED_RA_ALLOC), + ispecl_rule(TERM_LIST(R, m, a), named_ra_alloc), `ra_valid (excl_ra:((num)excl)ra) (a:(num)excl) ==> @@ -119,7 +119,7 @@ PROOF static int audit_named_v2_regressions(void) { exists allocated:num. finmap_lookup m allocated == NONE && result == finmap_insert allocated a m)`, - "NAMED_RA_ALLOC"); + "named_ra_alloc"); check_named_theorem( named_at_num_excl(named_own_def), @@ -133,7 +133,7 @@ PROOF static int audit_named_v2_regressions(void) { "named_own_def"); check_named_theorem( - ispecl_rule(TERM_LIST(R, name, a, b), NAMED_OWN_OP), + ispecl_rule(TERM_LIST(R, name, a, b), named_own_op), `r_equiv (named_ra (excl_ra:((num)excl)ra)) (named_own @@ -147,10 +147,10 @@ PROOF static int audit_named_v2_regressions(void) { (named_ra (excl_ra:((num)excl)ra)) (named_own (excl_ra:((num)excl)ra) name a) (named_own (excl_ra:((num)excl)ra) name b))`, - "NAMED_OWN_OP"); + "named_own_op"); check_named_theorem( - ispecl_rule(TERM_LIST(R, name, a), NAMED_OWN_VALID), + ispecl_rule(TERM_LIST(R, name, a), named_own_valid), `r_entails (named_ra (excl_ra:((num)excl)ra)) (named_own @@ -163,10 +163,10 @@ PROOF static int audit_named_v2_regressions(void) { (named_ra (excl_ra:((num)excl)ra)) (ra_valid (excl_ra:((num)excl)ra) a)) (named_own (excl_ra:((num)excl)ra) name a))`, - "NAMED_OWN_VALID uses fact"); + "named_own_valid uses fact"); check_named_theorem( - ispecl_rule(TERM_LIST(R, name, a, b), NAMED_OWN_UPDATE), + ispecl_rule(TERM_LIST(R, name, a, b), named_own_update), `ra_update (excl_ra:((num)excl)ra) (a:(num)excl) @@ -175,10 +175,10 @@ PROOF static int audit_named_v2_regressions(void) { (named_ra (excl_ra:((num)excl)ra)) (named_own (excl_ra:((num)excl)ra) (name:num) a) (named_own (excl_ra:((num)excl)ra) name b)`, - "NAMED_OWN_UPDATE"); + "named_own_update"); check_named_theorem( - ispecl_rule(TERM_LIST(R, name, a, P), NAMED_OWN_UPDATEP), + ispecl_rule(TERM_LIST(R, name, a, P), named_own_updateP), `ra_updateP (excl_ra:((num)excl)ra) (a:(num)excl) @@ -198,10 +198,10 @@ PROOF static int audit_named_v2_regressions(void) { (excl_ra:((num)excl)ra) name selected)))`, - "NAMED_OWN_UPDATEP uses fact"); + "named_own_updateP uses fact"); check_named_theorem( - ispecl_rule(TERM_LIST(R, name, a), NAMED_OWN_DROP), + ispecl_rule(TERM_LIST(R, name, a), named_own_drop), `r_viewshift (named_ra (excl_ra:((num)excl)ra)) (named_own @@ -209,10 +209,10 @@ PROOF static int audit_named_v2_regressions(void) { (name:num) (a:(num)excl)) (r_emp (named_ra (excl_ra:((num)excl)ra)))`, - "NAMED_OWN_DROP"); + "named_own_drop"); check_named_theorem( - ispecl_rule(TERM_LIST(R, a, assertion), NAMED_OWN_ALLOC), + ispecl_rule(TERM_LIST(R, a, assertion), named_own_alloc), `ra_valid (excl_ra:((num)excl)ra) (a:(num)excl) ==> @@ -229,7 +229,7 @@ PROOF static int audit_named_v2_regressions(void) { allocated a) Q))`, - "NAMED_OWN_ALLOC"); + "named_own_alloc"); return 0; err: diff --git a/test/ra_core_regression.c b/test/ra_core_regression.c index 511c4ff..1e5e03b 100644 --- a/test/ra_core_regression.c +++ b/test/ra_core_regression.c @@ -115,73 +115,73 @@ PROOF static int audit_ra_core_regressions(void) { "ra_exclusive_def"); check_ra_core_theorem( - ispecl_rule(TERM_LIST(R, a, b), RA_COMPAT_COMM), + ispecl_rule(TERM_LIST(R, a, b), ra_compat_comm), `ra_compatible (R:(num)ra) (a:num) (b:num) <=> ra_compatible R b a`, - "RA_COMPAT_COMM"); + "ra_compat_comm"); check_ra_core_theorem( - ispecl_rule(TERM_LIST(R, a), RA_COMPAT_UNIT), + ispecl_rule(TERM_LIST(R, a), ra_compat_unit), `ra_compatible (R:(num)ra) (a:num) (ra_unit R) <=> ra_valid R a`, - "RA_COMPAT_UNIT"); + "ra_compat_unit"); check_ra_core_theorem( - ispecl_rule(TERM_LIST(R, a, b), RA_UPDATEP_SINGLETON), + ispecl_rule(TERM_LIST(R, a, b), ra_updateP_singleton), `ra_updateP (R:(num)ra) (a:num) (\x:num. x == b) <=> ra_update R a (b:num)`, - "RA_UPDATEP_SINGLETON"); + "ra_updateP_singleton"); check_ra_core_theorem( - ispecl_rule(TERM_LIST(R, a, P, Q), RA_UPDATEP_MONO), + ispecl_rule(TERM_LIST(R, a, P, Q), ra_updateP_mono), `ra_updateP (R:(num)ra) (a:num) (P:num->bool) ==> (forall b:num. P b ==> Q b) ==> ra_updateP R a Q`, - "RA_UPDATEP_MONO"); + "ra_updateP_mono"); check_ra_core_theorem( - ispecl_rule(TERM_LIST(R, a, P, Q), RA_UPDATEP_TRANS), + ispecl_rule(TERM_LIST(R, a, P, Q), ra_updateP_trans), `ra_updateP (R:(num)ra) (a:num) (P:num->bool) ==> (forall b:num. P b ==> ra_updateP R b Q) ==> ra_updateP R a Q`, - "RA_UPDATEP_TRANS"); + "ra_updateP_trans"); check_ra_core_theorem( - ispecl_rule(TERM_LIST(R, a, P, extra), RA_UPDATEP_FRAME), + ispecl_rule(TERM_LIST(R, a, P, extra), ra_updateP_frame), `ra_updateP (R:(num)ra) (a:num) (P:num->bool) ==> ra_updateP R (ra_op R a (extra:num)) (\x:num. exists b:num. P b && x == ra_op R b extra)`, - "RA_UPDATEP_FRAME"); + "ra_updateP_frame"); check_ra_core_theorem( - ispecl_rule(TERM_LIST(R, a, c, P, Q), RA_UPDATEP_OP), + ispecl_rule(TERM_LIST(R, a, c, P, Q), ra_updateP_op), `ra_updateP (R:(num)ra) (a:num) (P:num->bool) ==> ra_updateP R (c:num) (Q:num->bool) ==> ra_updateP R (ra_op R a c) (\x:num. exists b d:num. P b && Q d && x == ra_op R b d)`, - "RA_UPDATEP_OP"); + "ra_updateP_op"); check_ra_core_theorem( - ispecl_rule(TERM_LIST(R, a, b, extra), RA_UPDATE_FRAME), + ispecl_rule(TERM_LIST(R, a, b, extra), ra_update_frame), `ra_update (R:(num)ra) (a:num) (b:num) ==> ra_update R (ra_op R a (extra:num)) (ra_op R b extra)`, - "RA_UPDATE_FRAME"); + "ra_update_frame"); check_ra_core_theorem( - ispecl_rule(TERM_LIST(R, a, b, c, d), RA_UPDATE_OP), + ispecl_rule(TERM_LIST(R, a, b, c, d), ra_update_op), `ra_update (R:(num)ra) (a:num) (b:num) ==> ra_update R (c:num) (d:num) ==> ra_update R (ra_op R a c) (ra_op R b d)`, - "RA_UPDATE_OP"); + "ra_update_op"); check_ra_core_theorem( - ispecl_rule(TERM_LIST(R, a, b), RA_EXCLUSIVE_UPDATE), + ispecl_rule(TERM_LIST(R, a, b), ra_exclusive_update), `ra_exclusive (R:(num)ra) (a:num) ==> ra_valid R (b:num) ==> ra_update R a b`, - "RA_EXCLUSIVE_UPDATE"); + "ra_exclusive_update"); check_ra_core_theorem( prove_exclusive_source_valid(), @@ -207,83 +207,83 @@ PROOF static int audit_ra_core_regressions(void) { check_ra_core_theorem( ispecl_rule( TERM_LIST(R, a, f, b, g, extra), - RA_LOCAL_UPDATE_APPLY), + ra_local_update_apply), `ra_local_update (R:(num)ra) (a:num) (f:num) (b:num) (g:num) ==> ra_valid R a ==> a == ra_op R f (extra:num) ==> ra_valid R b && b == ra_op R g extra`, - "RA_LOCAL_UPDATE_APPLY"); + "ra_local_update_apply"); check_ra_core_theorem( - ispecl_rule(TERM_LIST(R, a, f), RA_LOCAL_UPDATE_REFL), + ispecl_rule(TERM_LIST(R, a, f), ra_local_update_refl), `ra_local_update (R:(num)ra) (a:num) (f:num) a f`, - "RA_LOCAL_UPDATE_REFL"); + "ra_local_update_refl"); check_ra_core_theorem( ispecl_rule( TERM_LIST(R, a, f, b, g, c, h), - RA_LOCAL_UPDATE_TRANS), + ra_local_update_trans), `ra_local_update (R:(num)ra) (a:num) (f:num) (b:num) (g:num) ==> ra_local_update R b g (c:num) (h:num) ==> ra_local_update R a f c h`, - "RA_LOCAL_UPDATE_TRANS"); + "ra_local_update_trans"); check_ra_core_theorem( ispecl_rule( TERM_LIST(R, a, f, b, g, extra), - RA_LOCAL_UPDATE_FRAME), + ra_local_update_frame), `ra_local_update (R:(num)ra) (a:num) (f:num) (b:num) (g:num) ==> ra_local_update R a (ra_op R f (extra:num)) b (ra_op R g extra)`, - "RA_LOCAL_UPDATE_FRAME"); + "ra_local_update_frame"); check_ra_core_theorem( ispecl_rule( TERM_LIST(R, a, f, b, g, extra), - RA_LOCAL_UPDATE_PRESERVES_INCLUDED), + ra_local_update_preserves_included), `ra_local_update (R:(num)ra) (a:num) (f:num) (b:num) (g:num) ==> ra_valid R a ==> ra_included R (ra_op R f (extra:num)) a ==> ra_valid R b && ra_included R (ra_op R g extra) b`, - "RA_LOCAL_UPDATE_PRESERVES_INCLUDED"); + "ra_local_update_preserves_included"); check_ra_core_theorem( ispecl_rule( TERM_LIST(R, a, f, extra), - RA_LOCAL_UPDATE_ALLOC), + ra_local_update_alloc), `ra_valid (R:(num)ra) (ra_op R (a:num) (extra:num)) ==> ra_local_update R a (f:num) (ra_op R a extra) (ra_op R f extra)`, - "RA_LOCAL_UPDATE_ALLOC"); + "ra_local_update_alloc"); check_ra_core_theorem( ispecl_rule( TERM_LIST(R, a, f, b), - RA_LOCAL_UPDATE_EXCLUSIVE), + ra_local_update_exclusive), `ra_exclusive (R:(num)ra) (f:num) ==> ra_valid R (b:num) ==> ra_local_update R (a:num) f b b`, - "RA_LOCAL_UPDATE_EXCLUSIVE"); + "ra_local_update_exclusive"); check_ra_core_theorem( ispecl_rule( TERM_LIST(R, extra, a, f), - RA_LOCAL_UPDATE_CANCEL), + ra_local_update_cancel), `ra_cancellative (R:(num)ra) ==> ra_local_update R (ra_op R (extra:num) (a:num)) (ra_op R extra (f:num)) a f`, - "RA_LOCAL_UPDATE_CANCEL"); + "ra_local_update_cancel"); check_ra_core_theorem( ispecl_rule( TERM_LIST(R, a, b, extra), - RA_LOCAL_UPDATE_CANCELLATIVE), + ra_local_update_cancellative), `ra_cancellative (R:(num)ra) ==> ra_valid R (ra_op R (b:num) (extra:num)) ==> ra_local_update R (ra_op R (a:num) extra) a (ra_op R b extra) b`, - "RA_LOCAL_UPDATE_CANCELLATIVE"); + "ra_local_update_cancellative"); return 0; } diff --git a/test/sl_v2_regression.c b/test/sl_v2_regression.c index 127b7ee..9d8b865 100644 --- a/test/sl_v2_regression.c +++ b/test/sl_v2_regression.c @@ -61,7 +61,7 @@ PROOF static int audit_sl_v2_regressions(void) { `S:(bool)ra`, `a:bool`, `result_pred:bool->bool`), - R_RIGHT_OWN_UPDATEP), + r_right_own_updateP), `ra_updateP (S:(bool)ra) (a:bool) (result_pred:bool->bool) ==> r_viewshift_right (R:(num)ra) S @@ -73,7 +73,7 @@ PROOF static int audit_sl_v2_regressions(void) { (prod_ra R S) (r_fact (prod_ra R S) (result_pred selected)) (r_lift_right R S (r_own S selected))))`, - "R_RIGHT_OWN_UPDATEP uses exact-unit fact"); + "r_right_own_updateP uses exact-unit fact"); check_sl_v2_theorem( ispecl_rule( @@ -83,7 +83,7 @@ PROOF static int audit_sl_v2_regressions(void) { phi, assertion, target), - R_VIEWSHIFT_RIGHT_FACT), + r_viewshift_right_fact), `((phi:bool) ==> r_viewshift_right (R:(num)ra) (S:(bool)ra) @@ -99,12 +99,12 @@ PROOF static int audit_sl_v2_regressions(void) { (prod_ra R S) (r_fact (prod_ra R S) phi) Q)`, - "R_VIEWSHIFT_RIGHT_FACT schema"); + "r_viewshift_right_fact schema"); check_sl_v2_theorem( ispecl_rule( TERM_LIST(R, S, family, target_family), - R_VIEWSHIFT_RIGHT_EXISTS), + r_viewshift_right_exists), `(forall witness:num. r_viewshift_right (R:(num)ra) (S:(bool)ra) @@ -118,7 +118,7 @@ PROOF static int audit_sl_v2_regressions(void) { (r_exists (prod_ra R S) (\bound:num. (Psi:num->(num#bool)->bool) bound))`, - "R_VIEWSHIFT_RIGHT_EXISTS schema"); + "r_viewshift_right_exists schema"); check_sl_v2_theorem( ispecl_rule( @@ -127,7 +127,7 @@ PROOF static int audit_sl_v2_regressions(void) { `Item:bool->num->bool`, `f:num->bool`, `xs:(num)list`), - R_BIG_SEP_LIST_MAP), + r_big_sep_list_map), `r_equiv (R:(num)ra) (r_big_sep_list @@ -138,7 +138,7 @@ PROOF static int audit_sl_v2_regressions(void) { R (\x:num. (Item:bool->num->bool) (f x)) xs)`, - "R_BIG_SEP_LIST_MAP is list-only and r_equiv"); + "r_big_sep_list_map is list-only and r_equiv"); return 0; err: diff --git a/test/value_ra_constructors_regression.c b/test/value_ra_constructors_regression.c index eca384b..536f23a 100644 --- a/test/value_ra_constructors_regression.c +++ b/test/value_ra_constructors_regression.c @@ -38,100 +38,100 @@ err: PROOF static int audit_agree_constructor_regressions(void) { check_value_ra_theorem( - AGREE_RA_UNIT, + agree_ra_unit, `ra_unit agree_ra == (AgreeUnit:(A)agree)`, - "AGREE_RA_UNIT"); + "agree_ra_unit"); check_value_ra_theorem( - AGREE_RA_OWNED_OP, + agree_ra_owned_op, `forall a b:A. ra_op agree_ra (Agree a) (Agree b) == (if a == b then Agree a else (AgreeInvalid:(A)agree))`, - "AGREE_RA_OWNED_OP"); + "agree_ra_owned_op"); check_value_ra_theorem( - AGREE_RA_IDEMPOTENT, + agree_ra_idempotent, `forall a:A. ra_op agree_ra (Agree a) (Agree a) == (Agree a:(A)agree)`, - "AGREE_RA_IDEMPOTENT"); + "agree_ra_idempotent"); check_value_ra_theorem( - AGREE_RA_VALID_UNIT, + agree_ra_valid_unit, `ra_valid agree_ra (AgreeUnit:(A)agree)`, - "AGREE_RA_VALID_UNIT"); + "agree_ra_valid_unit"); check_value_ra_theorem( - AGREE_RA_VALID_OWNED, + agree_ra_valid_owned, `forall a:A. ra_valid agree_ra (Agree a)`, - "AGREE_RA_VALID_OWNED"); + "agree_ra_valid_owned"); check_value_ra_theorem( - AGREE_RA_INVALID, + agree_ra_invalid, `~(ra_valid agree_ra (AgreeInvalid:(A)agree))`, - "AGREE_RA_INVALID"); + "agree_ra_invalid"); check_value_ra_theorem( - AGREE_RA_VALID_COMBINE_IFF, + agree_ra_valid_combine_iff, `forall a b:A. ra_valid agree_ra (ra_op agree_ra (Agree a) (Agree b)) <=> a == b`, - "AGREE_RA_VALID_COMBINE_IFF"); + "agree_ra_valid_combine_iff"); check_value_ra_theorem( - AGREE_RA_AGREEMENT, + agree_ra_agreement, `forall a b:A. ra_compatible agree_ra (Agree a) (Agree b) ==> a == b`, - "AGREE_RA_AGREEMENT"); + "agree_ra_agreement"); check_value_ra_theorem( - AGREE_RA_INCLUDED_OWNED, + agree_ra_included_owned, `forall a b:A. ra_included agree_ra (Agree a) (Agree b) <=> a == b`, - "AGREE_RA_INCLUDED_OWNED"); + "agree_ra_included_owned"); check_value_ra_theorem( - AGREE_RA_NOT_CANCELLATIVE, + agree_ra_not_cancellative, `~(ra_cancellative (agree_ra:((A)agree)ra))`, - "AGREE_RA_NOT_CANCELLATIVE"); + "agree_ra_not_cancellative"); check_value_ra_theorem( - AGREE_RA_UPDATE_IFF, + agree_ra_update_iff, `forall a b:A. ra_update agree_ra (Agree a) (Agree b) <=> a == b`, - "AGREE_RA_UPDATE_IFF"); + "agree_ra_update_iff"); check_value_ra_theorem( - AGREE_RA_LOCAL_UPDATE_IFF, + agree_ra_local_update_iff, `forall a b:A. ra_local_update agree_ra (Agree a) (Agree a) (Agree b) (Agree b) <=> a == b`, - "AGREE_RA_LOCAL_UPDATE_IFF"); + "agree_ra_local_update_iff"); return 0; } PROOF static int audit_frac_constructor_regressions(void) { check_value_ra_theorem( - FRAC_RA_UNIT, + frac_ra_unit, `forall R:(A)ra. ra_unit (frac_ra R) == (frac_empty:(A)frac)`, - "FRAC_RA_UNIT"); + "frac_ra_unit"); check_value_ra_theorem( - FRAC_RA_FULL, + frac_ra_full, `forall a:A. frac_full a == frac_own (&1) a`, - "FRAC_RA_FULL"); + "frac_ra_full"); check_value_ra_theorem( - FRAC_RA_OWN_OP, + frac_ra_own_op, `forall (R:(A)ra) (p:real) (q:real) (a:A) (b:A). &0 < p ==> &0 < q ==> ra_op (frac_ra R) (frac_own p a) (frac_own q b) == frac_own (p + q) (ra_op R a b)`, - "FRAC_RA_OWN_OP"); + "frac_ra_own_op"); check_value_ra_theorem( - FRAC_RA_VALID_OWN, + frac_ra_valid_own, `forall (R:(A)ra) (p:real) (a:A). &0 < p ==> (ra_valid (frac_ra R) (frac_own p a) <=> p <= &1 && ra_valid R a)`, - "FRAC_RA_VALID_OWN"); + "frac_ra_valid_own"); check_value_ra_theorem( - FRAC_RA_EXCLUSIVE_FULL, + frac_ra_exclusive_full, `forall (R:(A)ra) (a:A). ra_valid R a ==> ra_exclusive (frac_ra R) (frac_full a)`, - "FRAC_RA_EXCLUSIVE_FULL"); + "frac_ra_exclusive_full"); check_value_ra_theorem( - FRAC_RA_UPDATE_WEAKEN, + frac_ra_update_weaken, `forall (R:(A)ra) (p:real) (q:real) (a:A) (b:A). &0 < q ==> q <= p ==> @@ -140,9 +140,9 @@ PROOF static int audit_frac_constructor_regressions(void) { (frac_ra R) (frac_own p a) (frac_own q b)`, - "FRAC_RA_UPDATE_WEAKEN"); + "frac_ra_update_weaken"); check_value_ra_theorem( - FRAC_RA_UPDATEP_WEAKEN, + frac_ra_updateP_weaken, `forall (R:(A)ra) (p:real) (q:real) (a:A) (P:A->bool). &0 < q ==> q <= p ==> @@ -152,121 +152,121 @@ PROOF static int audit_frac_constructor_regressions(void) { (frac_own p a) (\x:(A)frac. exists b:A. P b && x == frac_own q b)`, - "FRAC_RA_UPDATEP_WEAKEN"); + "frac_ra_updateP_weaken"); check_value_ra_theorem( - FRAC_RA_UPDATE_FULL_IFF, + frac_ra_update_full_iff, `forall (R:(A)ra) (a:A) (b:A). (ra_update (frac_ra R) (frac_full a) (frac_full b) <=> (ra_valid R a ==> ra_valid R b))`, - "FRAC_RA_UPDATE_FULL_IFF"); + "frac_ra_update_full_iff"); return 0; } PROOF static int audit_option_constructor_regressions(void) { check_value_ra_theorem( - OPTION_RA_UNIT, + option_ra_unit, `forall R:(A)ra. ra_unit (option_ra R) == (NONE:A option)`, - "OPTION_RA_UNIT"); + "option_ra_unit"); check_value_ra_theorem( - OPTION_RA_OP_NONE_L, + option_ra_op_none_l, `forall (R:(A)ra) (x:A option). ra_op (option_ra R) NONE x == x`, - "OPTION_RA_OP_NONE_L"); + "option_ra_op_none_l"); check_value_ra_theorem( - OPTION_RA_OP_SOME_SOME, + option_ra_op_some_some, `forall (R:(A)ra) (a:A) (b:A). ra_op (option_ra R) (SOME a) (SOME b) == SOME (ra_op R a b)`, - "OPTION_RA_OP_SOME_SOME"); + "option_ra_op_some_some"); check_value_ra_theorem( - OPTION_RA_VALID_NONE, + option_ra_valid_none, `forall R:(A)ra. ra_valid (option_ra R) (NONE:A option)`, - "OPTION_RA_VALID_NONE"); + "option_ra_valid_none"); check_value_ra_theorem( - OPTION_RA_VALID_SOME, + option_ra_valid_some, `forall (R:(A)ra) (a:A). ra_valid (option_ra R) (SOME a) <=> ra_valid R a`, - "OPTION_RA_VALID_SOME"); + "option_ra_valid_some"); check_value_ra_theorem( - OPTION_RA_INCLUDED_NONE, + option_ra_included_none, `forall (R:(A)ra) (x:A option). ra_included (option_ra R) NONE x`, - "OPTION_RA_INCLUDED_NONE"); + "option_ra_included_none"); check_value_ra_theorem( - OPTION_RA_INCLUDED_SOME_SOME, + option_ra_included_some_some, `forall (R:(A)ra) (a:A) (b:A). ra_included (option_ra R) (SOME a) (SOME b) <=> ra_included R a b`, - "OPTION_RA_INCLUDED_SOME_SOME"); + "option_ra_included_some_some"); check_value_ra_theorem( - OPTION_RA_NOT_INCLUDED_SOME_NONE, + option_ra_not_included_some_none, `forall (R:(A)ra) (a:A). ~(ra_included (option_ra R) (SOME a) NONE)`, - "OPTION_RA_NOT_INCLUDED_SOME_NONE"); + "option_ra_not_included_some_none"); check_value_ra_theorem( - OPTION_RA_SOME_UNIT_NE_NONE, + option_ra_some_unit_ne_none, `forall R:(A)ra. ~((SOME (ra_unit R):A option) == NONE)`, - "OPTION_RA_SOME_UNIT_NE_NONE"); + "option_ra_some_unit_ne_none"); check_value_ra_theorem( - OPTION_RA_NOT_CANCELLATIVE, + option_ra_not_cancellative, `forall R:(A)ra. ~(ra_cancellative (option_ra R))`, - "OPTION_RA_NOT_CANCELLATIVE"); + "option_ra_not_cancellative"); check_value_ra_theorem( - OPTION_RA_UPDATEP_IFF, + option_ra_updateP_iff, `forall (R:(A)ra) (a:A) (P:A->bool). ra_updateP (option_ra R) (SOME a) (\x:A option. exists b:A. P b && x == SOME b) <=> ra_updateP R a P`, - "OPTION_RA_UPDATEP_IFF"); + "option_ra_updateP_iff"); check_value_ra_theorem( - OPTION_RA_UPDATE_IFF, + option_ra_update_iff, `forall (R:(A)ra) (a:A) (b:A). ra_update (option_ra R) (SOME a) (SOME b) <=> ra_update R a b`, - "OPTION_RA_UPDATE_IFF"); + "option_ra_update_iff"); check_value_ra_theorem( - OPTION_RA_LOCAL_UPDATE_IFF, + option_ra_local_update_iff, `forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). ra_local_update (option_ra R) (SOME a) (SOME f) (SOME b) (SOME g) <=> ra_local_update R a f b g`, - "OPTION_RA_LOCAL_UPDATE_IFF"); + "option_ra_local_update_iff"); return 0; } PROOF static int audit_max_nat_constructor_regressions(void) { check_value_ra_theorem( - MAX_NAT_RA_UNIT, + max_nat_ra_unit, `ra_unit max_nat_ra == 0`, - "MAX_NAT_RA_UNIT"); + "max_nat_ra_unit"); check_value_ra_theorem( - MAX_NAT_RA_OP, + max_nat_ra_op, `forall a b:num. ra_op max_nat_ra a b == MAX a b`, - "MAX_NAT_RA_OP"); + "max_nat_ra_op"); check_value_ra_theorem( - MAX_NAT_RA_VALID, + max_nat_ra_valid, `forall n:num. ra_valid max_nat_ra n`, - "MAX_NAT_RA_VALID"); + "max_nat_ra_valid"); check_value_ra_theorem( - MAX_NAT_RA_INCLUDED, + max_nat_ra_included, `forall a b:num. ra_included max_nat_ra a b <=> a <= b`, - "MAX_NAT_RA_INCLUDED"); + "max_nat_ra_included"); check_value_ra_theorem( - MAX_NAT_RA_IDEMPOTENT, + max_nat_ra_idempotent, `forall n:num. ra_op max_nat_ra n n == n`, - "MAX_NAT_RA_IDEMPOTENT"); + "max_nat_ra_idempotent"); check_value_ra_theorem( - MAX_NAT_RA_UPDATE, + max_nat_ra_update, `forall a b:num. ra_update max_nat_ra a b`, - "MAX_NAT_RA_UPDATE"); + "max_nat_ra_update"); return 0; } diff --git a/theory/c_program_logic/c_basic_update.c b/theory/c_program_logic/c_basic_update.c index 4ebd9f5..0d2e19a 100644 --- a/theory/c_program_logic/c_basic_update.c +++ b/theory/c_program_logic/c_basic_update.c @@ -35,7 +35,7 @@ PROOF static thm prove_c_bupd_preserves_phys(void) { c_resource_ra_def, c_bupd_def, r_bupd_right_def, - PROD_RA_VALID))); + prod_ra_valid))); body = GEN_TAC(body, "G"); body = GEN_TAC(body, "Q"); body = GEN_TAC(body, "resource"); @@ -52,7 +52,7 @@ PROOF static thm prove_c_bupd_preserves_phys(void) { body, CONST_STRING_LIST("Hupdate")); thm result = match_mp_rule( - RA_UPDATEP_VALID, + ra_updateP_valid, assume_rule(update_terms[0])); result = match_mp_rule(result, ghost_valid); result = conv_rule( @@ -71,14 +71,14 @@ PROOF static thm prove_c_bupd_preserves_phys(void) { return gnode_prove(root); } -PROOF thm C_BUPD_PRESERVES_PHYS = +PROOF thm c_bupd_preserves_phys = prove_c_bupd_preserves_phys(); PROOF static int audit_c_basic_update(void) { thm_list public_theorems = THM_LIST( c_bupd_def, c_viewshift_def, - C_BUPD_PRESERVES_PHYS); + c_bupd_preserves_phys); for (size_t i = 0; i < vector_size(public_theorems); ++i) { ENSURE_COND(!IS_NULL(public_theorems[i]), "C update theorem %zu is empty", i); diff --git a/theory/c_program_logic/c_basic_update.h b/theory/c_program_logic/c_basic_update.h index 0513d74..96989ff 100644 --- a/theory/c_program_logic/c_basic_update.h +++ b/theory/c_program_logic/c_basic_update.h @@ -1,14 +1,31 @@ -#pragma once +/** + * @file c_basic_update.h + * @brief Ghost-only updates for the complete C resource. + * + * These aliases specialize the generic product modality to + * `c_resource_ra G == prod_ra mem_ra G`. A C view shift may update only the + * complete global ghost projection `G`; it cannot perform an algebraic update + * of physical memory. Physical-memory changes remain the responsibility of + * certified C command semantics. + */ -/* C program-level updates may change only the global ghost component. */ +#pragma once #include "proof/theory/c_program_logic/c_resource.h" -/* `c_bupd G == r_bupd_right mem_ra G`. */ +/** `c_bupd G == r_bupd_right mem_ra G`. */ PROOF extern thm c_bupd_def; -/* `c_viewshift G == r_viewshift_right mem_ra G`. */ +/** `c_viewshift G == r_viewshift_right mem_ra G`. */ PROOF extern thm c_viewshift_def; -/* Every observable result keeps the source physical projection. */ -PROOF extern thm C_BUPD_PRESERVES_PHYS; +/** + * Safety boundary for valid sources: + * + * ```text + * ra_valid (c_resource_ra G) resource ==> + * c_bupd G Q resource ==> + * exists ghost'. Q (FST resource,ghost'). + * ``` + */ +PROOF extern thm c_bupd_preserves_phys; diff --git a/theory/c_program_logic/c_fnspec.h b/theory/c_program_logic/c_fnspec.h index 83feec8..5da7142 100644 --- a/theory/c_program_logic/c_fnspec.h +++ b/theory/c_program_logic/c_fnspec.h @@ -12,12 +12,15 @@ * int -> ctype -> (B -> Prop_G) -> (B -> Prop_G) -> Prop_G * ``` * - * where `Prop_G = carrier(c_resource_ra G) -> bool`. They are deliberately - * opaque: their operational meaning is part of the certified C-logic/QCP - * boundary, not an RA or BI equation. The named-resource installer - * `c_logic_install_named(R)` specializes `G` to `named_ra R`, creates scoped - * `fnspec`/`fnspec_w` aliases, and includes them in its immutable runtime - * descriptor. + * where `Prop_G = carrier(c_resource_ra G) -> bool` and `G` denotes the whole + * global ghost algebra, not a payload RA hidden under an implicit name map. + * The markers are deliberately opaque: their operational meaning belongs to + * the certified C-logic/QCP boundary, not to an RA or BI equation. + * + * The named-resource installer `c_logic_install_named(R)` explicitly selects + * `G = named_ra R`, creates scoped `fnspec`/`fnspec_w` aliases, and includes + * them in its immutable runtime descriptor. This header declares no theorem + * equations for the two opaque markers. */ #pragma once diff --git a/theory/c_program_logic/c_ghost.c b/theory/c_program_logic/c_ghost.c index 809981a..81dd558 100644 --- a/theory/c_program_logic/c_ghost.c +++ b/theory/c_program_logic/c_ghost.c @@ -32,7 +32,7 @@ PROOF static thm prove_c_ghost_own_op(void) { THM_LIST(r_equiv_def), ispecl_rule( TERM_LIST(`G:(A)ra`, `a:A`, `b:A`), - R_OWN_OP)); + r_own_op)); thm own_forward = conjunct1_rule(own_equiv); thm own_reverse = conjunct2_rule(own_equiv); thm lifted_forward = mp_rule( @@ -41,7 +41,7 @@ PROOF static thm prove_c_ghost_own_op(void) { `mem_ra`, `G:(A)ra`, `r_own G (ra_op G (a:A) (b:A))`, `r_sep G (r_own G (a:A)) (r_own G (b:A))`), - R_LIFT_RIGHT_ENTAILS), + r_lift_right_entails), own_forward); thm lifted_reverse = mp_rule( ispecl_rule( @@ -49,7 +49,7 @@ PROOF static thm prove_c_ghost_own_op(void) { `mem_ra`, `G:(A)ra`, `r_sep G (r_own G (a:A)) (r_own G (b:A))`, `r_own G (ra_op G (a:A) (b:A))`), - R_LIFT_RIGHT_ENTAILS), + r_lift_right_entails), own_reverse); thm sep_equiv = rewrite_rule( THM_LIST(r_equiv_def), @@ -57,7 +57,7 @@ PROOF static thm prove_c_ghost_own_op(void) { TERM_LIST( `mem_ra`, `G:(A)ra`, `r_own G (a:A)`, `r_own G (b:A)`), - R_LIFT_RIGHT_SEP)); + r_lift_right_sep)); thm sep_forward = conjunct1_rule(sep_equiv); thm sep_reverse = conjunct2_rule(sep_equiv); @@ -73,7 +73,7 @@ PROOF static thm prove_c_ghost_own_op(void) { `r_sep (prod_ra mem_ra G) (r_lift_right mem_ra G (r_own G (a:A))) (r_lift_right mem_ra G (r_own G (b:A)))`), - R_ENTAILS_TRANS), + r_entails_trans), lifted_forward), sep_forward); thm reverse = mp_rule( @@ -88,7 +88,7 @@ PROOF static thm prove_c_ghost_own_op(void) { (r_sep G (r_own G (a:A)) (r_own G (b:A)))`, `r_lift_right mem_ra G (r_own G (ra_op G (a:A) (b:A)))`), - R_ENTAILS_TRANS), + r_entails_trans), sep_reverse), lifted_reverse); thm result = mp_rule( @@ -101,14 +101,14 @@ PROOF static thm prove_c_ghost_own_op(void) { `r_sep (prod_ra mem_ra G) (r_lift_right mem_ra G (r_own G (a:A))) (r_lift_right mem_ra G (r_own G (b:A)))`), - R_EQUIV_INTRO), + r_equiv_intro), forward), reverse); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm C_GHOST_OWN_OP = prove_c_ghost_own_op(); +PROOF thm c_ghost_own_op = prove_c_ghost_own_op(); PROOF static thm prove_c_ghost_own_valid(void) { gnode root = gnode_new_with_ccl(` @@ -132,7 +132,7 @@ PROOF static thm prove_c_ghost_own_valid(void) { r_own_def, r_sep_def, r_fact_def, - PROD_RA_VALID))); + prod_ra_valid))); body = GEN_TAC(body, "G"); body = GEN_TAC(body, "a"); body = GEN_TAC(body, "resource"); @@ -160,7 +160,7 @@ PROOF static thm prove_c_ghost_own_valid(void) { TERM_LIST( `prod_ra mem_ra (G:(A)ra)`, `resource:((int,(pmem_byte_state)excl)finmap)#A`), - RA_UNIT_L))); + ra_unit_l))); gnode_list predicates = CONJ_TAC(split[1]); gnode_list fact = CONJ_TAC(predicates[0]); ACCEPT_TAC(fact[0], valid_a); @@ -180,7 +180,7 @@ PROOF static thm prove_c_ghost_own_valid(void) { return gnode_prove(root); } -PROOF thm C_GHOST_OWN_VALID = prove_c_ghost_own_valid(); +PROOF thm c_ghost_own_valid = prove_c_ghost_own_valid(); PROOF static thm prove_c_ghost_own_update(void) { gnode root = gnode_new_with_ccl(` @@ -198,15 +198,15 @@ PROOF static thm prove_c_ghost_own_update(void) { thm result = mp_rule( ispecl_rule( TERM_LIST(`mem_ra`, `G:(A)ra`, `a:A`, `b:A`), - R_RIGHT_OWN_UPDATE), + r_right_own_update), assume_rule(`ra_update (G:(A)ra) (a:A) (b:A)`)); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm C_GHOST_OWN_UPDATE = prove_c_ghost_own_update(); +PROOF thm c_ghost_own_update = prove_c_ghost_own_update(); -PROOF static thm prove_c_ghost_own_updatep(void) { +PROOF static thm prove_c_ghost_own_updateP(void) { gnode root = gnode_new_with_ccl(` forall (G:(A)ra) (a:A) (P:A->bool). ra_updateP G a P ==> @@ -232,13 +232,13 @@ PROOF static thm prove_c_ghost_own_updatep(void) { thm result = mp_rule( ispecl_rule( TERM_LIST(`mem_ra`, `G:(A)ra`, `a:A`, `P:A->bool`), - R_RIGHT_OWN_UPDATEP), + r_right_own_updateP), assume_rule(`ra_updateP (G:(A)ra) (a:A) (P:A->bool)`)); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm C_GHOST_OWN_UPDATEP = prove_c_ghost_own_updatep(); +PROOF thm c_ghost_own_updateP = prove_c_ghost_own_updateP(); PROOF static thm prove_c_ghost_own_drop(void) { gnode root = gnode_new_with_ccl(` @@ -262,8 +262,8 @@ PROOF static thm prove_c_ghost_own_drop(void) { r_own_def, r_emp_def, ra_updateP_def, - PROD_RA_VALID, - PROD_RA_UNIT))); + prod_ra_valid, + prod_ra_unit))); body = CONV_TAC(body, depth_conv(get_conversion_by_name("BETA_CONV"))); body = GEN_TAC(body, "G"); body = GEN_TAC(body, "a"); @@ -280,7 +280,7 @@ PROOF static thm prove_c_ghost_own_drop(void) { `G:(A)ra`, `SND (owned:((int,(pmem_byte_state)excl)finmap)#A)`, `frame:A`), - RA_VALID_OP), + ra_valid_op), assume_rule(` ra_valid (G:(A)ra) @@ -312,12 +312,12 @@ PROOF static thm prove_c_ghost_own_drop(void) { `ra_valid (G:(A)ra):A->bool`, gsym_rule(ispecl_rule( TERM_LIST(`G:(A)ra`, `frame:A`), - RA_UNIT_L))), + ra_unit_l))), valid_frame)); return gnode_prove(root); } -PROOF thm C_GHOST_OWN_DROP = prove_c_ghost_own_drop(); +PROOF thm c_ghost_own_drop = prove_c_ghost_own_drop(); PROOF thm c_named_own_def = new_fun_definition(` c_named_own @@ -349,15 +349,15 @@ PROOF static thm prove_c_named_own_op(void) { `named_ra (R:(A)ra)`, `finmap_singleton (name:num) (a:A)`, `finmap_singleton (name:num) (b:A)`), - C_GHOST_OWN_OP); + c_ghost_own_op); result = rewrite_rule( - THM_LIST(NAMED_RA_SINGLETON_OP), + THM_LIST(named_ra_singleton_op), result); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm C_NAMED_OWN_OP = prove_c_named_own_op(); +PROOF thm c_named_own_op = prove_c_named_own_op(); PROOF static thm prove_c_named_own_valid(void) { gnode root = gnode_new_with_ccl(` @@ -380,15 +380,15 @@ PROOF static thm prove_c_named_own_valid(void) { TERM_LIST( `named_ra (R:(A)ra)`, `finmap_singleton (name:num) (a:A)`), - C_GHOST_OWN_VALID); + c_ghost_own_valid); result = rewrite_rule( - THM_LIST(NAMED_RA_VALID_SINGLETON), + THM_LIST(named_ra_valid_singleton), result); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm C_NAMED_OWN_VALID = prove_c_named_own_valid(); +PROOF thm c_named_own_valid = prove_c_named_own_valid(); PROOF static thm prove_c_named_own_update(void) { gnode root = gnode_new_with_ccl(` @@ -406,7 +406,7 @@ PROOF static thm prove_c_named_own_update(void) { thm map_update = mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `name:num`, `a:A`, `b:A`), - NAMED_RA_UPDATE_SINGLETON), + named_ra_update_singleton), assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); thm result = mp_rule( ispecl_rule( @@ -414,15 +414,15 @@ PROOF static thm prove_c_named_own_update(void) { `named_ra (R:(A)ra)`, `finmap_singleton (name:num) (a:A)`, `finmap_singleton (name:num) (b:A)`), - C_GHOST_OWN_UPDATE), + c_ghost_own_update), map_update); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm C_NAMED_OWN_UPDATE = prove_c_named_own_update(); +PROOF thm c_named_own_update = prove_c_named_own_update(); -PROOF static thm prove_c_named_own_updatep(void) { +PROOF static thm prove_c_named_own_updateP(void) { gnode root = gnode_new_with_ccl(` forall (R:(A)ra) (name:num) (a:A) (P:A->bool). ra_updateP R a P ==> @@ -480,7 +480,7 @@ PROOF static thm prove_c_named_own_updatep(void) { ispecl_rule( TERM_LIST( `R:(A)ra`, `name:num`, `a:A`, `P:A->bool`), - NAMED_RA_UPDATEP_SINGLETON), + named_ra_updateP_singleton), payload_update); map_update = rewrite_rule(THM_LIST(ra_updateP_def), map_update); thm source_eq = beta_rule(ap_term_rule( @@ -553,7 +553,7 @@ PROOF static thm prove_c_named_own_updatep(void) { `(FST (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap), selected:(num,A)finmap)`), - RA_UNIT_L))); + ra_unit_l))); gnode_list predicates = CONJ_TAC(post_split[1]); gnode_list fact = CONJ_TAC(predicates[0]); ACCEPT_TAC(fact[0], assume_rule(`(P:A->bool) (b:A)`)); @@ -603,8 +603,8 @@ PROOF static thm prove_c_named_own_updatep(void) { return gnode_prove(root); } -PROOF thm C_NAMED_OWN_UPDATEP = - prove_c_named_own_updatep(); +PROOF thm c_named_own_updateP = + prove_c_named_own_updateP(); PROOF static thm prove_c_named_own_drop(void) { gnode root = gnode_new_with_ccl(` @@ -622,12 +622,12 @@ PROOF static thm prove_c_named_own_drop(void) { TERM_LIST( `named_ra (R:(A)ra)`, `finmap_singleton (name:num) (a:A)`), - C_GHOST_OWN_DROP); + c_ghost_own_drop); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm C_NAMED_OWN_DROP = prove_c_named_own_drop(); +PROOF thm c_named_own_drop = prove_c_named_own_drop(); PROOF static thm prove_c_named_own_alloc(void) { gnode root = gnode_new_with_ccl(` @@ -663,7 +663,7 @@ PROOF static thm prove_c_named_own_alloc(void) { r_exists_def, r_sep_def, ra_updateP_def, - PROD_RA_OP))); + prod_ra_op))); body = CONV_TAC(body, depth_conv(get_conversion_by_name("BETA_CONV"))); body = GEN_TAC(body, "R"); body = GEN_TAC(body, "a"); @@ -690,7 +690,7 @@ PROOF static thm prove_c_named_own_alloc(void) { `SND (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)`, `a:A`), - NAMED_RA_ALLOC), + named_ra_alloc), assume_rule(valid_a_terms[0])); allocation = rewrite_rule(THM_LIST(ra_updateP_def), allocation); thm selected = mp_rule( @@ -746,7 +746,7 @@ PROOF static thm prove_c_named_own_alloc(void) { `a:A`, `SND (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)`), - GMAP_RA_SINGLETON_OP_FRESH), + gmap_ra_singleton_op_fresh), assume_rule(` finmap_lookup (SND @@ -762,7 +762,7 @@ PROOF static thm prove_c_named_own_alloc(void) { `mem_ra`, `FST (owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)`), - RA_UNIT_L)); + ra_unit_l)); thm ghost_eq = trans_rule( assume_rule(` (result:(num,A)finmap) == @@ -797,7 +797,7 @@ PROOF static thm prove_c_named_own_alloc(void) { `named_ra (R:(A)ra)`, `(ra_unit mem_ra,finmap_singleton (name:num) (a:A))`, `owned:((int,(pmem_byte_state)excl)finmap)#(num,A)finmap`), - PROD_RA_OP); + prod_ra_op); prod_op = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -842,22 +842,22 @@ PROOF static thm prove_c_named_own_alloc(void) { return gnode_prove(root); } -PROOF thm C_NAMED_OWN_ALLOC = prove_c_named_own_alloc(); +PROOF thm c_named_own_alloc = prove_c_named_own_alloc(); PROOF static int audit_c_ghost(void) { thm_list public_theorems = THM_LIST( - C_GHOST_OWN_OP, - C_GHOST_OWN_VALID, - C_GHOST_OWN_UPDATE, - C_GHOST_OWN_UPDATEP, - C_GHOST_OWN_DROP, + c_ghost_own_op, + c_ghost_own_valid, + c_ghost_own_update, + c_ghost_own_updateP, + c_ghost_own_drop, c_named_own_def, - C_NAMED_OWN_OP, - C_NAMED_OWN_VALID, - C_NAMED_OWN_UPDATE, - C_NAMED_OWN_UPDATEP, - C_NAMED_OWN_DROP, - C_NAMED_OWN_ALLOC); + c_named_own_op, + c_named_own_valid, + c_named_own_update, + c_named_own_updateP, + c_named_own_drop, + c_named_own_alloc); for (size_t i = 0; i < vector_size(public_theorems); ++i) { ENSURE_COND(!IS_NULL(public_theorems[i]), "C ghost theorem %zu is empty", i); diff --git a/theory/c_program_logic/c_ghost.h b/theory/c_program_logic/c_ghost.h index 406eae7..04c1290 100644 --- a/theory/c_program_logic/c_ghost.h +++ b/theory/c_program_logic/c_ghost.h @@ -1,21 +1,52 @@ -#pragma once +/** + * @file c_ghost.h + * @brief Ownership and ghost-only updates for a complete global ghost RA. + * + * `c_ghost_own G a` is the exact right lift of `r_own G a`; its physical + * projection is therefore exactly `ra_unit mem_ra`. The update laws below + * use `c_viewshift G`, so physical memory is preserved by construction. + * + * Resource-independent propositions and spatial facts remain distinct. In + * particular, validity and predicate-update witnesses are returned as + * exact-unit `r_fact` assertions next to the retained/new ownership; they are + * not encoded as resource-independent `r_pure` assertions. + */ -/* Generic ownership and updates for the complete global ghost RA. */ +#pragma once #include "proof/theory/c_program_logic/c_basic_update.h" #include "proof/theory/logic/named_ra.h" -PROOF extern thm C_GHOST_OWN_OP; -PROOF extern thm C_GHOST_OWN_VALID; -PROOF extern thm C_GHOST_OWN_UPDATE; -PROOF extern thm C_GHOST_OWN_UPDATEP; -PROOF extern thm C_GHOST_OWN_DROP; +/* Generic laws for an arbitrary complete global RA `G`. */ +/** Ghost ownership preserves `ra_op` splitting/joining up to `r_equiv`. */ +PROOF extern thm c_ghost_own_op; +/** Expose `ra_valid G a` as an exact-unit fact while retaining ownership. */ +PROOF extern thm c_ghost_own_valid; +/** Lift a deterministic `ra_update G a b` to a ghost-only C view shift. */ +PROOF extern thm c_ghost_own_update; +/** Lift `ra_updateP`; return a witness, exact-unit fact, and new ownership. */ +PROOF extern thm c_ghost_own_updateP; +/** Explicitly discard the owned global ghost fragment. */ +PROOF extern thm c_ghost_own_drop; -/* Convenience layer when the complete global RA is one named RA. */ +/** + * Convenience layer for `G = named_ra R`, the finite name map of payload RA + * `R`. Updates and drops affect one fixed name. Allocation requires a valid + * payload and returns an existential fresh name while framing the source + * assertion. “Drop” is intentional: this API does not call the operation + * deallocation. + */ +/** Exact ownership of payload `a` at `name` in `named_ra R`. */ PROOF extern thm c_named_own_def; -PROOF extern thm C_NAMED_OWN_OP; -PROOF extern thm C_NAMED_OWN_VALID; -PROOF extern thm C_NAMED_OWN_UPDATE; -PROOF extern thm C_NAMED_OWN_UPDATEP; -PROOF extern thm C_NAMED_OWN_DROP; -PROOF extern thm C_NAMED_OWN_ALLOC; +/** Named ownership preserves payload `ra_op` up to `r_equiv`. */ +PROOF extern thm c_named_own_op; +/** Expose payload validity as an exact-unit fact and retain named ownership. */ +PROOF extern thm c_named_own_valid; +/** Update the payload at one fixed name. */ +PROOF extern thm c_named_own_update; +/** Predicate-update one name and return witness, fact, and new ownership. */ +PROOF extern thm c_named_own_updateP; +/** Drop this fragment's contribution at one fixed name. */ +PROOF extern thm c_named_own_drop; +/** Allocate a fresh name for a valid payload while framing the source. */ +PROOF extern thm c_named_own_alloc; diff --git a/theory/c_program_logic/c_integer.c b/theory/c_program_logic/c_integer.c index 82ee923..026a5b8 100644 --- a/theory/c_program_logic/c_integer.c +++ b/theory/c_program_logic/c_integer.c @@ -76,7 +76,7 @@ PROOF static thm prove_unsigned_last_nbits_id(void) { return gnode_prove(root); } -PROOF thm UNSIGNED_LAST_NBITS_ID = +PROOF thm unsigned_last_nbits_id = prove_unsigned_last_nbits_id(); /* ------------------------------------------------------------------------- */ @@ -189,7 +189,7 @@ PROOF static int c_integer_register_theorems(void) { "duplicate C-integer theorem name: " name) thm exp_2_api = gen_rule(`width:int`, c_exp_2_def); - REGISTER_THEOREM("INT_EXP_2_DEF", exp_2_api); + REGISTER_THEOREM("int_exp_2_def", exp_2_api); REGISTER_THEOREM("max_unsigned_def", c_max_unsigned_def); REGISTER_THEOREM("max_signed_def", c_max_signed_def); REGISTER_THEOREM("min_signed_def", c_min_signed_def); @@ -197,7 +197,7 @@ PROOF static int c_integer_register_theorems(void) { REGISTER_THEOREM("cast_signed_def", cast_signed_def); REGISTER_THEOREM("unsigned_last_nbits_def", unsigned_last_nbits_def); REGISTER_THEOREM("signed_last_nbits_def", signed_last_nbits_def); - REGISTER_THEOREM("unsigned_last_nbits_id", UNSIGNED_LAST_NBITS_ID); + REGISTER_THEOREM("unsigned_last_nbits_id", unsigned_last_nbits_id); REGISTER_THEOREM("i32_and_def", i32_and_def); REGISTER_THEOREM("i32_or_def", i32_or_def); diff --git a/theory/c_program_logic/c_integer.h b/theory/c_program_logic/c_integer.h index 156341d..2f5ac56 100644 --- a/theory/c_program_logic/c_integer.h +++ b/theory/c_program_logic/c_integer.h @@ -39,7 +39,7 @@ PROOF extern thm signed_last_nbits_def; * unsigned_last_nbits x n = x * ``` */ -PROOF extern thm UNSIGNED_LAST_NBITS_ID; +PROOF extern thm unsigned_last_nbits_id; /* ------------------------------------------------------------------------- */ /* Fixed-width bit operations */ diff --git a/theory/c_program_logic/c_memory.c b/theory/c_program_logic/c_memory.c index 447ef67..7bbd37f 100644 --- a/theory/c_program_logic/c_memory.c +++ b/theory/c_program_logic/c_memory.c @@ -116,7 +116,7 @@ PROOF static thm prove_pmem_c_address_ok_tuint64(void) { return gnode_prove(root); } -PROOF thm PMEM_C_ADDRESS_OK_TUINT64 = +PROOF thm pmem_c_address_ok_Tuint64 = prove_pmem_c_address_ok_tuint64(); /* ------------------------------------------------------------------------- */ @@ -166,14 +166,14 @@ PROOF static thm prove_c_allocated_at_zero(void) { `); CONV_TAC(root, rewrite_conv(THM_LIST( c_allocated_at_def, - PMEM_ALLOCATED_AT_ZERO, + pmem_allocated_at_zero, c_lift_phys_def, c_resource_ra_def, - R_LIFT_LEFT_EMP_EQ))); + r_lift_left_emp_eq))); return gnode_prove(root); } -PROOF thm C_ALLOCATED_AT_ZERO = +PROOF thm c_allocated_at_zero = prove_c_allocated_at_zero(); PROOF static thm prove_c_allocated_at_append(void) { @@ -187,14 +187,14 @@ PROOF static thm prove_c_allocated_at_append(void) { `); CONV_TAC(root, rewrite_conv(THM_LIST( c_allocated_at_def, - PMEM_ALLOCATED_AT_APPEND, + pmem_allocated_at_append, c_lift_phys_def, c_resource_ra_def, - R_LIFT_LEFT_SEP_EQ))); + r_lift_left_sep_eq))); return gnode_prove(root); } -PROOF thm C_ALLOCATED_AT_APPEND = +PROOF thm c_allocated_at_append = prove_c_allocated_at_append(); PROOF static thm prove_pmem_data_at_allocated_at(void) { @@ -225,7 +225,7 @@ PROOF static thm prove_pmem_data_at_allocated_at(void) { `address:int`, `pmem_c_width (ty:ctype)`, `integer_value:int`), - PMEM_SCALAR_AT_ALLOCATED); + pmem_scalar_at_allocated); allocated = pure_once_rewrite_rule( THM_LIST(r_entails_def), allocated); allocated = spec_rule(` @@ -250,7 +250,7 @@ PROOF static thm prove_pmem_data_at_allocated_at(void) { return gnode_prove(root); } -PROOF thm PMEM_DATA_AT_ALLOCATED_AT = +PROOF thm pmem_data_at_allocated_at = prove_pmem_data_at_allocated_at(); PROOF static thm prove_pmem_undef_data_at_allocated_at(void) { @@ -261,7 +261,7 @@ PROOF static thm prove_pmem_undef_data_at_allocated_at(void) { `mem_ra`, `r_pure mem_ra (pmem_c_address_ok (address:int) (ty:ctype))`, target), - R_AND_ELIM_R); + r_and_elim_r); eliminate_wrapper = pure_once_rewrite_rule( THM_LIST(gsym_rule(pmem_undef_data_at_def)), eliminate_wrapper); @@ -269,7 +269,7 @@ PROOF static thm prove_pmem_undef_data_at_allocated_at(void) { TERM_LIST(`address:int`, `ty:ctype`), eliminate_wrapper); } -PROOF thm PMEM_UNDEF_DATA_AT_ALLOCATED_AT = +PROOF thm pmem_undef_data_at_allocated_at = prove_pmem_undef_data_at_allocated_at(); PROOF static thm prove_pmem_allocated_at_to_undef_data_at(void) { @@ -285,14 +285,14 @@ PROOF static thm prove_pmem_allocated_at_to_undef_data_at(void) { term allocated = `pmem_allocated_at (address:int) (pmem_c_width (ty:ctype))`; thm reflexivity = ispecl_rule( - TERM_LIST(`mem_ra`, allocated), R_ENTAILS_REFL); + TERM_LIST(`mem_ra`, allocated), r_entails_refl); thm introduce = ispecl_rule( TERM_LIST( `mem_ra`, `pmem_c_address_ok (address:int) (ty:ctype)`, allocated, allocated), - R_PURE_AND_INTRO); + r_pure_and_intro); thm with_address = match_mp_rule( introduce, assume_rule(`pmem_c_address_ok (address:int) (ty:ctype)`)); @@ -303,7 +303,7 @@ PROOF static thm prove_pmem_allocated_at_to_undef_data_at(void) { return gnode_prove(root); } -PROOF thm PMEM_ALLOCATED_AT_TO_UNDEF_DATA_AT = +PROOF thm pmem_allocated_at_to_undef_data_at = prove_pmem_allocated_at_to_undef_data_at(); PROOF static thm prove_pmem_data_at_to_undef_data_at(void) { @@ -341,7 +341,7 @@ PROOF static thm prove_pmem_data_at_to_undef_data_at(void) { `address:int`, `pmem_c_width (ty:ctype)`, `integer_value:int`), - PMEM_SCALAR_AT_ALLOCATED); + pmem_scalar_at_allocated); allocated = pure_once_rewrite_rule( THM_LIST(r_entails_def), allocated); allocated = spec_rule(` @@ -366,7 +366,7 @@ PROOF static thm prove_pmem_data_at_to_undef_data_at(void) { return gnode_prove(root); } -PROOF thm PMEM_DATA_AT_TO_UNDEF_DATA_AT = +PROOF thm pmem_data_at_to_undef_data_at = prove_pmem_data_at_to_undef_data_at(); PROOF static thm prove_pmem_undef_scalar_at_tuint64(void) { @@ -386,10 +386,10 @@ PROOF static thm prove_pmem_undef_scalar_at_tuint64(void) { term address_ok = `pmem_c_address_ok (address:int) Tuint64`; thm strict_to_allocated = ispecl_rule( TERM_LIST(`8:num`, `address:int`), - PMEM_UNDEF_SCALAR_AT_ALLOCATED); + pmem_undef_scalar_at_allocated); thm introduce_pure = ispecl_rule( TERM_LIST(`mem_ra`, address_ok, source, allocated), - R_PURE_AND_INTRO); + r_pure_and_intro); thm with_address = match_mp_rule( introduce_pure, assume_rule(address_ok)); @@ -411,7 +411,7 @@ PROOF static thm prove_pmem_undef_scalar_at_tuint64(void) { return gnode_prove(root); } -PROOF thm PMEM_UNDEF_SCALAR_AT_TUINT64 = +PROOF thm pmem_undef_scalar_at_Tuint64 = prove_pmem_undef_scalar_at_tuint64(); /* ------------------------------------------------------------------------- */ @@ -458,10 +458,10 @@ PROOF static thm prove_c_allocated_at_to_undef_data_at(void) { `pmem_allocated_at (address:int) (pmem_c_width (ty:ctype))`, `pmem_undef_data_at (address:int) (ty:ctype)`), - R_LIFT_LEFT_ENTAILS); + r_lift_left_entails); thm physical = ispecl_rule( TERM_LIST(`address:int`, `ty:ctype`), - PMEM_ALLOCATED_AT_TO_UNDEF_DATA_AT); + pmem_allocated_at_to_undef_data_at); physical = match_mp_rule( physical, assume_rule(`pmem_c_address_ok (address:int) (ty:ctype)`)); @@ -469,7 +469,7 @@ PROOF static thm prove_c_allocated_at_to_undef_data_at(void) { return gnode_prove(root); } -PROOF thm C_ALLOCATED_AT_TO_UNDEF_DATA_AT = +PROOF thm c_allocated_at_to_undef_data_at = prove_c_allocated_at_to_undef_data_at(); PROOF static thm prove_c_data_at_to_undef_data_at(void) { @@ -496,15 +496,15 @@ PROOF static thm prove_c_data_at_to_undef_data_at(void) { `pmem_data_at (address:int) (ty:ctype) (integer_value:int)`, `pmem_undef_data_at (address:int) (ty:ctype)`), - R_LIFT_LEFT_ENTAILS); + r_lift_left_entails); thm physical = ispecl_rule( TERM_LIST(`address:int`, `ty:ctype`, `integer_value:int`), - PMEM_DATA_AT_TO_UNDEF_DATA_AT); + pmem_data_at_to_undef_data_at); ACCEPT_TAC(body, match_mp_rule(lift, physical)); return gnode_prove(root); } -PROOF thm C_DATA_AT_TO_UNDEF_DATA_AT = +PROOF thm c_data_at_to_undef_data_at = prove_c_data_at_to_undef_data_at(); PROOF static thm prove_c_data_at_allocated_at(void) { @@ -532,15 +532,15 @@ PROOF static thm prove_c_data_at_allocated_at(void) { (address:int) (ty:ctype) (integer_value:int)`, `pmem_allocated_at (address:int) (pmem_c_width (ty:ctype))`), - R_LIFT_LEFT_ENTAILS); + r_lift_left_entails); thm physical = ispecl_rule( TERM_LIST(`address:int`, `ty:ctype`, `integer_value:int`), - PMEM_DATA_AT_ALLOCATED_AT); + pmem_data_at_allocated_at); ACCEPT_TAC(body, match_mp_rule(lift, physical)); return gnode_prove(root); } -PROOF thm C_DATA_AT_ALLOCATED_AT = +PROOF thm c_data_at_allocated_at = prove_c_data_at_allocated_at(); PROOF static thm prove_c_undef_data_at_allocated_at(void) { @@ -563,15 +563,15 @@ PROOF static thm prove_c_undef_data_at_allocated_at(void) { `pmem_undef_data_at (address:int) (ty:ctype)`, `pmem_allocated_at (address:int) (pmem_c_width (ty:ctype))`), - R_LIFT_LEFT_ENTAILS); + r_lift_left_entails); thm physical = ispecl_rule( TERM_LIST(`address:int`, `ty:ctype`), - PMEM_UNDEF_DATA_AT_ALLOCATED_AT); + pmem_undef_data_at_allocated_at); ACCEPT_TAC(body, match_mp_rule(lift, physical)); return gnode_prove(root); } -PROOF thm C_UNDEF_DATA_AT_ALLOCATED_AT = +PROOF thm c_undef_data_at_allocated_at = prove_c_undef_data_at_allocated_at(); PROOF static thm prove_c_data_at_pure_range(void) { @@ -621,7 +621,7 @@ PROOF static thm prove_c_data_at_pure_range(void) { return gnode_prove(root); } -PROOF static thm C_DATA_AT_PURE_RANGE = +PROOF static thm c_data_at_pure_range = prove_c_data_at_pure_range(); PROOF static thm prove_c_data_at_value_range(void) { @@ -658,19 +658,19 @@ PROOF static thm prove_c_data_at_value_range(void) { thm range_rule = ispecl_rule( TERM_LIST( `G:(A)ra`, `address:int`, `ty:ctype`, `integer_value:int`), - C_DATA_AT_PURE_RANGE); - thm reflexivity = ispecl_rule(TERM_LIST(R, source), R_ENTAILS_REFL); + c_data_at_pure_range); + thm reflexivity = ispecl_rule(TERM_LIST(R, source), r_entails_refl); thm combined = mp_rule( mp_rule( ispecl_rule( TERM_LIST(R, source, pure_bounds, source), - R_AND_INTRO), + r_and_intro), range_rule), reflexivity); thm fact_sep = ispecl_rule( TERM_LIST(R, bounds, source), - R_FACT_SEP_R_EQ); + r_fact_sep_r_eq); thm replace_target = beta_rule(ap_term_rule( `\target:(((int,(pmem_byte_state)excl)finmap)#A)->bool. r_entails @@ -682,7 +682,7 @@ PROOF static thm prove_c_data_at_value_range(void) { return gnode_prove(root); } -PROOF thm C_DATA_AT_VALUE_RANGE = +PROOF thm c_data_at_value_range = prove_c_data_at_value_range(); /* ------------------------------------------------------------------------- */ @@ -700,24 +700,24 @@ PROOF static int audit_c_memory(void) { pmem_uint64_address_ok_def, pmem_ptr_address_ok_def, pmem_c_value_ok_def, - PMEM_C_ADDRESS_OK_TUINT64, + pmem_c_address_ok_Tuint64, pmem_data_at_def, pmem_undef_data_at_def, c_allocated_at_def, - C_ALLOCATED_AT_ZERO, - C_ALLOCATED_AT_APPEND, - PMEM_DATA_AT_ALLOCATED_AT, - PMEM_UNDEF_DATA_AT_ALLOCATED_AT, - PMEM_ALLOCATED_AT_TO_UNDEF_DATA_AT, - PMEM_DATA_AT_TO_UNDEF_DATA_AT, - PMEM_UNDEF_SCALAR_AT_TUINT64, + c_allocated_at_zero, + c_allocated_at_append, + pmem_data_at_allocated_at, + pmem_undef_data_at_allocated_at, + pmem_allocated_at_to_undef_data_at, + pmem_data_at_to_undef_data_at, + pmem_undef_scalar_at_Tuint64, c_data_at_def, c_undef_data_at_def, - C_ALLOCATED_AT_TO_UNDEF_DATA_AT, - C_DATA_AT_TO_UNDEF_DATA_AT, - C_DATA_AT_ALLOCATED_AT, - C_UNDEF_DATA_AT_ALLOCATED_AT, - C_DATA_AT_VALUE_RANGE); + c_allocated_at_to_undef_data_at, + c_data_at_to_undef_data_at, + c_data_at_allocated_at, + c_undef_data_at_allocated_at, + c_data_at_value_range); for (size_t i = 0; i < vector_size(public_theorems); ++i) { ENSURE_COND(!IS_NULL(public_theorems[i]), diff --git a/theory/c_program_logic/c_memory.h b/theory/c_program_logic/c_memory.h index 2bfa264..d14fb6e 100644 --- a/theory/c_program_logic/c_memory.h +++ b/theory/c_program_logic/c_memory.h @@ -22,6 +22,16 @@ * exact lifts to `Prop_G = (Mem # Ghost_G) -> bool`. In formulas below, * `P ⊢_mem Q` abbreviates `r_entails mem_ra P Q`, while `P ⊢_G Q` * abbreviates `r_entails (c_resource_ra G) P Q`. + * + * ABI guards are embedded with resource-independent `r_pure` under additive + * `r_and`, so they constrain the same owned bytes without consuming a second + * resource. When a side condition is exposed as a separating conjunct, this + * layer instead uses exact-unit `r_fact`. + * + * Raw equalities in this header are concrete computation or normalization + * equations for the named memory predicates. They are not generic BI + * connective laws; public laws of the core BI assertion algebra remain stated + * with validity-sensitive `r_equiv`. */ #pragma once @@ -142,18 +152,18 @@ PROOF extern thm pmem_c_value_ok_def; * * In particular, ownership of eight consecutive bytes does not imply this * theorem's alignment conjunct; callers carving a typed cell must establish - * it as a separate pure fact. + * it as a separate resource-independent HOL side condition. */ -PROOF extern thm PMEM_C_ADDRESS_OK_TUINT64; +PROOF extern thm pmem_c_address_ok_Tuint64; /* ------------------------------------------------------------------------- */ -/* Pure physical-memory atoms */ +/* Physical-only typed-memory assertions */ /* ------------------------------------------------------------------------- */ /* * Initialized scalar storage: * - * pmem_data_at address ty value = + * pmem_data_at address ty value == * r_and mem_ra * (r_pure mem_ra * (pmem_c_address_ok address ty ∧ @@ -168,7 +178,7 @@ PROOF extern thm pmem_data_at_def; /* * Owned scalar storage of unknown current contents at a valid C address: * - * pmem_undef_data_at address ty = + * pmem_undef_data_at address ty == * r_and mem_ra * (r_pure mem_ra (pmem_c_address_ok address ty)) * (pmem_allocated_at address (pmem_c_width ty)). @@ -180,41 +190,11 @@ PROOF extern thm pmem_data_at_def; */ PROOF extern thm pmem_undef_data_at_def; -/** - * Exact physical lift of `count` arbitrary allocated bytes. This assertion - * carries no C type, value, initialization-state uniformity, alignment, or - * QCP load/store role: - * - * ```text - * ⊢ c_allocated_at G address count = - * c_lift_phys G (pmem_allocated_at address count). - * ``` - */ -PROOF extern thm c_allocated_at_def; - -/** Zero arbitrary allocated bytes are exactly the selected separating unit. */ -PROOF extern thm C_ALLOCATED_AT_ZERO; - -/** - * Adjacent arbitrary allocated byte ranges compose exactly: - * - * ```text - * ⊢ ∀G address m n. - * c_allocated_at G address (m + n) = - * c_allocated_at G address m **_G - * c_allocated_at G (address + &m) n. - * ``` - * - * This theorem only changes the spatial grouping of the same byte range. It - * neither adds C typing nor strengthens any byte's initialization state. - */ -PROOF extern thm C_ALLOCATED_AT_APPEND; - /** Initialized typed storage entails its allocated byte range. */ -PROOF extern thm PMEM_DATA_AT_ALLOCATED_AT; +PROOF extern thm pmem_data_at_allocated_at; /** Unknown-content typed storage entails its allocated byte range. */ -PROOF extern thm PMEM_UNDEF_DATA_AT_ALLOCATED_AT; +PROOF extern thm pmem_undef_data_at_allocated_at; /** * A valid-address allocated range can be viewed as unknown-content typed @@ -226,10 +206,10 @@ PROOF extern thm PMEM_UNDEF_DATA_AT_ALLOCATED_AT; * pmem_undef_data_at address ty. * ``` */ -PROOF extern thm PMEM_ALLOCATED_AT_TO_UNDEF_DATA_AT; +PROOF extern thm pmem_allocated_at_to_undef_data_at; /** Initialized typed storage may forget its value and initialization detail. */ -PROOF extern thm PMEM_DATA_AT_TO_UNDEF_DATA_AT; +PROOF extern thm pmem_data_at_to_undef_data_at; /** * View eight strictly uninitialized bytes as unknown-content `Tuint64` @@ -241,17 +221,28 @@ PROOF extern thm PMEM_DATA_AT_TO_UNDEF_DATA_AT; * pmem_undef_data_at address Tuint64. * ``` */ -PROOF extern thm PMEM_UNDEF_SCALAR_AT_TUINT64; +PROOF extern thm pmem_undef_scalar_at_Tuint64; -/* /* ------------------------------------------------------------------------- */ -/* Complete C-resource atoms */ +/* Exact lifts to the complete C resource */ /* ------------------------------------------------------------------------- */ +/** + * Exact physical lift of `count` arbitrary allocated bytes. This assertion + * carries no C type, value, initialization-state uniformity, alignment, or + * QCP load/store role: + * + * ```text + * c_allocated_at G address count == + * c_lift_phys G (pmem_allocated_at address count). + * ``` + */ +PROOF extern thm c_allocated_at_def; + /* * Exact physical lift with an empty ghost projection: * - * c_data_at G address ty value = + * c_data_at G address ty value == * c_lift_phys G (pmem_data_at address ty value). */ PROOF extern thm c_data_at_def; @@ -259,29 +250,57 @@ PROOF extern thm c_data_at_def; /* * Exact physical lift with an empty ghost projection: * - * c_undef_data_at G address ty = + * c_undef_data_at G address ty == * c_lift_phys G (pmem_undef_data_at address ty). */ PROOF extern thm c_undef_data_at_def; +/** + * Concrete normalization: zero allocated bytes are the separating unit. + * This is a raw equation for the named memory predicate, not a generic BI + * connective law. + */ +PROOF extern thm c_allocated_at_zero; + +/** + * Concrete normalization for adjacent arbitrary allocated byte ranges: + * + * ```text + * forall G address m n. + * c_allocated_at G address (m + n) == + * r_sep (c_resource_ra G) + * (c_allocated_at G address m) + * (c_allocated_at G (address + &m) n). + * ``` + * + * The equation only regroups the same physical byte range. It adds neither + * C typing nor initialization information. + */ +PROOF extern thm c_allocated_at_append; + /** Lifted allocated-to-unknown typed view, requiring C address validity. */ -PROOF extern thm C_ALLOCATED_AT_TO_UNDEF_DATA_AT; +PROOF extern thm c_allocated_at_to_undef_data_at; /** Lifted initialized storage entails the QCP unknown-content memory atom. */ -PROOF extern thm C_DATA_AT_TO_UNDEF_DATA_AT; +PROOF extern thm c_data_at_to_undef_data_at; /** Lifted initialized typed storage entails arbitrary allocated bytes. */ -PROOF extern thm C_DATA_AT_ALLOCATED_AT; +PROOF extern thm c_data_at_allocated_at; /** Lifted unknown-content typed storage entails allocated bytes. */ -PROOF extern thm C_UNDEF_DATA_AT_ALLOCATED_AT; +PROOF extern thm c_undef_data_at_allocated_at; -/* +/** * Initialized scalar ownership exposes its represented-value bounds while * retaining the cell: * * c_data_at G address ty value ⊢_G - * c_data_at G address ty value * - * r_fact R_G (pmem_c_min ty <= value /\ value <= pmem_c_max ty). + * r_sep (c_resource_ra G) + * (c_data_at G address ty value) + * (r_fact (c_resource_ra G) + * (pmem_c_min ty <= value /\ value <= pmem_c_max ty)). + * + * `r_fact`, rather than resource-independent `r_pure`, makes the exposed + * bounds an exact-unit spatial conjunct. */ -PROOF extern thm C_DATA_AT_VALUE_RANGE; +PROOF extern thm c_data_at_value_range; diff --git a/theory/c_program_logic/c_resource.c b/theory/c_program_logic/c_resource.c index aa9a61a..c247376 100644 --- a/theory/c_program_logic/c_resource.c +++ b/theory/c_program_logic/c_resource.c @@ -24,11 +24,11 @@ PROOF static thm prove_c_resource_ra_unit(void) { gnode root = gnode_new_with_ccl(goal_tm); CONV_TAC( root, - rewrite_conv(THM_LIST(c_resource_ra_def, PROD_RA_UNIT))); + rewrite_conv(THM_LIST(c_resource_ra_def, prod_ra_unit))); return gnode_prove(root); } -PROOF thm C_RESOURCE_RA_UNIT = prove_c_resource_ra_unit(); +PROOF thm c_resource_ra_unit = prove_c_resource_ra_unit(); PROOF static thm prove_c_resource_ra_op(void) { term goal_tm = ` @@ -43,11 +43,11 @@ PROOF static thm prove_c_resource_ra_op(void) { gnode root = gnode_new_with_ccl(goal_tm); CONV_TAC( root, - rewrite_conv(THM_LIST(c_resource_ra_def, PROD_RA_OP))); + rewrite_conv(THM_LIST(c_resource_ra_def, prod_ra_op))); return gnode_prove(root); } -PROOF thm C_RESOURCE_RA_OP = prove_c_resource_ra_op(); +PROOF thm c_resource_ra_op = prove_c_resource_ra_op(); PROOF static thm prove_c_resource_ra_valid(void) { term goal_tm = ` @@ -61,11 +61,11 @@ PROOF static thm prove_c_resource_ra_valid(void) { gnode root = gnode_new_with_ccl(goal_tm); CONV_TAC( root, - rewrite_conv(THM_LIST(c_resource_ra_def, PROD_RA_VALID))); + rewrite_conv(THM_LIST(c_resource_ra_def, prod_ra_valid))); return gnode_prove(root); } -PROOF thm C_RESOURCE_RA_VALID = prove_c_resource_ra_valid(); +PROOF thm c_resource_ra_valid = prove_c_resource_ra_valid(); PROOF thm c_lift_phys_def = new_fun_definition(` c_lift_phys @@ -106,9 +106,9 @@ PROOF thm c_pmem_byte_at_def = new_fun_definition(` PROOF static int audit_c_resource(void) { thm_list public_theorems = THM_LIST( c_resource_ra_def, - C_RESOURCE_RA_UNIT, - C_RESOURCE_RA_OP, - C_RESOURCE_RA_VALID, + c_resource_ra_unit, + c_resource_ra_op, + c_resource_ra_valid, c_lift_phys_def, c_lift_ghost_def, c_ghost_own_def, diff --git a/theory/c_program_logic/c_resource.h b/theory/c_program_logic/c_resource.h index 827ab65..f384c0f 100644 --- a/theory/c_program_logic/c_resource.h +++ b/theory/c_program_logic/c_resource.h @@ -1,22 +1,53 @@ -#pragma once +/** + * @file c_resource.h + * @brief Physical memory paired with one complete global ghost RA. + * + * The caller supplies `G:(A)ra` as the algebra of the entire global ghost + * state. `c_resource_ra` does not insert an implicit name map: + * + * ```text + * c_resource_ra G == prod_ra mem_ra G + * carrier = Mem # A. + * ``` + * + * When names are required, callers choose `G = named_ra R` explicitly; when + * several protocols are required, they compose their complete global algebra + * explicitly before selecting `G`. + * + * `c_lift_phys` and `c_lift_ghost` are exact product lifts: the complementary + * projection must be the corresponding RA unit. The primitive one-byte + * physical assertions are kept in this boundary module alongside the lifts, + * so this header intentionally depends on the physical ownership layer + * `mem_own.h` as well as generic product-resource logic. + */ -/* Physical memory paired with one complete, closed global ghost RA. */ +#pragma once #include "proof/theory/c_program_logic/mem_own.h" #include "proof/theory/logic/product_resource.h" -/* `c_resource_ra G == prod_ra mem_ra G`. */ +/* Complete C resource and its componentwise algebra. */ +/** `c_resource_ra G == prod_ra mem_ra G`. */ PROOF extern thm c_resource_ra_def; -PROOF extern thm C_RESOURCE_RA_UNIT; -PROOF extern thm C_RESOURCE_RA_OP; -PROOF extern thm C_RESOURCE_RA_VALID; +/** The unit of `c_resource_ra G` is `(ra_unit mem_ra, ra_unit G)`. */ +PROOF extern thm c_resource_ra_unit; +/** Composition in `c_resource_ra G` is componentwise. */ +PROOF extern thm c_resource_ra_op; +/** Validity in `c_resource_ra G` is validity of both projections. */ +PROOF extern thm c_resource_ra_valid; -/* Exact product lifts. */ +/* Exact product lifts; the unselected projection is exactly unit. */ +/** `c_lift_phys G P == r_lift_left mem_ra G P`. */ PROOF extern thm c_lift_phys_def; +/** `c_lift_ghost G Q == r_lift_right mem_ra G Q`. */ PROOF extern thm c_lift_ghost_def; -/* Exact ownership of an arbitrary global ghost fragment. */ +/* Exact ownership of an arbitrary fragment of the complete global ghost RA. */ +/** `c_ghost_own G a == c_lift_ghost G (r_own G a)`. */ PROOF extern thm c_ghost_own_def; +/* Exact physical lifts of canonical uninitialized and initialized bytes. */ +/** Lift exact ownership of `pmem_uninit address` into `c_resource_ra G`. */ PROOF extern thm c_pmem_uninit_at_def; +/** Lift exact ownership of `pmem_byte address byte` into `c_resource_ra G`. */ PROOF extern thm c_pmem_byte_at_def; diff --git a/theory/c_program_logic/mem_own.h b/theory/c_program_logic/mem_own.h index 2b21530..1d0e77e 100644 --- a/theory/c_program_logic/mem_own.h +++ b/theory/c_program_logic/mem_own.h @@ -6,6 +6,10 @@ * concrete byte algebra from `mem_ra.h`. Keeping these predicates separate * leaves the physical carrier and its algebraic laws independent of any * assertion model. + * + * The declarations below are exact predicate definitions, so their defining + * theorems use raw function equality. Generic assertion-algebra laws remain + * exposed through `r_equiv` by `resource_prop.h`. */ #pragma once @@ -15,19 +19,19 @@ /** * Defining theorem for exact memory ownership: - * `⊢ ∀memory. pmem_own memory = r_own mem_ra memory`. + * `⊢ ∀memory. pmem_own memory == r_own mem_ra memory`. */ PROOF extern thm pmem_own_def; /** * Defining theorem for one allocated, uninitialized byte: - * `⊢ ∀address. pmem_uninit_at address = pmem_own (pmem_uninit address)`. + * `⊢ ∀address. pmem_uninit_at address == pmem_own (pmem_uninit address)`. */ PROOF extern thm pmem_uninit_at_def; /** * Defining theorem for one initialized byte: - * `⊢ ∀address byte. pmem_byte_at address byte = + * `⊢ ∀address byte. pmem_byte_at address byte == * pmem_own (pmem_byte address byte)`. */ PROOF extern thm pmem_byte_at_def; diff --git a/theory/c_program_logic/mem_ra.c b/theory/c_program_logic/mem_ra.c index 4186e87..40d465f 100644 --- a/theory/c_program_logic/mem_ra.c +++ b/theory/c_program_logic/mem_ra.c @@ -32,14 +32,14 @@ PROOF static thm prove_mem_ra_unit(void) { gnode root = gnode_new_with_ccl(goal_tm); thm_list rewrites = THM_LIST( mem_ra_def, - GMAP_RA_UNIT); + gmap_ra_unit); conv rewrite = rewrite_conv(rewrites); CONV_TAC(root, rewrite); thm proved = gnode_prove(root); return proved; } -PROOF thm MEM_RA_UNIT = prove_mem_ra_unit(); +PROOF thm mem_ra_unit = prove_mem_ra_unit(); PROOF static thm prove_mem_ra_op_lookup(void) { term goal_tm = ` @@ -59,14 +59,14 @@ PROOF static thm prove_mem_ra_op_lookup(void) { gnode root = gnode_new_with_ccl(goal_tm); thm_list rewrites = THM_LIST( mem_ra_def, - GMAP_RA_OP_LOOKUP); + gmap_ra_op_lookup); conv rewrite = rewrite_conv(rewrites); CONV_TAC(root, rewrite); thm proved = gnode_prove(root); return proved; } -PROOF thm MEM_RA_OP_LOOKUP = +PROOF thm mem_ra_op_lookup = prove_mem_ra_op_lookup(); PROOF static thm prove_mem_ra_valid(void) { @@ -82,14 +82,14 @@ PROOF static thm prove_mem_ra_valid(void) { gnode root = gnode_new_with_ccl(goal_tm); thm_list rewrites = THM_LIST( mem_ra_def, - GMAP_RA_VALID); + gmap_ra_valid); conv rewrite = rewrite_conv(rewrites); CONV_TAC(root, rewrite); thm proved = gnode_prove(root); return proved; } -PROOF thm MEM_RA_VALID = prove_mem_ra_valid(); +PROOF thm mem_ra_valid = prove_mem_ra_valid(); /* ------------------------------------------------------------------------- */ /* Canonical fragments */ @@ -131,15 +131,15 @@ PROOF static thm prove_pmem_singleton_valid(void) { thm_list rewrites = THM_LIST( mem_ra_def, pmem_singleton_def, - GMAP_RA_VALID_SINGLETON, - EXCL_RA_VALID_OWNED); + gmap_ra_valid_singleton, + excl_ra_valid_owned); conv rewrite = rewrite_conv(rewrites); CONV_TAC(root, rewrite); thm proved = gnode_prove(root); return proved; } -PROOF thm PMEM_SINGLETON_VALID = +PROOF thm pmem_singleton_valid = prove_pmem_singleton_valid(); PROOF static thm prove_pmem_uninit_valid(void) { @@ -150,14 +150,14 @@ PROOF static thm prove_pmem_uninit_valid(void) { gnode root = gnode_new_with_ccl(goal_tm); thm_list rewrites = THM_LIST( pmem_uninit_def, - PMEM_SINGLETON_VALID); + pmem_singleton_valid); conv rewrite = rewrite_conv(rewrites); CONV_TAC(root, rewrite); thm proved = gnode_prove(root); return proved; } -PROOF thm PMEM_UNINIT_VALID = +PROOF thm pmem_uninit_valid = prove_pmem_uninit_valid(); PROOF static thm prove_pmem_byte_valid(void) { @@ -168,14 +168,14 @@ PROOF static thm prove_pmem_byte_valid(void) { gnode root = gnode_new_with_ccl(goal_tm); thm_list rewrites = THM_LIST( pmem_byte_def, - PMEM_SINGLETON_VALID); + pmem_singleton_valid); conv rewrite = rewrite_conv(rewrites); CONV_TAC(root, rewrite); thm proved = gnode_prove(root); return proved; } -PROOF thm PMEM_BYTE_VALID = +PROOF thm pmem_byte_valid = prove_pmem_byte_valid(); PROOF static thm prove_pmem_singleton_overlap_invalid(void) { @@ -195,17 +195,17 @@ PROOF static thm prove_pmem_singleton_overlap_invalid(void) { thm_list rewrites = THM_LIST( mem_ra_def, pmem_singleton_def, - GMAP_RA_SINGLETON_OP, - GMAP_RA_VALID_SINGLETON, - EXCL_RA_OWNED_CONFLICT, - EXCL_RA_INVALID); + gmap_ra_singleton_op, + gmap_ra_valid_singleton, + excl_ra_owned_conflict, + excl_ra_invalid); conv rewrite = rewrite_conv(rewrites); CONV_TAC(root, rewrite); thm proved = gnode_prove(root); return proved; } -PROOF thm PMEM_SINGLETON_OVERLAP_INVALID = +PROOF thm pmem_singleton_overlap_invalid = prove_pmem_singleton_overlap_invalid(); /* ------------------------------------------------------------------------- */ @@ -219,7 +219,7 @@ PROOF static thm pmem_lift_excl_singleton_update( term_list payload_arguments = TERM_LIST(source_state, target_state); thm payload_update = ispecl_rule( payload_arguments, - EXCL_RA_UPDATE); + excl_ra_update); term source_owned = mk_comb( `Excl:pmem_byte_state->(pmem_byte_state)excl`, source_state); @@ -233,7 +233,7 @@ PROOF static thm pmem_lift_excl_singleton_update( target_owned); thm singleton_update = ispecl_rule( singleton_arguments, - GMAP_RA_UPDATE_SINGLETON); + gmap_ra_update_singleton); thm lifted_update = mp_rule(singleton_update, payload_update); return lifted_update; } @@ -264,7 +264,7 @@ PROOF static thm prove_pmem_update_uninit_byte(void) { return proved; } -PROOF thm PMEM_UPDATE_UNINIT_BYTE = +PROOF thm pmem_update_uninit_byte = prove_pmem_update_uninit_byte(); PROOF static thm prove_pmem_update_byte_uninit(void) { @@ -293,7 +293,7 @@ PROOF static thm prove_pmem_update_byte_uninit(void) { return proved; } -PROOF thm PMEM_UPDATE_BYTE_UNINIT = +PROOF thm pmem_update_byte_uninit = prove_pmem_update_byte_uninit(); PROOF static thm prove_pmem_update_byte_byte(void) { @@ -321,7 +321,7 @@ PROOF static thm prove_pmem_update_byte_byte(void) { return proved; } -PROOF thm PMEM_UPDATE_BYTE_BYTE = +PROOF thm pmem_update_byte_byte = prove_pmem_update_byte_byte(); /* ------------------------------------------------------------------------- */ @@ -333,19 +333,19 @@ PROOF static int audit_mem_ra(void) { pmem_byte_state_type.ind, pmem_byte_state_type.rec, mem_ra_def, - MEM_RA_UNIT, - MEM_RA_OP_LOOKUP, - MEM_RA_VALID, + mem_ra_unit, + mem_ra_op_lookup, + mem_ra_valid, pmem_singleton_def, pmem_uninit_def, pmem_byte_def, - PMEM_SINGLETON_VALID, - PMEM_UNINIT_VALID, - PMEM_BYTE_VALID, - PMEM_SINGLETON_OVERLAP_INVALID, - PMEM_UPDATE_UNINIT_BYTE, - PMEM_UPDATE_BYTE_UNINIT, - PMEM_UPDATE_BYTE_BYTE); + pmem_singleton_valid, + pmem_uninit_valid, + pmem_byte_valid, + pmem_singleton_overlap_invalid, + pmem_update_uninit_byte, + pmem_update_byte_uninit, + pmem_update_byte_byte); size_t public_theorem_count = vector_size(public_theorems); for (size_t i = 0; i < public_theorem_count; ++i) { diff --git a/theory/c_program_logic/mem_ra.h b/theory/c_program_logic/mem_ra.h index 29918ca..7d1da6a 100644 --- a/theory/c_program_logic/mem_ra.h +++ b/theory/c_program_logic/mem_ra.h @@ -20,6 +20,9 @@ * * This theory is independent of every assertion language. Exact ownership * predicates over this algebra are layered separately in `mem_own.h`. + * Consequently, equalities in this header describe RA carrier data and + * operations; they are not assertion-function equality laws from the BI + * interface. */ #pragma once @@ -44,7 +47,7 @@ PROOF extern indtype pmem_byte_state_type; * Construction equation: * * ```text - * ⊢ mem_ra = gmap_ra (excl_ra : ((pmem_byte_state)excl)ra). + * ⊢ mem_ra == gmap_ra (excl_ra : ((pmem_byte_state)excl)ra). * ``` */ PROOF extern thm mem_ra_def; @@ -57,7 +60,7 @@ PROOF extern thm mem_ra_def; * (finmap_empty : (int,(pmem_byte_state)excl)finmap). * ``` */ -PROOF extern thm MEM_RA_UNIT; +PROOF extern thm mem_ra_unit; /** * Composition is pointwise through option and exclusive composition: @@ -70,7 +73,7 @@ PROOF extern thm MEM_RA_UNIT; * (finmap_lookup right address). * ``` */ -PROOF extern thm MEM_RA_OP_LOOKUP; +PROOF extern thm mem_ra_op_lookup; /** * Memory validity is pointwise option/exclusive validity: @@ -83,7 +86,7 @@ PROOF extern thm MEM_RA_OP_LOOKUP; * (finmap_lookup memory address). * ``` */ -PROOF extern thm MEM_RA_VALID; +PROOF extern thm mem_ra_valid; /* ------------------------------------------------------------------------- */ /* Canonical finite-memory fragments */ @@ -111,7 +114,7 @@ PROOF extern thm pmem_uninit_def; PROOF extern thm pmem_byte_def; /** `⊢ ∀address state. ra_valid mem_ra (pmem_singleton address state)`. */ -PROOF extern thm PMEM_SINGLETON_VALID; +PROOF extern thm pmem_singleton_valid; /** * Two canonical owned singletons at the same address compose to an invalid @@ -124,33 +127,34 @@ PROOF extern thm PMEM_SINGLETON_VALID; * (pmem_singleton address right)). * ``` */ -PROOF extern thm PMEM_SINGLETON_OVERLAP_INVALID; +PROOF extern thm pmem_singleton_overlap_invalid; /* ------------------------------------------------------------------------- */ /* Frame-preserving updates */ /* ------------------------------------------------------------------------- */ /* - * These algebraic updates are implementation lemmas for trusted C command - * semantic rules. They must not be exposed as program-level viewshifts: - * changing physical memory requires execution of the corresponding C command. + * These deterministic `ra_update` theorems are singleton specializations of + * primitive `ra_updateP`. They are implementation lemmas for trusted C + * command semantic rules and must not be exposed as program-level viewshifts: + * changing physical memory requires execution of the corresponding command. */ /** * `⊢ ∀address byte. ra_update mem_ra (pmem_uninit address) * (pmem_byte address byte)`. */ -PROOF extern thm PMEM_UPDATE_UNINIT_BYTE; +PROOF extern thm pmem_update_uninit_byte; /** * `⊢ ∀address byte. ra_update mem_ra (pmem_byte address byte) * (pmem_uninit address)`. */ -PROOF extern thm PMEM_UPDATE_BYTE_UNINIT; +PROOF extern thm pmem_update_byte_uninit; /** * `⊢ ∀address old_byte new_byte. * ra_update mem_ra (pmem_byte address old_byte) * (pmem_byte address new_byte)`. */ -PROOF extern thm PMEM_UPDATE_BYTE_BYTE; +PROOF extern thm pmem_update_byte_byte; diff --git a/theory/c_program_logic/mem_value.c b/theory/c_program_logic/mem_value.c index a8588a8..cc2bf3a 100644 --- a/theory/c_program_logic/mem_value.c +++ b/theory/c_program_logic/mem_value.c @@ -23,11 +23,11 @@ PROOF thm pmem_allocated_byte_at_def = new_fun_definition(` pmem_own (pmem_singleton address state)) `); -PROOF static thm MEM_VALUE_LIST_RECURSION = +PROOF static thm mem_value_list_recursion = get_theorem_by_name("list_RECURSION"); PROOF thm pmem_bytes_at_def = new_rec_definition( - MEM_VALUE_LIST_RECURSION, + mem_value_list_recursion, ` (pmem_bytes_at (base:int) @@ -54,7 +54,7 @@ PROOF static thm prove_pmem_bytes_at_nil(void) { return proved; } -PROOF thm PMEM_BYTES_AT_NIL = +PROOF thm pmem_bytes_at_nil = prove_pmem_bytes_at_nil(); PROOF static thm prove_pmem_bytes_at_cons(void) { @@ -73,14 +73,14 @@ PROOF static thm prove_pmem_bytes_at_cons(void) { return proved; } -PROOF thm PMEM_BYTES_AT_CONS = +PROOF thm pmem_bytes_at_cons = prove_pmem_bytes_at_cons(); -PROOF static thm MEM_VALUE_NUM_RECURSION = +PROOF static thm mem_value_num_recursion = get_theorem_by_name("num_RECURSION"); PROOF thm pmem_allocated_at_def = new_rec_definition( - MEM_VALUE_NUM_RECURSION, + mem_value_num_recursion, ` (pmem_allocated_at (base:int) @@ -107,7 +107,7 @@ PROOF static thm prove_pmem_allocated_at_zero(void) { return proved; } -PROOF thm PMEM_ALLOCATED_AT_ZERO = +PROOF thm pmem_allocated_at_zero = prove_pmem_allocated_at_zero(); PROOF static thm prove_pmem_allocated_at_suc(void) { @@ -126,7 +126,7 @@ PROOF static thm prove_pmem_allocated_at_suc(void) { return proved; } -PROOF thm PMEM_ALLOCATED_AT_SUC = +PROOF thm pmem_allocated_at_suc = prove_pmem_allocated_at_suc(); PROOF static thm prove_pmem_allocated_at_append(void) { @@ -146,8 +146,8 @@ PROOF static thm prove_pmem_allocated_at_append(void) { CONV_TAC(base, simp_conv(THM_LIST( get_theorem_by_name("ADD_CLAUSES"), zero_address, - PMEM_ALLOCATED_AT_ZERO, - R_SEP_EMP_L_EQ))); + pmem_allocated_at_zero, + r_sep_emp_l_eq))); gnode step = AUTO_INTROS_TAC(cases[1]); thm ih_general = assume_rule( @@ -171,9 +171,9 @@ PROOF static thm prove_pmem_allocated_at_append(void) { sym_rule(expose_successor), address_reassociation); step = CONV_TAC(step, simp_conv(THM_LIST( get_theorem_by_name("ADD_CLAUSES"), - PMEM_ALLOCATED_AT_SUC, + pmem_allocated_at_suc, address, - R_SEP_ASSOC_EQ))); + r_sep_assoc_eq))); thm lifted_ih = beta_rule(ap_term_rule(` \tail:((int,(pmem_byte_state)excl)finmap)->bool. r_sep mem_ra (pmem_allocated_byte_at base) tail @@ -182,7 +182,7 @@ PROOF static thm prove_pmem_allocated_at_append(void) { return gnode_prove(root); } -PROOF thm PMEM_ALLOCATED_AT_APPEND = +PROOF thm pmem_allocated_at_append = prove_pmem_allocated_at_append(); PROOF static thm prove_pmem_allocated_at_split(void) { @@ -200,7 +200,7 @@ PROOF static thm prove_pmem_allocated_at_split(void) { assume_rule(`k:num <= n`)); thm appended = ispecl_rule( TERM_LIST(`k:num`, `base:int`, `n - k:num`), - PMEM_ALLOCATED_AT_APPEND); + pmem_allocated_at_append); appended = conv_rule( once_rewrite_conv(THM_LIST(gsym_rule(decomposition))), appended); @@ -208,7 +208,7 @@ PROOF static thm prove_pmem_allocated_at_split(void) { return gnode_prove(root); } -PROOF thm PMEM_ALLOCATED_AT_SPLIT = +PROOF thm pmem_allocated_at_split = prove_pmem_allocated_at_split(); PROOF static thm prove_pmem_uninit_at_allocated_byte(void) { @@ -251,7 +251,7 @@ PROOF static thm prove_pmem_uninit_at_allocated_byte(void) { return proved; } -PROOF thm PMEM_UNINIT_AT_ALLOCATED_BYTE = +PROOF thm pmem_uninit_at_allocated_byte = prove_pmem_uninit_at_allocated_byte(); PROOF static thm prove_pmem_byte_at_allocated_byte(void) { @@ -295,7 +295,7 @@ PROOF static thm prove_pmem_byte_at_allocated_byte(void) { return proved; } -PROOF thm PMEM_BYTE_AT_ALLOCATED_BYTE = +PROOF thm pmem_byte_at_allocated_byte = prove_pmem_byte_at_allocated_byte(); PROOF static thm prove_pmem_bytes_at_allocated(void) { @@ -315,8 +315,8 @@ PROOF static thm prove_pmem_bytes_at_allocated(void) { gnode nil_case = GEN_TAC(cases[0], "base"); thm length = get_theorem_by_name("LENGTH"); thm_list nil_rewrites = THM_LIST( - PMEM_BYTES_AT_NIL, - PMEM_ALLOCATED_AT_ZERO, + pmem_bytes_at_nil, + pmem_allocated_at_zero, length); conv simplify_nil = rewrite_conv(nil_rewrites); nil_case = CONV_TAC(nil_case, simplify_nil); @@ -325,13 +325,13 @@ PROOF static thm prove_pmem_bytes_at_allocated(void) { r_emp mem_ra:(int,(pmem_byte_state)excl)finmap->bool `; term_list refl_arguments = TERM_LIST(mem_ra_tm, emp_tm); - thm entails_refl = ispecl_rule(refl_arguments, R_ENTAILS_REFL); + thm entails_refl = ispecl_rule(refl_arguments, r_entails_refl); ACCEPT_TAC(nil_case, entails_refl); gnode cons_case = GEN_TAC(cases[1], "base"); thm_list cons_rewrites = THM_LIST( - PMEM_BYTES_AT_CONS, - PMEM_ALLOCATED_AT_SUC, + pmem_bytes_at_cons, + pmem_allocated_at_suc, length); conv simplify_cons = rewrite_conv(cons_rewrites); cons_case = CONV_TAC(cons_case, simplify_cons); @@ -341,7 +341,7 @@ PROOF static thm prove_pmem_bytes_at_allocated(void) { term_list head_arguments = TERM_LIST(base_tm, head_tm); thm head_entails = ispecl_rule( head_arguments, - PMEM_BYTE_AT_ALLOCATED_BYTE); + pmem_byte_at_allocated_byte); term induction_tm = ` forall base:int. r_entails @@ -352,14 +352,14 @@ PROOF static thm prove_pmem_bytes_at_allocated(void) { thm induction = assume_rule(induction_tm); term next_base_tm = `base + &1:int`; thm tail_entails = spec_rule(next_base_tm, induction); - thm sep_after_head = match_mp_rule(R_SEP_MONO, head_entails); + thm sep_after_head = match_mp_rule(r_sep_mono, head_entails); thm region_entails = match_mp_rule(sep_after_head, tail_entails); ACCEPT_TAC(cons_case, region_entails); thm proved = gnode_prove(root); return proved; } -PROOF thm PMEM_BYTES_AT_ALLOCATED = +PROOF thm pmem_bytes_at_allocated = prove_pmem_bytes_at_allocated(); /* ------------------------------------------------------------------------- */ @@ -367,7 +367,7 @@ PROOF thm PMEM_BYTES_AT_ALLOCATED = /* ------------------------------------------------------------------------- */ PROOF thm pmem_le_bytes_def = new_rec_definition( - MEM_VALUE_NUM_RECURSION, + mem_value_num_recursion, ` (pmem_le_bytes 0 @@ -392,7 +392,7 @@ PROOF static thm prove_pmem_le_bytes_zero(void) { return proved; } -PROOF thm PMEM_LE_BYTES_ZERO = +PROOF thm pmem_le_bytes_zero = prove_pmem_le_bytes_zero(); PROOF static thm prove_pmem_le_bytes_suc(void) { @@ -409,7 +409,7 @@ PROOF static thm prove_pmem_le_bytes_suc(void) { return proved; } -PROOF thm PMEM_LE_BYTES_SUC = +PROOF thm pmem_le_bytes_suc = prove_pmem_le_bytes_suc(); PROOF static thm prove_pmem_le_bytes_length(void) { @@ -425,7 +425,7 @@ PROOF static thm prove_pmem_le_bytes_length(void) { gnode zero_case = GEN_TAC(cases[0], "integer_value"); thm_list zero_rewrites = THM_LIST( - PMEM_LE_BYTES_ZERO, + pmem_le_bytes_zero, length); conv simplify_zero = rewrite_conv(zero_rewrites); CONV_TAC(zero_case, simplify_zero); @@ -439,7 +439,7 @@ PROOF static thm prove_pmem_le_bytes_length(void) { term quotient_tm = `(integer_value:int) div &256`; thm induction = spec_rule(quotient_tm, induction_assumption); thm_list suc_rewrites = THM_LIST( - PMEM_LE_BYTES_SUC, + pmem_le_bytes_suc, length, induction); conv simplify_suc = rewrite_conv(suc_rewrites); @@ -448,7 +448,7 @@ PROOF static thm prove_pmem_le_bytes_length(void) { return proved; } -PROOF thm PMEM_LE_BYTES_LENGTH = +PROOF thm pmem_le_bytes_length = prove_pmem_le_bytes_length(); PROOF thm pmem_scalar_at_def = new_fun_definition(` @@ -461,7 +461,7 @@ PROOF thm pmem_scalar_at_def = new_fun_definition(` `); PROOF thm pmem_undef_scalar_at_def = new_rec_definition( - MEM_VALUE_NUM_RECURSION, + mem_value_num_recursion, ` (pmem_undef_scalar_at (base:int) @@ -483,15 +483,15 @@ PROOF static thm prove_pmem_scalar_at_zero(void) { `); thm_list rewrites = THM_LIST( pmem_scalar_at_def, - PMEM_LE_BYTES_ZERO, - PMEM_BYTES_AT_NIL); + pmem_le_bytes_zero, + pmem_bytes_at_nil); conv simplify = rewrite_conv(rewrites); CONV_TAC(root, simplify); thm proved = gnode_prove(root); return proved; } -PROOF thm PMEM_SCALAR_AT_ZERO = +PROOF thm pmem_scalar_at_zero = prove_pmem_scalar_at_zero(); PROOF static thm prove_pmem_scalar_at_suc(void) { @@ -508,15 +508,15 @@ PROOF static thm prove_pmem_scalar_at_suc(void) { `); thm_list rewrites = THM_LIST( pmem_scalar_at_def, - PMEM_LE_BYTES_SUC, - PMEM_BYTES_AT_CONS); + pmem_le_bytes_suc, + pmem_bytes_at_cons); conv simplify = rewrite_conv(rewrites); CONV_TAC(root, simplify); thm proved = gnode_prove(root); return proved; } -PROOF thm PMEM_SCALAR_AT_SUC = +PROOF thm pmem_scalar_at_suc = prove_pmem_scalar_at_suc(); PROOF static thm prove_pmem_undef_scalar_at_zero(void) { @@ -531,7 +531,7 @@ PROOF static thm prove_pmem_undef_scalar_at_zero(void) { return proved; } -PROOF thm PMEM_UNDEF_SCALAR_AT_ZERO = +PROOF thm pmem_undef_scalar_at_zero = prove_pmem_undef_scalar_at_zero(); PROOF static thm prove_pmem_undef_scalar_at_suc(void) { @@ -550,7 +550,7 @@ PROOF static thm prove_pmem_undef_scalar_at_suc(void) { return proved; } -PROOF thm PMEM_UNDEF_SCALAR_AT_SUC = +PROOF thm pmem_undef_scalar_at_suc = prove_pmem_undef_scalar_at_suc(); PROOF static thm prove_pmem_undef_scalar_at_allocated(void) { @@ -566,8 +566,8 @@ PROOF static thm prove_pmem_undef_scalar_at_allocated(void) { gnode zero = GEN_TAC(cases[0], "base"); zero = CONV_TAC(zero, rewrite_conv(THM_LIST( - PMEM_UNDEF_SCALAR_AT_ZERO, - PMEM_ALLOCATED_AT_ZERO))); + pmem_undef_scalar_at_zero, + pmem_allocated_at_zero))); ACCEPT_TAC( zero, ispecl_rule( @@ -575,15 +575,15 @@ PROOF static thm prove_pmem_undef_scalar_at_allocated(void) { `mem_ra`, `r_emp mem_ra: (int,(pmem_byte_state)excl)finmap->bool`), - R_ENTAILS_REFL)); + r_entails_refl)); gnode step = GEN_TAC(cases[1], "base"); step = CONV_TAC(step, rewrite_conv(THM_LIST( - PMEM_UNDEF_SCALAR_AT_SUC, - PMEM_ALLOCATED_AT_SUC))); + pmem_undef_scalar_at_suc, + pmem_allocated_at_suc))); thm head = ispec_rule( `base:int`, - PMEM_UNINIT_AT_ALLOCATED_BYTE); + pmem_uninit_at_allocated_byte); thm induction = spec_rule( `base + &1:int`, assume_rule(` @@ -594,11 +594,11 @@ PROOF static thm prove_pmem_undef_scalar_at_allocated(void) { `)); ACCEPT_TAC( step, - match_mp_rule(match_mp_rule(R_SEP_MONO, head), induction)); + match_mp_rule(match_mp_rule(r_sep_mono, head), induction)); return gnode_prove(root); } -PROOF thm PMEM_UNDEF_SCALAR_AT_ALLOCATED = +PROOF thm pmem_undef_scalar_at_allocated = prove_pmem_undef_scalar_at_allocated(); PROOF static thm prove_pmem_scalar_at_allocated(void) { @@ -618,15 +618,15 @@ PROOF static thm prove_pmem_scalar_at_allocated(void) { term_list allocated_arguments = TERM_LIST(bytes_tm, base_tm); thm allocated = ispecl_rule( allocated_arguments, - PMEM_BYTES_AT_ALLOCATED); - thm_list length_rewrites = THM_LIST(PMEM_LE_BYTES_LENGTH); + pmem_bytes_at_allocated); + thm_list length_rewrites = THM_LIST(pmem_le_bytes_length); allocated = rewrite_rule(length_rewrites, allocated); ACCEPT_TAC(body, allocated); thm proved = gnode_prove(root); return proved; } -PROOF thm PMEM_SCALAR_AT_ALLOCATED = +PROOF thm pmem_scalar_at_allocated = prove_pmem_scalar_at_allocated(); /* ------------------------------------------------------------------------- */ @@ -637,28 +637,28 @@ PROOF static int audit_mem_value(void) { thm_list public_theorems = THM_LIST( pmem_allocated_byte_at_def, pmem_bytes_at_def, - PMEM_BYTES_AT_NIL, - PMEM_BYTES_AT_CONS, + pmem_bytes_at_nil, + pmem_bytes_at_cons, pmem_allocated_at_def, - PMEM_ALLOCATED_AT_ZERO, - PMEM_ALLOCATED_AT_SUC, - PMEM_ALLOCATED_AT_APPEND, - PMEM_ALLOCATED_AT_SPLIT, - PMEM_UNINIT_AT_ALLOCATED_BYTE, - PMEM_BYTE_AT_ALLOCATED_BYTE, - PMEM_BYTES_AT_ALLOCATED, + pmem_allocated_at_zero, + pmem_allocated_at_suc, + pmem_allocated_at_append, + pmem_allocated_at_split, + pmem_uninit_at_allocated_byte, + pmem_byte_at_allocated_byte, + pmem_bytes_at_allocated, pmem_le_bytes_def, - PMEM_LE_BYTES_ZERO, - PMEM_LE_BYTES_SUC, - PMEM_LE_BYTES_LENGTH, + pmem_le_bytes_zero, + pmem_le_bytes_suc, + pmem_le_bytes_length, pmem_scalar_at_def, pmem_undef_scalar_at_def, - PMEM_SCALAR_AT_ZERO, - PMEM_SCALAR_AT_SUC, - PMEM_UNDEF_SCALAR_AT_ZERO, - PMEM_UNDEF_SCALAR_AT_SUC, - PMEM_UNDEF_SCALAR_AT_ALLOCATED, - PMEM_SCALAR_AT_ALLOCATED); + pmem_scalar_at_zero, + pmem_scalar_at_suc, + pmem_undef_scalar_at_zero, + pmem_undef_scalar_at_suc, + pmem_undef_scalar_at_allocated, + pmem_scalar_at_allocated); size_t public_theorem_count = vector_size(public_theorems); for (size_t i = 0; i < public_theorem_count; ++i) { diff --git a/theory/c_program_logic/mem_value.h b/theory/c_program_logic/mem_value.h index 2a9ec5e..020a0a6 100644 --- a/theory/c_program_logic/mem_value.h +++ b/theory/c_program_logic/mem_value.h @@ -6,7 +6,8 @@ * the scalar `data_at`/`undef_data_at` atoms installed by a C-program logic. * It deliberately contains no C type, alignment, signedness, range, combined * physical/ghost resource, or QCP registration. Those target-dependent - * choices belong to the layer that lifts these pure `mem_ra` assertions. + * choices belong to the layer that lifts these physical-only `mem_ra` + * assertions. * * Addresses and scalar values are mathematical HOL integers. Scalar bytes * use the provisional little-endian ABI described below. In particular, no @@ -15,6 +16,11 @@ * In this header `P ⊢_mem Q` abbreviates `r_entails mem_ra P Q` and * `P **_mem Q` abbreviates `r_sep mem_ra P Q`. Both are documentation * notation; the exported theorems use the `r_*` constants directly. + * + * The raw assertion equalities exported here are computation and + * normalization equations for these concrete recursive memory predicates. + * They do not expose raw equality as a generic BI connective law; the latter + * remains available to clients only through validity-sensitive `r_equiv`. */ #pragma once @@ -36,80 +42,85 @@ * * Hence the witness may be `PMemUninit` or `PMemByte byte`. This is the * content-forgetting assertion used for raw allocated memory. It is strictly - * weaker than the actually-uninitialized `pmem_uninit_at` assertion and is - * not the meaning of `undef_data_at`. + * weaker than the actually-uninitialized `pmem_uninit_at` assertion. It is + * also the per-byte basis of unknown-content `pmem_undef_data_at`; despite that + * later name, only `pmem_undef_scalar_at` guarantees physical `PMemUninit` + * states. */ PROOF extern thm pmem_allocated_byte_at_def; /* * Exact ownership of initialized bytes at consecutive addresses: * - * pmem_bytes_at base [] = r_emp mem_ra - * pmem_bytes_at base (byte :: bytes) = + * pmem_bytes_at base [] == r_emp mem_ra + * pmem_bytes_at base (byte :: bytes) == * r_sep mem_ra * (pmem_byte_at base byte) * (pmem_bytes_at (base + &1) bytes). */ PROOF extern thm pmem_bytes_at_def; -/** Base equation: `⊢ ∀base. pmem_bytes_at base [] = r_emp mem_ra`. */ -PROOF extern thm PMEM_BYTES_AT_NIL; +/** Raw computation equation: `⊢ ∀base. pmem_bytes_at base [] == r_emp mem_ra`. */ +PROOF extern thm pmem_bytes_at_nil; /** * Step equation: - * `⊢ ∀base byte bytes. pmem_bytes_at base (byte::bytes) = + * `⊢ ∀base byte bytes. pmem_bytes_at base (byte::bytes) == * pmem_byte_at base byte **_mem pmem_bytes_at (base + &1) bytes`. */ -PROOF extern thm PMEM_BYTES_AT_CONS; +PROOF extern thm pmem_bytes_at_cons; /* * Exact ownership of `count` consecutive allocated bytes with unspecified * contents: * - * pmem_allocated_at base 0 = r_emp mem_ra - * pmem_allocated_at base (SUC count) = + * pmem_allocated_at base 0 == r_emp mem_ra + * pmem_allocated_at base (SUC count) == * r_sep mem_ra * (pmem_allocated_byte_at base) * (pmem_allocated_at (base + &1) count). */ PROOF extern thm pmem_allocated_at_def; -/** Base equation: `⊢ ∀base. pmem_allocated_at base 0 = r_emp mem_ra`. */ -PROOF extern thm PMEM_ALLOCATED_AT_ZERO; +/** + * Raw computation equation: + * `⊢ ∀base. pmem_allocated_at base 0 == r_emp mem_ra`. + */ +PROOF extern thm pmem_allocated_at_zero; /** * Step equation: - * `⊢ ∀base count. pmem_allocated_at base (SUC count) = + * `⊢ ∀base count. pmem_allocated_at base (SUC count) == * pmem_allocated_byte_at base **_mem * pmem_allocated_at (base + &1) count`. */ -PROOF extern thm PMEM_ALLOCATED_AT_SUC; +PROOF extern thm pmem_allocated_at_suc; /** - * Contiguous allocated ranges compose without overlap: + * Raw normalization for composition of contiguous allocated ranges: * * ```text * ⊢ ∀m base n. - * pmem_allocated_at base (m + n) = + * pmem_allocated_at base (m + n) == * r_sep mem_ra * (pmem_allocated_at base m) * (pmem_allocated_at (base + &m) n). * ``` */ -PROOF extern thm PMEM_ALLOCATED_AT_APPEND; +PROOF extern thm pmem_allocated_at_append; /** - * Bounded split form of `PMEM_ALLOCATED_AT_APPEND`: + * Raw bounded-split normalization derived from `pmem_allocated_at_append`: * * ```text * ⊢ ∀base n k. k ≤ n ⇒ - * pmem_allocated_at base n = + * pmem_allocated_at base n == * r_sep mem_ra * (pmem_allocated_at base k) * (pmem_allocated_at (base + &k) (n - k)). * ``` */ -PROOF extern thm PMEM_ALLOCATED_AT_SPLIT; +PROOF extern thm pmem_allocated_at_split; /* * An actually uninitialized singleton entails unspecified allocation: @@ -119,7 +130,7 @@ PROOF extern thm PMEM_ALLOCATED_AT_SPLIT; * (pmem_uninit_at address) * (pmem_allocated_byte_at address). */ -PROOF extern thm PMEM_UNINIT_AT_ALLOCATED_BYTE; +PROOF extern thm pmem_uninit_at_allocated_byte; /* * An initialized singleton entails unspecified allocation: @@ -129,7 +140,7 @@ PROOF extern thm PMEM_UNINIT_AT_ALLOCATED_BYTE; * (pmem_byte_at address byte) * (pmem_allocated_byte_at address). */ -PROOF extern thm PMEM_BYTE_AT_ALLOCATED_BYTE; +PROOF extern thm pmem_byte_at_allocated_byte; /* * Initialized consecutive bytes may be forgotten to allocated bytes: @@ -139,7 +150,7 @@ PROOF extern thm PMEM_BYTE_AT_ALLOCATED_BYTE; * (pmem_bytes_at base bytes) * (pmem_allocated_at base (LENGTH bytes)). */ -PROOF extern thm PMEM_BYTES_AT_ALLOCATED; +PROOF extern thm pmem_bytes_at_allocated; /* ------------------------------------------------------------------------- */ /* Provisional little-endian scalar representation */ @@ -149,8 +160,8 @@ PROOF extern thm PMEM_BYTES_AT_ALLOCATED; * `pmem_le_bytes count value` is the low `count` base-256 digits of `value`, * least-significant digit first: * - * pmem_le_bytes 0 value = [] - * pmem_le_bytes (SUC count) value = + * pmem_le_bytes 0 value == [] + * pmem_le_bytes (SUC count) value == * (value rem &256) :: * pmem_le_bytes count (value div &256). * @@ -160,23 +171,23 @@ PROOF extern thm PMEM_BYTES_AT_ALLOCATED; */ PROOF extern thm pmem_le_bytes_def; -/** Base equation: `⊢ ∀value. pmem_le_bytes 0 value = []`. */ -PROOF extern thm PMEM_LE_BYTES_ZERO; +/** Data computation: `⊢ ∀value. pmem_le_bytes 0 value == []`. */ +PROOF extern thm pmem_le_bytes_zero; /** * Step equation: - * `⊢ ∀count value. pmem_le_bytes (SUC count) value = + * `⊢ ∀count value. pmem_le_bytes (SUC count) value == * (value rem &256)::pmem_le_bytes count (value div &256)`. */ -PROOF extern thm PMEM_LE_BYTES_SUC; +PROOF extern thm pmem_le_bytes_suc; -/** `⊢ ∀(count:num)(value:int). LENGTH (pmem_le_bytes count value) = count`. */ -PROOF extern thm PMEM_LE_BYTES_LENGTH; +/** `⊢ ∀(count:num)(value:int). LENGTH (pmem_le_bytes count value) == count`. */ +PROOF extern thm pmem_le_bytes_length; /* * Exact initialized scalar storage at byte width `count`: * - * pmem_scalar_at base count value = + * pmem_scalar_at base count value == * pmem_bytes_at base (pmem_le_bytes count value). */ PROOF extern thm pmem_scalar_at_def; @@ -184,8 +195,8 @@ PROOF extern thm pmem_scalar_at_def; /* * Strictly uninitialized scalar storage: * - * pmem_undef_scalar_at base 0 = r_emp mem_ra - * pmem_undef_scalar_at base (SUC count) = + * pmem_undef_scalar_at base 0 == r_emp mem_ra + * pmem_undef_scalar_at base (SUC count) == * r_sep mem_ra * (pmem_uninit_at base) * (pmem_undef_scalar_at (base + &1) count). @@ -197,38 +208,38 @@ PROOF extern thm pmem_undef_scalar_at_def; /** * Empty initialized scalar storage: - * `⊢ ∀(base:int)(value:int). pmem_scalar_at base 0 value = r_emp mem_ra`. + * `⊢ ∀(base:int)(value:int). pmem_scalar_at base 0 value == r_emp mem_ra`. */ -PROOF extern thm PMEM_SCALAR_AT_ZERO; +PROOF extern thm pmem_scalar_at_zero; /* * Little-endian head/tail equation: * * ⊢ ∀(base:int)(count:num)(value:int). - * pmem_scalar_at base (SUC count) value = + * pmem_scalar_at base (SUC count) value == * r_sep mem_ra * (pmem_byte_at base (value rem &256)) * (pmem_scalar_at * (base + &1) count (value div &256)). */ -PROOF extern thm PMEM_SCALAR_AT_SUC; +PROOF extern thm pmem_scalar_at_suc; /** * Empty uninitialized scalar storage: - * `⊢ ∀base:int. pmem_undef_scalar_at base 0 = r_emp mem_ra`. + * `⊢ ∀base:int. pmem_undef_scalar_at base 0 == r_emp mem_ra`. */ -PROOF extern thm PMEM_UNDEF_SCALAR_AT_ZERO; +PROOF extern thm pmem_undef_scalar_at_zero; /* * Uninitialized scalar storage unfolds by one uninitialized byte: * * ⊢ ∀(base:int)(count:num). - * pmem_undef_scalar_at base (SUC count) = + * pmem_undef_scalar_at base (SUC count) == * r_sep mem_ra * (pmem_uninit_at base) * (pmem_undef_scalar_at (base + &1) count). */ -PROOF extern thm PMEM_UNDEF_SCALAR_AT_SUC; +PROOF extern thm pmem_undef_scalar_at_suc; /** * Strictly uninitialized storage may be weakened to arbitrary allocated @@ -240,7 +251,7 @@ PROOF extern thm PMEM_UNDEF_SCALAR_AT_SUC; * pmem_allocated_at base count. * ``` */ -PROOF extern thm PMEM_UNDEF_SCALAR_AT_ALLOCATED; +PROOF extern thm pmem_undef_scalar_at_allocated; /* * Initialized scalar contents can soundly be forgotten only to arbitrary @@ -251,4 +262,4 @@ PROOF extern thm PMEM_UNDEF_SCALAR_AT_ALLOCATED; * (pmem_scalar_at base count value) * (pmem_allocated_at base count). */ -PROOF extern thm PMEM_SCALAR_AT_ALLOCATED; +PROOF extern thm pmem_scalar_at_allocated; diff --git a/theory/logic/agree_ra.c b/theory/logic/agree_ra.c index 9683770..d79ab84 100644 --- a/theory/logic/agree_ra.c +++ b/theory/logic/agree_ra.c @@ -95,7 +95,7 @@ PROOF static thm prove_agree_owned_assoc(void) { return gnode_prove(root); } -PROOF static thm AGREE_OWNED_ASSOC = +PROOF static thm agree_owned_assoc = prove_agree_owned_assoc(); PROOF static thm prove_agree_owned_comm(void) { @@ -132,7 +132,7 @@ PROOF static thm prove_agree_owned_comm(void) { return gnode_prove(root); } -PROOF static thm AGREE_OWNED_COMM = +PROOF static thm agree_owned_comm = prove_agree_owned_comm(); PROOF static thm prove_agree_ra_laws(void) { @@ -171,7 +171,7 @@ PROOF static thm prove_agree_ra_laws(void) { } gnode associated = CONV_TAC( normalized, - once_rewrite_conv(THM_LIST(AGREE_OWNED_ASSOC))); + once_rewrite_conv(THM_LIST(agree_owned_assoc))); CONV_TAC( associated, rewrite_conv(THM_LIST())); @@ -212,7 +212,7 @@ PROOF static thm prove_agree_ra_laws(void) { THM_LIST( agree_op_def, agree_owned_op_def, - AGREE_OWNED_COMM)); + agree_owned_comm)); } } @@ -254,7 +254,7 @@ PROOF static thm prove_agree_ra_laws(void) { return gnode_prove(root); } -PROOF static thm AGREE_RA_LAWS = +PROOF static thm agree_ra_laws = prove_agree_ra_laws(); PROOF static thm agree_ra_def = new_fun_definition(` @@ -272,14 +272,14 @@ PROOF static thm prove_agree_ra_unit(void) { `AgreeUnit:(A)agree`, `agree_op:(A)agree->(A)agree->(A)agree`, `agree_valid:(A)agree->bool`), - RA_UNIT_ABS), - AGREE_RA_LAWS); + ra_unit_abs), + agree_ra_laws); return pure_once_rewrite_rule( THM_LIST(gsym_rule(agree_ra_def)), computed); } -PROOF thm AGREE_RA_UNIT = +PROOF thm agree_ra_unit = prove_agree_ra_unit(); PROOF static thm prove_agree_ra_op_fn(void) { @@ -289,14 +289,14 @@ PROOF static thm prove_agree_ra_op_fn(void) { `AgreeUnit:(A)agree`, `agree_op:(A)agree->(A)agree->(A)agree`, `agree_valid:(A)agree->bool`), - RA_OP_ABS), - AGREE_RA_LAWS); + ra_op_abs), + agree_ra_laws); return pure_once_rewrite_rule( THM_LIST(gsym_rule(agree_ra_def)), computed); } -PROOF static thm AGREE_RA_OP_FN = +PROOF static thm agree_ra_op_fn = prove_agree_ra_op_fn(); PROOF static thm prove_agree_ra_valid_fn(void) { @@ -306,14 +306,14 @@ PROOF static thm prove_agree_ra_valid_fn(void) { `AgreeUnit:(A)agree`, `agree_op:(A)agree->(A)agree->(A)agree`, `agree_valid:(A)agree->bool`), - RA_VALID_ABS), - AGREE_RA_LAWS); + ra_valid_abs), + agree_ra_laws); return pure_once_rewrite_rule( THM_LIST(gsym_rule(agree_ra_def)), computed); } -PROOF static thm AGREE_RA_VALID_FN = +PROOF static thm agree_ra_valid_fn = prove_agree_ra_valid_fn(); PROOF static thm prove_agree_ra_owned_op(void) { @@ -328,13 +328,13 @@ PROOF static thm prove_agree_ra_owned_op(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - AGREE_RA_OP_FN, + agree_ra_op_fn, agree_op_def, agree_owned_op_def))); return gnode_prove(root); } -PROOF thm AGREE_RA_OWNED_OP = +PROOF thm agree_ra_owned_op = prove_agree_ra_owned_op(); PROOF static thm prove_agree_ra_idempotent(void) { @@ -346,11 +346,11 @@ PROOF static thm prove_agree_ra_idempotent(void) { gnode root = gnode_new_with_ccl(goal_tm); CONV_TAC( root, - rewrite_conv(THM_LIST(AGREE_RA_OWNED_OP))); + rewrite_conv(THM_LIST(agree_ra_owned_op))); return gnode_prove(root); } -PROOF thm AGREE_RA_IDEMPOTENT = +PROOF thm agree_ra_idempotent = prove_agree_ra_idempotent(); PROOF static thm prove_agree_ra_owned_inj(void) { @@ -366,7 +366,7 @@ PROOF static thm prove_agree_ra_owned_inj(void) { return gnode_prove(root); } -PROOF thm AGREE_RA_OWNED_INJ = +PROOF thm agree_ra_owned_inj = prove_agree_ra_owned_inj(); PROOF static thm prove_agree_ra_owned_ne_unit(void) { @@ -381,7 +381,7 @@ PROOF static thm prove_agree_ra_owned_ne_unit(void) { return gnode_prove(root); } -PROOF thm AGREE_RA_OWNED_NE_UNIT = +PROOF thm agree_ra_owned_ne_unit = prove_agree_ra_owned_ne_unit(); PROOF static thm prove_agree_ra_invalid_ne_unit(void) { @@ -396,7 +396,7 @@ PROOF static thm prove_agree_ra_invalid_ne_unit(void) { return gnode_prove(root); } -PROOF thm AGREE_RA_INVALID_NE_UNIT = +PROOF thm agree_ra_invalid_ne_unit = prove_agree_ra_invalid_ne_unit(); PROOF static thm prove_agree_ra_invalid_ne_owned(void) { @@ -411,7 +411,7 @@ PROOF static thm prove_agree_ra_invalid_ne_owned(void) { return gnode_prove(root); } -PROOF thm AGREE_RA_INVALID_NE_OWNED = +PROOF thm agree_ra_invalid_ne_owned = prove_agree_ra_invalid_ne_owned(); PROOF static thm prove_agree_ra_valid_unit_public(void) { @@ -420,12 +420,12 @@ PROOF static thm prove_agree_ra_valid_unit_public(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - AGREE_RA_VALID_FN, + agree_ra_valid_fn, agree_valid_def))); return gnode_prove(root); } -PROOF thm AGREE_RA_VALID_UNIT = +PROOF thm agree_ra_valid_unit = prove_agree_ra_valid_unit_public(); PROOF static thm prove_agree_ra_valid_owned(void) { @@ -437,12 +437,12 @@ PROOF static thm prove_agree_ra_valid_owned(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - AGREE_RA_VALID_FN, + agree_ra_valid_fn, agree_valid_def))); return gnode_prove(root); } -PROOF thm AGREE_RA_VALID_OWNED = +PROOF thm agree_ra_valid_owned = prove_agree_ra_valid_owned(); PROOF static thm prove_agree_ra_invalid(void) { @@ -453,12 +453,12 @@ PROOF static thm prove_agree_ra_invalid(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - AGREE_RA_VALID_FN, + agree_ra_valid_fn, agree_valid_def))); return gnode_prove(root); } -PROOF thm AGREE_RA_INVALID = +PROOF thm agree_ra_invalid = prove_agree_ra_invalid(); PROOF static thm prove_agree_ra_valid_combine_iff(void) { @@ -477,14 +477,14 @@ PROOF static thm prove_agree_ra_valid_combine_iff(void) { cases[i], rewrite_conv, THM_LIST( - AGREE_RA_OWNED_OP, - AGREE_RA_VALID_OWNED, - AGREE_RA_INVALID)); + agree_ra_owned_op, + agree_ra_valid_owned, + agree_ra_invalid)); } return gnode_prove(root); } -PROOF thm AGREE_RA_VALID_COMBINE_IFF = +PROOF thm agree_ra_valid_combine_iff = prove_agree_ra_valid_combine_iff(); PROOF static thm prove_agree_ra_agreement(void) { @@ -495,7 +495,7 @@ PROOF static thm prove_agree_ra_agreement(void) { `; thm equivalence = ispecl_rule( TERM_LIST(a, b), - AGREE_RA_VALID_COMBINE_IFF); + agree_ra_valid_combine_iff); thm conclusion = eq_mp_rule( equivalence, rewrite_rule( @@ -506,7 +506,7 @@ PROOF static thm prove_agree_ra_agreement(void) { return gen_rule(a, conclusion); } -PROOF thm AGREE_RA_AGREEMENT = +PROOF thm agree_ra_agreement = prove_agree_ra_agreement(); /* ------------------------------------------------------------------------- */ @@ -529,13 +529,13 @@ PROOF static thm prove_agree_ra_update_iff(void) { gnode forward = DISCH_TAC(directions[0], "Hupdate"); thm source_op = ispec_rule( `a:A`, - AGREE_RA_IDEMPOTENT); + agree_ra_idempotent); thm source_valid_eq = ap_term_rule( `ra_valid agree_ra:(A)agree->bool`, source_op); thm source_valid = eq_mp_rule( sym_rule(source_valid_eq), - ispec_rule(`a:A`, AGREE_RA_VALID_OWNED)); + ispec_rule(`a:A`, agree_ra_valid_owned)); thm framed_update = mp_rule( ispecl_rule( TERM_LIST( @@ -543,7 +543,7 @@ PROOF static thm prove_agree_ra_update_iff(void) { `Agree (a:A):(A)agree`, `Agree (b:A):(A)agree`, `Agree (a:A):(A)agree`), - RA_UPDATE_FRAME), + ra_update_frame), assume_rule(` ra_update agree_ra (Agree (a:A)) (Agree (b:A)) `)); @@ -553,7 +553,7 @@ PROOF static thm prove_agree_ra_update_iff(void) { `agree_ra:((A)agree)ra`, `ra_op agree_ra (Agree (a:A)) (Agree (a:A))`, `ra_op agree_ra (Agree (b:A)) (Agree (a:A))`), - RA_UPDATE_VALID), + ra_update_valid), framed_update); target_valid = mp_rule( target_valid, @@ -561,7 +561,7 @@ PROOF static thm prove_agree_ra_update_iff(void) { thm target_agrees = mp_rule( ispecl_rule( TERM_LIST(`b:A`, `a:A`), - AGREE_RA_AGREEMENT), + agree_ra_agreement), rewrite_rule( THM_LIST(gsym_rule(ra_compatible_def)), target_valid)); @@ -579,14 +579,14 @@ PROOF static thm prove_agree_ra_update_iff(void) { TERM_LIST( `agree_ra:((A)agree)ra`, `Agree (a:A):(A)agree`), - RA_UPDATE_REFL); + ra_update_refl); ACCEPT_TAC( reverse, eq_mp_rule(target_transport, reflexive)); return gnode_prove(root); } -PROOF thm AGREE_RA_UPDATE_IFF = +PROOF thm agree_ra_update_iff = prove_agree_ra_update_iff(); PROOF static thm prove_agree_ra_local_update_iff(void) { @@ -614,7 +614,7 @@ PROOF static thm prove_agree_ra_local_update_iff(void) { `Agree (b:A):(A)agree`, `Agree (b:A):(A)agree`, `Agree (a:A):(A)agree`), - RA_LOCAL_UPDATE_APPLY); + ra_local_update_apply); updated = mp_rule( updated, assume_rule(` @@ -627,10 +627,10 @@ PROOF static thm prove_agree_ra_local_update_iff(void) { `)); updated = mp_rule( updated, - ispec_rule(`a:A`, AGREE_RA_VALID_OWNED)); + ispec_rule(`a:A`, agree_ra_valid_owned)); updated = mp_rule( updated, - gsym_rule(ispec_rule(`a:A`, AGREE_RA_IDEMPOTENT))); + gsym_rule(ispec_rule(`a:A`, agree_ra_idempotent))); thm target_valid = conjunct1_rule(updated); thm target_decomposition = conjunct2_rule(updated); thm target_op_valid = eq_mp_rule( @@ -641,7 +641,7 @@ PROOF static thm prove_agree_ra_local_update_iff(void) { thm payload_eq = mp_rule( ispecl_rule( TERM_LIST(`b:A`, `a:A`), - AGREE_RA_AGREEMENT), + agree_ra_agreement), rewrite_rule( THM_LIST(gsym_rule(ra_compatible_def)), target_op_valid)); @@ -667,7 +667,7 @@ PROOF static thm prove_agree_ra_local_update_iff(void) { `agree_ra:((A)agree)ra`, `Agree (a:A):(A)agree`, `Agree (a:A):(A)agree`), - RA_LOCAL_UPDATE_REFL); + ra_local_update_refl); ACCEPT_TAC( reverse, eq_mp_rule( @@ -676,7 +676,7 @@ PROOF static thm prove_agree_ra_local_update_iff(void) { return gnode_prove(root); } -PROOF thm AGREE_RA_LOCAL_UPDATE_IFF = +PROOF thm agree_ra_local_update_iff = prove_agree_ra_local_update_iff(); /* ------------------------------------------------------------------------- */ @@ -708,7 +708,7 @@ PROOF static thm prove_agree_ra_included_owned(void) { `agree_ra:((A)agree)ra`, `Agree (b:A):(A)agree`, `Agree (a:A):(A)agree`), - RA_UPDATE_INCLUDED), + ra_update_included), assume_rule(` ra_included agree_ra @@ -718,7 +718,7 @@ PROOF static thm prove_agree_ra_included_owned(void) { thm payload_eq = eq_mp_rule( ispecl_rule( TERM_LIST(`b:A`, `a:A`), - AGREE_RA_UPDATE_IFF), + agree_ra_update_iff), discard_extension); ACCEPT_TAC(forward, sym_rule(payload_eq)); @@ -734,14 +734,14 @@ PROOF static thm prove_agree_ra_included_owned(void) { TERM_LIST( `agree_ra:((A)agree)ra`, `Agree (a:A):(A)agree`), - RA_INCLUDED_REFL); + ra_included_refl); ACCEPT_TAC( reverse, eq_mp_rule(target_transport, reflexive)); return gnode_prove(root); } -PROOF thm AGREE_RA_INCLUDED_OWNED = +PROOF thm agree_ra_included_owned = prove_agree_ra_included_owned(); PROOF static thm prove_agree_ra_included_unit(void) { @@ -755,15 +755,15 @@ PROOF static thm prove_agree_ra_included_unit(void) { TERM_LIST( `agree_ra:((A)agree)ra`, `x:(A)agree`), - RA_INCLUDED_UNIT); + ra_included_unit); included = rewrite_rule( - THM_LIST(AGREE_RA_UNIT), + THM_LIST(agree_ra_unit), included); ACCEPT_TAC(body, included); return gnode_prove(root); } -PROOF thm AGREE_RA_INCLUDED_UNIT = +PROOF thm agree_ra_included_unit = prove_agree_ra_included_unit(); PROOF static thm prove_agree_unit_ne_owned_result(void) { @@ -788,7 +788,7 @@ PROOF static thm prove_agree_unit_ne_owned_result(void) { return gnode_prove(root); } -PROOF static thm AGREE_UNIT_NE_OWNED_RESULT = +PROOF static thm agree_unit_ne_owned_result = prove_agree_unit_ne_owned_result(); PROOF static thm prove_agree_ra_unit_ne_owned_op(void) { @@ -807,16 +807,16 @@ PROOF static thm prove_agree_ra_unit_ne_owned_op(void) { frame_cases[i], rewrite_conv, THM_LIST( - AGREE_RA_OP_FN, + agree_ra_op_fn, agree_op_def, agree_owned_op_def, - AGREE_UNIT_NE_OWNED_RESULT, + agree_unit_ne_owned_result, get_datatype_distinctness("agree"))); } return gnode_prove(root); } -PROOF static thm AGREE_RA_UNIT_NE_OWNED_OP = +PROOF static thm agree_ra_unit_ne_owned_op = prove_agree_ra_unit_ne_owned_op(); PROOF static thm prove_agree_ra_not_included_owned_unit(void) { @@ -840,7 +840,7 @@ PROOF static thm prove_agree_ra_not_included_owned_unit(void) { thm contradiction = not_elim_rule( ispecl_rule( TERM_LIST(`a:A`, `frame:(A)agree`), - AGREE_RA_UNIT_NE_OWNED_OP), + agree_ra_unit_ne_owned_op), assume_rule(` (AgreeUnit:(A)agree) == ra_op @@ -852,7 +852,7 @@ PROOF static thm prove_agree_ra_not_included_owned_unit(void) { return gnode_prove(root); } -PROOF thm AGREE_RA_NOT_INCLUDED_OWNED_UNIT = +PROOF thm agree_ra_not_included_owned_unit = prove_agree_ra_not_included_owned_unit(); PROOF static thm prove_agree_ra_included_owned_invalid(void) { @@ -869,13 +869,13 @@ PROOF static thm prove_agree_ra_included_owned_invalid(void) { CONV_TAC( body, rewrite_conv(THM_LIST( - AGREE_RA_OP_FN, + agree_ra_op_fn, agree_op_def, agree_owned_op_def))); return gnode_prove(root); } -PROOF thm AGREE_RA_INCLUDED_OWNED_INVALID = +PROOF thm agree_ra_included_owned_invalid = prove_agree_ra_included_owned_invalid(); PROOF static thm prove_agree_ra_not_included_invalid_unit(void) { @@ -887,13 +887,13 @@ PROOF static thm prove_agree_ra_not_included_invalid_unit(void) { root, rewrite_conv(THM_LIST( ra_included_def, - AGREE_RA_OP_FN, + agree_ra_op_fn, agree_op_def, get_datatype_distinctness("agree")))); return gnode_prove(root); } -PROOF thm AGREE_RA_NOT_INCLUDED_INVALID_UNIT = +PROOF thm agree_ra_not_included_invalid_unit = prove_agree_ra_not_included_invalid_unit(); PROOF static thm prove_agree_ra_not_included_invalid_owned(void) { @@ -906,13 +906,13 @@ PROOF static thm prove_agree_ra_not_included_invalid_owned(void) { root, rewrite_conv(THM_LIST( ra_included_def, - AGREE_RA_OP_FN, + agree_ra_op_fn, agree_op_def, get_datatype_distinctness("agree")))); return gnode_prove(root); } -PROOF thm AGREE_RA_NOT_INCLUDED_INVALID_OWNED = +PROOF thm agree_ra_not_included_invalid_owned = prove_agree_ra_not_included_invalid_owned(); PROOF static thm prove_agree_ra_not_exclusive_owned(void) { @@ -928,24 +928,24 @@ PROOF static thm prove_agree_ra_not_exclusive_owned(void) { thm combined_valid = eq_mp_rule( gsym_rule(ap_term_rule( `ra_valid agree_ra:(A)agree->bool`, - ispec_rule(`a:A`, AGREE_RA_IDEMPOTENT))), - ispec_rule(`a:A`, AGREE_RA_VALID_OWNED)); + ispec_rule(`a:A`, agree_ra_idempotent))), + ispec_rule(`a:A`, agree_ra_valid_owned)); thm frame_is_unit = mp_rule( spec_rule( `Agree (a:A):(A)agree`, conjunct2_rule(exclusive)), combined_valid); frame_is_unit = rewrite_rule( - THM_LIST(AGREE_RA_UNIT), + THM_LIST(agree_ra_unit), frame_is_unit); thm contradiction = not_elim_rule( - ispec_rule(`a:A`, AGREE_RA_OWNED_NE_UNIT), + ispec_rule(`a:A`, agree_ra_owned_ne_unit), frame_is_unit); CONTR_TAC(body, contradiction); return gnode_prove(root); } -PROOF thm AGREE_RA_NOT_EXCLUSIVE_OWNED = +PROOF thm agree_ra_not_exclusive_owned = prove_agree_ra_not_exclusive_owned(); PROOF static thm prove_agree_ra_not_cancellative(void) { @@ -957,23 +957,23 @@ PROOF static thm prove_agree_ra_not_cancellative(void) { TERM_LIST( `agree_ra:((A)agree)ra`, owned), - RA_UNIT_R); + ra_unit_r); source_op = rewrite_rule( - THM_LIST(AGREE_RA_UNIT), + THM_LIST(agree_ra_unit), source_op); thm source_valid = eq_mp_rule( gsym_rule(ap_term_rule( `ra_valid agree_ra:(A)agree->bool`, source_op)), - ispec_rule(`a:A`, AGREE_RA_VALID_OWNED)); - thm right_op = ispec_rule(`a:A`, AGREE_RA_IDEMPOTENT); + ispec_rule(`a:A`, agree_ra_valid_owned)); + thm right_op = ispec_rule(`a:A`, agree_ra_idempotent); thm forced_equal = ispecl_rule( TERM_LIST( `agree_ra:((A)agree)ra`, owned, `AgreeUnit:(A)agree`, owned), - RA_CANCELLATIVE_APPLY); + ra_cancellative_apply); forced_equal = mp_rule( forced_equal, assume_rule(`ra_cancellative (agree_ra:((A)agree)ra)`)); @@ -982,13 +982,13 @@ PROOF static thm prove_agree_ra_not_cancellative(void) { forced_equal, trans_rule(source_op, gsym_rule(right_op))); thm contradiction = not_elim_rule( - ispec_rule(`a:A`, AGREE_RA_OWNED_NE_UNIT), + ispec_rule(`a:A`, agree_ra_owned_ne_unit), gsym_rule(forced_equal)); CONTR_TAC(body, contradiction); return gnode_prove(root); } -PROOF thm AGREE_RA_NOT_CANCELLATIVE = +PROOF thm agree_ra_not_cancellative = prove_agree_ra_not_cancellative(); PROOF static int audit_agree_ra(void) { @@ -998,34 +998,34 @@ PROOF static int audit_agree_ra(void) { agree_owned_op_def, agree_op_def, agree_valid_def, - AGREE_RA_LAWS, + agree_ra_laws, agree_ra_def, - AGREE_RA_UNIT, - AGREE_RA_OP_FN, - AGREE_RA_VALID_FN, - AGREE_RA_OWNED_OP, - AGREE_RA_IDEMPOTENT, - AGREE_RA_OWNED_INJ, - AGREE_RA_OWNED_NE_UNIT, - AGREE_RA_INVALID_NE_UNIT, - AGREE_RA_INVALID_NE_OWNED, - AGREE_RA_VALID_UNIT, - AGREE_RA_VALID_OWNED, - AGREE_RA_INVALID, - AGREE_RA_VALID_COMBINE_IFF, - AGREE_RA_INCLUDED_OWNED, - AGREE_RA_INCLUDED_UNIT, - AGREE_UNIT_NE_OWNED_RESULT, - AGREE_RA_UNIT_NE_OWNED_OP, - AGREE_RA_NOT_INCLUDED_OWNED_UNIT, - AGREE_RA_INCLUDED_OWNED_INVALID, - AGREE_RA_NOT_INCLUDED_INVALID_UNIT, - AGREE_RA_NOT_INCLUDED_INVALID_OWNED, - AGREE_RA_NOT_EXCLUSIVE_OWNED, - AGREE_RA_NOT_CANCELLATIVE, - AGREE_RA_AGREEMENT, - AGREE_RA_UPDATE_IFF, - AGREE_RA_LOCAL_UPDATE_IFF); + agree_ra_unit, + agree_ra_op_fn, + agree_ra_valid_fn, + agree_ra_owned_op, + agree_ra_idempotent, + agree_ra_owned_inj, + agree_ra_owned_ne_unit, + agree_ra_invalid_ne_unit, + agree_ra_invalid_ne_owned, + agree_ra_valid_unit, + agree_ra_valid_owned, + agree_ra_invalid, + agree_ra_valid_combine_iff, + agree_ra_included_owned, + agree_ra_included_unit, + agree_unit_ne_owned_result, + agree_ra_unit_ne_owned_op, + agree_ra_not_included_owned_unit, + agree_ra_included_owned_invalid, + agree_ra_not_included_invalid_unit, + agree_ra_not_included_invalid_owned, + agree_ra_not_exclusive_owned, + agree_ra_not_cancellative, + agree_ra_agreement, + agree_ra_update_iff, + agree_ra_local_update_iff); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { ENSURE_COND(!IS_NULL(audited_theorems[i]), diff --git a/theory/logic/agree_ra.h b/theory/logic/agree_ra.h index 37e8f3c..f900d41 100644 --- a/theory/logic/agree_ra.h +++ b/theory/logic/agree_ra.h @@ -1,18 +1,60 @@ #pragma once -/* Discrete agreement resource algebra. */ +/* + * Public semantic interface for the discrete agreement resource algebra. + * + * Equal `Agree` tokens compose idempotently; unequal payloads compose to the + * invalid value `AgreeInvalid`. Thus compatible owned tokens determine the + * same payload even though the surrounding separation logic remains linear. + */ #include "proof/theory/logic/local_update.h" -PROOF extern thm AGREE_RA_UNIT; -PROOF extern thm AGREE_RA_OWNED_OP; -PROOF extern thm AGREE_RA_IDEMPOTENT; -PROOF extern thm AGREE_RA_VALID_UNIT; -PROOF extern thm AGREE_RA_VALID_OWNED; -PROOF extern thm AGREE_RA_INVALID; -PROOF extern thm AGREE_RA_VALID_COMBINE_IFF; -PROOF extern thm AGREE_RA_AGREEMENT; -PROOF extern thm AGREE_RA_INCLUDED_OWNED; -PROOF extern thm AGREE_RA_NOT_CANCELLATIVE; -PROOF extern thm AGREE_RA_UPDATE_IFF; -PROOF extern thm AGREE_RA_LOCAL_UPDATE_IFF; +/* ------------------------------------------------------------------------- */ +/* Operation and validity */ +/* ------------------------------------------------------------------------- */ + +/* `ra_unit agree_ra == AgreeUnit`. */ +PROOF extern thm agree_ra_unit; + +/* + * `ra_op agree_ra (Agree a) (Agree b) == + * (if a == b then Agree a else AgreeInvalid)`. + */ +PROOF extern thm agree_ra_owned_op; + +/* `ra_op agree_ra (Agree a) (Agree a) == Agree a`. */ +PROOF extern thm agree_ra_idempotent; + +/* The unit and every single owned agreement token are valid. */ +PROOF extern thm agree_ra_valid_unit; +PROOF extern thm agree_ra_valid_owned; + +/* `~ra_valid agree_ra AgreeInvalid`. */ +PROOF extern thm agree_ra_invalid; + +/* ------------------------------------------------------------------------- */ +/* Agreement, inclusion, and cancellation */ +/* ------------------------------------------------------------------------- */ + +/* A composition of two owned tokens is valid exactly when payloads agree. */ +PROOF extern thm agree_ra_valid_combine_iff; + +/* Compatible owned tokens have equal payloads. */ +PROOF extern thm agree_ra_agreement; + +/* Owned-to-owned inclusion is exactly payload equality. */ +PROOF extern thm agree_ra_included_owned; + +/* Idempotence makes the agreement RA non-cancellative. */ +PROOF extern thm agree_ra_not_cancellative; + +/* ------------------------------------------------------------------------- */ +/* Agreement-preserving updates */ +/* ------------------------------------------------------------------------- */ + +/* `Agree a` updates to `Agree b` exactly when `a == b`. */ +PROOF extern thm agree_ra_update_iff; + +/* A complete owned local pair changes payload exactly when it stays equal. */ +PROOF extern thm agree_ra_local_update_iff; diff --git a/theory/logic/auth_ra.c b/theory/logic/auth_ra.c index 718c910..2d98ebf 100644 --- a/theory/logic/auth_ra.c +++ b/theory/logic/auth_ra.c @@ -79,8 +79,8 @@ PROOF static conv auth_reduce_conv(thm_list local_theorems) { auth_op_def, auth_valid_def, auth_valid_at_def, - PROD_RA_OP, - EXCL_RA_OP_FN, + prod_ra_op, + excl_ra_op_fn, excl_op_def, excl_owned_op_def, get_theorem_by_name("FST"), @@ -120,7 +120,7 @@ PROOF static thm prove_auth_ra_laws(void) { `a:(A)excl#A`, `b:(A)excl#A`, `c:(A)excl#A`), - RA_ASSOC)); + ra_assoc)); gnode_list law2 = CONJ_TAC(law1[1]); gnode comm = AUTO_INTROS_TAC(law2[0]); @@ -134,7 +134,7 @@ PROOF static thm prove_auth_ra_laws(void) { product, `a:(A)excl#A`, `b:(A)excl#A`), - RA_COMM)); + ra_comm)); gnode_list law3 = CONJ_TAC(law2[1]); gnode unit = AUTO_INTROS_TAC(law3[0]); @@ -145,9 +145,9 @@ PROOF static thm prove_auth_ra_laws(void) { TERM_LIST( `excl_ra:((A)excl)ra`, `R:(A)ra`), - PROD_RA_UNIT); + prod_ra_unit); product_unit = pure_once_rewrite_rule( - THM_LIST(EXCL_RA_UNIT), + THM_LIST(excl_ra_unit), product_unit); unit = CONV_TAC( unit, @@ -156,7 +156,7 @@ PROOF static thm prove_auth_ra_laws(void) { unit, ispecl_rule( TERM_LIST(product, `a:(A)excl#A`), - RA_UNIT_L)); + ra_unit_l)); gnode_list law4 = CONJ_TAC(law3[1]); CONV_TAC( @@ -166,7 +166,7 @@ PROOF static thm prove_auth_ra_laws(void) { auth_valid_at_def, get_theorem_by_name("FST"), get_theorem_by_name("SND"), - RA_VALID_UNIT))); + ra_valid_unit))); gnode valid_down = GEN_TAC(law4[1], "x"); valid_down = GEN_TAC(valid_down, "y"); @@ -192,7 +192,7 @@ PROOF static thm prove_auth_ra_laws(void) { `R:(A)ra`, `SND (x:(A)excl#A)`, `SND (y:(A)excl#A)`), - RA_VALID_OP_L), + ra_valid_op_l), assume_rule(` ra_valid (R:(A)ra) (ra_op R @@ -219,7 +219,7 @@ PROOF static thm prove_auth_ra_laws(void) { "Hvalid_authoritative")); thm valid_product = match_mp_rule( match_mp_rule( - RA_INCLUDED_VALID, + ra_included_valid, assume_rule(premises[0])), assume_rule(premises[1])); thm valid_left = mp_rule( @@ -228,7 +228,7 @@ PROOF static thm prove_auth_ra_laws(void) { `R:(A)ra`, `SND (x:(A)excl#A)`, `SND (y:(A)excl#A)`), - RA_VALID_OP_L), + ra_valid_op_l), valid_product); ACCEPT_TAC(reduced, valid_left); } else if (i == 1 && j == 0) { @@ -255,10 +255,10 @@ PROOF static thm prove_auth_ra_laws(void) { `R:(A)ra`, `SND (x:(A)excl#A)`, `SND (y:(A)excl#A)`), - RA_INCLUDED_OP_L); + ra_included_op_l); thm left_in_authoritative = match_mp_rule( match_mp_rule( - RA_INCLUDED_TRANS, + ra_included_trans, left_in_product), assume_rule(gnode_get_asmps( result[1], @@ -276,7 +276,7 @@ PROOF static thm prove_auth_ra_laws(void) { return gnode_prove(root); } -PROOF static thm AUTH_RA_LAWS = +PROOF static thm auth_ra_laws = prove_auth_ra_laws(); PROOF static thm auth_ra_def = new_fun_definition(` @@ -298,11 +298,11 @@ PROOF static thm prove_auth_ra_unit(void) { term valid = ` auth_valid (R:(A)ra):((A)excl#A)->bool `; - thm laws = ispec_rule(R, AUTH_RA_LAWS); + thm laws = ispec_rule(R, auth_ra_laws); thm computed = mp_rule( ispecl_rule( TERM_LIST(unit, op, valid), - RA_UNIT_ABS), + ra_unit_abs), laws); computed = pure_once_rewrite_rule( THM_LIST(gsym_rule(auth_ra_def)), @@ -313,7 +313,7 @@ PROOF static thm prove_auth_ra_unit(void) { return gen_rule(R, computed); } -PROOF thm AUTH_RA_UNIT = +PROOF thm auth_ra_unit = prove_auth_ra_unit(); PROOF static thm prove_auth_ra_op(void) { @@ -326,11 +326,11 @@ PROOF static thm prove_auth_ra_op(void) { term valid = ` auth_valid (R:(A)ra):((A)excl#A)->bool `; - thm laws = ispec_rule(R, AUTH_RA_LAWS); + thm laws = ispec_rule(R, auth_ra_laws); thm computed = mp_rule( ispecl_rule( TERM_LIST(unit, op, valid), - RA_OP_ABS), + ra_op_abs), laws); computed = pure_once_rewrite_rule( THM_LIST(gsym_rule(auth_ra_def)), @@ -338,7 +338,7 @@ PROOF static thm prove_auth_ra_op(void) { return gen_rule(R, computed); } -PROOF static thm AUTH_RA_OP_FN = +PROOF static thm auth_ra_op_fn = prove_auth_ra_op(); PROOF static thm prove_auth_ra_valid(void) { @@ -351,11 +351,11 @@ PROOF static thm prove_auth_ra_valid(void) { term valid = ` auth_valid (R:(A)ra):((A)excl#A)->bool `; - thm laws = ispec_rule(R, AUTH_RA_LAWS); + thm laws = ispec_rule(R, auth_ra_laws); thm computed = mp_rule( ispecl_rule( TERM_LIST(unit, op, valid), - RA_VALID_ABS), + ra_valid_abs), laws); computed = pure_once_rewrite_rule( THM_LIST(gsym_rule(auth_ra_def)), @@ -363,7 +363,7 @@ PROOF static thm prove_auth_ra_valid(void) { return gen_rule(R, computed); } -PROOF static thm AUTH_RA_VALID_FN = +PROOF static thm auth_ra_valid_fn = prove_auth_ra_valid(); PROOF static thm prove_auth_ra_op_components(void) { @@ -380,14 +380,14 @@ PROOF static thm prove_auth_ra_op_components(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - AUTH_RA_OP_FN, + auth_ra_op_fn, auth_op_def, - PROD_RA_OP, - EXCL_RA_OP_FN))); + prod_ra_op, + excl_ra_op_fn))); return gnode_prove(root); } -PROOF static thm AUTH_RA_OP_COMPONENTS = +PROOF static thm auth_ra_op_components = prove_auth_ra_op_components(); PROOF static thm prove_auth_ra_valid_components(void) { @@ -402,12 +402,12 @@ PROOF static thm prove_auth_ra_valid_components(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - AUTH_RA_VALID_FN, + auth_ra_valid_fn, auth_valid_def))); return gnode_prove(root); } -PROOF static thm AUTH_RA_VALID_COMPONENTS = +PROOF static thm auth_ra_valid_components = prove_auth_ra_valid_components(); /* The authoritative operation is the product operation used by its raw @@ -429,13 +429,13 @@ PROOF static thm prove_auth_ra_op_as_product(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - AUTH_RA_OP_COMPONENTS, - PROD_RA_OP, - EXCL_RA_OP_FN))); + auth_ra_op_components, + prod_ra_op, + excl_ra_op_fn))); return gnode_prove(root); } -PROOF static thm AUTH_RA_OP_AS_PRODUCT = +PROOF static thm auth_ra_op_as_product = prove_auth_ra_op_as_product(); /* Inclusion depends only on the carrier operation, so authoritative @@ -457,11 +457,11 @@ PROOF static thm prove_auth_ra_included_as_product(void) { root, rewrite_conv(THM_LIST( ra_included_def, - AUTH_RA_OP_AS_PRODUCT))); + auth_ra_op_as_product))); return gnode_prove(root); } -PROOF static thm AUTH_RA_INCLUDED_AS_PRODUCT = +PROOF static thm auth_ra_included_as_product = prove_auth_ra_included_as_product(); /* Private representation bridge used to derive the constructor-level public @@ -483,12 +483,12 @@ PROOF static thm prove_auth_ra_included_components(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - AUTH_RA_INCLUDED_AS_PRODUCT, - PROD_RA_INCLUDED))); + auth_ra_included_as_product, + prod_ra_included))); return gnode_prove(root); } -PROOF static thm AUTH_RA_INCLUDED_COMPONENTS = +PROOF static thm auth_ra_included_components = prove_auth_ra_included_components(); /* Authoritative validity is stronger than validity in the carrier product. @@ -508,7 +508,7 @@ PROOF static thm prove_auth_ra_valid_imp_product_valid(void) { body = DISCH_TAC(body, "Hauth_valid"); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(PROD_RA_VALID))); + once_rewrite_conv(THM_LIST(prod_ra_valid))); gnode_list tag_cases = CASES_TAC( body, `FST (x:(A)excl#A)`, "Htag"); @@ -521,7 +521,7 @@ PROOF static thm prove_auth_ra_valid_imp_product_valid(void) { thm auth_details = eq_mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `x:(A)excl#A`), - AUTH_RA_VALID_COMPONENTS), + auth_ra_valid_components), assume_rule(` ra_valid (auth_ra (R:(A)ra)) (x:(A)excl#A) `)); @@ -533,7 +533,7 @@ PROOF static thm prove_auth_ra_valid_imp_product_valid(void) { gnode_list result = CONJ_TAC(branch); thm excl_valid = pure_once_rewrite_rule( THM_LIST(gsym_rule(tag_eq)), - EXCL_RA_VALID_UNIT); + excl_ra_valid_unit); ACCEPT_TAC(result[0], excl_valid); ACCEPT_TAC(result[1], auth_details); } else if (i == 1) { @@ -541,7 +541,7 @@ PROOF static thm prove_auth_ra_valid_imp_product_valid(void) { gnode_list result = CONJ_TAC(branch); thm excl_valid = ispec_rule( owned, - EXCL_RA_VALID_OWNED); + excl_ra_valid_owned); excl_valid = pure_once_rewrite_rule( THM_LIST(gsym_rule(tag_eq)), excl_valid); @@ -549,7 +549,7 @@ PROOF static thm prove_auth_ra_valid_imp_product_valid(void) { thm fragment_valid = match_mp_rule( match_mp_rule( - RA_INCLUDED_VALID, + ra_included_valid, conjunct2_rule(auth_details)), conjunct1_rule(auth_details)); ACCEPT_TAC(result[1], fragment_valid); @@ -560,7 +560,7 @@ PROOF static thm prove_auth_ra_valid_imp_product_valid(void) { return gnode_prove(root); } -PROOF static thm AUTH_RA_VALID_IMP_PRODUCT_VALID = +PROOF static thm auth_ra_valid_imp_product_valid = prove_auth_ra_valid_imp_product_valid(); PROOF static thm prove_auth_ra_auth_frag(void) { @@ -575,11 +575,11 @@ PROOF static thm prove_auth_ra_auth_frag(void) { gnode root = gnode_new_with_ccl(goal_tm); thm unit_left = ispecl_rule( TERM_LIST(`R:(A)ra`, `fragment:A`), - RA_UNIT_L); + ra_unit_l); CONV_TAC( root, rewrite_conv(THM_LIST( - AUTH_RA_OP_COMPONENTS, + auth_ra_op_components, auth_auth_def, auth_frag_def, auth_both_def, @@ -591,7 +591,7 @@ PROOF static thm prove_auth_ra_auth_frag(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_AUTH_FRAG = +PROOF thm auth_ra_auth_frag = prove_auth_ra_auth_frag(); PROOF static thm prove_auth_ra_frag_frag(void) { @@ -607,7 +607,7 @@ PROOF static thm prove_auth_ra_frag_frag(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - AUTH_RA_OP_COMPONENTS, + auth_ra_op_components, auth_frag_def, excl_op_def, get_theorem_by_name("FST"), @@ -615,7 +615,7 @@ PROOF static thm prove_auth_ra_frag_frag(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_FRAG_FRAG = +PROOF thm auth_ra_frag_frag = prove_auth_ra_frag_frag(); PROOF static thm prove_auth_ra_both_frag(void) { @@ -631,7 +631,7 @@ PROOF static thm prove_auth_ra_both_frag(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - AUTH_RA_OP_COMPONENTS, + auth_ra_op_components, auth_both_def, auth_frag_def, excl_op_def, @@ -641,7 +641,7 @@ PROOF static thm prove_auth_ra_both_frag(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_BOTH_FRAG = +PROOF thm auth_ra_both_frag = prove_auth_ra_both_frag(); /* The combined constructor at the base unit is exactly authority-only. @@ -652,8 +652,8 @@ PROOF static thm prove_auth_ra_both_unit(void) { term a = `a:A`; thm composed = ispecl_rule( TERM_LIST(R, a, `ra_unit (R:(A)ra)`), - AUTH_RA_AUTH_FRAG); - thm unit_equation = ispec_rule(R, AUTH_RA_UNIT); + auth_ra_auth_frag); + thm unit_equation = ispec_rule(R, auth_ra_unit); thm replace_fragment = gsym_rule(beta_rule(ap_term_rule( `\x:(A)excl#A. ra_op @@ -665,7 +665,7 @@ PROOF static thm prove_auth_ra_both_unit(void) { TERM_LIST( `auth_ra (R:(A)ra)`, `auth_auth R (a:A)`), - RA_UNIT_R); + ra_unit_r); thm result = trans_rule( gsym_rule(composed), trans_rule(replace_fragment, remove_unit)); @@ -673,7 +673,7 @@ PROOF static thm prove_auth_ra_both_unit(void) { return gen_rule(R, result); } -PROOF thm AUTH_RA_BOTH_UNIT = +PROOF thm auth_ra_both_unit = prove_auth_ra_both_unit(); /* The excl implementation keeps its raw constructor-injectivity theorem @@ -693,7 +693,7 @@ PROOF static thm prove_auth_excl_owned_inj(void) { TERM_LIST( `excl_ra:((A)excl)ra`, `Excl (a:A):(A)excl`), - RA_INCLUDED_REFL); + ra_included_refl); thm replace_target = beta_rule(ap_term_rule( `\x:(A)excl. ra_included @@ -705,7 +705,7 @@ PROOF static thm prove_auth_excl_owned_inj(void) { thm payloads_equal = eq_mp_rule( ispecl_rule( TERM_LIST(`a:A`, `b:A`), - EXCL_RA_INCLUDED_OWNED), + excl_ra_included_owned), included); ACCEPT_TAC(forward, payloads_equal); @@ -718,7 +718,7 @@ PROOF static thm prove_auth_excl_owned_inj(void) { return gnode_prove(root); } -PROOF static thm AUTH_EXCL_OWNED_INJ = +PROOF static thm auth_excl_owned_inj = prove_auth_excl_owned_inj(); PROOF static thm prove_auth_ra_frag_inj(void) { @@ -735,7 +735,7 @@ PROOF static thm prove_auth_ra_frag_inj(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_FRAG_INJ = +PROOF thm auth_ra_frag_inj = prove_auth_ra_frag_inj(); PROOF static thm prove_auth_ra_both_inj(void) { @@ -750,11 +750,11 @@ PROOF static thm prove_auth_ra_both_inj(void) { rewrite_conv(THM_LIST( auth_both_def, get_theorem_by_name("PAIR_EQ"), - AUTH_EXCL_OWNED_INJ))); + auth_excl_owned_inj))); return gnode_prove(root); } -PROOF thm AUTH_RA_BOTH_INJ = +PROOF thm auth_ra_both_inj = prove_auth_ra_both_inj(); PROOF static thm prove_auth_ra_both_ne_frag(void) { @@ -769,11 +769,11 @@ PROOF static thm prove_auth_ra_both_ne_frag(void) { auth_both_def, auth_frag_def, get_theorem_by_name("PAIR_EQ"), - EXCL_OWNED_NE_UNIT))); + excl_owned_ne_unit))); return gnode_prove(root); } -PROOF thm AUTH_RA_BOTH_NE_FRAG = +PROOF thm auth_ra_both_ne_frag = prove_auth_ra_both_ne_frag(); PROOF static thm prove_auth_ra_auth_inj(void) { @@ -787,11 +787,11 @@ PROOF static thm prove_auth_ra_auth_inj(void) { rewrite_conv(THM_LIST( auth_auth_def, get_theorem_by_name("PAIR_EQ"), - AUTH_EXCL_OWNED_INJ))); + auth_excl_owned_inj))); return gnode_prove(root); } -PROOF thm AUTH_RA_AUTH_INJ = +PROOF thm auth_ra_auth_inj = prove_auth_ra_auth_inj(); PROOF static thm prove_auth_ra_auth_ne_frag(void) { @@ -806,11 +806,11 @@ PROOF static thm prove_auth_ra_auth_ne_frag(void) { auth_auth_def, auth_frag_def, get_theorem_by_name("PAIR_EQ"), - EXCL_OWNED_NE_UNIT))); + excl_owned_ne_unit))); return gnode_prove(root); } -PROOF thm AUTH_RA_AUTH_NE_FRAG = +PROOF thm auth_ra_auth_ne_frag = prove_auth_ra_auth_ne_frag(); PROOF static thm prove_auth_ra_auth_eq_both(void) { @@ -829,12 +829,12 @@ PROOF static thm prove_auth_ra_auth_eq_both(void) { auth_auth_def, auth_both_def, get_theorem_by_name("PAIR_EQ"), - AUTH_EXCL_OWNED_INJ, + auth_excl_owned_inj, unit_symmetry))); return gnode_prove(root); } -PROOF thm AUTH_RA_AUTH_EQ_BOTH = +PROOF thm auth_ra_auth_eq_both = prove_auth_ra_auth_eq_both(); PROOF static thm prove_auth_ra_valid_frag(void) { @@ -847,7 +847,7 @@ PROOF static thm prove_auth_ra_valid_frag(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - AUTH_RA_VALID_COMPONENTS, + auth_ra_valid_components, auth_frag_def, auth_valid_at_def, get_theorem_by_name("FST"), @@ -855,7 +855,7 @@ PROOF static thm prove_auth_ra_valid_frag(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_VALID_FRAG = +PROOF thm auth_ra_valid_frag = prove_auth_ra_valid_frag(); PROOF static thm prove_auth_ra_valid_both(void) { @@ -869,7 +869,7 @@ PROOF static thm prove_auth_ra_valid_both(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - AUTH_RA_VALID_COMPONENTS, + auth_ra_valid_components, auth_both_def, auth_valid_at_def, get_theorem_by_name("FST"), @@ -877,7 +877,7 @@ PROOF static thm prove_auth_ra_valid_both(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_VALID_BOTH = +PROOF thm auth_ra_valid_both = prove_auth_ra_valid_both(); PROOF static thm prove_auth_ra_valid_both_intro(void) { @@ -894,12 +894,12 @@ PROOF static thm prove_auth_ra_valid_both_intro(void) { assume_rule(`ra_included (R:(A)ra) (f:A) (a:A)`)); thm characterization = ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`, `f:A`), - AUTH_RA_VALID_BOTH); + auth_ra_valid_both); ACCEPT_TAC(body, eq_mp_rule(gsym_rule(characterization), details)); return gnode_prove(root); } -PROOF thm AUTH_RA_VALID_BOTH_INTRO = +PROOF thm auth_ra_valid_both_intro = prove_auth_ra_valid_both_intro(); PROOF static thm prove_auth_ra_valid_both_elim_valid(void) { @@ -913,7 +913,7 @@ PROOF static thm prove_auth_ra_valid_both_elim_valid(void) { thm details = eq_mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`, `f:A`), - AUTH_RA_VALID_BOTH), + auth_ra_valid_both), assume_rule(` ra_valid (auth_ra (R:(A)ra)) @@ -923,7 +923,7 @@ PROOF static thm prove_auth_ra_valid_both_elim_valid(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_VALID_BOTH_ELIM_VALID = +PROOF thm auth_ra_valid_both_elim_valid = prove_auth_ra_valid_both_elim_valid(); PROOF static thm prove_auth_ra_valid_both_elim_included(void) { @@ -937,7 +937,7 @@ PROOF static thm prove_auth_ra_valid_both_elim_included(void) { thm details = eq_mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`, `f:A`), - AUTH_RA_VALID_BOTH), + auth_ra_valid_both), assume_rule(` ra_valid (auth_ra (R:(A)ra)) @@ -947,7 +947,7 @@ PROOF static thm prove_auth_ra_valid_both_elim_included(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_VALID_BOTH_ELIM_INCLUDED = +PROOF thm auth_ra_valid_both_elim_included = prove_auth_ra_valid_both_elim_included(); PROOF static thm prove_auth_ra_valid_auth(void) { @@ -959,11 +959,11 @@ PROOF static thm prove_auth_ra_valid_auth(void) { gnode root = gnode_new_with_ccl(goal_tm); thm unit_included = ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), - RA_INCLUDED_UNIT); + ra_included_unit); CONV_TAC( root, rewrite_conv(THM_LIST( - AUTH_RA_VALID_COMPONENTS, + auth_ra_valid_components, auth_auth_def, auth_valid_at_def, get_theorem_by_name("FST"), @@ -972,7 +972,7 @@ PROOF static thm prove_auth_ra_valid_auth(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_VALID_AUTH = +PROOF thm auth_ra_valid_auth = prove_auth_ra_valid_auth(); PROOF static thm prove_auth_ra_valid_auth_frag(void) { @@ -990,12 +990,12 @@ PROOF static thm prove_auth_ra_valid_auth_frag(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - AUTH_RA_AUTH_FRAG, - AUTH_RA_VALID_BOTH))); + auth_ra_auth_frag, + auth_ra_valid_both))); return gnode_prove(root); } -PROOF thm AUTH_RA_VALID_AUTH_FRAG = +PROOF thm auth_ra_valid_auth_frag = prove_auth_ra_valid_auth_frag(); PROOF static thm prove_auth_ra_valid_both_frag(void) { @@ -1014,12 +1014,12 @@ PROOF static thm prove_auth_ra_valid_both_frag(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - AUTH_RA_BOTH_FRAG, - AUTH_RA_VALID_BOTH))); + auth_ra_both_frag, + auth_ra_valid_both))); return gnode_prove(root); } -PROOF thm AUTH_RA_VALID_BOTH_FRAG = +PROOF thm auth_ra_valid_both_frag = prove_auth_ra_valid_both_frag(); PROOF static thm prove_auth_ra_auth_conflict(void) { @@ -1035,8 +1035,8 @@ PROOF static thm prove_auth_ra_auth_conflict(void) { root, rewrite_conv(THM_LIST( ra_compatible_def, - AUTH_RA_OP_COMPONENTS, - AUTH_RA_VALID_COMPONENTS, + auth_ra_op_components, + auth_ra_valid_components, auth_auth_def, auth_valid_at_def, excl_op_def, @@ -1046,7 +1046,7 @@ PROOF static thm prove_auth_ra_auth_conflict(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_AUTH_CONFLICT = +PROOF thm auth_ra_auth_conflict = prove_auth_ra_auth_conflict(); /* A valid frame for an authoritative owner cannot itself contain authority. @@ -1080,16 +1080,16 @@ PROOF static thm prove_auth_ra_valid_both_frame_components(void) { cases[i], auth_reduce_conv, THM_LIST( - AUTH_RA_OP_COMPONENTS, - AUTH_RA_VALID_COMPONENTS, + auth_ra_op_components, + auth_ra_valid_components, auth_both_def, - EXCL_OWNED_NE_UNIT, - EXCL_INVALID_NE_UNIT)); + excl_owned_ne_unit, + excl_invalid_ne_unit)); } return gnode_prove(root); } -PROOF static thm AUTH_RA_VALID_BOTH_FRAME_COMPONENTS = +PROOF static thm auth_ra_valid_both_frame_components = prove_auth_ra_valid_both_frame_components(); /* Constructor-level form of the frame characterization. This is the public @@ -1125,7 +1125,7 @@ PROOF static thm prove_auth_ra_valid_both_frame(void) { `a:A`, `f:A`, `frame:(A)excl#A`), - AUTH_RA_VALID_BOTH_FRAME_COMPONENTS), + auth_ra_valid_both_frame_components), assume_rule(` ra_valid (auth_ra (R:(A)ra)) @@ -1195,14 +1195,14 @@ PROOF static thm prove_auth_ra_valid_both_frame(void) { `a:A`, `f:A`, `frame:(A)excl#A`), - AUTH_RA_VALID_BOTH_FRAME_COMPONENTS); + auth_ra_valid_both_frame_components); ACCEPT_TAC( reverse, eq_mp_rule(gsym_rule(raw_characterization), raw_components)); return gnode_prove(root); } -PROOF thm AUTH_RA_VALID_BOTH_FRAME = +PROOF thm auth_ra_valid_both_frame = prove_auth_ra_valid_both_frame(); /* Authority-only is the unit-fragment specialization of the public combined @@ -1213,18 +1213,18 @@ PROOF static thm prove_auth_ra_valid_auth_frame(void) { term frame = `frame:(A)excl#A`; thm result = ispecl_rule( TERM_LIST(R, a, `ra_unit (R:(A)ra)`, frame), - AUTH_RA_VALID_BOTH_FRAME); + auth_ra_valid_both_frame); result = rewrite_rule( THM_LIST( - AUTH_RA_BOTH_UNIT, - RA_UNIT_L), + auth_ra_both_unit, + ra_unit_l), result); result = gen_rule(frame, result); result = gen_rule(a, result); return gen_rule(R, result); } -PROOF thm AUTH_RA_VALID_AUTH_FRAME = +PROOF thm auth_ra_valid_auth_frame = prove_auth_ra_valid_auth_frame(); /* Any two combined resources carry two exclusive authoritative owners. The @@ -1255,7 +1255,7 @@ PROOF static thm prove_auth_ra_both_conflict(void) { `a:A`, `f:A`, `auth_both (b:A) (g:A)`), - AUTH_RA_VALID_BOTH_FRAME_COMPONENTS), + auth_ra_valid_both_frame_components), assume_rule(` ra_valid (auth_ra (R:(A)ra)) @@ -1271,13 +1271,13 @@ PROOF static thm prove_auth_ra_both_conflict(void) { THM_LIST(get_theorem_by_name("FST")), frame_is_unit); thm contradiction = not_elim_rule( - ispec_rule(`b:A`, EXCL_OWNED_NE_UNIT), + ispec_rule(`b:A`, excl_owned_ne_unit), frame_is_unit); CONTR_TAC(body, contradiction); return gnode_prove(root); } -PROOF thm AUTH_RA_BOTH_CONFLICT = +PROOF thm auth_ra_both_conflict = prove_auth_ra_both_conflict(); PROOF static thm prove_auth_ra_auth_both_conflict(void) { @@ -1287,9 +1287,9 @@ PROOF static thm prove_auth_ra_auth_both_conflict(void) { term g = `g:A`; thm result = ispecl_rule( TERM_LIST(R, a, `ra_unit (R:(A)ra)`, b, g), - AUTH_RA_BOTH_CONFLICT); + auth_ra_both_conflict); result = pure_once_rewrite_rule( - THM_LIST(AUTH_RA_BOTH_UNIT), + THM_LIST(auth_ra_both_unit), result); result = gen_rule(g, result); result = gen_rule(b, result); @@ -1297,7 +1297,7 @@ PROOF static thm prove_auth_ra_auth_both_conflict(void) { return gen_rule(R, result); } -PROOF thm AUTH_RA_AUTH_BOTH_CONFLICT = +PROOF thm auth_ra_auth_both_conflict = prove_auth_ra_auth_both_conflict(); /* ExclUnit is the exclusive RA unit and is therefore included in every @@ -1305,13 +1305,13 @@ PROOF thm AUTH_RA_AUTH_BOTH_CONFLICT = PROOF static thm prove_auth_excl_unit_included(void) { thm result = ispec_rule( `excl_ra:((A)excl)ra`, - RA_INCLUDED_UNIT); + ra_included_unit); return pure_rewrite_rule( - THM_LIST(EXCL_RA_UNIT), + THM_LIST(excl_ra_unit), result); } -PROOF static thm AUTH_EXCL_UNIT_INCLUDED = +PROOF static thm auth_excl_unit_included = prove_auth_excl_unit_included(); /* An owned exclusive element cannot extend to ExclUnit. Deriving this from @@ -1332,13 +1332,13 @@ PROOF static thm prove_auth_excl_owned_not_included_unit(void) { `excl_ra:((A)excl)ra`, `Excl (a:A):(A)excl`, `ExclUnit:(A)excl`), - RA_EXCLUSIVE_INCLUDED); + ra_exclusive_included); forced_equal = mp_rule( forced_equal, - ispec_rule(`a:A`, EXCL_RA_EXCLUSIVE)); + ispec_rule(`a:A`, excl_ra_exclusive)); forced_equal = mp_rule( forced_equal, - EXCL_RA_VALID_UNIT); + excl_ra_valid_unit); forced_equal = mp_rule( forced_equal, assume_rule(` @@ -1348,28 +1348,28 @@ PROOF static thm prove_auth_excl_owned_not_included_unit(void) { (ExclUnit:(A)excl) `)); thm contradiction = not_elim_rule( - ispec_rule(`a:A`, EXCL_OWNED_NE_UNIT), + ispec_rule(`a:A`, excl_owned_ne_unit), forced_equal); CONTR_TAC(body, contradiction); return gnode_prove(root); } -PROOF static thm AUTH_EXCL_OWNED_NOT_INCLUDED_UNIT = +PROOF static thm auth_excl_owned_not_included_unit = prove_auth_excl_owned_not_included_unit(); /* Shared reduction for the complete constructor-inclusion table. */ PROOF static conv auth_included_reduce_conv(void) { return rewrite_conv(THM_LIST( - AUTH_RA_INCLUDED_COMPONENTS, + auth_ra_included_components, auth_auth_def, auth_frag_def, auth_both_def, get_theorem_by_name("FST"), get_theorem_by_name("SND"), - AUTH_EXCL_UNIT_INCLUDED, - AUTH_EXCL_OWNED_NOT_INCLUDED_UNIT, - EXCL_RA_INCLUDED_OWNED, - RA_INCLUDED_UNIT)); + auth_excl_unit_included, + auth_excl_owned_not_included_unit, + excl_ra_included_owned, + ra_included_unit)); } PROOF static thm prove_auth_ra_included_frag_frag(void) { @@ -1386,7 +1386,7 @@ PROOF static thm prove_auth_ra_included_frag_frag(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_INCLUDED_FRAG_FRAG = +PROOF thm auth_ra_included_frag_frag = prove_auth_ra_included_frag_frag(); PROOF static thm prove_auth_ra_included_frag_auth(void) { @@ -1403,7 +1403,7 @@ PROOF static thm prove_auth_ra_included_frag_auth(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_INCLUDED_FRAG_AUTH = +PROOF thm auth_ra_included_frag_auth = prove_auth_ra_included_frag_auth(); PROOF static thm prove_auth_ra_included_frag_both(void) { @@ -1420,7 +1420,7 @@ PROOF static thm prove_auth_ra_included_frag_both(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_INCLUDED_FRAG_BOTH = +PROOF thm auth_ra_included_frag_both = prove_auth_ra_included_frag_both(); PROOF static thm prove_auth_ra_included_auth_frag(void) { @@ -1436,7 +1436,7 @@ PROOF static thm prove_auth_ra_included_auth_frag(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_INCLUDED_AUTH_FRAG = +PROOF thm auth_ra_included_auth_frag = prove_auth_ra_included_auth_frag(); PROOF static thm prove_auth_ra_included_auth_auth(void) { @@ -1453,7 +1453,7 @@ PROOF static thm prove_auth_ra_included_auth_auth(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_INCLUDED_AUTH_AUTH = +PROOF thm auth_ra_included_auth_auth = prove_auth_ra_included_auth_auth(); PROOF static thm prove_auth_ra_included_auth_both(void) { @@ -1470,7 +1470,7 @@ PROOF static thm prove_auth_ra_included_auth_both(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_INCLUDED_AUTH_BOTH = +PROOF thm auth_ra_included_auth_both = prove_auth_ra_included_auth_both(); PROOF static thm prove_auth_ra_included_both_frag(void) { @@ -1486,7 +1486,7 @@ PROOF static thm prove_auth_ra_included_both_frag(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_INCLUDED_BOTH_FRAG = +PROOF thm auth_ra_included_both_frag = prove_auth_ra_included_both_frag(); PROOF static thm prove_auth_ra_included_both_auth(void) { @@ -1503,7 +1503,7 @@ PROOF static thm prove_auth_ra_included_both_auth(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_INCLUDED_BOTH_AUTH = +PROOF thm auth_ra_included_both_auth = prove_auth_ra_included_both_auth(); PROOF static thm prove_auth_ra_included_both_both(void) { @@ -1520,7 +1520,7 @@ PROOF static thm prove_auth_ra_included_both_both(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_INCLUDED_BOTH_BOTH = +PROOF thm auth_ra_included_both_both = prove_auth_ra_included_both_both(); /* Cancellativity follows from the carrier product. Auth validity supplies @@ -1548,10 +1548,10 @@ PROOF static thm prove_auth_ra_cancellative(void) { TERM_LIST( `excl_ra:((A)excl)ra`, `R:(A)ra`), - PROD_RA_CANCELLATIVE); + prod_ra_cancellative); product_cancellative = mp_rule( product_cancellative, - EXCL_RA_CANCELLATIVE); + excl_ra_cancellative); product_cancellative = mp_rule( product_cancellative, assume_rule(`ra_cancellative (R:(A)ra)`)); @@ -1564,13 +1564,13 @@ PROOF static thm prove_auth_ra_cancellative(void) { `R:(A)ra`, `frame:(A)excl#A`, `a:(A)excl#A`), - AUTH_RA_OP_AS_PRODUCT); + auth_ra_op_as_product); thm right_op = ispecl_rule( TERM_LIST( `R:(A)ra`, `frame:(A)excl#A`, `b:(A)excl#A`), - AUTH_RA_OP_AS_PRODUCT); + auth_ra_op_as_product); thm source_product_at_auth_op = mp_rule( ispecl_rule( @@ -1580,7 +1580,7 @@ PROOF static thm prove_auth_ra_cancellative(void) { (auth_ra (R:(A)ra)) (frame:(A)excl#A) (a:(A)excl#A)`), - AUTH_RA_VALID_IMP_PRODUCT_VALID), + auth_ra_valid_imp_product_valid), assume_rule(` ra_valid (auth_ra (R:(A)ra)) @@ -1626,7 +1626,7 @@ PROOF static thm prove_auth_ra_cancellative(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_CANCELLATIVE = +PROOF thm auth_ra_cancellative = prove_auth_ra_cancellative(); PROOF static thm prove_auth_ra_cancellative_iff(void) { @@ -1654,7 +1654,7 @@ PROOF static thm prove_auth_ra_cancellative_iff(void) { thm lifted_source_valid = eq_mp_rule( gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, source), - AUTH_RA_VALID_FRAG)), + auth_ra_valid_frag)), assume_rule(` ra_valid (R:(A)ra) @@ -1662,7 +1662,7 @@ PROOF static thm prove_auth_ra_cancellative_iff(void) { `)); thm left_op = ispecl_rule( TERM_LIST(`R:(A)ra`, `frame:A`, `a:A`), - AUTH_RA_FRAG_FRAG); + auth_ra_frag_frag); thm lifted_source_eq = ap_term_rule( `ra_valid (auth_ra (R:(A)ra))`, left_op); @@ -1678,7 +1678,7 @@ PROOF static thm prove_auth_ra_cancellative_iff(void) { `)); thm right_op = ispecl_rule( TERM_LIST(`R:(A)ra`, `frame:A`, `b:A`), - AUTH_RA_FRAG_FRAG); + auth_ra_frag_frag); thm lifted_ops_equal = trans_rule( left_op, trans_rule(lifted_base_eq, gsym_rule(right_op))); @@ -1689,7 +1689,7 @@ PROOF static thm prove_auth_ra_cancellative_iff(void) { `auth_frag (frame:A)`, `auth_frag (a:A)`, `auth_frag (b:A)`), - RA_CANCELLATIVE_APPLY); + ra_cancellative_apply); fragment_equality = mp_rule( fragment_equality, assume_rule(`ra_cancellative (auth_ra (R:(A)ra))`)); @@ -1698,7 +1698,7 @@ PROOF static thm prove_auth_ra_cancellative_iff(void) { thm payload_equality = eq_mp_rule( ispecl_rule( TERM_LIST(`a:A`, `b:A`), - AUTH_RA_FRAG_INJ), + auth_ra_frag_inj), fragment_equality); ACCEPT_TAC(forward, payload_equality); @@ -1708,12 +1708,12 @@ PROOF static thm prove_auth_ra_cancellative_iff(void) { ACCEPT_TAC( reverse, mp_rule( - ispec_rule(`R:(A)ra`, AUTH_RA_CANCELLATIVE), + ispec_rule(`R:(A)ra`, auth_ra_cancellative), assume_rule(`ra_cancellative (R:(A)ra)`))); return gnode_prove(root); } -PROOF thm AUTH_RA_CANCELLATIVE_IFF = +PROOF thm auth_ra_cancellative_iff = prove_auth_ra_cancellative_iff(); /* ------------------------------------------------------------------------- */ @@ -1759,7 +1759,7 @@ PROOF static thm prove_auth_ra_update_framewise(void) { `a:A`, `f:A`, `frame:(A)excl#A`), - AUTH_RA_VALID_BOTH_FRAME_COMPONENTS); + auth_ra_valid_both_frame_components); thm source_details = eq_mp_rule( source_characterization, assume_rule(` @@ -1793,14 +1793,14 @@ PROOF static thm prove_auth_ra_update_framewise(void) { `b:A`, `g:A`, `frame:(A)excl#A`), - AUTH_RA_VALID_BOTH_FRAME_COMPONENTS); + auth_ra_valid_both_frame_components); ACCEPT_TAC( body, eq_mp_rule(gsym_rule(target_characterization), target_details)); return gnode_prove(root); } -PROOF thm AUTH_RA_UPDATE_FRAMEWISE = +PROOF thm auth_ra_update_framewise = prove_auth_ra_update_framewise(); PROOF static thm prove_auth_ra_update_framewise_iff(void) { @@ -1835,7 +1835,7 @@ PROOF static thm prove_auth_ra_update_framewise_iff(void) { `a:A`, `f:A`, `external:A`), - AUTH_RA_VALID_BOTH_FRAG)), + auth_ra_valid_both_frag)), assume_rule(` ra_valid (R:(A)ra) (a:A) && ra_included @@ -1851,7 +1851,7 @@ PROOF static thm prove_auth_ra_update_framewise_iff(void) { `auth_both (a:A) (f:A)`, `auth_both (b:A) (g:A)`, `auth_frag (external:A)`), - RA_UPDATE_APPLY), + ra_update_apply), assume_rule(` ra_update (auth_ra (R:(A)ra)) @@ -1866,7 +1866,7 @@ PROOF static thm prove_auth_ra_update_framewise_iff(void) { `b:A`, `g:A`, `external:A`), - AUTH_RA_VALID_BOTH_FRAG), + auth_ra_valid_both_frag), target_valid); ACCEPT_TAC(forward, target_details); @@ -1881,7 +1881,7 @@ PROOF static thm prove_auth_ra_update_framewise_iff(void) { `f:A`, `b:A`, `g:A`), - AUTH_RA_UPDATE_FRAMEWISE), + auth_ra_update_framewise), assume_rule(` forall external:A. ra_valid (R:(A)ra) (a:A) && @@ -1892,7 +1892,7 @@ PROOF static thm prove_auth_ra_update_framewise_iff(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_UPDATE_FRAMEWISE_IFF = +PROOF thm auth_ra_update_framewise_iff = prove_auth_ra_update_framewise_iff(); /* Iris-style auth update. A local update preserves the exact residual @@ -1924,7 +1924,7 @@ PROOF static thm prove_auth_ra_update_local(void) { `f:A`, `b:A`, `g:A`), - AUTH_RA_UPDATE_FRAMEWISE)); + auth_ra_update_framewise)); body = GEN_TAC(body, "external"); body = DISCH_TAC(body, "Hsource"); body = ASMP_CONJ_TAC( @@ -1940,7 +1940,7 @@ PROOF static thm prove_auth_ra_update_local(void) { `b:A`, `g:A`, `external:A`), - RA_LOCAL_UPDATE_PRESERVES_INCLUDED); + ra_local_update_preserves_included); preserved = mp_rule( preserved, assume_rule(`ra_local_update (R:(A)ra) (a:A) (f:A) (b:A) (g:A)`)); @@ -1959,7 +1959,7 @@ PROOF static thm prove_auth_ra_update_local(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_UPDATE_LOCAL = +PROOF thm auth_ra_update_local = prove_auth_ra_update_local(); /* ------------------------------------------------------------------------- */ @@ -1987,11 +1987,11 @@ PROOF static thm prove_auth_ra_update_auth_iff(void) { `ra_unit (R:(A)ra)`, `b:A`, `ra_unit (R:(A)ra)`), - AUTH_RA_UPDATE_FRAMEWISE_IFF); + auth_ra_update_framewise_iff); framewise_characterization = rewrite_rule( THM_LIST( - AUTH_RA_BOTH_UNIT, - RA_UNIT_L), + auth_ra_both_unit, + ra_unit_l), framewise_characterization); gnode forward = DISCH_TAC(directions[0], "Hupdate"); @@ -2008,7 +2008,7 @@ PROOF static thm prove_auth_ra_update_auth_iff(void) { assume_rule(`ra_valid (R:(A)ra) (a:A)`), ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), - RA_INCLUDED_REFL)); + ra_included_refl)); thm target_at_self = mp_rule( spec_rule(`a:A`, framewise), source_at_self); @@ -2022,11 +2022,11 @@ PROOF static thm prove_auth_ra_update_auth_iff(void) { `ra_unit (R:(A)ra)`, `b:A`, `ra_unit (R:(A)ra)`), - AUTH_RA_UPDATE_FRAMEWISE); + auth_ra_update_framewise); update_rule = rewrite_rule( THM_LIST( - AUTH_RA_BOTH_UNIT, - RA_UNIT_L), + auth_ra_both_unit, + ra_unit_l), update_rule); reverse = MATCH_MP_TAC(reverse, update_rule); reverse = GEN_TAC(reverse, "external"); @@ -2042,7 +2042,7 @@ PROOF static thm prove_auth_ra_update_auth_iff(void) { `))); thm target_included = match_mp_rule( match_mp_rule( - RA_INCLUDED_TRANS, + ra_included_trans, conjunct2_rule(assume_rule(` ra_valid (R:(A)ra) (a:A) && ra_included R (external:A) a @@ -2054,7 +2054,7 @@ PROOF static thm prove_auth_ra_update_auth_iff(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_UPDATE_AUTH_IFF = +PROOF thm auth_ra_update_auth_iff = prove_auth_ra_update_auth_iff(); PROOF static thm prove_auth_ra_update_auth_included(void) { @@ -2071,7 +2071,7 @@ PROOF static thm prove_auth_ra_update_auth_included(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(AUTH_RA_UPDATE_AUTH_IFF))); + once_rewrite_conv(THM_LIST(auth_ra_update_auth_iff))); body = DISCH_TAC(body, "Hsource_valid"); ACCEPT_TAC( body, @@ -2081,7 +2081,7 @@ PROOF static thm prove_auth_ra_update_auth_included(void) { return gnode_prove(root); } -PROOF thm AUTH_RA_UPDATE_AUTH_INCLUDED = +PROOF thm auth_ra_update_auth_included = prove_auth_ra_update_auth_included(); PROOF static thm prove_auth_ra_update_drop_local(void) { @@ -2094,21 +2094,21 @@ PROOF static thm prove_auth_ra_update_drop_local(void) { term combined = `auth_both (a:A) (f:A)`; thm included = ispecl_rule( TERM_LIST(auth, authority, fragment), - RA_INCLUDED_OP_L); + ra_included_op_l); included = rewrite_rule( - THM_LIST(AUTH_RA_AUTH_FRAG), + THM_LIST(auth_ra_auth_frag), included); thm result = mp_rule( ispecl_rule( TERM_LIST(auth, combined, authority), - RA_UPDATE_INCLUDED), + ra_update_included), included); result = gen_rule(f, result); result = gen_rule(a, result); return gen_rule(R, result); } -PROOF thm AUTH_RA_UPDATE_DROP_LOCAL = +PROOF thm auth_ra_update_drop_local = prove_auth_ra_update_drop_local(); PROOF static thm prove_auth_ra_update_drop_auth(void) { @@ -2121,21 +2121,21 @@ PROOF static thm prove_auth_ra_update_drop_auth(void) { term combined = `auth_both (a:A) (f:A)`; thm included = ispecl_rule( TERM_LIST(auth, authority, fragment), - RA_INCLUDED_OP_R); + ra_included_op_r); included = rewrite_rule( - THM_LIST(AUTH_RA_AUTH_FRAG), + THM_LIST(auth_ra_auth_frag), included); thm result = mp_rule( ispecl_rule( TERM_LIST(auth, combined, fragment), - RA_UPDATE_INCLUDED), + ra_update_included), included); result = gen_rule(f, result); result = gen_rule(a, result); return gen_rule(R, result); } -PROOF thm AUTH_RA_UPDATE_DROP_AUTH = +PROOF thm auth_ra_update_drop_auth = prove_auth_ra_update_drop_auth(); PROOF static thm prove_auth_ra_update_weaken_frag(void) { @@ -2160,7 +2160,7 @@ PROOF static thm prove_auth_ra_update_weaken_frag(void) { `g:A`, `a:A`, `f:A`), - AUTH_RA_INCLUDED_BOTH_BOTH)), + auth_ra_included_both_both)), details); thm updated = mp_rule( ispecl_rule( @@ -2168,13 +2168,13 @@ PROOF static thm prove_auth_ra_update_weaken_frag(void) { `auth_ra (R:(A)ra)`, `auth_both (a:A) (f:A)`, `auth_both (a:A) (g:A)`), - RA_UPDATE_INCLUDED), + ra_update_included), included); ACCEPT_TAC(body, updated); return gnode_prove(root); } -PROOF thm AUTH_RA_UPDATE_WEAKEN_FRAG = +PROOF thm auth_ra_update_weaken_frag = prove_auth_ra_update_weaken_frag(); PROOF static thm prove_auth_ra_frag_update_included(void) { @@ -2191,7 +2191,7 @@ PROOF static thm prove_auth_ra_frag_update_included(void) { thm included = eq_mp_rule( gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `g:A`, `f:A`), - AUTH_RA_INCLUDED_FRAG_FRAG)), + auth_ra_included_frag_frag)), assume_rule(`ra_included (R:(A)ra) (g:A) (f:A)`)); thm updated = mp_rule( ispecl_rule( @@ -2199,13 +2199,13 @@ PROOF static thm prove_auth_ra_frag_update_included(void) { `auth_ra (R:(A)ra)`, `auth_frag (f:A)`, `auth_frag (g:A)`), - RA_UPDATE_INCLUDED), + ra_update_included), included); ACCEPT_TAC(body, updated); return gnode_prove(root); } -PROOF thm AUTH_RA_FRAG_UPDATE_INCLUDED = +PROOF thm auth_ra_frag_update_included = prove_auth_ra_frag_update_included(); PROOF static thm prove_auth_ra_update_both_included(void) { @@ -2224,7 +2224,7 @@ PROOF static thm prove_auth_ra_update_both_included(void) { mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`, `b:A`), - AUTH_RA_UPDATE_AUTH_INCLUDED), + auth_ra_update_auth_included), assume_rule(`ra_valid (R:(A)ra) (b:A)`)), assume_rule(`ra_included (R:(A)ra) (a:A) (b:A)`)); thm framed = mp_rule( @@ -2234,16 +2234,16 @@ PROOF static thm prove_auth_ra_update_both_included(void) { `auth_auth (R:(A)ra) (a:A)`, `auth_auth (R:(A)ra) (b:A)`, `auth_frag (f:A)`), - RA_UPDATE_FRAME), + ra_update_frame), authority_update); framed = rewrite_rule( - THM_LIST(AUTH_RA_AUTH_FRAG), + THM_LIST(auth_ra_auth_frag), framed); ACCEPT_TAC(body, framed); return gnode_prove(root); } -PROOF thm AUTH_RA_UPDATE_BOTH_INCLUDED = +PROOF thm auth_ra_update_both_included = prove_auth_ra_update_both_included(); /* Iris `auth_update_alloc`: authority-only is the unit-fragment instance of @@ -2267,7 +2267,7 @@ PROOF static thm prove_auth_ra_update_alloc(void) { `ra_unit (R:(A)ra)`, `b:A`, `g:A`), - AUTH_RA_UPDATE_LOCAL), + auth_ra_update_local), assume_rule(` ra_local_update (R:(A)ra) @@ -2277,13 +2277,13 @@ PROOF static thm prove_auth_ra_update_alloc(void) { (g:A) `)); updated = rewrite_rule( - THM_LIST(AUTH_RA_BOTH_UNIT), + THM_LIST(auth_ra_both_unit), updated); ACCEPT_TAC(body, updated); return gnode_prove(root); } -PROOF thm AUTH_RA_UPDATE_ALLOC = +PROOF thm auth_ra_update_alloc = prove_auth_ra_update_alloc(); /* ------------------------------------------------------------------------- */ @@ -2314,7 +2314,7 @@ PROOF static thm prove_auth_ra_alloc_both(void) { `a:A`, `f:A`, `piece:A`), - RA_LOCAL_UPDATE_ALLOC), + ra_local_update_alloc), assume_rule(` ra_valid (R:(A)ra) @@ -2328,13 +2328,13 @@ PROOF static thm prove_auth_ra_alloc_both(void) { `f:A`, `ra_op (R:(A)ra) (a:A) (piece:A)`, `ra_op (R:(A)ra) (f:A) (piece:A)`), - AUTH_RA_UPDATE_LOCAL), + auth_ra_update_local), local); ACCEPT_TAC(body, updated); return gnode_prove(root); } -PROOF thm AUTH_RA_ALLOC_BOTH = +PROOF thm auth_ra_alloc_both = prove_auth_ra_alloc_both(); PROOF static thm prove_auth_ra_alloc(void) { @@ -2355,20 +2355,20 @@ PROOF static thm prove_auth_ra_alloc(void) { `a:A`, `ra_unit (R:(A)ra)`, `piece:A`), - AUTH_RA_ALLOC_BOTH), + auth_ra_alloc_both), assume_rule(` ra_valid (R:(A)ra) (ra_op R (a:A) (piece:A)) `)); thm_list reductions = THM_LIST( - AUTH_RA_BOTH_UNIT, - RA_UNIT_L); + auth_ra_both_unit, + ra_unit_l); ACCEPT_TAC(body, rewrite_rule(reductions, allocated)); return gnode_prove(root); } -PROOF thm AUTH_RA_ALLOC = +PROOF thm auth_ra_alloc = prove_auth_ra_alloc(); PROOF static thm prove_auth_ra_update_cancellative(void) { @@ -2395,7 +2395,7 @@ PROOF static thm prove_auth_ra_update_cancellative(void) { `a:A`, `b:A`, `frame:A`), - RA_LOCAL_UPDATE_CANCELLATIVE), + ra_local_update_cancellative), assume_rule(`ra_cancellative (R:(A)ra)`)), assume_rule(` ra_valid @@ -2410,13 +2410,13 @@ PROOF static thm prove_auth_ra_update_cancellative(void) { `a:A`, `ra_op (R:(A)ra) (b:A) (frame:A)`, `b:A`), - AUTH_RA_UPDATE_LOCAL), + auth_ra_update_local), local); ACCEPT_TAC(body, updated); return gnode_prove(root); } -PROOF thm AUTH_RA_UPDATE_CANCELLATIVE = +PROOF thm auth_ra_update_cancellative = prove_auth_ra_update_cancellative(); PROOF static int audit_auth_ra(void) { @@ -2427,69 +2427,69 @@ PROOF static int audit_auth_ra(void) { auth_auth_def, auth_frag_def, auth_both_def, - AUTH_RA_LAWS, + auth_ra_laws, auth_ra_def, - AUTH_RA_OP_FN, - AUTH_RA_VALID_FN, - AUTH_RA_OP_COMPONENTS, - AUTH_RA_VALID_COMPONENTS, - AUTH_RA_OP_AS_PRODUCT, - AUTH_RA_INCLUDED_AS_PRODUCT, - AUTH_RA_INCLUDED_COMPONENTS, - AUTH_RA_VALID_IMP_PRODUCT_VALID, - AUTH_RA_UNIT, - AUTH_RA_AUTH_FRAG, - AUTH_RA_FRAG_FRAG, - AUTH_RA_BOTH_FRAG, - AUTH_RA_BOTH_UNIT, - AUTH_EXCL_OWNED_INJ, - AUTH_RA_FRAG_INJ, - AUTH_RA_BOTH_INJ, - AUTH_RA_BOTH_NE_FRAG, - AUTH_RA_AUTH_INJ, - AUTH_RA_AUTH_NE_FRAG, - AUTH_RA_AUTH_EQ_BOTH, - AUTH_RA_VALID_FRAG, - AUTH_RA_VALID_BOTH, - AUTH_RA_VALID_BOTH_INTRO, - AUTH_RA_VALID_BOTH_ELIM_VALID, - AUTH_RA_VALID_BOTH_ELIM_INCLUDED, - AUTH_RA_VALID_AUTH, - AUTH_RA_VALID_AUTH_FRAG, - AUTH_RA_VALID_BOTH_FRAG, - AUTH_RA_AUTH_CONFLICT, - AUTH_RA_VALID_BOTH_FRAME_COMPONENTS, - AUTH_RA_VALID_BOTH_FRAME, - AUTH_RA_VALID_AUTH_FRAME, - AUTH_RA_BOTH_CONFLICT, - AUTH_RA_AUTH_BOTH_CONFLICT, - AUTH_EXCL_UNIT_INCLUDED, - AUTH_EXCL_OWNED_NOT_INCLUDED_UNIT, - AUTH_RA_INCLUDED_FRAG_FRAG, - AUTH_RA_INCLUDED_FRAG_AUTH, - AUTH_RA_INCLUDED_FRAG_BOTH, - AUTH_RA_INCLUDED_AUTH_FRAG, - AUTH_RA_INCLUDED_AUTH_AUTH, - AUTH_RA_INCLUDED_AUTH_BOTH, - AUTH_RA_INCLUDED_BOTH_FRAG, - AUTH_RA_INCLUDED_BOTH_AUTH, - AUTH_RA_INCLUDED_BOTH_BOTH, - AUTH_RA_CANCELLATIVE, - AUTH_RA_CANCELLATIVE_IFF, - AUTH_RA_UPDATE_FRAMEWISE, - AUTH_RA_UPDATE_FRAMEWISE_IFF, - AUTH_RA_UPDATE_LOCAL, - AUTH_RA_UPDATE_AUTH_IFF, - AUTH_RA_UPDATE_AUTH_INCLUDED, - AUTH_RA_UPDATE_DROP_LOCAL, - AUTH_RA_UPDATE_DROP_AUTH, - AUTH_RA_UPDATE_WEAKEN_FRAG, - AUTH_RA_FRAG_UPDATE_INCLUDED, - AUTH_RA_UPDATE_BOTH_INCLUDED, - AUTH_RA_UPDATE_ALLOC, - AUTH_RA_ALLOC_BOTH, - AUTH_RA_ALLOC, - AUTH_RA_UPDATE_CANCELLATIVE); + auth_ra_op_fn, + auth_ra_valid_fn, + auth_ra_op_components, + auth_ra_valid_components, + auth_ra_op_as_product, + auth_ra_included_as_product, + auth_ra_included_components, + auth_ra_valid_imp_product_valid, + auth_ra_unit, + auth_ra_auth_frag, + auth_ra_frag_frag, + auth_ra_both_frag, + auth_ra_both_unit, + auth_excl_owned_inj, + auth_ra_frag_inj, + auth_ra_both_inj, + auth_ra_both_ne_frag, + auth_ra_auth_inj, + auth_ra_auth_ne_frag, + auth_ra_auth_eq_both, + auth_ra_valid_frag, + auth_ra_valid_both, + auth_ra_valid_both_intro, + auth_ra_valid_both_elim_valid, + auth_ra_valid_both_elim_included, + auth_ra_valid_auth, + auth_ra_valid_auth_frag, + auth_ra_valid_both_frag, + auth_ra_auth_conflict, + auth_ra_valid_both_frame_components, + auth_ra_valid_both_frame, + auth_ra_valid_auth_frame, + auth_ra_both_conflict, + auth_ra_auth_both_conflict, + auth_excl_unit_included, + auth_excl_owned_not_included_unit, + auth_ra_included_frag_frag, + auth_ra_included_frag_auth, + auth_ra_included_frag_both, + auth_ra_included_auth_frag, + auth_ra_included_auth_auth, + auth_ra_included_auth_both, + auth_ra_included_both_frag, + auth_ra_included_both_auth, + auth_ra_included_both_both, + auth_ra_cancellative, + auth_ra_cancellative_iff, + auth_ra_update_framewise, + auth_ra_update_framewise_iff, + auth_ra_update_local, + auth_ra_update_auth_iff, + auth_ra_update_auth_included, + auth_ra_update_drop_local, + auth_ra_update_drop_auth, + auth_ra_update_weaken_frag, + auth_ra_frag_update_included, + auth_ra_update_both_included, + auth_ra_update_alloc, + auth_ra_alloc_both, + auth_ra_alloc, + auth_ra_update_cancellative); for (size_t i = 0; i < vector_size(implementation_theorems); ++i) { ENSURE_COND(!IS_NULL(implementation_theorems[i]), diff --git a/theory/logic/auth_ra.h b/theory/logic/auth_ra.h index 19a2886..6433f2b 100644 --- a/theory/logic/auth_ra.h +++ b/theory/logic/auth_ra.h @@ -1,37 +1,121 @@ #pragma once -/* Authoritative resource algebra over a base RA. */ +/* + * Public semantic interface for the authoritative RA over a base RA `R`. + * + * `auth_auth R a` owns authority only, `auth_frag f` owns a fragment only, + * and `auth_both a f` owns both. Authority is exclusive. A combined value is + * valid exactly when `a` is valid and the complete visible fragment is + * included in `a`. Raw constructor equations and datatype elimination stay + * in implementation-only headers. + */ #include "proof/theory/logic/excl_ra.h" #include "proof/theory/logic/local_update.h" -PROOF extern thm AUTH_RA_UNIT; -PROOF extern thm AUTH_RA_AUTH_FRAG; -PROOF extern thm AUTH_RA_FRAG_FRAG; -PROOF extern thm AUTH_RA_BOTH_FRAG; +/* ------------------------------------------------------------------------- */ +/* Unit and composition */ +/* ------------------------------------------------------------------------- */ -PROOF extern thm AUTH_RA_VALID_FRAG; -PROOF extern thm AUTH_RA_VALID_BOTH; -PROOF extern thm AUTH_RA_VALID_AUTH; -PROOF extern thm AUTH_RA_VALID_BOTH_FRAME; -PROOF extern thm AUTH_RA_AUTH_CONFLICT; +/* `ra_unit (auth_ra R) == auth_frag (ra_unit R)`. */ +PROOF extern thm auth_ra_unit; -PROOF extern thm AUTH_RA_INCLUDED_FRAG_FRAG; -PROOF extern thm AUTH_RA_INCLUDED_FRAG_BOTH; -PROOF extern thm AUTH_RA_INCLUDED_AUTH_AUTH; -PROOF extern thm AUTH_RA_INCLUDED_AUTH_BOTH; -PROOF extern thm AUTH_RA_INCLUDED_BOTH_BOTH; +/* Authority composed with a fragment yields a combined resource. */ +PROOF extern thm auth_ra_auth_frag; -PROOF extern thm AUTH_RA_CANCELLATIVE_IFF; +/* Fragment-only resources compose through the base RA. */ +PROOF extern thm auth_ra_frag_frag; -PROOF extern thm AUTH_RA_UPDATE_FRAMEWISE_IFF; +/* A combined resource absorbs an additional base fragment. */ +PROOF extern thm auth_ra_both_frag; -/* Base local updates lift to frame-preserving authoritative updates. */ -PROOF extern thm AUTH_RA_UPDATE_LOCAL; +/* ------------------------------------------------------------------------- */ +/* Validity and compatibility */ +/* ------------------------------------------------------------------------- */ -PROOF extern thm AUTH_RA_UPDATE_AUTH_IFF; -PROOF extern thm AUTH_RA_UPDATE_ALLOC; -PROOF extern thm AUTH_RA_UPDATE_DROP_LOCAL; -PROOF extern thm AUTH_RA_UPDATE_DROP_AUTH; -PROOF extern thm AUTH_RA_UPDATE_WEAKEN_FRAG; -PROOF extern thm AUTH_RA_ALLOC; +/* `ra_valid (auth_ra R) (auth_frag f) <=> ra_valid R f`. */ +PROOF extern thm auth_ra_valid_frag; + +/* + * `ra_valid (auth_ra R) (auth_both a f) <=> + * ra_valid R a && ra_included R f a`. + */ +PROOF extern thm auth_ra_valid_both; + +/* `ra_valid (auth_ra R) (auth_auth R a) <=> ra_valid R a`. */ +PROOF extern thm auth_ra_valid_auth; + +/* + * Characterize every valid hidden frame of `auth_both a f`: it must be an + * `auth_frag external`, and `ra_op R f external` must be included in `a`. + */ +PROOF extern thm auth_ra_valid_both_frame; + +/* Two authority-only resources are never compatible. */ +PROOF extern thm auth_ra_auth_conflict; + +/* ------------------------------------------------------------------------- */ +/* Inclusion */ +/* ------------------------------------------------------------------------- */ + +/* Fragment-to-fragment inclusion is exactly base inclusion. */ +PROOF extern thm auth_ra_included_frag_frag; + +/* A fragment is included in `auth_both a g` exactly when included in `g`. */ +PROOF extern thm auth_ra_included_frag_both; + +/* Authority-only inclusion requires equality of authoritative values. */ +PROOF extern thm auth_ra_included_auth_auth; + +/* Authority-only is included in a combined value exactly at equal authority. */ +PROOF extern thm auth_ra_included_auth_both; + +/* + * Combined inclusion preserves the authoritative value and uses base + * inclusion for the fragment coordinate. + */ +PROOF extern thm auth_ra_included_both_both; + +/* The authoritative construction preserves cancellativity exactly. */ +PROOF extern thm auth_ra_cancellative_iff; + +/* ------------------------------------------------------------------------- */ +/* Authoritative updates */ +/* ------------------------------------------------------------------------- */ + +/* + * Exact framewise characterization of + * `ra_update (auth_ra R) (auth_both a f) (auth_both b g)` over every external + * base fragment compatible with the source authority. + */ +PROOF extern thm auth_ra_update_framewise_iff; + +/* Lift a five-argument base local update to an authoritative update. */ +PROOF extern thm auth_ra_update_local; + +/* + * Authority-only update characterization: a valid source must lead to a valid + * target that includes the old authoritative value. + */ +PROOF extern thm auth_ra_update_auth_iff; + +/* + * Allocate a local fragment through a base local update from + * `(a,ra_unit R)` to `(b,g)`. + */ +PROOF extern thm auth_ra_update_alloc; + +/* Drop the local fragment from `auth_both a f`, retaining `auth_auth R a`. */ +PROOF extern thm auth_ra_update_drop_local; + +/* Drop authority from `auth_both a f`, retaining `auth_frag f`. */ +PROOF extern thm auth_ra_update_drop_auth; + +/* Keep authority fixed while weakening the local fragment to an included part. */ +PROOF extern thm auth_ra_update_weaken_frag; + +/* + * Extend authority by `piece` and simultaneously allocate that same piece as + * a local fragment, provided the extended authoritative value is valid. + */ +PROOF extern thm auth_ra_alloc; diff --git a/theory/logic/basic_update.c b/theory/logic/basic_update.c index a17f11c..2117662 100644 --- a/theory/logic/basic_update.c +++ b/theory/logic/basic_update.c @@ -53,7 +53,7 @@ PROOF static thm prove_r_bupd_intro(void) { return gnode_prove(root); } -PROOF thm R_BUPD_INTRO = +PROOF thm r_bupd_intro = prove_r_bupd_intro(); PROOF static thm prove_r_bupd_mono(void) { @@ -116,7 +116,7 @@ PROOF static thm prove_r_bupd_mono(void) { `R:(A)ra`, `selected:A`, `frame:A`), - RA_VALID_OP), + ra_valid_op), assume_rule(` ra_valid (R:(A)ra) @@ -148,7 +148,7 @@ PROOF static thm prove_r_bupd_mono(void) { return gnode_prove(root); } -PROOF thm R_BUPD_MONO = +PROOF thm r_bupd_mono = prove_r_bupd_mono(); PROOF static thm prove_r_bupd_idem(void) { @@ -226,7 +226,7 @@ PROOF static thm prove_r_bupd_idem(void) { return gnode_prove(root); } -PROOF thm R_BUPD_IDEM = +PROOF thm r_bupd_idem = prove_r_bupd_idem(); PROOF static thm prove_r_bupd_frame(void) { @@ -295,7 +295,7 @@ PROOF static thm prove_r_bupd_frame(void) { `updated:A`, `explicit_frame:A`, `hidden:A`), - RA_ASSOC); + ra_assoc); thm source_assoc_validity = ap_term_rule( `ra_valid (R:(A)ra):A->bool`, source_assoc); @@ -362,7 +362,7 @@ PROOF static thm prove_r_bupd_frame(void) { `selected:A`, `explicit_frame:A`, `hidden:A`), - RA_ASSOC); + ra_assoc); thm result_assoc_validity = ap_term_rule( `ra_valid (R:(A)ra):A->bool`, gsym_rule(result_assoc)); @@ -384,7 +384,7 @@ PROOF static thm prove_r_bupd_frame(void) { return gnode_prove(root); } -PROOF thm R_BUPD_FRAME = +PROOF thm r_bupd_frame = prove_r_bupd_frame(); PROOF static thm prove_r_viewshift_refl(void) { @@ -405,11 +405,11 @@ PROOF static thm prove_r_viewshift_refl(void) { TERM_LIST( `R:(A)ra`, `P:A->bool`), - R_BUPD_INTRO)); + r_bupd_intro)); return gnode_prove(root); } -PROOF thm R_VIEWSHIFT_REFL = +PROOF thm r_viewshift_refl = prove_r_viewshift_refl(); PROOF static thm prove_r_entails_to_viewshift(void) { @@ -434,7 +434,7 @@ PROOF static thm prove_r_entails_to_viewshift(void) { `P:A->bool`, `Q:A->bool`, `r_bupd (R:(A)ra) (Q:A->bool)`), - R_ENTAILS_TRANS), + r_entails_trans), assume_rule(` r_entails (R:(A)ra) (P:A->bool) (Q:A->bool) `)), @@ -442,12 +442,12 @@ PROOF static thm prove_r_entails_to_viewshift(void) { TERM_LIST( `R:(A)ra`, `Q:A->bool`), - R_BUPD_INTRO)); + r_bupd_intro)); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm R_ENTAILS_TO_VIEWSHIFT = +PROOF thm r_entails_to_viewshift = prove_r_entails_to_viewshift(); PROOF static thm prove_r_viewshift_trans(void) { @@ -473,7 +473,7 @@ PROOF static thm prove_r_viewshift_trans(void) { `R:(A)ra`, `Q:A->bool`, `r_bupd (R:(A)ra) (S:A->bool)`), - R_BUPD_MONO), + r_bupd_mono), assume_rule(` r_entails (R:(A)ra) @@ -488,13 +488,13 @@ PROOF static thm prove_r_viewshift_trans(void) { `r_bupd (R:(A)ra) (Q:A->bool)`, `r_bupd R (r_bupd R (S:A->bool))`, `r_bupd R (S:A->bool)`), - R_ENTAILS_TRANS), + r_entails_trans), lifted_second), ispecl_rule( TERM_LIST( `R:(A)ra`, `S:A->bool`), - R_BUPD_IDEM)); + r_bupd_idem)); thm result = mp_rule( mp_rule( ispecl_rule( @@ -503,7 +503,7 @@ PROOF static thm prove_r_viewshift_trans(void) { `P:A->bool`, `r_bupd R (Q:A->bool)`, `r_bupd R (S:A->bool)`), - R_ENTAILS_TRANS), + r_entails_trans), assume_rule(` r_entails (R:(A)ra) @@ -515,7 +515,7 @@ PROOF static thm prove_r_viewshift_trans(void) { return gnode_prove(root); } -PROOF thm R_VIEWSHIFT_TRANS = +PROOF thm r_viewshift_trans = prove_r_viewshift_trans(); PROOF static thm prove_r_viewshift_mono(void) { @@ -543,7 +543,7 @@ PROOF static thm prove_r_viewshift_mono(void) { `R:(A)ra`, `Q:A->bool`, `Q2:A->bool`), - R_BUPD_MONO), + r_bupd_mono), assume_rule(` r_entails (R:(A)ra) (Q:A->bool) (Q2:A->bool) `)); @@ -555,7 +555,7 @@ PROOF static thm prove_r_viewshift_mono(void) { `P:A->bool`, `r_bupd R (Q:A->bool)`, `r_bupd R (Q2:A->bool)`), - R_ENTAILS_TRANS), + r_entails_trans), assume_rule(` r_entails (R:(A)ra) @@ -571,7 +571,7 @@ PROOF static thm prove_r_viewshift_mono(void) { `P2:A->bool`, `P:A->bool`, `r_bupd R (Q2:A->bool)`), - R_ENTAILS_TRANS), + r_entails_trans), assume_rule(` r_entails (R:(A)ra) (P2:A->bool) (P:A->bool) `)), @@ -580,7 +580,7 @@ PROOF static thm prove_r_viewshift_mono(void) { return gnode_prove(root); } -PROOF thm R_VIEWSHIFT_MONO = +PROOF thm r_viewshift_mono = prove_r_viewshift_mono(); PROOF static thm prove_r_viewshift_frame(void) { @@ -609,7 +609,7 @@ PROOF static thm prove_r_viewshift_frame(void) { `P:A->bool`, `r_bupd R (Q:A->bool)`, `frame_pred:A->bool`), - R_SEP_FRAME_L), + r_sep_frame_l), assume_rule(` r_entails (R:(A)ra) @@ -635,19 +635,19 @@ PROOF static thm prove_r_viewshift_frame(void) { R (Q:A->bool) (frame_pred:A->bool))`), - R_ENTAILS_TRANS), + r_entails_trans), explicit_frame), ispecl_rule( TERM_LIST( `R:(A)ra`, `Q:A->bool`, `frame_pred:A->bool`), - R_BUPD_FRAME)); + r_bupd_frame)); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm R_VIEWSHIFT_FRAME = +PROOF thm r_viewshift_frame = prove_r_viewshift_frame(); PROOF static thm prove_r_viewshift_sep(void) { @@ -681,7 +681,7 @@ PROOF static thm prove_r_viewshift_sep(void) { `P1:A->bool`, `Q1:A->bool`, `P2:A->bool`), - R_VIEWSHIFT_FRAME), + r_viewshift_frame), assume_rule(` r_viewshift (R:(A)ra) (P1:A->bool) (Q1:A->bool) `)); @@ -692,7 +692,7 @@ PROOF static thm prove_r_viewshift_sep(void) { `P2:A->bool`, `Q2:A->bool`, `Q1:A->bool`), - R_VIEWSHIFT_FRAME), + r_viewshift_frame), assume_rule(` r_viewshift (R:(A)ra) (P2:A->bool) (Q2:A->bool) `)); @@ -704,7 +704,7 @@ PROOF static thm prove_r_viewshift_sep(void) { `R:(A)ra`, `Q1:A->bool`, `P2:A->bool`), - R_SEP_COMM)); + r_sep_comm)); thm target_commute = rewrite_rule( THM_LIST(r_equiv_def), @@ -713,7 +713,7 @@ PROOF static thm prove_r_viewshift_sep(void) { `R:(A)ra`, `Q2:A->bool`, `Q1:A->bool`), - R_SEP_COMM)); + r_sep_comm)); thm second_aligned = mp_rule( mp_rule( mp_rule( @@ -724,7 +724,7 @@ PROOF static thm prove_r_viewshift_sep(void) { `r_sep R (P2:A->bool) (Q1:A->bool)`, `r_sep R (Q2:A->bool) (Q1:A->bool)`, `r_sep R (Q1:A->bool) (Q2:A->bool)`), - R_VIEWSHIFT_MONO), + r_viewshift_mono), conjunct1_rule(source_commute)), second_framed), conjunct1_rule(target_commute)); @@ -737,14 +737,14 @@ PROOF static thm prove_r_viewshift_sep(void) { `r_sep R (P1:A->bool) (P2:A->bool)`, `r_sep R (Q1:A->bool) (P2:A->bool)`, `r_sep R (Q1:A->bool) (Q2:A->bool)`), - R_VIEWSHIFT_TRANS), + r_viewshift_trans), first_framed), second_aligned); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm R_VIEWSHIFT_SEP = +PROOF thm r_viewshift_sep = prove_r_viewshift_sep(); PROOF static thm prove_r_viewshift_exists_l(void) { @@ -768,7 +768,7 @@ PROOF static thm prove_r_viewshift_exists_l(void) { `R:(A)ra`, `P:B->A->bool`, `r_bupd R (Q:A->bool)`), - R_EXISTS_ELIM), + r_exists_elim), assume_rule(` forall witness:B. r_entails @@ -780,7 +780,7 @@ PROOF static thm prove_r_viewshift_exists_l(void) { return gnode_prove(root); } -PROOF thm R_VIEWSHIFT_EXISTS_L = +PROOF thm r_viewshift_exists_l = prove_r_viewshift_exists_l(); PROOF static thm prove_r_viewshift_exists_r(void) { @@ -804,14 +804,14 @@ PROOF static thm prove_r_viewshift_exists_r(void) { `R:(A)ra`, `Q:B->A->bool`, `witness:B`), - R_EXISTS_INTRO); + r_exists_intro); thm lifted_post = mp_rule( ispecl_rule( TERM_LIST( `R:(A)ra`, `(Q:B->A->bool) (witness:B)`, `r_exists R (\bound:B. (Q:B->A->bool) bound)`), - R_BUPD_MONO), + r_bupd_mono), post_inclusion); thm result = mp_rule( mp_rule( @@ -822,7 +822,7 @@ PROOF static thm prove_r_viewshift_exists_r(void) { `r_bupd R ((Q:B->A->bool) (witness:B))`, `r_bupd R (r_exists R (\bound:B. (Q:B->A->bool) bound))`), - R_ENTAILS_TRANS), + r_entails_trans), assume_rule(` r_entails (R:(A)ra) @@ -836,7 +836,7 @@ PROOF static thm prove_r_viewshift_exists_r(void) { return gnode_prove(root); } -PROOF thm R_VIEWSHIFT_EXISTS_R = +PROOF thm r_viewshift_exists_r = prove_r_viewshift_exists_r(); PROOF static thm prove_r_viewshift_exists(void) { @@ -864,7 +864,7 @@ PROOF static thm prove_r_viewshift_exists(void) { `R:(A)ra`, `P:B->A->bool`, `r_exists R (\bound:B. (Q:B->A->bool) bound)`), - R_VIEWSHIFT_EXISTS_L)); + r_viewshift_exists_l)); body = GEN_TAC(body, "witness"); thm selected = spec_rule( `witness:B`, @@ -882,13 +882,13 @@ PROOF static thm prove_r_viewshift_exists(void) { `(P:B->A->bool) (witness:B)`, `Q:B->A->bool`, `witness:B`), - R_VIEWSHIFT_EXISTS_R), + r_viewshift_exists_r), selected); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm R_VIEWSHIFT_EXISTS = +PROOF thm r_viewshift_exists = prove_r_viewshift_exists(); PROOF static thm prove_r_own_update(void) { @@ -957,10 +957,10 @@ PROOF static thm prove_r_own_update(void) { return gnode_prove(root); } -PROOF thm R_OWN_UPDATE = +PROOF thm r_own_update = prove_r_own_update(); -PROOF static thm prove_r_own_updatep(void) { +PROOF static thm prove_r_own_updateP(void) { term goal_tm = ` forall (R:(A)ra) @@ -1054,7 +1054,7 @@ PROOF static thm prove_r_own_updatep(void) { post_split[0], gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `selected:A`), - RA_UNIT_L))); + ra_unit_l))); gnode_list post_preds = CONJ_TAC(post_split[1]); gnode_list post_fact = CONJ_TAC(post_preds[0]); ACCEPT_TAC( @@ -1076,28 +1076,28 @@ PROOF static thm prove_r_own_updatep(void) { return gnode_prove(root); } -PROOF thm R_OWN_UPDATEP = - prove_r_own_updatep(); +PROOF thm r_own_updateP = + prove_r_own_updateP(); PROOF static int audit_basic_update(void) { thm_list public_theorems = THM_LIST( r_bupd_def, r_viewshift_def, - R_BUPD_INTRO, - R_BUPD_MONO, - R_BUPD_IDEM, - R_BUPD_FRAME, - R_VIEWSHIFT_REFL, - R_ENTAILS_TO_VIEWSHIFT, - R_VIEWSHIFT_TRANS, - R_VIEWSHIFT_MONO, - R_VIEWSHIFT_FRAME, - R_VIEWSHIFT_SEP, - R_VIEWSHIFT_EXISTS_L, - R_VIEWSHIFT_EXISTS_R, - R_VIEWSHIFT_EXISTS, - R_OWN_UPDATE, - R_OWN_UPDATEP); + r_bupd_intro, + r_bupd_mono, + r_bupd_idem, + r_bupd_frame, + r_viewshift_refl, + r_entails_to_viewshift, + r_viewshift_trans, + r_viewshift_mono, + r_viewshift_frame, + r_viewshift_sep, + r_viewshift_exists_l, + r_viewshift_exists_r, + r_viewshift_exists, + r_own_update, + r_own_updateP); for (size_t i = 0; i < vector_size(public_theorems); ++i) { ENSURE_COND( diff --git a/theory/logic/basic_update.h b/theory/logic/basic_update.h index 2e66645..bdd6756 100644 --- a/theory/logic/basic_update.h +++ b/theory/logic/basic_update.h @@ -1,30 +1,41 @@ -#pragma once +/** + * @file basic_update.h + * @brief Generic frame-preserving updates for one complete RA. + * + * `r_bupd R` is interpreted directly by primitive predicate update + * `ra_updateP R`; consequently it may change any part of the resource owned by + * `R`. It is appropriate for an algebraic or ghost-only logic. A program + * logic whose resource contains physical state must instead use a restricted + * modality such as the right-only product update in `product_resource.h`. + */ -/* Generic algebraic basic updates. This modality may update the complete RA; - * product-restricted clients must use product_resource.h instead. */ +#pragma once #include "proof/theory/logic/resource_prop.h" -/* `r_bupd R Q owned <=> ra_updateP R owned Q`. */ +/** `r_bupd R Q owned <=> ra_updateP R owned Q`. */ PROOF extern thm r_bupd_def; -/* `r_viewshift R P Q <=> r_entails R P (r_bupd R Q)`. */ +/** `r_viewshift R P Q <=> r_entails R P (r_bupd R Q)`. */ PROOF extern thm r_viewshift_def; -PROOF extern thm R_BUPD_INTRO; -PROOF extern thm R_BUPD_MONO; -PROOF extern thm R_BUPD_IDEM; -PROOF extern thm R_BUPD_FRAME; - -PROOF extern thm R_VIEWSHIFT_REFL; -PROOF extern thm R_ENTAILS_TO_VIEWSHIFT; -PROOF extern thm R_VIEWSHIFT_TRANS; -PROOF extern thm R_VIEWSHIFT_MONO; -PROOF extern thm R_VIEWSHIFT_FRAME; -PROOF extern thm R_VIEWSHIFT_SEP; -PROOF extern thm R_VIEWSHIFT_EXISTS; - -PROOF extern thm R_OWN_UPDATE; - -/* Predicate update exposes a witness, an exact-unit fact, and exact ownership. */ -PROOF extern thm R_OWN_UPDATEP; +/* Basic-update modality laws. */ +PROOF extern thm r_bupd_intro; +PROOF extern thm r_bupd_mono; +PROOF extern thm r_bupd_idem; +PROOF extern thm r_bupd_frame; + +/* View-shift consequence, composition, framing, and logical lifting. */ +PROOF extern thm r_viewshift_refl; +PROOF extern thm r_entails_to_viewshift; +PROOF extern thm r_viewshift_trans; +PROOF extern thm r_viewshift_mono; +PROOF extern thm r_viewshift_frame; +PROOF extern thm r_viewshift_sep; +PROOF extern thm r_viewshift_exists; + +/* Ownership rules induced by deterministic and predicate RA updates. */ +PROOF extern thm r_own_update; + +/* The predicate rule returns a witness, an exact-unit `r_fact`, and ownership. */ +PROOF extern thm r_own_updateP; diff --git a/theory/logic/big_sep.c b/theory/logic/big_sep.c index 9cc21c1..dec37ac 100644 --- a/theory/logic/big_sep.c +++ b/theory/logic/big_sep.c @@ -39,11 +39,11 @@ PROOF static thm prove_r_equiv_of_eq(void) { lifted, ispecl_rule( TERM_LIST(`R:(A)ra`, `P:A->bool`), - R_EQUIV_REFL))); + r_equiv_refl))); return gnode_prove(root); } -PROOF static thm R_EQUIV_OF_EQ_BIG_SEP = +PROOF static thm r_equiv_of_eq_big_sep = prove_r_equiv_of_eq(); PROOF static thm prove_r_sep_ac(void) { @@ -53,10 +53,10 @@ PROOF static thm prove_r_sep_ac(void) { term S = `S:A->bool`; thm commute = ispecl_rule( TERM_LIST(R, P, Q), - R_SEP_COMM_EQ); + r_sep_comm_eq); thm associate = ispecl_rule( TERM_LIST(R, P, Q, S), - R_SEP_ASSOC_EQ); + r_sep_assoc_eq); thm expose_pair = gsym_rule(associate); thm swap_pair = beta_rule(ap_term_rule( `\pair:A->bool. @@ -64,7 +64,7 @@ PROOF static thm prove_r_sep_ac(void) { commute)); thm regroup = ispecl_rule( TERM_LIST(R, Q, P, S), - R_SEP_ASSOC_EQ); + r_sep_assoc_eq); thm left_commute = trans_rule( expose_pair, trans_rule(swap_pair, regroup)); @@ -73,7 +73,7 @@ PROOF static thm prove_r_sep_ac(void) { conj_rule(associate, left_commute)); } -PROOF static thm R_SEP_AC = +PROOF static thm r_sep_ac = prove_r_sep_ac(); PROOF thm r_big_sep_list_def = new_rec_definition( @@ -102,7 +102,7 @@ PROOF static thm prove_r_big_sep_list_nil_eq(void) { return gnode_prove(root); } -PROOF static thm R_BIG_SEP_LIST_NIL_EQ = +PROOF static thm r_big_sep_list_nil_eq = prove_r_big_sep_list_nil_eq(); PROOF static thm prove_r_big_sep_list_cons_eq(void) { @@ -119,7 +119,7 @@ PROOF static thm prove_r_big_sep_list_cons_eq(void) { return gnode_prove(root); } -PROOF static thm R_BIG_SEP_LIST_CONS_EQ = +PROOF static thm r_big_sep_list_cons_eq = prove_r_big_sep_list_cons_eq(); PROOF static thm prove_r_big_sep_list_singleton_eq(void) { @@ -130,13 +130,13 @@ PROOF static thm prove_r_big_sep_list_singleton_eq(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - R_BIG_SEP_LIST_CONS_EQ, - R_BIG_SEP_LIST_NIL_EQ, - R_SEP_EMP_R_EQ))); + r_big_sep_list_cons_eq, + r_big_sep_list_nil_eq, + r_sep_emp_r_eq))); return gnode_prove(root); } -PROOF static thm R_BIG_SEP_LIST_SINGLETON_EQ = +PROOF static thm r_big_sep_list_singleton_eq = prove_r_big_sep_list_singleton_eq(); PROOF static thm prove_r_big_sep_list_append_eq(void) { @@ -162,8 +162,8 @@ PROOF static thm prove_r_big_sep_list_append_eq(void) { base, pure_rewrite_conv(THM_LIST( HOL_APPEND, - R_BIG_SEP_LIST_NIL_EQ, - R_SEP_EMP_L_EQ))); + r_big_sep_list_nil_eq, + r_sep_emp_l_eq))); RULE_TAC(base, prove_reflexive_equality_goal); gnode step = AUTO_INTROS_TAC(cases[1]); @@ -172,13 +172,13 @@ PROOF static thm prove_r_big_sep_list_append_eq(void) { pure_rewrite_conv, THM_LIST( HOL_APPEND, - R_BIG_SEP_LIST_CONS_EQ, - R_SEP_ASSOC_EQ)); + r_big_sep_list_cons_eq, + r_sep_assoc_eq)); RULE_TAC(step, prove_reflexive_equality_goal); return gnode_prove(root); } -PROOF static thm R_BIG_SEP_LIST_APPEND_EQ = +PROOF static thm r_big_sep_list_append_eq = prove_r_big_sep_list_append_eq(); PROOF static thm prove_r_big_sep_list_map_eq(void) { @@ -200,13 +200,13 @@ PROOF static thm prove_r_big_sep_list_map_eq(void) { cases[0], rewrite_conv(THM_LIST( get_theorem_by_name("MAP"), - R_BIG_SEP_LIST_NIL_EQ))); + r_big_sep_list_nil_eq))); gnode step = CONV_WITH_ASMP_TAC( cases[1], pure_rewrite_conv, THM_LIST( get_theorem_by_name("MAP"), - R_BIG_SEP_LIST_CONS_EQ)); + r_big_sep_list_cons_eq)); step = CONV_TAC( step, depth_conv(get_conversion_by_name("BETA_CONV"))); @@ -214,7 +214,7 @@ PROOF static thm prove_r_big_sep_list_map_eq(void) { return gnode_prove(root); } -PROOF static thm R_BIG_SEP_LIST_MAP_EQ = +PROOF static thm r_big_sep_list_map_eq = prove_r_big_sep_list_map_eq(); PROOF static thm prove_r_big_sep_list_sep_eq(void) { @@ -241,22 +241,22 @@ PROOF static thm prove_r_big_sep_list_sep_eq(void) { CONV_TAC( cases[0], rewrite_conv(THM_LIST( - R_BIG_SEP_LIST_NIL_EQ, - R_SEP_EMP_L_EQ))); + r_big_sep_list_nil_eq, + r_sep_emp_l_eq))); gnode step = CONV_WITH_ASMP_TAC( cases[1], pure_rewrite_conv, - THM_LIST(R_BIG_SEP_LIST_CONS_EQ)); + THM_LIST(r_big_sep_list_cons_eq)); step = CONV_TAC( step, depth_conv(get_conversion_by_name("BETA_CONV"))); ACCEPT_TAC( step, - ac_rule(R_SEP_AC, goal_ccl(step->g))); + ac_rule(r_sep_ac, goal_ccl(step->g))); return gnode_prove(root); } -PROOF static thm R_BIG_SEP_LIST_SEP_EQ = +PROOF static thm r_big_sep_list_sep_eq = prove_r_big_sep_list_sep_eq(); PROOF static thm prove_r_big_sep_list_nil(void) { @@ -276,14 +276,14 @@ PROOF static thm prove_r_big_sep_list_nil(void) { (Phi:B->A->bool) ([]:(B)list)`, `r_emp (R:(A)ra)`), - R_EQUIV_OF_EQ_BIG_SEP), + r_equiv_of_eq_big_sep), ispecl_rule( TERM_LIST(`R:(A)ra`, `Phi:B->A->bool`), - R_BIG_SEP_LIST_NIL_EQ))); + r_big_sep_list_nil_eq))); return gnode_prove(root); } -PROOF thm R_BIG_SEP_LIST_NIL = +PROOF thm r_big_sep_list_nil = prove_r_big_sep_list_nil(); PROOF static thm prove_r_big_sep_list_cons(void) { @@ -312,18 +312,18 @@ PROOF static thm prove_r_big_sep_list_cons(void) { `r_sep (R:(A)ra) ((Phi:B->A->bool) (x:B)) (r_big_sep_list R Phi (xs:(B)list))`), - R_EQUIV_OF_EQ_BIG_SEP), + r_equiv_of_eq_big_sep), ispecl_rule( TERM_LIST( `R:(A)ra`, `Phi:B->A->bool`, `x:B`, `xs:(B)list`), - R_BIG_SEP_LIST_CONS_EQ))); + r_big_sep_list_cons_eq))); return gnode_prove(root); } -PROOF thm R_BIG_SEP_LIST_CONS = +PROOF thm r_big_sep_list_cons = prove_r_big_sep_list_cons(); PROOF static thm prove_r_big_sep_list_singleton(void) { @@ -343,14 +343,14 @@ PROOF static thm prove_r_big_sep_list_singleton(void) { (Phi:B->A->bool) ((x:B) :: [])`, `(Phi:B->A->bool) (x:B)`), - R_EQUIV_OF_EQ_BIG_SEP), + r_equiv_of_eq_big_sep), ispecl_rule( TERM_LIST(`R:(A)ra`, `Phi:B->A->bool`, `x:B`), - R_BIG_SEP_LIST_SINGLETON_EQ))); + r_big_sep_list_singleton_eq))); return gnode_prove(root); } -PROOF thm R_BIG_SEP_LIST_SINGLETON = +PROOF thm r_big_sep_list_singleton = prove_r_big_sep_list_singleton(); PROOF static thm prove_r_big_sep_list_append(void) { @@ -381,18 +381,18 @@ PROOF static thm prove_r_big_sep_list_append(void) { `r_sep (R:(A)ra) (r_big_sep_list R Phi (left:(B)list)) (r_big_sep_list R Phi (right:(B)list))`), - R_EQUIV_OF_EQ_BIG_SEP), + r_equiv_of_eq_big_sep), ispecl_rule( TERM_LIST( `R:(A)ra`, `Phi:B->A->bool`, `left:(B)list`, `right:(B)list`), - R_BIG_SEP_LIST_APPEND_EQ))); + r_big_sep_list_append_eq))); return gnode_prove(root); } -PROOF thm R_BIG_SEP_LIST_APPEND = +PROOF thm r_big_sep_list_append = prove_r_big_sep_list_append(); PROOF static thm prove_r_big_sep_list_mono(void) { @@ -419,17 +419,17 @@ PROOF static thm prove_r_big_sep_list_mono(void) { gnode base = DISCH_TAC(cases[0], "Hpointwise"); base = CONV_TAC( base, - pure_rewrite_conv(THM_LIST(R_BIG_SEP_LIST_NIL_EQ))); + pure_rewrite_conv(THM_LIST(r_big_sep_list_nil_eq))); ACCEPT_TAC( base, ispecl_rule( TERM_LIST(`R:(A)ra`, `r_emp (R:(A)ra)`), - R_ENTAILS_REFL)); + r_entails_refl)); gnode step = DISCH_TAC(cases[1], "Hpointwise"); step = CONV_TAC( step, - pure_rewrite_conv(THM_LIST(R_BIG_SEP_LIST_CONS_EQ))); + pure_rewrite_conv(THM_LIST(r_big_sep_list_cons_eq))); thm pointwise = assume_rule(` forall x:B. MEM x ((a0:B) :: (a1:(B)list)) ==> @@ -494,14 +494,14 @@ PROOF static thm prove_r_big_sep_list_mono(void) { (R:(A)ra) (Psi:B->A->bool) (a1:(B)list)`), - R_SEP_MONO), + r_sep_mono), head_entails), tail_entails); ACCEPT_TAC(step, result); return gnode_prove(root); } -PROOF thm R_BIG_SEP_LIST_MONO = +PROOF thm r_big_sep_list_mono = prove_r_big_sep_list_mono(); PROOF static thm prove_r_big_sep_list_equiv(void) { @@ -550,7 +550,7 @@ PROOF static thm prove_r_big_sep_list_equiv(void) { `Phi:B->A->bool`, `Psi:B->A->bool`, `xs:(B)list`), - R_BIG_SEP_LIST_MONO), + r_big_sep_list_mono), forward_pointwise); thm reverse = mp_rule( ispecl_rule( @@ -559,7 +559,7 @@ PROOF static thm prove_r_big_sep_list_equiv(void) { `Psi:B->A->bool`, `Phi:B->A->bool`, `xs:(B)list`), - R_BIG_SEP_LIST_MONO), + r_big_sep_list_mono), reverse_pointwise); ACCEPT_TAC( body, @@ -576,13 +576,13 @@ PROOF static thm prove_r_big_sep_list_equiv(void) { (R:(A)ra) (Psi:B->A->bool) (xs:(B)list)`), - R_EQUIV_INTRO), + r_equiv_intro), forward), reverse)); return gnode_prove(root); } -PROOF thm R_BIG_SEP_LIST_EQUIV = +PROOF thm r_big_sep_list_equiv = prove_r_big_sep_list_equiv(); PROOF static thm prove_r_big_sep_list_map(void) { @@ -609,18 +609,18 @@ PROOF static thm prove_r_big_sep_list_map(void) { `r_big_sep_list R (\x:C. (Phi:B->A->bool) ((f:C->B) x)) (xs:(C)list)`), - R_EQUIV_OF_EQ_BIG_SEP), + r_equiv_of_eq_big_sep), ispecl_rule( TERM_LIST( `R:(A)ra`, `Phi:B->A->bool`, `f:C->B`, `xs:(C)list`), - R_BIG_SEP_LIST_MAP_EQ))); + r_big_sep_list_map_eq))); return gnode_prove(root); } -PROOF thm R_BIG_SEP_LIST_MAP = +PROOF thm r_big_sep_list_map = prove_r_big_sep_list_map(); PROOF static thm prove_r_big_sep_list_sep(void) { @@ -657,31 +657,31 @@ PROOF static thm prove_r_big_sep_list_sep(void) { `r_sep (R:(A)ra) (r_big_sep_list R Phi (xs:(B)list)) (r_big_sep_list R Psi (xs:(B)list))`), - R_EQUIV_OF_EQ_BIG_SEP), + r_equiv_of_eq_big_sep), ispecl_rule( TERM_LIST( `R:(A)ra`, `Phi:B->A->bool`, `Psi:B->A->bool`, `xs:(B)list`), - R_BIG_SEP_LIST_SEP_EQ))); + r_big_sep_list_sep_eq))); return gnode_prove(root); } -PROOF thm R_BIG_SEP_LIST_SEP = +PROOF thm r_big_sep_list_sep = prove_r_big_sep_list_sep(); PROOF static int audit_big_sep(void) { thm_list public_theorems = THM_LIST( r_big_sep_list_def, - R_BIG_SEP_LIST_NIL, - R_BIG_SEP_LIST_CONS, - R_BIG_SEP_LIST_SINGLETON, - R_BIG_SEP_LIST_APPEND, - R_BIG_SEP_LIST_MONO, - R_BIG_SEP_LIST_EQUIV, - R_BIG_SEP_LIST_MAP, - R_BIG_SEP_LIST_SEP); + r_big_sep_list_nil, + r_big_sep_list_cons, + r_big_sep_list_singleton, + r_big_sep_list_append, + r_big_sep_list_mono, + r_big_sep_list_equiv, + r_big_sep_list_map, + r_big_sep_list_sep); for (size_t i = 0; i < vector_size(public_theorems); ++i) { ENSURE_COND( !IS_NULL(public_theorems[i]), diff --git a/theory/logic/big_sep.h b/theory/logic/big_sep.h index f12828b..d12545d 100644 --- a/theory/logic/big_sep.h +++ b/theory/logic/big_sep.h @@ -1,27 +1,39 @@ -#pragma once +/** + * @file big_sep.h + * @brief List-indexed iterated separating conjunction. + * + * The module and file intentionally contain both the right-fold definition + * and its useful list laws; `big_sep` is not split into core/extras modules. + * The container surface is nevertheless list-only. In particular, + * `r_big_sep_list_map` is a naturality law for the ordinary list `MAP` + * operation, not a finite-map big-separation binder. + * + * The recursive definition has raw computation equations. Every exported + * assertion-algebra normalization below is stated with `r_equiv`; its raw + * equality proof remains private to `big_sep.c`. + */ -/* Core iterated separating conjunction. The stable API is intentionally - * list-only; set/map/indexed variants are not part of this module's public - * surface. */ +#pragma once #include "proof/theory/data/list.h" #include "proof/theory/logic/resource_prop.h" -/* Direct right fold: - * r_big_sep_list R Phi [] = r_emp R - * r_big_sep_list R Phi (x::xs) = +/** Direct right fold: + * r_big_sep_list R Phi [] == r_emp R + * r_big_sep_list R Phi (x::xs) == * r_sep R (Phi x) (r_big_sep_list R Phi xs). */ PROOF extern thm r_big_sep_list_def; -/* All assertion-algebra equations are exposed as `r_equiv`. */ -PROOF extern thm R_BIG_SEP_LIST_NIL; -PROOF extern thm R_BIG_SEP_LIST_CONS; -PROOF extern thm R_BIG_SEP_LIST_SINGLETON; -PROOF extern thm R_BIG_SEP_LIST_APPEND; +/* Fold computation and append laws, exposed as `r_equiv`. */ +PROOF extern thm r_big_sep_list_nil; +PROOF extern thm r_big_sep_list_cons; +PROOF extern thm r_big_sep_list_singleton; +PROOF extern thm r_big_sep_list_append; -/* Member-restricted logical lifting. */ -PROOF extern thm R_BIG_SEP_LIST_MONO; -PROOF extern thm R_BIG_SEP_LIST_EQUIV; +/* Member-restricted pointwise entailment and equivalence lifting. */ +PROOF extern thm r_big_sep_list_mono; +PROOF extern thm r_big_sep_list_equiv; -PROOF extern thm R_BIG_SEP_LIST_MAP; -PROOF extern thm R_BIG_SEP_LIST_SEP; +/* List MAP naturality and pointwise separation. */ +PROOF extern thm r_big_sep_list_map; +PROOF extern thm r_big_sep_list_sep; diff --git a/theory/logic/excl_ra.c b/theory/logic/excl_ra.c index 77c70ac..2a34527 100644 --- a/theory/logic/excl_ra.c +++ b/theory/logic/excl_ra.c @@ -71,7 +71,7 @@ PROOF static thm prove_excl_owned_ne_unit(void) { return gnode_prove(root); } -PROOF thm EXCL_OWNED_NE_UNIT = +PROOF thm excl_owned_ne_unit = prove_excl_owned_ne_unit(); PROOF static thm prove_excl_invalid_ne_unit(void) { @@ -90,7 +90,7 @@ PROOF static thm prove_excl_invalid_ne_unit(void) { return gnode_prove(root); } -PROOF thm EXCL_INVALID_NE_UNIT = +PROOF thm excl_invalid_ne_unit = prove_excl_invalid_ne_unit(); /* Internal constructor discriminator used to derive injectivity and the @@ -128,14 +128,14 @@ PROOF static thm prove_excl_owned_injective(void) { ap_term_rule(`Excl:A->(A)excl`, assume_rule(`(a:A) == (b:A)`))); thm proved = gnode_prove(root); ENSURE_COND(equals_term(concl(proved), goal_tm), - "EXCL_RA_OWNED_INJ has the wrong conclusion"); + "excl_ra_owned_inj has the wrong conclusion"); return proved; err: ERR_FUN_PUTS("prove_excl_owned_injective"); return empty_theorem; } -PROOF thm EXCL_RA_OWNED_INJ = +PROOF thm excl_ra_owned_inj = prove_excl_owned_injective(); PROOF static thm prove_excl_invalid_ne_owned(void) { @@ -154,36 +154,36 @@ PROOF static thm prove_excl_invalid_ne_owned(void) { CONTR_TAC(body, contradiction); thm proved = gnode_prove(root); ENSURE_COND(equals_term(concl(proved), goal_tm), - "EXCL_INVALID_NE_OWNED has the wrong conclusion"); + "excl_invalid_ne_owned has the wrong conclusion"); return proved; err: ERR_FUN_PUTS("prove_excl_invalid_ne_owned"); return empty_theorem; } -PROOF static thm EXCL_INVALID_NE_OWNED = +PROOF static thm excl_invalid_ne_owned = prove_excl_invalid_ne_owned(); /* Public constructor facts preserve the smaller internal ABI used by auth. */ PROOF static thm expose_excl_owned_ne_unit(void) { - return EXCL_OWNED_NE_UNIT; + return excl_owned_ne_unit; } -PROOF thm EXCL_RA_OWNED_NE_UNIT = +PROOF thm excl_ra_owned_ne_unit = expose_excl_owned_ne_unit(); PROOF static thm expose_excl_invalid_ne_unit(void) { - return EXCL_INVALID_NE_UNIT; + return excl_invalid_ne_unit; } -PROOF thm EXCL_RA_INVALID_NE_UNIT = +PROOF thm excl_ra_invalid_ne_unit = expose_excl_invalid_ne_unit(); PROOF static thm expose_excl_invalid_ne_owned(void) { - return EXCL_INVALID_NE_OWNED; + return excl_invalid_ne_owned; } -PROOF thm EXCL_RA_INVALID_NE_OWNED = +PROOF thm excl_ra_invalid_ne_owned = expose_excl_invalid_ne_owned(); PROOF static conv excl_reduce_conv(void) { @@ -287,7 +287,7 @@ PROOF static thm prove_excl_ra_laws(void) { return gnode_prove(root); } -PROOF static thm EXCL_RA_LAWS = prove_excl_ra_laws(); +PROOF static thm excl_ra_laws = prove_excl_ra_laws(); PROOF static thm excl_ra_def = new_fun_definition(` excl_ra : ((A)excl)ra = @@ -302,14 +302,14 @@ PROOF static thm prove_excl_ra_unit(void) { `ExclUnit:(A)excl`, `excl_op:(A)excl->(A)excl->(A)excl`, `excl_valid:(A)excl->bool`), - RA_UNIT_ABS), - EXCL_RA_LAWS); + ra_unit_abs), + excl_ra_laws); return pure_once_rewrite_rule( THM_LIST(gsym_rule(excl_ra_def)), computed); } -PROOF thm EXCL_RA_UNIT = prove_excl_ra_unit(); +PROOF thm excl_ra_unit = prove_excl_ra_unit(); PROOF static thm prove_excl_ra_op_fn(void) { thm computed = mp_rule( @@ -318,14 +318,14 @@ PROOF static thm prove_excl_ra_op_fn(void) { `ExclUnit:(A)excl`, `excl_op:(A)excl->(A)excl->(A)excl`, `excl_valid:(A)excl->bool`), - RA_OP_ABS), - EXCL_RA_LAWS); + ra_op_abs), + excl_ra_laws); return pure_once_rewrite_rule( THM_LIST(gsym_rule(excl_ra_def)), computed); } -PROOF thm EXCL_RA_OP_FN = prove_excl_ra_op_fn(); +PROOF thm excl_ra_op_fn = prove_excl_ra_op_fn(); PROOF static thm prove_excl_ra_valid_fn(void) { thm computed = mp_rule( @@ -334,14 +334,14 @@ PROOF static thm prove_excl_ra_valid_fn(void) { `ExclUnit:(A)excl`, `excl_op:(A)excl->(A)excl->(A)excl`, `excl_valid:(A)excl->bool`), - RA_VALID_ABS), - EXCL_RA_LAWS); + ra_valid_abs), + excl_ra_laws); return pure_once_rewrite_rule( THM_LIST(gsym_rule(excl_ra_def)), computed); } -PROOF static thm EXCL_RA_VALID_FN = prove_excl_ra_valid_fn(); +PROOF static thm excl_ra_valid_fn = prove_excl_ra_valid_fn(); PROOF static thm prove_excl_ra_owned_conflict(void) { term goal_tm = ` @@ -353,13 +353,13 @@ PROOF static thm prove_excl_ra_owned_conflict(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - EXCL_RA_OP_FN, + excl_ra_op_fn, excl_op_def, excl_owned_op_def))); return gnode_prove(root); } -PROOF thm EXCL_RA_OWNED_CONFLICT = prove_excl_ra_owned_conflict(); +PROOF thm excl_ra_owned_conflict = prove_excl_ra_owned_conflict(); PROOF static thm prove_excl_ra_valid_unit(void) { term goal_tm = ` @@ -369,12 +369,12 @@ PROOF static thm prove_excl_ra_valid_unit(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - EXCL_RA_VALID_FN, + excl_ra_valid_fn, excl_valid_def))); return gnode_prove(root); } -PROOF thm EXCL_RA_VALID_UNIT = prove_excl_ra_valid_unit(); +PROOF thm excl_ra_valid_unit = prove_excl_ra_valid_unit(); PROOF static thm prove_excl_ra_valid_owned(void) { term goal_tm = ` @@ -384,12 +384,12 @@ PROOF static thm prove_excl_ra_valid_owned(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - EXCL_RA_VALID_FN, + excl_ra_valid_fn, excl_valid_def))); return gnode_prove(root); } -PROOF thm EXCL_RA_VALID_OWNED = prove_excl_ra_valid_owned(); +PROOF thm excl_ra_valid_owned = prove_excl_ra_valid_owned(); PROOF static thm prove_excl_ra_invalid(void) { term goal_tm = ` @@ -399,12 +399,12 @@ PROOF static thm prove_excl_ra_invalid(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - EXCL_RA_VALID_FN, + excl_ra_valid_fn, excl_valid_def))); return gnode_prove(root); } -PROOF thm EXCL_RA_INVALID = prove_excl_ra_invalid(); +PROOF thm excl_ra_invalid = prove_excl_ra_invalid(); /* Exactly the distinguished invalid constructor is invalid. */ PROOF static thm prove_excl_ra_valid_iff(void) { @@ -427,7 +427,7 @@ PROOF static thm prove_excl_ra_valid_iff(void) { assume_rule(`ra_valid (excl_ra:((A)excl)ra) (x:(A)excl)`)); CONTR_TAC( forward, - not_elim_rule(EXCL_RA_INVALID, invalid_valid)); + not_elim_rule(excl_ra_invalid, invalid_valid)); gnode reverse = DISCH_TAC(directions[1], "Hnot_invalid"); gnode_list cases = CASES_TAC( @@ -438,13 +438,13 @@ PROOF static thm prove_excl_ra_valid_iff(void) { cases[0], pure_rewrite_rule( THM_LIST(gsym_rule(unit_eq)), - EXCL_RA_VALID_UNIT)); + excl_ra_valid_unit)); thm owned_eq = assume_rule(gnode_get_asmps( cases[1], CONST_STRING_LIST("Hx"))[0]); thm owned_valid = ispec_rule( `a:A`, - EXCL_RA_VALID_OWNED); + excl_ra_valid_owned); ACCEPT_TAC( cases[1], pure_rewrite_rule( @@ -460,7 +460,7 @@ PROOF static thm prove_excl_ra_valid_iff(void) { return gnode_prove(root); } -PROOF thm EXCL_RA_VALID_IFF = +PROOF thm excl_ra_valid_iff = prove_excl_ra_valid_iff(); /* @@ -483,7 +483,7 @@ PROOF static thm prove_excl_ra_exclusive(void) { gnode_list exclusive = CONJ_TAC(body); ACCEPT_TAC( exclusive[0], - ispec_rule(`a:A`, EXCL_RA_VALID_OWNED)); + ispec_rule(`a:A`, excl_ra_valid_owned)); body = GEN_TAC(exclusive[1], "frame"); gnode_list frame_cases = CASES_TAC( body, @@ -494,9 +494,9 @@ PROOF static thm prove_excl_ra_exclusive(void) { frame_cases[i], rewrite_conv, THM_LIST( - EXCL_RA_UNIT, - EXCL_RA_OP_FN, - EXCL_RA_VALID_FN, + excl_ra_unit, + excl_ra_op_fn, + excl_ra_valid_fn, excl_op_def, excl_owned_op_def, excl_valid_def)); @@ -504,7 +504,7 @@ PROOF static thm prove_excl_ra_exclusive(void) { return gnode_prove(root); } -PROOF thm EXCL_RA_EXCLUSIVE = +PROOF thm excl_ra_exclusive = prove_excl_ra_exclusive(); PROOF static thm prove_excl_ra_included_owned(void) { @@ -532,7 +532,7 @@ PROOF static thm prove_excl_ra_included_owned(void) { thm unit_extension = rewrite_rule( THM_LIST( unit_frame, - EXCL_RA_OP_FN, + excl_ra_op_fn, excl_op_def, excl_owned_op_def), assume_rule(` @@ -542,7 +542,7 @@ PROOF static thm prove_excl_ra_included_owned(void) { (Excl (a:A)) (frame:(A)excl)`)); thm unit_payloads = eq_mp_rule( - ispecl_rule(TERM_LIST(`b:A`, `a:A`), EXCL_RA_OWNED_INJ), + ispecl_rule(TERM_LIST(`b:A`, `a:A`), excl_ra_owned_inj), unit_extension); ACCEPT_TAC(frame_cases[0], gsym_rule(unit_payloads)); @@ -552,7 +552,7 @@ PROOF static thm prove_excl_ra_included_owned(void) { thm invalid_extension = rewrite_rule( THM_LIST( frame_eq, - EXCL_RA_OP_FN, + excl_ra_op_fn, excl_op_def, excl_owned_op_def), assume_rule(` @@ -562,7 +562,7 @@ PROOF static thm prove_excl_ra_included_owned(void) { (Excl (a:A)) (frame:(A)excl)`)); thm impossible = not_elim_rule( - ispec_rule(`b:A`, EXCL_INVALID_NE_OWNED), + ispec_rule(`b:A`, excl_invalid_ne_owned), gsym_rule(invalid_extension)); CONTR_TAC(frame_cases[i], impossible); } @@ -570,12 +570,12 @@ PROOF static thm prove_excl_ra_included_owned(void) { gnode reverse = DISCH_TAC(directions[1], "Heq"); reverse = EXISTS_TAC(reverse, `ExclUnit:(A)excl`); thm unit_op = pure_once_rewrite_rule( - THM_LIST(EXCL_RA_UNIT), + THM_LIST(excl_ra_unit), ispecl_rule( TERM_LIST( `excl_ra:((A)excl)ra`, `Excl (a:A):(A)excl`), - RA_UNIT_R)); + ra_unit_r)); thm payload_eq = ap_term_rule( `Excl:A->(A)excl`, gsym_rule(assume_rule(`(a:A) == (b:A)`))); @@ -583,14 +583,14 @@ PROOF static thm prove_excl_ra_included_owned(void) { thm proved = gnode_prove(root); ENSURE_COND(equals_term(concl(proved), goal_tm), - "EXCL_RA_INCLUDED_OWNED has the wrong conclusion"); + "excl_ra_included_owned has the wrong conclusion"); return proved; err: ERR_FUN_PUTS("prove_excl_ra_included_owned"); return empty_theorem; } -PROOF thm EXCL_RA_INCLUDED_OWNED = +PROOF thm excl_ra_included_owned = prove_excl_ra_included_owned(); /* Owned values extend either trivially or to the inconsistent element. */ @@ -616,15 +616,15 @@ PROOF static thm prove_excl_ra_included_owned_iff(void) { `excl_ra:((A)excl)ra`, `Excl (a:A):(A)excl`, `x:(A)excl`), - RA_EXCLUSIVE_INCLUDED); + ra_exclusive_included); source_eq_unit = mp_rule( source_eq_unit, - ispec_rule(`a:A`, EXCL_RA_EXCLUSIVE)); + ispec_rule(`a:A`, excl_ra_exclusive)); thm case_unit_eq = assume_rule(gnode_get_asmps( cases[0], CONST_STRING_LIST("Hx"))[0]); thm case_unit_valid = pure_rewrite_rule( THM_LIST(gsym_rule(case_unit_eq)), - EXCL_RA_VALID_UNIT); + excl_ra_valid_unit); source_eq_unit = mp_rule(source_eq_unit, case_unit_valid); source_eq_unit = mp_rule( source_eq_unit, @@ -638,7 +638,7 @@ PROOF static thm prove_excl_ra_included_owned_iff(void) { CONTR_TAC( cases[0], not_elim_rule( - ispec_rule(`a:A`, EXCL_RA_OWNED_NE_UNIT), + ispec_rule(`a:A`, excl_ra_owned_ne_unit), owned_eq_unit)); thm source_eq_owned = ispecl_rule( @@ -646,10 +646,10 @@ PROOF static thm prove_excl_ra_included_owned_iff(void) { `excl_ra:((A)excl)ra`, `Excl (a:A):(A)excl`, `x:(A)excl`), - RA_EXCLUSIVE_INCLUDED); + ra_exclusive_included); source_eq_owned = mp_rule( source_eq_owned, - ispec_rule(`a:A`, EXCL_RA_EXCLUSIVE)); + ispec_rule(`a:A`, excl_ra_exclusive)); thm case_owned_eq = assume_rule(gnode_get_asmps( cases[1], CONST_STRING_LIST("Hx"))[0]); term case_owned_payload = dest_comb( @@ -658,7 +658,7 @@ PROOF static thm prove_excl_ra_included_owned_iff(void) { ap_term_rule( `ra_valid (excl_ra:((A)excl)ra):(A)excl->bool`, gsym_rule(case_owned_eq)), - ispec_rule(case_owned_payload, EXCL_RA_VALID_OWNED)); + ispec_rule(case_owned_payload, excl_ra_valid_owned)); source_eq_owned = mp_rule(source_eq_owned, case_owned_valid); source_eq_owned = mp_rule( source_eq_owned, @@ -690,7 +690,7 @@ PROOF static thm prove_excl_ra_included_owned_iff(void) { TERM_LIST( `excl_ra:((A)excl)ra`, `Excl (a:A):(A)excl`), - RA_INCLUDED_REFL); + ra_included_refl); ACCEPT_TAC( target_cases[0], eq_mp_rule( @@ -712,14 +712,14 @@ PROOF static thm prove_excl_ra_included_owned_iff(void) { `); thm conflict = ispecl_rule( TERM_LIST(`a:A`, `a:A`), - EXCL_RA_OWNED_CONFLICT); + excl_ra_owned_conflict); ACCEPT_TAC( invalid_target, trans_rule(target_invalid, gsym_rule(conflict))); return gnode_prove(root); } -PROOF thm EXCL_RA_INCLUDED_OWNED_IFF = +PROOF thm excl_ra_included_owned_iff = prove_excl_ra_included_owned_iff(); /* Invalid is absorbing, so it includes only itself. */ @@ -749,7 +749,7 @@ PROOF static thm prove_excl_ra_included_invalid_iff(void) { (frame:(A)excl) `); extension = rewrite_rule( - THM_LIST(EXCL_RA_OP_FN, excl_op_def), + THM_LIST(excl_ra_op_fn, excl_op_def), extension); ACCEPT_TAC(forward, extension); @@ -759,19 +759,19 @@ PROOF static thm prove_excl_ra_included_invalid_iff(void) { (x:(A)excl) == (ExclInvalid:(A)excl) `); thm unit_extension = pure_once_rewrite_rule( - THM_LIST(EXCL_RA_UNIT), + THM_LIST(excl_ra_unit), ispecl_rule( TERM_LIST( `excl_ra:((A)excl)ra`, `ExclInvalid:(A)excl`), - RA_UNIT_R)); + ra_unit_r)); ACCEPT_TAC( reverse, trans_rule(target_eq, gsym_rule(unit_extension))); return gnode_prove(root); } -PROOF thm EXCL_RA_INCLUDED_INVALID_IFF = +PROOF thm excl_ra_included_invalid_iff = prove_excl_ra_included_invalid_iff(); /* Exclusive composition is cancellative on valid sources. Explicit cases @@ -819,7 +819,7 @@ PROOF static thm prove_excl_ra_cancellative(void) { thm result = rewrite_rule( THM_LIST( frame_eq, - EXCL_RA_OP_FN, + excl_ra_op_fn, excl_op_def), ops_equal); ACCEPT_TAC(branch, result); @@ -840,8 +840,8 @@ PROOF static thm prove_excl_ra_cancellative(void) { THM_LIST( frame_eq, b_eq, - EXCL_RA_OP_FN, - EXCL_RA_VALID_FN, + excl_ra_op_fn, + excl_ra_valid_fn, excl_op_def, excl_owned_op_def, excl_valid_def), @@ -852,8 +852,8 @@ PROOF static thm prove_excl_ra_cancellative(void) { THM_LIST( frame_eq, a_eq, - EXCL_RA_OP_FN, - EXCL_RA_VALID_FN, + excl_ra_op_fn, + excl_ra_valid_fn, excl_op_def, excl_owned_op_def, excl_valid_def), @@ -866,7 +866,7 @@ PROOF static thm prove_excl_ra_cancellative(void) { return gnode_prove(root); } -PROOF thm EXCL_RA_CANCELLATIVE = +PROOF thm excl_ra_cancellative = prove_excl_ra_cancellative(); /* Any valid target may replace an exclusive source. */ @@ -878,18 +878,18 @@ PROOF static thm prove_excl_ra_update(void) { `excl_ra:((A)excl)ra`, `Excl (a:A):(A)excl`, `Excl (b:A):(A)excl`), - RA_EXCLUSIVE_UPDATE); + ra_exclusive_update); result = mp_rule( result, - ispec_rule(a, EXCL_RA_EXCLUSIVE)); + ispec_rule(a, excl_ra_exclusive)); result = mp_rule( result, - ispec_rule(b, EXCL_RA_VALID_OWNED)); + ispec_rule(b, excl_ra_valid_owned)); result = gen_rule(b, result); return gen_rule(a, result); } -PROOF thm EXCL_RA_UPDATE = prove_excl_ra_update(); +PROOF thm excl_ra_update = prove_excl_ra_update(); /* Generic exclusive replacement, with an arbitrary valid target. */ PROOF static thm prove_excl_ra_update_valid(void) { @@ -905,10 +905,10 @@ PROOF static thm prove_excl_ra_update_valid(void) { `excl_ra:((A)excl)ra`, `Excl (a:A):(A)excl`, `x:(A)excl`), - RA_EXCLUSIVE_UPDATE); + ra_exclusive_update); result = mp_rule( result, - ispec_rule(`a:A`, EXCL_RA_EXCLUSIVE)); + ispec_rule(`a:A`, excl_ra_exclusive)); result = mp_rule( result, assume_rule(`ra_valid (excl_ra:((A)excl)ra) (x:(A)excl)`)); @@ -916,7 +916,7 @@ PROOF static thm prove_excl_ra_update_valid(void) { return gnode_prove(root); } -PROOF thm EXCL_RA_UPDATE_VALID = +PROOF thm excl_ra_update_valid = prove_excl_ra_update_valid(); /* Unit framing makes target validity necessary as well as sufficient. */ @@ -939,7 +939,7 @@ PROOF static thm prove_excl_ra_update_owned_iff(void) { `excl_ra:((A)excl)ra`, `Excl (a:A):(A)excl`, `x:(A)excl`), - RA_UPDATE_VALID); + ra_update_valid); preserved = mp_rule( preserved, assume_rule(` @@ -950,13 +950,13 @@ PROOF static thm prove_excl_ra_update_owned_iff(void) { `)); preserved = mp_rule( preserved, - ispec_rule(`a:A`, EXCL_RA_VALID_OWNED)); + ispec_rule(`a:A`, excl_ra_valid_owned)); ACCEPT_TAC(forward, preserved); gnode reverse = DISCH_TAC(directions[1], "Hvalid"); thm result = ispecl_rule( TERM_LIST(`a:A`, `x:(A)excl`), - EXCL_RA_UPDATE_VALID); + excl_ra_update_valid); ACCEPT_TAC( reverse, mp_rule( @@ -965,7 +965,7 @@ PROOF static thm prove_excl_ra_update_owned_iff(void) { return gnode_prove(root); } -PROOF thm EXCL_RA_UPDATE_OWNED_IFF = +PROOF thm excl_ra_update_owned_iff = prove_excl_ra_update_owned_iff(); /* The generic exclusive local update gives full owned replacement directly. */ @@ -988,10 +988,10 @@ PROOF static thm prove_excl_ra_local_update_valid(void) { `Excl (a:A):(A)excl`, `Excl (a:A):(A)excl`, `x:(A)excl`), - RA_LOCAL_UPDATE_EXCLUSIVE); + ra_local_update_exclusive); result = mp_rule( result, - ispec_rule(`a:A`, EXCL_RA_EXCLUSIVE)); + ispec_rule(`a:A`, excl_ra_exclusive)); result = mp_rule( result, assume_rule(`ra_valid (excl_ra:((A)excl)ra) (x:(A)excl)`)); @@ -999,7 +999,7 @@ PROOF static thm prove_excl_ra_local_update_valid(void) { return gnode_prove(root); } -PROOF thm EXCL_RA_LOCAL_UPDATE_VALID = +PROOF thm excl_ra_local_update_valid = prove_excl_ra_local_update_valid(); /* Unit residual exposes target validity, making the local rule exact. */ @@ -1027,7 +1027,7 @@ PROOF static thm prove_excl_ra_local_update_iff(void) { `x:(A)excl`, `x:(A)excl`, `ExclUnit:(A)excl`), - RA_LOCAL_UPDATE_APPLY); + ra_local_update_apply); applied = mp_rule( applied, assume_rule(` @@ -1040,14 +1040,14 @@ PROOF static thm prove_excl_ra_local_update_iff(void) { `)); applied = mp_rule( applied, - ispec_rule(`a:A`, EXCL_RA_VALID_OWNED)); + ispec_rule(`a:A`, excl_ra_valid_owned)); thm source_unit = pure_once_rewrite_rule( - THM_LIST(EXCL_RA_UNIT), + THM_LIST(excl_ra_unit), ispecl_rule( TERM_LIST( `excl_ra:((A)excl)ra`, `Excl (a:A):(A)excl`), - RA_UNIT_R)); + ra_unit_r)); applied = mp_rule(applied, gsym_rule(source_unit)); ACCEPT_TAC(forward, conjunct1_rule(applied)); @@ -1057,12 +1057,12 @@ PROOF static thm prove_excl_ra_local_update_iff(void) { mp_rule( ispecl_rule( TERM_LIST(`a:A`, `x:(A)excl`), - EXCL_RA_LOCAL_UPDATE_VALID), + excl_ra_local_update_valid), assume_rule(`ra_valid (excl_ra:((A)excl)ra) (x:(A)excl)`))); return gnode_prove(root); } -PROOF thm EXCL_RA_LOCAL_UPDATE_IFF = +PROOF thm excl_ra_local_update_iff = prove_excl_ra_local_update_iff(); PROOF static int audit_excl_ra(void) { @@ -1074,33 +1074,33 @@ PROOF static int audit_excl_ra(void) { excl_valid_def, excl_is_unit_def, excl_matches_def, - EXCL_OWNED_NE_UNIT, - EXCL_INVALID_NE_UNIT, - EXCL_RA_OWNED_INJ, - EXCL_INVALID_NE_OWNED, - EXCL_RA_OWNED_NE_UNIT, - EXCL_RA_INVALID_NE_UNIT, - EXCL_RA_INVALID_NE_OWNED, - EXCL_RA_LAWS, + excl_owned_ne_unit, + excl_invalid_ne_unit, + excl_ra_owned_inj, + excl_invalid_ne_owned, + excl_ra_owned_ne_unit, + excl_ra_invalid_ne_unit, + excl_ra_invalid_ne_owned, + excl_ra_laws, excl_ra_def, - EXCL_RA_UNIT, - EXCL_RA_OP_FN, - EXCL_RA_VALID_FN, - EXCL_RA_OWNED_CONFLICT, - EXCL_RA_VALID_UNIT, - EXCL_RA_VALID_OWNED, - EXCL_RA_INVALID, - EXCL_RA_VALID_IFF, - EXCL_RA_EXCLUSIVE, - EXCL_RA_INCLUDED_OWNED, - EXCL_RA_INCLUDED_OWNED_IFF, - EXCL_RA_INCLUDED_INVALID_IFF, - EXCL_RA_CANCELLATIVE, - EXCL_RA_UPDATE, - EXCL_RA_UPDATE_VALID, - EXCL_RA_UPDATE_OWNED_IFF, - EXCL_RA_LOCAL_UPDATE_VALID, - EXCL_RA_LOCAL_UPDATE_IFF); + excl_ra_unit, + excl_ra_op_fn, + excl_ra_valid_fn, + excl_ra_owned_conflict, + excl_ra_valid_unit, + excl_ra_valid_owned, + excl_ra_invalid, + excl_ra_valid_iff, + excl_ra_exclusive, + excl_ra_included_owned, + excl_ra_included_owned_iff, + excl_ra_included_invalid_iff, + excl_ra_cancellative, + excl_ra_update, + excl_ra_update_valid, + excl_ra_update_owned_iff, + excl_ra_local_update_valid, + excl_ra_local_update_iff); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { ENSURE_COND(!IS_NULL(audited_theorems[i]), diff --git a/theory/logic/excl_ra.h b/theory/logic/excl_ra.h index 745b942..3e7f05b 100644 --- a/theory/logic/excl_ra.h +++ b/theory/logic/excl_ra.h @@ -1,16 +1,55 @@ #pragma once -/* Exclusive resource algebra. Invalid-source vacuum rules are not public. */ +/* + * Public semantic interface for the exclusive resource algebra. + * + * `ExclUnit` is the unit, each `Excl a` is a valid exclusive token, and + * composing two owned tokens produces the invalid value `ExclInvalid`. + * Datatype elimination, constructor distinctions, and raw operation equations + * are confined to `excl_ra_internal.h`. + */ #include "proof/theory/logic/local_update.h" -PROOF extern thm EXCL_RA_UNIT; -PROOF extern thm EXCL_RA_OWNED_CONFLICT; -PROOF extern thm EXCL_RA_VALID_UNIT; -PROOF extern thm EXCL_RA_VALID_OWNED; -PROOF extern thm EXCL_RA_INVALID; -PROOF extern thm EXCL_RA_INCLUDED_OWNED; -PROOF extern thm EXCL_RA_EXCLUSIVE; -PROOF extern thm EXCL_RA_CANCELLATIVE; -PROOF extern thm EXCL_RA_UPDATE_OWNED_IFF; -PROOF extern thm EXCL_RA_LOCAL_UPDATE_IFF; +/* ------------------------------------------------------------------------- */ +/* Operation and validity */ +/* ------------------------------------------------------------------------- */ + +/* `ra_unit excl_ra == ExclUnit`. */ +PROOF extern thm excl_ra_unit; + +/* `ra_op excl_ra (Excl a) (Excl b) == ExclInvalid`. */ +PROOF extern thm excl_ra_owned_conflict; + +/* The unit and every single owned token are valid. */ +PROOF extern thm excl_ra_valid_unit; +PROOF extern thm excl_ra_valid_owned; + +/* `~ra_valid excl_ra ExclInvalid`. */ +PROOF extern thm excl_ra_invalid; + +/* ------------------------------------------------------------------------- */ +/* Inclusion and algebraic properties */ +/* ------------------------------------------------------------------------- */ + +/* `ra_included excl_ra (Excl a) (Excl b) <=> a == b`. */ +PROOF extern thm excl_ra_included_owned; + +/* Every `Excl a` is a valid exclusive element. */ +PROOF extern thm excl_ra_exclusive; + +/* `ra_cancellative excl_ra`. */ +PROOF extern thm excl_ra_cancellative; + +/* ------------------------------------------------------------------------- */ +/* Replacement updates */ +/* ------------------------------------------------------------------------- */ + +/* `ra_update excl_ra (Excl a) x <=> ra_valid excl_ra x`. */ +PROOF extern thm excl_ra_update_owned_iff; + +/* + * `ra_local_update excl_ra (Excl a) (Excl a) x x <=> + * ra_valid excl_ra x`. + */ +PROOF extern thm excl_ra_local_update_iff; diff --git a/theory/logic/excl_ra_internal.h b/theory/logic/excl_ra_internal.h index 27c30ab..1162774 100644 --- a/theory/logic/excl_ra_internal.h +++ b/theory/logic/excl_ra_internal.h @@ -3,43 +3,41 @@ /* * INTERNAL CONSTRUCTION INTERFACE for the exclusive RA. * - * General clients should include `excl_ra.h`. This header exists only for - * implementations, notably `auth_ra`, whose proofs must eliminate the - * exclusive datatype or reduce its raw operation. None of the handles below - * belongs to the semantic client API; use `excl_ra.h` unless eliminating the - * representation is unavoidable in an implementation proof. + * Ordinary clients use `excl_ra.h`. This header is limited to constructor + * implementations such as `auth_ra` and `mem_ra` that must eliminate the + * exclusive datatype or normalize its raw operation. It must not be + * re-exported from a public protocol header. */ #include "proof/theory/logic/excl_ra.h" -/** - * Datatype package for `excl = ExclUnit | Excl A | ExclInvalid`. - * Constructor, induction, and recursion handles are implementation details. - */ +/* ------------------------------------------------------------------------- */ +/* Raw datatype and operation */ +/* ------------------------------------------------------------------------- */ + +/* Datatype package for `excl = ExclUnit | Excl A | ExclInvalid`. */ PROOF extern indtype excl_type; -/** - * Case equations for `excl_owned_op a`: unit returns `Excl a`; either an - * owned right operand or `ExclInvalid` returns `ExclInvalid`. - */ +/* Case equations for the owned-left operation helper. */ PROOF extern thm excl_owned_op_def; -/** - * Case equations for the raw commutative operation `excl_op`; its left-unit - * case returns the right operand and its owned case delegates to - * `excl_owned_op`. - */ +/* Case equations for the raw commutative operation `excl_op`. */ PROOF extern thm excl_op_def; -/** Constructor distinction: `⊢ ∀a. ¬(Excl a = ExclUnit)`. */ -PROOF extern thm EXCL_OWNED_NE_UNIT; +/* ------------------------------------------------------------------------- */ +/* Representation normalization */ +/* ------------------------------------------------------------------------- */ -/** Constructor distinction: `⊢ ¬(ExclInvalid = ExclUnit)`. */ -PROOF extern thm EXCL_INVALID_NE_UNIT; +/* Constructor distinctions needed by implementation case analyses. */ +PROOF extern thm excl_owned_ne_unit; +PROOF extern thm excl_invalid_ne_unit; -/** Projection equation: `⊢ ra_op excl_ra = excl_op`. */ -PROOF extern thm EXCL_RA_OP_FN; +/* `ra_op excl_ra == excl_op`. */ +PROOF extern thm excl_ra_op_fn; -/* Internal whole-descriptor replacement rule used by the physical-memory - * constructor. Protocol clients use EXCL_RA_UPDATE_OWNED_IFF instead. */ -PROOF extern thm EXCL_RA_UPDATE; +/* + * Direct owned-token replacement: `Excl a` may update to `Excl b`. + * Physical-memory construction uses this convenience form; protocol clients + * use the exact public rule `excl_ra_update_owned_iff`. + */ +PROOF extern thm excl_ra_update; diff --git a/theory/logic/finmap.c b/theory/logic/finmap.c index ba85191..aecfb62 100644 --- a/theory/logic/finmap.c +++ b/theory/logic/finmap.c @@ -26,11 +26,11 @@ PROOF static thm prove_finmap_rep_exists(void) { return gnode_prove(root); } -PROOF static thm FINMAP_REP_EXISTS = +PROOF static thm finmap_rep_exists = prove_finmap_rep_exists(); -PROOF thm FINMAP_TYPE_BIJECTION = new_type_bijection_definition( - "finmap", "finmap_abs", "finmap_rep", FINMAP_REP_EXISTS); +PROOF thm finmap_type_bijection = new_type_bijection_definition( + "finmap", "finmap_abs", "finmap_rep", finmap_rep_exists); PROOF static thm prove_finmap_rep_finite(void) { term goal_tm = ` @@ -41,11 +41,11 @@ PROOF static thm prove_finmap_rep_finite(void) { gnode body = AUTO_INTROS_TAC(root); CONV_TAC( body, - rewrite_conv(THM_LIST(FINMAP_TYPE_BIJECTION))); + rewrite_conv(THM_LIST(finmap_type_bijection))); return gnode_prove(root); } -PROOF thm FINMAP_REP_FINITE = +PROOF thm finmap_rep_finite = prove_finmap_rep_finite(); PROOF static thm prove_finmap_eq(void) { @@ -71,13 +71,13 @@ PROOF static thm prove_finmap_eq(void) { finmap_rep (m:(K,V)finmap) == finmap_rep n `)); abstract_eq = rewrite_rule( - THM_LIST(conjunct1_rule(FINMAP_TYPE_BIJECTION)), + THM_LIST(conjunct1_rule(finmap_type_bijection)), abstract_eq); ACCEPT_TAC(reverse, abstract_eq); return gnode_prove(root); } -PROOF thm FINMAP_EQ = prove_finmap_eq(); +PROOF thm finmap_eq = prove_finmap_eq(); PROOF static thm prove_finmap_empty_finite(void) { term goal_tm = ` @@ -93,7 +93,7 @@ PROOF static thm prove_finmap_empty_finite(void) { return gnode_prove(root); } -PROOF static thm FINMAP_EMPTY_FINITE = +PROOF static thm finmap_empty_finite = prove_finmap_empty_finite(); PROOF thm finmap_empty_def = new_fun_definition(` @@ -110,14 +110,14 @@ PROOF static thm prove_finmap_empty_rep(void) { term raw_empty = `\k:K. (NONE:V option)`; thm inverse = ispec_rule( raw_empty, - conjunct2_rule(FINMAP_TYPE_BIJECTION)); - thm represented = eq_mp_rule(inverse, FINMAP_EMPTY_FINITE); + conjunct2_rule(finmap_type_bijection)); + thm represented = eq_mp_rule(inverse, finmap_empty_finite); return pure_once_rewrite_rule( THM_LIST(gsym_rule(finmap_empty_def)), represented); } -PROOF thm FINMAP_EMPTY_REP = +PROOF thm finmap_empty_rep = prove_finmap_empty_rep(); PROOF static thm prove_finmap_empty_lookup(void) { @@ -130,11 +130,11 @@ PROOF static thm prove_finmap_empty_lookup(void) { root, rewrite_conv(THM_LIST( finmap_lookup_def, - FINMAP_EMPTY_REP))); + finmap_empty_rep))); return gnode_prove(root); } -PROOF thm FINMAP_EMPTY_LOOKUP = +PROOF thm finmap_empty_lookup = prove_finmap_empty_lookup(); PROOF static thm prove_finmap_singleton_support(void) { @@ -165,7 +165,7 @@ PROOF static thm prove_finmap_singleton_support(void) { return gnode_prove(root); } -PROOF thm FINMAP_SINGLETON_SUPPORT = +PROOF thm finmap_singleton_support = prove_finmap_singleton_support(); PROOF static thm prove_finmap_singleton_finite(void) { @@ -184,7 +184,7 @@ PROOF static thm prove_finmap_singleton_finite(void) { `; thm support = ispecl_rule( TERM_LIST(key, v), - FINMAP_SINGLETON_SUPPORT); + finmap_singleton_support); thm finite_singleton = ispec_rule( key, get_theorem_by_name("FINITE_SING")); @@ -205,7 +205,7 @@ PROOF static thm prove_finmap_singleton_finite(void) { return gnode_prove(root); } -PROOF static thm FINMAP_SINGLETON_FINITE = +PROOF static thm finmap_singleton_finite = prove_finmap_singleton_finite(); PROOF thm finmap_singleton_def = new_fun_definition(` @@ -222,10 +222,10 @@ PROOF static thm prove_finmap_singleton_rep(void) { `; thm finite = ispecl_rule( TERM_LIST(key, v), - FINMAP_SINGLETON_FINITE); + finmap_singleton_finite); thm inverse = ispec_rule( raw, - conjunct2_rule(FINMAP_TYPE_BIJECTION)); + conjunct2_rule(finmap_type_bijection)); thm represented = eq_mp_rule(inverse, finite); represented = pure_once_rewrite_rule( THM_LIST(gsym_rule(finmap_singleton_def)), @@ -234,7 +234,7 @@ PROOF static thm prove_finmap_singleton_rep(void) { return gen_rule(key, represented); } -PROOF thm FINMAP_SINGLETON_REP = +PROOF thm finmap_singleton_rep = prove_finmap_singleton_rep(); PROOF static thm prove_finmap_singleton_lookup(void) { @@ -248,11 +248,11 @@ PROOF static thm prove_finmap_singleton_lookup(void) { root, rewrite_conv(THM_LIST( finmap_lookup_def, - FINMAP_SINGLETON_REP))); + finmap_singleton_rep))); return gnode_prove(root); } -PROOF thm FINMAP_SINGLETON_LOOKUP = +PROOF thm finmap_singleton_lookup = prove_finmap_singleton_lookup(); PROOF static thm prove_finmap_insert_support(void) { @@ -283,7 +283,7 @@ PROOF static thm prove_finmap_insert_support(void) { return gnode_prove(root); } -PROOF thm FINMAP_INSERT_SUPPORT = +PROOF thm finmap_insert_support = prove_finmap_insert_support(); PROOF static thm prove_finmap_insert_finite(void) { @@ -313,7 +313,7 @@ PROOF static thm prove_finmap_insert_finite(void) { thm finite_support = rewrite_rule( THM_LIST(finmap_finite_def), - ispec_rule(m, FINMAP_REP_FINITE)); + ispec_rule(m, finmap_rep_finite)); thm finite_insert = eq_mp_rule( gsym_rule(ispecl_rule( TERM_LIST(support, key), @@ -324,7 +324,7 @@ PROOF static thm prove_finmap_insert_finite(void) { key, v, `finmap_rep (m:(K,V)finmap)`), - FINMAP_INSERT_SUPPORT); + finmap_insert_support); thm finite_raw_support = eq_mp_rule( gsym_rule(ap_term_rule( `FINITE:(K->bool)->bool`, @@ -343,7 +343,7 @@ PROOF static thm prove_finmap_insert_finite(void) { return gnode_prove(root); } -PROOF static thm FINMAP_INSERT_FINITE = +PROOF static thm finmap_insert_finite = prove_finmap_insert_finite(); PROOF thm finmap_insert_def = new_fun_definition(` @@ -367,10 +367,10 @@ PROOF static thm prove_finmap_insert_rep(void) { `; thm finite = ispecl_rule( TERM_LIST(key, v, m), - FINMAP_INSERT_FINITE); + finmap_insert_finite); thm inverse = ispec_rule( raw, - conjunct2_rule(FINMAP_TYPE_BIJECTION)); + conjunct2_rule(finmap_type_bijection)); thm represented = eq_mp_rule(inverse, finite); represented = pure_once_rewrite_rule( THM_LIST(gsym_rule(finmap_insert_def)), @@ -380,7 +380,7 @@ PROOF static thm prove_finmap_insert_rep(void) { return gen_rule(key, represented); } -PROOF thm FINMAP_INSERT_REP = +PROOF thm finmap_insert_rep = prove_finmap_insert_rep(); PROOF static thm prove_finmap_insert_lookup(void) { @@ -398,11 +398,11 @@ PROOF static thm prove_finmap_insert_lookup(void) { root, rewrite_conv(THM_LIST( finmap_lookup_def, - FINMAP_INSERT_REP))); + finmap_insert_rep))); return gnode_prove(root); } -PROOF thm FINMAP_INSERT_LOOKUP = +PROOF thm finmap_insert_lookup = prove_finmap_insert_lookup(); PROOF static thm prove_finmap_insert_lookup_eq(void) { @@ -416,11 +416,11 @@ PROOF static thm prove_finmap_insert_lookup_eq(void) { gnode root = gnode_new_with_ccl(goal_tm); CONV_TAC( root, - rewrite_conv(THM_LIST(FINMAP_INSERT_LOOKUP))); + rewrite_conv(THM_LIST(finmap_insert_lookup))); return gnode_prove(root); } -PROOF thm FINMAP_INSERT_LOOKUP_EQ = +PROOF thm finmap_insert_lookup_eq = prove_finmap_insert_lookup_eq(); PROOF static thm prove_finmap_insert_lookup_ne(void) { @@ -439,11 +439,11 @@ PROOF static thm prove_finmap_insert_lookup_ne(void) { CONV_WITH_ASMP_TAC( body, rewrite_conv, - THM_LIST(FINMAP_INSERT_LOOKUP)); + THM_LIST(finmap_insert_lookup)); return gnode_prove(root); } -PROOF thm FINMAP_INSERT_LOOKUP_NE = +PROOF thm finmap_insert_lookup_ne = prove_finmap_insert_lookup_ne(); PROOF static thm prove_finmap_delete_support(void) { @@ -473,7 +473,7 @@ PROOF static thm prove_finmap_delete_support(void) { return gnode_prove(root); } -PROOF thm FINMAP_DELETE_SUPPORT = +PROOF thm finmap_delete_support = prove_finmap_delete_support(); PROOF static thm prove_finmap_delete_finite(void) { @@ -501,7 +501,7 @@ PROOF static thm prove_finmap_delete_finite(void) { thm finite_support = rewrite_rule( THM_LIST(finmap_finite_def), - ispec_rule(m, FINMAP_REP_FINITE)); + ispec_rule(m, finmap_rep_finite)); thm finite_delete = eq_mp_rule( gsym_rule(ispecl_rule( TERM_LIST(support, key), @@ -511,7 +511,7 @@ PROOF static thm prove_finmap_delete_finite(void) { TERM_LIST( key, `finmap_rep (m:(K,V)finmap)`), - FINMAP_DELETE_SUPPORT); + finmap_delete_support); thm finite_raw_support = eq_mp_rule( gsym_rule(ap_term_rule( `FINITE:(K->bool)->bool`, @@ -530,7 +530,7 @@ PROOF static thm prove_finmap_delete_finite(void) { return gnode_prove(root); } -PROOF static thm FINMAP_DELETE_FINITE = +PROOF static thm finmap_delete_finite = prove_finmap_delete_finite(); PROOF thm finmap_delete_def = new_fun_definition(` @@ -552,10 +552,10 @@ PROOF static thm prove_finmap_delete_rep(void) { `; thm finite = ispecl_rule( TERM_LIST(key, m), - FINMAP_DELETE_FINITE); + finmap_delete_finite); thm inverse = ispec_rule( raw, - conjunct2_rule(FINMAP_TYPE_BIJECTION)); + conjunct2_rule(finmap_type_bijection)); thm represented = eq_mp_rule(inverse, finite); represented = pure_once_rewrite_rule( THM_LIST(gsym_rule(finmap_delete_def)), @@ -564,7 +564,7 @@ PROOF static thm prove_finmap_delete_rep(void) { return gen_rule(key, represented); } -PROOF thm FINMAP_DELETE_REP = +PROOF thm finmap_delete_rep = prove_finmap_delete_rep(); PROOF static thm prove_finmap_delete_lookup(void) { @@ -581,11 +581,11 @@ PROOF static thm prove_finmap_delete_lookup(void) { root, rewrite_conv(THM_LIST( finmap_lookup_def, - FINMAP_DELETE_REP))); + finmap_delete_rep))); return gnode_prove(root); } -PROOF thm FINMAP_DELETE_LOOKUP = +PROOF thm finmap_delete_lookup = prove_finmap_delete_lookup(); PROOF static thm prove_finmap_delete_lookup_eq(void) { @@ -598,11 +598,11 @@ PROOF static thm prove_finmap_delete_lookup_eq(void) { gnode root = gnode_new_with_ccl(goal_tm); CONV_TAC( root, - rewrite_conv(THM_LIST(FINMAP_DELETE_LOOKUP))); + rewrite_conv(THM_LIST(finmap_delete_lookup))); return gnode_prove(root); } -PROOF thm FINMAP_DELETE_LOOKUP_EQ = +PROOF thm finmap_delete_lookup_eq = prove_finmap_delete_lookup_eq(); PROOF static thm prove_finmap_delete_lookup_ne(void) { @@ -620,11 +620,11 @@ PROOF static thm prove_finmap_delete_lookup_ne(void) { CONV_WITH_ASMP_TAC( body, rewrite_conv, - THM_LIST(FINMAP_DELETE_LOOKUP)); + THM_LIST(finmap_delete_lookup)); return gnode_prove(root); } -PROOF thm FINMAP_DELETE_LOOKUP_NE = +PROOF thm finmap_delete_lookup_ne = prove_finmap_delete_lookup_ne(); PROOF static thm prove_finmap_eq_lookup(void) { @@ -638,7 +638,7 @@ PROOF static thm prove_finmap_eq_lookup(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ))); + once_rewrite_conv(THM_LIST(finmap_eq))); body = CONV_TAC( body, once_rewrite_conv(THM_LIST( @@ -649,7 +649,7 @@ PROOF static thm prove_finmap_eq_lookup(void) { return gnode_prove(root); } -PROOF thm FINMAP_EQ_LOOKUP = +PROOF thm finmap_eq_lookup = prove_finmap_eq_lookup(); PROOF static thm prove_finmap_insert_empty(void) { @@ -662,7 +662,7 @@ PROOF static thm prove_finmap_insert_empty(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "query"); gnode_list cases = BOOL_CASES_TAC( body, `(query:K) == (key:K)`, NULL); @@ -671,14 +671,14 @@ PROOF static thm prove_finmap_insert_empty(void) { cases[i], rewrite_conv, THM_LIST( - FINMAP_INSERT_LOOKUP, - FINMAP_EMPTY_LOOKUP, - FINMAP_SINGLETON_LOOKUP)); + finmap_insert_lookup, + finmap_empty_lookup, + finmap_singleton_lookup)); } return gnode_prove(root); } -PROOF thm FINMAP_INSERT_EMPTY = +PROOF thm finmap_insert_empty = prove_finmap_insert_empty(); PROOF static thm prove_finmap_delete_empty(void) { @@ -691,7 +691,7 @@ PROOF static thm prove_finmap_delete_empty(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "query"); gnode_list cases = BOOL_CASES_TAC( body, `(query:K) == (key:K)`, NULL); @@ -700,13 +700,13 @@ PROOF static thm prove_finmap_delete_empty(void) { cases[i], rewrite_conv, THM_LIST( - FINMAP_DELETE_LOOKUP, - FINMAP_EMPTY_LOOKUP)); + finmap_delete_lookup, + finmap_empty_lookup)); } return gnode_prove(root); } -PROOF thm FINMAP_DELETE_EMPTY = +PROOF thm finmap_delete_empty = prove_finmap_delete_empty(); PROOF static thm prove_finmap_insert_overwrite(void) { @@ -723,7 +723,7 @@ PROOF static thm prove_finmap_insert_overwrite(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "query"); gnode_list cases = BOOL_CASES_TAC( body, `(query:K) == (key:K)`, NULL); @@ -731,12 +731,12 @@ PROOF static thm prove_finmap_insert_overwrite(void) { CONV_WITH_ASMP_TAC( cases[i], rewrite_conv, - THM_LIST(FINMAP_INSERT_LOOKUP)); + THM_LIST(finmap_insert_lookup)); } return gnode_prove(root); } -PROOF thm FINMAP_INSERT_OVERWRITE = +PROOF thm finmap_insert_overwrite = prove_finmap_insert_overwrite(); PROOF static thm prove_finmap_insert_comm(void) { @@ -755,7 +755,7 @@ PROOF static thm prove_finmap_insert_comm(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "query"); gnode_list key1_cases = BOOL_CASES_TAC( body, `(query:K) == (key1:K)`, NULL); @@ -766,13 +766,13 @@ PROOF static thm prove_finmap_insert_comm(void) { CONV_WITH_ASMP_TAC( key2_cases[j], rewrite_conv, - THM_LIST(FINMAP_INSERT_LOOKUP)); + THM_LIST(finmap_insert_lookup)); } } return gnode_prove(root); } -PROOF thm FINMAP_INSERT_COMM = +PROOF thm finmap_insert_comm = prove_finmap_insert_comm(); PROOF static thm prove_finmap_delete_idempotent(void) { @@ -785,7 +785,7 @@ PROOF static thm prove_finmap_delete_idempotent(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "query"); gnode_list cases = BOOL_CASES_TAC( body, `(query:K) == (key:K)`, NULL); @@ -793,12 +793,12 @@ PROOF static thm prove_finmap_delete_idempotent(void) { CONV_WITH_ASMP_TAC( cases[i], rewrite_conv, - THM_LIST(FINMAP_DELETE_LOOKUP)); + THM_LIST(finmap_delete_lookup)); } return gnode_prove(root); } -PROOF thm FINMAP_DELETE_IDEMPOTENT = +PROOF thm finmap_delete_idempotent = prove_finmap_delete_idempotent(); PROOF static thm prove_finmap_delete_comm(void) { @@ -814,7 +814,7 @@ PROOF static thm prove_finmap_delete_comm(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "query"); gnode_list key_cases = BOOL_CASES_TAC( body, `(key1:K) == (key2:K)`, NULL); @@ -828,14 +828,14 @@ PROOF static thm prove_finmap_delete_comm(void) { CONV_WITH_ASMP_TAC( key2_cases[k], rewrite_conv, - THM_LIST(FINMAP_DELETE_LOOKUP)); + THM_LIST(finmap_delete_lookup)); } } } return gnode_prove(root); } -PROOF thm FINMAP_DELETE_COMM = +PROOF thm finmap_delete_comm = prove_finmap_delete_comm(); PROOF static thm prove_finmap_delete_insert(void) { @@ -851,7 +851,7 @@ PROOF static thm prove_finmap_delete_insert(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "query"); gnode_list cases = BOOL_CASES_TAC( body, `(query:K) == (key:K)`, NULL); @@ -860,13 +860,13 @@ PROOF static thm prove_finmap_delete_insert(void) { cases[i], rewrite_conv, THM_LIST( - FINMAP_DELETE_LOOKUP, - FINMAP_INSERT_LOOKUP)); + finmap_delete_lookup, + finmap_insert_lookup)); } return gnode_prove(root); } -PROOF thm FINMAP_DELETE_INSERT = +PROOF thm finmap_delete_insert = prove_finmap_delete_insert(); PROOF static thm prove_finmap_delete_insert_ne(void) { @@ -884,7 +884,7 @@ PROOF static thm prove_finmap_delete_insert_ne(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "query"); gnode_list deleted_cases = BOOL_CASES_TAC( body, `(query:K) == (deleted:K)`, NULL); @@ -896,14 +896,14 @@ PROOF static thm prove_finmap_delete_insert_ne(void) { inserted_cases[j], rewrite_conv, THM_LIST( - FINMAP_DELETE_LOOKUP, - FINMAP_INSERT_LOOKUP)); + finmap_delete_lookup, + finmap_insert_lookup)); } } return gnode_prove(root); } -PROOF thm FINMAP_DELETE_INSERT_NE = +PROOF thm finmap_delete_insert_ne = prove_finmap_delete_insert_ne(); PROOF static thm prove_finmap_insert_delete(void) { @@ -919,7 +919,7 @@ PROOF static thm prove_finmap_insert_delete(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "query"); gnode_list cases = BOOL_CASES_TAC( body, `(query:K) == (key:K)`, NULL); @@ -928,13 +928,13 @@ PROOF static thm prove_finmap_insert_delete(void) { cases[i], rewrite_conv, THM_LIST( - FINMAP_INSERT_LOOKUP, - FINMAP_DELETE_LOOKUP)); + finmap_insert_lookup, + finmap_delete_lookup)); } return gnode_prove(root); } -PROOF thm FINMAP_INSERT_DELETE = +PROOF thm finmap_insert_delete = prove_finmap_insert_delete(); PROOF static thm prove_finmap_insert_id(void) { @@ -950,7 +950,7 @@ PROOF static thm prove_finmap_insert_id(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "query"); gnode_list cases = BOOL_CASES_TAC( body, `(query:K) == (key:K)`, NULL); @@ -958,12 +958,12 @@ PROOF static thm prove_finmap_insert_id(void) { CONV_WITH_ASMP_TAC( cases[i], rewrite_conv, - THM_LIST(FINMAP_INSERT_LOOKUP)); + THM_LIST(finmap_insert_lookup)); } return gnode_prove(root); } -PROOF thm FINMAP_INSERT_ID = +PROOF thm finmap_insert_id = prove_finmap_insert_id(); PROOF static thm prove_finmap_delete_id(void) { @@ -978,7 +978,7 @@ PROOF static thm prove_finmap_delete_id(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "query"); gnode_list cases = BOOL_CASES_TAC( body, `(query:K) == (key:K)`, NULL); @@ -986,12 +986,12 @@ PROOF static thm prove_finmap_delete_id(void) { CONV_WITH_ASMP_TAC( cases[i], rewrite_conv, - THM_LIST(FINMAP_DELETE_LOOKUP)); + THM_LIST(finmap_delete_lookup)); } return gnode_prove(root); } -PROOF thm FINMAP_DELETE_ID = +PROOF thm finmap_delete_id = prove_finmap_delete_id(); PROOF static thm prove_finmap_decompose(void) { @@ -1010,14 +1010,14 @@ PROOF static thm prove_finmap_decompose(void) { `key:K`, `v:V`, `m:(K,V)finmap`), - FINMAP_INSERT_DELETE); + finmap_insert_delete); thm insert_existing = mp_rule( ispecl_rule( TERM_LIST( `key:K`, `v:V`, `m:(K,V)finmap`), - FINMAP_INSERT_ID), + finmap_insert_id), assume_rule(` finmap_lookup (m:(K,V)finmap) (key:K) == SOME (v:V) `)); @@ -1027,7 +1027,7 @@ PROOF static thm prove_finmap_decompose(void) { return gnode_prove(root); } -PROOF thm FINMAP_DECOMPOSE = +PROOF thm finmap_decompose = prove_finmap_decompose(); PROOF thm finmap_dom_def = new_fun_definition(` @@ -1049,7 +1049,7 @@ PROOF static thm prove_finmap_dom_finite(void) { finmap_lookup_def))); thm finite = ispec_rule( `m:(K,V)finmap`, - FINMAP_REP_FINITE); + finmap_rep_finite); finite = rewrite_rule( THM_LIST(finmap_finite_def), finite); @@ -1057,7 +1057,7 @@ PROOF static thm prove_finmap_dom_finite(void) { return gnode_prove(root); } -PROOF thm FINMAP_DOM_FINITE = +PROOF thm finmap_dom_finite = prove_finmap_dom_finite(); PROOF static thm prove_finmap_dom_empty(void) { @@ -1069,12 +1069,12 @@ PROOF static thm prove_finmap_dom_empty(void) { root, rewrite_conv(THM_LIST( finmap_dom_def, - FINMAP_EMPTY_LOOKUP, + finmap_empty_lookup, get_theorem_by_name("EMPTY_GSPEC")))); return gnode_prove(root); } -PROOF thm FINMAP_DOM_EMPTY = +PROOF thm finmap_dom_empty = prove_finmap_dom_empty(); PROOF static thm prove_finmap_dom_singleton(void) { @@ -1085,15 +1085,15 @@ PROOF static thm prove_finmap_dom_singleton(void) { gnode root = gnode_new_with_ccl(goal_tm); thm_list rules = THM_LIST( finmap_dom_def, - FINMAP_SINGLETON_LOOKUP, - FINMAP_SINGLETON_SUPPORT); + finmap_singleton_lookup, + finmap_singleton_support); conv normalize = rewrite_conv(rules); CONV_TAC(root, normalize); thm result = gnode_prove(root); return result; } -PROOF thm FINMAP_DOM_SINGLETON = +PROOF thm finmap_dom_singleton = prove_finmap_dom_singleton(); PROOF static thm prove_finmap_in_dom(void) { @@ -1111,7 +1111,7 @@ PROOF static thm prove_finmap_in_dom(void) { return gnode_prove(root); } -PROOF thm FINMAP_IN_DOM = +PROOF thm finmap_in_dom = prove_finmap_in_dom(); PROOF static thm prove_finmap_in_dom_some(void) { @@ -1137,7 +1137,7 @@ PROOF static thm prove_finmap_in_dom_some(void) { TERM_LIST( `key:K`, `m:(K,V)finmap`), - FINMAP_IN_DOM), + finmap_in_dom), assume_rule(` (key:K) IN finmap_dom (m:(K,V)finmap) `)); @@ -1187,12 +1187,12 @@ PROOF static thm prove_finmap_in_dom_some(void) { TERM_LIST( `key:K`, `m:(K,V)finmap`), - FINMAP_IN_DOM)), + finmap_in_dom)), payload_non_none)); return gnode_prove(root); } -PROOF thm FINMAP_IN_DOM_SOME = +PROOF thm finmap_in_dom_some = prove_finmap_in_dom_some(); PROOF static thm prove_finmap_not_in_dom(void) { @@ -1205,12 +1205,12 @@ PROOF static thm prove_finmap_not_in_dom(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - FINMAP_IN_DOM, + finmap_in_dom, get_theorem_by_name("NOT_CLAUSES")))); return gnode_prove(root); } -PROOF thm FINMAP_NOT_IN_DOM = +PROOF thm finmap_not_in_dom = prove_finmap_not_in_dom(); /* Every infinite set has an element outside a finite forbidden set. Keep @@ -1251,7 +1251,7 @@ PROOF static thm prove_finmap_infinite_avoid(void) { return gnode_prove(root); } -PROOF static thm FINMAP_INFINITE_AVOID = +PROOF static thm finmap_infinite_avoid = prove_finmap_infinite_avoid(); PROOF static thm prove_finmap_fresh_in(void) { @@ -1270,19 +1270,19 @@ PROOF static thm prove_finmap_fresh_in(void) { TERM_LIST( `candidates:K->bool`, `finmap_dom (m:(K,V)finmap)`), - FINMAP_INFINITE_AVOID), + finmap_infinite_avoid), assume_rule(`INFINITE (candidates:K->bool)`)), ispec_rule( `m:(K,V)finmap`, - FINMAP_DOM_FINITE)); + finmap_dom_finite)); fresh = rewrite_rule( - THM_LIST(FINMAP_NOT_IN_DOM), + THM_LIST(finmap_not_in_dom), fresh); ACCEPT_TAC(body, fresh); return gnode_prove(root); } -PROOF thm FINMAP_FRESH_IN = +PROOF thm finmap_fresh_in = prove_finmap_fresh_in(); PROOF static thm prove_finmap_fresh_in_pair(void) { @@ -1312,28 +1312,28 @@ PROOF static thm prove_finmap_fresh_in_pair(void) { conj_rule( ispec_rule( `m:(K,V)finmap`, - FINMAP_DOM_FINITE), + finmap_dom_finite), ispec_rule( `n:(K,W)finmap`, - FINMAP_DOM_FINITE))); + finmap_dom_finite))); thm fresh = mp_rule( mp_rule( ispecl_rule( TERM_LIST(`candidates:K->bool`, forbidden), - FINMAP_INFINITE_AVOID), + finmap_infinite_avoid), assume_rule(`INFINITE (candidates:K->bool)`)), forbidden_finite); fresh = rewrite_rule( THM_LIST( get_theorem_by_name("IN_UNION"), get_theorem_by_name("DE_MORGAN_THM"), - FINMAP_NOT_IN_DOM), + finmap_not_in_dom), fresh); ACCEPT_TAC(body, fresh); return gnode_prove(root); } -PROOF thm FINMAP_FRESH_IN_PAIR = +PROOF thm finmap_fresh_in_pair = prove_finmap_fresh_in_pair(); PROOF static thm prove_finmap_fresh(void) { @@ -1350,7 +1350,7 @@ PROOF static thm prove_finmap_fresh(void) { TERM_LIST( `UNIV:K->bool`, `m:(K,V)finmap`), - FINMAP_FRESH_IN), + finmap_fresh_in), assume_rule(`INFINITE (UNIV:K->bool)`)); fresh = rewrite_rule( THM_LIST( @@ -1361,7 +1361,7 @@ PROOF static thm prove_finmap_fresh(void) { return gnode_prove(root); } -PROOF thm FINMAP_FRESH = +PROOF thm finmap_fresh = prove_finmap_fresh(); PROOF static thm prove_finmap_fresh_pair(void) { @@ -1382,7 +1382,7 @@ PROOF static thm prove_finmap_fresh_pair(void) { `UNIV:K->bool`, `m:(K,V)finmap`, `n:(K,W)finmap`), - FINMAP_FRESH_IN_PAIR), + finmap_fresh_in_pair), assume_rule(`INFINITE (UNIV:K->bool)`)); fresh = rewrite_rule( THM_LIST( @@ -1393,7 +1393,7 @@ PROOF static thm prove_finmap_fresh_pair(void) { return gnode_prove(root); } -PROOF thm FINMAP_FRESH_PAIR = +PROOF thm finmap_fresh_pair = prove_finmap_fresh_pair(); PROOF static thm prove_finmap_dom_eq_empty(void) { @@ -1409,11 +1409,11 @@ PROOF static thm prove_finmap_dom_eq_empty(void) { gnode forward = DISCH_TAC(directions[0], "Hdom"); forward = CONV_TAC( forward, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); forward = GEN_TAC(forward, "key"); forward = CONV_TAC( forward, - once_rewrite_conv(THM_LIST(FINMAP_EMPTY_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_empty_lookup))); thm not_in_empty = ispec_rule( `key:K`, get_theorem_by_name("NOT_IN_EMPTY")); @@ -1429,7 +1429,7 @@ PROOF static thm prove_finmap_dom_eq_empty(void) { TERM_LIST( `key:K`, `m:(K,V)finmap`), - FINMAP_NOT_IN_DOM), + finmap_not_in_dom), not_in_dom)); gnode reverse = DISCH_TAC(directions[1], "Hmap"); @@ -1439,13 +1439,13 @@ PROOF static thm prove_finmap_dom_eq_empty(void) { (m:(K,V)finmap) == finmap_empty `)); domains_equal = rewrite_rule( - THM_LIST(FINMAP_DOM_EMPTY), + THM_LIST(finmap_dom_empty), domains_equal); ACCEPT_TAC(reverse, domains_equal); return gnode_prove(root); } -PROOF thm FINMAP_DOM_EQ_EMPTY = +PROOF thm finmap_dom_eq_empty = prove_finmap_dom_eq_empty(); PROOF static thm prove_finmap_dom_insert(void) { @@ -1471,15 +1471,15 @@ PROOF static thm prove_finmap_dom_insert(void) { cases[i], rewrite_conv, THM_LIST( - FINMAP_IN_DOM, - FINMAP_INSERT_LOOKUP, + finmap_in_dom, + finmap_insert_lookup, get_theorem_by_name("IN_INSERT"), get_theorem_by_name("option_DISTINCT"))); } return gnode_prove(root); } -PROOF thm FINMAP_DOM_INSERT = +PROOF thm finmap_dom_insert = prove_finmap_dom_insert(); PROOF static thm prove_finmap_dom_delete(void) { @@ -1504,14 +1504,14 @@ PROOF static thm prove_finmap_dom_delete(void) { cases[i], rewrite_conv, THM_LIST( - FINMAP_IN_DOM, - FINMAP_DELETE_LOOKUP, + finmap_in_dom, + finmap_delete_lookup, get_theorem_by_name("IN_DELETE"))); } return gnode_prove(root); } -PROOF thm FINMAP_DOM_DELETE = +PROOF thm finmap_dom_delete = prove_finmap_dom_delete(); PROOF static thm prove_finmap_induct(void) { @@ -1555,7 +1555,7 @@ PROOF static thm prove_finmap_induct(void) { all_finite_domains), ispec_rule( `m:(K,V)finmap`, - FINMAP_DOM_FINITE)); + finmap_dom_finite)); current_domain_case = beta_rule(current_domain_case); thm current_map_case = mp_rule( ispec_rule( @@ -1574,7 +1574,7 @@ PROOF static thm prove_finmap_induct(void) { thm map_is_empty = eq_mp_rule( ispec_rule( `n:(K,V)finmap`, - FINMAP_DOM_EQ_EMPTY), + finmap_dom_eq_empty), assume_rule(` finmap_dom (n:(K,V)finmap) == {} `)); @@ -1620,7 +1620,7 @@ PROOF static thm prove_finmap_induct(void) { TERM_LIST( `key:K`, `n:(K,V)finmap`), - FINMAP_IN_DOM_SOME), + finmap_in_dom_some), in_domain); insert_case = ASSUME_TAC( insert_case, payload_exists, "Hpayload"); @@ -1631,7 +1631,7 @@ PROOF static thm prove_finmap_induct(void) { TERM_LIST( `key:K`, `n:(K,V)finmap`), - FINMAP_DOM_DELETE); + finmap_dom_delete); thm delete_domain_congruence = beta_rule(ap_term_rule( `\d:K->bool. d DELETE (key:K)`, assume_rule(` @@ -1692,7 +1692,7 @@ PROOF static thm prove_finmap_induct(void) { TERM_LIST( `key:K`, `n:(K,V)finmap`), - FINMAP_DELETE_LOOKUP_EQ)), + finmap_delete_lookup_eq)), smaller_property); thm restored_map = mp_rule( ispecl_rule( @@ -1700,7 +1700,7 @@ PROOF static thm prove_finmap_induct(void) { `key:K`, `v:V`, `n:(K,V)finmap`), - FINMAP_DECOMPOSE), + finmap_decompose), assume_rule(` finmap_lookup (n:(K,V)finmap) (key:K) == SOME (v:V) `)); @@ -1714,63 +1714,63 @@ PROOF static thm prove_finmap_induct(void) { return gnode_prove(root); } -PROOF thm FINMAP_INDUCT = +PROOF thm finmap_induct = prove_finmap_induct(); PROOF static int audit_finmap(void) { thm_list public_theorems = THM_LIST( finmap_finite_def, - FINMAP_TYPE_BIJECTION, - FINMAP_REP_FINITE, - FINMAP_EQ, + finmap_type_bijection, + finmap_rep_finite, + finmap_eq, finmap_empty_def, finmap_lookup_def, finmap_singleton_def, finmap_insert_def, finmap_delete_def, finmap_dom_def, - FINMAP_EMPTY_REP, - FINMAP_EMPTY_LOOKUP, - FINMAP_SINGLETON_SUPPORT, - FINMAP_SINGLETON_REP, - FINMAP_SINGLETON_LOOKUP, - FINMAP_INSERT_SUPPORT, - FINMAP_INSERT_REP, - FINMAP_INSERT_LOOKUP, - FINMAP_INSERT_LOOKUP_EQ, - FINMAP_INSERT_LOOKUP_NE, - FINMAP_DELETE_SUPPORT, - FINMAP_DELETE_REP, - FINMAP_DELETE_LOOKUP, - FINMAP_DELETE_LOOKUP_EQ, - FINMAP_DELETE_LOOKUP_NE, - FINMAP_EQ_LOOKUP, - FINMAP_INSERT_EMPTY, - FINMAP_DELETE_EMPTY, - FINMAP_INSERT_OVERWRITE, - FINMAP_INSERT_COMM, - FINMAP_DELETE_IDEMPOTENT, - FINMAP_DELETE_COMM, - FINMAP_DELETE_INSERT, - FINMAP_DELETE_INSERT_NE, - FINMAP_INSERT_DELETE, - FINMAP_INSERT_ID, - FINMAP_DELETE_ID, - FINMAP_DECOMPOSE, - FINMAP_DOM_FINITE, - FINMAP_DOM_EMPTY, - FINMAP_DOM_SINGLETON, - FINMAP_IN_DOM, - FINMAP_IN_DOM_SOME, - FINMAP_NOT_IN_DOM, - FINMAP_FRESH_IN, - FINMAP_FRESH_IN_PAIR, - FINMAP_FRESH, - FINMAP_FRESH_PAIR, - FINMAP_DOM_EQ_EMPTY, - FINMAP_DOM_INSERT, - FINMAP_DOM_DELETE, - FINMAP_INDUCT); + finmap_empty_rep, + finmap_empty_lookup, + finmap_singleton_support, + finmap_singleton_rep, + finmap_singleton_lookup, + finmap_insert_support, + finmap_insert_rep, + finmap_insert_lookup, + finmap_insert_lookup_eq, + finmap_insert_lookup_ne, + finmap_delete_support, + finmap_delete_rep, + finmap_delete_lookup, + finmap_delete_lookup_eq, + finmap_delete_lookup_ne, + finmap_eq_lookup, + finmap_insert_empty, + finmap_delete_empty, + finmap_insert_overwrite, + finmap_insert_comm, + finmap_delete_idempotent, + finmap_delete_comm, + finmap_delete_insert, + finmap_delete_insert_ne, + finmap_insert_delete, + finmap_insert_id, + finmap_delete_id, + finmap_decompose, + finmap_dom_finite, + finmap_dom_empty, + finmap_dom_singleton, + finmap_in_dom, + finmap_in_dom_some, + finmap_not_in_dom, + finmap_fresh_in, + finmap_fresh_in_pair, + finmap_fresh, + finmap_fresh_pair, + finmap_dom_eq_empty, + finmap_dom_insert, + finmap_dom_delete, + finmap_induct); for (size_t i = 0; i < vector_size(public_theorems); ++i) { ENSURE_COND(!IS_NULL(public_theorems[i]), diff --git a/theory/logic/finmap.h b/theory/logic/finmap.h index 620fec1..b75f1ca 100644 --- a/theory/logic/finmap.h +++ b/theory/logic/finmap.h @@ -40,16 +40,16 @@ PROOF extern thm finmap_finite_def; * finmap_finite f <=> * finmap_rep (finmap_abs f) == f) */ -PROOF extern thm FINMAP_TYPE_BIJECTION; +PROOF extern thm finmap_type_bijection; /* `forall m:(K,V)finmap. finmap_finite (finmap_rep m)`. */ -PROOF extern thm FINMAP_REP_FINITE; +PROOF extern thm finmap_rep_finite; /* * forall (m:(K,V)finmap) (n:(K,V)finmap). * m == n <=> finmap_rep m == finmap_rep n */ -PROOF extern thm FINMAP_EQ; +PROOF extern thm finmap_eq; /* ------------------------------------------------------------------------- */ /* Constructors and observations */ @@ -101,38 +101,38 @@ PROOF extern thm finmap_dom_def; /* ------------------------------------------------------------------------- */ /* `finmap_rep (finmap_empty:(K,V)finmap) == (\k:K. NONE)`. */ -PROOF extern thm FINMAP_EMPTY_REP; +PROOF extern thm finmap_empty_rep; /* `forall k:K. finmap_lookup (finmap_empty:(K,V)finmap) k == NONE`. */ -PROOF extern thm FINMAP_EMPTY_LOOKUP; +PROOF extern thm finmap_empty_lookup; /* * forall (key:K) (v:V). * {k:K | ~((if k == key then SOME v else NONE) == NONE)} == * {key} */ -PROOF extern thm FINMAP_SINGLETON_SUPPORT; +PROOF extern thm finmap_singleton_support; /* * forall (key:K) (v:V). * finmap_rep (finmap_singleton key v) == * (\k:K. if k == key then SOME v else NONE) */ -PROOF extern thm FINMAP_SINGLETON_REP; +PROOF extern thm finmap_singleton_rep; /* * forall (key:K) (v:V) (k:K). * finmap_lookup (finmap_singleton key v) k == * if k == key then SOME v else NONE */ -PROOF extern thm FINMAP_SINGLETON_LOOKUP; +PROOF extern thm finmap_singleton_lookup; /* * forall (key:K) (v:V) (f:K->V option). * {k:K | ~((if k == key then SOME v else f k) == NONE)} == * key INSERT {k:K | ~(f k == NONE)} */ -PROOF extern thm FINMAP_INSERT_SUPPORT; +PROOF extern thm finmap_insert_support; /* * forall (key:K) (v:V) (m:(K,V)finmap). @@ -140,7 +140,7 @@ PROOF extern thm FINMAP_INSERT_SUPPORT; * (\k:K. * if k == key then SOME v else finmap_rep m k) */ -PROOF extern thm FINMAP_INSERT_REP; +PROOF extern thm finmap_insert_rep; /* * forall @@ -151,13 +151,13 @@ PROOF extern thm FINMAP_INSERT_REP; * finmap_lookup (finmap_insert key v m) k == * if k == key then SOME v else finmap_lookup m k */ -PROOF extern thm FINMAP_INSERT_LOOKUP; +PROOF extern thm finmap_insert_lookup; /* * forall (key:K) (v:V) (m:(K,V)finmap). * finmap_lookup (finmap_insert key v m) key == SOME v */ -PROOF extern thm FINMAP_INSERT_LOOKUP_EQ; +PROOF extern thm finmap_insert_lookup_eq; /* * forall @@ -168,48 +168,48 @@ PROOF extern thm FINMAP_INSERT_LOOKUP_EQ; * ~(k == key) ==> * finmap_lookup (finmap_insert key v m) k == finmap_lookup m k */ -PROOF extern thm FINMAP_INSERT_LOOKUP_NE; +PROOF extern thm finmap_insert_lookup_ne; /* * forall (key:K) (f:K->V option). * {k:K | ~((if k == key then NONE else f k) == NONE)} == * {k:K | ~(f k == NONE)} DELETE key */ -PROOF extern thm FINMAP_DELETE_SUPPORT; +PROOF extern thm finmap_delete_support; /* * forall (key:K) (m:(K,V)finmap). * finmap_rep (finmap_delete key m) == * (\k:K. if k == key then NONE else finmap_rep m k) */ -PROOF extern thm FINMAP_DELETE_REP; +PROOF extern thm finmap_delete_rep; /* * forall (key:K) (m:(K,V)finmap) (k:K). * finmap_lookup (finmap_delete key m) k == * if k == key then NONE else finmap_lookup m k */ -PROOF extern thm FINMAP_DELETE_LOOKUP; +PROOF extern thm finmap_delete_lookup; /* * forall (key:K) (m:(K,V)finmap). * finmap_lookup (finmap_delete key m) key == NONE */ -PROOF extern thm FINMAP_DELETE_LOOKUP_EQ; +PROOF extern thm finmap_delete_lookup_eq; /* * forall (key:K) (m:(K,V)finmap) (k:K). * ~(k == key) ==> * finmap_lookup (finmap_delete key m) k == finmap_lookup m k */ -PROOF extern thm FINMAP_DELETE_LOOKUP_NE; +PROOF extern thm finmap_delete_lookup_ne; /* * forall (m:(K,V)finmap) (n:(K,V)finmap). * m == n <=> * forall k:K. finmap_lookup m k == finmap_lookup n k */ -PROOF extern thm FINMAP_EQ_LOOKUP; +PROOF extern thm finmap_eq_lookup; /* ------------------------------------------------------------------------- */ /* Laws: insertion and deletion */ @@ -220,13 +220,13 @@ PROOF extern thm FINMAP_EQ_LOOKUP; * finmap_insert key v (finmap_empty:(K,V)finmap) == * finmap_singleton key v */ -PROOF extern thm FINMAP_INSERT_EMPTY; +PROOF extern thm finmap_insert_empty; /* * forall key:K. * finmap_delete key (finmap_empty:(K,V)finmap) == finmap_empty */ -PROOF extern thm FINMAP_DELETE_EMPTY; +PROOF extern thm finmap_delete_empty; /* * forall @@ -237,7 +237,7 @@ PROOF extern thm FINMAP_DELETE_EMPTY; * finmap_insert key v (finmap_insert key w m) == * finmap_insert key v m */ -PROOF extern thm FINMAP_INSERT_OVERWRITE; +PROOF extern thm finmap_insert_overwrite; /* * forall @@ -250,26 +250,26 @@ PROOF extern thm FINMAP_INSERT_OVERWRITE; * finmap_insert key1 v1 (finmap_insert key2 v2 m) == * finmap_insert key2 v2 (finmap_insert key1 v1 m) */ -PROOF extern thm FINMAP_INSERT_COMM; +PROOF extern thm finmap_insert_comm; /* * forall (key:K) (m:(K,V)finmap). * finmap_delete key (finmap_delete key m) == finmap_delete key m */ -PROOF extern thm FINMAP_DELETE_IDEMPOTENT; +PROOF extern thm finmap_delete_idempotent; /* * forall (key1:K) (key2:K) (m:(K,V)finmap). * finmap_delete key1 (finmap_delete key2 m) == * finmap_delete key2 (finmap_delete key1 m) */ -PROOF extern thm FINMAP_DELETE_COMM; +PROOF extern thm finmap_delete_comm; /* * forall (key:K) (v:V) (m:(K,V)finmap). * finmap_delete key (finmap_insert key v m) == finmap_delete key m */ -PROOF extern thm FINMAP_DELETE_INSERT; +PROOF extern thm finmap_delete_insert; /* * Deletion commutes with insertion at a different key: @@ -283,70 +283,70 @@ PROOF extern thm FINMAP_DELETE_INSERT; * finmap_delete deleted (finmap_insert inserted v m) == * finmap_insert inserted v (finmap_delete deleted m) */ -PROOF extern thm FINMAP_DELETE_INSERT_NE; +PROOF extern thm finmap_delete_insert_ne; /* * forall (key:K) (v:V) (m:(K,V)finmap). * finmap_insert key v (finmap_delete key m) == * finmap_insert key v m */ -PROOF extern thm FINMAP_INSERT_DELETE; +PROOF extern thm finmap_insert_delete; /* * forall (key:K) (v:V) (m:(K,V)finmap). * finmap_lookup m key == SOME v ==> * finmap_insert key v m == m */ -PROOF extern thm FINMAP_INSERT_ID; +PROOF extern thm finmap_insert_id; /* * forall (key:K) (m:(K,V)finmap). * finmap_lookup m key == NONE ==> * finmap_delete key m == m */ -PROOF extern thm FINMAP_DELETE_ID; +PROOF extern thm finmap_delete_id; /* * forall (key:K) (v:V) (m:(K,V)finmap). * finmap_lookup m key == SOME v ==> * finmap_insert key v (finmap_delete key m) == m */ -PROOF extern thm FINMAP_DECOMPOSE; +PROOF extern thm finmap_decompose; /* ------------------------------------------------------------------------- */ /* Laws: finite domain */ /* ------------------------------------------------------------------------- */ /* `forall m:(K,V)finmap. FINITE (finmap_dom m)`. */ -PROOF extern thm FINMAP_DOM_FINITE; +PROOF extern thm finmap_dom_finite; /* `finmap_dom (finmap_empty:(K,V)finmap) == {}`. */ -PROOF extern thm FINMAP_DOM_EMPTY; +PROOF extern thm finmap_dom_empty; /* * forall (key:K) (v:V). * finmap_dom (finmap_singleton key v) == {key} */ -PROOF extern thm FINMAP_DOM_SINGLETON; +PROOF extern thm finmap_dom_singleton; /* * forall (key:K) (m:(K,V)finmap). * key IN finmap_dom m <=> ~(finmap_lookup m key == NONE) */ -PROOF extern thm FINMAP_IN_DOM; +PROOF extern thm finmap_in_dom; /* * forall (key:K) (m:(K,V)finmap). * key IN finmap_dom m <=> * exists v:V. finmap_lookup m key == SOME v */ -PROOF extern thm FINMAP_IN_DOM_SOME; +PROOF extern thm finmap_in_dom_some; /* * forall (key:K) (m:(K,V)finmap). * ~(key IN finmap_dom m) <=> finmap_lookup m key == NONE */ -PROOF extern thm FINMAP_NOT_IN_DOM; +PROOF extern thm finmap_not_in_dom; /* * An infinite candidate set contains a key outside any one finite map: @@ -357,7 +357,7 @@ PROOF extern thm FINMAP_NOT_IN_DOM; * key IN candidates && * finmap_lookup m key == NONE */ -PROOF extern thm FINMAP_FRESH_IN; +PROOF extern thm finmap_fresh_in; /* * An infinite candidate set contains a key outside two finite maps at once: @@ -372,7 +372,7 @@ PROOF extern thm FINMAP_FRESH_IN; * finmap_lookup m key == NONE && * finmap_lookup n key == NONE */ -PROOF extern thm FINMAP_FRESH_IN_PAIR; +PROOF extern thm finmap_fresh_in_pair; /* * If the key type is infinite, every finite map has a fresh key: @@ -382,7 +382,7 @@ PROOF extern thm FINMAP_FRESH_IN_PAIR; * exists key:K. * finmap_lookup m key == NONE */ -PROOF extern thm FINMAP_FRESH; +PROOF extern thm finmap_fresh; /* * If the key type is infinite, two finite maps have a common fresh key: @@ -395,26 +395,26 @@ PROOF extern thm FINMAP_FRESH; * finmap_lookup m key == NONE && * finmap_lookup n key == NONE */ -PROOF extern thm FINMAP_FRESH_PAIR; +PROOF extern thm finmap_fresh_pair; /* * forall m:(K,V)finmap. * finmap_dom m == {} <=> m == finmap_empty */ -PROOF extern thm FINMAP_DOM_EQ_EMPTY; +PROOF extern thm finmap_dom_eq_empty; /* * forall (key:K) (v:V) (m:(K,V)finmap). * finmap_dom (finmap_insert key v m) == * key INSERT finmap_dom m */ -PROOF extern thm FINMAP_DOM_INSERT; +PROOF extern thm finmap_dom_insert; /* * forall (key:K) (m:(K,V)finmap). * finmap_dom (finmap_delete key m) == finmap_dom m DELETE key */ -PROOF extern thm FINMAP_DOM_DELETE; +PROOF extern thm finmap_dom_delete; /* ------------------------------------------------------------------------- */ /* Induction */ @@ -434,4 +434,4 @@ PROOF extern thm FINMAP_DOM_DELETE; * P (finmap_insert key v m)) ==> * forall m:(K,V)finmap. P m */ -PROOF extern thm FINMAP_INDUCT; +PROOF extern thm finmap_induct; diff --git a/theory/logic/frac_ra.c b/theory/logic/frac_ra.c index 3f45028..bff98f5 100644 --- a/theory/logic/frac_ra.c +++ b/theory/logic/frac_ra.c @@ -21,15 +21,15 @@ PROOF static thm prove_frac_weight_rep_exists(void) { return gnode_prove(root); } -PROOF static thm FRAC_WEIGHT_REP_EXISTS = +PROOF static thm frac_weight_rep_exists = prove_frac_weight_rep_exists(); -PROOF static thm FRAC_WEIGHT_TYPE_BIJECTION = +PROOF static thm frac_weight_type_bijection = new_type_bijection_definition( "frac_weight", "frac_weight_abs", "frac_weight_rep", - FRAC_WEIGHT_REP_EXISTS); + frac_weight_rep_exists); PROOF static thm frac_weight_value_def = new_fun_definition(` @@ -63,11 +63,11 @@ PROOF static thm prove_frac_weight_value_pos(void) { body, rewrite_conv(THM_LIST( frac_weight_value_def, - FRAC_WEIGHT_TYPE_BIJECTION))); + frac_weight_type_bijection))); return gnode_prove(root); } -PROOF static thm FRAC_WEIGHT_VALUE_POS = +PROOF static thm frac_weight_value_pos = prove_frac_weight_value_pos(); PROOF static thm prove_frac_weight_of_real_value(void) { @@ -80,7 +80,7 @@ PROOF static thm prove_frac_weight_of_real_value(void) { gnode body = AUTO_INTROS_TAC(root); thm inverse = spec_rule( `p:real`, - conjunct2_rule(FRAC_WEIGHT_TYPE_BIJECTION)); + conjunct2_rule(frac_weight_type_bijection)); thm represented = eq_mp_rule( inverse, assume_rule(`&0 < (p:real)`)); @@ -100,7 +100,7 @@ PROOF static thm prove_frac_weight_of_real_value(void) { return gnode_prove(root); } -PROOF static thm FRAC_WEIGHT_OF_REAL_VALUE = +PROOF static thm frac_weight_of_real_value = prove_frac_weight_of_real_value(); PROOF static thm prove_frac_weight_add_value(void) { @@ -117,10 +117,10 @@ PROOF static thm prove_frac_weight_add_value(void) { thm q_pos = ispec_rule( `q:frac_weight`, - FRAC_WEIGHT_VALUE_POS); + frac_weight_value_pos); thm r_pos = ispec_rule( `r:frac_weight`, - FRAC_WEIGHT_VALUE_POS); + frac_weight_value_pos); thm sum_pos = mp_rule( ispecl_rule( TERM_LIST( @@ -134,12 +134,12 @@ PROOF static thm prove_frac_weight_add_value(void) { ispec_rule( `frac_weight_value (q:frac_weight) + frac_weight_value (r:frac_weight)`, - FRAC_WEIGHT_OF_REAL_VALUE), + frac_weight_of_real_value), sum_pos)); return gnode_prove(root); } -PROOF static thm FRAC_WEIGHT_ADD_VALUE = +PROOF static thm frac_weight_add_value = prove_frac_weight_add_value(); PROOF static thm prove_frac_weight_eq(void) { @@ -171,13 +171,13 @@ PROOF static thm prove_frac_weight_eq(void) { rep_eq); abs_eq = rewrite_rule( THM_LIST(conjunct1_rule( - FRAC_WEIGHT_TYPE_BIJECTION)), + frac_weight_type_bijection)), abs_eq); ACCEPT_TAC(reverse, abs_eq); return gnode_prove(root); } -PROOF static thm FRAC_WEIGHT_EQ = +PROOF static thm frac_weight_eq = prove_frac_weight_eq(); PROOF static thm prove_frac_weight_add_assoc(void) { @@ -203,16 +203,16 @@ PROOF static thm prove_frac_weight_add_assoc(void) { (frac_weight_add (r:frac_weight) (s:frac_weight))`), - FRAC_WEIGHT_EQ)))); + frac_weight_eq)))); CONV_TAC( body, rewrite_conv(THM_LIST( - FRAC_WEIGHT_ADD_VALUE, + frac_weight_add_value, get_theorem_by_name("REAL_ADD_ASSOC")))); return gnode_prove(root); } -PROOF static thm FRAC_WEIGHT_ADD_ASSOC = +PROOF static thm frac_weight_add_assoc = prove_frac_weight_add_assoc(); PROOF static thm prove_frac_weight_add_comm(void) { @@ -233,16 +233,16 @@ PROOF static thm prove_frac_weight_add_comm(void) { `frac_weight_add (r:frac_weight) (q:frac_weight)`), - FRAC_WEIGHT_EQ)))); + frac_weight_eq)))); CONV_TAC( body, rewrite_conv(THM_LIST( - FRAC_WEIGHT_ADD_VALUE, + frac_weight_add_value, get_theorem_by_name("REAL_ADD_SYM")))); return gnode_prove(root); } -PROOF static thm FRAC_WEIGHT_ADD_COMM = +PROOF static thm frac_weight_add_comm = prove_frac_weight_add_comm(); PROOF static thm prove_frac_weight_add_le_left(void) { @@ -258,7 +258,7 @@ PROOF static thm prove_frac_weight_add_le_left(void) { TERM_LIST( `q:frac_weight`, `r:frac_weight`), - FRAC_WEIGHT_ADD_VALUE)), + frac_weight_add_value)), assume_rule(` frac_weight_value (frac_weight_add @@ -267,7 +267,7 @@ PROOF static thm prove_frac_weight_add_le_left(void) { `)); thm r_pos = ispec_rule( `r:frac_weight`, - FRAC_WEIGHT_VALUE_POS); + frac_weight_value_pos); thm left_bound = mp_rule( mp_rule( real_arith_rule(` @@ -282,7 +282,7 @@ PROOF static thm prove_frac_weight_add_le_left(void) { return gnode_prove(root); } -PROOF static thm FRAC_WEIGHT_ADD_LE_LEFT = +PROOF static thm frac_weight_add_le_left = prove_frac_weight_add_le_left(); /* ------------------------------------------------------------------------- */ @@ -368,15 +368,15 @@ PROOF static thm prove_frac_op_assoc(void) { THM_LIST( frac_op_def, frac_token_op_def, - FRAC_WEIGHT_ADD_ASSOC, - RA_ASSOC)); + frac_weight_add_assoc, + ra_assoc)); } } } return gnode_prove(root); } -PROOF static thm FRAC_OP_ASSOC = +PROOF static thm frac_op_assoc = prove_frac_op_assoc(); PROOF static thm prove_frac_op_comm(void) { @@ -401,14 +401,14 @@ PROOF static thm prove_frac_op_comm(void) { THM_LIST( frac_op_def, frac_token_op_def, - FRAC_WEIGHT_ADD_COMM, - RA_COMM)); + frac_weight_add_comm, + ra_comm)); } } return gnode_prove(root); } -PROOF static thm FRAC_OP_COMM = +PROOF static thm frac_op_comm = prove_frac_op_comm(); PROOF static thm prove_frac_op_unit_l(void) { @@ -424,7 +424,7 @@ PROOF static thm prove_frac_op_unit_l(void) { return gnode_prove(root); } -PROOF static thm FRAC_OP_UNIT_L = +PROOF static thm frac_op_unit_l = prove_frac_op_unit_l(); PROOF static thm prove_frac_valid_unit(void) { @@ -439,7 +439,7 @@ PROOF static thm prove_frac_valid_unit(void) { return gnode_prove(root); } -PROOF static thm FRAC_VALID_UNIT = +PROOF static thm frac_valid_unit = prove_frac_valid_unit(); PROOF static thm prove_frac_valid_op_l(void) { @@ -497,7 +497,7 @@ PROOF static thm prove_frac_valid_op_l(void) { TERM_LIST( `a0:frac_weight`, `a0_:frac_weight`), - FRAC_WEIGHT_ADD_LE_LEFT), + frac_weight_add_le_left), source_weight); thm target_payload = mp_rule( ispecl_rule( @@ -505,7 +505,7 @@ PROOF static thm prove_frac_valid_op_l(void) { `R:(A)ra`, `a1:A`, `a1_:A`), - RA_VALID_OP_L), + ra_valid_op_l), source_payload); target_components = conj_rule(target_weight, target_payload); @@ -529,7 +529,7 @@ PROOF static thm prove_frac_valid_op_l(void) { return gnode_prove(root); } -PROOF static thm FRAC_VALID_OP_L = +PROOF static thm frac_valid_op_l = prove_frac_valid_op_l(); PROOF static thm prove_frac_ra_laws(void) { @@ -549,29 +549,29 @@ PROOF static thm prove_frac_ra_laws(void) { gnode_list law1 = CONJ_TAC(unfolded); ACCEPT_TAC( law1[0], - spec_rule(`R:(A)ra`, FRAC_OP_ASSOC)); + spec_rule(`R:(A)ra`, frac_op_assoc)); gnode_list law2 = CONJ_TAC(law1[1]); ACCEPT_TAC( law2[0], - spec_rule(`R:(A)ra`, FRAC_OP_COMM)); + spec_rule(`R:(A)ra`, frac_op_comm)); gnode_list law3 = CONJ_TAC(law2[1]); ACCEPT_TAC( law3[0], - spec_rule(`R:(A)ra`, FRAC_OP_UNIT_L)); + spec_rule(`R:(A)ra`, frac_op_unit_l)); gnode_list law4 = CONJ_TAC(law3[1]); ACCEPT_TAC( law4[0], - spec_rule(`R:(A)ra`, FRAC_VALID_UNIT)); + spec_rule(`R:(A)ra`, frac_valid_unit)); ACCEPT_TAC( law4[1], - spec_rule(`R:(A)ra`, FRAC_VALID_OP_L)); + spec_rule(`R:(A)ra`, frac_valid_op_l)); return gnode_prove(root); } -PROOF static thm FRAC_RA_LAWS = +PROOF static thm frac_ra_laws = prove_frac_ra_laws(); PROOF static thm frac_ra_def = new_fun_definition(` @@ -583,14 +583,14 @@ PROOF static thm frac_ra_def = new_fun_definition(` PROOF static thm prove_frac_ra_unit_raw(void) { term R = `R:(A)ra`; - thm laws = ispec_rule(R, FRAC_RA_LAWS); + thm laws = ispec_rule(R, frac_ra_laws); thm computed = mp_rule( ispecl_rule( TERM_LIST( `FracUnit:(A)frac`, `frac_op (R:(A)ra):(A)frac->(A)frac->(A)frac`, `frac_valid (R:(A)ra):(A)frac->bool`), - RA_UNIT_ABS), + ra_unit_abs), laws); computed = pure_once_rewrite_rule( THM_LIST(gsym_rule(frac_ra_def)), @@ -598,19 +598,19 @@ PROOF static thm prove_frac_ra_unit_raw(void) { return gen_rule(R, computed); } -PROOF static thm FRAC_RA_UNIT_RAW = +PROOF static thm frac_ra_unit_raw = prove_frac_ra_unit_raw(); PROOF static thm prove_frac_ra_op_fn(void) { term R = `R:(A)ra`; - thm laws = ispec_rule(R, FRAC_RA_LAWS); + thm laws = ispec_rule(R, frac_ra_laws); thm computed = mp_rule( ispecl_rule( TERM_LIST( `FracUnit:(A)frac`, `frac_op (R:(A)ra):(A)frac->(A)frac->(A)frac`, `frac_valid (R:(A)ra):(A)frac->bool`), - RA_OP_ABS), + ra_op_abs), laws); computed = pure_once_rewrite_rule( THM_LIST(gsym_rule(frac_ra_def)), @@ -618,19 +618,19 @@ PROOF static thm prove_frac_ra_op_fn(void) { return gen_rule(R, computed); } -PROOF static thm FRAC_RA_OP_FN = +PROOF static thm frac_ra_op_fn = prove_frac_ra_op_fn(); PROOF static thm prove_frac_ra_valid_fn(void) { term R = `R:(A)ra`; - thm laws = ispec_rule(R, FRAC_RA_LAWS); + thm laws = ispec_rule(R, frac_ra_laws); thm computed = mp_rule( ispecl_rule( TERM_LIST( `FracUnit:(A)frac`, `frac_op (R:(A)ra):(A)frac->(A)frac->(A)frac`, `frac_valid (R:(A)ra):(A)frac->bool`), - RA_VALID_ABS), + ra_valid_abs), laws); computed = pure_once_rewrite_rule( THM_LIST(gsym_rule(frac_ra_def)), @@ -638,7 +638,7 @@ PROOF static thm prove_frac_ra_valid_fn(void) { return gen_rule(R, computed); } -PROOF static thm FRAC_RA_VALID_FN = +PROOF static thm frac_ra_valid_fn = prove_frac_ra_valid_fn(); /* ------------------------------------------------------------------------- */ @@ -669,12 +669,12 @@ PROOF static thm prove_frac_ra_unit(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - FRAC_RA_UNIT_RAW, + frac_ra_unit_raw, frac_empty_def))); return gnode_prove(root); } -PROOF thm FRAC_RA_UNIT = +PROOF thm frac_ra_unit = prove_frac_ra_unit(); PROOF static thm prove_frac_ra_full(void) { @@ -688,7 +688,7 @@ PROOF static thm prove_frac_ra_full(void) { return eqt_elim_rule(reduced); } -PROOF thm FRAC_RA_FULL = +PROOF thm frac_ra_full = prove_frac_ra_full(); PROOF static thm prove_frac_ra_own_op(void) { @@ -723,16 +723,16 @@ PROOF static thm prove_frac_ra_own_op(void) { thm p_value = mp_rule( ispec_rule( `p:real`, - FRAC_WEIGHT_OF_REAL_VALUE), + frac_weight_of_real_value), assume_rule(`&0 < (p:real)`)); thm q_value = mp_rule( ispec_rule( `q:real`, - FRAC_WEIGHT_OF_REAL_VALUE), + frac_weight_of_real_value), assume_rule(`&0 < (q:real)`)); thm reduced = apply_conversion( rewrite_conv(THM_LIST( - FRAC_RA_OP_FN, + frac_ra_op_fn, frac_op_def, frac_token_op_def, frac_own_def, @@ -744,7 +744,7 @@ PROOF static thm prove_frac_ra_own_op(void) { return gnode_prove(root); } -PROOF thm FRAC_RA_OWN_OP = +PROOF thm frac_ra_own_op = prove_frac_ra_own_op(); PROOF static thm prove_frac_ra_own_inj(void) { @@ -759,23 +759,23 @@ PROOF static thm prove_frac_ra_own_inj(void) { gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); thm p_value = mp_rule( - ispec_rule(`p:real`, FRAC_WEIGHT_OF_REAL_VALUE), + ispec_rule(`p:real`, frac_weight_of_real_value), assume_rule(`&0 < (p:real)`)); thm q_value = mp_rule( - ispec_rule(`q:real`, FRAC_WEIGHT_OF_REAL_VALUE), + ispec_rule(`q:real`, frac_weight_of_real_value), assume_rule(`&0 < (q:real)`)); CONV_TAC( body, rewrite_conv(THM_LIST( frac_own_def, get_datatype_injectivity("frac"), - FRAC_WEIGHT_EQ, + frac_weight_eq, p_value, q_value))); return gnode_prove(root); } -PROOF static thm FRAC_RA_OWN_INJ = +PROOF static thm frac_ra_own_inj = prove_frac_ra_own_inj(); PROOF static thm prove_frac_ra_own_ne_empty(void) { @@ -793,7 +793,7 @@ PROOF static thm prove_frac_ra_own_ne_empty(void) { return gnode_prove(root); } -PROOF static thm FRAC_RA_OWN_NE_EMPTY = +PROOF static thm frac_ra_own_ne_empty = prove_frac_ra_own_ne_empty(); PROOF static thm prove_frac_ra_full_inj(void) { @@ -805,7 +805,7 @@ PROOF static thm prove_frac_ra_full_inj(void) { mp_rule( ispecl_rule( TERM_LIST(`&1:real`, `&1:real`, `a:A`, `b:A`), - FRAC_RA_OWN_INJ), + frac_ra_own_inj), get_theorem_by_name("REAL_LT_01")), get_theorem_by_name("REAL_LT_01")); gnode root = gnode_new_with_ccl(goal_tm); @@ -817,7 +817,7 @@ PROOF static thm prove_frac_ra_full_inj(void) { return gnode_prove(root); } -PROOF static thm FRAC_RA_FULL_INJ = +PROOF static thm frac_ra_full_inj = prove_frac_ra_full_inj(); PROOF static thm prove_frac_ra_full_ne_empty(void) { @@ -830,11 +830,11 @@ PROOF static thm prove_frac_ra_full_ne_empty(void) { root, rewrite_conv(THM_LIST( frac_full_def, - FRAC_RA_OWN_NE_EMPTY))); + frac_ra_own_ne_empty))); return gnode_prove(root); } -PROOF static thm FRAC_RA_FULL_NE_EMPTY = +PROOF static thm frac_ra_full_ne_empty = prove_frac_ra_full_ne_empty(); PROOF static thm prove_frac_ra_valid_empty(void) { @@ -848,13 +848,13 @@ PROOF static thm prove_frac_ra_valid_empty(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - FRAC_RA_VALID_FN, + frac_ra_valid_fn, frac_valid_def, frac_empty_def))); return gnode_prove(root); } -PROOF static thm FRAC_RA_VALID_EMPTY = +PROOF static thm frac_ra_valid_empty = prove_frac_ra_valid_empty(); PROOF static thm prove_frac_ra_valid_own(void) { @@ -871,11 +871,11 @@ PROOF static thm prove_frac_ra_valid_own(void) { thm p_value = mp_rule( ispec_rule( `p:real`, - FRAC_WEIGHT_OF_REAL_VALUE), + frac_weight_of_real_value), assume_rule(`&0 < (p:real)`)); thm reduced = apply_conversion( rewrite_conv(THM_LIST( - FRAC_RA_VALID_FN, + frac_ra_valid_fn, frac_valid_def, frac_own_def, p_value)), @@ -889,7 +889,7 @@ PROOF static thm prove_frac_ra_valid_own(void) { return gnode_prove(root); } -PROOF thm FRAC_RA_VALID_OWN = +PROOF thm frac_ra_valid_own = prove_frac_ra_valid_own(); PROOF static thm prove_frac_ra_valid_full(void) { @@ -908,7 +908,7 @@ PROOF static thm prove_frac_ra_valid_full(void) { `R:(A)ra`, `&1:real`, `a:A`), - FRAC_RA_VALID_OWN), + frac_ra_valid_own), get_theorem_by_name("REAL_LT_01")); owned_valid = rewrite_rule( THM_LIST(get_theorem_by_name("REAL_LE_REFL")), @@ -929,7 +929,7 @@ PROOF static thm prove_frac_ra_valid_full(void) { return gnode_prove(root); } -PROOF static thm FRAC_RA_VALID_FULL = +PROOF static thm frac_ra_valid_full = prove_frac_ra_valid_full(); /* ------------------------------------------------------------------------- */ @@ -947,16 +947,16 @@ PROOF static thm prove_frac_ra_included_empty(void) { TERM_LIST( `frac_ra (R:(A)ra)`, `x:(A)frac`), - RA_INCLUDED_UNIT); + ra_included_unit); ACCEPT_TAC( body, pure_once_rewrite_rule( - THM_LIST(ispec_rule(`R:(A)ra`, FRAC_RA_UNIT)), + THM_LIST(ispec_rule(`R:(A)ra`, frac_ra_unit)), included)); return gnode_prove(root); } -PROOF static thm FRAC_RA_INCLUDED_EMPTY = +PROOF static thm frac_ra_included_empty = prove_frac_ra_included_empty(); PROOF static thm prove_frac_ra_included_own(void) { @@ -979,10 +979,10 @@ PROOF static thm prove_frac_ra_included_own(void) { gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); thm p_value = mp_rule( - ispec_rule(`p:real`, FRAC_WEIGHT_OF_REAL_VALUE), + ispec_rule(`p:real`, frac_weight_of_real_value), assume_rule(`&0 < (p:real)`)); thm q_value = mp_rule( - ispec_rule(`q:real`, FRAC_WEIGHT_OF_REAL_VALUE), + ispec_rule(`q:real`, frac_weight_of_real_value), assume_rule(`&0 < (q:real)`)); gnode_list directions = EQ_TAC(body); @@ -1007,7 +1007,7 @@ PROOF static thm prove_frac_ra_included_own(void) { thm unit_extension = rewrite_rule( THM_LIST( assume_rule(unit_frame_eq_tm), - FRAC_RA_OP_FN, + frac_ra_op_fn, frac_op_def, frac_token_op_def, frac_own_def), @@ -1021,7 +1021,7 @@ PROOF static thm prove_frac_ra_included_own(void) { thm unit_components = rewrite_rule( THM_LIST( get_datatype_injectivity("frac"), - FRAC_WEIGHT_EQ, + frac_weight_eq, p_value, q_value), unit_extension); @@ -1040,7 +1040,7 @@ PROOF static thm prove_frac_ra_included_own(void) { thm owned_components = rewrite_rule( THM_LIST( assume_rule(owned_frame_eq_tm), - FRAC_RA_OP_FN, + frac_ra_op_fn, frac_op_def, frac_token_op_def, frac_own_def, @@ -1057,7 +1057,7 @@ PROOF static thm prove_frac_ra_included_own(void) { conjunct1_rule(owned_components)); owned_weight_value_eq = pure_rewrite_rule( THM_LIST( - FRAC_WEIGHT_ADD_VALUE, + frac_weight_add_value, p_value, q_value), owned_weight_value_eq); @@ -1071,7 +1071,7 @@ PROOF static thm prove_frac_ra_included_own(void) { `), ispec_rule( `a0:frac_weight`, - FRAC_WEIGHT_VALUE_POS)), + frac_weight_value_pos)), owned_weight_value_eq); gnode owned_result = DISJ2_TAC(frame_cases[1]); gnode_list owned_parts = CONJ_TAC(owned_result); @@ -1105,7 +1105,7 @@ PROOF static thm prove_frac_ra_included_own(void) { ispecl_rule( TERM_LIST( `p:real`, `q:real`, `a:A`, `b:A`), - FRAC_RA_OWN_INJ), + frac_ra_own_inj), assume_rule(`&0 < (p:real)`)), assume_rule(`&0 < (q:real)`))), equal_components); @@ -1113,7 +1113,7 @@ PROOF static thm prove_frac_ra_included_own(void) { TERM_LIST( `frac_ra (R:(A)ra)`, `frac_own (p:real) (a:A)`), - RA_INCLUDED_REFL); + ra_included_refl); thm equal_transport = beta_rule(ap_term_rule( `\x:(A)frac. ra_included @@ -1159,7 +1159,7 @@ PROOF static thm prove_frac_ra_included_own(void) { `(q:real) - p`, `a:A`, `base_frame:A`), - FRAC_RA_OWN_OP), + frac_ra_own_op), assume_rule(`&0 < (p:real)`)), delta_pos); thm payload_lift = beta_rule(ap_term_rule( @@ -1189,7 +1189,7 @@ PROOF static thm prove_frac_ra_included_own(void) { return gnode_prove(root); } -PROOF static thm FRAC_RA_INCLUDED_OWN = +PROOF static thm frac_ra_included_own = prove_frac_ra_included_own(); PROOF static thm prove_frac_ra_not_included_own_empty(void) { @@ -1222,7 +1222,7 @@ PROOF static thm prove_frac_ra_not_included_own_empty(void) { thm contradiction = rewrite_rule( THM_LIST( assume_rule(frame_eq_tm), - FRAC_RA_OP_FN, + frac_ra_op_fn, frac_op_def, frac_token_op_def, frac_empty_def, @@ -1240,7 +1240,7 @@ PROOF static thm prove_frac_ra_not_included_own_empty(void) { return gnode_prove(root); } -PROOF static thm FRAC_RA_NOT_INCLUDED_OWN_EMPTY = +PROOF static thm frac_ra_not_included_own_empty = prove_frac_ra_not_included_own_empty(); PROOF static thm prove_frac_ra_included_full(void) { @@ -1263,7 +1263,7 @@ PROOF static thm prove_frac_ra_included_full(void) { `&1:real`, `a:A`, `b:A`), - FRAC_RA_INCLUDED_OWN), + frac_ra_included_own), get_theorem_by_name("REAL_LT_01")), get_theorem_by_name("REAL_LT_01")); CONV_TAC( @@ -1275,7 +1275,7 @@ PROOF static thm prove_frac_ra_included_full(void) { return gnode_prove(root); } -PROOF static thm FRAC_RA_INCLUDED_FULL = +PROOF static thm frac_ra_included_full = prove_frac_ra_included_full(); /* ------------------------------------------------------------------------- */ @@ -1305,7 +1305,7 @@ PROOF static thm prove_frac_ra_exclusive_full(void) { thm full_valid = eq_mp_rule( gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), - FRAC_RA_VALID_FULL)), + frac_ra_valid_full)), assume_rule(`ra_valid (R:(A)ra) (a:A)`)); ACCEPT_TAC(exclusive_parts[0], full_valid); @@ -1318,7 +1318,7 @@ PROOF static thm prove_frac_ra_exclusive_full(void) { `); thm ra_unit_is_unit = spec_rule( `R:(A)ra`, - FRAC_RA_UNIT_RAW); + frac_ra_unit_raw); ACCEPT_TAC( frame_cases[0], trans_rule( @@ -1328,21 +1328,21 @@ PROOF static thm prove_frac_ra_exclusive_full(void) { thm one_value = mp_rule( ispec_rule( `&1:real`, - FRAC_WEIGHT_OF_REAL_VALUE), + frac_weight_of_real_value), get_theorem_by_name("REAL_LT_01")); thm source_valid = rewrite_rule( THM_LIST( assume_rule(` (frame:(A)frac) == Frac a0 a1 `), - FRAC_RA_OP_FN, - FRAC_RA_VALID_FN, + frac_ra_op_fn, + frac_ra_valid_fn, frac_op_def, frac_token_op_def, frac_valid_def, frac_full_def, frac_own_def, - FRAC_WEIGHT_ADD_VALUE, + frac_weight_add_value, one_value), assume_rule(` ra_valid @@ -1354,7 +1354,7 @@ PROOF static thm prove_frac_ra_exclusive_full(void) { `)); thm frame_pos = ispec_rule( `a0:frac_weight`, - FRAC_WEIGHT_VALUE_POS); + frac_weight_value_pos); thm impossible = mp_rule( mp_rule( real_arith_rule(` @@ -1368,7 +1368,7 @@ PROOF static thm prove_frac_ra_exclusive_full(void) { return gnode_prove(root); } -PROOF thm FRAC_RA_EXCLUSIVE_FULL = +PROOF thm frac_ra_exclusive_full = prove_frac_ra_exclusive_full(); /* ------------------------------------------------------------------------- */ @@ -1416,7 +1416,7 @@ PROOF static thm prove_frac_ra_cancellative(void) { thm unit_combination_eq = rewrite_rule( THM_LIST( frame_unit_eq, - FRAC_RA_OP_FN, + frac_ra_op_fn, frac_op_def), assume_rule(` ra_op @@ -1484,7 +1484,7 @@ PROOF static thm prove_frac_ra_cancellative(void) { frame_owned_eq, unit_owned_left_eq, unit_owned_right_eq, - FRAC_RA_OP_FN, + frac_ra_op_fn, frac_op_def, frac_token_op_def, frac_injective), @@ -1502,7 +1502,7 @@ PROOF static thm prove_frac_ra_cancellative(void) { weight_value_fn, conjunct1_rule(unit_owned_combination)); unit_owned_weight_eq = pure_rewrite_rule( - THM_LIST(FRAC_WEIGHT_ADD_VALUE), + THM_LIST(frac_weight_add_value), unit_owned_weight_eq); unit_owned_weight_eq = sym_rule( unit_owned_weight_eq); @@ -1521,7 +1521,7 @@ PROOF static thm prove_frac_ra_cancellative(void) { positive_not_zero), ispec_rule( unit_owned_right_weight, - FRAC_WEIGHT_VALUE_POS)), + frac_weight_value_pos)), unit_owned_zero); CONTR_TAC( unit_left_right_cases[1], @@ -1553,7 +1553,7 @@ PROOF static thm prove_frac_ra_cancellative(void) { frame_owned_eq, owned_unit_left_eq, owned_unit_right_eq, - FRAC_RA_OP_FN, + frac_ra_op_fn, frac_op_def, frac_token_op_def, frac_injective), @@ -1571,7 +1571,7 @@ PROOF static thm prove_frac_ra_cancellative(void) { weight_value_fn, conjunct1_rule(owned_unit_combination)); owned_unit_weight_eq = pure_rewrite_rule( - THM_LIST(FRAC_WEIGHT_ADD_VALUE), + THM_LIST(frac_weight_add_value), owned_unit_weight_eq); thm owned_unit_zero = eq_mp_rule( ispecl_rule( @@ -1588,7 +1588,7 @@ PROOF static thm prove_frac_ra_cancellative(void) { positive_not_zero), ispec_rule( owned_left_weight, - FRAC_WEIGHT_VALUE_POS)), + frac_weight_value_pos)), owned_unit_zero); CONTR_TAC( owned_left_right_cases[0], @@ -1616,7 +1616,7 @@ PROOF static thm prove_frac_ra_cancellative(void) { frame_owned_eq, owned_owned_left_eq, owned_owned_right_eq, - FRAC_RA_OP_FN, + frac_ra_op_fn, frac_op_def, frac_token_op_def, frac_injective), @@ -1634,7 +1634,7 @@ PROOF static thm prove_frac_ra_cancellative(void) { weight_value_fn, conjunct1_rule(owned_owned_combination)); owned_owned_weight_value_eq = pure_rewrite_rule( - THM_LIST(FRAC_WEIGHT_ADD_VALUE), + THM_LIST(frac_weight_add_value), owned_owned_weight_value_eq); thm owned_owned_value_eq = eq_mp_rule( ispecl_rule( @@ -1650,15 +1650,15 @@ PROOF static thm prove_frac_ra_cancellative(void) { TERM_LIST( owned_left_weight, owned_right_weight), - FRAC_WEIGHT_EQ)), + frac_weight_eq)), owned_owned_value_eq); thm source_owned_valid = rewrite_rule( THM_LIST( frame_owned_eq, owned_owned_left_eq, - FRAC_RA_OP_FN, - FRAC_RA_VALID_FN, + frac_ra_op_fn, + frac_ra_valid_fn, frac_op_def, frac_token_op_def, frac_valid_def), @@ -1679,7 +1679,7 @@ PROOF static thm prove_frac_ra_cancellative(void) { frame_payload, owned_left_payload, owned_right_payload), - RA_CANCELLATIVE_APPLY), + ra_cancellative_apply), assume_rule(` ra_cancellative (R:(A)ra) `)), @@ -1699,7 +1699,7 @@ PROOF static thm prove_frac_ra_cancellative(void) { return gnode_prove(root); } -PROOF static thm FRAC_RA_CANCELLATIVE = +PROOF static thm frac_ra_cancellative = prove_frac_ra_cancellative(); /* ------------------------------------------------------------------------- */ @@ -1743,12 +1743,12 @@ PROOF static thm prove_frac_ra_update_weaken(void) { thm p_value = mp_rule( ispec_rule( `p:real`, - FRAC_WEIGHT_OF_REAL_VALUE), + frac_weight_of_real_value), p_pos); thm q_value = mp_rule( ispec_rule( `q:real`, - FRAC_WEIGHT_OF_REAL_VALUE), + frac_weight_of_real_value), assume_rule(`&0 < (q:real)`)); body = CONV_TAC( @@ -1768,8 +1768,8 @@ PROOF static thm prove_frac_ra_update_weaken(void) { assume_rule(` (frame:(A)frac) == FracUnit `), - FRAC_RA_OP_FN, - FRAC_RA_VALID_FN, + frac_ra_op_fn, + frac_ra_valid_fn, frac_op_def, frac_token_op_def, frac_valid_def, @@ -1790,7 +1790,7 @@ PROOF static thm prove_frac_ra_update_weaken(void) { `R:(A)ra`, `a:A`, `b:A`), - RA_UPDATE_VALID), + ra_update_valid), assume_rule(` ra_update (R:(A)ra) (a:A) (b:A) `)), @@ -1817,8 +1817,8 @@ PROOF static thm prove_frac_ra_update_weaken(void) { assume_rule(` (frame:(A)frac) == FracUnit `), - FRAC_RA_OP_FN, - FRAC_RA_VALID_FN, + frac_ra_op_fn, + frac_ra_valid_fn, frac_op_def, frac_token_op_def, frac_valid_def, @@ -1835,13 +1835,13 @@ PROOF static thm prove_frac_ra_update_weaken(void) { assume_rule(` (frame:(A)frac) == Frac a0 a1 `), - FRAC_RA_OP_FN, - FRAC_RA_VALID_FN, + frac_ra_op_fn, + frac_ra_valid_fn, frac_op_def, frac_token_op_def, frac_valid_def, frac_own_def, - FRAC_WEIGHT_ADD_VALUE, + frac_weight_add_value, p_value), assume_rule(` ra_valid @@ -1859,7 +1859,7 @@ PROOF static thm prove_frac_ra_update_weaken(void) { `a:A`, `b:A`, `a1:A`), - RA_UPDATE_APPLY), + ra_update_apply), assume_rule(` ra_update (R:(A)ra) (a:A) (b:A) `)), @@ -1894,13 +1894,13 @@ PROOF static thm prove_frac_ra_update_weaken(void) { assume_rule(` (frame:(A)frac) == Frac a0 a1 `), - FRAC_RA_OP_FN, - FRAC_RA_VALID_FN, + frac_ra_op_fn, + frac_ra_valid_fn, frac_op_def, frac_token_op_def, frac_valid_def, frac_own_def, - FRAC_WEIGHT_ADD_VALUE, + frac_weight_add_value, q_value))); ACCEPT_TAC( target_owned, @@ -1910,7 +1910,7 @@ PROOF static thm prove_frac_ra_update_weaken(void) { return gnode_prove(root); } -PROOF thm FRAC_RA_UPDATE_WEAKEN = +PROOF thm frac_ra_update_weaken = prove_frac_ra_update_weaken(); /* @@ -1951,12 +1951,12 @@ PROOF static thm prove_frac_ra_updateP_weaken(void) { thm p_value = mp_rule( ispec_rule( `p:real`, - FRAC_WEIGHT_OF_REAL_VALUE), + frac_weight_of_real_value), p_pos); thm q_value = mp_rule( ispec_rule( `q:real`, - FRAC_WEIGHT_OF_REAL_VALUE), + frac_weight_of_real_value), assume_rule(`&0 < (q:real)`)); body = CONV_TAC( @@ -1974,8 +1974,8 @@ PROOF static thm prove_frac_ra_updateP_weaken(void) { assume_rule(` (frame:(A)frac) == FracUnit `), - FRAC_RA_OP_FN, - FRAC_RA_VALID_FN, + frac_ra_op_fn, + frac_ra_valid_fn, frac_op_def, frac_token_op_def, frac_valid_def, @@ -1996,7 +1996,7 @@ PROOF static thm prove_frac_ra_updateP_weaken(void) { `R:(A)ra`, `a:A`, `P:A->bool`), - RA_UPDATEP_VALID), + ra_updateP_valid), assume_rule(` ra_updateP (R:(A)ra) @@ -2043,8 +2043,8 @@ PROOF static thm prove_frac_ra_updateP_weaken(void) { assume_rule(` (frame:(A)frac) == FracUnit `), - FRAC_RA_OP_FN, - FRAC_RA_VALID_FN, + frac_ra_op_fn, + frac_ra_valid_fn, frac_op_def, frac_token_op_def, frac_valid_def, @@ -2061,13 +2061,13 @@ PROOF static thm prove_frac_ra_updateP_weaken(void) { assume_rule(` (frame:(A)frac) == Frac a0 a1 `), - FRAC_RA_OP_FN, - FRAC_RA_VALID_FN, + frac_ra_op_fn, + frac_ra_valid_fn, frac_op_def, frac_token_op_def, frac_valid_def, frac_own_def, - FRAC_WEIGHT_ADD_VALUE, + frac_weight_add_value, p_value), assume_rule(` ra_valid @@ -2135,13 +2135,13 @@ PROOF static thm prove_frac_ra_updateP_weaken(void) { assume_rule(` (frame:(A)frac) == Frac a0 a1 `), - FRAC_RA_OP_FN, - FRAC_RA_VALID_FN, + frac_ra_op_fn, + frac_ra_valid_fn, frac_op_def, frac_token_op_def, frac_valid_def, frac_own_def, - FRAC_WEIGHT_ADD_VALUE, + frac_weight_add_value, q_value))); ACCEPT_TAC( target_owned, @@ -2155,7 +2155,7 @@ PROOF static thm prove_frac_ra_updateP_weaken(void) { return gnode_prove(root); } -PROOF thm FRAC_RA_UPDATEP_WEAKEN = +PROOF thm frac_ra_updateP_weaken = prove_frac_ra_updateP_weaken(); PROOF static thm prove_frac_ra_update_full_iff(void) { @@ -2176,7 +2176,7 @@ PROOF static thm prove_frac_ra_update_full_iff(void) { thm source_full_valid = eq_mp_rule( gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), - FRAC_RA_VALID_FULL)), + frac_ra_valid_full)), assume_rule(`ra_valid (R:(A)ra) (a:A)`)); thm target_full_valid = mp_rule( mp_rule( @@ -2185,7 +2185,7 @@ PROOF static thm prove_frac_ra_update_full_iff(void) { `frac_ra (R:(A)ra)`, `frac_full (a:A)`, `frac_full (b:A)`), - RA_UPDATE_VALID), + ra_update_valid), assume_rule(` ra_update (frac_ra (R:(A)ra)) @@ -2198,7 +2198,7 @@ PROOF static thm prove_frac_ra_update_full_iff(void) { eq_mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `b:A`), - FRAC_RA_VALID_FULL), + frac_ra_valid_full), target_full_valid)); gnode reverse = DISCH_TAC(directions[1], "Hvalid"); @@ -2218,7 +2218,7 @@ PROOF static thm prove_frac_ra_update_full_iff(void) { `frac_ra (R:(A)ra)`, `frac_full (a:A)`, `frame:(A)frac`), - RA_VALID_OP), + ra_valid_op), assume_rule(` ra_valid (frac_ra (R:(A)ra)) @@ -2230,7 +2230,7 @@ PROOF static thm prove_frac_ra_update_full_iff(void) { thm source_base_valid = eq_mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), - FRAC_RA_VALID_FULL), + frac_ra_valid_full), conjunct1_rule(source_parts)); thm target_base_valid = mp_rule( assume_rule(` @@ -2241,13 +2241,13 @@ PROOF static thm prove_frac_ra_update_full_iff(void) { thm reverse_target_full_valid = eq_mp_rule( gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `b:A`), - FRAC_RA_VALID_FULL)), + frac_ra_valid_full)), target_base_valid); thm exclusive = mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), - FRAC_RA_EXCLUSIVE_FULL), + frac_ra_exclusive_full), source_base_valid); thm frame_is_unit = mp_rule( mp_rule( @@ -2256,7 +2256,7 @@ PROOF static thm prove_frac_ra_update_full_iff(void) { `frac_ra (R:(A)ra)`, `frac_full (a:A)`, `frame:(A)frac`), - RA_EXCLUSIVE_APPLY), + ra_exclusive_apply), exclusive), assume_rule(` ra_valid @@ -2271,7 +2271,7 @@ PROOF static thm prove_frac_ra_update_full_iff(void) { TERM_LIST( `frac_ra (R:(A)ra)`, `frac_full (b:A)`), - RA_UNIT_R); + ra_unit_r); thm target_with_unit = eq_mp_rule( gsym_rule(beta_rule(ap_term_rule( `\x:(A)frac. @@ -2295,60 +2295,60 @@ PROOF static thm prove_frac_ra_update_full_iff(void) { return gnode_prove(root); } -PROOF thm FRAC_RA_UPDATE_FULL_IFF = +PROOF thm frac_ra_update_full_iff = prove_frac_ra_update_full_iff(); PROOF static int audit_frac_ra(void) { thm_list audited_theorems = THM_LIST( - FRAC_WEIGHT_REP_EXISTS, - FRAC_WEIGHT_TYPE_BIJECTION, + frac_weight_rep_exists, + frac_weight_type_bijection, frac_weight_value_def, frac_weight_of_real_def, frac_weight_add_def, - FRAC_WEIGHT_VALUE_POS, - FRAC_WEIGHT_OF_REAL_VALUE, - FRAC_WEIGHT_ADD_VALUE, - FRAC_WEIGHT_EQ, - FRAC_WEIGHT_ADD_ASSOC, - FRAC_WEIGHT_ADD_COMM, - FRAC_WEIGHT_ADD_LE_LEFT, + frac_weight_value_pos, + frac_weight_of_real_value, + frac_weight_add_value, + frac_weight_eq, + frac_weight_add_assoc, + frac_weight_add_comm, + frac_weight_add_le_left, frac_type.ind, frac_type.rec, frac_token_op_def, frac_op_def, frac_valid_def, - FRAC_OP_ASSOC, - FRAC_OP_COMM, - FRAC_OP_UNIT_L, - FRAC_VALID_UNIT, - FRAC_VALID_OP_L, - FRAC_RA_LAWS, + frac_op_assoc, + frac_op_comm, + frac_op_unit_l, + frac_valid_unit, + frac_valid_op_l, + frac_ra_laws, frac_ra_def, - FRAC_RA_UNIT_RAW, - FRAC_RA_OP_FN, - FRAC_RA_VALID_FN, + frac_ra_unit_raw, + frac_ra_op_fn, + frac_ra_valid_fn, frac_empty_def, frac_own_def, frac_full_def, - FRAC_RA_UNIT, - FRAC_RA_FULL, - FRAC_RA_OWN_OP, - FRAC_RA_OWN_INJ, - FRAC_RA_OWN_NE_EMPTY, - FRAC_RA_FULL_INJ, - FRAC_RA_FULL_NE_EMPTY, - FRAC_RA_VALID_EMPTY, - FRAC_RA_VALID_OWN, - FRAC_RA_VALID_FULL, - FRAC_RA_INCLUDED_EMPTY, - FRAC_RA_INCLUDED_OWN, - FRAC_RA_NOT_INCLUDED_OWN_EMPTY, - FRAC_RA_INCLUDED_FULL, - FRAC_RA_EXCLUSIVE_FULL, - FRAC_RA_CANCELLATIVE, - FRAC_RA_UPDATE_WEAKEN, - FRAC_RA_UPDATEP_WEAKEN, - FRAC_RA_UPDATE_FULL_IFF); + frac_ra_unit, + frac_ra_full, + frac_ra_own_op, + frac_ra_own_inj, + frac_ra_own_ne_empty, + frac_ra_full_inj, + frac_ra_full_ne_empty, + frac_ra_valid_empty, + frac_ra_valid_own, + frac_ra_valid_full, + frac_ra_included_empty, + frac_ra_included_own, + frac_ra_not_included_own_empty, + frac_ra_included_full, + frac_ra_exclusive_full, + frac_ra_cancellative, + frac_ra_update_weaken, + frac_ra_updateP_weaken, + frac_ra_update_full_iff); for (size_t i = 0; i < vector_size(audited_theorems); diff --git a/theory/logic/frac_ra.h b/theory/logic/frac_ra.h index d3a1150..934687d 100644 --- a/theory/logic/frac_ra.h +++ b/theory/logic/frac_ra.h @@ -1,7 +1,7 @@ #pragma once /* - * Optional positive-fraction RA construction. + * Public interface for the optional positive-fraction RA construction. * * `frac_ra R : ((A)frac)ra` contains an empty unit and positive-share tokens * `frac_own p a`. Shares compose by addition while payloads compose in `R`; @@ -11,11 +11,15 @@ #include "proof/theory/logic/ra.h" +/* ------------------------------------------------------------------------- */ +/* Constructors and composition */ +/* ------------------------------------------------------------------------- */ + /* `forall R:(A)ra. ra_unit (frac_ra R) == (frac_empty:(A)frac)`. */ -PROOF extern thm FRAC_RA_UNIT; +PROOF extern thm frac_ra_unit; /* `forall a:A. frac_full a == frac_own (&1) a`. */ -PROOF extern thm FRAC_RA_FULL; +PROOF extern thm frac_ra_full; /* * Positive shares join (and, by symmetry, split) exactly: @@ -25,7 +29,11 @@ PROOF extern thm FRAC_RA_FULL; * ra_op (frac_ra R) (frac_own p a) (frac_own q b) == * frac_own (p + q) (ra_op R a b)`. */ -PROOF extern thm FRAC_RA_OWN_OP; +PROOF extern thm frac_ra_own_op; + +/* ------------------------------------------------------------------------- */ +/* Validity and exclusivity */ +/* ------------------------------------------------------------------------- */ /* * `forall (R:(A)ra) (p:real) (a:A). @@ -33,20 +41,24 @@ PROOF extern thm FRAC_RA_OWN_OP; * (ra_valid (frac_ra R) (frac_own p a) <=> * p <= &1 && ra_valid R a)`. */ -PROOF extern thm FRAC_RA_VALID_OWN; +PROOF extern thm frac_ra_valid_own; /* * `forall (R:(A)ra) (a:A). * ra_valid R a ==> ra_exclusive (frac_ra R) (frac_full a)`. */ -PROOF extern thm FRAC_RA_EXCLUSIVE_FULL; +PROOF extern thm frac_ra_exclusive_full; + +/* ------------------------------------------------------------------------- */ +/* Share and payload updates */ +/* ------------------------------------------------------------------------- */ /* * `forall (R:(A)ra) (p q:real) (a b:A). * &0 < q ==> q <= p ==> ra_update R a b ==> * ra_update (frac_ra R) (frac_own p a) (frac_own q b)`. */ -PROOF extern thm FRAC_RA_UPDATE_WEAKEN; +PROOF extern thm frac_ra_update_weaken; /* * Predicate-update weakening with an exact fixed-share image: @@ -58,11 +70,11 @@ PROOF extern thm FRAC_RA_UPDATE_WEAKEN; * (frac_own p a) * (\x. exists b. P b && x == frac_own q b)`. */ -PROOF extern thm FRAC_RA_UPDATEP_WEAKEN; +PROOF extern thm frac_ra_updateP_weaken; /* * `forall (R:(A)ra) (a b:A). * (ra_update (frac_ra R) (frac_full a) (frac_full b) <=> * (ra_valid R a ==> ra_valid R b))`. */ -PROOF extern thm FRAC_RA_UPDATE_FULL_IFF; +PROOF extern thm frac_ra_update_full_iff; diff --git a/theory/logic/gmap_ra.c b/theory/logic/gmap_ra.c index 2b38734..bd53ff3 100644 --- a/theory/logic/gmap_ra.c +++ b/theory/logic/gmap_ra.c @@ -45,9 +45,9 @@ PROOF static thm prove_gmap_raw_op_support(void) { rewrite_conv, THM_LIST( gmap_raw_op_def, - OPTION_RA_OP_NONE_L, - OPTION_RA_OP_NONE_R, - OPTION_RA_OP_SOME_SOME, + option_ra_op_none_l, + option_ra_op_none_r, + option_ra_op_some_some, get_theorem_by_name("IN_ELIM_THM"), get_theorem_by_name("IN_UNION"), get_theorem_by_name("option_DISTINCT"))); @@ -56,7 +56,7 @@ PROOF static thm prove_gmap_raw_op_support(void) { return gnode_prove(root); } -PROOF static thm GMAP_RAW_OP_SUPPORT = +PROOF static thm gmap_raw_op_support = prove_gmap_raw_op_support(); PROOF static thm prove_gmap_raw_op_finite(void) { @@ -90,7 +90,7 @@ PROOF static thm prove_gmap_raw_op_finite(void) { `R:(V)ra`, `f:K->V option`, `g:K->V option`), - GMAP_RAW_OP_SUPPORT); + gmap_raw_op_support); thm raw_finite = rewrite_rule( THM_LIST(gsym_rule(support)), union_finite); @@ -98,7 +98,7 @@ PROOF static thm prove_gmap_raw_op_finite(void) { return gnode_prove(root); } -PROOF static thm GMAP_RAW_OP_FINITE = +PROOF static thm gmap_raw_op_finite = prove_gmap_raw_op_finite(); PROOF static thm gmap_op_def = new_fun_definition(` @@ -125,17 +125,17 @@ PROOF static thm prove_gmap_op_rep(void) { R, `finmap_rep (m:(K,V)finmap)`, `finmap_rep (n:(K,V)finmap)`), - GMAP_RAW_OP_FINITE); + gmap_raw_op_finite); finite = mp_rule( finite, - ispec_rule(m, FINMAP_REP_FINITE)); + ispec_rule(m, finmap_rep_finite)); finite = mp_rule( finite, - ispec_rule(n, FINMAP_REP_FINITE)); + ispec_rule(n, finmap_rep_finite)); thm inverse = ispec_rule( raw, - conjunct2_rule(FINMAP_TYPE_BIJECTION)); + conjunct2_rule(finmap_type_bijection)); thm represented = eq_mp_rule(inverse, finite); represented = pure_once_rewrite_rule( THM_LIST(gsym_rule(gmap_op_def)), @@ -145,7 +145,7 @@ PROOF static thm prove_gmap_op_rep(void) { return gen_rule(R, represented); } -PROOF static thm GMAP_OP_REP = +PROOF static thm gmap_op_rep = prove_gmap_op_rep(); PROOF static thm prove_gmap_op_lookup(void) { @@ -166,12 +166,12 @@ PROOF static thm prove_gmap_op_lookup(void) { root, rewrite_conv(THM_LIST( finmap_lookup_def, - GMAP_OP_REP, + gmap_op_rep, gmap_raw_op_def))); return gnode_prove(root); } -PROOF static thm GMAP_OP_LOOKUP = +PROOF static thm gmap_op_lookup = prove_gmap_op_lookup(); PROOF static thm gmap_valid_def = new_fun_definition(` @@ -196,11 +196,11 @@ PROOF static thm prove_gmap_op_assoc(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "k"); body = CONV_TAC( body, - pure_rewrite_conv(THM_LIST(GMAP_OP_LOOKUP))); + pure_rewrite_conv(THM_LIST(gmap_op_lookup))); ACCEPT_TAC( body, ispecl_rule( @@ -209,11 +209,11 @@ PROOF static thm prove_gmap_op_assoc(void) { `finmap_lookup (m:(K,V)finmap) (k:K)`, `finmap_lookup (n:(K,V)finmap) (k:K)`, `finmap_lookup (p:(K,V)finmap) (k:K)`), - RA_ASSOC)); + ra_assoc)); return gnode_prove(root); } -PROOF static thm GMAP_OP_ASSOC = +PROOF static thm gmap_op_assoc = prove_gmap_op_assoc(); PROOF static thm prove_gmap_op_comm(void) { @@ -228,11 +228,11 @@ PROOF static thm prove_gmap_op_comm(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "k"); body = CONV_TAC( body, - pure_rewrite_conv(THM_LIST(GMAP_OP_LOOKUP))); + pure_rewrite_conv(THM_LIST(gmap_op_lookup))); ACCEPT_TAC( body, ispecl_rule( @@ -240,11 +240,11 @@ PROOF static thm prove_gmap_op_comm(void) { `option_ra (R:(V)ra)`, `finmap_lookup (m:(K,V)finmap) (k:K)`, `finmap_lookup (n:(K,V)finmap) (k:K)`), - RA_COMM)); + ra_comm)); return gnode_prove(root); } -PROOF static thm GMAP_OP_COMM = +PROOF static thm gmap_op_comm = prove_gmap_op_comm(); PROOF static thm prove_gmap_op_unit_l(void) { @@ -256,26 +256,26 @@ PROOF static thm prove_gmap_op_unit_l(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "k"); body = CONV_TAC( body, pure_rewrite_conv(THM_LIST( - GMAP_OP_LOOKUP, - FINMAP_EMPTY_LOOKUP))); + gmap_op_lookup, + finmap_empty_lookup))); thm unit = ispecl_rule( TERM_LIST( `option_ra (R:(V)ra)`, `finmap_lookup (m:(K,V)finmap) (k:K)`), - RA_UNIT_L); + ra_unit_l); unit = rewrite_rule( - THM_LIST(OPTION_RA_UNIT), + THM_LIST(option_ra_unit), unit); ACCEPT_TAC(body, unit); return gnode_prove(root); } -PROOF static thm GMAP_OP_UNIT_L = +PROOF static thm gmap_op_unit_l = prove_gmap_op_unit_l(); PROOF static thm prove_gmap_valid_empty(void) { @@ -292,12 +292,12 @@ PROOF static thm prove_gmap_valid_empty(void) { CONV_TAC( body, rewrite_conv(THM_LIST( - FINMAP_EMPTY_LOOKUP, - OPTION_RA_VALID_NONE))); + finmap_empty_lookup, + option_ra_valid_none))); return gnode_prove(root); } -PROOF static thm GMAP_VALID_EMPTY = +PROOF static thm gmap_valid_empty = prove_gmap_valid_empty(); PROOF static thm prove_gmap_valid_op_l(void) { @@ -328,7 +328,7 @@ PROOF static thm prove_gmap_valid_op_l(void) { k) `)); source_valid = rewrite_rule( - THM_LIST(GMAP_OP_LOOKUP), + THM_LIST(gmap_op_lookup), source_valid); thm both_valid = mp_rule( ispecl_rule( @@ -336,14 +336,14 @@ PROOF static thm prove_gmap_valid_op_l(void) { `option_ra (R:(V)ra)`, `finmap_lookup (m:(K,V)finmap) (k:K)`, `finmap_lookup (n:(K,V)finmap) (k:K)`), - RA_VALID_OP), + ra_valid_op), source_valid); thm left_valid = conjunct1_rule(both_valid); ACCEPT_TAC(body, left_valid); return gnode_prove(root); } -PROOF static thm GMAP_VALID_OP_L = +PROOF static thm gmap_valid_op_l = prove_gmap_valid_op_l(); PROOF static thm prove_gmap_ra_laws(void) { @@ -363,29 +363,29 @@ PROOF static thm prove_gmap_ra_laws(void) { gnode_list law1 = CONJ_TAC(unfolded); ACCEPT_TAC( law1[0], - spec_rule(`R:(V)ra`, GMAP_OP_ASSOC)); + spec_rule(`R:(V)ra`, gmap_op_assoc)); gnode_list law2 = CONJ_TAC(law1[1]); ACCEPT_TAC( law2[0], - spec_rule(`R:(V)ra`, GMAP_OP_COMM)); + spec_rule(`R:(V)ra`, gmap_op_comm)); gnode_list law3 = CONJ_TAC(law2[1]); ACCEPT_TAC( law3[0], - spec_rule(`R:(V)ra`, GMAP_OP_UNIT_L)); + spec_rule(`R:(V)ra`, gmap_op_unit_l)); gnode_list law4 = CONJ_TAC(law3[1]); ACCEPT_TAC( law4[0], - spec_rule(`R:(V)ra`, GMAP_VALID_EMPTY)); + spec_rule(`R:(V)ra`, gmap_valid_empty)); ACCEPT_TAC( law4[1], - spec_rule(`R:(V)ra`, GMAP_VALID_OP_L)); + spec_rule(`R:(V)ra`, gmap_valid_op_l)); return gnode_prove(root); } -PROOF static thm GMAP_RA_LAWS = +PROOF static thm gmap_ra_laws = prove_gmap_ra_laws(); PROOF static thm gmap_ra_def = new_fun_definition(` @@ -407,11 +407,11 @@ PROOF static thm prove_gmap_ra_unit(void) { term valid = ` gmap_valid (R:(V)ra):(K,V)finmap->bool `; - thm laws = ispec_rule(R, GMAP_RA_LAWS); + thm laws = ispec_rule(R, gmap_ra_laws); thm computed = mp_rule( ispecl_rule( TERM_LIST(empty, op, valid), - RA_UNIT_ABS), + ra_unit_abs), laws); computed = pure_once_rewrite_rule( THM_LIST(gsym_rule(gmap_ra_def)), @@ -419,7 +419,7 @@ PROOF static thm prove_gmap_ra_unit(void) { return gen_rule(R, computed); } -PROOF thm GMAP_RA_UNIT = +PROOF thm gmap_ra_unit = prove_gmap_ra_unit(); PROOF static thm prove_gmap_ra_op_fn(void) { @@ -432,11 +432,11 @@ PROOF static thm prove_gmap_ra_op_fn(void) { term valid = ` gmap_valid (R:(V)ra):(K,V)finmap->bool `; - thm laws = ispec_rule(R, GMAP_RA_LAWS); + thm laws = ispec_rule(R, gmap_ra_laws); thm computed = mp_rule( ispecl_rule( TERM_LIST(empty, op, valid), - RA_OP_ABS), + ra_op_abs), laws); computed = pure_once_rewrite_rule( THM_LIST(gsym_rule(gmap_ra_def)), @@ -444,7 +444,7 @@ PROOF static thm prove_gmap_ra_op_fn(void) { return gen_rule(R, computed); } -PROOF static thm GMAP_RA_OP_FN = +PROOF static thm gmap_ra_op_fn = prove_gmap_ra_op_fn(); PROOF static thm prove_gmap_ra_valid_fn(void) { @@ -457,11 +457,11 @@ PROOF static thm prove_gmap_ra_valid_fn(void) { term valid = ` gmap_valid (R:(V)ra):(K,V)finmap->bool `; - thm laws = ispec_rule(R, GMAP_RA_LAWS); + thm laws = ispec_rule(R, gmap_ra_laws); thm computed = mp_rule( ispecl_rule( TERM_LIST(empty, op, valid), - RA_VALID_ABS), + ra_valid_abs), laws); computed = pure_once_rewrite_rule( THM_LIST(gsym_rule(gmap_ra_def)), @@ -469,7 +469,7 @@ PROOF static thm prove_gmap_ra_valid_fn(void) { return gen_rule(R, computed); } -PROOF static thm GMAP_RA_VALID_FN = +PROOF static thm gmap_ra_valid_fn = prove_gmap_ra_valid_fn(); PROOF static thm prove_gmap_ra_op_lookup(void) { @@ -489,12 +489,12 @@ PROOF static thm prove_gmap_ra_op_lookup(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - GMAP_RA_OP_FN, - GMAP_OP_LOOKUP))); + gmap_ra_op_fn, + gmap_op_lookup))); return gnode_prove(root); } -PROOF thm GMAP_RA_OP_LOOKUP = +PROOF thm gmap_ra_op_lookup = prove_gmap_ra_op_lookup(); PROOF static thm prove_gmap_ra_op_insert_insert(void) { @@ -519,7 +519,7 @@ PROOF static thm prove_gmap_ra_op_insert_insert(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "query"); gnode_list cases = BOOL_CASES_TAC( body, `(query:K) == (key:K)`, NULL); @@ -528,14 +528,14 @@ PROOF static thm prove_gmap_ra_op_insert_insert(void) { cases[i], rewrite_conv, THM_LIST( - GMAP_RA_OP_LOOKUP, - FINMAP_INSERT_LOOKUP, - OPTION_RA_OP_SOME_SOME)); + gmap_ra_op_lookup, + finmap_insert_lookup, + option_ra_op_some_some)); } return gnode_prove(root); } -PROOF thm GMAP_RA_OP_INSERT_INSERT = +PROOF thm gmap_ra_op_insert_insert = prove_gmap_ra_op_insert_insert(); PROOF static thm prove_gmap_ra_op_delete(void) { @@ -555,7 +555,7 @@ PROOF static thm prove_gmap_ra_op_delete(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "query"); gnode_list cases = BOOL_CASES_TAC( body, `(query:K) == (key:K)`, NULL); @@ -564,14 +564,14 @@ PROOF static thm prove_gmap_ra_op_delete(void) { cases[i], rewrite_conv, THM_LIST( - GMAP_RA_OP_LOOKUP, - FINMAP_DELETE_LOOKUP, - OPTION_RA_OP_NONE_L)); + gmap_ra_op_lookup, + finmap_delete_lookup, + option_ra_op_none_l)); } return gnode_prove(root); } -PROOF thm GMAP_RA_OP_DELETE = +PROOF thm gmap_ra_op_delete = prove_gmap_ra_op_delete(); PROOF static thm prove_gmap_ra_valid(void) { @@ -589,12 +589,12 @@ PROOF static thm prove_gmap_ra_valid(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - GMAP_RA_VALID_FN, + gmap_ra_valid_fn, gmap_valid_def))); return gnode_prove(root); } -PROOF thm GMAP_RA_VALID = +PROOF thm gmap_ra_valid = prove_gmap_ra_valid(); /* @@ -626,7 +626,7 @@ PROOF static thm prove_gmap_ra_valid_lookup_delete(void) { TERM_LIST( `R:(V)ra`, `m:(K,V)finmap`), - GMAP_RA_VALID), + gmap_ra_valid), assume_rule(`ra_valid (gmap_ra (R:(V)ra)) (m:(K,V)finmap)`)); gnode_list forward_parts = CONJ_TAC(forward); ACCEPT_TAC( @@ -635,7 +635,7 @@ PROOF static thm prove_gmap_ra_valid_lookup_delete(void) { gnode deleted = CONV_TAC( forward_parts[1], - once_rewrite_conv(THM_LIST(GMAP_RA_VALID))); + once_rewrite_conv(THM_LIST(gmap_ra_valid))); deleted = GEN_TAC(deleted, "query"); deleted = ASSUME_TAC( deleted, @@ -651,11 +651,11 @@ PROOF static thm prove_gmap_ra_valid_lookup_delete(void) { delete_cases[i], rewrite_conv(THM_LIST( branch, - FINMAP_DELETE_LOOKUP))); + finmap_delete_lookup))); if (i == 0) { ACCEPT_TAC( reduced_goal, - ispec_rule(`R:(V)ra`, OPTION_RA_VALID_NONE)); + ispec_rule(`R:(V)ra`, option_ra_valid_none)); } else { ACCEPT_TAC( reduced_goal, @@ -678,7 +678,7 @@ PROOF static thm prove_gmap_ra_valid_lookup_delete(void) { TERM_LIST( `R:(V)ra`, `finmap_delete (key:K) (m:(K,V)finmap)`), - GMAP_RA_VALID), + gmap_ra_valid), assume_rule(` ra_valid (gmap_ra (R:(V)ra)) @@ -686,7 +686,7 @@ PROOF static thm prove_gmap_ra_valid_lookup_delete(void) { `)); reverse = CONV_TAC( reverse, - once_rewrite_conv(THM_LIST(GMAP_RA_VALID))); + once_rewrite_conv(THM_LIST(gmap_ra_valid))); reverse = GEN_TAC(reverse, "query"); reverse = ASSUME_TAC( reverse, @@ -713,7 +713,7 @@ PROOF static thm prove_gmap_ra_valid_lookup_delete(void) { thm restored = rewrite_rule( THM_LIST( branch, - FINMAP_DELETE_LOOKUP), + finmap_delete_lookup), assume_rule(` ra_valid (option_ra (R:(V)ra)) @@ -727,7 +727,7 @@ PROOF static thm prove_gmap_ra_valid_lookup_delete(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_VALID_LOOKUP_DELETE = +PROOF thm gmap_ra_valid_lookup_delete = prove_gmap_ra_valid_lookup_delete(); PROOF static thm prove_gmap_ra_valid_delete_some(void) { @@ -749,19 +749,19 @@ PROOF static thm prove_gmap_ra_valid_delete_some(void) { `R:(V)ra`, `key:K`, `m:(K,V)finmap`), - GMAP_RA_VALID_LOOKUP_DELETE); + gmap_ra_valid_lookup_delete); split_validity = rewrite_rule( THM_LIST( assume_rule(` finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) `), - OPTION_RA_VALID_SOME), + option_ra_valid_some), split_validity); ACCEPT_TAC(body, split_validity); return gnode_prove(root); } -PROOF thm GMAP_RA_VALID_DELETE_SOME = +PROOF thm gmap_ra_valid_delete_some = prove_gmap_ra_valid_delete_some(); PROOF static thm prove_gmap_ra_valid_lookup(void) { @@ -784,7 +784,7 @@ PROOF static thm prove_gmap_ra_valid_lookup(void) { `key:K`, `a:V`, `m:(K,V)finmap`), - GMAP_RA_VALID_DELETE_SOME), + gmap_ra_valid_delete_some), assume_rule(` finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) `)); @@ -795,7 +795,7 @@ PROOF static thm prove_gmap_ra_valid_lookup(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_VALID_LOOKUP = +PROOF thm gmap_ra_valid_lookup = prove_gmap_ra_valid_lookup(); PROOF static thm prove_gmap_ra_valid_delete(void) { @@ -815,13 +815,13 @@ PROOF static thm prove_gmap_ra_valid_delete(void) { `R:(V)ra`, `key:K`, `m:(K,V)finmap`), - GMAP_RA_VALID_LOOKUP_DELETE), + gmap_ra_valid_lookup_delete), assume_rule(`ra_valid (gmap_ra (R:(V)ra)) (m:(K,V)finmap)`)); ACCEPT_TAC(body, conjunct2_rule(split_validity)); return gnode_prove(root); } -PROOF thm GMAP_RA_VALID_DELETE = +PROOF thm gmap_ra_valid_delete = prove_gmap_ra_valid_delete(); PROOF static thm prove_gmap_ra_valid_insert(void) { @@ -846,18 +846,18 @@ PROOF static thm prove_gmap_ra_valid_insert(void) { `R:(V)ra`, `key:K`, `finmap_insert (key:K) (a:V) (m:(K,V)finmap)`), - GMAP_RA_VALID_LOOKUP_DELETE); + gmap_ra_valid_lookup_delete); split_validity = rewrite_rule( THM_LIST( - FINMAP_INSERT_LOOKUP_EQ, - OPTION_RA_VALID_SOME, - FINMAP_DELETE_INSERT), + finmap_insert_lookup_eq, + option_ra_valid_some, + finmap_delete_insert), split_validity); ACCEPT_TAC(body, split_validity); return gnode_prove(root); } -PROOF thm GMAP_RA_VALID_INSERT = +PROOF thm gmap_ra_valid_insert = prove_gmap_ra_valid_insert(); PROOF static thm prove_gmap_ra_valid_insert_of_valid(void) { @@ -881,7 +881,7 @@ PROOF static thm prove_gmap_ra_valid_insert_of_valid(void) { `R:(V)ra`, `key:K`, `m:(K,V)finmap`), - GMAP_RA_VALID_DELETE), + gmap_ra_valid_delete), assume_rule(`ra_valid (gmap_ra (R:(V)ra)) (m:(K,V)finmap)`)); thm insert_characterization = ispecl_rule( TERM_LIST( @@ -889,7 +889,7 @@ PROOF static thm prove_gmap_ra_valid_insert_of_valid(void) { `key:K`, `a:V`, `m:(K,V)finmap`), - GMAP_RA_VALID_INSERT); + gmap_ra_valid_insert); thm inserted_valid = eq_mp_rule( gsym_rule(insert_characterization), conj_rule( @@ -899,7 +899,7 @@ PROOF static thm prove_gmap_ra_valid_insert_of_valid(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_VALID_INSERT_OF_VALID = +PROOF thm gmap_ra_valid_insert_of_valid = prove_gmap_ra_valid_insert_of_valid(); PROOF static thm prove_gmap_ra_valid_insert_fresh(void) { @@ -922,7 +922,7 @@ PROOF static thm prove_gmap_ra_valid_insert_fresh(void) { TERM_LIST( `key:K`, `m:(K,V)finmap`), - FINMAP_DELETE_ID), + finmap_delete_id), assume_rule(` finmap_lookup (m:(K,V)finmap) (key:K) == NONE `)); @@ -932,14 +932,14 @@ PROOF static thm prove_gmap_ra_valid_insert_fresh(void) { `key:K`, `a:V`, `m:(K,V)finmap`), - GMAP_RA_VALID_INSERT); + gmap_ra_valid_insert); ACCEPT_TAC( body, rewrite_rule(THM_LIST(delete_id), insert_validity)); return gnode_prove(root); } -PROOF thm GMAP_RA_VALID_INSERT_FRESH = +PROOF thm gmap_ra_valid_insert_fresh = prove_gmap_ra_valid_insert_fresh(); /* @@ -960,7 +960,7 @@ PROOF static thm prove_gmap_ra_singleton_op(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "query"); gnode_list cases = BOOL_CASES_TAC( body, `(query:K) == (key:K)`, "Hkey"); @@ -969,15 +969,15 @@ PROOF static thm prove_gmap_ra_singleton_op(void) { cases[i], rewrite_conv, THM_LIST( - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP, - OPTION_RA_OP_NONE_L, - OPTION_RA_OP_SOME_SOME)); + gmap_ra_op_lookup, + finmap_singleton_lookup, + option_ra_op_none_l, + option_ra_op_some_some)); } return gnode_prove(root); } -PROOF thm GMAP_RA_SINGLETON_OP = +PROOF thm gmap_ra_singleton_op = prove_gmap_ra_singleton_op(); /* An existing binding composes with a singleton frame only at that key. */ @@ -1000,7 +1000,7 @@ PROOF static thm prove_gmap_ra_op_singleton_at(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "query"); gnode_list cases = BOOL_CASES_TAC( body, `(query:K) == (key:K)`, "Hkey"); @@ -1009,16 +1009,16 @@ PROOF static thm prove_gmap_ra_op_singleton_at(void) { cases[i], rewrite_conv, THM_LIST( - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP, - FINMAP_INSERT_LOOKUP, - OPTION_RA_OP_NONE_R, - OPTION_RA_OP_SOME_SOME)); + gmap_ra_op_lookup, + finmap_singleton_lookup, + finmap_insert_lookup, + option_ra_op_none_r, + option_ra_op_some_some)); } return gnode_prove(root); } -PROOF thm GMAP_RA_OP_SINGLETON_AT = +PROOF thm gmap_ra_op_singleton_at = prove_gmap_ra_op_singleton_at(); PROOF static thm prove_gmap_ra_singleton_op_fresh(void) { @@ -1039,7 +1039,7 @@ PROOF static thm prove_gmap_ra_singleton_op_fresh(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); body = GEN_TAC(body, "query"); gnode_list cases = BOOL_CASES_TAC( body, `(query:K) == (key:K)`, NULL); @@ -1048,16 +1048,16 @@ PROOF static thm prove_gmap_ra_singleton_op_fresh(void) { cases[i], rewrite_conv, THM_LIST( - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP, - FINMAP_INSERT_LOOKUP, - OPTION_RA_OP_NONE_L, - OPTION_RA_OP_NONE_R)); + gmap_ra_op_lookup, + finmap_singleton_lookup, + finmap_insert_lookup, + option_ra_op_none_l, + option_ra_op_none_r)); } return gnode_prove(root); } -PROOF thm GMAP_RA_SINGLETON_OP_FRESH = +PROOF thm gmap_ra_singleton_op_fresh = prove_gmap_ra_singleton_op_fresh(); PROOF static thm prove_gmap_ra_decompose(void) { @@ -1082,7 +1082,7 @@ PROOF static thm prove_gmap_ra_decompose(void) { `key:K`, `a:V`, `m:(K,V)finmap`), - FINMAP_DECOMPOSE), + finmap_decompose), assume_rule(` finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) `)); @@ -1093,12 +1093,12 @@ PROOF static thm prove_gmap_ra_decompose(void) { `key:K`, `a:V`, `finmap_delete (key:K) (m:(K,V)finmap)`), - GMAP_RA_SINGLETON_OP_FRESH), + gmap_ra_singleton_op_fresh), ispecl_rule( TERM_LIST( `key:K`, `m:(K,V)finmap`), - FINMAP_DELETE_LOOKUP_EQ)); + finmap_delete_lookup_eq)); ACCEPT_TAC( body, trans_rule( @@ -1107,7 +1107,7 @@ PROOF static thm prove_gmap_ra_decompose(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_DECOMPOSE = +PROOF thm gmap_ra_decompose = prove_gmap_ra_decompose(); /* The deleted remainder is always fresh at key, so recombining it with a @@ -1134,25 +1134,25 @@ PROOF static thm prove_gmap_ra_singleton_op_delete(void) { `key:K`, `a:V`, `finmap_delete (key:K) (m:(K,V)finmap)`), - GMAP_RA_SINGLETON_OP_FRESH), + gmap_ra_singleton_op_fresh), ispecl_rule( TERM_LIST( `key:K`, `m:(K,V)finmap`), - FINMAP_DELETE_LOOKUP_EQ)); + finmap_delete_lookup_eq)); thm restore_insertion = ispecl_rule( TERM_LIST( `key:K`, `a:V`, `m:(K,V)finmap`), - FINMAP_INSERT_DELETE); + finmap_insert_delete); ACCEPT_TAC( body, trans_rule(fresh_composition, restore_insertion)); return gnode_prove(root); } -PROOF thm GMAP_RA_SINGLETON_OP_DELETE = +PROOF thm gmap_ra_singleton_op_delete = prove_gmap_ra_singleton_op_delete(); PROOF static thm prove_gmap_ra_dom_op(void) { @@ -1185,19 +1185,19 @@ PROOF static thm prove_gmap_ra_dom_op(void) { n_cases[j], rewrite_conv, THM_LIST( - FINMAP_IN_DOM, + finmap_in_dom, get_theorem_by_name("IN_UNION"), - GMAP_RA_OP_LOOKUP, - OPTION_RA_OP_NONE_L, - OPTION_RA_OP_NONE_R, - OPTION_RA_OP_SOME_SOME, + gmap_ra_op_lookup, + option_ra_op_none_l, + option_ra_op_none_r, + option_ra_op_some_some, get_theorem_by_name("option_DISTINCT"))); } } return gnode_prove(root); } -PROOF thm GMAP_RA_DOM_OP = +PROOF thm gmap_ra_dom_op = prove_gmap_ra_dom_op(); /* @@ -1214,7 +1214,7 @@ PROOF static thm prove_gmap_ra_valid_singleton(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(GMAP_RA_VALID))); + once_rewrite_conv(THM_LIST(gmap_ra_valid))); gnode_list directions = EQ_TAC(body); gnode forward = DISCH_TAC(directions[0], "Hall"); @@ -1230,8 +1230,8 @@ PROOF static thm prove_gmap_ra_valid_singleton(void) { `)); at_key = rewrite_rule( THM_LIST( - FINMAP_SINGLETON_LOOKUP, - OPTION_RA_VALID_SOME), + finmap_singleton_lookup, + option_ra_valid_some), at_key); ACCEPT_TAC(forward, at_key); @@ -1244,14 +1244,14 @@ PROOF static thm prove_gmap_ra_valid_singleton(void) { cases[i], rewrite_conv, THM_LIST( - FINMAP_SINGLETON_LOOKUP, - OPTION_RA_VALID_NONE, - OPTION_RA_VALID_SOME)); + finmap_singleton_lookup, + option_ra_valid_none, + option_ra_valid_some)); } return gnode_prove(root); } -PROOF thm GMAP_RA_VALID_SINGLETON = +PROOF thm gmap_ra_valid_singleton = prove_gmap_ra_valid_singleton(); /* ------------------------------------------------------------------------- */ @@ -1320,13 +1320,13 @@ PROOF static thm prove_gmap_ra_included_lookup(void) { (frame:(K,V)finmap) `)); extension_at = rewrite_rule( - THM_LIST(GMAP_RA_OP_LOOKUP), + THM_LIST(gmap_ra_op_lookup), extension_at); ACCEPT_TAC(body, extension_at); return gnode_prove(root); } -PROOF thm GMAP_RA_INCLUDED_LOOKUP = +PROOF thm gmap_ra_included_lookup = prove_gmap_ra_included_lookup(); /* At a fixed singleton key, finite-map inclusion is exactly payload @@ -1353,7 +1353,7 @@ PROOF static thm prove_gmap_ra_included_singleton(void) { `R:(V)ra`, `finmap_singleton (key:K) (a:V)`, `finmap_singleton (key:K) (b:V)`), - GMAP_RA_INCLUDED_LOOKUP), + gmap_ra_included_lookup), assume_rule(` ra_included (gmap_ra (R:(V)ra)) @@ -1363,8 +1363,8 @@ PROOF static thm prove_gmap_ra_included_singleton(void) { thm at_key = spec_rule(`key:K`, pointwise); at_key = rewrite_rule( THM_LIST( - FINMAP_SINGLETON_LOOKUP, - OPTION_RA_INCLUDED_SOME_SOME), + finmap_singleton_lookup, + option_ra_included_some_some), at_key); ACCEPT_TAC(forward, at_key); @@ -1396,7 +1396,7 @@ PROOF static thm prove_gmap_ra_included_singleton(void) { `key:K`, `a:V`, `base_frame:V`), - GMAP_RA_SINGLETON_OP); + gmap_ra_singleton_op); ACCEPT_TAC( reverse, trans_rule( @@ -1405,7 +1405,7 @@ PROOF static thm prove_gmap_ra_included_singleton(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_INCLUDED_SINGLETON = +PROOF thm gmap_ra_included_singleton = prove_gmap_ra_included_singleton(); PROOF static thm prove_gmap_lookup_included_empty(void) { @@ -1420,15 +1420,15 @@ PROOF static thm prove_gmap_lookup_included_empty(void) { TERM_LIST( `gmap_ra (R:(V)ra):((K,V)finmap)ra`, `n:(K,V)finmap`), - RA_INCLUDED_UNIT); + ra_included_unit); unit_included = rewrite_rule( - THM_LIST(GMAP_RA_UNIT), + THM_LIST(gmap_ra_unit), unit_included); ACCEPT_TAC(body, unit_included); return gnode_prove(root); } -PROOF static thm GMAP_LOOKUP_INCLUDED_EMPTY = +PROOF static thm gmap_lookup_included_empty = prove_gmap_lookup_included_empty(); PROOF static thm prove_gmap_lookup_included_insert(void) { @@ -1469,7 +1469,7 @@ PROOF static thm prove_gmap_lookup_included_insert(void) { `)); thm included_at_key = spec_rule(`key:K`, pointwise); included_at_key = rewrite_rule( - THM_LIST(FINMAP_INSERT_LOOKUP), + THM_LIST(finmap_insert_lookup), included_at_key); gnode_list target_cases = CASES_TAC( @@ -1489,7 +1489,7 @@ PROOF static thm prove_gmap_lookup_included_insert(void) { TERM_LIST( `R:(V)ra`, `a:V`), - OPTION_RA_NOT_INCLUDED_SOME_NONE), + option_ra_not_included_some_none), impossible_inclusion)); thm target_some = assume_rule(gnode_get_asmps( @@ -1501,7 +1501,7 @@ PROOF static thm prove_gmap_lookup_included_insert(void) { thm payload_included = rewrite_rule( THM_LIST( target_some, - OPTION_RA_INCLUDED_SOME_SOME), + option_ra_included_some_some), included_at_key); term rest_pointwise = ` @@ -1524,20 +1524,20 @@ PROOF static thm prove_gmap_lookup_included_insert(void) { query_cases[0], rewrite_conv, THM_LIST( - FINMAP_DELETE_LOOKUP, - OPTION_RA_INCLUDED_NONE)); + finmap_delete_lookup, + option_ra_included_none)); thm original_query = spec_rule(`query:K`, pointwise); original_query = rewrite_rule( THM_LIST( assume_rule(`~((query:K) == (key:K))`), - FINMAP_INSERT_LOOKUP, - FINMAP_DELETE_LOOKUP), + finmap_insert_lookup, + finmap_delete_lookup), original_query); gnode rest_ne = CONV_WITH_ASMP_TAC( query_cases[1], rewrite_conv, - THM_LIST(FINMAP_DELETE_LOOKUP)); + THM_LIST(finmap_delete_lookup)); ACCEPT_TAC(rest_ne, original_query); thm rest_included = mp_rule( @@ -1559,7 +1559,7 @@ PROOF static thm prove_gmap_lookup_included_insert(void) { `key:K`, `a:V`, b), - GMAP_RA_INCLUDED_SINGLETON)), + gmap_ra_included_singleton)), payload_included); thm combined_included = mp_rule( mp_rule( @@ -1570,7 +1570,7 @@ PROOF static thm prove_gmap_lookup_included_insert(void) { singleton_b, `m:(K,V)finmap`, `finmap_delete (key:K) (n:(K,V)finmap)`), - RA_INCLUDED_OP_MONO), + ra_included_op_mono), singleton_included), rest_included); thm source_composition = mp_rule( @@ -1580,7 +1580,7 @@ PROOF static thm prove_gmap_lookup_included_insert(void) { `key:K`, `a:V`, `m:(K,V)finmap`), - GMAP_RA_SINGLETON_OP_FRESH), + gmap_ra_singleton_op_fresh), assume_rule(` finmap_lookup (m:(K,V)finmap) (key:K) == NONE `)); @@ -1591,7 +1591,7 @@ PROOF static thm prove_gmap_lookup_included_insert(void) { `key:K`, b, `n:(K,V)finmap`), - GMAP_RA_DECOMPOSE), + gmap_ra_decompose), target_some); combined_included = rewrite_rule( THM_LIST( @@ -1602,7 +1602,7 @@ PROOF static thm prove_gmap_lookup_included_insert(void) { return gnode_prove(root); } -PROOF static thm GMAP_LOOKUP_INCLUDED_INSERT = +PROOF static thm gmap_lookup_included_insert = prove_gmap_lookup_included_insert(); PROOF static thm prove_gmap_ra_included_of_lookup(void) { @@ -1627,17 +1627,17 @@ PROOF static thm prove_gmap_ra_included_of_lookup(void) { gmap_lookup_included (R:(V)ra) source target ==> ra_included (gmap_ra R) source target `; - thm induction = beta_rule(ispec_rule(property, FINMAP_INDUCT)); + thm induction = beta_rule(ispec_rule(property, finmap_induct)); induction = mp_rule( induction, ispec_rule( `R:(V)ra`, - GMAP_LOOKUP_INCLUDED_EMPTY)); + gmap_lookup_included_empty)); induction = mp_rule( induction, ispec_rule( `R:(V)ra`, - GMAP_LOOKUP_INCLUDED_INSERT)); + gmap_lookup_included_insert)); thm selected_source = ispec_rule( `m:(K,V)finmap`, induction); @@ -1659,7 +1659,7 @@ PROOF static thm prove_gmap_ra_included_of_lookup(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_INCLUDED_OF_LOOKUP = +PROOF thm gmap_ra_included_of_lookup = prove_gmap_ra_included_of_lookup(); PROOF static thm prove_gmap_ra_included_lookup_iff(void) { @@ -1687,7 +1687,7 @@ PROOF static thm prove_gmap_ra_included_lookup_iff(void) { `R:(V)ra`, `m:(K,V)finmap`, `n:(K,V)finmap`), - GMAP_RA_INCLUDED_LOOKUP), + gmap_ra_included_lookup), assume_rule(` ra_included (gmap_ra (R:(V)ra)) @@ -1703,7 +1703,7 @@ PROOF static thm prove_gmap_ra_included_lookup_iff(void) { `R:(V)ra`, `m:(K,V)finmap`, `n:(K,V)finmap`), - GMAP_RA_INCLUDED_OF_LOOKUP), + gmap_ra_included_of_lookup), assume_rule(` forall k:K. ra_included @@ -1714,7 +1714,7 @@ PROOF static thm prove_gmap_ra_included_lookup_iff(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_INCLUDED_LOOKUP_IFF = +PROOF thm gmap_ra_included_lookup_iff = prove_gmap_ra_included_lookup_iff(); PROOF static thm prove_gmap_ra_included_delete(void) { @@ -1733,7 +1733,7 @@ PROOF static thm prove_gmap_ra_included_delete(void) { body = CONV_TAC( body, once_rewrite_conv(THM_LIST( - GMAP_RA_INCLUDED_LOOKUP_IFF))); + gmap_ra_included_lookup_iff))); body = GEN_TAC(body, "query"); gnode_list cases = BOOL_CASES_TAC( body, `(query:K) == (key:K)`, "Hkey"); @@ -1745,7 +1745,7 @@ PROOF static thm prove_gmap_ra_included_delete(void) { cases[i], rewrite_conv(THM_LIST( branch, - FINMAP_DELETE_LOOKUP))); + finmap_delete_lookup))); if (i == 0) { ACCEPT_TAC( reduced_goal, @@ -1753,7 +1753,7 @@ PROOF static thm prove_gmap_ra_included_delete(void) { TERM_LIST( `R:(V)ra`, `finmap_lookup (m:(K,V)finmap) (key:K)`), - OPTION_RA_INCLUDED_NONE)); + option_ra_included_none)); } else { ACCEPT_TAC( reduced_goal, @@ -1761,13 +1761,13 @@ PROOF static thm prove_gmap_ra_included_delete(void) { TERM_LIST( `option_ra (R:(V)ra)`, `finmap_lookup (m:(K,V)finmap) (query:K)`), - RA_INCLUDED_REFL)); + ra_included_refl)); } } return gnode_prove(root); } -PROOF thm GMAP_RA_INCLUDED_DELETE = +PROOF thm gmap_ra_included_delete = prove_gmap_ra_included_delete(); PROOF static thm prove_gmap_ra_included_lookup_some(void) { @@ -1794,7 +1794,7 @@ PROOF static thm prove_gmap_ra_included_lookup_some(void) { `R:(V)ra`, `m:(K,V)finmap`, `n:(K,V)finmap`), - GMAP_RA_INCLUDED_LOOKUP), + gmap_ra_included_lookup), assume_rule(` ra_included (gmap_ra (R:(V)ra)) @@ -1827,7 +1827,7 @@ PROOF static thm prove_gmap_ra_included_lookup_some(void) { TERM_LIST( `R:(V)ra`, `a:V`), - OPTION_RA_NOT_INCLUDED_SOME_NONE), + option_ra_not_included_some_none), impossible)); thm target_some = assume_rule(gnode_get_asmps( @@ -1839,7 +1839,7 @@ PROOF static thm prove_gmap_ra_included_lookup_some(void) { thm base_included = rewrite_rule( THM_LIST( target_some, - OPTION_RA_INCLUDED_SOME_SOME), + option_ra_included_some_some), at_key); ACCEPT_TAC(some_parts[1], base_included); @@ -1851,7 +1851,7 @@ PROOF static thm prove_gmap_ra_included_lookup_some(void) { `R:(V)ra`, `m:(K,V)finmap`, `n:(K,V)finmap`), - GMAP_RA_INCLUDED_OF_LOOKUP)); + gmap_ra_included_of_lookup)); reverse = GEN_TAC(reverse, "key"); gnode_list source_cases = CASES_TAC( reverse, @@ -1861,7 +1861,7 @@ PROOF static thm prove_gmap_ra_included_lookup_some(void) { CONV_WITH_ASMP_TAC( source_cases[0], rewrite_conv, - THM_LIST(OPTION_RA_INCLUDED_NONE)); + THM_LIST(option_ra_included_none)); thm source_some = assume_rule(gnode_get_asmps( source_cases[1], CONST_STRING_LIST("Hsource"))[0]); @@ -1893,7 +1893,7 @@ PROOF static thm prove_gmap_ra_included_lookup_some(void) { `R:(V)ra`, a, `b:V`), - OPTION_RA_INCLUDED_SOME_SOME)), + option_ra_included_some_some)), base_inclusion); lifted_inclusion = rewrite_rule( THM_LIST( @@ -1906,7 +1906,7 @@ PROOF static thm prove_gmap_ra_included_lookup_some(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_INCLUDED_LOOKUP_SOME = +PROOF thm gmap_ra_included_lookup_some = prove_gmap_ra_included_lookup_some(); PROOF static thm prove_gmap_ra_included_dom(void) { @@ -1926,7 +1926,7 @@ PROOF static thm prove_gmap_ra_included_dom(void) { `R:(V)ra`, `m:(K,V)finmap`, `n:(K,V)finmap`), - GMAP_RA_INCLUDED_LOOKUP_SOME), + gmap_ra_included_lookup_some), assume_rule(` ra_included (gmap_ra (R:(V)ra)) @@ -1944,7 +1944,7 @@ PROOF static thm prove_gmap_ra_included_dom(void) { TERM_LIST( `key:K`, `m:(K,V)finmap`), - FINMAP_IN_DOM_SOME), + finmap_in_dom_some), assume_rule(` (key:K) IN finmap_dom (m:(K,V)finmap) `)); @@ -1980,12 +1980,12 @@ PROOF static thm prove_gmap_ra_included_dom(void) { TERM_LIST( `key:K`, `n:(K,V)finmap`), - FINMAP_IN_DOM_SOME)), + finmap_in_dom_some)), target_present)); return gnode_prove(root); } -PROOF thm GMAP_RA_INCLUDED_DOM = +PROOF thm gmap_ra_included_dom = prove_gmap_ra_included_dom(); /* Lift an existing-key base local update while retaining the original map at @@ -2023,7 +2023,7 @@ PROOF static thm prove_gmap_ra_local_update_at(void) { thm source_all = eq_mp_rule( ispecl_rule( TERM_LIST(`R:(V)ra`, `m:(K,V)finmap`), - GMAP_RA_VALID), + gmap_ra_valid), assume_rule(` ra_valid ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) @@ -2049,8 +2049,8 @@ PROOF static thm prove_gmap_ra_local_update_at(void) { assume_rule(` finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) `), - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP), + gmap_ra_op_lookup, + finmap_singleton_lookup), source_key_eq); thm option_local = eq_mp_rule( @@ -2061,7 +2061,7 @@ PROOF static thm prove_gmap_ra_local_update_at(void) { `f:V`, `b:V`, `g:V`), - OPTION_RA_LOCAL_UPDATE_IFF)), + option_ra_local_update_iff)), assume_rule(` ra_local_update (R:(V)ra) @@ -2080,7 +2080,7 @@ PROOF static thm prove_gmap_ra_local_update_at(void) { `finmap_lookup (residual:(K,V)finmap) (key:K)`), - RA_LOCAL_UPDATE_APPLY); + ra_local_update_apply); thm option_result = mp_rule( mp_rule( mp_rule(option_apply, option_local), @@ -2092,7 +2092,7 @@ PROOF static thm prove_gmap_ra_local_update_at(void) { thm target_payload_valid = eq_mp_rule( ispecl_rule( TERM_LIST(`R:(V)ra`, `b:V`), - OPTION_RA_VALID_SOME), + option_ra_valid_some), conjunct1_rule(option_result)); thm source_delete_valid = mp_rule( ispecl_rule( @@ -2100,7 +2100,7 @@ PROOF static thm prove_gmap_ra_local_update_at(void) { `R:(V)ra`, `key:K`, `m:(K,V)finmap`), - GMAP_RA_VALID_DELETE), + gmap_ra_valid_delete), assume_rule(` ra_valid ((gmap_ra (R:(V)ra)):((K,V)finmap)ra) @@ -2113,13 +2113,13 @@ PROOF static thm prove_gmap_ra_local_update_at(void) { `key:K`, `b:V`, `m:(K,V)finmap`), - GMAP_RA_VALID_INSERT)), + gmap_ra_valid_insert)), conj_rule(target_payload_valid, source_delete_valid)); ACCEPT_TAC(result[0], target_valid); gnode target_eq = CONV_TAC( result[1], - once_rewrite_conv(THM_LIST(FINMAP_EQ_LOOKUP))); + once_rewrite_conv(THM_LIST(finmap_eq_lookup))); target_eq = GEN_TAC(target_eq, "query"); gnode_list query_cases = BOOL_CASES_TAC( target_eq, `(query:K) == (key:K)`, "Hkey"); @@ -2131,10 +2131,10 @@ PROOF static thm prove_gmap_ra_local_update_at(void) { query_cases[i], rewrite_conv(THM_LIST( branch, - FINMAP_INSERT_LOOKUP, - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP, - OPTION_RA_OP_NONE_L))); + finmap_insert_lookup, + gmap_ra_op_lookup, + finmap_singleton_lookup, + option_ra_op_none_l))); if (i == 0) { thm target_key_eq = rewrite_rule( THM_LIST(branch), @@ -2153,9 +2153,9 @@ PROOF static thm prove_gmap_ra_local_update_at(void) { source_at = rewrite_rule( THM_LIST( branch, - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP, - OPTION_RA_OP_NONE_L), + gmap_ra_op_lookup, + finmap_singleton_lookup, + option_ra_op_none_l), source_at); ACCEPT_TAC(reduced, source_at); } @@ -2163,7 +2163,7 @@ PROOF static thm prove_gmap_ra_local_update_at(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_LOCAL_UPDATE_AT = +PROOF thm gmap_ra_local_update_at = prove_gmap_ra_local_update_at(); /* @@ -2207,7 +2207,7 @@ PROOF static thm prove_gmap_ra_update_singleton(void) { (gmap_ra (R:(V)ra)) (finmap_singleton (key:K) (a:V)) (frame:(K,V)finmap)`), - GMAP_RA_VALID); + gmap_ra_valid); thm source_all = eq_mp_rule( source_valid_rule, assume_rule(` @@ -2225,12 +2225,12 @@ PROOF static thm prove_gmap_ra_update_singleton(void) { `R:(V)ra`, `a:V`, `b:V`), - OPTION_RA_UPDATE), + option_ra_update), assume_rule(`ra_update (R:(V)ra) (a:V) (b:V)`)); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(GMAP_RA_VALID))); + once_rewrite_conv(THM_LIST(gmap_ra_valid))); body = GEN_TAC(body, "query"); thm source_at = spec_rule(`query:K`, source_all); gnode_list cases = BOOL_CASES_TAC( @@ -2242,17 +2242,17 @@ PROOF static thm prove_gmap_ra_update_singleton(void) { thm normalized_source = rewrite_rule( THM_LIST( branch, - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP, - OPTION_RA_OP_NONE_L), + gmap_ra_op_lookup, + finmap_singleton_lookup, + option_ra_op_none_l), source_at); gnode reduced_goal = CONV_TAC( cases[i], rewrite_conv(THM_LIST( branch, - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP, - OPTION_RA_OP_NONE_L))); + gmap_ra_op_lookup, + finmap_singleton_lookup, + option_ra_op_none_l))); if (i == 0) { thm updated = mp_rule( mp_rule( @@ -2264,7 +2264,7 @@ PROOF static thm prove_gmap_ra_update_singleton(void) { `finmap_lookup (frame:(K,V)finmap) (key:K)`), - RA_UPDATE_APPLY), + ra_update_apply), option_update), normalized_source); ACCEPT_TAC(reduced_goal, updated); @@ -2275,7 +2275,7 @@ PROOF static thm prove_gmap_ra_update_singleton(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_UPDATE_SINGLETON = +PROOF thm gmap_ra_update_singleton = prove_gmap_ra_update_singleton(); /* Factor an inserted map into a singleton and the deleted remainder, frame @@ -2303,7 +2303,7 @@ PROOF static thm prove_gmap_ra_update_insert(void) { `key:K`, `a:V`, `b:V`), - GMAP_RA_UPDATE_SINGLETON), + gmap_ra_update_singleton), assume_rule(`ra_update (R:(V)ra) (a:V) (b:V)`)); thm framed_update = mp_rule( ispecl_rule( @@ -2312,7 +2312,7 @@ PROOF static thm prove_gmap_ra_update_insert(void) { `finmap_singleton (key:K) (a:V)`, `finmap_singleton (key:K) (b:V)`, `finmap_delete (key:K) (m:(K,V)finmap)`), - RA_UPDATE_FRAME), + ra_update_frame), singleton_update); thm source_factorization = ispecl_rule( TERM_LIST( @@ -2320,14 +2320,14 @@ PROOF static thm prove_gmap_ra_update_insert(void) { `key:K`, `a:V`, `m:(K,V)finmap`), - GMAP_RA_SINGLETON_OP_DELETE); + gmap_ra_singleton_op_delete); thm target_factorization = ispecl_rule( TERM_LIST( `R:(V)ra`, `key:K`, `b:V`, `m:(K,V)finmap`), - GMAP_RA_SINGLETON_OP_DELETE); + gmap_ra_singleton_op_delete); ACCEPT_TAC( body, rewrite_rule( @@ -2338,7 +2338,7 @@ PROOF static thm prove_gmap_ra_update_insert(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_UPDATE_INSERT = +PROOF thm gmap_ra_update_insert = prove_gmap_ra_update_insert(); PROOF static thm prove_gmap_ra_update_at(void) { @@ -2366,7 +2366,7 @@ PROOF static thm prove_gmap_ra_update_at(void) { `a:V`, `b:V`, `m:(K,V)finmap`), - GMAP_RA_UPDATE_INSERT), + gmap_ra_update_insert), assume_rule(`ra_update (R:(V)ra) (a:V) (b:V)`)); thm source_identity = mp_rule( ispecl_rule( @@ -2374,7 +2374,7 @@ PROOF static thm prove_gmap_ra_update_at(void) { `key:K`, `a:V`, `m:(K,V)finmap`), - FINMAP_INSERT_ID), + finmap_insert_id), assume_rule(` finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) `)); @@ -2384,7 +2384,7 @@ PROOF static thm prove_gmap_ra_update_at(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_UPDATE_AT = +PROOF thm gmap_ra_update_at = prove_gmap_ra_update_at(); PROOF static thm prove_gmap_ra_drop_at(void) { @@ -2405,28 +2405,28 @@ PROOF static thm prove_gmap_ra_drop_at(void) { `R:(V)ra`, `key:K`, `m:(K,V)finmap`), - GMAP_RA_INCLUDED_DELETE); + gmap_ra_included_delete); thm delete_update = mp_rule( ispecl_rule( TERM_LIST( `(gmap_ra (R:(V)ra)):((K,V)finmap)ra`, `m:(K,V)finmap`, `finmap_delete (key:K) (m:(K,V)finmap)`), - RA_UPDATE_INCLUDED), + ra_update_included), delete_included); ACCEPT_TAC(body, delete_update); return gnode_prove(root); } -PROOF thm GMAP_RA_DROP_AT = +PROOF thm gmap_ra_drop_at = prove_gmap_ra_drop_at(); /* * The nondeterministic lift selects an exact SOME payload at the chosen key - * using OPTION_RA_UPDATEP, then packages that payload as an exact singleton + * using option_ra_updateP, then packages that payload as an exact singleton * map. Other keys again retain the source frame validity unchanged. */ -PROOF static thm prove_gmap_ra_updatep_singleton(void) { +PROOF static thm prove_gmap_ra_updateP_singleton(void) { term goal_tm = ` forall (R:(V)ra) (key:K) (a:V) (P:V->bool). ra_updateP R a P ==> @@ -2454,7 +2454,7 @@ PROOF static thm prove_gmap_ra_updatep_singleton(void) { (gmap_ra (R:(V)ra)) (finmap_singleton (key:K) (a:V)) (frame:(K,V)finmap)`), - GMAP_RA_VALID); + gmap_ra_valid); thm source_all = eq_mp_rule( source_valid_rule, assume_rule(` @@ -2468,8 +2468,8 @@ PROOF static thm prove_gmap_ra_updatep_singleton(void) { thm source_key = spec_rule(`key:K`, source_all); source_key = rewrite_rule( THM_LIST( - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP), + gmap_ra_op_lookup, + finmap_singleton_lookup), source_key); thm option_update = mp_rule( @@ -2478,7 +2478,7 @@ PROOF static thm prove_gmap_ra_updatep_singleton(void) { `R:(V)ra`, `a:V`, `P:V->bool`), - OPTION_RA_UPDATEP), + option_ra_updateP), assume_rule(` ra_updateP (R:(V)ra) (a:V) (P:V->bool) `)); @@ -2541,7 +2541,7 @@ PROOF static thm prove_gmap_ra_updatep_singleton(void) { gnode validity = CONV_TAC( result_parts[1], - once_rewrite_conv(THM_LIST(GMAP_RA_VALID))); + once_rewrite_conv(THM_LIST(gmap_ra_valid))); validity = GEN_TAC(validity, "query"); thm source_at = spec_rule(`query:K`, source_all); gnode_list cases = BOOL_CASES_TAC( @@ -2554,9 +2554,9 @@ PROOF static thm prove_gmap_ra_updatep_singleton(void) { cases[i], rewrite_conv(THM_LIST( branch, - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP, - OPTION_RA_OP_NONE_L))); + gmap_ra_op_lookup, + finmap_singleton_lookup, + option_ra_op_none_l))); if (i == 0) { ACCEPT_TAC( reduced_goal, @@ -2574,9 +2574,9 @@ PROOF static thm prove_gmap_ra_updatep_singleton(void) { thm normalized_source = rewrite_rule( THM_LIST( branch, - GMAP_RA_OP_LOOKUP, - FINMAP_SINGLETON_LOOKUP, - OPTION_RA_OP_NONE_L), + gmap_ra_op_lookup, + finmap_singleton_lookup, + option_ra_op_none_l), source_at); ACCEPT_TAC(reduced_goal, normalized_source); } @@ -2584,13 +2584,13 @@ PROOF static thm prove_gmap_ra_updatep_singleton(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_UPDATEP_SINGLETON = - prove_gmap_ra_updatep_singleton(); +PROOF thm gmap_ra_updateP_singleton = + prove_gmap_ra_updateP_singleton(); /* Frame the exact singleton image by the deleted remainder. ND * monotonicity then normalizes each selected singleton back to an insertion; * the selected payload remains free to depend on the hidden frame. */ -PROOF static thm prove_gmap_ra_updatep_insert(void) { +PROOF static thm prove_gmap_ra_updateP_insert(void) { term goal_tm = ` forall (R:(V)ra) @@ -2642,7 +2642,7 @@ PROOF static thm prove_gmap_ra_updatep_insert(void) { `key:K`, `a:V`, `P:V->bool`), - GMAP_RA_UPDATEP_SINGLETON), + gmap_ra_updateP_singleton), assume_rule(` ra_updateP (R:(V)ra) (a:V) (P:V->bool) `)); @@ -2653,7 +2653,7 @@ PROOF static thm prove_gmap_ra_updatep_insert(void) { `finmap_singleton (key:K) (a:V)`, singleton_image, `finmap_delete (key:K) (m:(K,V)finmap)`), - RA_UPDATEP_FRAME), + ra_updateP_frame), singleton_update); framed_update = beta_rule(framed_update); @@ -2663,7 +2663,7 @@ PROOF static thm prove_gmap_ra_updatep_insert(void) { `key:K`, `a:V`, `m:(K,V)finmap`), - GMAP_RA_SINGLETON_OP_DELETE); + gmap_ra_singleton_op_delete); framed_update = rewrite_rule( THM_LIST(source_factorization), framed_update); @@ -2674,7 +2674,7 @@ PROOF static thm prove_gmap_ra_updatep_insert(void) { `finmap_insert (key:K) (a:V) (m:(K,V)finmap)`, framed_image, insert_image), - RA_UPDATEP_MONO); + ra_updateP_mono); weakened = mp_rule(weakened, framed_update); weakened = beta_rule(weakened); body = MATCH_MP_TAC(body, weakened); @@ -2706,7 +2706,7 @@ PROOF static thm prove_gmap_ra_updatep_insert(void) { `key:K`, `b:V`, `m:(K,V)finmap`), - GMAP_RA_SINGLETON_OP_DELETE); + gmap_ra_singleton_op_delete); thm result_equality = rewrite_rule( THM_LIST( assume_rule(` @@ -2725,10 +2725,10 @@ PROOF static thm prove_gmap_ra_updatep_insert(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_UPDATEP_INSERT = - prove_gmap_ra_updatep_insert(); +PROOF thm gmap_ra_updateP_insert = + prove_gmap_ra_updateP_insert(); -PROOF static thm prove_gmap_ra_updatep_at(void) { +PROOF static thm prove_gmap_ra_updateP_at(void) { term goal_tm = ` forall (R:(V)ra) @@ -2755,7 +2755,7 @@ PROOF static thm prove_gmap_ra_updatep_at(void) { `a:V`, `P:V->bool`, `m:(K,V)finmap`), - GMAP_RA_UPDATEP_INSERT), + gmap_ra_updateP_insert), assume_rule(` ra_updateP (R:(V)ra) (a:V) (P:V->bool) `)); @@ -2765,7 +2765,7 @@ PROOF static thm prove_gmap_ra_updatep_at(void) { `key:K`, `a:V`, `m:(K,V)finmap`), - FINMAP_INSERT_ID), + finmap_insert_id), assume_rule(` finmap_lookup (m:(K,V)finmap) (key:K) == SOME (a:V) `)); @@ -2775,8 +2775,8 @@ PROOF static thm prove_gmap_ra_updatep_at(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_UPDATEP_AT = - prove_gmap_ra_updatep_at(); +PROOF thm gmap_ra_updateP_at = + prove_gmap_ra_updateP_at(); /* Pick the fresh key only after the hidden map frame has been introduced. * The common-freshness theorem is precisely where infinitude is used: both @@ -2819,7 +2819,7 @@ PROOF static thm prove_gmap_ra_alloc_strong_dep(void) { (gmap_ra (R:(V)ra)) (m:(K,V)finmap) (frame:(K,V)finmap)`), - GMAP_RA_VALID), + gmap_ra_valid), assume_rule(` ra_valid (gmap_ra (R:(V)ra)) @@ -2834,7 +2834,7 @@ PROOF static thm prove_gmap_ra_alloc_strong_dep(void) { `candidates:K->bool`, `m:(K,V)finmap`, `frame:(K,V)finmap`), - FINMAP_FRESH_IN_PAIR), + finmap_fresh_in_pair), assume_rule(`INFINITE (candidates:K->bool)`)); body = ASSUME_TAC(body, fresh, "Hfresh"); body = ASMP_EXISTS_TAC(body, "Hfresh", "key"); @@ -2894,11 +2894,11 @@ PROOF static thm prove_gmap_ra_alloc_strong_dep(void) { gnode validity = CONV_TAC( result_parts[1], - once_rewrite_conv(THM_LIST(GMAP_RA_VALID))); + once_rewrite_conv(THM_LIST(gmap_ra_valid))); validity = GEN_TAC(validity, "query"); thm source_at = spec_rule(`query:K`, source_all); source_at = rewrite_rule( - THM_LIST(GMAP_RA_OP_LOOKUP), + THM_LIST(gmap_ra_op_lookup), source_at); gnode_list cases = BOOL_CASES_TAC( validity, @@ -2910,15 +2910,15 @@ PROOF static thm prove_gmap_ra_alloc_strong_dep(void) { cases[0], rewrite_conv(THM_LIST( equal_key, - GMAP_RA_OP_LOOKUP, - FINMAP_INSERT_LOOKUP, + gmap_ra_op_lookup, + finmap_insert_lookup, assume_rule(` finmap_lookup (frame:(K,V)finmap) (key:K) == NONE `), - OPTION_RA_OP_NONE_R, - OPTION_RA_VALID_SOME))); + option_ra_op_none_r, + option_ra_valid_some))); ACCEPT_TAC(at_key, payload_valid); thm unequal_key = assume_rule(`~(query:K == key)`); @@ -2926,13 +2926,13 @@ PROOF static thm prove_gmap_ra_alloc_strong_dep(void) { cases[1], rewrite_conv(THM_LIST( unequal_key, - GMAP_RA_OP_LOOKUP, - FINMAP_INSERT_LOOKUP))); + gmap_ra_op_lookup, + finmap_insert_lookup))); ACCEPT_TAC(away, source_at); return gnode_prove(root); } -PROOF thm GMAP_RA_ALLOC_STRONG_DEP = +PROOF thm gmap_ra_alloc_strong_dep = prove_gmap_ra_alloc_strong_dep(); PROOF static thm prove_gmap_ra_alloc_strong(void) { @@ -2961,7 +2961,7 @@ PROOF static thm prove_gmap_ra_alloc_strong(void) { `candidates:K->bool`, `\key:K. a:V`, `m:(K,V)finmap`), - GMAP_RA_ALLOC_STRONG_DEP); + gmap_ra_alloc_strong_dep); allocated = beta_rule(allocated); allocated = mp_rule( allocated, @@ -2974,7 +2974,7 @@ PROOF static thm prove_gmap_ra_alloc_strong(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_ALLOC_STRONG = +PROOF thm gmap_ra_alloc_strong = prove_gmap_ra_alloc_strong(); PROOF static thm prove_gmap_ra_alloc(void) { @@ -3003,7 +3003,7 @@ PROOF static thm prove_gmap_ra_alloc(void) { `UNIV:K->bool`, `m:(K,V)finmap`, `a:V`), - GMAP_RA_ALLOC_STRONG), + gmap_ra_alloc_strong), assume_rule(`INFINITE (UNIV:K->bool)`)), assume_rule(`ra_valid (R:(V)ra) (a:V)`)); allocated = rewrite_rule( @@ -3015,7 +3015,7 @@ PROOF static thm prove_gmap_ra_alloc(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_ALLOC = +PROOF thm gmap_ra_alloc = prove_gmap_ra_alloc(); PROOF static thm prove_gmap_ra_alloc_cofinite(void) { @@ -3055,7 +3055,7 @@ PROOF static thm prove_gmap_ra_alloc_cofinite(void) { candidates, `m:(K,V)finmap`, `a:V`), - GMAP_RA_ALLOC_STRONG), + gmap_ra_alloc_strong), candidates_infinite), assume_rule(`ra_valid (R:(V)ra) (a:V)`)); allocated = rewrite_rule( @@ -3068,7 +3068,7 @@ PROOF static thm prove_gmap_ra_alloc_cofinite(void) { return gnode_prove(root); } -PROOF thm GMAP_RA_ALLOC_COFINITE = +PROOF thm gmap_ra_alloc_cofinite = prove_gmap_ra_alloc_cofinite(); PROOF static thm prove_gmap_ra_alloc_empty(void) { @@ -3092,82 +3092,82 @@ PROOF static thm prove_gmap_ra_alloc_empty(void) { `R:(V)ra`, `finmap_empty:(K,V)finmap`, `a:V`), - GMAP_RA_ALLOC), + gmap_ra_alloc), assume_rule(`INFINITE (UNIV:K->bool)`)), assume_rule(`ra_valid (R:(V)ra) (a:V)`)); allocated = rewrite_rule( THM_LIST( - FINMAP_EMPTY_LOOKUP, - FINMAP_INSERT_EMPTY, + finmap_empty_lookup, + finmap_insert_empty, get_theorem_by_name("AND_CLAUSES")), allocated); ACCEPT_TAC(body, allocated); return gnode_prove(root); } -PROOF thm GMAP_RA_ALLOC_EMPTY = +PROOF thm gmap_ra_alloc_empty = prove_gmap_ra_alloc_empty(); PROOF static int audit_gmap_ra(void) { thm_list audited_theorems = THM_LIST( gmap_raw_op_def, - GMAP_RAW_OP_SUPPORT, - GMAP_RAW_OP_FINITE, + gmap_raw_op_support, + gmap_raw_op_finite, gmap_op_def, - GMAP_OP_REP, - GMAP_OP_LOOKUP, + gmap_op_rep, + gmap_op_lookup, gmap_valid_def, - GMAP_OP_ASSOC, - GMAP_OP_COMM, - GMAP_OP_UNIT_L, - GMAP_VALID_EMPTY, - GMAP_VALID_OP_L, - GMAP_RA_LAWS, + gmap_op_assoc, + gmap_op_comm, + gmap_op_unit_l, + gmap_valid_empty, + gmap_valid_op_l, + gmap_ra_laws, gmap_ra_def, - GMAP_RA_UNIT, - GMAP_RA_OP_FN, - GMAP_RA_VALID_FN, - GMAP_RA_OP_LOOKUP, - GMAP_RA_OP_SINGLETON_AT, - GMAP_RA_OP_INSERT_INSERT, - GMAP_RA_OP_DELETE, - GMAP_RA_VALID, - GMAP_RA_VALID_LOOKUP_DELETE, - GMAP_RA_VALID_DELETE_SOME, - GMAP_RA_VALID_LOOKUP, - GMAP_RA_VALID_DELETE, - GMAP_RA_VALID_INSERT, - GMAP_RA_VALID_INSERT_OF_VALID, - GMAP_RA_VALID_INSERT_FRESH, - GMAP_RA_SINGLETON_OP, - GMAP_RA_SINGLETON_OP_FRESH, - GMAP_RA_DECOMPOSE, - GMAP_RA_SINGLETON_OP_DELETE, - GMAP_RA_DOM_OP, - GMAP_RA_VALID_SINGLETON, + gmap_ra_unit, + gmap_ra_op_fn, + gmap_ra_valid_fn, + gmap_ra_op_lookup, + gmap_ra_op_singleton_at, + gmap_ra_op_insert_insert, + gmap_ra_op_delete, + gmap_ra_valid, + gmap_ra_valid_lookup_delete, + gmap_ra_valid_delete_some, + gmap_ra_valid_lookup, + gmap_ra_valid_delete, + gmap_ra_valid_insert, + gmap_ra_valid_insert_of_valid, + gmap_ra_valid_insert_fresh, + gmap_ra_singleton_op, + gmap_ra_singleton_op_fresh, + gmap_ra_decompose, + gmap_ra_singleton_op_delete, + gmap_ra_dom_op, + gmap_ra_valid_singleton, gmap_lookup_included_def, - GMAP_RA_INCLUDED_LOOKUP, - GMAP_RA_INCLUDED_SINGLETON, - GMAP_LOOKUP_INCLUDED_EMPTY, - GMAP_LOOKUP_INCLUDED_INSERT, - GMAP_RA_INCLUDED_OF_LOOKUP, - GMAP_RA_INCLUDED_LOOKUP_IFF, - GMAP_RA_INCLUDED_DELETE, - GMAP_RA_INCLUDED_LOOKUP_SOME, - GMAP_RA_INCLUDED_DOM, - GMAP_RA_LOCAL_UPDATE_AT, - GMAP_RA_UPDATE_SINGLETON, - GMAP_RA_UPDATE_INSERT, - GMAP_RA_UPDATE_AT, - GMAP_RA_DROP_AT, - GMAP_RA_UPDATEP_SINGLETON, - GMAP_RA_UPDATEP_INSERT, - GMAP_RA_UPDATEP_AT, - GMAP_RA_ALLOC_STRONG_DEP, - GMAP_RA_ALLOC_STRONG, - GMAP_RA_ALLOC, - GMAP_RA_ALLOC_COFINITE, - GMAP_RA_ALLOC_EMPTY); + gmap_ra_included_lookup, + gmap_ra_included_singleton, + gmap_lookup_included_empty, + gmap_lookup_included_insert, + gmap_ra_included_of_lookup, + gmap_ra_included_lookup_iff, + gmap_ra_included_delete, + gmap_ra_included_lookup_some, + gmap_ra_included_dom, + gmap_ra_local_update_at, + gmap_ra_update_singleton, + gmap_ra_update_insert, + gmap_ra_update_at, + gmap_ra_drop_at, + gmap_ra_updateP_singleton, + gmap_ra_updateP_insert, + gmap_ra_updateP_at, + gmap_ra_alloc_strong_dep, + gmap_ra_alloc_strong, + gmap_ra_alloc, + gmap_ra_alloc_cofinite, + gmap_ra_alloc_empty); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { ENSURE_COND(!IS_NULL(audited_theorems[i]), diff --git a/theory/logic/gmap_ra.h b/theory/logic/gmap_ra.h index 1c9508f..c66bda2 100644 --- a/theory/logic/gmap_ra.h +++ b/theory/logic/gmap_ra.h @@ -1,58 +1,91 @@ #pragma once /* - * Pointwise finite-map resource algebras. + * Public interface for pointwise finite-map resource algebras. * - * `gmap_ra R:((K,V)finmap)ra` uses `option_ra R` at every key. The - * representation and support machinery stay private; clients observe maps - * through `finmap_lookup`, validity, inclusion, and the update rules below. + * `gmap_ra R : ((K,V)finmap)ra` interprets every lookup in `option_ra R`, so + * absent keys contribute the option-RA unit. Clients observe maps through the + * public finite-map lookup/domain API and the semantic rules below. Raw map + * representation and support computation remain private to `finmap`. */ #include "proof/theory/logic/finmap.h" #include "proof/theory/logic/local_update.h" #include "proof/theory/logic/option_ra.h" +/* ------------------------------------------------------------------------- */ +/* Pointwise algebra and validity */ +/* ------------------------------------------------------------------------- */ + /* `ra_unit (gmap_ra R) == finmap_empty`. */ -PROOF extern thm GMAP_RA_UNIT; +PROOF extern thm gmap_ra_unit; -/* Pointwise operation through `option_ra R`. */ -PROOF extern thm GMAP_RA_OP_LOOKUP; +/* + * `finmap_lookup (ra_op (gmap_ra R) m n) key == + * ra_op (option_ra R) (finmap_lookup m key) (finmap_lookup n key)`. + */ +PROOF extern thm gmap_ra_op_lookup; -/* Pointwise validity. */ -PROOF extern thm GMAP_RA_VALID; +/* Map validity is exactly pointwise validity in `option_ra R`. */ +PROOF extern thm gmap_ra_valid; -/* Singleton validity is exactly payload validity. */ -PROOF extern thm GMAP_RA_VALID_SINGLETON; +/* Singleton-map validity is exactly payload validity. */ +PROOF extern thm gmap_ra_valid_singleton; /* A present lookup in a valid map has a valid payload. */ -PROOF extern thm GMAP_RA_VALID_LOOKUP; +PROOF extern thm gmap_ra_valid_lookup; + +/* ------------------------------------------------------------------------- */ +/* Inclusion and decomposition */ +/* ------------------------------------------------------------------------- */ -/* Inclusion is characterized pointwise. */ -PROOF extern thm GMAP_RA_INCLUDED_LOOKUP_IFF; +/* Map inclusion is exactly pointwise inclusion in `option_ra R`. */ +PROOF extern thm gmap_ra_included_lookup_iff; /* Inclusion can only grow the finite domain. */ -PROOF extern thm GMAP_RA_INCLUDED_DOM; +PROOF extern thm gmap_ra_included_dom; + +/* + * A present binding decomposes into its singleton fragment and the map with + * that key deleted. + */ +PROOF extern thm gmap_ra_decompose; -/* Extract a present binding as a singleton RA fragment. */ -PROOF extern thm GMAP_RA_DECOMPOSE; +/* ------------------------------------------------------------------------- */ +/* Existing-key transformations */ +/* ------------------------------------------------------------------------- */ -/* Lift a payload local update at an existing key. */ -PROOF extern thm GMAP_RA_LOCAL_UPDATE_AT; +/* Lift a payload local update at a key whose current payload is known. */ +PROOF extern thm gmap_ra_local_update_at; /* Lift a deterministic payload update at an existing key. */ -PROOF extern thm GMAP_RA_UPDATE_AT; +PROOF extern thm gmap_ra_update_at; -/* Lift a predicate payload update at an existing key. */ -PROOF extern thm GMAP_RA_UPDATEP_AT; +/* + * Lift a payload predicate update at an existing key, exposing an exact + * `finmap_insert` result for the selected payload. + */ +PROOF extern thm gmap_ra_updateP_at; -/* Drop this fragment's contribution at one key. */ -PROOF extern thm GMAP_RA_DROP_AT; +/* + * Delete this fragment's contribution at one key. This does not assert that + * the key is absent from a hidden frame or globally absent. + */ +PROOF extern thm gmap_ra_drop_at; -/* Fresh allocation with key-dependent payload and candidate set. */ -PROOF extern thm GMAP_RA_ALLOC_STRONG_DEP; +/* ------------------------------------------------------------------------- */ +/* Fresh allocation */ +/* ------------------------------------------------------------------------- */ + +/* + * Allocate a key-dependent valid payload from an infinite candidate set. + * The chosen fresh key remains inside the `ra_updateP` result predicate and + * may therefore depend on the hidden frame. + */ +PROOF extern thm gmap_ra_alloc_strong_dep; -/* Fresh allocation on an infinite key type. */ -PROOF extern thm GMAP_RA_ALLOC; +/* Allocate a fixed valid payload when the key type is infinite. */ +PROOF extern thm gmap_ra_alloc; -/* Fresh allocation while avoiding a finite forbidden set. */ -PROOF extern thm GMAP_RA_ALLOC_COFINITE; +/* Allocate a fixed valid payload while avoiding a finite forbidden set. */ +PROOF extern thm gmap_ra_alloc_cofinite; diff --git a/theory/logic/gmap_ra_internal.h b/theory/logic/gmap_ra_internal.h index 11e6c01..0dfb3b4 100644 --- a/theory/logic/gmap_ra_internal.h +++ b/theory/logic/gmap_ra_internal.h @@ -1,11 +1,21 @@ #pragma once -/* Constructor/adapter-only helpers for the pointwise finite-map RA. */ +/* + * INTERNAL finite-map RA rules for dependent constructors and adapters. + * Ordinary clients use `gmap_ra.h`; this header must not be re-exported. + */ #include "proof/theory/logic/gmap_ra.h" -PROOF extern thm GMAP_RA_SINGLETON_OP; -PROOF extern thm GMAP_RA_SINGLETON_OP_FRESH; -PROOF extern thm GMAP_RA_UPDATE_SINGLETON; -PROOF extern thm GMAP_RA_UPDATEP_SINGLETON; -PROOF extern thm GMAP_RA_ALLOC_STRONG; +/* Same-key singleton composition. */ +PROOF extern thm gmap_ra_singleton_op; + +/* Compose a singleton with a map at a fresh key to obtain `finmap_insert`. */ +PROOF extern thm gmap_ra_singleton_op_fresh; + +/* Lift deterministic and predicate updates to exact singleton-map images. */ +PROOF extern thm gmap_ra_update_singleton; +PROOF extern thm gmap_ra_updateP_singleton; + +/* Fixed-payload allocation from an arbitrary infinite candidate set. */ +PROOF extern thm gmap_ra_alloc_strong; diff --git a/theory/logic/local_update.c b/theory/logic/local_update.c index 9d44aa1..e211a92 100644 --- a/theory/logic/local_update.c +++ b/theory/logic/local_update.c @@ -49,7 +49,7 @@ PROOF static thm prove_ra_local_update_apply(void) { return gnode_prove(root); } -PROOF thm RA_LOCAL_UPDATE_APPLY = +PROOF thm ra_local_update_apply = prove_ra_local_update_apply(); PROOF static thm prove_ra_local_update_refl(void) { @@ -74,7 +74,7 @@ PROOF static thm prove_ra_local_update_refl(void) { return gnode_prove(root); } -PROOF thm RA_LOCAL_UPDATE_REFL = +PROOF thm ra_local_update_refl = prove_ra_local_update_refl(); PROOF static thm prove_ra_local_update_trans(void) { @@ -122,7 +122,7 @@ PROOF static thm prove_ra_local_update_trans(void) { return gnode_prove(root); } -PROOF thm RA_LOCAL_UPDATE_TRANS = +PROOF thm ra_local_update_trans = prove_ra_local_update_trans(); PROOF static thm prove_ra_local_update_frame(void) { @@ -151,7 +151,7 @@ PROOF static thm prove_ra_local_update_frame(void) { `), ispecl_rule( TERM_LIST(`R:(A)ra`, `f:A`, `extra:A`, `residual:A`), - RA_ASSOC)); + ra_assoc)); thm updated = mp_rule( mp_rule( spec_rule( @@ -172,12 +172,12 @@ PROOF static thm prove_ra_local_update_frame(void) { conjunct2_rule(updated), gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `g:A`, `extra:A`, `residual:A`), - RA_ASSOC))); + ra_assoc))); ACCEPT_TAC(result[1], target_reassociated); return gnode_prove(root); } -PROOF thm RA_LOCAL_UPDATE_FRAME = +PROOF thm ra_local_update_frame = prove_ra_local_update_frame(); PROOF static thm prove_ra_local_update_preserves_included(void) { @@ -217,7 +217,7 @@ PROOF static thm prove_ra_local_update_preserves_included(void) { `), ispecl_rule( TERM_LIST(`R:(A)ra`, `f:A`, `external:A`, `slack:A`), - RA_ASSOC)); + ra_assoc)); thm local_at_residual = ispecl_rule( TERM_LIST( `R:(A)ra`, @@ -226,7 +226,7 @@ PROOF static thm prove_ra_local_update_preserves_included(void) { `b:A`, `g:A`, `ra_op (R:(A)ra) (external:A) (slack:A)`), - RA_LOCAL_UPDATE_APPLY); + ra_local_update_apply); thm updated = mp_rule( mp_rule( mp_rule( @@ -247,11 +247,11 @@ PROOF static thm prove_ra_local_update_preserves_included(void) { conjunct2_rule(updated), gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `g:A`, `external:A`, `slack:A`), - RA_ASSOC)))); + ra_assoc)))); return gnode_prove(root); } -PROOF thm RA_LOCAL_UPDATE_PRESERVES_INCLUDED = +PROOF thm ra_local_update_preserves_included = prove_ra_local_update_preserves_included(); PROOF static thm prove_ra_local_update_op(void) { @@ -284,12 +284,12 @@ PROOF static thm prove_ra_local_update_op(void) { `))); thm swapped = ispecl_rule( TERM_LIST(`R:(A)ra`, `f:A`, `residual:A`, `piece:A`), - RA_OP_SWAP_RIGHT); + ra_op_swap_right); ACCEPT_TAC(result[1], trans_rule(lifted_source, swapped)); return gnode_prove(root); } -PROOF static thm RA_LOCAL_UPDATE_OP = +PROOF static thm ra_local_update_op = prove_ra_local_update_op(); PROOF static thm prove_ra_local_update_alloc(void) { @@ -304,7 +304,7 @@ PROOF static thm prove_ra_local_update_alloc(void) { body, ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`, `f:A`, `piece:A`), - RA_LOCAL_UPDATE_OP)); + ra_local_update_op)); body = DISCH_TAC(body, "Hvalid_source"); ACCEPT_TAC( body, @@ -316,7 +316,7 @@ PROOF static thm prove_ra_local_update_alloc(void) { return gnode_prove(root); } -PROOF thm RA_LOCAL_UPDATE_ALLOC = +PROOF thm ra_local_update_alloc = prove_ra_local_update_alloc(); PROOF static thm prove_ra_local_update_exclusive(void) { @@ -358,12 +358,12 @@ PROOF static thm prove_ra_local_update_exclusive(void) { trans_rule( gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `b:A`), - RA_UNIT_R)), + ra_unit_r)), gsym_rule(replace_frame))); return gnode_prove(root); } -PROOF thm RA_LOCAL_UPDATE_EXCLUSIVE = +PROOF thm ra_local_update_exclusive = prove_ra_local_update_exclusive(); PROOF static thm prove_ra_local_update_cancel(void) { @@ -383,7 +383,7 @@ PROOF static thm prove_ra_local_update_cancel(void) { mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `common:A`, `a:A`), - RA_VALID_OP_R), + ra_valid_op_r), assume_rule(` ra_valid (R:(A)ra) @@ -399,7 +399,7 @@ PROOF static thm prove_ra_local_update_cancel(void) { `), ispecl_rule( TERM_LIST(`R:(A)ra`, `common:A`, `f:A`, `residual:A`), - RA_ASSOC)); + ra_assoc)); thm cancelled = mp_rule( mp_rule( mp_rule( @@ -409,7 +409,7 @@ PROOF static thm prove_ra_local_update_cancel(void) { `common:A`, `a:A`, `ra_op (R:(A)ra) (f:A) (residual:A)`), - RA_CANCELLATIVE_APPLY), + ra_cancellative_apply), assume_rule(`ra_cancellative (R:(A)ra)`)), assume_rule(` ra_valid @@ -421,7 +421,7 @@ PROOF static thm prove_ra_local_update_cancel(void) { return gnode_prove(root); } -PROOF thm RA_LOCAL_UPDATE_CANCEL = +PROOF thm ra_local_update_cancel = prove_ra_local_update_cancel(); PROOF static thm prove_ra_local_update_cancel_unit(void) { @@ -438,18 +438,18 @@ PROOF static thm prove_ra_local_update_cancel_unit(void) { `common:A`, `a:A`, `ra_unit (R:(A)ra)`), - RA_LOCAL_UPDATE_CANCEL); + ra_local_update_cancel); result = mp_rule(result, assume_rule(`ra_cancellative (R:(A)ra)`)); result = rewrite_rule( THM_LIST(ispecl_rule( TERM_LIST(`R:(A)ra`, `common:A`), - RA_UNIT_R)), + ra_unit_r)), result); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF static thm RA_LOCAL_UPDATE_CANCEL_UNIT = +PROOF static thm ra_local_update_cancel_unit = prove_ra_local_update_cancel_unit(); PROOF static thm prove_ra_local_update_cancellative(void) { @@ -465,7 +465,7 @@ PROOF static thm prove_ra_local_update_cancellative(void) { thm cancelled = mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`, `common:A`), - RA_LOCAL_UPDATE_CANCEL_UNIT), + ra_local_update_cancel_unit), assume_rule(`ra_cancellative (R:(A)ra)`)); thm allocated = mp_rule( ispecl_rule( @@ -474,13 +474,13 @@ PROOF static thm prove_ra_local_update_cancellative(void) { `common:A`, `ra_unit (R:(A)ra)`, `b:A`), - RA_LOCAL_UPDATE_ALLOC), + ra_local_update_alloc), eq_mp_rule( ap_term_rule( `ra_valid (R:(A)ra)`, ispecl_rule( TERM_LIST(`R:(A)ra`, `b:A`, `common:A`), - RA_COMM)), + ra_comm)), assume_rule(` ra_valid (R:(A)ra) @@ -497,33 +497,33 @@ PROOF static thm prove_ra_local_update_cancellative(void) { `ra_unit (R:(A)ra)`, `ra_op (R:(A)ra) (common:A) (b:A)`, `ra_op (R:(A)ra) (ra_unit R) (b:A)`), - RA_LOCAL_UPDATE_TRANS), + ra_local_update_trans), cancelled), allocated); thm normalized = rewrite_rule( THM_LIST( - ispecl_rule(TERM_LIST(`R:(A)ra`, `common:A`, `b:A`), RA_COMM), - ispecl_rule(TERM_LIST(`R:(A)ra`, `b:A`), RA_UNIT_L)), + ispecl_rule(TERM_LIST(`R:(A)ra`, `common:A`, `b:A`), ra_comm), + ispecl_rule(TERM_LIST(`R:(A)ra`, `b:A`), ra_unit_l)), composed); ACCEPT_TAC(body, normalized); return gnode_prove(root); } -PROOF thm RA_LOCAL_UPDATE_CANCELLATIVE = +PROOF thm ra_local_update_cancellative = prove_ra_local_update_cancellative(); PROOF static int audit_local_update(void) { thm_list public_theorems = THM_LIST( ra_local_update_def, - RA_LOCAL_UPDATE_APPLY, - RA_LOCAL_UPDATE_REFL, - RA_LOCAL_UPDATE_TRANS, - RA_LOCAL_UPDATE_FRAME, - RA_LOCAL_UPDATE_PRESERVES_INCLUDED, - RA_LOCAL_UPDATE_ALLOC, - RA_LOCAL_UPDATE_EXCLUSIVE, - RA_LOCAL_UPDATE_CANCEL, - RA_LOCAL_UPDATE_CANCELLATIVE); + ra_local_update_apply, + ra_local_update_refl, + ra_local_update_trans, + ra_local_update_frame, + ra_local_update_preserves_included, + ra_local_update_alloc, + ra_local_update_exclusive, + ra_local_update_cancel, + ra_local_update_cancellative); for (size_t i = 0; i < vector_size(public_theorems); ++i) { ENSURE_COND(!IS_NULL(public_theorems[i]), diff --git a/theory/logic/local_update.h b/theory/logic/local_update.h index ac22c55..21186e2 100644 --- a/theory/logic/local_update.h +++ b/theory/logic/local_update.h @@ -1,16 +1,57 @@ #pragma once -/* Five-argument local updates preserving one unknown residual resource. */ +/* + * Five-argument local updates. + * + * `ra_local_update R a f b g` changes whole/local ownership `(a,f)` to + * `(b,g)` while preserving the same unknown residual. Here `a` and `b` are + * whole resources and `f` and `g` are the visible local fragments. + */ #include "proof/theory/logic/ra.h" +/* ------------------------------------------------------------------------- */ +/* Definition and elimination */ +/* ------------------------------------------------------------------------- */ + +/* + * `ra_local_update R a f b g <=> + * forall residual. + * ra_valid R a ==> + * a == ra_op R f residual ==> + * ra_valid R b && b == ra_op R g residual`. + */ PROOF extern thm ra_local_update_def; -PROOF extern thm RA_LOCAL_UPDATE_APPLY; -PROOF extern thm RA_LOCAL_UPDATE_REFL; -PROOF extern thm RA_LOCAL_UPDATE_TRANS; -PROOF extern thm RA_LOCAL_UPDATE_FRAME; -PROOF extern thm RA_LOCAL_UPDATE_PRESERVES_INCLUDED; -PROOF extern thm RA_LOCAL_UPDATE_ALLOC; -PROOF extern thm RA_LOCAL_UPDATE_EXCLUSIVE; -PROOF extern thm RA_LOCAL_UPDATE_CANCEL; -PROOF extern thm RA_LOCAL_UPDATE_CANCELLATIVE; + +/* Apply a local update to one explicit residual decomposition. */ +PROOF extern thm ra_local_update_apply; + +/* ------------------------------------------------------------------------- */ +/* Structural rules */ +/* ------------------------------------------------------------------------- */ + +/* Local updates are reflexive and compose while preserving the residual. */ +PROOF extern thm ra_local_update_refl; +PROOF extern thm ra_local_update_trans; + +/* Add the same explicit extra resource to both visible local fragments. */ +PROOF extern thm ra_local_update_frame; + +/* Preserve validity and inclusion in the presence of an external fragment. */ +PROOF extern thm ra_local_update_preserves_included; + +/* ------------------------------------------------------------------------- */ +/* Standard local updates */ +/* ------------------------------------------------------------------------- */ + +/* Allocate one piece into both the whole resource and visible fragment. */ +PROOF extern thm ra_local_update_alloc; + +/* Replace a complete exclusive visible fragment by any valid target. */ +PROOF extern thm ra_local_update_exclusive; + +/* Remove one common prefix from the whole and visible fragment. */ +PROOF extern thm ra_local_update_cancel; + +/* Synchronize a known residual across source and target in a cancellative RA. */ +PROOF extern thm ra_local_update_cancellative; diff --git a/theory/logic/max_nat_ra.c b/theory/logic/max_nat_ra.c index 2554547..9358443 100644 --- a/theory/logic/max_nat_ra.c +++ b/theory/logic/max_nat_ra.c @@ -36,7 +36,7 @@ PROOF static thm prove_max_nat_assoc_raw(void) { return gen_rule(a, natural_assoc); } -PROOF static thm MAX_NAT_ASSOC_RAW = +PROOF static thm max_nat_assoc_raw = prove_max_nat_assoc_raw(); PROOF static thm prove_max_nat_comm_raw(void) { @@ -54,7 +54,7 @@ PROOF static thm prove_max_nat_comm_raw(void) { return gen_rule(a, natural_comm); } -PROOF static thm MAX_NAT_COMM_RAW = +PROOF static thm max_nat_comm_raw = prove_max_nat_comm_raw(); PROOF static thm prove_max_nat_zero_left_raw(void) { @@ -68,7 +68,7 @@ PROOF static thm prove_max_nat_zero_left_raw(void) { return gen_rule(n, reduced); } -PROOF static thm MAX_NAT_ZERO_LEFT_RAW = +PROOF static thm max_nat_zero_left_raw = prove_max_nat_zero_left_raw(); PROOF static thm prove_max_nat_le_left_raw(void) { @@ -87,7 +87,7 @@ PROOF static thm prove_max_nat_le_left_raw(void) { return gen_rule(a, result); } -PROOF static thm MAX_NAT_LE_LEFT_RAW = +PROOF static thm max_nat_le_left_raw = prove_max_nat_le_left_raw(); PROOF static thm prove_max_nat_le_raw(void) { @@ -110,7 +110,7 @@ PROOF static thm prove_max_nat_le_raw(void) { return gen_rule(a, natural_bound); } -PROOF static thm MAX_NAT_LE_RAW = +PROOF static thm max_nat_le_raw = prove_max_nat_le_raw(); PROOF static thm prove_max_nat_eq_right_raw(void) { @@ -136,7 +136,7 @@ PROOF static thm prove_max_nat_eq_right_raw(void) { return gnode_prove(root); } -PROOF static thm MAX_NAT_EQ_RIGHT_RAW = +PROOF static thm max_nat_eq_right_raw = prove_max_nat_eq_right_raw(); /* ------------------------------------------------------------------------- */ @@ -166,7 +166,7 @@ PROOF static thm prove_max_nat_ra_laws(void) { assoc, rewrite_conv(THM_LIST( max_nat_op_def, - MAX_NAT_ASSOC_RAW))); + max_nat_assoc_raw))); gnode_list law2 = CONJ_TAC(law1[1]); gnode comm = AUTO_INTROS_TAC(law2[0]); @@ -174,7 +174,7 @@ PROOF static thm prove_max_nat_ra_laws(void) { comm, rewrite_conv(THM_LIST( max_nat_op_def, - MAX_NAT_COMM_RAW))); + max_nat_comm_raw))); gnode_list law3 = CONJ_TAC(law2[1]); gnode unit = AUTO_INTROS_TAC(law3[0]); @@ -182,7 +182,7 @@ PROOF static thm prove_max_nat_ra_laws(void) { unit, rewrite_conv(THM_LIST( max_nat_op_def, - MAX_NAT_ZERO_LEFT_RAW))); + max_nat_zero_left_raw))); gnode_list law4 = CONJ_TAC(law3[1]); CONV_TAC( @@ -194,7 +194,7 @@ PROOF static thm prove_max_nat_ra_laws(void) { return gnode_prove(root); } -PROOF static thm MAX_NAT_RA_LAWS = +PROOF static thm max_nat_ra_laws = prove_max_nat_ra_laws(); PROOF static thm max_nat_ra_def = new_fun_definition(` @@ -213,14 +213,14 @@ PROOF static thm prove_max_nat_ra_unit(void) { `0:num`, `max_nat_op:num->num->num`, `max_nat_valid:num->bool`), - RA_UNIT_ABS), - MAX_NAT_RA_LAWS); + ra_unit_abs), + max_nat_ra_laws); return pure_once_rewrite_rule( THM_LIST(gsym_rule(max_nat_ra_def)), computed); } -PROOF thm MAX_NAT_RA_UNIT = +PROOF thm max_nat_ra_unit = prove_max_nat_ra_unit(); PROOF static thm prove_max_nat_ra_op_fn(void) { @@ -230,14 +230,14 @@ PROOF static thm prove_max_nat_ra_op_fn(void) { `0:num`, `max_nat_op:num->num->num`, `max_nat_valid:num->bool`), - RA_OP_ABS), - MAX_NAT_RA_LAWS); + ra_op_abs), + max_nat_ra_laws); return pure_once_rewrite_rule( THM_LIST(gsym_rule(max_nat_ra_def)), computed); } -PROOF static thm MAX_NAT_RA_OP_FN = +PROOF static thm max_nat_ra_op_fn = prove_max_nat_ra_op_fn(); PROOF static thm prove_max_nat_ra_valid_fn(void) { @@ -247,14 +247,14 @@ PROOF static thm prove_max_nat_ra_valid_fn(void) { `0:num`, `max_nat_op:num->num->num`, `max_nat_valid:num->bool`), - RA_VALID_ABS), - MAX_NAT_RA_LAWS); + ra_valid_abs), + max_nat_ra_laws); return pure_once_rewrite_rule( THM_LIST(gsym_rule(max_nat_ra_def)), computed); } -PROOF static thm MAX_NAT_RA_VALID_FN = +PROOF static thm max_nat_ra_valid_fn = prove_max_nat_ra_valid_fn(); PROOF static thm prove_max_nat_ra_op(void) { @@ -266,12 +266,12 @@ PROOF static thm prove_max_nat_ra_op(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - MAX_NAT_RA_OP_FN, + max_nat_ra_op_fn, max_nat_op_def))); return gnode_prove(root); } -PROOF thm MAX_NAT_RA_OP = +PROOF thm max_nat_ra_op = prove_max_nat_ra_op(); PROOF static thm prove_max_nat_ra_valid(void) { @@ -282,12 +282,12 @@ PROOF static thm prove_max_nat_ra_valid(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - MAX_NAT_RA_VALID_FN, + max_nat_ra_valid_fn, max_nat_valid_def))); return gnode_prove(root); } -PROOF thm MAX_NAT_RA_VALID = +PROOF thm max_nat_ra_valid = prove_max_nat_ra_valid(); /* ------------------------------------------------------------------------- */ @@ -319,13 +319,13 @@ PROOF static thm prove_max_nat_ra_included(void) { `), ispecl_rule( TERM_LIST(`a:num`, `frame:num`), - MAX_NAT_RA_OP)); + max_nat_ra_op)); thm transport = beta_rule(ap_term_rule( `\x:num. (a:num) <= x`, framed)); thm lower_bound = ispecl_rule( TERM_LIST(`a:num`, `frame:num`), - MAX_NAT_LE_LEFT_RAW); + max_nat_le_left_raw); ACCEPT_TAC( forward, eq_mp_rule(gsym_rule(transport), lower_bound)); @@ -334,11 +334,11 @@ PROOF static thm prove_max_nat_ra_included(void) { reverse = EXISTS_TAC(reverse, `b:num`); thm op_computation = ispecl_rule( TERM_LIST(`a:num`, `b:num`), - MAX_NAT_RA_OP); + max_nat_ra_op); thm maximum = mp_rule( ispecl_rule( TERM_LIST(`a:num`, `b:num`), - MAX_NAT_EQ_RIGHT_RAW), + max_nat_eq_right_raw), assume_rule(`(a:num) <= (b:num)`)); ACCEPT_TAC( reverse, @@ -346,7 +346,7 @@ PROOF static thm prove_max_nat_ra_included(void) { return gnode_prove(root); } -PROOF thm MAX_NAT_RA_INCLUDED = +PROOF thm max_nat_ra_included = prove_max_nat_ra_included(); PROOF static thm prove_max_nat_ra_included_zero(void) { @@ -357,7 +357,7 @@ PROOF static thm prove_max_nat_ra_included_zero(void) { gnode body = GEN_TAC(root, "n"); thm characterization = ispecl_rule( TERM_LIST(`0`, `n:num`), - MAX_NAT_RA_INCLUDED); + max_nat_ra_included); thm zero_bound = spec_rule( `n:num`, get_theorem_by_name("LE_0")); @@ -367,7 +367,7 @@ PROOF static thm prove_max_nat_ra_included_zero(void) { return gnode_prove(root); } -PROOF static thm MAX_NAT_RA_INCLUDED_ZERO = +PROOF static thm max_nat_ra_included_zero = prove_max_nat_ra_included_zero(); PROOF static thm prove_max_nat_ra_included_op(void) { @@ -384,13 +384,13 @@ PROOF static thm prove_max_nat_ra_included_op(void) { CONV_TAC( body, rewrite_conv(THM_LIST( - MAX_NAT_RA_INCLUDED, - MAX_NAT_RA_OP, - MAX_NAT_LE_RAW))); + max_nat_ra_included, + max_nat_ra_op, + max_nat_le_raw))); return gnode_prove(root); } -PROOF static thm MAX_NAT_RA_INCLUDED_OP = +PROOF static thm max_nat_ra_included_op = prove_max_nat_ra_included_op(); PROOF static thm prove_max_nat_ra_idempotent(void) { @@ -401,11 +401,11 @@ PROOF static thm prove_max_nat_ra_idempotent(void) { gnode body = GEN_TAC(root, "n"); thm op_computation = ispecl_rule( TERM_LIST(`n:num`, `n:num`), - MAX_NAT_RA_OP); + max_nat_ra_op); thm maximum = mp_rule( ispecl_rule( TERM_LIST(`n:num`, `n:num`), - MAX_NAT_EQ_RIGHT_RAW), + max_nat_eq_right_raw), spec_rule(`n:num`, get_theorem_by_name("LE_REFL"))); ACCEPT_TAC( body, @@ -413,7 +413,7 @@ PROOF static thm prove_max_nat_ra_idempotent(void) { return gnode_prove(root); } -PROOF thm MAX_NAT_RA_IDEMPOTENT = +PROOF thm max_nat_ra_idempotent = prove_max_nat_ra_idempotent(); PROOF static thm prove_max_nat_ra_op_eq_right(void) { @@ -427,11 +427,11 @@ PROOF static thm prove_max_nat_ra_op_eq_right(void) { body = DISCH_TAC(body, "Hab"); thm op_computation = ispecl_rule( TERM_LIST(`a:num`, `b:num`), - MAX_NAT_RA_OP); + max_nat_ra_op); thm maximum = mp_rule( ispecl_rule( TERM_LIST(`a:num`, `b:num`), - MAX_NAT_EQ_RIGHT_RAW), + max_nat_eq_right_raw), assume_rule(`(a:num) <= (b:num)`)); ACCEPT_TAC( body, @@ -439,7 +439,7 @@ PROOF static thm prove_max_nat_ra_op_eq_right(void) { return gnode_prove(root); } -PROOF static thm MAX_NAT_RA_OP_EQ_RIGHT = +PROOF static thm max_nat_ra_op_eq_right = prove_max_nat_ra_op_eq_right(); PROOF static thm prove_max_nat_ra_op_eq_left(void) { @@ -454,14 +454,14 @@ PROOF static thm prove_max_nat_ra_op_eq_left(void) { thm op_computation = ispecl_rule( TERM_LIST(`a:num`, `b:num`), - MAX_NAT_RA_OP); + max_nat_ra_op); thm commute = ispecl_rule( TERM_LIST(`a:num`, `b:num`), - MAX_NAT_COMM_RAW); + max_nat_comm_raw); thm maximum = mp_rule( ispecl_rule( TERM_LIST(`b:num`, `a:num`), - MAX_NAT_EQ_RIGHT_RAW), + max_nat_eq_right_raw), assume_rule(`(b:num) <= (a:num)`)); ACCEPT_TAC( body, @@ -471,7 +471,7 @@ PROOF static thm prove_max_nat_ra_op_eq_left(void) { return gnode_prove(root); } -PROOF static thm MAX_NAT_RA_OP_EQ_LEFT = +PROOF static thm max_nat_ra_op_eq_left = prove_max_nat_ra_op_eq_left(); /* All frames are compatible because validity is total; choosing frame one @@ -491,9 +491,9 @@ PROOF static thm prove_max_nat_ra_not_exclusive(void) { spec_rule(`1`, exclusive), ispec_rule( `ra_op max_nat_ra (n:num) 1`, - MAX_NAT_RA_VALID)); + max_nat_ra_valid)); frame_is_unit = rewrite_rule( - THM_LIST(MAX_NAT_RA_UNIT), + THM_LIST(max_nat_ra_unit), frame_is_unit); thm contradiction = not_elim_rule( arith_rule(`~((1:num) == 0)`), @@ -502,7 +502,7 @@ PROOF static thm prove_max_nat_ra_not_exclusive(void) { return gnode_prove(root); } -PROOF static thm MAX_NAT_RA_NOT_EXCLUSIVE = +PROOF static thm max_nat_ra_not_exclusive = prove_max_nat_ra_not_exclusive(); /* The common frame one absorbs both zero and one, witnessing failure of @@ -514,16 +514,16 @@ PROOF static thm prove_max_nat_ra_not_cancellative(void) { thm left_op = mp_rule( ispecl_rule( TERM_LIST(`1`, `0`), - MAX_NAT_RA_OP_EQ_LEFT), + max_nat_ra_op_eq_left), spec_rule(`1`, get_theorem_by_name("LE_0"))); - thm right_op = ispec_rule(`1`, MAX_NAT_RA_IDEMPOTENT); + thm right_op = ispec_rule(`1`, max_nat_ra_idempotent); thm forced_equal = ispecl_rule( TERM_LIST( `max_nat_ra`, `1`, `0`, `1`), - RA_CANCELLATIVE_APPLY); + ra_cancellative_apply); forced_equal = mp_rule( forced_equal, assume_rule(`ra_cancellative max_nat_ra`)); @@ -531,7 +531,7 @@ PROOF static thm prove_max_nat_ra_not_cancellative(void) { forced_equal, ispec_rule( `ra_op max_nat_ra 1 0`, - MAX_NAT_RA_VALID)); + max_nat_ra_valid)); forced_equal = mp_rule( forced_equal, trans_rule(left_op, gsym_rule(right_op))); @@ -542,7 +542,7 @@ PROOF static thm prove_max_nat_ra_not_cancellative(void) { return gnode_prove(root); } -PROOF static thm MAX_NAT_RA_NOT_CANCELLATIVE = +PROOF static thm max_nat_ra_not_cancellative = prove_max_nat_ra_not_cancellative(); PROOF static thm prove_max_nat_ra_included_mono_right(void) { @@ -561,7 +561,7 @@ PROOF static thm prove_max_nat_ra_included_mono_right(void) { thm old_characterization = ispecl_rule( TERM_LIST(`fragment:num`, `old:num`), - MAX_NAT_RA_INCLUDED); + max_nat_ra_included); thm fragment_le_old = eq_mp_rule( old_characterization, assume_rule(` @@ -579,14 +579,14 @@ PROOF static thm prove_max_nat_ra_included_mono_right(void) { assume_rule(`(old:num) <= (new:num)`))); thm new_characterization = ispecl_rule( TERM_LIST(`fragment:num`, `new:num`), - MAX_NAT_RA_INCLUDED); + max_nat_ra_included); ACCEPT_TAC( body, eq_mp_rule(gsym_rule(new_characterization), fragment_le_new)); return gnode_prove(root); } -PROOF static thm MAX_NAT_RA_INCLUDED_MONO_RIGHT = +PROOF static thm max_nat_ra_included_mono_right = prove_max_nat_ra_included_mono_right(); /* ------------------------------------------------------------------------- */ @@ -615,11 +615,11 @@ PROOF static thm prove_max_nat_ra_update(void) { result[1], spec_rule( `ra_op max_nat_ra (new:num) (frame:num)`, - MAX_NAT_RA_VALID)); + max_nat_ra_valid)); return gnode_prove(root); } -PROOF thm MAX_NAT_RA_UPDATE = +PROOF thm max_nat_ra_update = prove_max_nat_ra_update(); PROOF static thm prove_max_nat_ra_updateP(void) { @@ -650,11 +650,11 @@ PROOF static thm prove_max_nat_ra_updateP(void) { result[1], spec_rule( `ra_op max_nat_ra (new:num) (frame:num)`, - MAX_NAT_RA_VALID)); + max_nat_ra_valid)); return gnode_prove(root); } -PROOF static thm MAX_NAT_RA_UPDATEP = +PROOF static thm max_nat_ra_updateP = prove_max_nat_ra_updateP(); PROOF static thm prove_max_nat_ra_updateP_iff(void) { @@ -674,7 +674,7 @@ PROOF static thm prove_max_nat_ra_updateP_iff(void) { `max_nat_ra:(num)ra`, `old:num`, `P:num->bool`), - RA_UPDATEP_VALID); + ra_updateP_valid); selected = mp_rule( selected, assume_rule(` @@ -685,7 +685,7 @@ PROOF static thm prove_max_nat_ra_updateP_iff(void) { `)); selected = mp_rule( selected, - ispec_rule(`old:num`, MAX_NAT_RA_VALID)); + ispec_rule(`old:num`, max_nat_ra_valid)); forward = ASSUME_TAC( forward, selected, "Hselected"); forward = ASMP_EXISTS_TAC( @@ -707,12 +707,12 @@ PROOF static thm prove_max_nat_ra_updateP_iff(void) { mp_rule( ispecl_rule( TERM_LIST(`old:num`, `P:num->bool`), - MAX_NAT_RA_UPDATEP), + max_nat_ra_updateP), assume_rule(`exists new:num. (P:num->bool) new`))); return gnode_prove(root); } -PROOF static thm MAX_NAT_RA_UPDATEP_IFF = +PROOF static thm max_nat_ra_updateP_iff = prove_max_nat_ra_updateP_iff(); /* ------------------------------------------------------------------------- */ @@ -721,33 +721,33 @@ PROOF static thm MAX_NAT_RA_UPDATEP_IFF = PROOF static int audit_max_nat_ra(void) { thm_list audited_theorems = THM_LIST( - MAX_NAT_ASSOC_RAW, - MAX_NAT_COMM_RAW, - MAX_NAT_ZERO_LEFT_RAW, - MAX_NAT_LE_LEFT_RAW, - MAX_NAT_LE_RAW, - MAX_NAT_EQ_RIGHT_RAW, + max_nat_assoc_raw, + max_nat_comm_raw, + max_nat_zero_left_raw, + max_nat_le_left_raw, + max_nat_le_raw, + max_nat_eq_right_raw, max_nat_op_def, max_nat_valid_def, - MAX_NAT_RA_LAWS, + max_nat_ra_laws, max_nat_ra_def, - MAX_NAT_RA_UNIT, - MAX_NAT_RA_OP_FN, - MAX_NAT_RA_VALID_FN, - MAX_NAT_RA_OP, - MAX_NAT_RA_VALID, - MAX_NAT_RA_INCLUDED, - MAX_NAT_RA_INCLUDED_ZERO, - MAX_NAT_RA_INCLUDED_OP, - MAX_NAT_RA_IDEMPOTENT, - MAX_NAT_RA_OP_EQ_RIGHT, - MAX_NAT_RA_OP_EQ_LEFT, - MAX_NAT_RA_NOT_EXCLUSIVE, - MAX_NAT_RA_NOT_CANCELLATIVE, - MAX_NAT_RA_INCLUDED_MONO_RIGHT, - MAX_NAT_RA_UPDATE, - MAX_NAT_RA_UPDATEP, - MAX_NAT_RA_UPDATEP_IFF); + max_nat_ra_unit, + max_nat_ra_op_fn, + max_nat_ra_valid_fn, + max_nat_ra_op, + max_nat_ra_valid, + max_nat_ra_included, + max_nat_ra_included_zero, + max_nat_ra_included_op, + max_nat_ra_idempotent, + max_nat_ra_op_eq_right, + max_nat_ra_op_eq_left, + max_nat_ra_not_exclusive, + max_nat_ra_not_cancellative, + max_nat_ra_included_mono_right, + max_nat_ra_update, + max_nat_ra_updateP, + max_nat_ra_updateP_iff); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { ENSURE_COND(!IS_NULL(audited_theorems[i]), diff --git a/theory/logic/max_nat_ra.h b/theory/logic/max_nat_ra.h index 493f3d4..04f9d82 100644 --- a/theory/logic/max_nat_ra.h +++ b/theory/logic/max_nat_ra.h @@ -1,7 +1,7 @@ #pragma once /* - * Natural-number maximum resource algebra. + * Public interface for the natural-number maximum resource algebra. * * `max_nat_ra:(num)ra` has unit `0`, operation `MAX`, and total validity. * It is a useful idempotent fragment algebra; monotone authority protocols @@ -11,20 +11,32 @@ #include "proof/theory/logic/ra.h" +/* ------------------------------------------------------------------------- */ +/* Algebra, validity, and order */ +/* ------------------------------------------------------------------------- */ + /* `ra_unit max_nat_ra == 0`. */ -PROOF extern thm MAX_NAT_RA_UNIT; +PROOF extern thm max_nat_ra_unit; /* `forall a b:num. ra_op max_nat_ra a b == MAX a b`. */ -PROOF extern thm MAX_NAT_RA_OP; +PROOF extern thm max_nat_ra_op; /* `forall n:num. ra_valid max_nat_ra n`. */ -PROOF extern thm MAX_NAT_RA_VALID; +PROOF extern thm max_nat_ra_valid; /* `forall a b:num. ra_included max_nat_ra a b <=> a <= b`. */ -PROOF extern thm MAX_NAT_RA_INCLUDED; +PROOF extern thm max_nat_ra_included; /* `forall n:num. ra_op max_nat_ra n n == n`. */ -PROOF extern thm MAX_NAT_RA_IDEMPOTENT; +PROOF extern thm max_nat_ra_idempotent; + +/* ------------------------------------------------------------------------- */ +/* Updates */ +/* ------------------------------------------------------------------------- */ -/* `forall a b:num. ra_update max_nat_ra a b`. */ -PROOF extern thm MAX_NAT_RA_UPDATE; +/* + * `forall a b:num. ra_update max_nat_ra a b`. + * Monotonicity is imposed by an enclosing authority protocol, not this base + * RA's frame-preserving update relation. + */ +PROOF extern thm max_nat_ra_update; diff --git a/theory/logic/named_logic.c b/theory/logic/named_logic.c index 8a2f539..123b322 100644 --- a/theory/logic/named_logic.c +++ b/theory/logic/named_logic.c @@ -38,15 +38,15 @@ PROOF static thm prove_named_own_op(void) { `named_ra (R:(A)ra)`, `finmap_singleton (name:num) (a:A)`, `finmap_singleton (name:num) (b:A)`), - R_OWN_OP); + r_own_op); result = rewrite_rule( - THM_LIST(NAMED_RA_SINGLETON_OP), + THM_LIST(named_ra_singleton_op), result); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm NAMED_OWN_OP = prove_named_own_op(); +PROOF thm named_own_op = prove_named_own_op(); PROOF static thm prove_named_own_valid(void) { term goal_tm = ` @@ -68,15 +68,15 @@ PROOF static thm prove_named_own_valid(void) { TERM_LIST( `named_ra (R:(A)ra)`, `finmap_singleton (name:num) (a:A)`), - R_OWN_VALID); + r_own_valid); result = rewrite_rule( - THM_LIST(NAMED_RA_VALID_SINGLETON), + THM_LIST(named_ra_valid_singleton), result); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm NAMED_OWN_VALID = prove_named_own_valid(); +PROOF thm named_own_valid = prove_named_own_valid(); PROOF static thm prove_named_own_update(void) { term goal_tm = ` @@ -95,7 +95,7 @@ PROOF static thm prove_named_own_update(void) { thm map_update = mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `name:num`, `a:A`, `b:A`), - NAMED_RA_UPDATE_SINGLETON), + named_ra_update_singleton), assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); thm result = mp_rule( ispecl_rule( @@ -103,15 +103,15 @@ PROOF static thm prove_named_own_update(void) { `named_ra (R:(A)ra)`, `finmap_singleton (name:num) (a:A)`, `finmap_singleton (name:num) (b:A)`), - R_OWN_UPDATE), + r_own_update), map_update); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm NAMED_OWN_UPDATE = prove_named_own_update(); +PROOF thm named_own_update = prove_named_own_update(); -PROOF static thm prove_named_own_updatep(void) { +PROOF static thm prove_named_own_updateP(void) { term goal_tm = ` forall (R:(A)ra) (name:num) (a:A) (P:A->bool). ra_updateP R a P ==> @@ -169,7 +169,7 @@ PROOF static thm prove_named_own_updatep(void) { `name:num`, `a:A`, `P:A->bool`), - NAMED_RA_UPDATEP_SINGLETON), + named_ra_updateP_singleton), payload_update); thm unfolded = rewrite_rule(THM_LIST(ra_updateP_def), map_update); thm source_eq = beta_rule(ap_term_rule( @@ -216,7 +216,7 @@ PROOF static thm prove_named_own_updatep(void) { split[0], gsym_rule(ispecl_rule( TERM_LIST(`named_ra (R:(A)ra)`, `selected:(num,A)finmap`), - RA_UNIT_L))); + ra_unit_l))); gnode_list predicates = CONJ_TAC(split[1]); gnode_list fact = CONJ_TAC(predicates[0]); ACCEPT_TAC(fact[0], assume_rule(`(P:A->bool) (b:A)`)); @@ -240,7 +240,7 @@ PROOF static thm prove_named_own_updatep(void) { return gnode_prove(root); } -PROOF thm NAMED_OWN_UPDATEP = prove_named_own_updatep(); +PROOF thm named_own_updateP = prove_named_own_updateP(); PROOF static thm prove_named_own_drop(void) { term goal_tm = ` @@ -257,17 +257,17 @@ PROOF static thm prove_named_own_drop(void) { pure_rewrite_conv(THM_LIST(named_own_def))); thm dropped = ispecl_rule( TERM_LIST(`R:(A)ra`, `name:num`, `a:A`), - NAMED_RA_DROP); + named_ra_drop); thm own_update = mp_rule( ispecl_rule( TERM_LIST( `named_ra (R:(A)ra)`, `finmap_singleton (name:num) (a:A)`, `finmap_empty:(num,A)finmap`), - R_OWN_UPDATE), + r_own_update), dropped); - thm own_unit = ispec_rule(`named_ra (R:(A)ra)`, R_OWN_UNIT); - own_unit = rewrite_rule(THM_LIST(NAMED_RA_UNIT, r_equiv_def), own_unit); + thm own_unit = ispec_rule(`named_ra (R:(A)ra)`, r_own_unit); + own_unit = rewrite_rule(THM_LIST(named_ra_unit, r_equiv_def), own_unit); thm post_entails = conjunct1_rule(own_unit); thm consequence = ispecl_rule( TERM_LIST( @@ -279,7 +279,7 @@ PROOF static thm prove_named_own_drop(void) { `r_own (named_ra (R:(A)ra)) (finmap_empty:(num,A)finmap)`, `r_emp (named_ra (R:(A)ra))`), - R_VIEWSHIFT_MONO); + r_viewshift_mono); consequence = mp_rule( consequence, ispecl_rule( @@ -287,14 +287,14 @@ PROOF static thm prove_named_own_drop(void) { `named_ra (R:(A)ra)`, `r_own (named_ra (R:(A)ra)) (finmap_singleton (name:num) (a:A))`), - R_ENTAILS_REFL)); + r_entails_refl)); consequence = mp_rule(consequence, own_update); consequence = mp_rule(consequence, post_entails); ACCEPT_TAC(body, consequence); return gnode_prove(root); } -PROOF thm NAMED_OWN_DROP = prove_named_own_drop(); +PROOF thm named_own_drop = prove_named_own_drop(); PROOF static thm prove_named_own_alloc(void) { term goal_tm = ` @@ -352,7 +352,7 @@ PROOF static thm prove_named_own_alloc(void) { `R:(A)ra`, `owned:(num,A)finmap`, `a:A`), - NAMED_RA_ALLOC), + named_ra_alloc), assume_rule(valid_a_terms[0])); allocation = rewrite_rule(THM_LIST(ra_updateP_def), allocation); thm selected = mp_rule( @@ -390,7 +390,7 @@ PROOF static thm prove_named_own_alloc(void) { `name:num`, `a:A`, `owned:(num,A)finmap`), - GMAP_RA_SINGLETON_OP_FRESH), + gmap_ra_singleton_op_fresh), assume_rule(` finmap_lookup (owned:(num,A)finmap) (name:num) == NONE `)); @@ -424,17 +424,17 @@ PROOF static thm prove_named_own_alloc(void) { return gnode_prove(root); } -PROOF thm NAMED_OWN_ALLOC = prove_named_own_alloc(); +PROOF thm named_own_alloc = prove_named_own_alloc(); PROOF static int audit_named_logic(void) { thm_list public_theorems = THM_LIST( named_own_def, - NAMED_OWN_OP, - NAMED_OWN_VALID, - NAMED_OWN_UPDATE, - NAMED_OWN_UPDATEP, - NAMED_OWN_DROP, - NAMED_OWN_ALLOC); + named_own_op, + named_own_valid, + named_own_update, + named_own_updateP, + named_own_drop, + named_own_alloc); for (size_t i = 0; i < vector_size(public_theorems); ++i) { ENSURE_COND(!IS_NULL(public_theorems[i]), "named logic theorem %zu is empty", i); diff --git a/theory/logic/named_logic.h b/theory/logic/named_logic.h index 1390996..560e134 100644 --- a/theory/logic/named_logic.h +++ b/theory/logic/named_logic.h @@ -6,9 +6,9 @@ #include "proof/theory/logic/named_ra.h" PROOF extern thm named_own_def; -PROOF extern thm NAMED_OWN_OP; -PROOF extern thm NAMED_OWN_VALID; -PROOF extern thm NAMED_OWN_UPDATE; -PROOF extern thm NAMED_OWN_UPDATEP; -PROOF extern thm NAMED_OWN_DROP; -PROOF extern thm NAMED_OWN_ALLOC; +PROOF extern thm named_own_op; +PROOF extern thm named_own_valid; +PROOF extern thm named_own_update; +PROOF extern thm named_own_updateP; +PROOF extern thm named_own_drop; +PROOF extern thm named_own_alloc; diff --git a/theory/logic/named_ra.c b/theory/logic/named_ra.c index 86feae3..773aac6 100644 --- a/theory/logic/named_ra.c +++ b/theory/logic/named_ra.c @@ -18,11 +18,11 @@ PROOF static thm prove_named_ra_unit(void) { ra_unit (named_ra R) == (finmap_empty:(num,A)finmap) `; gnode root = gnode_new_with_ccl(goal_tm); - CONV_TAC(root, rewrite_conv(THM_LIST(named_ra_def, GMAP_RA_UNIT))); + CONV_TAC(root, rewrite_conv(THM_LIST(named_ra_def, gmap_ra_unit))); return gnode_prove(root); } -PROOF thm NAMED_RA_UNIT = prove_named_ra_unit(); +PROOF thm named_ra_unit = prove_named_ra_unit(); PROOF static thm prove_named_ra_singleton_op(void) { term goal_tm = ` @@ -36,11 +36,11 @@ PROOF static thm prove_named_ra_singleton_op(void) { gnode root = gnode_new_with_ccl(goal_tm); CONV_TAC( root, - rewrite_conv(THM_LIST(named_ra_def, GMAP_RA_SINGLETON_OP))); + rewrite_conv(THM_LIST(named_ra_def, gmap_ra_singleton_op))); return gnode_prove(root); } -PROOF thm NAMED_RA_SINGLETON_OP = +PROOF thm named_ra_singleton_op = prove_named_ra_singleton_op(); PROOF static thm prove_named_ra_valid_singleton(void) { @@ -52,11 +52,11 @@ PROOF static thm prove_named_ra_valid_singleton(void) { gnode root = gnode_new_with_ccl(goal_tm); CONV_TAC( root, - rewrite_conv(THM_LIST(named_ra_def, GMAP_RA_VALID_SINGLETON))); + rewrite_conv(THM_LIST(named_ra_def, gmap_ra_valid_singleton))); return gnode_prove(root); } -PROOF thm NAMED_RA_VALID_SINGLETON = +PROOF thm named_ra_valid_singleton = prove_named_ra_valid_singleton(); PROOF static thm prove_named_ra_update_singleton(void) { @@ -76,15 +76,15 @@ PROOF static thm prove_named_ra_update_singleton(void) { mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `name:num`, `a:A`, `b:A`), - GMAP_RA_UPDATE_SINGLETON), + gmap_ra_update_singleton), assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`))); return gnode_prove(root); } -PROOF thm NAMED_RA_UPDATE_SINGLETON = +PROOF thm named_ra_update_singleton = prove_named_ra_update_singleton(); -PROOF static thm prove_named_ra_updatep_singleton(void) { +PROOF static thm prove_named_ra_updateP_singleton(void) { term goal_tm = ` forall (R:(A)ra) (name:num) (a:A) (P:A->bool). ra_updateP R a P ==> @@ -106,13 +106,13 @@ PROOF static thm prove_named_ra_updatep_singleton(void) { `name:num`, `a:A`, `P:A->bool`), - GMAP_RA_UPDATEP_SINGLETON), + gmap_ra_updateP_singleton), assume_rule(`ra_updateP (R:(A)ra) (a:A) (P:A->bool)`))); return gnode_prove(root); } -PROOF thm NAMED_RA_UPDATEP_SINGLETON = - prove_named_ra_updatep_singleton(); +PROOF thm named_ra_updateP_singleton = + prove_named_ra_updateP_singleton(); PROOF static thm prove_named_ra_drop(void) { term R = `R:(A)ra`; @@ -122,19 +122,19 @@ PROOF static thm prove_named_ra_drop(void) { term target = `finmap_empty:(num,A)finmap`; thm included = ispecl_rule( TERM_LIST(`named_ra (R:(A)ra)`, source), - RA_INCLUDED_UNIT); - included = rewrite_rule(THM_LIST(NAMED_RA_UNIT), included); + ra_included_unit); + included = rewrite_rule(THM_LIST(named_ra_unit), included); thm dropped = mp_rule( ispecl_rule( TERM_LIST(`named_ra (R:(A)ra)`, source, target), - RA_UPDATE_INCLUDED), + ra_update_included), included); dropped = gen_rule(a, dropped); dropped = gen_rule(name, dropped); return gen_rule(R, dropped); } -PROOF thm NAMED_RA_DROP = prove_named_ra_drop(); +PROOF thm named_ra_drop = prove_named_ra_drop(); PROOF static thm prove_named_ra_alloc(void) { term goal_tm = ` @@ -153,7 +153,7 @@ PROOF static thm prove_named_ra_alloc(void) { body = CONV_TAC(body, once_rewrite_conv(THM_LIST(named_ra_def))); thm allocated = ispecl_rule( TERM_LIST(`R:(A)ra`, `m:(num,A)finmap`, `a:A`), - GMAP_RA_ALLOC); + gmap_ra_alloc); allocated = mp_rule(allocated, get_theorem_by_name("num_INFINITE")); allocated = mp_rule( allocated, @@ -162,18 +162,18 @@ PROOF static thm prove_named_ra_alloc(void) { return gnode_prove(root); } -PROOF thm NAMED_RA_ALLOC = prove_named_ra_alloc(); +PROOF thm named_ra_alloc = prove_named_ra_alloc(); PROOF static int audit_named_ra(void) { thm_list public_theorems = THM_LIST( named_ra_def, - NAMED_RA_UNIT, - NAMED_RA_SINGLETON_OP, - NAMED_RA_VALID_SINGLETON, - NAMED_RA_UPDATE_SINGLETON, - NAMED_RA_UPDATEP_SINGLETON, - NAMED_RA_DROP, - NAMED_RA_ALLOC); + named_ra_unit, + named_ra_singleton_op, + named_ra_valid_singleton, + named_ra_update_singleton, + named_ra_updateP_singleton, + named_ra_drop, + named_ra_alloc); for (size_t i = 0; i < vector_size(public_theorems); ++i) { ENSURE_COND(!IS_NULL(public_theorems[i]), "named RA theorem %zu is empty", i); diff --git a/theory/logic/named_ra.h b/theory/logic/named_ra.h index aea5d83..d33a02f 100644 --- a/theory/logic/named_ra.h +++ b/theory/logic/named_ra.h @@ -1,16 +1,54 @@ #pragma once -/* Optional numeric naming for ghost resources. */ +/* + * Public interface for optional numeric naming of ghost resources. + * + * `named_ra R` is a transparent `num`-keyed specialization of `gmap_ra R`, + * not a distinct algebraic construction. Fixed-name laws specialize the + * generic singleton-map rules; allocation selects a fresh natural-number key. + */ #include "proof/theory/logic/gmap_ra.h" +/* ------------------------------------------------------------------------- */ +/* Specialization and pointwise semantics */ +/* ------------------------------------------------------------------------- */ + /* `named_ra R == (gmap_ra R:((num,A)finmap)ra)`. */ PROOF extern thm named_ra_def; -PROOF extern thm NAMED_RA_UNIT; -PROOF extern thm NAMED_RA_SINGLETON_OP; -PROOF extern thm NAMED_RA_VALID_SINGLETON; -PROOF extern thm NAMED_RA_UPDATE_SINGLETON; -PROOF extern thm NAMED_RA_UPDATEP_SINGLETON; -PROOF extern thm NAMED_RA_DROP; -PROOF extern thm NAMED_RA_ALLOC; +/* `ra_unit (named_ra R) == (finmap_empty:(num,A)finmap)`. */ +PROOF extern thm named_ra_unit; + +/* Same-name singleton fragments compose in the payload RA. */ +PROOF extern thm named_ra_singleton_op; + +/* A named singleton is valid exactly when its payload is valid. */ +PROOF extern thm named_ra_valid_singleton; + +/* ------------------------------------------------------------------------- */ +/* Fixed-name updates */ +/* ------------------------------------------------------------------------- */ + +/* Lift a deterministic payload update at one fixed name. */ +PROOF extern thm named_ra_update_singleton; + +/* Lift a predicate payload update to an exact singleton-map result. */ +PROOF extern thm named_ra_updateP_singleton; + +/* ------------------------------------------------------------------------- */ +/* Fragment lifecycle */ +/* ------------------------------------------------------------------------- */ + +/* + * Drop a singleton fragment to the empty map. This does not prove that the + * same name is absent from a hidden frame or globally absent. + */ +PROOF extern thm named_ra_drop; + +/* + * Allocate a valid payload at a source-map-fresh natural-number name. The + * chosen name remains existential inside the `ra_updateP` result predicate and + * may depend on the hidden frame. + */ +PROOF extern thm named_ra_alloc; diff --git a/theory/logic/option_ra.c b/theory/logic/option_ra.c index c7ca450..1d4e2eb 100644 --- a/theory/logic/option_ra.c +++ b/theory/logic/option_ra.c @@ -78,14 +78,14 @@ PROOF static thm prove_option_ra_op_assoc(void) { THM_LIST( option_ra_op_def, option_ra_some_op_def, - RA_ASSOC)); + ra_assoc)); } } } return gnode_prove(root); } -PROOF static thm OPTION_RA_OP_ASSOC = +PROOF static thm option_ra_op_assoc = prove_option_ra_op_assoc(); PROOF static thm prove_option_ra_op_comm(void) { @@ -108,13 +108,13 @@ PROOF static thm prove_option_ra_op_comm(void) { THM_LIST( option_ra_op_def, option_ra_some_op_def, - RA_COMM)); + ra_comm)); } } return gnode_prove(root); } -PROOF static thm OPTION_RA_OP_COMM = +PROOF static thm option_ra_op_comm = prove_option_ra_op_comm(); PROOF static thm prove_option_ra_op_unit_l(void) { @@ -130,7 +130,7 @@ PROOF static thm prove_option_ra_op_unit_l(void) { return gnode_prove(root); } -PROOF static thm OPTION_RA_OP_UNIT_L = +PROOF static thm option_ra_op_unit_l = prove_option_ra_op_unit_l(); PROOF static thm prove_option_ra_valid_unit(void) { @@ -146,7 +146,7 @@ PROOF static thm prove_option_ra_valid_unit(void) { return gnode_prove(root); } -PROOF static thm OPTION_RA_VALID_UNIT = +PROOF static thm option_ra_valid_unit = prove_option_ra_valid_unit(); PROOF static thm prove_option_ra_valid_op_l(void) { @@ -172,13 +172,13 @@ PROOF static thm prove_option_ra_valid_op_l(void) { option_ra_op_def, option_ra_some_op_def, option_ra_valid_def, - RA_VALID_OP_L)); + ra_valid_op_l)); } } return gnode_prove(root); } -PROOF static thm OPTION_RA_VALID_OP_L = +PROOF static thm option_ra_valid_op_l = prove_option_ra_valid_op_l(); PROOF static thm prove_option_ra_laws(void) { @@ -198,29 +198,29 @@ PROOF static thm prove_option_ra_laws(void) { gnode_list law1 = CONJ_TAC(unfolded); ACCEPT_TAC( law1[0], - spec_rule(`R:(A)ra`, OPTION_RA_OP_ASSOC)); + spec_rule(`R:(A)ra`, option_ra_op_assoc)); gnode_list law2 = CONJ_TAC(law1[1]); ACCEPT_TAC( law2[0], - spec_rule(`R:(A)ra`, OPTION_RA_OP_COMM)); + spec_rule(`R:(A)ra`, option_ra_op_comm)); gnode_list law3 = CONJ_TAC(law2[1]); ACCEPT_TAC( law3[0], - spec_rule(`R:(A)ra`, OPTION_RA_OP_UNIT_L)); + spec_rule(`R:(A)ra`, option_ra_op_unit_l)); gnode_list law4 = CONJ_TAC(law3[1]); ACCEPT_TAC( law4[0], - spec_rule(`R:(A)ra`, OPTION_RA_VALID_UNIT)); + spec_rule(`R:(A)ra`, option_ra_valid_unit)); ACCEPT_TAC( law4[1], - spec_rule(`R:(A)ra`, OPTION_RA_VALID_OP_L)); + spec_rule(`R:(A)ra`, option_ra_valid_op_l)); return gnode_prove(root); } -PROOF static thm OPTION_RA_LAWS = +PROOF static thm option_ra_laws = prove_option_ra_laws(); PROOF static thm option_ra_def = new_fun_definition(` @@ -241,11 +241,11 @@ PROOF static thm prove_option_ra_unit(void) { term valid = ` option_ra_valid (R:(A)ra):A option->bool `; - thm laws = ispec_rule(R, OPTION_RA_LAWS); + thm laws = ispec_rule(R, option_ra_laws); thm computed = mp_rule( ispecl_rule( TERM_LIST(none, op, valid), - RA_UNIT_ABS), + ra_unit_abs), laws); computed = pure_once_rewrite_rule( THM_LIST(gsym_rule(option_ra_def)), @@ -253,7 +253,7 @@ PROOF static thm prove_option_ra_unit(void) { return gen_rule(R, computed); } -PROOF thm OPTION_RA_UNIT = +PROOF thm option_ra_unit = prove_option_ra_unit(); PROOF static thm prove_option_ra_op_fn(void) { @@ -266,11 +266,11 @@ PROOF static thm prove_option_ra_op_fn(void) { term valid = ` option_ra_valid (R:(A)ra):A option->bool `; - thm laws = ispec_rule(R, OPTION_RA_LAWS); + thm laws = ispec_rule(R, option_ra_laws); thm computed = mp_rule( ispecl_rule( TERM_LIST(none, op, valid), - RA_OP_ABS), + ra_op_abs), laws); computed = pure_once_rewrite_rule( THM_LIST(gsym_rule(option_ra_def)), @@ -278,7 +278,7 @@ PROOF static thm prove_option_ra_op_fn(void) { return gen_rule(R, computed); } -PROOF static thm OPTION_RA_OP_FN = +PROOF static thm option_ra_op_fn = prove_option_ra_op_fn(); PROOF static thm prove_option_ra_valid_fn(void) { @@ -291,11 +291,11 @@ PROOF static thm prove_option_ra_valid_fn(void) { term valid = ` option_ra_valid (R:(A)ra):A option->bool `; - thm laws = ispec_rule(R, OPTION_RA_LAWS); + thm laws = ispec_rule(R, option_ra_laws); thm computed = mp_rule( ispecl_rule( TERM_LIST(none, op, valid), - RA_VALID_ABS), + ra_valid_abs), laws); computed = pure_once_rewrite_rule( THM_LIST(gsym_rule(option_ra_def)), @@ -303,7 +303,7 @@ PROOF static thm prove_option_ra_valid_fn(void) { return gen_rule(R, computed); } -PROOF static thm OPTION_RA_VALID_FN = +PROOF static thm option_ra_valid_fn = prove_option_ra_valid_fn(); PROOF static thm prove_option_ra_op_none_l(void) { @@ -315,12 +315,12 @@ PROOF static thm prove_option_ra_op_none_l(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - OPTION_RA_OP_FN, + option_ra_op_fn, option_ra_op_def))); return gnode_prove(root); } -PROOF thm OPTION_RA_OP_NONE_L = +PROOF thm option_ra_op_none_l = prove_option_ra_op_none_l(); PROOF static thm prove_option_ra_op_none_r(void) { @@ -337,14 +337,14 @@ PROOF static thm prove_option_ra_op_none_r(void) { x_cases[i], rewrite_conv, THM_LIST( - OPTION_RA_OP_FN, + option_ra_op_fn, option_ra_op_def, option_ra_some_op_def)); } return gnode_prove(root); } -PROOF thm OPTION_RA_OP_NONE_R = +PROOF thm option_ra_op_none_r = prove_option_ra_op_none_r(); PROOF static thm prove_option_ra_op_some_some(void) { @@ -357,13 +357,13 @@ PROOF static thm prove_option_ra_op_some_some(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - OPTION_RA_OP_FN, + option_ra_op_fn, option_ra_op_def, option_ra_some_op_def))); return gnode_prove(root); } -PROOF thm OPTION_RA_OP_SOME_SOME = +PROOF thm option_ra_op_some_some = prove_option_ra_op_some_some(); PROOF static thm prove_option_ra_some_inj(void) { @@ -379,7 +379,7 @@ PROOF static thm prove_option_ra_some_inj(void) { return gnode_prove(root); } -PROOF thm OPTION_RA_SOME_INJ = +PROOF thm option_ra_some_inj = prove_option_ra_some_inj(); PROOF static thm prove_option_ra_some_ne_none(void) { @@ -394,7 +394,7 @@ PROOF static thm prove_option_ra_some_ne_none(void) { return gnode_prove(root); } -PROOF thm OPTION_RA_SOME_NE_NONE = +PROOF thm option_ra_some_ne_none = prove_option_ra_some_ne_none(); PROOF static thm prove_option_ra_some_unit_ne_none(void) { @@ -410,7 +410,7 @@ PROOF static thm prove_option_ra_some_unit_ne_none(void) { return gnode_prove(root); } -PROOF thm OPTION_RA_SOME_UNIT_NE_NONE = +PROOF thm option_ra_some_unit_ne_none = prove_option_ra_some_unit_ne_none(); PROOF static thm prove_option_ra_valid_none(void) { @@ -422,12 +422,12 @@ PROOF static thm prove_option_ra_valid_none(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - OPTION_RA_VALID_FN, + option_ra_valid_fn, option_ra_valid_def))); return gnode_prove(root); } -PROOF thm OPTION_RA_VALID_NONE = +PROOF thm option_ra_valid_none = prove_option_ra_valid_none(); PROOF static thm prove_option_ra_valid_some(void) { @@ -440,12 +440,12 @@ PROOF static thm prove_option_ra_valid_some(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - OPTION_RA_VALID_FN, + option_ra_valid_fn, option_ra_valid_def))); return gnode_prove(root); } -PROOF thm OPTION_RA_VALID_SOME = +PROOF thm option_ra_valid_some = prove_option_ra_valid_some(); /* ------------------------------------------------------------------------- */ @@ -464,10 +464,10 @@ PROOF static thm prove_option_ra_included_none(void) { TERM_LIST( `option_ra (R:(A)ra)`, `x:A option`), - RA_INCLUDED_UNIT); + ra_included_unit); thm unit_equation = ispec_rule( `R:(A)ra`, - OPTION_RA_UNIT); + option_ra_unit); ACCEPT_TAC( body, pure_once_rewrite_rule( @@ -476,7 +476,7 @@ PROOF static thm prove_option_ra_included_none(void) { return gnode_prove(root); } -PROOF thm OPTION_RA_INCLUDED_NONE = +PROOF thm option_ra_included_none = prove_option_ra_included_none(); /* Inclusion between present values is exactly base inclusion. The adjoined @@ -520,7 +520,7 @@ PROOF static thm prove_option_ra_included_some_some(void) { thm none_extension = rewrite_rule( THM_LIST( assume_rule(none_eq_tm), - OPTION_RA_OP_NONE_R, + option_ra_op_none_r, get_theorem_by_name("option_INJ")), assume_rule(` SOME (b:A) == @@ -536,7 +536,7 @@ PROOF static thm prove_option_ra_included_some_some(void) { none_extension, gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), - RA_UNIT_R))); + ra_unit_r))); ACCEPT_TAC(none_branch, base_unit_extension); term some_eq_tm = gnode_get_asmps( @@ -546,7 +546,7 @@ PROOF static thm prove_option_ra_included_some_some(void) { thm some_extension = rewrite_rule( THM_LIST( assume_rule(some_eq_tm), - OPTION_RA_OP_SOME_SOME, + option_ra_op_some_some, get_theorem_by_name("option_INJ")), assume_rule(` SOME (b:A) == @@ -587,7 +587,7 @@ PROOF static thm prove_option_ra_included_some_some(void) { `R:(A)ra`, `a:A`, `base_frame:A`), - OPTION_RA_OP_SOME_SOME); + option_ra_op_some_some); ACCEPT_TAC( reverse, trans_rule( @@ -596,7 +596,7 @@ PROOF static thm prove_option_ra_included_some_some(void) { return gnode_prove(root); } -PROOF thm OPTION_RA_INCLUDED_SOME_SOME = +PROOF thm option_ra_included_some_some = prove_option_ra_included_some_some(); /* A present value cannot be extended back to the freshly adjoined unit. */ @@ -631,8 +631,8 @@ PROOF static thm prove_option_ra_not_included_some_none(void) { thm contradiction = rewrite_rule( THM_LIST( assume_rule(frame_eq_tm), - OPTION_RA_OP_NONE_R, - OPTION_RA_OP_SOME_SOME, + option_ra_op_none_r, + option_ra_op_some_some, get_theorem_by_name("option_DISTINCT")), assume_rule(` (NONE:A option) == @@ -646,7 +646,7 @@ PROOF static thm prove_option_ra_not_included_some_none(void) { return gnode_prove(root); } -PROOF thm OPTION_RA_NOT_INCLUDED_SOME_NONE = +PROOF thm option_ra_not_included_some_none = prove_option_ra_not_included_some_none(); PROOF static thm prove_option_ra_not_cancellative(void) { @@ -661,13 +661,13 @@ PROOF static thm prove_option_ra_not_cancellative(void) { thm source_valid = eq_mp_rule( gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `ra_unit (R:(A)ra)`), - OPTION_RA_VALID_SOME)), - ispec_rule(`R:(A)ra`, RA_VALID_UNIT)); + option_ra_valid_some)), + ispec_rule(`R:(A)ra`, ra_valid_unit)); thm source_op = ispecl_rule( TERM_LIST( `R:(A)ra`, some_unit), - OPTION_RA_OP_NONE_R); + option_ra_op_none_r); thm framed_source_valid = eq_mp_rule( gsym_rule(ap_term_rule( `ra_valid (option_ra (R:(A)ra)):A option->bool`, @@ -680,12 +680,12 @@ PROOF static thm prove_option_ra_not_cancellative(void) { `R:(A)ra`, `ra_unit (R:(A)ra)`, `ra_unit (R:(A)ra)`), - OPTION_RA_OP_SOME_SOME), + option_ra_op_some_some), ap_term_rule( `SOME:A->A option`, ispecl_rule( TERM_LIST(`R:(A)ra`, `ra_unit (R:(A)ra)`), - RA_UNIT_L))); + ra_unit_l))); thm ops_equal = trans_rule(source_op, gsym_rule(right_op)); thm forced_equal = ispecl_rule( TERM_LIST( @@ -693,20 +693,20 @@ PROOF static thm prove_option_ra_not_cancellative(void) { some_unit, `NONE:A option`, some_unit), - RA_CANCELLATIVE_APPLY); + ra_cancellative_apply); forced_equal = mp_rule( forced_equal, assume_rule(`ra_cancellative (option_ra (R:(A)ra))`)); forced_equal = mp_rule(forced_equal, framed_source_valid); forced_equal = mp_rule(forced_equal, ops_equal); thm contradiction = not_elim_rule( - ispec_rule(`ra_unit (R:(A)ra)`, OPTION_RA_SOME_NE_NONE), + ispec_rule(`ra_unit (R:(A)ra)`, option_ra_some_ne_none), gsym_rule(forced_equal)); CONTR_TAC(body, contradiction); return gnode_prove(root); } -PROOF thm OPTION_RA_NOT_CANCELLATIVE = +PROOF thm option_ra_not_cancellative = prove_option_ra_not_cancellative(); /* ------------------------------------------------------------------------- */ @@ -743,7 +743,7 @@ PROOF static thm prove_option_ra_local_update_some(void) { thm residual_eq = assume_rule(residual_eq_tm); thm source_valid = rewrite_rule( THM_LIST( - OPTION_RA_VALID_SOME), + option_ra_valid_some), assume_rule(` ra_valid (option_ra (R:(A)ra)) @@ -752,8 +752,8 @@ PROOF static thm prove_option_ra_local_update_some(void) { thm source_decomposition = rewrite_rule( THM_LIST( residual_eq, - OPTION_RA_OP_NONE_R, - OPTION_RA_OP_SOME_SOME, + option_ra_op_none_r, + option_ra_op_some_some, get_theorem_by_name("option_INJ")), assume_rule(` SOME (a:A) == @@ -771,7 +771,7 @@ PROOF static thm prove_option_ra_local_update_some(void) { source_decomposition, gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `f:A`), - RA_UNIT_R))); + ra_unit_r))); } thm updated = ispecl_rule( @@ -782,7 +782,7 @@ PROOF static thm prove_option_ra_local_update_some(void) { `b:A`, `g:A`, base_residual), - RA_LOCAL_UPDATE_APPLY); + ra_local_update_apply); updated = mp_rule( updated, assume_rule(` @@ -796,7 +796,7 @@ PROOF static thm prove_option_ra_local_update_some(void) { updated = mp_rule(updated, source_valid); updated = mp_rule(updated, source_decomposition); updated = rewrite_rule( - THM_LIST(RA_UNIT_R), + THM_LIST(ra_unit_r), updated); gnode target = CONV_WITH_ASMP_TAC( @@ -804,17 +804,17 @@ PROOF static thm prove_option_ra_local_update_some(void) { rewrite_conv, THM_LIST( residual_eq, - OPTION_RA_OP_NONE_R, - OPTION_RA_OP_SOME_SOME, - OPTION_RA_VALID_SOME, + option_ra_op_none_r, + option_ra_op_some_some, + option_ra_valid_some, get_theorem_by_name("option_INJ"), - RA_UNIT_R)); + ra_unit_r)); ACCEPT_TAC(target, updated); } return gnode_prove(root); } -PROOF static thm OPTION_RA_LOCAL_UPDATE_SOME = +PROOF static thm option_ra_local_update_some = prove_option_ra_local_update_some(); PROOF static thm prove_option_ra_local_update_iff(void) { @@ -842,7 +842,7 @@ PROOF static thm prove_option_ra_local_update_iff(void) { thm source_valid = eq_mp_rule( gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), - OPTION_RA_VALID_SOME)), + option_ra_valid_some)), assume_rule(`ra_valid (R:(A)ra) (a:A)`)); thm base_decomposition = assume_rule(` (a:A) == @@ -858,7 +858,7 @@ PROOF static thm prove_option_ra_local_update_iff(void) { `R:(A)ra`, `f:A`, `residual:A`), - OPTION_RA_OP_SOME_SOME))); + option_ra_op_some_some))); thm updated = ispecl_rule( TERM_LIST( @@ -868,7 +868,7 @@ PROOF static thm prove_option_ra_local_update_iff(void) { `SOME (b:A):A option`, `SOME (g:A):A option`, `SOME (residual:A)`), - RA_LOCAL_UPDATE_APPLY); + ra_local_update_apply); updated = mp_rule( updated, assume_rule(` @@ -883,8 +883,8 @@ PROOF static thm prove_option_ra_local_update_iff(void) { updated = mp_rule(updated, lifted_decomposition); updated = rewrite_rule( THM_LIST( - OPTION_RA_VALID_SOME, - OPTION_RA_OP_SOME_SOME, + option_ra_valid_some, + option_ra_op_some_some, get_theorem_by_name("option_INJ")), updated); ACCEPT_TAC(forward, updated); @@ -901,7 +901,7 @@ PROOF static thm prove_option_ra_local_update_iff(void) { `f:A`, `b:A`, `g:A`), - OPTION_RA_LOCAL_UPDATE_SOME), + option_ra_local_update_some), assume_rule(` ra_local_update (R:(A)ra) @@ -913,7 +913,7 @@ PROOF static thm prove_option_ra_local_update_iff(void) { return gnode_prove(root); } -PROOF thm OPTION_RA_LOCAL_UPDATE_IFF = +PROOF thm option_ra_local_update_iff = prove_option_ra_local_update_iff(); /* @@ -953,8 +953,8 @@ PROOF static thm prove_option_ra_update(void) { thm source_none = rewrite_rule( THM_LIST( assume_rule(frame_none_eq), - OPTION_RA_OP_NONE_R, - OPTION_RA_VALID_SOME), + option_ra_op_none_r, + option_ra_valid_some), assume_rule(` ra_valid (option_ra (R:(A)ra)) @@ -970,15 +970,15 @@ PROOF static thm prove_option_ra_update(void) { `R:(A)ra`, `a:A`, `b:A`), - RA_UPDATE_VALID), + ra_update_valid), assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)), source_none); gnode target_none_goal = CONV_TAC( none_parts[1], rewrite_conv(THM_LIST( assume_rule(frame_none_eq), - OPTION_RA_OP_NONE_R, - OPTION_RA_VALID_SOME))); + option_ra_op_none_r, + option_ra_valid_some))); ACCEPT_TAC(target_none_goal, target_none); term frame_some_eq = gnode_get_asmps( @@ -993,8 +993,8 @@ PROOF static thm prove_option_ra_update(void) { thm source_some = rewrite_rule( THM_LIST( assume_rule(frame_some_eq), - OPTION_RA_OP_SOME_SOME, - OPTION_RA_VALID_SOME), + option_ra_op_some_some, + option_ra_valid_some), assume_rule(` ra_valid (option_ra (R:(A)ra)) @@ -1010,22 +1010,22 @@ PROOF static thm prove_option_ra_update(void) { `a:A`, `b:A`, base_frame), - RA_UPDATE_FRAME), + ra_update_frame), assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); thm target_some = mp_rule( - match_mp_rule(RA_UPDATE_VALID, framed_update), + match_mp_rule(ra_update_valid, framed_update), source_some); gnode target_some_goal = CONV_TAC( some_parts[1], rewrite_conv(THM_LIST( assume_rule(frame_some_eq), - OPTION_RA_OP_SOME_SOME, - OPTION_RA_VALID_SOME))); + option_ra_op_some_some, + option_ra_valid_some))); ACCEPT_TAC(target_some_goal, target_some); return gnode_prove(root); } -PROOF thm OPTION_RA_UPDATE = +PROOF thm option_ra_update = prove_option_ra_update(); PROOF static thm prove_option_ra_update_iff(void) { @@ -1061,7 +1061,7 @@ PROOF static thm prove_option_ra_update_iff(void) { TERM_LIST( `R:(A)ra`, `ra_op (R:(A)ra) (a:A) (frame:A)`), - OPTION_RA_VALID_SOME)), + option_ra_valid_some)), assume_rule(` ra_valid (R:(A)ra) @@ -1075,7 +1075,7 @@ PROOF static thm prove_option_ra_update_iff(void) { `R:(A)ra`, `a:A`, `frame:A`), - OPTION_RA_OP_SOME_SOME))), + option_ra_op_some_some))), source_valid); thm framed_update = mp_rule( ispecl_rule( @@ -1084,7 +1084,7 @@ PROOF static thm prove_option_ra_update_iff(void) { `SOME (a:A):A option`, `SOME (b:A):A option`, `SOME (frame:A):A option`), - RA_UPDATE_FRAME), + ra_update_frame), assume_rule(` ra_update (option_ra (R:(A)ra)) @@ -1092,12 +1092,12 @@ PROOF static thm prove_option_ra_update_iff(void) { (SOME (b:A)) `)); thm target_valid = mp_rule( - match_mp_rule(RA_UPDATE_VALID, framed_update), + match_mp_rule(ra_update_valid, framed_update), source_valid); target_valid = rewrite_rule( THM_LIST( - OPTION_RA_OP_SOME_SOME, - OPTION_RA_VALID_SOME), + option_ra_op_some_some, + option_ra_valid_some), target_valid); ACCEPT_TAC(result[1], target_valid); @@ -1111,14 +1111,14 @@ PROOF static thm prove_option_ra_update_iff(void) { `R:(A)ra`, `a:A`, `b:A`), - OPTION_RA_UPDATE), + option_ra_update), assume_rule(` ra_update (R:(A)ra) (a:A) (b:A) `))); return gnode_prove(root); } -PROOF thm OPTION_RA_UPDATE_IFF = +PROOF thm option_ra_update_iff = prove_option_ra_update_iff(); /* Predicate updates lift to the exact SOME image. */ @@ -1151,9 +1151,9 @@ PROOF static thm prove_option_ra_updateP(void) { thm source_valid = rewrite_rule( THM_LIST( frame_eq, - OPTION_RA_OP_NONE_R, - OPTION_RA_OP_SOME_SOME, - OPTION_RA_VALID_SOME), + option_ra_op_none_r, + option_ra_op_some_some, + option_ra_valid_some), assume_rule(` ra_valid (option_ra (R:(A)ra)) @@ -1172,7 +1172,7 @@ PROOF static thm prove_option_ra_updateP(void) { `R:(A)ra`, `a:A`, `P:A->bool`), - RA_UPDATEP_VALID), + ra_updateP_valid), assume_rule(` ra_updateP (R:(A)ra) @@ -1222,9 +1222,9 @@ PROOF static thm prove_option_ra_updateP(void) { result_parts[1], rewrite_conv(THM_LIST( frame_eq, - OPTION_RA_OP_NONE_R, - OPTION_RA_OP_SOME_SOME, - OPTION_RA_VALID_SOME))); + option_ra_op_none_r, + option_ra_op_some_some, + option_ra_valid_some))); ACCEPT_TAC( target_valid, assume_rule(gnode_get_asmps( @@ -1234,7 +1234,7 @@ PROOF static thm prove_option_ra_updateP(void) { return gnode_prove(root); } -PROOF thm OPTION_RA_UPDATEP = +PROOF thm option_ra_updateP = prove_option_ra_updateP(); PROOF static thm prove_option_ra_updateP_iff(void) { @@ -1263,7 +1263,7 @@ PROOF static thm prove_option_ra_updateP_iff(void) { TERM_LIST( `R:(A)ra`, `ra_op (R:(A)ra) (a:A) (frame:A)`), - OPTION_RA_VALID_SOME)), + option_ra_valid_some)), assume_rule(` ra_valid (R:(A)ra) @@ -1277,7 +1277,7 @@ PROOF static thm prove_option_ra_updateP_iff(void) { `R:(A)ra`, `a:A`, `frame:A`), - OPTION_RA_OP_SOME_SOME))), + option_ra_op_some_some))), source_valid); thm option_update = pure_once_rewrite_rule( @@ -1320,8 +1320,8 @@ PROOF static thm prove_option_ra_updateP_iff(void) { thm target_valid = rewrite_rule( THM_LIST( assume_rule(`(x:A option) == SOME (b:A)`), - OPTION_RA_OP_SOME_SOME, - OPTION_RA_VALID_SOME), + option_ra_op_some_some, + option_ra_valid_some), assume_rule(` ra_valid (option_ra (R:(A)ra)) @@ -1342,7 +1342,7 @@ PROOF static thm prove_option_ra_updateP_iff(void) { `R:(A)ra`, `a:A`, `P:A->bool`), - OPTION_RA_UPDATEP), + option_ra_updateP), assume_rule(` ra_updateP (R:(A)ra) @@ -1352,7 +1352,7 @@ PROOF static thm prove_option_ra_updateP_iff(void) { return gnode_prove(root); } -PROOF thm OPTION_RA_UPDATEP_IFF = +PROOF thm option_ra_updateP_iff = prove_option_ra_updateP_iff(); PROOF static int audit_option_ra(void) { @@ -1360,34 +1360,34 @@ PROOF static int audit_option_ra(void) { option_ra_some_op_def, option_ra_op_def, option_ra_valid_def, - OPTION_RA_OP_ASSOC, - OPTION_RA_OP_COMM, - OPTION_RA_OP_UNIT_L, - OPTION_RA_VALID_UNIT, - OPTION_RA_VALID_OP_L, - OPTION_RA_LAWS, + option_ra_op_assoc, + option_ra_op_comm, + option_ra_op_unit_l, + option_ra_valid_unit, + option_ra_valid_op_l, + option_ra_laws, option_ra_def, - OPTION_RA_UNIT, - OPTION_RA_OP_FN, - OPTION_RA_VALID_FN, - OPTION_RA_OP_NONE_L, - OPTION_RA_OP_NONE_R, - OPTION_RA_OP_SOME_SOME, - OPTION_RA_SOME_INJ, - OPTION_RA_SOME_NE_NONE, - OPTION_RA_SOME_UNIT_NE_NONE, - OPTION_RA_VALID_NONE, - OPTION_RA_VALID_SOME, - OPTION_RA_INCLUDED_NONE, - OPTION_RA_INCLUDED_SOME_SOME, - OPTION_RA_NOT_INCLUDED_SOME_NONE, - OPTION_RA_NOT_CANCELLATIVE, - OPTION_RA_LOCAL_UPDATE_SOME, - OPTION_RA_LOCAL_UPDATE_IFF, - OPTION_RA_UPDATE, - OPTION_RA_UPDATE_IFF, - OPTION_RA_UPDATEP, - OPTION_RA_UPDATEP_IFF); + option_ra_unit, + option_ra_op_fn, + option_ra_valid_fn, + option_ra_op_none_l, + option_ra_op_none_r, + option_ra_op_some_some, + option_ra_some_inj, + option_ra_some_ne_none, + option_ra_some_unit_ne_none, + option_ra_valid_none, + option_ra_valid_some, + option_ra_included_none, + option_ra_included_some_some, + option_ra_not_included_some_none, + option_ra_not_cancellative, + option_ra_local_update_some, + option_ra_local_update_iff, + option_ra_update, + option_ra_update_iff, + option_ra_updateP, + option_ra_updateP_iff); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { ENSURE_COND(!IS_NULL(audited_theorems[i]), diff --git a/theory/logic/option_ra.h b/theory/logic/option_ra.h index 30f621d..6bbbaf2 100644 --- a/theory/logic/option_ra.h +++ b/theory/logic/option_ra.h @@ -1,19 +1,65 @@ #pragma once -/* Option/lift resource algebra. `NONE` is the freshly added unit. */ +/* + * Public interface for the option (lift) resource algebra. + * + * `option_ra R : (A option)ra` adjoins `NONE` as a new unit and embeds base + * resources as `SOME a`. Consequently `NONE` (absence) remains distinct from + * `SOME (ra_unit R)` (a present slot carrying an empty payload). + */ #include "proof/theory/logic/local_update.h" -PROOF extern thm OPTION_RA_UNIT; -PROOF extern thm OPTION_RA_OP_NONE_L; -PROOF extern thm OPTION_RA_OP_SOME_SOME; -PROOF extern thm OPTION_RA_VALID_NONE; -PROOF extern thm OPTION_RA_VALID_SOME; -PROOF extern thm OPTION_RA_INCLUDED_NONE; -PROOF extern thm OPTION_RA_INCLUDED_SOME_SOME; -PROOF extern thm OPTION_RA_NOT_INCLUDED_SOME_NONE; -PROOF extern thm OPTION_RA_SOME_UNIT_NE_NONE; -PROOF extern thm OPTION_RA_NOT_CANCELLATIVE; -PROOF extern thm OPTION_RA_UPDATEP_IFF; -PROOF extern thm OPTION_RA_UPDATE_IFF; -PROOF extern thm OPTION_RA_LOCAL_UPDATE_IFF; +/* ------------------------------------------------------------------------- */ +/* Operation and validity */ +/* ------------------------------------------------------------------------- */ + +/* `ra_unit (option_ra R) == NONE`. */ +PROOF extern thm option_ra_unit; + +/* `ra_op (option_ra R) NONE x == x`. */ +PROOF extern thm option_ra_op_none_l; + +/* + * `ra_op (option_ra R) (SOME a) (SOME b) == + * SOME (ra_op R a b)`. + */ +PROOF extern thm option_ra_op_some_some; + +/* `ra_valid (option_ra R) NONE`. */ +PROOF extern thm option_ra_valid_none; + +/* `ra_valid (option_ra R) (SOME a) <=> ra_valid R a`. */ +PROOF extern thm option_ra_valid_some; + +/* ------------------------------------------------------------------------- */ +/* Inclusion and algebraic properties */ +/* ------------------------------------------------------------------------- */ + +/* `NONE` is included in every option resource. */ +PROOF extern thm option_ra_included_none; + +/* Present-to-present inclusion is exactly base-RA inclusion. */ +PROOF extern thm option_ra_included_some_some; + +/* A present resource is never included in `NONE`. */ +PROOF extern thm option_ra_not_included_some_none; + +/* `~(SOME (ra_unit R) == NONE)`. */ +PROOF extern thm option_ra_some_unit_ne_none; + +/* Adjoining a distinct unit makes `option_ra R` non-cancellative. */ +PROOF extern thm option_ra_not_cancellative; + +/* ------------------------------------------------------------------------- */ +/* Exact lifting rules */ +/* ------------------------------------------------------------------------- */ + +/* Predicate updates lift exactly to a predicate over `SOME` results. */ +PROOF extern thm option_ra_updateP_iff; + +/* `SOME a` updates to `SOME b` exactly when `a` updates to `b` in `R`. */ +PROOF extern thm option_ra_update_iff; + +/* Five-argument local updates lift exactly through `SOME`. */ +PROOF extern thm option_ra_local_update_iff; diff --git a/theory/logic/option_ra_internal.h b/theory/logic/option_ra_internal.h index aa18d66..6b7f903 100644 --- a/theory/logic/option_ra_internal.h +++ b/theory/logic/option_ra_internal.h @@ -1,9 +1,15 @@ #pragma once -/* Private option-RA normalization/lifting rules for container constructors. */ +/* + * INTERNAL option-RA normalization rules for container constructors. + * Ordinary clients use `option_ra.h`; this header must not be re-exported. + */ #include "proof/theory/logic/option_ra.h" -PROOF extern thm OPTION_RA_OP_NONE_R; -PROOF extern thm OPTION_RA_UPDATE; -PROOF extern thm OPTION_RA_UPDATEP; +/* Right-unit computation, retained internally as a direct rewrite rule. */ +PROOF extern thm option_ra_op_none_r; + +/* One-way deterministic and predicate-update lifting through `SOME`. */ +PROOF extern thm option_ra_update; +PROOF extern thm option_ra_updateP; diff --git a/theory/logic/prod_ra.c b/theory/logic/prod_ra.c index e3c3491..219785d 100644 --- a/theory/logic/prod_ra.c +++ b/theory/logic/prod_ra.c @@ -63,7 +63,7 @@ PROOF static thm prove_prod_ra_laws(void) { `FST (a:A#B)`, `FST (b:A#B)`, `FST (c:A#B)`), - RA_ASSOC)); + ra_assoc)); ACCEPT_TAC( assoc_parts[1], ispecl_rule( @@ -72,7 +72,7 @@ PROOF static thm prove_prod_ra_laws(void) { `SND (a:A#B)`, `SND (b:A#B)`, `SND (c:A#B)`), - RA_ASSOC)); + ra_assoc)); gnode_list law2 = CONJ_TAC(law1[1]); gnode comm = AUTO_INTROS_TAC(law2[0]); @@ -91,7 +91,7 @@ PROOF static thm prove_prod_ra_laws(void) { `R1:(A)ra`, `FST (a:A#B)`, `FST (b:A#B)`), - RA_COMM)); + ra_comm)); ACCEPT_TAC( comm_parts[1], ispecl_rule( @@ -99,7 +99,7 @@ PROOF static thm prove_prod_ra_laws(void) { `R2:(B)ra`, `SND (a:A#B)`, `SND (b:A#B)`), - RA_COMM)); + ra_comm)); gnode_list law3 = CONJ_TAC(law2[1]); gnode unit = AUTO_INTROS_TAC(law3[0]); @@ -109,7 +109,7 @@ PROOF static thm prove_prod_ra_laws(void) { prod_ra_op_def, get_theorem_by_name("FST"), get_theorem_by_name("SND"), - RA_UNIT_L, + ra_unit_l, get_theorem_by_name("PAIR")))); gnode_list law4 = CONJ_TAC(law3[1]); @@ -119,7 +119,7 @@ PROOF static thm prove_prod_ra_laws(void) { prod_ra_valid_def, get_theorem_by_name("FST"), get_theorem_by_name("SND"), - RA_VALID_UNIT))); + ra_valid_unit))); gnode valid_down = CONV_TAC( law4[1], @@ -143,7 +143,7 @@ PROOF static thm prove_prod_ra_laws(void) { `R1:(A)ra`, `FST (a:A#B)`, `FST (b:A#B)`), - RA_VALID_OP_L), + ra_valid_op_l), assume_rule(` ra_valid (R1:(A)ra) (ra_op R1 (FST (a:A#B)) (FST (b:A#B))) @@ -156,7 +156,7 @@ PROOF static thm prove_prod_ra_laws(void) { `R2:(B)ra`, `SND (a:A#B)`, `SND (b:A#B)`), - RA_VALID_OP_L), + ra_valid_op_l), assume_rule(` ra_valid (R2:(B)ra) (ra_op R2 (SND (a:A#B)) (SND (b:A#B))) @@ -164,7 +164,7 @@ PROOF static thm prove_prod_ra_laws(void) { return gnode_prove(root); } -PROOF static thm PROD_RA_LAWS = prove_prod_ra_laws(); +PROOF static thm prod_ra_laws = prove_prod_ra_laws(); PROOF static thm prod_ra_def = new_fun_definition(` prod_ra (R1:(A)ra) (R2:(B)ra) : (A#B)ra = @@ -176,14 +176,14 @@ PROOF static thm prod_ra_def = new_fun_definition(` PROOF static thm prove_prod_ra_unit(void) { term R1 = `R1:(A)ra`; term R2 = `R2:(B)ra`; - thm laws = ispecl_rule(TERM_LIST(R1, R2), PROD_RA_LAWS); + thm laws = ispecl_rule(TERM_LIST(R1, R2), prod_ra_laws); thm computed = mp_rule( ispecl_rule( TERM_LIST( `(ra_unit (R1:(A)ra),ra_unit (R2:(B)ra))`, `prod_ra_op (R1:(A)ra) (R2:(B)ra)`, `prod_ra_valid (R1:(A)ra) (R2:(B)ra)`), - RA_UNIT_ABS), + ra_unit_abs), laws); computed = pure_once_rewrite_rule( THM_LIST(gsym_rule(prod_ra_def)), @@ -192,19 +192,19 @@ PROOF static thm prove_prod_ra_unit(void) { return gen_rule(R1, computed); } -PROOF thm PROD_RA_UNIT = prove_prod_ra_unit(); +PROOF thm prod_ra_unit = prove_prod_ra_unit(); PROOF static thm prove_prod_ra_op_fn(void) { term R1 = `R1:(A)ra`; term R2 = `R2:(B)ra`; - thm laws = ispecl_rule(TERM_LIST(R1, R2), PROD_RA_LAWS); + thm laws = ispecl_rule(TERM_LIST(R1, R2), prod_ra_laws); thm computed = mp_rule( ispecl_rule( TERM_LIST( `(ra_unit (R1:(A)ra),ra_unit (R2:(B)ra))`, `prod_ra_op (R1:(A)ra) (R2:(B)ra)`, `prod_ra_valid (R1:(A)ra) (R2:(B)ra)`), - RA_OP_ABS), + ra_op_abs), laws); computed = pure_once_rewrite_rule( THM_LIST(gsym_rule(prod_ra_def)), @@ -213,19 +213,19 @@ PROOF static thm prove_prod_ra_op_fn(void) { return gen_rule(R1, computed); } -PROOF static thm PROD_RA_OP_FN = prove_prod_ra_op_fn(); +PROOF static thm prod_ra_op_fn = prove_prod_ra_op_fn(); PROOF static thm prove_prod_ra_valid_fn(void) { term R1 = `R1:(A)ra`; term R2 = `R2:(B)ra`; - thm laws = ispecl_rule(TERM_LIST(R1, R2), PROD_RA_LAWS); + thm laws = ispecl_rule(TERM_LIST(R1, R2), prod_ra_laws); thm computed = mp_rule( ispecl_rule( TERM_LIST( `(ra_unit (R1:(A)ra),ra_unit (R2:(B)ra))`, `prod_ra_op (R1:(A)ra) (R2:(B)ra)`, `prod_ra_valid (R1:(A)ra) (R2:(B)ra)`), - RA_VALID_ABS), + ra_valid_abs), laws); computed = pure_once_rewrite_rule( THM_LIST(gsym_rule(prod_ra_def)), @@ -234,7 +234,7 @@ PROOF static thm prove_prod_ra_valid_fn(void) { return gen_rule(R1, computed); } -PROOF static thm PROD_RA_VALID_FN = prove_prod_ra_valid_fn(); +PROOF static thm prod_ra_valid_fn = prove_prod_ra_valid_fn(); PROOF static thm prove_prod_ra_op(void) { term goal_tm = ` @@ -247,12 +247,12 @@ PROOF static thm prove_prod_ra_op(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - PROD_RA_OP_FN, + prod_ra_op_fn, prod_ra_op_def))); return gnode_prove(root); } -PROOF thm PROD_RA_OP = prove_prod_ra_op(); +PROOF thm prod_ra_op = prove_prod_ra_op(); PROOF static thm prove_prod_ra_valid(void) { term goal_tm = ` @@ -264,12 +264,12 @@ PROOF static thm prove_prod_ra_valid(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - PROD_RA_VALID_FN, + prod_ra_valid_fn, prod_ra_valid_def))); return gnode_prove(root); } -PROOF thm PROD_RA_VALID = prove_prod_ra_valid(); +PROOF thm prod_ra_valid = prove_prod_ra_valid(); /* * A product is included in another product exactly when both projections are @@ -306,7 +306,7 @@ PROOF static thm prove_prod_ra_included(void) { `R2:(B)ra`, `x:A#B`, `frame:A#B`), - PROD_RA_OP); + prod_ra_op); thm fst_extension = ap_term_rule( `FST:(A#B)->A`, product_extension); @@ -378,7 +378,7 @@ PROOF static thm prove_prod_ra_included(void) { `R2:(B)ra`, `x:A#B`, `((left_frame:A),(right_frame:B))`), - PROD_RA_OP); + prod_ra_op); paired_product_op = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -390,7 +390,7 @@ PROOF static thm prove_prod_ra_included(void) { return gnode_prove(root); } -PROOF thm PROD_RA_INCLUDED = prove_prod_ra_included(); +PROOF thm prod_ra_included = prove_prod_ra_included(); /* Compatible frames are units componentwise when both projections are * exclusive. This is deliberately stronger than Iris's one-sided product @@ -420,7 +420,7 @@ PROOF static thm prove_prod_ra_exclusive(void) { conjunct1_rule(right_exclusive)); thm source_validity = ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), - PROD_RA_VALID); + prod_ra_valid); ACCEPT_TAC( exclusive[0], eq_mp_rule(gsym_rule(source_validity), source_components)); @@ -436,7 +436,7 @@ PROOF static thm prove_prod_ra_exclusive(void) { (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B) (frame:A#B)`), - PROD_RA_VALID); + prod_ra_valid); thm components = eq_mp_rule( product_validity, assume_rule(` @@ -449,7 +449,7 @@ PROOF static thm prove_prod_ra_exclusive(void) { `)); components = pure_rewrite_rule( THM_LIST( - PROD_RA_OP, + prod_ra_op, get_theorem_by_name("FST"), get_theorem_by_name("SND")), components); @@ -478,7 +478,7 @@ PROOF static thm prove_prod_ra_exclusive(void) { get_theorem_by_name("PAIR")); thm product_unit = ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`), - PROD_RA_UNIT); + prod_ra_unit); ACCEPT_TAC( body, trans_rule( @@ -487,7 +487,7 @@ PROOF static thm prove_prod_ra_exclusive(void) { return gnode_prove(root); } -PROOF thm PROD_RA_EXCLUSIVE = +PROOF thm prod_ra_exclusive = prove_prod_ra_exclusive(); /* Embed a left frame together with the right unit. Validity of the source @@ -509,14 +509,14 @@ PROOF static thm prove_prod_ra_exclusive_elim_left(void) { thm source_components = eq_mp_rule( ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), - PROD_RA_VALID), + prod_ra_valid), assume_rule(`ra_valid (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); ACCEPT_TAC(exclusive[0], conjunct1_rule(source_components)); body = GEN_TAC(exclusive[1], "frame"); body = DISCH_TAC(body, "Hcompatible"); thm right_unit = ispecl_rule( TERM_LIST(`R2:(B)ra`, `SND (x:A#B)`), - RA_UNIT_R); + ra_unit_r); thm right_compatible = eq_mp_rule( ap_term_rule( `ra_valid (R2:(B)ra):B->bool`, @@ -539,10 +539,10 @@ PROOF static thm prove_prod_ra_exclusive_elim_left(void) { `; thm framed_validity = ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, framed_source), - PROD_RA_VALID); + prod_ra_valid); framed_validity = pure_rewrite_rule( THM_LIST( - PROD_RA_OP, + prod_ra_op, get_theorem_by_name("FST"), get_theorem_by_name("SND")), framed_validity); @@ -555,7 +555,7 @@ PROOF static thm prove_prod_ra_exclusive_elim_left(void) { `R2:(B)ra`, `x:A#B`, product_frame), - PROD_RA_OP); + prod_ra_op); framed_op = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -577,14 +577,14 @@ PROOF static thm prove_prod_ra_exclusive_elim_left(void) { thm projected = ap_term_rule(`FST:(A#B)->A`, unit_frame); projected = pure_rewrite_rule( THM_LIST( - PROD_RA_UNIT, + prod_ra_unit, get_theorem_by_name("FST")), projected); ACCEPT_TAC(body, projected); return gnode_prove(root); } -PROOF thm PROD_RA_EXCLUSIVE_ELIM_LEFT = +PROOF thm prod_ra_exclusive_elim_left = prove_prod_ra_exclusive_elim_left(); /* Symmetric embedding of a right frame with the left unit. */ @@ -605,14 +605,14 @@ PROOF static thm prove_prod_ra_exclusive_elim_right(void) { thm source_components = eq_mp_rule( ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), - PROD_RA_VALID), + prod_ra_valid), assume_rule(`ra_valid (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); ACCEPT_TAC(exclusive[0], conjunct2_rule(source_components)); body = GEN_TAC(exclusive[1], "frame"); body = DISCH_TAC(body, "Hcompatible"); thm left_unit = ispecl_rule( TERM_LIST(`R1:(A)ra`, `FST (x:A#B)`), - RA_UNIT_R); + ra_unit_r); thm left_compatible = eq_mp_rule( ap_term_rule( `ra_valid (R1:(A)ra):A->bool`, @@ -635,10 +635,10 @@ PROOF static thm prove_prod_ra_exclusive_elim_right(void) { `; thm framed_validity = ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, framed_source), - PROD_RA_VALID); + prod_ra_valid); framed_validity = pure_rewrite_rule( THM_LIST( - PROD_RA_OP, + prod_ra_op, get_theorem_by_name("FST"), get_theorem_by_name("SND")), framed_validity); @@ -651,7 +651,7 @@ PROOF static thm prove_prod_ra_exclusive_elim_right(void) { `R2:(B)ra`, `x:A#B`, product_frame), - PROD_RA_OP); + prod_ra_op); framed_op = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -673,14 +673,14 @@ PROOF static thm prove_prod_ra_exclusive_elim_right(void) { thm projected = ap_term_rule(`SND:(A#B)->B`, unit_frame); projected = pure_rewrite_rule( THM_LIST( - PROD_RA_UNIT, + prod_ra_unit, get_theorem_by_name("SND")), projected); ACCEPT_TAC(body, projected); return gnode_prove(root); } -PROOF thm PROD_RA_EXCLUSIVE_ELIM_RIGHT = +PROOF thm prod_ra_exclusive_elim_right = prove_prod_ra_exclusive_elim_right(); PROOF static thm prove_prod_ra_exclusive_iff(void) { @@ -701,7 +701,7 @@ PROOF static thm prove_prod_ra_exclusive_iff(void) { gnode_list components = CONJ_TAC(forward); thm left = ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), - PROD_RA_EXCLUSIVE_ELIM_LEFT); + prod_ra_exclusive_elim_left); left = mp_rule( left, conjunct1_rule(product_exclusive)); @@ -712,7 +712,7 @@ PROOF static thm prove_prod_ra_exclusive_iff(void) { thm right = ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), - PROD_RA_EXCLUSIVE_ELIM_RIGHT); + prod_ra_exclusive_elim_right); right = mp_rule( right, conjunct1_rule(product_exclusive)); @@ -724,7 +724,7 @@ PROOF static thm prove_prod_ra_exclusive_iff(void) { gnode reverse = DISCH_TAC(directions[1], "Hcomponents"); thm result = ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), - PROD_RA_EXCLUSIVE); + prod_ra_exclusive); result = mp_rule( result, conjunct1_rule(assume_rule(` @@ -741,7 +741,7 @@ PROOF static thm prove_prod_ra_exclusive_iff(void) { return gnode_prove(root); } -PROOF thm PROD_RA_EXCLUSIVE_IFF = +PROOF thm prod_ra_exclusive_iff = prove_prod_ra_exclusive_iff(); /* @@ -778,7 +778,7 @@ PROOF static thm prove_prod_ra_cancellative(void) { (prod_ra (R1:(A)ra) (R2:(B)ra)) (frame:A#B) (a:A#B)`), - PROD_RA_VALID); + prod_ra_valid); thm source_components = eq_mp_rule( source_valid_rule, assume_rule(` @@ -795,7 +795,7 @@ PROOF static thm prove_prod_ra_cancellative(void) { `R2:(B)ra`, `frame:A#B`, `a:A#B`), - PROD_RA_OP); + prod_ra_op); source_components = pure_rewrite_rule( THM_LIST( source_op, @@ -809,7 +809,7 @@ PROOF static thm prove_prod_ra_cancellative(void) { `R2:(B)ra`, `frame:A#B`, `b:A#B`), - PROD_RA_OP); + prod_ra_op); thm product_ops_equal = pure_rewrite_rule( THM_LIST(source_op, target_op), assume_rule(` @@ -839,7 +839,7 @@ PROOF static thm prove_prod_ra_cancellative(void) { `FST (frame:A#B)`, `FST (a:A#B)`, `FST (b:A#B)`), - RA_CANCELLATIVE_APPLY); + ra_cancellative_apply); left_equal = mp_rule( left_equal, assume_rule(`ra_cancellative (R1:(A)ra)`)); @@ -856,7 +856,7 @@ PROOF static thm prove_prod_ra_cancellative(void) { `SND (frame:A#B)`, `SND (a:A#B)`, `SND (b:A#B)`), - RA_CANCELLATIVE_APPLY); + ra_cancellative_apply); right_equal = mp_rule( right_equal, assume_rule(`ra_cancellative (R2:(B)ra)`)); @@ -891,7 +891,7 @@ PROOF static thm prove_prod_ra_cancellative(void) { return gnode_prove(root); } -PROOF thm PROD_RA_CANCELLATIVE = prove_prod_ra_cancellative(); +PROOF thm prod_ra_cancellative = prove_prod_ra_cancellative(); /* Recover left cancellation by embedding the right component at its unit. */ PROOF static thm prove_prod_ra_cancellative_elim_left(void) { @@ -910,11 +910,11 @@ PROOF static thm prove_prod_ra_cancellative_elim_left(void) { term product_frame = `((frame:A),ra_unit (R2:(B)ra))`; term product_a = `((a:A),ra_unit (R2:(B)ra))`; term product_b = `((b:A),ra_unit (R2:(B)ra))`; - thm right_unit_valid = RA_VALID_UNIT; + thm right_unit_valid = ra_valid_unit; right_unit_valid = ispec_rule(`R2:(B)ra`, right_unit_valid); thm right_unit_op = ispecl_rule( TERM_LIST(`R2:(B)ra`, `ra_unit (R2:(B)ra)`), - RA_UNIT_L); + ra_unit_l); thm right_composition_valid = eq_mp_rule( ap_term_rule( `ra_valid (R2:(B)ra):B->bool`, @@ -926,7 +926,7 @@ PROOF static thm prove_prod_ra_cancellative_elim_left(void) { `R2:(B)ra`, `(ra_op (R1:(A)ra) (frame:A) (a:A), ra_op (R2:(B)ra) (ra_unit R2) (ra_unit R2))`), - PROD_RA_VALID); + prod_ra_valid); explicit_source_validity = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -943,7 +943,7 @@ PROOF static thm prove_prod_ra_cancellative_elim_left(void) { right_composition_valid)); thm source_op = ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, product_frame, product_a), - PROD_RA_OP); + prod_ra_op); source_op = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -971,7 +971,7 @@ PROOF static thm prove_prod_ra_cancellative_elim_left(void) { refl_rule(`ra_op (R2:(B)ra) (ra_unit R2) (ra_unit R2)`))); thm target_op = ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, product_frame, product_b), - PROD_RA_OP); + prod_ra_op); target_op = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -987,7 +987,7 @@ PROOF static thm prove_prod_ra_cancellative_elim_left(void) { product_frame, product_a, product_b), - RA_CANCELLATIVE_APPLY); + ra_cancellative_apply); cancelled = mp_rule( cancelled, assume_rule(`ra_cancellative (prod_ra (R1:(A)ra) (R2:(B)ra))`)); @@ -1001,7 +1001,7 @@ PROOF static thm prove_prod_ra_cancellative_elim_left(void) { return gnode_prove(root); } -PROOF static thm PROD_RA_CANCELLATIVE_ELIM_LEFT = +PROOF static thm prod_ra_cancellative_elim_left = prove_prod_ra_cancellative_elim_left(); /* Symmetric embedding at the valid left unit. */ @@ -1021,10 +1021,10 @@ PROOF static thm prove_prod_ra_cancellative_elim_right(void) { term product_frame = `(ra_unit (R1:(A)ra),(frame:B))`; term product_a = `(ra_unit (R1:(A)ra),(a:B))`; term product_b = `(ra_unit (R1:(A)ra),(b:B))`; - thm left_unit_valid = ispec_rule(`R1:(A)ra`, RA_VALID_UNIT); + thm left_unit_valid = ispec_rule(`R1:(A)ra`, ra_valid_unit); thm left_unit_op = ispecl_rule( TERM_LIST(`R1:(A)ra`, `ra_unit (R1:(A)ra)`), - RA_UNIT_L); + ra_unit_l); thm left_composition_valid = eq_mp_rule( ap_term_rule( `ra_valid (R1:(A)ra):A->bool`, @@ -1036,7 +1036,7 @@ PROOF static thm prove_prod_ra_cancellative_elim_right(void) { `R2:(B)ra`, `(ra_op (R1:(A)ra) (ra_unit R1) (ra_unit R1), ra_op (R2:(B)ra) (frame:B) (a:B))`), - PROD_RA_VALID); + prod_ra_valid); explicit_source_validity = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -1053,7 +1053,7 @@ PROOF static thm prove_prod_ra_cancellative_elim_right(void) { `))); thm source_op = ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, product_frame, product_a), - PROD_RA_OP); + prod_ra_op); source_op = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -1081,7 +1081,7 @@ PROOF static thm prove_prod_ra_cancellative_elim_right(void) { `))); thm target_op = ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, product_frame, product_b), - PROD_RA_OP); + prod_ra_op); target_op = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -1097,7 +1097,7 @@ PROOF static thm prove_prod_ra_cancellative_elim_right(void) { product_frame, product_a, product_b), - RA_CANCELLATIVE_APPLY); + ra_cancellative_apply); cancelled = mp_rule( cancelled, assume_rule(`ra_cancellative (prod_ra (R1:(A)ra) (R2:(B)ra))`)); @@ -1111,7 +1111,7 @@ PROOF static thm prove_prod_ra_cancellative_elim_right(void) { return gnode_prove(root); } -PROOF static thm PROD_RA_CANCELLATIVE_ELIM_RIGHT = +PROOF static thm prod_ra_cancellative_elim_right = prove_prod_ra_cancellative_elim_right(); PROOF static thm prove_prod_ra_cancellative_iff(void) { @@ -1131,20 +1131,20 @@ PROOF static thm prove_prod_ra_cancellative_iff(void) { mp_rule( ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`), - PROD_RA_CANCELLATIVE_ELIM_LEFT), + prod_ra_cancellative_elim_left), assume_rule(`ra_cancellative (prod_ra (R1:(A)ra) (R2:(B)ra))`))); ACCEPT_TAC( components[1], mp_rule( ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`), - PROD_RA_CANCELLATIVE_ELIM_RIGHT), + prod_ra_cancellative_elim_right), assume_rule(`ra_cancellative (prod_ra (R1:(A)ra) (R2:(B)ra))`))); gnode reverse = DISCH_TAC(directions[1], "Hcomponents"); thm result = ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`), - PROD_RA_CANCELLATIVE); + prod_ra_cancellative); result = mp_rule( result, conjunct1_rule(assume_rule(` @@ -1159,7 +1159,7 @@ PROOF static thm prove_prod_ra_cancellative_iff(void) { return gnode_prove(root); } -PROOF thm PROD_RA_CANCELLATIVE_IFF = +PROOF thm prod_ra_cancellative_iff = prove_prod_ra_cancellative_iff(); /* @@ -1207,7 +1207,7 @@ PROOF static thm prove_prod_ra_updateP(void) { (prod_ra (R1:(A)ra) (R2:(B)ra)) ((a1:A),(a2:B)) (frame:A#B)`), - PROD_RA_VALID); + prod_ra_valid); thm source_components = eq_mp_rule(source_valid_rule, source_valid); thm source_op = ispecl_rule( TERM_LIST( @@ -1215,7 +1215,7 @@ PROOF static thm prove_prod_ra_updateP(void) { `R2:(B)ra`, `((a1:A),(a2:B))`, `frame:A#B`), - PROD_RA_OP); + prod_ra_op); source_components = pure_rewrite_rule( THM_LIST( source_op, @@ -1280,14 +1280,14 @@ PROOF static thm prove_prod_ra_updateP(void) { (prod_ra (R1:(A)ra) (R2:(B)ra)) ((b1:A),(b2:B)) (frame:A#B)`), - PROD_RA_VALID); + prod_ra_valid); thm result_op = ispecl_rule( TERM_LIST( `R1:(A)ra`, `R2:(B)ra`, `((b1:A),(b2:B))`, `frame:A#B`), - PROD_RA_OP); + prod_ra_op); result_op = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -1332,7 +1332,7 @@ PROOF static thm prove_prod_ra_updateP(void) { return gnode_prove(root); } -PROOF thm PROD_RA_UPDATEP = prove_prod_ra_updateP(); +PROOF thm prod_ra_updateP = prove_prod_ra_updateP(); /* Deterministic component updates preserve every product frame pointwise. */ PROOF static thm prove_prod_ra_update(void) { @@ -1375,7 +1375,7 @@ PROOF static thm prove_prod_ra_update(void) { (prod_ra (R1:(A)ra) (R2:(B)ra)) ((a1:A),(a2:B)) (frame:A#B)`), - PROD_RA_VALID); + prod_ra_valid); thm source_components = eq_mp_rule(source_valid_rule, source_valid); thm source_op = ispecl_rule( TERM_LIST( @@ -1383,7 +1383,7 @@ PROOF static thm prove_prod_ra_update(void) { `R2:(B)ra`, `((a1:A),(a2:B))`, `frame:A#B`), - PROD_RA_OP); + prod_ra_op); source_components = pure_rewrite_rule( THM_LIST( source_op, @@ -1398,10 +1398,10 @@ PROOF static thm prove_prod_ra_update(void) { `a1:A`, `b1:A`, `FST (frame:A#B)`), - RA_UPDATE_FRAME), + ra_update_frame), assume_rule(`ra_update (R1:(A)ra) (a1:A) (b1:A)`)); thm left_valid = mp_rule( - match_mp_rule(RA_UPDATE_VALID, left_update), + match_mp_rule(ra_update_valid, left_update), conjunct1_rule(source_components)); thm right_update = mp_rule( ispecl_rule( @@ -1410,10 +1410,10 @@ PROOF static thm prove_prod_ra_update(void) { `a2:B`, `b2:B`, `SND (frame:A#B)`), - RA_UPDATE_FRAME), + ra_update_frame), assume_rule(`ra_update (R2:(B)ra) (a2:B) (b2:B)`)); thm right_valid = mp_rule( - match_mp_rule(RA_UPDATE_VALID, right_update), + match_mp_rule(ra_update_valid, right_update), conjunct2_rule(source_components)); thm result_valid_rule = ispecl_rule( @@ -1424,14 +1424,14 @@ PROOF static thm prove_prod_ra_update(void) { (prod_ra (R1:(A)ra) (R2:(B)ra)) ((b1:A),(b2:B)) (frame:A#B)`), - PROD_RA_VALID); + prod_ra_valid); thm result_op = ispecl_rule( TERM_LIST( `R1:(A)ra`, `R2:(B)ra`, `((b1:A),(b2:B))`, `frame:A#B`), - PROD_RA_OP); + prod_ra_op); result_op = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -1465,7 +1465,7 @@ PROOF static thm prove_prod_ra_update(void) { return gnode_prove(root); } -PROOF thm PROD_RA_UPDATE = prove_prod_ra_update(); +PROOF thm prod_ra_update = prove_prod_ra_update(); /* Observe a product update through a frame in one component and the valid * unit frame in the other. The other source component must itself be valid @@ -1496,7 +1496,7 @@ PROOF static thm prove_prod_ra_update_elim_left(void) { thm right_unit = ispecl_rule( TERM_LIST(`R2:(B)ra`, `a2:B`), - RA_UNIT_R); + ra_unit_r); thm right_valid = eq_mp_rule( ap_term_rule( `ra_valid (R2:(B)ra):B->bool`, @@ -1513,7 +1513,7 @@ PROOF static thm prove_prod_ra_update_elim_left(void) { `R2:(B)ra`, `(ra_op (R1:(A)ra) (a1:A) (frame:A), ra_op (R2:(B)ra) (a2:B) (ra_unit R2))`), - PROD_RA_VALID); + prod_ra_valid); source_validity = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -1528,7 +1528,7 @@ PROOF static thm prove_prod_ra_update_elim_left(void) { `R2:(B)ra`, `((a1:A),(a2:B))`, product_frame), - PROD_RA_OP); + prod_ra_op); source_op = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -1547,7 +1547,7 @@ PROOF static thm prove_prod_ra_update_elim_left(void) { `((a1:A),(a2:B))`, `((b1:A),(b2:B))`, product_frame), - RA_UPDATE_FRAME), + ra_update_frame), assume_rule(` ra_update (prod_ra (R1:(A)ra) (R2:(B)ra)) @@ -1555,7 +1555,7 @@ PROOF static thm prove_prod_ra_update_elim_left(void) { ((b1:A),(b2:B)) `)); thm target_valid = mp_rule( - match_mp_rule(RA_UPDATE_VALID, framed_update), + match_mp_rule(ra_update_valid, framed_update), source_valid); thm target_components = eq_mp_rule( @@ -1567,11 +1567,11 @@ PROOF static thm prove_prod_ra_update_elim_left(void) { (prod_ra (R1:(A)ra) (R2:(B)ra)) ((b1:A),(b2:B)) ((frame:A),ra_unit R2)`), - PROD_RA_VALID), + prod_ra_valid), target_valid); target_components = pure_rewrite_rule( THM_LIST( - PROD_RA_OP, + prod_ra_op, get_theorem_by_name("FST"), get_theorem_by_name("SND")), target_components); @@ -1579,7 +1579,7 @@ PROOF static thm prove_prod_ra_update_elim_left(void) { return gnode_prove(root); } -PROOF thm PROD_RA_UPDATE_ELIM_LEFT = +PROOF thm prod_ra_update_elim_left = prove_prod_ra_update_elim_left(); PROOF static thm prove_prod_ra_update_elim_right(void) { @@ -1608,7 +1608,7 @@ PROOF static thm prove_prod_ra_update_elim_right(void) { thm left_unit = ispecl_rule( TERM_LIST(`R1:(A)ra`, `a1:A`), - RA_UNIT_R); + ra_unit_r); thm left_valid = eq_mp_rule( ap_term_rule( `ra_valid (R1:(A)ra):A->bool`, @@ -1625,7 +1625,7 @@ PROOF static thm prove_prod_ra_update_elim_right(void) { `R2:(B)ra`, `(ra_op (R1:(A)ra) (a1:A) (ra_unit R1), ra_op (R2:(B)ra) (a2:B) (frame:B))`), - PROD_RA_VALID); + prod_ra_valid); source_validity = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -1640,7 +1640,7 @@ PROOF static thm prove_prod_ra_update_elim_right(void) { `R2:(B)ra`, `((a1:A),(a2:B))`, product_frame), - PROD_RA_OP); + prod_ra_op); source_op = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -1659,7 +1659,7 @@ PROOF static thm prove_prod_ra_update_elim_right(void) { `((a1:A),(a2:B))`, `((b1:A),(b2:B))`, product_frame), - RA_UPDATE_FRAME), + ra_update_frame), assume_rule(` ra_update (prod_ra (R1:(A)ra) (R2:(B)ra)) @@ -1667,7 +1667,7 @@ PROOF static thm prove_prod_ra_update_elim_right(void) { ((b1:A),(b2:B)) `)); thm target_valid = mp_rule( - match_mp_rule(RA_UPDATE_VALID, framed_update), + match_mp_rule(ra_update_valid, framed_update), source_valid); thm target_components = eq_mp_rule( @@ -1679,11 +1679,11 @@ PROOF static thm prove_prod_ra_update_elim_right(void) { (prod_ra (R1:(A)ra) (R2:(B)ra)) ((b1:A),(b2:B)) (ra_unit R1,(frame:B))`), - PROD_RA_VALID), + prod_ra_valid), target_valid); target_components = pure_rewrite_rule( THM_LIST( - PROD_RA_OP, + prod_ra_op, get_theorem_by_name("FST"), get_theorem_by_name("SND")), target_components); @@ -1691,7 +1691,7 @@ PROOF static thm prove_prod_ra_update_elim_right(void) { return gnode_prove(root); } -PROOF thm PROD_RA_UPDATE_ELIM_RIGHT = +PROOF thm prod_ra_update_elim_right = prove_prod_ra_update_elim_right(); PROOF static thm prove_prod_ra_update_iff(void) { @@ -1713,7 +1713,7 @@ PROOF static thm prove_prod_ra_update_iff(void) { TERM_LIST( `R1:(A)ra`, `R2:(B)ra`, `a1:A`, `a2:B`, `b1:A`, `b2:B`), - PROD_RA_UPDATE_ELIM_LEFT); + prod_ra_update_elim_left); left = mp_rule(left, assume_rule(` ra_update (prod_ra (R1:(A)ra) (R2:(B)ra)) @@ -1727,7 +1727,7 @@ PROOF static thm prove_prod_ra_update_iff(void) { TERM_LIST( `R1:(A)ra`, `R2:(B)ra`, `a1:A`, `a2:B`, `b1:A`, `b2:B`), - PROD_RA_UPDATE_ELIM_RIGHT); + prod_ra_update_elim_right); right = mp_rule(right, assume_rule(` ra_update (prod_ra (R1:(A)ra) (R2:(B)ra)) @@ -1742,7 +1742,7 @@ PROOF static thm prove_prod_ra_update_iff(void) { TERM_LIST( `R1:(A)ra`, `R2:(B)ra`, `a1:A`, `a2:B`, `b1:A`, `b2:B`), - PROD_RA_UPDATE); + prod_ra_update); result = mp_rule( result, conjunct1_rule(assume_rule(` @@ -1759,7 +1759,7 @@ PROOF static thm prove_prod_ra_update_iff(void) { return gnode_prove(root); } -PROOF thm PROD_RA_UPDATE_IFF = +PROOF thm prod_ra_update_iff = prove_prod_ra_update_iff(); /* @@ -1801,7 +1801,7 @@ PROOF static thm prove_prod_ra_left_image_imp(void) { return gnode_prove(root); } -PROOF static thm PROD_RA_LEFT_IMAGE_IMP = +PROOF static thm prod_ra_left_image_imp = prove_prod_ra_left_image_imp(); /* @@ -1844,7 +1844,7 @@ PROOF static thm prove_prod_ra_update_leftP(void) { `a2:B`, `P:A->bool`, fixed_right), - PROD_RA_UPDATEP); + prod_ra_updateP); combined = mp_rule( combined, assume_rule(` @@ -1854,7 +1854,7 @@ PROOF static thm prove_prod_ra_update_leftP(void) { combined, ispecl_rule( TERM_LIST(`R2:(B)ra`, `a2:B`), - RA_UPDATEP_REFL)); + ra_updateP_refl)); combined = conv_rule( depth_conv(get_conversion_by_name("BETA_CONV")), combined); @@ -1865,21 +1865,21 @@ PROOF static thm prove_prod_ra_update_leftP(void) { `((a1:A),(a2:B))`, combined_predicate, left_image), - RA_UPDATEP_MONO); + ra_updateP_mono); weakened = mp_rule(weakened, combined); weakened = conv_rule( depth_conv(get_conversion_by_name("BETA_CONV")), weakened); thm image_implication = ispecl_rule( TERM_LIST(`P:A->bool`, `a2:B`), - PROD_RA_LEFT_IMAGE_IMP); + prod_ra_left_image_imp); ACCEPT_TAC( body, mp_rule(weakened, image_implication)); return gnode_prove(root); } -PROOF static thm PROD_RA_UPDATE_LEFTP = prove_prod_ra_update_leftP(); +PROOF static thm prod_ra_update_leftP = prove_prod_ra_update_leftP(); /* The deterministic one-sided rule is product update plus reflexivity. */ PROOF static thm prove_prod_ra_update_left(void) { @@ -1899,7 +1899,7 @@ PROOF static thm prove_prod_ra_update_left(void) { `a2:B`, `b1:A`, `a2:B`), - PROD_RA_UPDATE); + prod_ra_update); combined = mp_rule( combined, assume_rule(`ra_update (R1:(A)ra) (a1:A) (b1:A)`)); @@ -1907,12 +1907,12 @@ PROOF static thm prove_prod_ra_update_left(void) { combined, ispecl_rule( TERM_LIST(`R2:(B)ra`, `a2:B`), - RA_UPDATE_REFL)); + ra_update_refl)); ACCEPT_TAC(body, combined); return gnode_prove(root); } -PROOF thm PROD_RA_UPDATE_LEFT = prove_prod_ra_update_left(); +PROOF thm prod_ra_update_left = prove_prod_ra_update_left(); /* Symmetric exact-image normalization for a fixed left component. */ PROOF static thm prove_prod_ra_right_image_imp(void) { @@ -1949,7 +1949,7 @@ PROOF static thm prove_prod_ra_right_image_imp(void) { return gnode_prove(root); } -PROOF static thm PROD_RA_RIGHT_IMAGE_IMP = +PROOF static thm prod_ra_right_image_imp = prove_prod_ra_right_image_imp(); /* Combine left-side ND reflexivity with the requested right update. */ @@ -1989,12 +1989,12 @@ PROOF static thm prove_prod_ra_update_rightP(void) { `a2:B`, fixed_left, `P:B->bool`), - PROD_RA_UPDATEP); + prod_ra_updateP); combined = mp_rule( combined, ispecl_rule( TERM_LIST(`R1:(A)ra`, `a1:A`), - RA_UPDATEP_REFL)); + ra_updateP_refl)); combined = mp_rule( combined, assume_rule(` @@ -2010,21 +2010,21 @@ PROOF static thm prove_prod_ra_update_rightP(void) { `((a1:A),(a2:B))`, combined_predicate, right_image), - RA_UPDATEP_MONO); + ra_updateP_mono); weakened = mp_rule(weakened, combined); weakened = conv_rule( depth_conv(get_conversion_by_name("BETA_CONV")), weakened); thm image_implication = ispecl_rule( TERM_LIST(`a1:A`, `P:B->bool`), - PROD_RA_RIGHT_IMAGE_IMP); + prod_ra_right_image_imp); ACCEPT_TAC( body, mp_rule(weakened, image_implication)); return gnode_prove(root); } -PROOF static thm PROD_RA_UPDATE_RIGHTP = prove_prod_ra_update_rightP(); +PROOF static thm prod_ra_update_rightP = prove_prod_ra_update_rightP(); /* The deterministic right-only rule is product update plus reflexivity. */ PROOF static thm prove_prod_ra_update_right(void) { @@ -2044,12 +2044,12 @@ PROOF static thm prove_prod_ra_update_right(void) { `a2:B`, `a1:A`, `b2:B`), - PROD_RA_UPDATE); + prod_ra_update); combined = mp_rule( combined, ispecl_rule( TERM_LIST(`R1:(A)ra`, `a1:A`), - RA_UPDATE_REFL)); + ra_update_refl)); combined = mp_rule( combined, assume_rule(`ra_update (R2:(B)ra) (a2:B) (b2:B)`)); @@ -2057,7 +2057,7 @@ PROOF static thm prove_prod_ra_update_right(void) { return gnode_prove(root); } -PROOF thm PROD_RA_UPDATE_RIGHT = prove_prod_ra_update_right(); +PROOF thm prod_ra_update_right = prove_prod_ra_update_right(); /* Iris's product local update specializes directly to the discrete unital * relation used here: project validity and the shared residual frame, run the @@ -2088,7 +2088,7 @@ PROOF static thm prove_prod_ra_local_update(void) { `R1:(A)ra`, `R2:(B)ra`, `((a1:A),(a2:B))`), - PROD_RA_VALID); + prod_ra_valid); source_validity = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -2112,14 +2112,14 @@ PROOF static thm prove_prod_ra_local_update(void) { thm left_extension = ap_term_rule(`FST:(A#B)->A`, source_extension); left_extension = pure_rewrite_rule( THM_LIST( - PROD_RA_OP, + prod_ra_op, get_theorem_by_name("FST"), get_theorem_by_name("SND")), left_extension); thm right_extension = ap_term_rule(`SND:(A#B)->B`, source_extension); right_extension = pure_rewrite_rule( THM_LIST( - PROD_RA_OP, + prod_ra_op, get_theorem_by_name("FST"), get_theorem_by_name("SND")), right_extension); @@ -2132,7 +2132,7 @@ PROOF static thm prove_prod_ra_local_update(void) { `b1:A`, `g1:A`, `FST (residual:A#B)`), - RA_LOCAL_UPDATE_APPLY); + ra_local_update_apply); left_result = mp_rule( left_result, assume_rule(` @@ -2154,7 +2154,7 @@ PROOF static thm prove_prod_ra_local_update(void) { `b2:B`, `g2:B`, `SND (residual:A#B)`), - RA_LOCAL_UPDATE_APPLY); + ra_local_update_apply); right_result = mp_rule( right_result, assume_rule(` @@ -2174,7 +2174,7 @@ PROOF static thm prove_prod_ra_local_update(void) { `R1:(A)ra`, `R2:(B)ra`, `((b1:A),(b2:B))`), - PROD_RA_VALID); + prod_ra_valid); target_validity = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -2205,7 +2205,7 @@ PROOF static thm prove_prod_ra_local_update(void) { `R2:(B)ra`, `((g1:A),(g2:B))`, `residual:A#B`), - PROD_RA_OP); + prod_ra_op); target_op = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -2217,7 +2217,7 @@ PROOF static thm prove_prod_ra_local_update(void) { return gnode_prove(root); } -PROOF thm PROD_RA_LOCAL_UPDATE = +PROOF thm prod_ra_local_update = prove_prod_ra_local_update(); /* One-sided rules are the product rule plus local-update reflexivity. */ @@ -2241,7 +2241,7 @@ PROOF static thm prove_prod_ra_local_update_left(void) { `R1:(A)ra`, `R2:(B)ra`, `a1:A`, `f1:A`, `b1:A`, `g1:A`, `a2:B`, `f2:B`, `a2:B`, `f2:B`), - PROD_RA_LOCAL_UPDATE); + prod_ra_local_update); result = mp_rule( result, assume_rule(` @@ -2256,12 +2256,12 @@ PROOF static thm prove_prod_ra_local_update_left(void) { result, ispecl_rule( TERM_LIST(`R2:(B)ra`, `a2:B`, `f2:B`), - RA_LOCAL_UPDATE_REFL)); + ra_local_update_refl)); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF static thm PROD_RA_LOCAL_UPDATE_LEFT = +PROOF static thm prod_ra_local_update_left = prove_prod_ra_local_update_left(); PROOF static thm prove_prod_ra_local_update_right(void) { @@ -2284,12 +2284,12 @@ PROOF static thm prove_prod_ra_local_update_right(void) { `R1:(A)ra`, `R2:(B)ra`, `a1:A`, `f1:A`, `a1:A`, `f1:A`, `a2:B`, `f2:B`, `b2:B`, `g2:B`), - PROD_RA_LOCAL_UPDATE); + prod_ra_local_update); result = mp_rule( result, ispecl_rule( TERM_LIST(`R1:(A)ra`, `a1:A`, `f1:A`), - RA_LOCAL_UPDATE_REFL)); + ra_local_update_refl)); result = mp_rule( result, assume_rule(` @@ -2304,7 +2304,7 @@ PROOF static thm prove_prod_ra_local_update_right(void) { return gnode_prove(root); } -PROOF static thm PROD_RA_LOCAL_UPDATE_RIGHT = +PROOF static thm prod_ra_local_update_right = prove_prod_ra_local_update_right(); /* ------------------------------------------------------------------------- */ @@ -2350,14 +2350,14 @@ PROOF static thm prove_prod_inl_op(void) { root, rewrite_conv(THM_LIST( prod_inl_def, - PROD_RA_OP, + prod_ra_op, get_theorem_by_name("FST"), get_theorem_by_name("SND"), - RA_UNIT_L))); + ra_unit_l))); return gnode_prove(root); } -PROOF thm PROD_INL_OP = prove_prod_inl_op(); +PROOF thm prod_inl_op = prove_prod_inl_op(); PROOF static thm prove_prod_inr_op(void) { term goal_tm = ` @@ -2370,14 +2370,14 @@ PROOF static thm prove_prod_inr_op(void) { root, rewrite_conv(THM_LIST( prod_inr_def, - PROD_RA_OP, + prod_ra_op, get_theorem_by_name("FST"), get_theorem_by_name("SND"), - RA_UNIT_L))); + ra_unit_l))); return gnode_prove(root); } -PROOF thm PROD_INR_OP = prove_prod_inr_op(); +PROOF thm prod_inr_op = prove_prod_inr_op(); PROOF static thm prove_prod_inl_updateP(void) { term goal_tm = ` @@ -2398,7 +2398,7 @@ PROOF static thm prove_prod_inl_updateP(void) { `a:A`, `ra_unit (S:(B)ra)`, `P:A->bool`), - PROD_RA_UPDATE_LEFTP), + prod_ra_update_leftP), assume_rule(`ra_updateP (R:(A)ra) (a:A) (P:A->bool)`)); body = CONV_TAC( body, @@ -2407,7 +2407,7 @@ PROOF static thm prove_prod_inl_updateP(void) { return gnode_prove(root); } -PROOF thm PROD_INL_UPDATEP = prove_prod_inl_updateP(); +PROOF thm prod_inl_updateP = prove_prod_inl_updateP(); PROOF static thm prove_prod_inr_updateP(void) { term goal_tm = ` @@ -2428,7 +2428,7 @@ PROOF static thm prove_prod_inr_updateP(void) { `ra_unit (R:(A)ra)`, `a:B`, `P:B->bool`), - PROD_RA_UPDATE_RIGHTP), + prod_ra_update_rightP), assume_rule(`ra_updateP (S:(B)ra) (a:B) (P:B->bool)`)); body = CONV_TAC( body, @@ -2437,7 +2437,7 @@ PROOF static thm prove_prod_inr_updateP(void) { return gnode_prove(root); } -PROOF thm PROD_INR_UPDATEP = prove_prod_inr_updateP(); +PROOF thm prod_inr_updateP = prove_prod_inr_updateP(); PROOF static thm prove_prod_inl_update(void) { term goal_tm = ` @@ -2458,7 +2458,7 @@ PROOF static thm prove_prod_inl_update(void) { `a:A`, `ra_unit (S:(B)ra)`, `b:A`), - PROD_RA_UPDATE_LEFT), + prod_ra_update_left), assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); body = CONV_TAC( body, @@ -2467,7 +2467,7 @@ PROOF static thm prove_prod_inl_update(void) { return gnode_prove(root); } -PROOF thm PROD_INL_UPDATE = prove_prod_inl_update(); +PROOF thm prod_inl_update = prove_prod_inl_update(); PROOF static thm prove_prod_inr_update(void) { term goal_tm = ` @@ -2488,7 +2488,7 @@ PROOF static thm prove_prod_inr_update(void) { `ra_unit (R:(A)ra)`, `a:B`, `b:B`), - PROD_RA_UPDATE_RIGHT), + prod_ra_update_right), assume_rule(`ra_update (S:(B)ra) (a:B) (b:B)`)); body = CONV_TAC( body, @@ -2497,52 +2497,52 @@ PROOF static thm prove_prod_inr_update(void) { return gnode_prove(root); } -PROOF thm PROD_INR_UPDATE = prove_prod_inr_update(); +PROOF thm prod_inr_update = prove_prod_inr_update(); PROOF static int audit_prod_ra(void) { thm_list source_theorems = THM_LIST( prod_ra_op_def, prod_ra_valid_def, - PROD_RA_LAWS, + prod_ra_laws, prod_ra_def, - PROD_RA_UNIT, - PROD_RA_OP_FN, - PROD_RA_VALID_FN, - PROD_RA_OP, - PROD_RA_VALID, - PROD_RA_INCLUDED, - PROD_RA_EXCLUSIVE, - PROD_RA_EXCLUSIVE_ELIM_LEFT, - PROD_RA_EXCLUSIVE_ELIM_RIGHT, - PROD_RA_EXCLUSIVE_IFF, - PROD_RA_CANCELLATIVE, - PROD_RA_CANCELLATIVE_ELIM_LEFT, - PROD_RA_CANCELLATIVE_ELIM_RIGHT, - PROD_RA_CANCELLATIVE_IFF, - PROD_RA_UPDATEP, - PROD_RA_UPDATE, - PROD_RA_UPDATE_ELIM_LEFT, - PROD_RA_UPDATE_ELIM_RIGHT, - PROD_RA_UPDATE_IFF, - PROD_RA_LEFT_IMAGE_IMP, - PROD_RA_UPDATE_LEFTP, - PROD_RA_UPDATE_LEFT, - PROD_RA_RIGHT_IMAGE_IMP, - PROD_RA_UPDATE_RIGHTP, - PROD_RA_UPDATE_RIGHT, - PROD_RA_LOCAL_UPDATE, - PROD_RA_LOCAL_UPDATE_LEFT, - PROD_RA_LOCAL_UPDATE_RIGHT, + prod_ra_unit, + prod_ra_op_fn, + prod_ra_valid_fn, + prod_ra_op, + prod_ra_valid, + prod_ra_included, + prod_ra_exclusive, + prod_ra_exclusive_elim_left, + prod_ra_exclusive_elim_right, + prod_ra_exclusive_iff, + prod_ra_cancellative, + prod_ra_cancellative_elim_left, + prod_ra_cancellative_elim_right, + prod_ra_cancellative_iff, + prod_ra_updateP, + prod_ra_update, + prod_ra_update_elim_left, + prod_ra_update_elim_right, + prod_ra_update_iff, + prod_ra_left_image_imp, + prod_ra_update_leftP, + prod_ra_update_left, + prod_ra_right_image_imp, + prod_ra_update_rightP, + prod_ra_update_right, + prod_ra_local_update, + prod_ra_local_update_left, + prod_ra_local_update_right, prod_inl_raw_def, prod_inl_def, prod_inr_raw_def, prod_inr_def, - PROD_INL_OP, - PROD_INR_OP, - PROD_INL_UPDATEP, - PROD_INR_UPDATEP, - PROD_INL_UPDATE, - PROD_INR_UPDATE); + prod_inl_op, + prod_inr_op, + prod_inl_updateP, + prod_inr_updateP, + prod_inl_update, + prod_inr_update); for (size_t i = 0; i < vector_size(source_theorems); ++i) { ENSURE_COND(!IS_NULL(source_theorems[i]), diff --git a/theory/logic/prod_ra.h b/theory/logic/prod_ra.h index 3d2d300..b646601 100644 --- a/theory/logic/prod_ra.h +++ b/theory/logic/prod_ra.h @@ -1,33 +1,74 @@ #pragma once -/* Binary product resource algebra and its canonical component embeddings. */ +/* + * Public interface for binary product resource algebras. + * + * `prod_ra R S : (A#B)ra` combines, validates, and updates both coordinates + * pointwise. `prod_inl` and `prod_inr` embed one coordinate while fixing the + * other coordinate at its unit; they are the canonical way to address one + * component of a larger global ghost RA. + */ #include "proof/theory/logic/local_update.h" -PROOF extern thm PROD_RA_UNIT; -PROOF extern thm PROD_RA_OP; -PROOF extern thm PROD_RA_VALID; -PROOF extern thm PROD_RA_INCLUDED; -PROOF extern thm PROD_RA_CANCELLATIVE_IFF; -PROOF extern thm PROD_RA_EXCLUSIVE_IFF; +/* ------------------------------------------------------------------------- */ +/* Pointwise algebra */ +/* ------------------------------------------------------------------------- */ -/* Componentwise predicate update. */ -PROOF extern thm PROD_RA_UPDATEP; +/* `ra_unit (prod_ra R S) == (ra_unit R,ra_unit S)`. */ +PROOF extern thm prod_ra_unit; -/* Deterministic one-coordinate updates. */ -PROOF extern thm PROD_RA_UPDATE_LEFT; -PROOF extern thm PROD_RA_UPDATE_RIGHT; +/* + * `ra_op (prod_ra R S) x y == + * (ra_op R (FST x) (FST y),ra_op S (SND x) (SND y))`. + */ +PROOF extern thm prod_ra_op; -/* Componentwise five-argument local update. */ -PROOF extern thm PROD_RA_LOCAL_UPDATE; +/* Product validity is exactly componentwise validity. */ +PROOF extern thm prod_ra_valid; -/* `prod_inl R S a == (a,ra_unit S)` and its right-hand dual. */ +/* Product inclusion is exactly componentwise inclusion. */ +PROOF extern thm prod_ra_included; + +/* Product cancellativity/exclusivity hold exactly componentwise. */ +PROOF extern thm prod_ra_cancellative_iff; +PROOF extern thm prod_ra_exclusive_iff; + +/* ------------------------------------------------------------------------- */ +/* Componentwise updates */ +/* ------------------------------------------------------------------------- */ + +/* + * Combine two predicate updates, exposing only exact result pairs selected by + * the two component predicates. + */ +PROOF extern thm prod_ra_updateP; + +/* Lift a deterministic update in one coordinate and preserve the other. */ +PROOF extern thm prod_ra_update_left; +PROOF extern thm prod_ra_update_right; + +/* Lift two five-argument local updates componentwise. */ +PROOF extern thm prod_ra_local_update; + +/* ------------------------------------------------------------------------- */ +/* Canonical component embeddings */ +/* ------------------------------------------------------------------------- */ + +/* `prod_inl R S a == (a,ra_unit S)`. */ PROOF extern thm prod_inl_def; + +/* `prod_inr R S b == (ra_unit R,b)`. */ PROOF extern thm prod_inr_def; -PROOF extern thm PROD_INL_OP; -PROOF extern thm PROD_INR_OP; -PROOF extern thm PROD_INL_UPDATEP; -PROOF extern thm PROD_INR_UPDATEP; -PROOF extern thm PROD_INL_UPDATE; -PROOF extern thm PROD_INR_UPDATE; +/* Each embedding preserves the RA operation. */ +PROOF extern thm prod_inl_op; +PROOF extern thm prod_inr_op; + +/* Lift predicate updates to the exact image of the corresponding embedding. */ +PROOF extern thm prod_inl_updateP; +PROOF extern thm prod_inr_updateP; + +/* Lift deterministic updates through the corresponding embedding. */ +PROOF extern thm prod_inl_update; +PROOF extern thm prod_inr_update; diff --git a/theory/logic/prod_ra_internal.h b/theory/logic/prod_ra_internal.h index 34cc77d..5b888d5 100644 --- a/theory/logic/prod_ra_internal.h +++ b/theory/logic/prod_ra_internal.h @@ -1,8 +1,16 @@ #pragma once -/* Private product-RA rules used while implementing dependent constructors. */ +/* + * INTERNAL product-RA proof rules for dependent constructor implementations. + * Ordinary clients use `prod_ra.h`; this header must not be re-exported. + */ #include "proof/theory/logic/prod_ra.h" -/* One-way constructor rule used by `auth_ra.c`; clients use the public iff. */ -PROOF extern thm PROD_RA_CANCELLATIVE; +/* + * One-way constructor rule: + * `ra_cancellative R ==> ra_cancellative S ==> + * ra_cancellative (prod_ra R S)`. + * Public clients use `prod_ra_cancellative_iff`. + */ +PROOF extern thm prod_ra_cancellative; diff --git a/theory/logic/product_resource.c b/theory/logic/product_resource.c index 3ab2154..3fdceb6 100644 --- a/theory/logic/product_resource.c +++ b/theory/logic/product_resource.c @@ -23,11 +23,11 @@ PROOF static thm prove_r_equiv_of_eq(void) { lifted, ispecl_rule( TERM_LIST(`R:(A)ra`, `P:A->bool`), - R_EQUIV_REFL))); + r_equiv_refl))); return gnode_prove(root); } -PROOF static thm R_EQUIV_OF_EQ_PRODUCT = +PROOF static thm r_equiv_of_eq_product = prove_r_equiv_of_eq(); PROOF thm r_lift_left_def = new_fun_definition(` @@ -91,7 +91,7 @@ PROOF static thm prove_r_lift_left_emp_eq(void) { pure_rewrite_conv(THM_LIST( r_lift_left_def, r_emp_def, - PROD_RA_UNIT))); + prod_ra_unit))); thm pair_components = ispecl_rule( TERM_LIST( `FST (resource:A#B)`, @@ -113,7 +113,7 @@ PROOF static thm prove_r_lift_left_emp_eq(void) { return gnode_prove(root); } -PROOF thm R_LIFT_LEFT_EMP_EQ = +PROOF thm r_lift_left_emp_eq = prove_r_lift_left_emp_eq(); PROOF static thm prove_r_lift_right_emp_eq(void) { @@ -136,7 +136,7 @@ PROOF static thm prove_r_lift_right_emp_eq(void) { pure_rewrite_conv(THM_LIST( r_lift_right_def, r_emp_def, - PROD_RA_UNIT))); + prod_ra_unit))); thm pair_components = ispecl_rule( TERM_LIST( `FST (resource:A#B)`, @@ -158,7 +158,7 @@ PROOF static thm prove_r_lift_right_emp_eq(void) { return gnode_prove(root); } -PROOF thm R_LIFT_RIGHT_EMP_EQ = +PROOF thm r_lift_right_emp_eq = prove_r_lift_right_emp_eq(); PROOF static thm prove_r_lift_left_emp(void) { @@ -178,14 +178,14 @@ PROOF static thm prove_r_lift_left_emp(void) { `prod_ra (R:(A)ra) (S:(B)ra)`, `r_lift_left (R:(A)ra) (S:(B)ra) (r_emp R)`, `r_emp (prod_ra (R:(A)ra) (S:(B)ra))`), - R_EQUIV_OF_EQ_PRODUCT), + r_equiv_of_eq_product), ispecl_rule( TERM_LIST(`R:(A)ra`, `S:(B)ra`), - R_LIFT_LEFT_EMP_EQ))); + r_lift_left_emp_eq))); return gnode_prove(root); } -PROOF thm R_LIFT_LEFT_EMP = +PROOF thm r_lift_left_emp = prove_r_lift_left_emp(); PROOF static thm prove_r_lift_right_emp(void) { @@ -205,14 +205,14 @@ PROOF static thm prove_r_lift_right_emp(void) { `prod_ra (R:(A)ra) (S:(B)ra)`, `r_lift_right (R:(A)ra) (S:(B)ra) (r_emp S)`, `r_emp (prod_ra (R:(A)ra) (S:(B)ra))`), - R_EQUIV_OF_EQ_PRODUCT), + r_equiv_of_eq_product), ispecl_rule( TERM_LIST(`R:(A)ra`, `S:(B)ra`), - R_LIFT_RIGHT_EMP_EQ))); + r_lift_right_emp_eq))); return gnode_prove(root); } -PROOF thm R_LIFT_RIGHT_EMP = +PROOF thm r_lift_right_emp = prove_r_lift_right_emp(); PROOF static thm prove_r_lift_left_entails(void) { @@ -237,7 +237,7 @@ PROOF static thm prove_r_lift_left_entails(void) { thm components = eq_mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `S:(B)ra`, `resource:A#B`), - PROD_RA_VALID), + prod_ra_valid), assume_rule(` ra_valid (prod_ra (R:(A)ra) (S:(B)ra)) @@ -270,7 +270,7 @@ PROOF static thm prove_r_lift_left_entails(void) { return gnode_prove(root); } -PROOF thm R_LIFT_LEFT_ENTAILS = +PROOF thm r_lift_left_entails = prove_r_lift_left_entails(); PROOF static thm prove_r_lift_right_entails(void) { @@ -295,7 +295,7 @@ PROOF static thm prove_r_lift_right_entails(void) { thm components = eq_mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `S:(B)ra`, `resource:A#B`), - PROD_RA_VALID), + prod_ra_valid), assume_rule(` ra_valid (prod_ra (R:(A)ra) (S:(B)ra)) @@ -328,7 +328,7 @@ PROOF static thm prove_r_lift_right_entails(void) { return gnode_prove(root); } -PROOF thm R_LIFT_RIGHT_ENTAILS = +PROOF thm r_lift_right_entails = prove_r_lift_right_entails(); PROOF static thm prove_r_lift_left_sep_eq(void) { @@ -403,12 +403,12 @@ PROOF static thm prove_r_lift_left_sep_eq(void) { `R:(A)ra`, `S:(B)ra`, `((component_left:A),(ra_unit (S:(B)ra)))`, `((component_right:A),(ra_unit (S:(B)ra)))`), - PROD_RA_OP); + prod_ra_op); combined_op = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), get_theorem_by_name("SND"), - RA_UNIT_L), + ra_unit_l), combined_op); ACCEPT_TAC( forward1[0], @@ -452,7 +452,7 @@ PROOF static thm prove_r_lift_left_sep_eq(void) { (left:A#B) (right:A#B) `)); fst_split = pure_rewrite_rule( - THM_LIST(PROD_RA_OP, get_theorem_by_name("FST")), + THM_LIST(prod_ra_op, get_theorem_by_name("FST")), fst_split); ACCEPT_TAC(component_parts[0], fst_split); gnode_list component_preds = CONJ_TAC(component_parts[1]); @@ -468,17 +468,17 @@ PROOF static thm prove_r_lift_left_sep_eq(void) { `)); snd_split = pure_rewrite_rule( THM_LIST( - PROD_RA_OP, + prod_ra_op, get_theorem_by_name("SND"), assume_rule(`SND (left:A#B) == ra_unit (S:(B)ra)`), assume_rule(`SND (right:A#B) == ra_unit (S:(B)ra)`), - RA_UNIT_L), + ra_unit_l), snd_split); ACCEPT_TAC(reverse_parts[1], snd_split); return gnode_prove(root); } -PROOF thm R_LIFT_LEFT_SEP_EQ = +PROOF thm r_lift_left_sep_eq = prove_r_lift_left_sep_eq(); PROOF static thm prove_r_lift_right_sep_eq(void) { @@ -553,12 +553,12 @@ PROOF static thm prove_r_lift_right_sep_eq(void) { `R:(A)ra`, `S:(B)ra`, `((ra_unit (R:(A)ra)),(component_left:B))`, `((ra_unit (R:(A)ra)),(component_right:B))`), - PROD_RA_OP); + prod_ra_op); combined_op = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), get_theorem_by_name("SND"), - RA_UNIT_L), + ra_unit_l), combined_op); ACCEPT_TAC( forward1[0], @@ -600,11 +600,11 @@ PROOF static thm prove_r_lift_right_sep_eq(void) { `)); fst_split = pure_rewrite_rule( THM_LIST( - PROD_RA_OP, + prod_ra_op, get_theorem_by_name("FST"), assume_rule(`FST (left:A#B) == ra_unit (R:(A)ra)`), assume_rule(`FST (right:A#B) == ra_unit (R:(A)ra)`), - RA_UNIT_L), + ra_unit_l), fst_split); ACCEPT_TAC(reverse_parts[0], fst_split); gnode component_sep = EXISTS_TAC(reverse_parts[1], `SND (left:A#B)`); @@ -619,7 +619,7 @@ PROOF static thm prove_r_lift_right_sep_eq(void) { (left:A#B) (right:A#B) `)); snd_split = pure_rewrite_rule( - THM_LIST(PROD_RA_OP, get_theorem_by_name("SND")), + THM_LIST(prod_ra_op, get_theorem_by_name("SND")), snd_split); ACCEPT_TAC(component_parts[0], snd_split); gnode_list component_preds = CONJ_TAC(component_parts[1]); @@ -628,7 +628,7 @@ PROOF static thm prove_r_lift_right_sep_eq(void) { return gnode_prove(root); } -PROOF thm R_LIFT_RIGHT_SEP_EQ = +PROOF thm r_lift_right_sep_eq = prove_r_lift_right_sep_eq(); PROOF static thm prove_r_lift_left_sep(void) { @@ -653,14 +653,14 @@ PROOF static thm prove_r_lift_left_sep(void) { `r_sep (prod_ra (R:(A)ra) (S:(B)ra)) (r_lift_left R S (P:A->bool)) (r_lift_left R S (Q:A->bool))`), - R_EQUIV_OF_EQ_PRODUCT), + r_equiv_of_eq_product), ispecl_rule( TERM_LIST(`R:(A)ra`, `S:(B)ra`, `P:A->bool`, `Q:A->bool`), - R_LIFT_LEFT_SEP_EQ))); + r_lift_left_sep_eq))); return gnode_prove(root); } -PROOF thm R_LIFT_LEFT_SEP = +PROOF thm r_lift_left_sep = prove_r_lift_left_sep(); PROOF static thm prove_r_lift_right_sep(void) { @@ -685,14 +685,14 @@ PROOF static thm prove_r_lift_right_sep(void) { `r_sep (prod_ra (R:(A)ra) (S:(B)ra)) (r_lift_right R S (P:B->bool)) (r_lift_right R S (Q:B->bool))`), - R_EQUIV_OF_EQ_PRODUCT), + r_equiv_of_eq_product), ispecl_rule( TERM_LIST(`R:(A)ra`, `S:(B)ra`, `P:B->bool`, `Q:B->bool`), - R_LIFT_RIGHT_SEP_EQ))); + r_lift_right_sep_eq))); return gnode_prove(root); } -PROOF thm R_LIFT_RIGHT_SEP = +PROOF thm r_lift_right_sep = prove_r_lift_right_sep(); PROOF static thm prove_r_bupd_right_intro(void) { @@ -731,7 +731,7 @@ PROOF static thm prove_r_bupd_right_intro(void) { return gnode_prove(root); } -PROOF thm R_BUPD_RIGHT_INTRO = +PROOF thm r_bupd_right_intro = prove_r_bupd_right_intro(); PROOF static thm prove_r_bupd_right_mono(void) { @@ -795,14 +795,14 @@ PROOF static thm prove_r_bupd_right_mono(void) { thm owned_components = eq_mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `S:(B)ra`, `owned:A#B`), - PROD_RA_VALID), + prod_ra_valid), assume_rule(` ra_valid (prod_ra (R:(A)ra) (S:(B)ra)) (owned:A#B) `)); thm selected_valid = conjunct1_rule(mp_rule( ispecl_rule( TERM_LIST(`S:(B)ra`, `selected:B`, `frame:B`), - RA_VALID_OP), + ra_valid_op), assume_rule(` ra_valid (S:(B)ra) @@ -813,7 +813,7 @@ PROOF static thm prove_r_bupd_right_mono(void) { `R:(A)ra`, `S:(B)ra`, `((FST (owned:A#B)),(selected:B))`), - PROD_RA_VALID); + prod_ra_valid); selected_pair_rule = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -851,7 +851,7 @@ PROOF static thm prove_r_bupd_right_mono(void) { return gnode_prove(root); } -PROOF thm R_BUPD_RIGHT_MONO = +PROOF thm r_bupd_right_mono = prove_r_bupd_right_mono(); PROOF static thm prove_r_bupd_right_idem(void) { @@ -892,7 +892,7 @@ PROOF static thm prove_r_bupd_right_idem(void) { `SND (owned:A#B)`, middle_post, post), - RA_UPDATEP_TRANS); + ra_updateP_trans); term_list outer_terms = gnode_get_asmps( body, CONST_STRING_LIST("Houter_update")); @@ -915,7 +915,7 @@ PROOF static thm prove_r_bupd_right_idem(void) { return gnode_prove(root); } -PROOF thm R_BUPD_RIGHT_IDEM = +PROOF thm r_bupd_right_idem = prove_r_bupd_right_idem(); PROOF static thm prove_r_bupd_right_frame(void) { @@ -973,7 +973,7 @@ PROOF static thm prove_r_bupd_right_frame(void) { `)); snd_split = pure_rewrite_rule( THM_LIST( - PROD_RA_OP, + prod_ra_op, get_theorem_by_name("SND")), snd_split); thm split_with_hidden = beta_rule(ap_term_rule( @@ -995,7 +995,7 @@ PROOF static thm prove_r_bupd_right_frame(void) { `SND (updated:A#B)`, `SND (explicit_frame:A#B)`, `hidden:B`), - RA_ASSOC); + ra_assoc); thm source_assoc_validity = ap_term_rule( `ra_valid (S:(B)ra):B->bool`, source_assoc); @@ -1057,7 +1057,7 @@ PROOF static thm prove_r_bupd_right_frame(void) { `)); fst_split = pure_rewrite_rule( THM_LIST( - PROD_RA_OP, + prod_ra_op, get_theorem_by_name("FST")), fst_split); thm pair_rule = ispecl_rule( @@ -1083,7 +1083,7 @@ PROOF static thm prove_r_bupd_right_frame(void) { `S:(B)ra`, `((FST (updated:A#B)),(selected:B))`, `explicit_frame:A#B`), - PROD_RA_OP); + prod_ra_op); combined_op = pure_rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -1108,7 +1108,7 @@ PROOF static thm prove_r_bupd_right_frame(void) { `selected:B`, `SND (explicit_frame:A#B)`, `hidden:B`), - RA_ASSOC); + ra_assoc); thm result_assoc_validity = ap_term_rule( `ra_valid (S:(B)ra):B->bool`, gsym_rule(result_assoc)); @@ -1130,7 +1130,7 @@ PROOF static thm prove_r_bupd_right_frame(void) { return gnode_prove(root); } -PROOF thm R_BUPD_RIGHT_FRAME = +PROOF thm r_bupd_right_frame = prove_r_bupd_right_frame(); PROOF static thm prove_r_viewshift_right_refl(void) { @@ -1152,11 +1152,11 @@ PROOF static thm prove_r_viewshift_right_refl(void) { `R:(A)ra`, `S:(B)ra`, `P:(A#B)->bool`), - R_BUPD_RIGHT_INTRO)); + r_bupd_right_intro)); return gnode_prove(root); } -PROOF thm R_VIEWSHIFT_RIGHT_REFL = +PROOF thm r_viewshift_right_refl = prove_r_viewshift_right_refl(); PROOF static thm prove_r_viewshift_right_entails(void) { @@ -1181,7 +1181,7 @@ PROOF static thm prove_r_viewshift_right_entails(void) { `P:(A#B)->bool`, `Q:(A#B)->bool`, `r_bupd_right R S (Q:(A#B)->bool)`), - R_ENTAILS_TRANS), + r_entails_trans), assume_rule(` r_entails (prod_ra (R:(A)ra) (S:(B)ra)) @@ -1193,12 +1193,12 @@ PROOF static thm prove_r_viewshift_right_entails(void) { `R:(A)ra`, `S:(B)ra`, `Q:(A#B)->bool`), - R_BUPD_RIGHT_INTRO)); + r_bupd_right_intro)); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm R_VIEWSHIFT_RIGHT_ENTAILS = +PROOF thm r_viewshift_right_entails = prove_r_viewshift_right_entails(); PROOF static thm prove_r_viewshift_right_trans(void) { @@ -1224,7 +1224,7 @@ PROOF static thm prove_r_viewshift_right_trans(void) { `S:(B)ra`, `Q:(A#B)->bool`, `r_bupd_right R S (U:(A#B)->bool)`), - R_BUPD_RIGHT_MONO), + r_bupd_right_mono), assume_rule(` r_entails (prod_ra (R:(A)ra) (S:(B)ra)) @@ -1240,11 +1240,11 @@ PROOF static thm prove_r_viewshift_right_trans(void) { `r_bupd_right R S (r_bupd_right R S (U:(A#B)->bool))`, `r_bupd_right R S (U:(A#B)->bool)`), - R_ENTAILS_TRANS), + r_entails_trans), lifted_second), ispecl_rule( TERM_LIST(`R:(A)ra`, `S:(B)ra`, `U:(A#B)->bool`), - R_BUPD_RIGHT_IDEM)); + r_bupd_right_idem)); ACCEPT_TAC( body, mp_rule( @@ -1255,7 +1255,7 @@ PROOF static thm prove_r_viewshift_right_trans(void) { `P:(A#B)->bool`, `r_bupd_right R S (Q:(A#B)->bool)`, `r_bupd_right R S (U:(A#B)->bool)`), - R_ENTAILS_TRANS), + r_entails_trans), assume_rule(` r_entails (prod_ra (R:(A)ra) (S:(B)ra)) @@ -1266,7 +1266,7 @@ PROOF static thm prove_r_viewshift_right_trans(void) { return gnode_prove(root); } -PROOF thm R_VIEWSHIFT_RIGHT_TRANS = +PROOF thm r_viewshift_right_trans = prove_r_viewshift_right_trans(); PROOF static thm prove_r_viewshift_right_frame(void) { @@ -1294,7 +1294,7 @@ PROOF static thm prove_r_viewshift_right_frame(void) { `P:(A#B)->bool`, `r_bupd_right R S (Q:(A#B)->bool)`, `Frame:(A#B)->bool`), - R_SEP_FRAME_L), + r_sep_frame_l), assume_rule(` r_entails (prod_ra (R:(A)ra) (S:(B)ra)) @@ -1318,7 +1318,7 @@ PROOF static thm prove_r_viewshift_right_frame(void) { (r_sep (prod_ra R S) (Q:(A#B)->bool) (Frame:(A#B)->bool))`), - R_ENTAILS_TRANS), + r_entails_trans), explicit_frame), ispecl_rule( TERM_LIST( @@ -1326,11 +1326,11 @@ PROOF static thm prove_r_viewshift_right_frame(void) { `S:(B)ra`, `Q:(A#B)->bool`, `Frame:(A#B)->bool`), - R_BUPD_RIGHT_FRAME))); + r_bupd_right_frame))); return gnode_prove(root); } -PROOF thm R_VIEWSHIFT_RIGHT_FRAME = +PROOF thm r_viewshift_right_frame = prove_r_viewshift_right_frame(); PROOF static thm prove_r_viewshift_right_mono(void) { @@ -1356,7 +1356,7 @@ PROOF static thm prove_r_viewshift_right_mono(void) { TERM_LIST( `R:(A)ra`, `S:(B)ra`, `Q:(A#B)->bool`, `Q2:(A#B)->bool`), - R_BUPD_RIGHT_MONO), + r_bupd_right_mono), assume_rule(` r_entails (prod_ra (R:(A)ra) (S:(B)ra)) @@ -1371,7 +1371,7 @@ PROOF static thm prove_r_viewshift_right_mono(void) { `P:(A#B)->bool`, `r_bupd_right R S (Q:(A#B)->bool)`, `r_bupd_right R S (Q2:(A#B)->bool)`), - R_ENTAILS_TRANS), + r_entails_trans), assume_rule(` r_entails (prod_ra (R:(A)ra) (S:(B)ra)) @@ -1389,7 +1389,7 @@ PROOF static thm prove_r_viewshift_right_mono(void) { `P2:(A#B)->bool`, `P:(A#B)->bool`, `r_bupd_right R S (Q2:(A#B)->bool)`), - R_ENTAILS_TRANS), + r_entails_trans), assume_rule(` r_entails (prod_ra (R:(A)ra) (S:(B)ra)) @@ -1400,7 +1400,7 @@ PROOF static thm prove_r_viewshift_right_mono(void) { return gnode_prove(root); } -PROOF thm R_VIEWSHIFT_RIGHT_MONO = +PROOF thm r_viewshift_right_mono = prove_r_viewshift_right_mono(); PROOF static thm prove_r_viewshift_right_sep(void) { @@ -1426,7 +1426,7 @@ PROOF static thm prove_r_viewshift_right_sep(void) { `R:(A)ra`, `S:(B)ra`, `P1:(A#B)->bool`, `Q1:(A#B)->bool`, `P2:(A#B)->bool`), - R_VIEWSHIFT_RIGHT_FRAME), + r_viewshift_right_frame), assume_rule(` r_viewshift_right (R:(A)ra) (S:(B)ra) @@ -1438,7 +1438,7 @@ PROOF static thm prove_r_viewshift_right_sep(void) { `R:(A)ra`, `S:(B)ra`, `P2:(A#B)->bool`, `Q2:(A#B)->bool`, `Q1:(A#B)->bool`), - R_VIEWSHIFT_RIGHT_FRAME), + r_viewshift_right_frame), assume_rule(` r_viewshift_right (R:(A)ra) (S:(B)ra) @@ -1451,7 +1451,7 @@ PROOF static thm prove_r_viewshift_right_sep(void) { `prod_ra (R:(A)ra) (S:(B)ra)`, `Q1:(A#B)->bool`, `P2:(A#B)->bool`), - R_SEP_COMM))); + r_sep_comm))); thm target_commute = conjunct1_rule(rewrite_rule( THM_LIST(r_equiv_def), ispecl_rule( @@ -1459,7 +1459,7 @@ PROOF static thm prove_r_viewshift_right_sep(void) { `prod_ra (R:(A)ra) (S:(B)ra)`, `Q2:(A#B)->bool`, `Q1:(A#B)->bool`), - R_SEP_COMM))); + r_sep_comm))); thm second_aligned = mp_rule( mp_rule( mp_rule( @@ -1475,7 +1475,7 @@ PROOF static thm prove_r_viewshift_right_sep(void) { `r_sep (prod_ra R S) (Q1:(A#B)->bool) (Q2:(A#B)->bool)`), /* Consequence follows by unfolding the right view shift. */ - R_VIEWSHIFT_RIGHT_MONO), + r_viewshift_right_mono), source_commute), second_framed), target_commute); @@ -1492,13 +1492,13 @@ PROOF static thm prove_r_viewshift_right_sep(void) { (Q1:(A#B)->bool) (P2:(A#B)->bool)`, `r_sep (prod_ra R S) (Q1:(A#B)->bool) (Q2:(A#B)->bool)`), - R_VIEWSHIFT_RIGHT_TRANS), + r_viewshift_right_trans), first_framed), second_aligned)); return gnode_prove(root); } -PROOF thm R_VIEWSHIFT_RIGHT_SEP = +PROOF thm r_viewshift_right_sep = prove_r_viewshift_right_sep(); PROOF static thm prove_r_viewshift_right_fact(void) { @@ -1543,7 +1543,7 @@ PROOF static thm prove_r_viewshift_right_fact(void) { (prod_ra R S) (r_fact (prod_ra R S) (guard:bool)) (Q:(A#B)->bool))`), - R_FACT_ELIM)); + r_fact_elim)); body = DISCH_TAC(body, "Hguard"); term_list conditional_terms = gnode_get_asmps( @@ -1564,13 +1564,13 @@ PROOF static thm prove_r_viewshift_right_fact(void) { `guard:bool`, `Q:(A#B)->bool`, `Q:(A#B)->bool`), - R_FACT_INTRO), + r_fact_intro), assume_rule(`guard:bool`)), ispecl_rule( TERM_LIST( `prod_ra (R:(A)ra) (S:(B)ra)`, `Q:(A#B)->bool`), - R_ENTAILS_REFL)); + r_entails_refl)); thm lifted_post = mp_rule( ispecl_rule( TERM_LIST( @@ -1581,7 +1581,7 @@ PROOF static thm prove_r_viewshift_right_fact(void) { (prod_ra R S) (r_fact (prod_ra R S) (guard:bool)) (Q:(A#B)->bool)`), - R_BUPD_RIGHT_MONO), + r_bupd_right_mono), post_inclusion); ACCEPT_TAC( body, @@ -1600,13 +1600,13 @@ PROOF static thm prove_r_viewshift_right_fact(void) { (prod_ra R S) (guard:bool)) (Q:(A#B)->bool))`), - R_ENTAILS_TRANS), + r_entails_trans), change), lifted_post)); return gnode_prove(root); } -PROOF thm R_VIEWSHIFT_RIGHT_FACT = +PROOF thm r_viewshift_right_fact = prove_r_viewshift_right_fact(); PROOF static thm prove_r_viewshift_right_exists_l(void) { @@ -1633,7 +1633,7 @@ PROOF static thm prove_r_viewshift_right_exists_l(void) { `prod_ra (R:(A)ra) (S:(B)ra)`, `P:C->(A#B)->bool`, `r_bupd_right R S (Q:(A#B)->bool)`), - R_EXISTS_ELIM), + r_exists_elim), assume_rule(` forall witness:C. r_entails @@ -1645,7 +1645,7 @@ PROOF static thm prove_r_viewshift_right_exists_l(void) { return gnode_prove(root); } -PROOF static thm R_VIEWSHIFT_RIGHT_EXISTS_L = +PROOF static thm r_viewshift_right_exists_l = prove_r_viewshift_right_exists_l(); PROOF static thm prove_r_viewshift_right_exists_r(void) { @@ -1670,7 +1670,7 @@ PROOF static thm prove_r_viewshift_right_exists_r(void) { `prod_ra (R:(A)ra) (S:(B)ra)`, `Q:C->(A#B)->bool`, `witness:C`), - R_EXISTS_INTRO); + r_exists_intro); thm lifted_post = mp_rule( ispecl_rule( TERM_LIST( @@ -1680,7 +1680,7 @@ PROOF static thm prove_r_viewshift_right_exists_r(void) { `r_exists (prod_ra R S) (\bound:C. (Q:C->(A#B)->bool) bound)`), - R_BUPD_RIGHT_MONO), + r_bupd_right_mono), post_inclusion); thm result = mp_rule( mp_rule( @@ -1696,7 +1696,7 @@ PROOF static thm prove_r_viewshift_right_exists_r(void) { (r_exists (prod_ra R S) (\bound:C. (Q:C->(A#B)->bool) bound))`), - R_ENTAILS_TRANS), + r_entails_trans), assume_rule(` r_entails (prod_ra (R:(A)ra) (S:(B)ra)) @@ -1710,7 +1710,7 @@ PROOF static thm prove_r_viewshift_right_exists_r(void) { return gnode_prove(root); } -PROOF static thm R_VIEWSHIFT_RIGHT_EXISTS_R = +PROOF static thm r_viewshift_right_exists_r = prove_r_viewshift_right_exists_r(); PROOF static thm prove_r_viewshift_right_exists(void) { @@ -1742,7 +1742,7 @@ PROOF static thm prove_r_viewshift_right_exists(void) { `r_exists (prod_ra R S) (\bound:C. (Q:C->(A#B)->bool) bound)`), - R_VIEWSHIFT_RIGHT_EXISTS_L)); + r_viewshift_right_exists_l)); body = GEN_TAC(body, "witness"); thm selected = spec_rule( `witness:C`, @@ -1761,13 +1761,13 @@ PROOF static thm prove_r_viewshift_right_exists(void) { `(P:C->(A#B)->bool) (witness:C)`, `Q:C->(A#B)->bool`, `witness:C`), - R_VIEWSHIFT_RIGHT_EXISTS_R), + r_viewshift_right_exists_r), selected); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm R_VIEWSHIFT_RIGHT_EXISTS = +PROOF thm r_viewshift_right_exists = prove_r_viewshift_right_exists(); PROOF static thm prove_r_right_own_update(void) { @@ -1873,10 +1873,10 @@ PROOF static thm prove_r_right_own_update(void) { return gnode_prove(root); } -PROOF thm R_RIGHT_OWN_UPDATE = +PROOF thm r_right_own_update = prove_r_right_own_update(); -PROOF static thm prove_r_right_own_updatep(void) { +PROOF static thm prove_r_right_own_updateP(void) { gnode root = gnode_new_with_ccl(` forall (R:(A)ra) @@ -1994,7 +1994,7 @@ PROOF static thm prove_r_right_own_updatep(void) { TERM_LIST( `prod_ra (R:(A)ra) (S:(B)ra)`, `((ra_unit (R:(A)ra)),(selected:B))`), - RA_UNIT_L)))); + ra_unit_l)))); gnode_list post2 = CONJ_TAC(post1[1]); gnode_list fact_parts = CONJ_TAC(post2[0]); ACCEPT_TAC( @@ -2018,39 +2018,39 @@ PROOF static thm prove_r_right_own_updatep(void) { return gnode_prove(root); } -PROOF thm R_RIGHT_OWN_UPDATEP = - prove_r_right_own_updatep(); +PROOF thm r_right_own_updateP = + prove_r_right_own_updateP(); PROOF static int audit_product_resource(void) { thm_list exported_theorems = THM_LIST( r_lift_left_def, r_lift_right_def, - R_LIFT_LEFT_EMP, - R_LIFT_RIGHT_EMP, - R_LIFT_LEFT_SEP, - R_LIFT_RIGHT_SEP, - R_LIFT_LEFT_ENTAILS, - R_LIFT_RIGHT_ENTAILS, + r_lift_left_emp, + r_lift_right_emp, + r_lift_left_sep, + r_lift_right_sep, + r_lift_left_entails, + r_lift_right_entails, r_bupd_right_def, r_viewshift_right_def, - R_BUPD_RIGHT_INTRO, - R_BUPD_RIGHT_MONO, - R_BUPD_RIGHT_IDEM, - R_BUPD_RIGHT_FRAME, - R_VIEWSHIFT_RIGHT_REFL, - R_VIEWSHIFT_RIGHT_ENTAILS, - R_VIEWSHIFT_RIGHT_TRANS, - R_VIEWSHIFT_RIGHT_MONO, - R_VIEWSHIFT_RIGHT_FRAME, - R_VIEWSHIFT_RIGHT_SEP, - R_VIEWSHIFT_RIGHT_FACT, - R_VIEWSHIFT_RIGHT_EXISTS, - R_RIGHT_OWN_UPDATE, - R_RIGHT_OWN_UPDATEP, - R_LIFT_LEFT_EMP_EQ, - R_LIFT_RIGHT_EMP_EQ, - R_LIFT_LEFT_SEP_EQ, - R_LIFT_RIGHT_SEP_EQ); + r_bupd_right_intro, + r_bupd_right_mono, + r_bupd_right_idem, + r_bupd_right_frame, + r_viewshift_right_refl, + r_viewshift_right_entails, + r_viewshift_right_trans, + r_viewshift_right_mono, + r_viewshift_right_frame, + r_viewshift_right_sep, + r_viewshift_right_fact, + r_viewshift_right_exists, + r_right_own_update, + r_right_own_updateP, + r_lift_left_emp_eq, + r_lift_right_emp_eq, + r_lift_left_sep_eq, + r_lift_right_sep_eq); for (size_t i = 0; i < vector_size(exported_theorems); ++i) { ENSURE_COND( !IS_NULL(exported_theorems[i]), diff --git a/theory/logic/product_resource.h b/theory/logic/product_resource.h index cf56c6f..e7c28d4 100644 --- a/theory/logic/product_resource.h +++ b/theory/logic/product_resource.h @@ -1,6 +1,25 @@ -#pragma once +/** + * @file product_resource.h + * @brief Exact assertion lifts and right-only updates for product resources. + * + * An exact left lift requires the right projection to be `ra_unit S`; an + * exact right lift symmetrically requires the left projection to be + * `ra_unit R`. Their public separating-monoid laws use `r_equiv`; raw + * function equalities are confined to `product_resource_internal.h`. + * + * The restricted update is defined by + * + * ```text + * r_bupd_right R S Q (left,right) <=> + * ra_updateP S right (\right'. Q (left,right')). + * ``` + * + * Thus the left projection is definitionally unchanged while only the right + * RA participates in the frame-preserving update. Frames may still contain + * resources in both projections and are preserved by the laws below. + */ -/* Exact assertion lifts and right-only updates for product resources. */ +#pragma once #include "proof/theory/logic/prod_ra.h" #include "proof/theory/logic/resource_prop.h" @@ -8,30 +27,34 @@ PROOF extern thm r_lift_left_def; PROOF extern thm r_lift_right_def; -PROOF extern thm R_LIFT_LEFT_EMP; -PROOF extern thm R_LIFT_RIGHT_EMP; -PROOF extern thm R_LIFT_LEFT_SEP; -PROOF extern thm R_LIFT_RIGHT_SEP; -PROOF extern thm R_LIFT_LEFT_ENTAILS; -PROOF extern thm R_LIFT_RIGHT_ENTAILS; +/* Exact-lift separating-monoid and entailment laws. */ +PROOF extern thm r_lift_left_emp; +PROOF extern thm r_lift_right_emp; +PROOF extern thm r_lift_left_sep; +PROOF extern thm r_lift_right_sep; +PROOF extern thm r_lift_left_entails; +PROOF extern thm r_lift_right_entails; -/* Only the right component may change. */ +/* Right-only basic update and view shift. */ PROOF extern thm r_bupd_right_def; PROOF extern thm r_viewshift_right_def; -PROOF extern thm R_BUPD_RIGHT_INTRO; -PROOF extern thm R_BUPD_RIGHT_MONO; -PROOF extern thm R_BUPD_RIGHT_IDEM; -PROOF extern thm R_BUPD_RIGHT_FRAME; - -PROOF extern thm R_VIEWSHIFT_RIGHT_REFL; -PROOF extern thm R_VIEWSHIFT_RIGHT_ENTAILS; -PROOF extern thm R_VIEWSHIFT_RIGHT_TRANS; -PROOF extern thm R_VIEWSHIFT_RIGHT_MONO; -PROOF extern thm R_VIEWSHIFT_RIGHT_FRAME; -PROOF extern thm R_VIEWSHIFT_RIGHT_SEP; -PROOF extern thm R_VIEWSHIFT_RIGHT_FACT; -PROOF extern thm R_VIEWSHIFT_RIGHT_EXISTS; - -PROOF extern thm R_RIGHT_OWN_UPDATE; -PROOF extern thm R_RIGHT_OWN_UPDATEP; +/* Right-only basic-update modality laws. */ +PROOF extern thm r_bupd_right_intro; +PROOF extern thm r_bupd_right_mono; +PROOF extern thm r_bupd_right_idem; +PROOF extern thm r_bupd_right_frame; + +/* Right-only view-shift laws, including exact-fact and existential lifting. */ +PROOF extern thm r_viewshift_right_refl; +PROOF extern thm r_viewshift_right_entails; +PROOF extern thm r_viewshift_right_trans; +PROOF extern thm r_viewshift_right_mono; +PROOF extern thm r_viewshift_right_frame; +PROOF extern thm r_viewshift_right_sep; +PROOF extern thm r_viewshift_right_fact; +PROOF extern thm r_viewshift_right_exists; + +/* Ownership rules for deterministic and predicate updates of the right RA. */ +PROOF extern thm r_right_own_update; +PROOF extern thm r_right_own_updateP; diff --git a/theory/logic/product_resource_internal.h b/theory/logic/product_resource_internal.h index 2235b47..270e98b 100644 --- a/theory/logic/product_resource_internal.h +++ b/theory/logic/product_resource_internal.h @@ -1,14 +1,17 @@ -#pragma once - -/* - * Raw assertion-function equalities used by implementation adapters. +/** + * @file product_resource_internal.h + * @brief Raw exact-lift equalities for implementations and adapters. + * * The public product-resource interface exposes the corresponding laws only - * through validity-sensitive `r_equiv` theorems. + * through validity-sensitive `r_equiv`. This header is intentionally not a + * stable client surface and must not be re-exported by umbrella headers. */ +#pragma once + #include "proof/theory/logic/product_resource.h" -PROOF extern thm R_LIFT_LEFT_EMP_EQ; -PROOF extern thm R_LIFT_RIGHT_EMP_EQ; -PROOF extern thm R_LIFT_LEFT_SEP_EQ; -PROOF extern thm R_LIFT_RIGHT_SEP_EQ; +PROOF extern thm r_lift_left_emp_eq; +PROOF extern thm r_lift_right_emp_eq; +PROOF extern thm r_lift_left_sep_eq; +PROOF extern thm r_lift_right_sep_eq; diff --git a/theory/logic/ra.c b/theory/logic/ra.c index b8fddeb..501abfa 100644 --- a/theory/logic/ra.c +++ b/theory/logic/ra.c @@ -89,7 +89,7 @@ PROOF static thm prove_ra_witness_absorb_nonunit(void) { return gnode_prove(root); } -PROOF static thm RA_WITNESS_ABSORB_NONUNIT = +PROOF static thm ra_witness_absorb_nonunit = prove_ra_witness_absorb_nonunit(); PROOF static thm prove_ra_witness_assoc(void) { @@ -103,7 +103,7 @@ PROOF static thm prove_ra_witness_assoc(void) { gnode_list a_cases = BOOL_CASES_TAC(body, `(a:A) == (ARB:A)`, "Ha"); thm absorb_nonunit_from_a = mp_rule( - spec_rule(`a:A`, RA_WITNESS_ABSORB_NONUNIT), + spec_rule(`a:A`, ra_witness_absorb_nonunit), assume_rule(`~((a:A) == (ARB:A))`)); for (size_t i = 0; i < vector_size(a_cases); ++i) { @@ -132,7 +132,7 @@ PROOF static thm prove_ra_witness_assoc(void) { return gnode_prove(root); } -PROOF static thm RA_WITNESS_ASSOC = prove_ra_witness_assoc(); +PROOF static thm ra_witness_assoc = prove_ra_witness_assoc(); PROOF static thm prove_ra_witness_comm(void) { term goal_tm = ` @@ -153,13 +153,13 @@ PROOF static thm prove_ra_witness_comm(void) { rewrite_conv, THM_LIST( ra_witness_op_def, - RA_WITNESS_ABSORB_NONUNIT)); + ra_witness_absorb_nonunit)); } } return gnode_prove(root); } -PROOF static thm RA_WITNESS_COMM = prove_ra_witness_comm(); +PROOF static thm ra_witness_comm = prove_ra_witness_comm(); PROOF static thm prove_ra_witness_unit(void) { term goal_tm = ` @@ -171,7 +171,7 @@ PROOF static thm prove_ra_witness_unit(void) { return gnode_prove(root); } -PROOF static thm RA_WITNESS_UNIT = prove_ra_witness_unit(); +PROOF static thm ra_witness_unit = prove_ra_witness_unit(); PROOF static thm prove_ra_witness_laws(void) { term goal_tm = ` @@ -182,13 +182,13 @@ PROOF static thm prove_ra_witness_laws(void) { root, rewrite_conv(THM_LIST( ra_laws_def, - RA_WITNESS_ASSOC, - RA_WITNESS_COMM, - RA_WITNESS_UNIT))); + ra_witness_assoc, + ra_witness_comm, + ra_witness_unit))); return gnode_prove(root); } -PROOF static thm RA_WITNESS_LAWS = prove_ra_witness_laws(); +PROOF static thm ra_witness_laws = prove_ra_witness_laws(); PROOF static thm prove_ra_rep_exists(void) { term descriptor = ` @@ -212,11 +212,11 @@ PROOF static thm prove_ra_rep_exists(void) { get_theorem_by_name("FST"), get_theorem_by_name("SND"))), witness_body); - thm witness_laws = eq_mp_rule(sym_rule(projected), RA_WITNESS_LAWS); + thm witness_laws = eq_mp_rule(sym_rule(projected), ra_witness_laws); return exists_rule(existence, descriptor, witness_laws); } -PROOF static thm RA_REP_EXISTS = prove_ra_rep_exists(); +PROOF static thm ra_rep_exists = prove_ra_rep_exists(); /* * This call creates the genuine unary type constructor `(A)ra`. @@ -224,8 +224,8 @@ PROOF static thm RA_REP_EXISTS = prove_ra_rep_exists(); * The representation predicate is exactly: * ra_laws (FST d) (FST (SND d)) (SND (SND d)). */ -PROOF thm RA_TYPE_BIJECTION = new_type_bijection_definition( - "ra", "ra_abs", "ra_rep", RA_REP_EXISTS); +PROOF thm ra_type_bijection = new_type_bijection_definition( + "ra", "ra_abs", "ra_rep", ra_rep_exists); /* Public projections from the abstract descriptor. */ PROOF static thm ra_unit_def = new_fun_definition(` @@ -309,11 +309,11 @@ PROOF static thm prove_ra_rep_laws(void) { `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); - CONV_TAC(body, rewrite_conv(THM_LIST(RA_TYPE_BIJECTION))); + CONV_TAC(body, rewrite_conv(THM_LIST(ra_type_bijection))); return gnode_prove(root); } -PROOF thm RA_REP_LAWS = prove_ra_rep_laws(); +PROOF thm ra_rep_laws = prove_ra_rep_laws(); PROOF static thm prove_ra_laws(void) { term goal_tm = ` @@ -323,11 +323,11 @@ PROOF static thm prove_ra_laws(void) { gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); CONV_TAC(body, rewrite_conv(THM_LIST( - ra_unit_def, ra_op_def, ra_valid_def, RA_REP_LAWS))); + ra_unit_def, ra_op_def, ra_valid_def, ra_rep_laws))); return gnode_prove(root); } -PROOF thm RA_LAWS = prove_ra_laws(); +PROOF thm ra_laws = prove_ra_laws(); /* * Stable projections of the intrinsic laws. Downstream RA constructors use @@ -336,7 +336,7 @@ PROOF thm RA_LAWS = prove_ra_laws(); PROOF static thm expanded_ra_laws(const term R) { return rewrite_rule( THM_LIST(ra_laws_def), - spec_rule(R, RA_LAWS)); + spec_rule(R, ra_laws)); } PROOF static thm prove_ra_assoc(void) { @@ -344,7 +344,7 @@ PROOF static thm prove_ra_assoc(void) { return gen_rule(R, conjunct1_rule(expanded_ra_laws(R))); } -PROOF thm RA_ASSOC = prove_ra_assoc(); +PROOF thm ra_assoc = prove_ra_assoc(); PROOF static thm prove_ra_comm(void) { term R = `R:(A)ra`; @@ -352,7 +352,7 @@ PROOF static thm prove_ra_comm(void) { return gen_rule(R, conjunct1_rule(law_tail)); } -PROOF thm RA_COMM = prove_ra_comm(); +PROOF thm ra_comm = prove_ra_comm(); /* * A compact AC-normalization rule for the common case where the leftmost @@ -365,15 +365,15 @@ PROOF static thm prove_ra_op_swap_right(void) { term c = `c:A`; thm associated_left = ispecl_rule( TERM_LIST(R, a, b, c), - RA_ASSOC); + ra_assoc); thm commute_inner = beta_rule(ap_term_rule( `\x:A. ra_op (R:(A)ra) (a:A) x`, ispecl_rule( TERM_LIST(R, b, c), - RA_COMM))); + ra_comm))); thm associated_right = gsym_rule(ispecl_rule( TERM_LIST(R, a, c, b), - RA_ASSOC)); + ra_assoc)); thm result = trans_rule( associated_left, trans_rule(commute_inner, associated_right)); @@ -383,7 +383,7 @@ PROOF static thm prove_ra_op_swap_right(void) { return gen_rule(R, result); } -PROOF thm RA_OP_SWAP_RIGHT = +PROOF thm ra_op_swap_right = prove_ra_op_swap_right(); PROOF static thm prove_ra_unit_l(void) { @@ -393,23 +393,23 @@ PROOF static thm prove_ra_unit_l(void) { return gen_rule(R, conjunct1_rule(law_tail)); } -PROOF thm RA_UNIT_L = prove_ra_unit_l(); +PROOF thm ra_unit_l = prove_ra_unit_l(); PROOF static thm prove_ra_unit_r(void) { term R = `R:(A)ra`; term a = `a:A`; thm commuted = ispecl_rule( TERM_LIST(R, a, `ra_unit (R:(A)ra)`), - RA_COMM); + ra_comm); thm reduced = ispecl_rule( TERM_LIST(R, a), - RA_UNIT_L); + ra_unit_l); thm result = trans_rule(commuted, reduced); result = gen_rule(a, result); return gen_rule(R, result); } -PROOF thm RA_UNIT_R = +PROOF thm ra_unit_r = prove_ra_unit_r(); PROOF static thm prove_ra_valid_unit(void) { @@ -420,7 +420,7 @@ PROOF static thm prove_ra_valid_unit(void) { return gen_rule(R, conjunct1_rule(law_tail)); } -PROOF thm RA_VALID_UNIT = prove_ra_valid_unit(); +PROOF thm ra_valid_unit = prove_ra_valid_unit(); PROOF static thm prove_ra_valid_op_l(void) { term R = `R:(A)ra`; @@ -430,7 +430,7 @@ PROOF static thm prove_ra_valid_op_l(void) { return gen_rule(R, conjunct2_rule(law_tail)); } -PROOF thm RA_VALID_OP_L = prove_ra_valid_op_l(); +PROOF thm ra_valid_op_l = prove_ra_valid_op_l(); PROOF static thm prove_ra_valid_op_r(void) { term goal_tm = ` @@ -446,7 +446,7 @@ PROOF static thm prove_ra_valid_op_r(void) { `R:(A)ra`, `a:A`, `b:A`), - RA_COMM)), + ra_comm)), assume_rule(` ra_valid (R:(A)ra) @@ -458,13 +458,13 @@ PROOF static thm prove_ra_valid_op_r(void) { `R:(A)ra`, `b:A`, `a:A`), - RA_VALID_OP_L), + ra_valid_op_l), commuted_valid); ACCEPT_TAC(body, right_valid); return gnode_prove(root); } -PROOF thm RA_VALID_OP_R = +PROOF thm ra_valid_op_r = prove_ra_valid_op_r(); /* @@ -483,12 +483,12 @@ PROOF static thm prove_ra_valid_op(void) { thm left_valid = mp_rule( ispecl_rule( TERM_LIST(R, a, b), - RA_VALID_OP_L), + ra_valid_op_l), pair_assumption); thm right_valid = mp_rule( ispecl_rule( TERM_LIST(R, a, b), - RA_VALID_OP_R), + ra_valid_op_r), pair_assumption); thm result = disch_rule( valid_pair, @@ -498,7 +498,7 @@ PROOF static thm prove_ra_valid_op(void) { return gen_rule(R, result); } -PROOF thm RA_VALID_OP = +PROOF thm ra_valid_op = prove_ra_valid_op(); PROOF static thm prove_ra_compat_comm(void) { @@ -512,11 +512,11 @@ PROOF static thm prove_ra_compat_comm(void) { body, rewrite_conv(THM_LIST( ra_compatible_def, - RA_COMM))); + ra_comm))); return gnode_prove(root); } -PROOF thm RA_COMPAT_COMM = prove_ra_compat_comm(); +PROOF thm ra_compat_comm = prove_ra_compat_comm(); PROOF static thm prove_ra_compat_unit(void) { term goal_tm = ` @@ -529,11 +529,11 @@ PROOF static thm prove_ra_compat_unit(void) { body, rewrite_conv(THM_LIST( ra_compatible_def, - RA_UNIT_R))); + ra_unit_r))); return gnode_prove(root); } -PROOF thm RA_COMPAT_UNIT = prove_ra_compat_unit(); +PROOF thm ra_compat_unit = prove_ra_compat_unit(); /* * Apply the optional cancellativity property without exposing its quantified @@ -572,7 +572,7 @@ PROOF static thm prove_ra_cancellative_apply(void) { return gnode_prove(root); } -PROOF thm RA_CANCELLATIVE_APPLY = +PROOF thm ra_cancellative_apply = prove_ra_cancellative_apply(); /* Direct eliminators keep goal-directed proofs from unfolding quantified @@ -601,7 +601,7 @@ PROOF static thm prove_ra_exclusive_apply(void) { return gnode_prove(root); } -PROOF thm RA_EXCLUSIVE_APPLY = +PROOF thm ra_exclusive_apply = prove_ra_exclusive_apply(); PROOF static thm prove_ra_update_apply(void) { @@ -644,7 +644,7 @@ PROOF static thm prove_ra_update_apply(void) { return gnode_prove(root); } -PROOF thm RA_UPDATE_APPLY = +PROOF thm ra_update_apply = prove_ra_update_apply(); PROOF static thm prove_ra_updateP_apply(void) { @@ -670,7 +670,7 @@ PROOF static thm prove_ra_updateP_apply(void) { return gnode_prove(root); } -PROOF thm RA_UPDATEP_APPLY = +PROOF thm ra_updateP_apply = prove_ra_updateP_apply(); /* @@ -691,11 +691,11 @@ PROOF static thm prove_ra_included_refl(void) { body, gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), - RA_UNIT_R))); + ra_unit_r))); return gnode_prove(root); } -PROOF thm RA_INCLUDED_REFL = +PROOF thm ra_included_refl = prove_ra_included_refl(); /* @@ -716,11 +716,11 @@ PROOF static thm prove_ra_included_unit(void) { body, gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), - RA_UNIT_L))); + ra_unit_l))); return gnode_prove(root); } -PROOF thm RA_INCLUDED_UNIT = +PROOF thm ra_included_unit = prove_ra_included_unit(); PROOF static thm prove_ra_included_op_l(void) { @@ -738,7 +738,7 @@ PROOF static thm prove_ra_included_op_l(void) { return gnode_prove(root); } -PROOF thm RA_INCLUDED_OP_L = +PROOF thm ra_included_op_l = prove_ra_included_op_l(); /* @@ -760,11 +760,11 @@ PROOF static thm prove_ra_included_op_r(void) { body, ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`, `b:A`), - RA_COMM)); + ra_comm)); return gnode_prove(root); } -PROOF thm RA_INCLUDED_OP_R = +PROOF thm ra_included_op_r = prove_ra_included_op_r(); PROOF static thm prove_ra_included_trans(void) { @@ -810,14 +810,14 @@ PROOF static thm prove_ra_included_trans(void) { `a:A`, `frame_ab:A`, `frame_bc:A`), - RA_ASSOC); + ra_assoc); CONV_TAC( b_substituted, rewrite_conv(THM_LIST(assoc))); return gnode_prove(root); } -PROOF thm RA_INCLUDED_TRANS = +PROOF thm ra_included_trans = prove_ra_included_trans(); /* @@ -858,14 +858,14 @@ PROOF static thm prove_ra_included_op_mono_l(void) { `a1:A`, `extension:A`, `b:A`), - RA_OP_SWAP_RIGHT); + ra_op_swap_right); ACCEPT_TAC( body, trans_rule(lifted_witness, swapped_extension)); return gnode_prove(root); } -PROOF thm RA_INCLUDED_OP_MONO_L = +PROOF thm ra_included_op_mono_l = prove_ra_included_op_mono_l(); /* Right monotonicity is left monotonicity transported through commutativity. */ @@ -884,7 +884,7 @@ PROOF static thm prove_ra_included_op_mono_r(void) { `a1:A`, `a2:A`, `b:A`), - RA_INCLUDED_OP_MONO_L), + ra_included_op_mono_l), assume_rule(`ra_included (R:(A)ra) (a1:A) (a2:A)`)); thm commute_source = beta_rule(ap_term_rule( `\x:A. @@ -894,7 +894,7 @@ PROOF static thm prove_ra_included_op_mono_r(void) { (ra_op R (a2:A) (b:A))`, ispecl_rule( TERM_LIST(`R:(A)ra`, `a1:A`, `b:A`), - RA_COMM))); + ra_comm))); thm commute_target = beta_rule(ap_term_rule( `\x:A. ra_included @@ -903,7 +903,7 @@ PROOF static thm prove_ra_included_op_mono_r(void) { x`, ispecl_rule( TERM_LIST(`R:(A)ra`, `a2:A`, `b:A`), - RA_COMM))); + ra_comm))); thm normalized = eq_mp_rule( trans_rule(commute_source, commute_target), monotone_left); @@ -911,7 +911,7 @@ PROOF static thm prove_ra_included_op_mono_r(void) { return gnode_prove(root); } -PROOF thm RA_INCLUDED_OP_MONO_R = +PROOF thm ra_included_op_mono_r = prove_ra_included_op_mono_r(); /* Monotonicity in both operands is the transitive closure of the two sides. */ @@ -936,7 +936,7 @@ PROOF static thm prove_ra_included_op_mono(void) { `a1:A`, `a2:A`, `b1:A`), - RA_INCLUDED_OP_MONO_L), + ra_included_op_mono_l), assume_rule(`ra_included (R:(A)ra) (a1:A) (a2:A)`)); thm right_step = mp_rule( ispecl_rule( @@ -945,7 +945,7 @@ PROOF static thm prove_ra_included_op_mono(void) { `b1:A`, `b2:A`, `a2:A`), - RA_INCLUDED_OP_MONO_R), + ra_included_op_mono_r), assume_rule(`ra_included (R:(A)ra) (b1:A) (b2:A)`)); thm result = ispecl_rule( TERM_LIST( @@ -953,14 +953,14 @@ PROOF static thm prove_ra_included_op_mono(void) { `ra_op (R:(A)ra) (a1:A) (b1:A)`, `ra_op (R:(A)ra) (a2:A) (b1:A)`, `ra_op (R:(A)ra) (a2:A) (b2:A)`), - RA_INCLUDED_TRANS); + ra_included_trans); result = mp_rule(result, left_step); result = mp_rule(result, right_step); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm RA_INCLUDED_OP_MONO = +PROOF thm ra_included_op_mono = prove_ra_included_op_mono(); PROOF static thm prove_ra_included_valid(void) { @@ -993,13 +993,13 @@ PROOF static thm prove_ra_included_valid(void) { `R:(A)ra`, `a:A`, `frame:A`), - RA_VALID_OP_L), + ra_valid_op_l), valid_extension); ACCEPT_TAC(body, valid_left); return gnode_prove(root); } -PROOF thm RA_INCLUDED_VALID = +PROOF thm ra_included_valid = prove_ra_included_valid(); /* @@ -1022,14 +1022,14 @@ PROOF static thm prove_ra_included_valid_frame(void) { `a:A`, `b:A`, `frame:A`), - RA_INCLUDED_OP_MONO_L), + ra_included_op_mono_l), assume_rule(`ra_included (R:(A)ra) (a:A) (b:A)`)); thm result = ispecl_rule( TERM_LIST( `R:(A)ra`, `ra_op (R:(A)ra) (a:A) (frame:A)`, `ra_op (R:(A)ra) (b:A) (frame:A)`), - RA_INCLUDED_VALID); + ra_included_valid); result = mp_rule(result, framed_inclusion); result = mp_rule( result, @@ -1042,7 +1042,7 @@ PROOF static thm prove_ra_included_valid_frame(void) { return gnode_prove(root); } -PROOF thm RA_INCLUDED_VALID_FRAME = +PROOF thm ra_included_valid_frame = prove_ra_included_valid_frame(); /* Unpack the inclusion witness, reassociate it behind the common prefix, @@ -1078,7 +1078,7 @@ PROOF static thm prove_ra_included_cancel_l(void) { "extension"); thm framed_eq = rewrite_rule( - THM_LIST(RA_ASSOC), + THM_LIST(ra_assoc), assume_rule(` ra_op (R:(A)ra) (common:A) (b:A) == ra_op R (ra_op R common (a:A)) (extension:A) @@ -1092,7 +1092,7 @@ PROOF static thm prove_ra_included_cancel_l(void) { `common:A`, `b:A`, `ra_op (R:(A)ra) (a:A) (extension:A)`), - RA_CANCELLATIVE_APPLY), + ra_cancellative_apply), assume_rule(`ra_cancellative (R:(A)ra)`)), assume_rule(` ra_valid @@ -1109,7 +1109,7 @@ PROOF static thm prove_ra_included_cancel_l(void) { return gnode_prove(root); } -PROOF thm RA_INCLUDED_CANCEL_L = +PROOF thm ra_included_cancel_l = prove_ra_included_cancel_l(); /* @@ -1165,12 +1165,12 @@ PROOF static thm prove_ra_exclusive_included(void) { replace_frame, ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), - RA_UNIT_R))); + ra_unit_r))); ACCEPT_TAC(body, gsym_rule(extension_is_a)); return gnode_prove(root); } -PROOF thm RA_EXCLUSIVE_INCLUDED = +PROOF thm ra_exclusive_included = prove_ra_exclusive_included(); /* For an exclusive source, compatibility is exactly ordinary source @@ -1198,11 +1198,11 @@ PROOF static thm prove_ra_exclusive_valid_op_iff(void) { mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`, `frame:A`), - RA_VALID_OP_L), + ra_valid_op_l), compatible)); thm frame_is_unit = ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`, `frame:A`), - RA_EXCLUSIVE_APPLY); + ra_exclusive_apply); frame_is_unit = mp_rule( frame_is_unit, assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); @@ -1221,7 +1221,7 @@ PROOF static thm prove_ra_exclusive_valid_op_iff(void) { assume_rule(`(frame:A) == ra_unit (R:(A)ra)`))), ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), - RA_UNIT_R)); + ra_unit_r)); thm valid_eq = ap_term_rule(`ra_valid (R:(A)ra)`, framed_eq); ACCEPT_TAC( reverse, @@ -1231,7 +1231,7 @@ PROOF static thm prove_ra_exclusive_valid_op_iff(void) { return gnode_prove(root); } -PROOF thm RA_EXCLUSIVE_VALID_OP_IFF = +PROOF thm ra_exclusive_valid_op_iff = prove_ra_exclusive_valid_op_iff(); /* Deterministic update is definitionally the singleton specialization. */ @@ -1245,7 +1245,7 @@ PROOF static thm prove_ra_updateP_singleton(void) { return gen_rule(R, result); } -PROOF thm RA_UPDATEP_SINGLETON = prove_ra_updateP_singleton(); +PROOF thm ra_updateP_singleton = prove_ra_updateP_singleton(); /* Internal first-order view of the singleton update. */ PROOF static thm prove_ra_update_direct(void) { @@ -1319,7 +1319,7 @@ PROOF static thm prove_ra_update_direct(void) { return gnode_prove(root); } -PROOF static thm RA_UPDATE_DIRECT = prove_ra_update_direct(); +PROOF static thm ra_update_direct = prove_ra_update_direct(); /* * Nondeterministic update is reflexive. Select the source itself and retain @@ -1349,7 +1349,7 @@ PROOF static thm prove_ra_updateP_refl(void) { return gnode_prove(root); } -PROOF thm RA_UPDATEP_REFL = +PROOF thm ra_updateP_refl = prove_ra_updateP_refl(); /* @@ -1372,7 +1372,7 @@ PROOF static thm prove_ra_updateP_trans(void) { thm intermediate = ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`, `P:A->bool`, `frame:A`), - RA_UPDATEP_APPLY); + ra_updateP_apply); intermediate = mp_rule( intermediate, assume_rule(`ra_updateP (R:(A)ra) (a:A) (P:A->bool)`)); @@ -1397,7 +1397,7 @@ PROOF static thm prove_ra_updateP_trans(void) { assume_rule(`(P:A->bool) (middle:A)`)); thm result = ispecl_rule( TERM_LIST(`R:(A)ra`, `middle:A`, `Q:A->bool`, `frame:A`), - RA_UPDATEP_APPLY); + ra_updateP_apply); result = mp_rule(result, middle_update); result = mp_rule( result, @@ -1408,7 +1408,7 @@ PROOF static thm prove_ra_updateP_trans(void) { return gnode_prove(root); } -PROOF thm RA_UPDATEP_TRANS = prove_ra_updateP_trans(); +PROOF thm ra_updateP_trans = prove_ra_updateP_trans(); /* * Enlarging the allowed result set preserves a predicate update. @@ -1462,7 +1462,7 @@ PROOF static thm prove_ra_updateP_mono(void) { return gnode_prove(root); } -PROOF thm RA_UPDATEP_MONO = +PROOF thm ra_updateP_mono = prove_ra_updateP_mono(); /* @@ -1486,7 +1486,7 @@ PROOF static thm prove_ra_updateP_of_update(void) { `R:(A)ra`, `a:A`, `b:A`), - RA_UPDATEP_SINGLETON)), + ra_updateP_singleton)), assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); term singleton_pred = `\x:A. x == (b:A)`; thm weakened = ispecl_rule( @@ -1495,7 +1495,7 @@ PROOF static thm prove_ra_updateP_of_update(void) { `a:A`, singleton_pred, `P:A->bool`), - RA_UPDATEP_MONO); + ra_updateP_mono); weakened = mp_rule(weakened, singleton); weakened = conv_rule( depth_conv(get_conversion_by_name("BETA_CONV")), @@ -1514,7 +1514,7 @@ PROOF static thm prove_ra_updateP_of_update(void) { return gnode_prove(root); } -PROOF thm RA_UPDATEP_OF_UPDATE = +PROOF thm ra_updateP_of_update = prove_ra_updateP_of_update(); /* @@ -1534,7 +1534,7 @@ PROOF static thm prove_ra_updateP_valid(void) { thm source_unit_eq = gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), - RA_UNIT_R)); + ra_unit_r)); thm source_valid_eq = ap_term_rule( `ra_valid (R:(A)ra)`, source_unit_eq); @@ -1547,7 +1547,7 @@ PROOF static thm prove_ra_updateP_valid(void) { `a:A`, `P:A->bool`, `ra_unit (R:(A)ra)`), - RA_UPDATEP_APPLY); + ra_updateP_apply); selected = mp_rule( selected, assume_rule(`ra_updateP (R:(A)ra) (a:A) (P:A->bool)`)); @@ -1567,7 +1567,7 @@ PROOF static thm prove_ra_updateP_valid(void) { thm selected_unit_eq = ispecl_rule( TERM_LIST(`R:(A)ra`, `selected:A`), - RA_UNIT_R); + ra_unit_r); thm selected_valid_eq = ap_term_rule( `ra_valid (R:(A)ra)`, selected_unit_eq); @@ -1582,7 +1582,7 @@ PROOF static thm prove_ra_updateP_valid(void) { return gnode_prove(root); } -PROOF thm RA_UPDATEP_VALID = +PROOF thm ra_updateP_valid = prove_ra_updateP_valid(); /* @@ -1599,7 +1599,7 @@ PROOF static thm prove_ra_exclusive_update(void) { gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - once_rewrite_conv(THM_LIST(RA_UPDATE_DIRECT))); + once_rewrite_conv(THM_LIST(ra_update_direct))); body = GEN_TAC(body, "R"); body = GEN_TAC(body, "a"); body = GEN_TAC(body, "b"); @@ -1610,7 +1610,7 @@ PROOF static thm prove_ra_exclusive_update(void) { thm frame_is_unit = ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`, `frame:A`), - RA_EXCLUSIVE_APPLY); + ra_exclusive_apply); frame_is_unit = mp_rule( frame_is_unit, assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); @@ -1625,7 +1625,7 @@ PROOF static thm prove_ra_exclusive_update(void) { `ra_valid (R:(A)ra)`, gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `b:A`), - RA_UNIT_R))); + ra_unit_r))); thm target_with_unit = eq_mp_rule( target_unit_eq, assume_rule(`ra_valid (R:(A)ra) (b:A)`)); @@ -1642,7 +1642,7 @@ PROOF static thm prove_ra_exclusive_update(void) { return gnode_prove(root); } -PROOF thm RA_EXCLUSIVE_UPDATE = +PROOF thm ra_exclusive_update = prove_ra_exclusive_update(); PROOF static thm prove_ra_update_refl(void) { @@ -1652,7 +1652,7 @@ PROOF static thm prove_ra_update_refl(void) { gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - once_rewrite_conv(THM_LIST(RA_UPDATE_DIRECT))); + once_rewrite_conv(THM_LIST(ra_update_direct))); body = AUTO_INTROS_TAC(body); ACCEPT_TAC( body, @@ -1662,12 +1662,12 @@ PROOF static thm prove_ra_update_refl(void) { return gnode_prove(root); } -PROOF thm RA_UPDATE_REFL = prove_ra_update_refl(); +PROOF thm ra_update_refl = prove_ra_update_refl(); /* * A larger resource may always update to one of its included parts: every * frame compatible with the larger source is compatible with the smaller - * target by RA_INCLUDED_VALID_FRAME. + * target by ra_included_valid_frame. */ PROOF static thm prove_ra_update_included(void) { term goal_tm = ` @@ -1678,7 +1678,7 @@ PROOF static thm prove_ra_update_included(void) { gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - once_rewrite_conv(THM_LIST(RA_UPDATE_DIRECT))); + once_rewrite_conv(THM_LIST(ra_update_direct))); body = AUTO_INTROS_TAC(body); thm result = ispecl_rule( TERM_LIST( @@ -1686,7 +1686,7 @@ PROOF static thm prove_ra_update_included(void) { `b:A`, `a:A`, `frame:A`), - RA_INCLUDED_VALID_FRAME); + ra_included_valid_frame); result = mp_rule( result, assume_rule(`ra_included (R:(A)ra) (b:A) (a:A)`)); @@ -1701,26 +1701,26 @@ PROOF static thm prove_ra_update_included(void) { return gnode_prove(root); } -PROOF thm RA_UPDATE_INCLUDED = +PROOF thm ra_update_included = prove_ra_update_included(); -/* The unit update is the unit-inclusion instance of RA_UPDATE_INCLUDED. */ +/* The unit update is the unit-inclusion instance of ra_update_included. */ PROOF static thm prove_ra_update_unit(void) { term R = `R:(A)ra`; term a = `a:A`; thm result = ispecl_rule( TERM_LIST(R, a, `ra_unit (R:(A)ra)`), - RA_UPDATE_INCLUDED); + ra_update_included); result = mp_rule( result, ispecl_rule( TERM_LIST(R, a), - RA_INCLUDED_UNIT)); + ra_included_unit)); result = gen_rule(a, result); return gen_rule(R, result); } -PROOF thm RA_UPDATE_UNIT = +PROOF thm ra_update_unit = prove_ra_update_unit(); PROOF static thm prove_ra_update_trans(void) { @@ -1734,12 +1734,12 @@ PROOF static thm prove_ra_update_trans(void) { gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(RA_UPDATE_DIRECT))); + once_rewrite_conv(THM_LIST(ra_update_direct))); body = AUTO_INTROS_TAC(body); thm b_valid = ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`, `b:A`, `frame:A`), - RA_UPDATE_APPLY); + ra_update_apply); b_valid = mp_rule( b_valid, assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); @@ -1750,7 +1750,7 @@ PROOF static thm prove_ra_update_trans(void) { `)); thm c_valid = ispecl_rule( TERM_LIST(`R:(A)ra`, `b:A`, `c:A`, `frame:A`), - RA_UPDATE_APPLY); + ra_update_apply); c_valid = mp_rule( c_valid, assume_rule(`ra_update (R:(A)ra) (b:A) (c:A)`)); @@ -1759,7 +1759,7 @@ PROOF static thm prove_ra_update_trans(void) { return gnode_prove(root); } -PROOF thm RA_UPDATE_TRANS = prove_ra_update_trans(); +PROOF thm ra_update_trans = prove_ra_update_trans(); /* Weaken the selected target by composing the original update with the * generic discard-to-an-included-part update. */ @@ -1775,11 +1775,11 @@ PROOF static thm prove_ra_update_target_included(void) { thm discard = mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `b:A`, `c:A`), - RA_UPDATE_INCLUDED), + ra_update_included), assume_rule(`ra_included (R:(A)ra) (c:A) (b:A)`)); thm result = ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`, `b:A`, `c:A`), - RA_UPDATE_TRANS); + ra_update_trans); result = mp_rule( result, assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); @@ -1788,7 +1788,7 @@ PROOF static thm prove_ra_update_target_included(void) { return gnode_prove(root); } -PROOF thm RA_UPDATE_TARGET_INCLUDED = +PROOF thm ra_update_target_included = prove_ra_update_target_included(); /* @@ -1807,7 +1807,7 @@ PROOF static thm prove_ra_update_valid(void) { thm source_unit_eq = gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), - RA_UNIT_R)); + ra_unit_r)); thm source_valid_eq = ap_term_rule( `ra_valid (R:(A)ra)`, source_unit_eq); @@ -1820,14 +1820,14 @@ PROOF static thm prove_ra_update_valid(void) { `a:A`, `b:A`, `ra_unit (R:(A)ra)`), - RA_UPDATE_APPLY); + ra_update_apply); result_with_unit = mp_rule( result_with_unit, assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); result_with_unit = mp_rule(result_with_unit, source_with_unit); thm result_unit_eq = ispecl_rule( TERM_LIST(`R:(A)ra`, `b:A`), - RA_UNIT_R); + ra_unit_r); thm result_valid_eq = ap_term_rule( `ra_valid (R:(A)ra)`, result_unit_eq); @@ -1838,7 +1838,7 @@ PROOF static thm prove_ra_update_valid(void) { return gnode_prove(root); } -PROOF thm RA_UPDATE_VALID = +PROOF thm ra_update_valid = prove_ra_update_valid(); /* @@ -1854,7 +1854,7 @@ PROOF static thm prove_ra_update_frame(void) { gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - pure_rewrite_conv(THM_LIST(RA_UPDATE_DIRECT))); + pure_rewrite_conv(THM_LIST(ra_update_direct))); body = AUTO_INTROS_TAC(body); thm source_assoc = specl_rule( @@ -1863,7 +1863,7 @@ PROOF static thm prove_ra_update_frame(void) { `a:A`, `extra:A`, `frame:A`), - RA_ASSOC); + ra_assoc); thm normalized_source = rewrite_rule( THM_LIST(source_assoc), assume_rule(` @@ -1887,7 +1887,7 @@ PROOF static thm prove_ra_update_frame(void) { `b:A`, `extra:A`, `frame:A`), - RA_ASSOC); + ra_assoc); thm framed_result = rewrite_rule( THM_LIST(gsym_rule(result_assoc)), normalized_result); @@ -1895,7 +1895,7 @@ PROOF static thm prove_ra_update_frame(void) { return gnode_prove(root); } -PROOF thm RA_UPDATE_FRAME = prove_ra_update_frame(); +PROOF thm ra_update_frame = prove_ra_update_frame(); /* * Update the two operands independently. Frame the first update by c, frame @@ -1915,22 +1915,22 @@ PROOF static thm prove_ra_update_op(void) { thm first_step = mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`, `b:A`, `c:A`), - RA_UPDATE_FRAME), + ra_update_frame), assume_rule(`ra_update (R:(A)ra) (a:A) (b:A)`)); thm second_step = mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `c:A`, `d:A`, `b:A`), - RA_UPDATE_FRAME), + ra_update_frame), assume_rule(`ra_update (R:(A)ra) (c:A) (d:A)`)); second_step = rewrite_rule( THM_LIST( ispecl_rule( TERM_LIST(`R:(A)ra`, `c:A`, `b:A`), - RA_COMM), + ra_comm), ispecl_rule( TERM_LIST(`R:(A)ra`, `d:A`, `b:A`), - RA_COMM)), + ra_comm)), second_step); thm result = ispecl_rule( @@ -1939,14 +1939,14 @@ PROOF static thm prove_ra_update_op(void) { `ra_op (R:(A)ra) (a:A) (c:A)`, `ra_op (R:(A)ra) (b:A) (c:A)`, `ra_op (R:(A)ra) (b:A) (d:A)`), - RA_UPDATE_TRANS); + ra_update_trans); result = mp_rule(result, first_step); result = mp_rule(result, second_step); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm RA_UPDATE_OP = +PROOF thm ra_update_op = prove_ra_update_op(); PROOF static thm prove_ra_updateP_frame(void) { @@ -1975,7 +1975,7 @@ PROOF static thm prove_ra_updateP_frame(void) { `a:A`, `extra:A`, `frame:A`), - RA_ASSOC); + ra_assoc); thm normalized_source = rewrite_rule( THM_LIST(source_assoc), assume_rule(` @@ -2030,7 +2030,7 @@ PROOF static thm prove_ra_updateP_frame(void) { `b:A`, `extra:A`, `frame:A`), - RA_ASSOC); + ra_assoc); thm framed_valid = rewrite_rule( THM_LIST(gsym_rule(result_assoc)), assume_rule(` @@ -2044,7 +2044,7 @@ PROOF static thm prove_ra_updateP_frame(void) { return gnode_prove(root); } -PROOF thm RA_UPDATEP_FRAME = +PROOF thm ra_updateP_frame = prove_ra_updateP_frame(); /* @@ -2095,7 +2095,7 @@ PROOF static thm prove_ra_updateP_op(void) { `a:A`, `c:A`, `frame:A`), - RA_ASSOC); + ra_assoc); thm source_for_a = rewrite_rule( THM_LIST(source_assoc), assume_rule(` @@ -2132,19 +2132,19 @@ PROOF static thm prove_ra_updateP_op(void) { `b:A`, `c:A`, `frame:A`), - RA_ASSOC)); + ra_assoc)); thm commute_bc = beta_rule(ap_term_rule( `\x:A. ra_op (R:(A)ra) x (frame:A)`, ispecl_rule( TERM_LIST(`R:(A)ra`, `b:A`, `c:A`), - RA_COMM))); + ra_comm))); thm expose_c = ispecl_rule( TERM_LIST( `R:(A)ra`, `c:A`, `b:A`, `frame:A`), - RA_ASSOC); + ra_assoc); thm c_source_eq = trans_rule( regroup_bc, trans_rule(commute_bc, expose_c)); @@ -2202,12 +2202,12 @@ PROOF static thm prove_ra_updateP_op(void) { `d:A`, `b:A`, `frame:A`), - RA_ASSOC)); + ra_assoc)); thm commute_db = beta_rule(ap_term_rule( `\x:A. ra_op (R:(A)ra) x (frame:A)`, ispecl_rule( TERM_LIST(`R:(A)ra`, `d:A`, `b:A`), - RA_COMM))); + ra_comm))); thm result_eq = trans_rule(regroup_db, commute_db); thm result_valid = eq_mp_rule( ap_term_rule(`ra_valid (R:(A)ra)`, result_eq), @@ -2222,7 +2222,7 @@ PROOF static thm prove_ra_updateP_op(void) { return gnode_prove(root); } -PROOF thm RA_UPDATEP_OP = +PROOF thm ra_updateP_op = prove_ra_updateP_op(); /* @@ -2240,7 +2240,7 @@ PROOF static thm prove_ra_abs_rep(void) { thm inverse = spec_rule( descriptor, - conjunct2_rule(RA_TYPE_BIJECTION)); + conjunct2_rule(ra_type_bijection)); inverse = rewrite_rule( THM_LIST( get_theorem_by_name("FST"), @@ -2254,7 +2254,7 @@ PROOF static thm prove_ra_abs_rep(void) { return gen_rule(e, abstracted); } -PROOF thm RA_ABS_REP = prove_ra_abs_rep(); +PROOF thm ra_abs_rep = prove_ra_abs_rep(); PROOF static thm prove_ra_unit_abs(void) { term goal_tm = ` @@ -2267,7 +2267,7 @@ PROOF static thm prove_ra_unit_abs(void) { thm abstracted = mp_rule( specl_rule( TERM_LIST(`e:A`, `op:A->A->A`, `valid:A->bool`), - RA_ABS_REP), + ra_abs_rep), assume_rule(`ra_laws (e:A) (op:A->A->A) (valid:A->bool)`)); CONV_TAC( body, @@ -2279,7 +2279,7 @@ PROOF static thm prove_ra_unit_abs(void) { return gnode_prove(root); } -PROOF thm RA_UNIT_ABS = prove_ra_unit_abs(); +PROOF thm ra_unit_abs = prove_ra_unit_abs(); PROOF static thm prove_ra_op_abs(void) { term goal_tm = ` @@ -2292,7 +2292,7 @@ PROOF static thm prove_ra_op_abs(void) { thm abstracted = mp_rule( specl_rule( TERM_LIST(`e:A`, `op:A->A->A`, `valid:A->bool`), - RA_ABS_REP), + ra_abs_rep), assume_rule(`ra_laws (e:A) (op:A->A->A) (valid:A->bool)`)); CONV_TAC( body, @@ -2304,7 +2304,7 @@ PROOF static thm prove_ra_op_abs(void) { return gnode_prove(root); } -PROOF thm RA_OP_ABS = prove_ra_op_abs(); +PROOF thm ra_op_abs = prove_ra_op_abs(); PROOF static thm prove_ra_valid_abs(void) { term goal_tm = ` @@ -2317,7 +2317,7 @@ PROOF static thm prove_ra_valid_abs(void) { thm abstracted = mp_rule( specl_rule( TERM_LIST(`e:A`, `op:A->A->A`, `valid:A->bool`), - RA_ABS_REP), + ra_abs_rep), assume_rule(`ra_laws (e:A) (op:A->A->A) (valid:A->bool)`)); CONV_TAC( body, @@ -2329,7 +2329,7 @@ PROOF static thm prove_ra_valid_abs(void) { return gnode_prove(root); } -PROOF thm RA_VALID_ABS = prove_ra_valid_abs(); +PROOF thm ra_valid_abs = prove_ra_valid_abs(); PROOF static thm prove_ra_abs_eta(void) { term goal_tm = ` @@ -2341,7 +2341,7 @@ PROOF static thm prove_ra_abs_eta(void) { CONV_TAC( body, rewrite_conv(THM_LIST( - RA_TYPE_BIJECTION, + ra_type_bijection, ra_unit_def, ra_op_def, ra_valid_def, @@ -2349,7 +2349,7 @@ PROOF static thm prove_ra_abs_eta(void) { return gnode_prove(root); } -PROOF thm RA_ABS_ETA = prove_ra_abs_eta(); +PROOF thm ra_abs_eta = prove_ra_abs_eta(); PROOF static int audit_ra_core(void) { thm_list public_definitions = THM_LIST( @@ -2360,48 +2360,48 @@ PROOF static int audit_ra_core(void) { ra_cancellative_def, ra_exclusive_def); thm_list public_rules = THM_LIST( - RA_LAWS, - RA_ASSOC, - RA_COMM, - RA_UNIT_L, - RA_UNIT_R, - RA_VALID_UNIT, - RA_VALID_OP, - RA_COMPAT_COMM, - RA_COMPAT_UNIT, - RA_INCLUDED_REFL, - RA_INCLUDED_UNIT, - RA_INCLUDED_OP_L, - RA_INCLUDED_OP_R, - RA_INCLUDED_TRANS, - RA_INCLUDED_OP_MONO, - RA_INCLUDED_VALID, - RA_UPDATEP_SINGLETON, - RA_UPDATEP_REFL, - RA_UPDATEP_MONO, - RA_UPDATEP_TRANS, - RA_UPDATEP_VALID, - RA_UPDATEP_FRAME, - RA_UPDATEP_OP, - RA_UPDATE_REFL, - RA_UPDATE_TRANS, - RA_UPDATE_FRAME, - RA_UPDATE_OP, - RA_UPDATE_INCLUDED, - RA_UPDATE_TARGET_INCLUDED, - RA_UPDATE_VALID, - RA_EXCLUSIVE_INCLUDED, - RA_EXCLUSIVE_UPDATE, - RA_CANCELLATIVE_APPLY); + ra_laws, + ra_assoc, + ra_comm, + ra_unit_l, + ra_unit_r, + ra_valid_unit, + ra_valid_op, + ra_compat_comm, + ra_compat_unit, + ra_included_refl, + ra_included_unit, + ra_included_op_l, + ra_included_op_r, + ra_included_trans, + ra_included_op_mono, + ra_included_valid, + ra_updateP_singleton, + ra_updateP_refl, + ra_updateP_mono, + ra_updateP_trans, + ra_updateP_valid, + ra_updateP_frame, + ra_updateP_op, + ra_update_refl, + ra_update_trans, + ra_update_frame, + ra_update_op, + ra_update_included, + ra_update_target_included, + ra_update_valid, + ra_exclusive_included, + ra_exclusive_update, + ra_cancellative_apply); thm_list builder_theorems = THM_LIST( ra_laws_def, - RA_TYPE_BIJECTION, - RA_REP_LAWS, - RA_ABS_REP, - RA_UNIT_ABS, - RA_OP_ABS, - RA_VALID_ABS, - RA_ABS_ETA); + ra_type_bijection, + ra_rep_laws, + ra_abs_rep, + ra_unit_abs, + ra_op_abs, + ra_valid_abs, + ra_abs_eta); for (size_t i = 0; i < vector_size(public_definitions); ++i) { ENSURE_COND(!IS_NULL(public_definitions[i]), diff --git a/theory/logic/ra.h b/theory/logic/ra.h index b76b4ca..79b1941 100644 --- a/theory/logic/ra.h +++ b/theory/logic/ra.h @@ -1,69 +1,148 @@ #pragma once /* - * Discrete unital resource algebras: stable client API. + * Public interface for discrete unital resource algebras. * - * `(A)ra` is an abstract HOL type whose values bundle a unit, a commutative - * associative operation, and a downward-closed validity predicate. Lawful - * construction is handled by `ra_builder.h`; clients only see the projections - * and the algebraic interface below. + * `(A)ra` bundles a unit, a commutative associative operation, and a validity + * predicate closed under taking fragments. This header exposes only the + * semantic projections, relations, and laws used by ordinary clients. + * Constructor authors use `ra_builder.h`; implementation proofs may also use + * `ra_internal.h`. * - * Predicate update is primitive. A deterministic update is exactly its - * singleton specialization. Exclusivity includes source validity, so an - * invalid element is never exclusive merely by vacuity. + * `ra_updateP` is the primitive frame-preserving update. `ra_update` is its + * singleton specialization. `ra_exclusive` includes source validity, so an + * invalid element is not exclusive merely because it has no valid frames. */ #include "proof/proof_kernel.h" -/* Definitions. */ +/* ------------------------------------------------------------------------- */ +/* Derived relations */ +/* ------------------------------------------------------------------------- */ + +/* `ra_compatible R a b <=> ra_valid R (ra_op R a b)`. */ PROOF extern thm ra_compatible_def; + +/* `ra_included R a b <=> exists frame. b == ra_op R a frame`. */ PROOF extern thm ra_included_def; + +/* + * `ra_updateP R a P` holds when every frame valid with `a` admits a + * frame-compatible result selected by `P`. The result may depend on the + * hidden frame. + */ PROOF extern thm ra_updateP_def; + +/* `ra_update R a b <=> ra_updateP R a (\x. x == b)`. */ PROOF extern thm ra_update_def; + +/* Valid-source cancellation of a common left frame. */ PROOF extern thm ra_cancellative_def; + +/* A valid element whose every compatible frame is the unit. */ PROOF extern thm ra_exclusive_def; -/* Intrinsic RA laws. */ -PROOF extern thm RA_LAWS; -PROOF extern thm RA_ASSOC; -PROOF extern thm RA_COMM; -PROOF extern thm RA_UNIT_L; -PROOF extern thm RA_UNIT_R; -PROOF extern thm RA_VALID_UNIT; -PROOF extern thm RA_VALID_OP; - -/* Compatibility. */ -PROOF extern thm RA_COMPAT_COMM; -PROOF extern thm RA_COMPAT_UNIT; - -/* Inclusion. */ -PROOF extern thm RA_INCLUDED_REFL; -PROOF extern thm RA_INCLUDED_UNIT; -PROOF extern thm RA_INCLUDED_OP_L; -PROOF extern thm RA_INCLUDED_OP_R; -PROOF extern thm RA_INCLUDED_TRANS; -PROOF extern thm RA_INCLUDED_OP_MONO; -PROOF extern thm RA_INCLUDED_VALID; - -/* Primitive predicate updates. */ -PROOF extern thm RA_UPDATEP_SINGLETON; -PROOF extern thm RA_UPDATEP_REFL; -PROOF extern thm RA_UPDATEP_MONO; -PROOF extern thm RA_UPDATEP_TRANS; -PROOF extern thm RA_UPDATEP_VALID; -PROOF extern thm RA_UPDATEP_FRAME; -PROOF extern thm RA_UPDATEP_OP; - -/* Deterministic singleton updates. */ -PROOF extern thm RA_UPDATE_REFL; -PROOF extern thm RA_UPDATE_TRANS; -PROOF extern thm RA_UPDATE_FRAME; -PROOF extern thm RA_UPDATE_OP; -PROOF extern thm RA_UPDATE_INCLUDED; -PROOF extern thm RA_UPDATE_TARGET_INCLUDED; -PROOF extern thm RA_UPDATE_VALID; - -/* Optional algebraic properties. */ -PROOF extern thm RA_EXCLUSIVE_INCLUDED; -PROOF extern thm RA_EXCLUSIVE_UPDATE; -PROOF extern thm RA_CANCELLATIVE_APPLY; +/* ------------------------------------------------------------------------- */ +/* Intrinsic RA laws */ +/* ------------------------------------------------------------------------- */ + +/* `forall R. ra_laws (ra_unit R) (ra_op R) (ra_valid R)`. */ +PROOF extern thm ra_laws; + +/* `ra_op R (ra_op R a b) c == ra_op R a (ra_op R b c)`. */ +PROOF extern thm ra_assoc; + +/* `ra_op R a b == ra_op R b a`. */ +PROOF extern thm ra_comm; + +/* `ra_op R (ra_unit R) a == a`. */ +PROOF extern thm ra_unit_l; + +/* `ra_op R a (ra_unit R) == a`. */ +PROOF extern thm ra_unit_r; + +/* `ra_valid R (ra_unit R)`. */ +PROOF extern thm ra_valid_unit; + +/* `ra_valid R (ra_op R a b) ==> ra_valid R a && ra_valid R b`. */ +PROOF extern thm ra_valid_op; + +/* ------------------------------------------------------------------------- */ +/* Compatibility and inclusion */ +/* ------------------------------------------------------------------------- */ + +/* `ra_compatible R a b <=> ra_compatible R b a`. */ +PROOF extern thm ra_compat_comm; + +/* `ra_compatible R a (ra_unit R) <=> ra_valid R a`. */ +PROOF extern thm ra_compat_unit; + +/* Inclusion is a preorder whose bottom element is the RA unit. */ +PROOF extern thm ra_included_refl; +PROOF extern thm ra_included_unit; + +/* Each operand is included in its composition. */ +PROOF extern thm ra_included_op_l; +PROOF extern thm ra_included_op_r; + +/* Inclusion is transitive and composition is monotone in both operands. */ +PROOF extern thm ra_included_trans; +PROOF extern thm ra_included_op_mono; + +/* `ra_included R a b ==> ra_valid R b ==> ra_valid R a`. */ +PROOF extern thm ra_included_valid; + +/* ------------------------------------------------------------------------- */ +/* Predicate updates */ +/* ------------------------------------------------------------------------- */ + +/* `ra_updateP R a (\x. x == b) <=> ra_update R a b`. */ +PROOF extern thm ra_updateP_singleton; + +/* Predicate updates are reflexive, monotone in their result, and transitive. */ +PROOF extern thm ra_updateP_refl; +PROOF extern thm ra_updateP_mono; +PROOF extern thm ra_updateP_trans; + +/* A valid source selects at least one valid result satisfying the predicate. */ +PROOF extern thm ra_updateP_valid; + +/* Lift a predicate update while retaining one explicit owned frame. */ +PROOF extern thm ra_updateP_frame; + +/* Combine two predicate updates under the RA operation. */ +PROOF extern thm ra_updateP_op; + +/* ------------------------------------------------------------------------- */ +/* Deterministic updates */ +/* ------------------------------------------------------------------------- */ + +/* Deterministic updates are reflexive and transitive. */ +PROOF extern thm ra_update_refl; +PROOF extern thm ra_update_trans; + +/* Retain one frame, or combine two independent deterministic updates. */ +PROOF extern thm ra_update_frame; +PROOF extern thm ra_update_op; + +/* A resource may update to an included part. */ +PROOF extern thm ra_update_included; + +/* An update target may be weakened further to one of its included parts. */ +PROOF extern thm ra_update_target_included; + +/* `ra_update R a b ==> ra_valid R a ==> ra_valid R b`. */ +PROOF extern thm ra_update_valid; + +/* ------------------------------------------------------------------------- */ +/* Optional algebraic properties */ +/* ------------------------------------------------------------------------- */ + +/* A valid exclusive element has no strict valid extension. */ +PROOF extern thm ra_exclusive_included; + +/* A valid exclusive element may be replaced by any valid target. */ +PROOF extern thm ra_exclusive_update; + +/* Direct eliminator for `ra_cancellative`. */ +PROOF extern thm ra_cancellative_apply; diff --git a/theory/logic/ra_builder.h b/theory/logic/ra_builder.h index 784cf24..7a4aa1e 100644 --- a/theory/logic/ra_builder.h +++ b/theory/logic/ra_builder.h @@ -1,14 +1,43 @@ #pragma once -/* Constructor-author API for defining lawful `(A)ra` instances. */ +/* + * INTERNAL CONSTRUCTOR-AUTHOR INTERFACE for defining lawful `(A)ra` values. + * + * Ordinary clients should include `ra.h`. This header deliberately exposes + * the raw descriptor predicate and abstraction/representation machinery + * needed by constructor implementations. It must not be re-exported from a + * public constructor header. + */ #include "proof/theory/logic/ra.h" +/* ------------------------------------------------------------------------- */ +/* Raw descriptor laws and representation */ +/* ------------------------------------------------------------------------- */ + +/* + * `ra_laws e op valid` requires associativity, commutativity, a left unit, + * unit validity, and validity closure under taking an operand of `op`. + */ PROOF extern thm ra_laws_def; -PROOF extern thm RA_TYPE_BIJECTION; -PROOF extern thm RA_REP_LAWS; -PROOF extern thm RA_ABS_REP; -PROOF extern thm RA_UNIT_ABS; -PROOF extern thm RA_OP_ABS; -PROOF extern thm RA_VALID_ABS; -PROOF extern thm RA_ABS_ETA; + +/* Bijection between lawful raw descriptors and the abstract `(A)ra` type. */ +PROOF extern thm ra_type_bijection; + +/* The representation of every abstract RA satisfies `ra_laws`. */ +PROOF extern thm ra_rep_laws; + +/* A lawful descriptor survives the `ra_abs`/`ra_rep` round trip. */ +PROOF extern thm ra_abs_rep; + +/* ------------------------------------------------------------------------- */ +/* Constructor computation rules */ +/* ------------------------------------------------------------------------- */ + +/* Compute the unit, operation, and validity of a lawful `ra_abs` descriptor. */ +PROOF extern thm ra_unit_abs; +PROOF extern thm ra_op_abs; +PROOF extern thm ra_valid_abs; + +/* `ra_abs (ra_unit R,(ra_op R,ra_valid R)) == R`. */ +PROOF extern thm ra_abs_eta; diff --git a/theory/logic/ra_internal.h b/theory/logic/ra_internal.h index 68c61a3..d204e29 100644 --- a/theory/logic/ra_internal.h +++ b/theory/logic/ra_internal.h @@ -1,25 +1,54 @@ #pragma once /* - * Derived proof helpers for RA implementation modules. + * INTERNAL DERIVED RULES for RA and constructor implementations. * - * These rules intentionally do not belong to the stable client surface in - * `ra.h`. Constructor and local-update implementations may include this - * header to avoid repeatedly unfolding core definitions. + * Ordinary protocol/client headers must include only `ra.h`. These helpers + * expose convenient eliminators and normalization rules that are intentionally + * absent from the public compatibility surface. */ #include "proof/theory/logic/ra.h" -PROOF extern thm RA_OP_SWAP_RIGHT; -PROOF extern thm RA_VALID_OP_L; -PROOF extern thm RA_VALID_OP_R; -PROOF extern thm RA_EXCLUSIVE_APPLY; -PROOF extern thm RA_UPDATE_APPLY; -PROOF extern thm RA_UPDATEP_APPLY; -PROOF extern thm RA_INCLUDED_OP_MONO_L; -PROOF extern thm RA_INCLUDED_OP_MONO_R; -PROOF extern thm RA_INCLUDED_VALID_FRAME; -PROOF extern thm RA_INCLUDED_CANCEL_L; -PROOF extern thm RA_EXCLUSIVE_VALID_OP_IFF; -PROOF extern thm RA_UPDATEP_OF_UPDATE; -PROOF extern thm RA_UPDATE_UNIT; +/* ------------------------------------------------------------------------- */ +/* Operation and validity normalization */ +/* ------------------------------------------------------------------------- */ + +/* `(a · b) · c == (a · c) · b`, with the left operand fixed. */ +PROOF extern thm ra_op_swap_right; + +/* Project either valid operand from a valid composition. */ +PROOF extern thm ra_valid_op_l; +PROOF extern thm ra_valid_op_r; + +/* Direct eliminators for exclusivity and frame-preserving updates. */ +PROOF extern thm ra_exclusive_apply; +PROOF extern thm ra_update_apply; +PROOF extern thm ra_updateP_apply; + +/* ------------------------------------------------------------------------- */ +/* Inclusion and cancellation helpers */ +/* ------------------------------------------------------------------------- */ + +/* One-coordinate forms of public two-coordinate inclusion monotonicity. */ +PROOF extern thm ra_included_op_mono_l; +PROOF extern thm ra_included_op_mono_r; + +/* A valid framed extension implies validity of the same frame on its part. */ +PROOF extern thm ra_included_valid_frame; + +/* Cancel a common left operand from an inclusion in a cancellative RA. */ +PROOF extern thm ra_included_cancel_l; + +/* Exact valid-frame characterization for an exclusive source. */ +PROOF extern thm ra_exclusive_valid_op_iff; + +/* ------------------------------------------------------------------------- */ +/* Update bridges */ +/* ------------------------------------------------------------------------- */ + +/* Lift a deterministic update whose target satisfies a result predicate. */ +PROOF extern thm ra_updateP_of_update; + +/* Every resource can update to the RA unit. */ +PROOF extern thm ra_update_unit; diff --git a/theory/logic/resource_prop.c b/theory/logic/resource_prop.c index 423b874..fe174e2 100644 --- a/theory/logic/resource_prop.c +++ b/theory/logic/resource_prop.c @@ -164,7 +164,7 @@ PROOF static thm prove_r_entails_refl(void) { return gnode_prove(root); } -PROOF thm R_ENTAILS_REFL = +PROOF thm r_entails_refl = prove_r_entails_refl(); PROOF static thm prove_r_entails_trans(void) { @@ -212,7 +212,7 @@ PROOF static thm prove_r_entails_trans(void) { return gnode_prove(root); } -PROOF thm R_ENTAILS_TRANS = +PROOF thm r_entails_trans = prove_r_entails_trans(); PROOF static thm prove_r_entails_pointwise(void) { @@ -243,7 +243,7 @@ PROOF static thm prove_r_entails_pointwise(void) { return gnode_prove(root); } -PROOF thm R_ENTAILS_POINTWISE = +PROOF thm r_entails_pointwise = prove_r_entails_pointwise(); PROOF static thm prove_r_equiv_pointwise(void) { @@ -345,7 +345,7 @@ PROOF static thm prove_r_equiv_pointwise(void) { return gnode_prove(root); } -PROOF thm R_EQUIV_POINTWISE = +PROOF thm r_equiv_pointwise = prove_r_equiv_pointwise(); PROOF static thm prove_r_equiv_intro(void) { @@ -373,7 +373,7 @@ PROOF static thm prove_r_equiv_intro(void) { return gnode_prove(root); } -PROOF thm R_EQUIV_INTRO = +PROOF thm r_equiv_intro = prove_r_equiv_intro(); PROOF static thm prove_r_equiv_refl(void) { @@ -391,16 +391,16 @@ PROOF static thm prove_r_equiv_refl(void) { parts[0], ispecl_rule( TERM_LIST(`R:(A)ra`, `P:A->bool`), - R_ENTAILS_REFL)); + r_entails_refl)); ACCEPT_TAC( parts[1], ispecl_rule( TERM_LIST(`R:(A)ra`, `P:A->bool`), - R_ENTAILS_REFL)); + r_entails_refl)); return gnode_prove(root); } -PROOF thm R_EQUIV_REFL = +PROOF thm r_equiv_refl = prove_r_equiv_refl(); /* Raw function equality is useful inside implementations, but the public @@ -421,11 +421,11 @@ PROOF static thm prove_r_equiv_of_eq(void) { lifted, ispecl_rule( TERM_LIST(`R:(A)ra`, `P:A->bool`), - R_EQUIV_REFL))); + r_equiv_refl))); return gnode_prove(root); } -PROOF static thm R_EQUIV_OF_EQ = +PROOF static thm r_equiv_of_eq = prove_r_equiv_of_eq(); PROOF static thm prove_r_equiv_sym(void) { @@ -460,7 +460,7 @@ PROOF static thm prove_r_equiv_sym(void) { return gnode_prove(root); } -PROOF thm R_EQUIV_SYM = +PROOF thm r_equiv_sym = prove_r_equiv_sym(); PROOF static thm prove_r_equiv_trans(void) { @@ -504,7 +504,7 @@ PROOF static thm prove_r_equiv_trans(void) { `P:A->bool`, `Q:A->bool`, `S:A->bool`), - R_ENTAILS_TRANS), + r_entails_trans), assume_rule(` r_entails (R:(A)ra) (P:A->bool) (Q:A->bool) `)), @@ -521,7 +521,7 @@ PROOF static thm prove_r_equiv_trans(void) { `S:A->bool`, `Q:A->bool`, `P:A->bool`), - R_ENTAILS_TRANS), + r_entails_trans), assume_rule(` r_entails (R:(A)ra) (S:A->bool) (Q:A->bool) `)), @@ -532,7 +532,7 @@ PROOF static thm prove_r_equiv_trans(void) { return gnode_prove(root); } -PROOF thm R_EQUIV_TRANS = +PROOF thm r_equiv_trans = prove_r_equiv_trans(); PROOF static thm prove_r_top_intro(void) { @@ -548,7 +548,7 @@ PROOF static thm prove_r_top_intro(void) { return gnode_prove(root); } -PROOF thm R_TOP_INTRO = +PROOF thm r_top_intro = prove_r_top_intro(); PROOF static thm prove_r_bottom_elim(void) { @@ -564,7 +564,7 @@ PROOF static thm prove_r_bottom_elim(void) { return gnode_prove(root); } -PROOF thm R_BOTTOM_ELIM = +PROOF thm r_bottom_elim = prove_r_bottom_elim(); PROOF static thm prove_r_sep_comm(void) { @@ -621,7 +621,7 @@ PROOF static thm prove_r_sep_comm(void) { `R:(A)ra`, `left:A`, `right:A`), - RA_COMM)); + ra_comm)); ACCEPT_TAC(result1[0], swapped); gnode_list result2 = CONJ_TAC(result1[1]); ACCEPT_TAC( @@ -640,7 +640,7 @@ PROOF static thm prove_r_sep_comm(void) { return gnode_prove(root); } -PROOF thm R_SEP_COMM_EQ = +PROOF thm r_sep_comm_eq = prove_r_sep_comm(); PROOF static thm prove_r_sep_comm_equiv(void) { @@ -657,14 +657,14 @@ PROOF static thm prove_r_sep_comm_equiv(void) { `R:(A)ra`, `r_sep (R:(A)ra) (P:A->bool) (Q:A->bool)`, `r_sep (R:(A)ra) (Q:A->bool) (P:A->bool)`), - R_EQUIV_OF_EQ), + r_equiv_of_eq), ispecl_rule( TERM_LIST(`R:(A)ra`, `P:A->bool`, `Q:A->bool`), - R_SEP_COMM_EQ))); + r_sep_comm_eq))); return gnode_prove(root); } -PROOF thm R_SEP_COMM = +PROOF thm r_sep_comm = prove_r_sep_comm_equiv(); PROOF static thm prove_r_sep_emp_l(void) { @@ -725,7 +725,7 @@ PROOF static thm prove_r_sep_emp_l(void) { replace_left, ispecl_rule( TERM_LIST(`R:(A)ra`, `right:A`), - RA_UNIT_L))); + ra_unit_l))); thm pred_eq = ap_term_rule( `P:A->bool`, gsym_rule(resource_eq_right)); @@ -743,7 +743,7 @@ PROOF static thm prove_r_sep_emp_l(void) { result1[0], gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `resource:A`), - RA_UNIT_L))); + ra_unit_l))); gnode_list result2 = CONJ_TAC(result1[1]); ACCEPT_TAC( result2[0], @@ -754,7 +754,7 @@ PROOF static thm prove_r_sep_emp_l(void) { return gnode_prove(root); } -PROOF thm R_SEP_EMP_L_EQ = +PROOF thm r_sep_emp_l_eq = prove_r_sep_emp_l(); PROOF static thm prove_r_sep_emp_l_equiv(void) { @@ -771,14 +771,14 @@ PROOF static thm prove_r_sep_emp_l_equiv(void) { `R:(A)ra`, `r_sep (R:(A)ra) (r_emp R) (P:A->bool)`, `P:A->bool`), - R_EQUIV_OF_EQ), + r_equiv_of_eq), ispecl_rule( TERM_LIST(`R:(A)ra`, `P:A->bool`), - R_SEP_EMP_L_EQ))); + r_sep_emp_l_eq))); return gnode_prove(root); } -PROOF thm R_SEP_EMP_L = +PROOF thm r_sep_emp_l = prove_r_sep_emp_l_equiv(); PROOF static thm prove_r_sep_emp_r(void) { @@ -789,16 +789,16 @@ PROOF static thm prove_r_sep_emp_r(void) { R, P, `r_emp (R:(A)ra)`), - R_SEP_COMM_EQ); + r_sep_comm_eq); thm left_unit = ispecl_rule( TERM_LIST(R, P), - R_SEP_EMP_L_EQ); + r_sep_emp_l_eq); thm result = trans_rule(commute, left_unit); result = gen_rule(P, result); return gen_rule(R, result); } -PROOF thm R_SEP_EMP_R_EQ = +PROOF thm r_sep_emp_r_eq = prove_r_sep_emp_r(); PROOF static thm prove_r_sep_emp_r_equiv(void) { @@ -815,14 +815,14 @@ PROOF static thm prove_r_sep_emp_r_equiv(void) { `R:(A)ra`, `r_sep (R:(A)ra) (P:A->bool) (r_emp R)`, `P:A->bool`), - R_EQUIV_OF_EQ), + r_equiv_of_eq), ispecl_rule( TERM_LIST(`R:(A)ra`, `P:A->bool`), - R_SEP_EMP_R_EQ))); + r_sep_emp_r_eq))); return gnode_prove(root); } -PROOF thm R_SEP_EMP_R = +PROOF thm r_sep_emp_r = prove_r_sep_emp_r_equiv(); PROOF static thm prove_r_sep_assoc(void) { @@ -907,7 +907,7 @@ PROOF static thm prove_r_sep_assoc(void) { `left:A`, `middle:A`, `right:A`), - RA_ASSOC))); + ra_assoc))); ACCEPT_TAC(f1[0], regrouped); gnode_list f2 = CONJ_TAC(f1[1]); ACCEPT_TAC( @@ -979,7 +979,7 @@ PROOF static thm prove_r_sep_assoc(void) { `left:A`, `middle:A`, `right:A`), - RA_ASSOC)))); + ra_assoc)))); ACCEPT_TAC(r1[0], ungrouped); gnode_list r2 = CONJ_TAC(r1[1]); gnode reverse_inner = EXISTS_TAC(r2[0], `left:A`); @@ -1003,7 +1003,7 @@ PROOF static thm prove_r_sep_assoc(void) { return gnode_prove(root); } -PROOF thm R_SEP_ASSOC_EQ = +PROOF thm r_sep_assoc_eq = prove_r_sep_assoc(); PROOF static thm prove_r_sep_assoc_equiv(void) { @@ -1027,15 +1027,15 @@ PROOF static thm prove_r_sep_assoc_equiv(void) { `r_sep (R:(A)ra) (P:A->bool) (r_sep R (Q:A->bool) (S:A->bool))`), - R_EQUIV_OF_EQ), + r_equiv_of_eq), ispecl_rule( TERM_LIST( `R:(A)ra`, `P:A->bool`, `Q:A->bool`, `S:A->bool`), - R_SEP_ASSOC_EQ))); + r_sep_assoc_eq))); return gnode_prove(root); } -PROOF thm R_SEP_ASSOC = +PROOF thm r_sep_assoc = prove_r_sep_assoc_equiv(); PROOF static thm prove_r_sep_mono(void) { @@ -1097,7 +1097,7 @@ PROOF static thm prove_r_sep_mono(void) { `R:(A)ra`, `left:A`, `right:A`), - RA_VALID_OP), + ra_valid_op), valid_pair); thm valid_left = conjunct1_rule(valid_parts); thm valid_right = conjunct2_rule(valid_parts); @@ -1142,7 +1142,7 @@ PROOF static thm prove_r_sep_mono(void) { return gnode_prove(root); } -PROOF thm R_SEP_MONO = +PROOF thm r_sep_mono = prove_r_sep_mono(); PROOF static thm prove_r_sep_frame_l(void) { @@ -1169,18 +1169,18 @@ PROOF static thm prove_r_sep_frame_l(void) { `Q:A->bool`, `frame_pred:A->bool`, `frame_pred:A->bool`), - R_SEP_MONO), + r_sep_mono), assume_rule(` r_entails (R:(A)ra) (P:A->bool) (Q:A->bool) `)), ispecl_rule( TERM_LIST(`R:(A)ra`, `frame_pred:A->bool`), - R_ENTAILS_REFL)); + r_entails_refl)); ACCEPT_TAC(body, framed); return gnode_prove(root); } -PROOF thm R_SEP_FRAME_L = +PROOF thm r_sep_frame_l = prove_r_sep_frame_l(); PROOF static thm prove_r_sep_frame_r(void) { @@ -1207,10 +1207,10 @@ PROOF static thm prove_r_sep_frame_r(void) { `frame_pred:A->bool`, `P:A->bool`, `Q:A->bool`), - R_SEP_MONO), + r_sep_mono), ispecl_rule( TERM_LIST(`R:(A)ra`, `frame_pred:A->bool`), - R_ENTAILS_REFL)), + r_entails_refl)), assume_rule(` r_entails (R:(A)ra) (P:A->bool) (Q:A->bool) `)); @@ -1218,7 +1218,7 @@ PROOF static thm prove_r_sep_frame_r(void) { return gnode_prove(root); } -PROOF thm R_SEP_FRAME_R = +PROOF thm r_sep_frame_r = prove_r_sep_frame_r(); PROOF static thm prove_r_sep_exists_l(void) { @@ -1341,7 +1341,7 @@ PROOF static thm prove_r_sep_exists_l(void) { return result; } -PROOF thm R_SEP_EXISTS_L_EQ = +PROOF thm r_sep_exists_l_eq = prove_r_sep_exists_l(); PROOF static thm prove_r_sep_exists_l_equiv(void) { @@ -1364,14 +1364,14 @@ PROOF static thm prove_r_sep_exists_l_equiv(void) { (Q:A->bool)`, `r_exists (R:(A)ra) (\x:B. r_sep R ((P:B->A->bool) x) (Q:A->bool))`), - R_EQUIV_OF_EQ), + r_equiv_of_eq), ispecl_rule( TERM_LIST(`R:(A)ra`, `P:B->A->bool`, `Q:A->bool`), - R_SEP_EXISTS_L_EQ))); + r_sep_exists_l_eq))); return gnode_prove(root); } -PROOF thm R_SEP_EXISTS_L = +PROOF thm r_sep_exists_l = prove_r_sep_exists_l_equiv(); PROOF static thm prove_r_sep_exists_r(void) { @@ -1494,7 +1494,7 @@ PROOF static thm prove_r_sep_exists_r(void) { return result; } -PROOF thm R_SEP_EXISTS_R_EQ = +PROOF thm r_sep_exists_r_eq = prove_r_sep_exists_r(); PROOF static thm prove_r_sep_exists_r_equiv(void) { @@ -1517,14 +1517,14 @@ PROOF static thm prove_r_sep_exists_r_equiv(void) { (r_exists R (\x:B. (Q:B->A->bool) x))`, `r_exists (R:(A)ra) (\x:B. r_sep R (P:A->bool) ((Q:B->A->bool) x))`), - R_EQUIV_OF_EQ), + r_equiv_of_eq), ispecl_rule( TERM_LIST(`R:(A)ra`, `P:A->bool`, `Q:B->A->bool`), - R_SEP_EXISTS_R_EQ))); + r_sep_exists_r_eq))); return gnode_prove(root); } -PROOF thm R_SEP_EXISTS_R = +PROOF thm r_sep_exists_r = prove_r_sep_exists_r_equiv(); PROOF static thm prove_r_and_intro(void) { @@ -1577,7 +1577,7 @@ PROOF static thm prove_r_and_intro(void) { return gnode_prove(root); } -PROOF thm R_AND_INTRO = +PROOF thm r_and_intro = prove_r_and_intro(); PROOF static thm prove_r_and_elim_l(void) { @@ -1609,7 +1609,7 @@ PROOF static thm prove_r_and_elim_l(void) { return gnode_prove(root); } -PROOF thm R_AND_ELIM_L = +PROOF thm r_and_elim_l = prove_r_and_elim_l(); PROOF static thm prove_r_and_elim_r(void) { @@ -1641,7 +1641,7 @@ PROOF static thm prove_r_and_elim_r(void) { return gnode_prove(root); } -PROOF thm R_AND_ELIM_R = +PROOF thm r_and_elim_r = prove_r_and_elim_r(); PROOF static thm prove_r_or_intro_l(void) { @@ -1664,7 +1664,7 @@ PROOF static thm prove_r_or_intro_l(void) { return gnode_prove(root); } -PROOF thm R_OR_INTRO_L = +PROOF thm r_or_intro_l = prove_r_or_intro_l(); PROOF static thm prove_r_or_intro_r(void) { @@ -1687,7 +1687,7 @@ PROOF static thm prove_r_or_intro_r(void) { return gnode_prove(root); } -PROOF thm R_OR_INTRO_R = +PROOF thm r_or_intro_r = prove_r_or_intro_r(); PROOF static thm prove_r_or_elim(void) { @@ -1752,7 +1752,7 @@ PROOF static thm prove_r_or_elim(void) { return gnode_prove(root); } -PROOF thm R_OR_ELIM = +PROOF thm r_or_elim = prove_r_or_elim(); PROOF static thm prove_r_exists_intro(void) { @@ -1783,7 +1783,7 @@ PROOF static thm prove_r_exists_intro(void) { return gnode_prove(root); } -PROOF thm R_EXISTS_INTRO = +PROOF thm r_exists_intro = prove_r_exists_intro(); PROOF static thm prove_r_exists_elim(void) { @@ -1834,7 +1834,7 @@ PROOF static thm prove_r_exists_elim(void) { return gnode_prove(root); } -PROOF thm R_EXISTS_ELIM = +PROOF thm r_exists_elim = prove_r_exists_elim(); PROOF static thm prove_r_exists_mono(void) { @@ -1889,7 +1889,7 @@ PROOF static thm prove_r_exists_mono(void) { return gnode_prove(root); } -PROOF thm R_EXISTS_MONO = +PROOF thm r_exists_mono = prove_r_exists_mono(); PROOF static thm prove_r_forall_intro(void) { @@ -1945,7 +1945,7 @@ PROOF static thm prove_r_forall_intro(void) { return gnode_prove(root); } -PROOF thm R_FORALL_INTRO = +PROOF thm r_forall_intro = prove_r_forall_intro(); PROOF static thm prove_r_forall_elim(void) { @@ -1977,7 +1977,7 @@ PROOF static thm prove_r_forall_elim(void) { return gnode_prove(root); } -PROOF thm R_FORALL_ELIM = +PROOF thm r_forall_elim = prove_r_forall_elim(); PROOF static thm prove_r_forall_elim_cont(void) { @@ -1999,7 +1999,7 @@ PROOF static thm prove_r_forall_elim_cont(void) { `R:(A)ra`, `\x:B. (P:B->A->bool) x`, `witness:B`), - R_FORALL_ELIM); + r_forall_elim); selected = conv_rule( depth_conv(get_conversion_by_name("BETA_CONV")), selected); @@ -2009,7 +2009,7 @@ PROOF static thm prove_r_forall_elim_cont(void) { `r_forall R (\x:B. (P:B->A->bool) x)`, `(P:B->A->bool) (witness:B)`, `Q:A->bool`), - R_ENTAILS_TRANS); + r_entails_trans); composed = mp_rule(composed, selected); composed = mp_rule( composed, @@ -2023,7 +2023,7 @@ PROOF static thm prove_r_forall_elim_cont(void) { return gnode_prove(root); } -PROOF thm R_FORALL_ELIM_CONT = +PROOF thm r_forall_elim_cont = prove_r_forall_elim_cont(); PROOF static thm prove_r_pure_and_intro(void) { @@ -2067,7 +2067,7 @@ PROOF static thm prove_r_pure_and_intro(void) { return gnode_prove(root); } -PROOF thm R_PURE_AND_INTRO = +PROOF thm r_pure_and_intro = prove_r_pure_and_intro(); PROOF static thm prove_r_pure_and_elim(void) { @@ -2122,7 +2122,7 @@ PROOF static thm prove_r_pure_and_elim(void) { return gnode_prove(root); } -PROOF thm R_PURE_AND_ELIM = +PROOF thm r_pure_and_elim = prove_r_pure_and_elim(); PROOF static thm prove_r_fact_as_pure_and_emp(void) { @@ -2155,7 +2155,7 @@ PROOF static thm prove_r_fact_as_pure_and_emp(void) { return gnode_prove(root); } -PROOF thm R_FACT_AS_PURE_AND_EMP_EQ = +PROOF thm r_fact_as_pure_and_emp_eq = prove_r_fact_as_pure_and_emp(); PROOF static thm prove_r_fact_as_pure_and_emp_equiv(void) { @@ -2176,14 +2176,14 @@ PROOF static thm prove_r_fact_as_pure_and_emp_equiv(void) { `r_and (R:(A)ra) (r_pure R (phi:bool)) (r_emp R)`), - R_EQUIV_OF_EQ), + r_equiv_of_eq), ispecl_rule( TERM_LIST(`R:(A)ra`, `phi:bool`), - R_FACT_AS_PURE_AND_EMP_EQ))); + r_fact_as_pure_and_emp_eq))); return gnode_prove(root); } -PROOF thm R_FACT_AS_PURE_AND_EMP = +PROOF thm r_fact_as_pure_and_emp = prove_r_fact_as_pure_and_emp_equiv(); PROOF static thm prove_r_fact_true(void) { @@ -2211,7 +2211,7 @@ PROOF static thm prove_r_fact_true(void) { return gnode_prove(root); } -PROOF thm R_FACT_TRUE_EQ = +PROOF thm r_fact_true_eq = prove_r_fact_true(); PROOF static thm prove_r_fact_true_equiv(void) { @@ -2228,12 +2228,12 @@ PROOF static thm prove_r_fact_true_equiv(void) { `R:(A)ra`, `r_fact (R:(A)ra) T`, `r_emp (R:(A)ra)`), - R_EQUIV_OF_EQ), - spec_rule(`R:(A)ra`, R_FACT_TRUE_EQ))); + r_equiv_of_eq), + spec_rule(`R:(A)ra`, r_fact_true_eq))); return gnode_prove(root); } -PROOF thm R_FACT_TRUE = +PROOF thm r_fact_true = prove_r_fact_true_equiv(); PROOF static thm prove_r_fact_false(void) { @@ -2261,7 +2261,7 @@ PROOF static thm prove_r_fact_false(void) { return gnode_prove(root); } -PROOF thm R_FACT_FALSE_EQ = +PROOF thm r_fact_false_eq = prove_r_fact_false(); PROOF static thm prove_r_fact_false_equiv(void) { @@ -2278,12 +2278,12 @@ PROOF static thm prove_r_fact_false_equiv(void) { `R:(A)ra`, `r_fact (R:(A)ra) F`, `r_bottom (R:(A)ra)`), - R_EQUIV_OF_EQ), - spec_rule(`R:(A)ra`, R_FACT_FALSE_EQ))); + r_equiv_of_eq), + spec_rule(`R:(A)ra`, r_fact_false_eq))); return gnode_prove(root); } -PROOF thm R_FACT_FALSE = +PROOF thm r_fact_false = prove_r_fact_false_equiv(); PROOF static thm prove_r_fact_sep_l(void) { @@ -2357,7 +2357,7 @@ PROOF static thm prove_r_fact_sep_l(void) { replace_left, ispecl_rule( TERM_LIST(`R:(A)ra`, `right:A`), - RA_UNIT_L))); + ra_unit_l))); thm pred_eq = ap_term_rule( `P:A->bool`, gsym_rule(resource_eq_right)); @@ -2380,7 +2380,7 @@ PROOF static thm prove_r_fact_sep_l(void) { reverse1[0], gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `resource:A`), - RA_UNIT_L))); + ra_unit_l))); gnode_list reverse2 = CONJ_TAC(reverse1[1]); gnode_list fact_parts = CONJ_TAC(reverse2[0]); ACCEPT_TAC(fact_parts[0], assume_rule(`phi:bool`)); @@ -2393,7 +2393,7 @@ PROOF static thm prove_r_fact_sep_l(void) { return gnode_prove(root); } -PROOF thm R_FACT_SEP_L_EQ = +PROOF thm r_fact_sep_l_eq = prove_r_fact_sep_l(); PROOF static thm prove_r_fact_sep_l_equiv(void) { @@ -2416,14 +2416,14 @@ PROOF static thm prove_r_fact_sep_l_equiv(void) { `r_and (R:(A)ra) (r_pure R (phi:bool)) (P:A->bool)`), - R_EQUIV_OF_EQ), + r_equiv_of_eq), ispecl_rule( TERM_LIST(`R:(A)ra`, `phi:bool`, `P:A->bool`), - R_FACT_SEP_L_EQ))); + r_fact_sep_l_eq))); return gnode_prove(root); } -PROOF thm R_FACT_SEP_L = +PROOF thm r_fact_sep_l = prove_r_fact_sep_l_equiv(); PROOF static thm prove_r_fact_sep_r(void) { @@ -2435,17 +2435,17 @@ PROOF static thm prove_r_fact_sep_r(void) { R, P, `r_fact (R:(A)ra) (phi:bool)`), - R_SEP_COMM_EQ); + r_sep_comm_eq); thm bridge = ispecl_rule( TERM_LIST(R, phi, P), - R_FACT_SEP_L_EQ); + r_fact_sep_l_eq); thm result = trans_rule(commute, bridge); result = gen_rule(P, result); result = gen_rule(phi, result); return gen_rule(R, result); } -PROOF thm R_FACT_SEP_R_EQ = +PROOF thm r_fact_sep_r_eq = prove_r_fact_sep_r(); PROOF static thm prove_r_fact_sep_r_equiv(void) { @@ -2468,14 +2468,14 @@ PROOF static thm prove_r_fact_sep_r_equiv(void) { `r_and (R:(A)ra) (r_pure R (phi:bool)) (P:A->bool)`), - R_EQUIV_OF_EQ), + r_equiv_of_eq), ispecl_rule( TERM_LIST(`R:(A)ra`, `phi:bool`, `P:A->bool`), - R_FACT_SEP_R_EQ))); + r_fact_sep_r_eq))); return gnode_prove(root); } -PROOF thm R_FACT_SEP_R = +PROOF thm r_fact_sep_r = prove_r_fact_sep_r_equiv(); PROOF static thm prove_r_fact_intro(void) { @@ -2505,7 +2505,7 @@ PROOF static thm prove_r_fact_intro(void) { `phi:bool`, `P:A->bool`, `Q:A->bool`), - R_PURE_AND_INTRO), + r_pure_and_intro), assume_rule(`phi:bool`)), assume_rule(`r_entails (R:(A)ra) (P:A->bool) (Q:A->bool)`)); thm fact_sep = ispecl_rule( @@ -2513,7 +2513,7 @@ PROOF static thm prove_r_fact_intro(void) { `R:(A)ra`, `phi:bool`, `Q:A->bool`), - R_FACT_SEP_L_EQ); + r_fact_sep_l_eq); thm target_eq = beta_rule(ap_term_rule( `\target:A->bool. r_entails (R:(A)ra) (P:A->bool) target`, @@ -2522,7 +2522,7 @@ PROOF static thm prove_r_fact_intro(void) { return gnode_prove(root); } -PROOF thm R_FACT_INTRO = +PROOF thm r_fact_intro = prove_r_fact_intro(); PROOF static thm prove_r_fact_elim(void) { @@ -2549,7 +2549,7 @@ PROOF static thm prove_r_fact_elim(void) { `phi:bool`, `P:A->bool`, `Q:A->bool`), - R_PURE_AND_ELIM), + r_pure_and_elim), assume_rule(` (phi:bool) ==> r_entails (R:(A)ra) (P:A->bool) (Q:A->bool) @@ -2559,7 +2559,7 @@ PROOF static thm prove_r_fact_elim(void) { `R:(A)ra`, `phi:bool`, `P:A->bool`), - R_FACT_SEP_L_EQ); + r_fact_sep_l_eq); thm source_eq = beta_rule(ap_term_rule( `\source:A->bool. r_entails (R:(A)ra) source (Q:A->bool)`, @@ -2568,7 +2568,7 @@ PROOF static thm prove_r_fact_elim(void) { return gnode_prove(root); } -PROOF thm R_FACT_ELIM = +PROOF thm r_fact_elim = prove_r_fact_elim(); PROOF static thm prove_r_fact_dup(void) { @@ -2611,7 +2611,7 @@ PROOF static thm prove_r_fact_dup(void) { TERM_LIST( `R:(A)ra`, `ra_unit (R:(A)ra)`), - RA_UNIT_L)))); + ra_unit_l)))); gnode_list result2 = CONJ_TAC(result1[1]); gnode_list left_fact = CONJ_TAC(result2[0]); ACCEPT_TAC(left_fact[0], assume_rule(`phi:bool`)); @@ -2626,7 +2626,7 @@ PROOF static thm prove_r_fact_dup(void) { return gnode_prove(root); } -PROOF thm R_FACT_DUP = +PROOF thm r_fact_dup = prove_r_fact_dup(); PROOF static thm prove_r_own_unit(void) { @@ -2654,7 +2654,7 @@ PROOF static thm prove_r_own_unit(void) { return gnode_prove(root); } -PROOF thm R_OWN_UNIT_EQ = +PROOF thm r_own_unit_eq = prove_r_own_unit(); PROOF static thm prove_r_own_unit_equiv(void) { @@ -2671,12 +2671,12 @@ PROOF static thm prove_r_own_unit_equiv(void) { `R:(A)ra`, `r_own (R:(A)ra) (ra_unit R)`, `r_emp (R:(A)ra)`), - R_EQUIV_OF_EQ), - spec_rule(`R:(A)ra`, R_OWN_UNIT_EQ))); + r_equiv_of_eq), + spec_rule(`R:(A)ra`, r_own_unit_eq))); return gnode_prove(root); } -PROOF thm R_OWN_UNIT = +PROOF thm r_own_unit = prove_r_own_unit_equiv(); PROOF static thm prove_r_own_op(void) { @@ -2753,7 +2753,7 @@ PROOF static thm prove_r_own_op(void) { return gnode_prove(root); } -PROOF thm R_OWN_OP_EQ = +PROOF thm r_own_op_eq = prove_r_own_op(); PROOF static thm prove_r_own_op_equiv(void) { @@ -2774,14 +2774,14 @@ PROOF static thm prove_r_own_op_equiv(void) { `r_sep (R:(A)ra) (r_own R (a:A)) (r_own R (b:A))`), - R_EQUIV_OF_EQ), + r_equiv_of_eq), ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`, `b:A`), - R_OWN_OP_EQ))); + r_own_op_eq))); return gnode_prove(root); } -PROOF thm R_OWN_OP = +PROOF thm r_own_op = prove_r_own_op_equiv(); PROOF static thm prove_r_own_valid(void) { @@ -2823,7 +2823,7 @@ PROOF static thm prove_r_own_valid(void) { assume_rule(`(resource:A) == (a:A)`), gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), - RA_UNIT_L)))); + ra_unit_l)))); gnode_list result2 = CONJ_TAC(result1[1]); gnode_list fact = CONJ_TAC(result2[0]); ACCEPT_TAC(fact[0], valid_a); @@ -2832,7 +2832,7 @@ PROOF static thm prove_r_own_valid(void) { return gnode_prove(root); } -PROOF thm R_OWN_VALID = +PROOF thm r_own_valid = prove_r_own_valid(); PROOF static thm prove_r_impl_adjunction(void) { @@ -2911,7 +2911,7 @@ PROOF static thm prove_r_impl_adjunction(void) { return gnode_prove(root); } -PROOF thm R_IMPL_ADJUNCTION = +PROOF thm r_impl_adjunction = prove_r_impl_adjunction(); PROOF static thm prove_r_wand_adjunction(void) { @@ -3030,7 +3030,7 @@ PROOF static thm prove_r_wand_adjunction(void) { `R:(A)ra`, `left:A`, `right:A`), - RA_VALID_OP), + ra_valid_op), valid_pair)); thm wand_left = mp_rule( mp_rule( @@ -3064,7 +3064,7 @@ PROOF static thm prove_r_wand_adjunction(void) { return gnode_prove(root); } -PROOF thm R_WAND_ADJUNCTION = +PROOF thm r_wand_adjunction = prove_r_wand_adjunction(); PROOF static thm prove_r_wand_elim(void) { @@ -3079,7 +3079,7 @@ PROOF static thm prove_r_wand_elim(void) { `r_wand (R:(A)ra) (P:A->bool) (Q:A->bool)`, `P:A->bool`, `Q:A->bool`), - R_WAND_ADJUNCTION); + r_wand_adjunction); ACCEPT_TAC( body, eq_mp_rule( @@ -3088,11 +3088,11 @@ PROOF static thm prove_r_wand_elim(void) { TERM_LIST( `R:(A)ra`, `r_wand (R:(A)ra) (P:A->bool) (Q:A->bool)`), - R_ENTAILS_REFL))); + r_entails_refl))); return gnode_prove(root); } -PROOF thm R_WAND_ELIM = +PROOF thm r_wand_elim = prove_r_wand_elim(); PROOF static thm prove_r_wand_mono(void) { @@ -3114,7 +3114,7 @@ PROOF static thm prove_r_wand_mono(void) { thm valid_frame = conjunct2_rule(mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `resource:A`, `frame:A`), - RA_VALID_OP), + ra_valid_op), assume_rule(` ra_valid (R:(A)ra) @@ -3170,7 +3170,7 @@ PROOF static thm prove_r_wand_mono(void) { return gnode_prove(root); } -PROOF thm R_WAND_MONO = +PROOF thm r_wand_mono = prove_r_wand_mono(); PROOF static thm prove_r_sep_and_forward_r(void) { @@ -3203,16 +3203,16 @@ PROOF static thm prove_r_sep_and_forward_r(void) { (Q:A->bool) (S:A->bool)`, `Q:A->bool`), - R_SEP_MONO), + r_sep_mono), ispecl_rule( TERM_LIST(`R:(A)ra`, `P:A->bool`), - R_ENTAILS_REFL)), + r_entails_refl)), ispecl_rule( TERM_LIST( `R:(A)ra`, `Q:A->bool`, `S:A->bool`), - R_AND_ELIM_L)); + r_and_elim_l)); thm right_projection = mp_rule( mp_rule( ispecl_rule( @@ -3225,16 +3225,16 @@ PROOF static thm prove_r_sep_and_forward_r(void) { (Q:A->bool) (S:A->bool)`, `S:A->bool`), - R_SEP_MONO), + r_sep_mono), ispecl_rule( TERM_LIST(`R:(A)ra`, `P:A->bool`), - R_ENTAILS_REFL)), + r_entails_refl)), ispecl_rule( TERM_LIST( `R:(A)ra`, `Q:A->bool`, `S:A->bool`), - R_AND_ELIM_R)); + r_and_elim_r)); thm result = mp_rule( mp_rule( ispecl_rule( @@ -3246,14 +3246,14 @@ PROOF static thm prove_r_sep_and_forward_r(void) { (r_and R (Q:A->bool) (S:A->bool))`, `r_sep R (P:A->bool) (Q:A->bool)`, `r_sep R (P:A->bool) (S:A->bool)`), - R_AND_INTRO), + r_and_intro), left_projection), right_projection); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm R_SEP_AND_FORWARD_R = +PROOF thm r_sep_and_forward_r = prove_r_sep_and_forward_r(); PROOF static thm prove_r_sep_and_forward_l(void) { @@ -3286,16 +3286,16 @@ PROOF static thm prove_r_sep_and_forward_l(void) { `Q:A->bool`, `P:A->bool`, `P:A->bool`), - R_SEP_MONO), + r_sep_mono), ispecl_rule( TERM_LIST( `R:(A)ra`, `Q:A->bool`, `S:A->bool`), - R_AND_ELIM_L)), + r_and_elim_l)), ispecl_rule( TERM_LIST(`R:(A)ra`, `P:A->bool`), - R_ENTAILS_REFL)); + r_entails_refl)); thm right_projection = mp_rule( mp_rule( ispecl_rule( @@ -3308,16 +3308,16 @@ PROOF static thm prove_r_sep_and_forward_l(void) { `S:A->bool`, `P:A->bool`, `P:A->bool`), - R_SEP_MONO), + r_sep_mono), ispecl_rule( TERM_LIST( `R:(A)ra`, `Q:A->bool`, `S:A->bool`), - R_AND_ELIM_R)), + r_and_elim_r)), ispecl_rule( TERM_LIST(`R:(A)ra`, `P:A->bool`), - R_ENTAILS_REFL)); + r_entails_refl)); thm result = mp_rule( mp_rule( ispecl_rule( @@ -3329,14 +3329,14 @@ PROOF static thm prove_r_sep_and_forward_l(void) { (P:A->bool)`, `r_sep R (Q:A->bool) (P:A->bool)`, `r_sep R (S:A->bool) (P:A->bool)`), - R_AND_INTRO), + r_and_intro), left_projection), right_projection); ACCEPT_TAC(body, result); return gnode_prove(root); } -PROOF thm R_SEP_AND_FORWARD_L = +PROOF thm r_sep_and_forward_l = prove_r_sep_and_forward_l(); PROOF static int audit_resource_prop(void) { @@ -3356,55 +3356,55 @@ PROOF static int audit_resource_prop(void) { r_pure_def, r_fact_def, r_wand_def, - R_ENTAILS_REFL, - R_ENTAILS_TRANS, - R_ENTAILS_POINTWISE, - R_EQUIV_POINTWISE, - R_EQUIV_INTRO, - R_EQUIV_REFL, - R_EQUIV_SYM, - R_EQUIV_TRANS, - R_TOP_INTRO, - R_BOTTOM_ELIM, - R_SEP_ASSOC, - R_SEP_COMM, - R_SEP_EMP_L, - R_SEP_EMP_R, - R_SEP_MONO, - R_SEP_FRAME_L, - R_SEP_FRAME_R, - R_SEP_EXISTS_L, - R_SEP_EXISTS_R, - R_AND_INTRO, - R_AND_ELIM_L, - R_AND_ELIM_R, - R_OR_INTRO_L, - R_OR_INTRO_R, - R_OR_ELIM, - R_EXISTS_INTRO, - R_EXISTS_ELIM, - R_EXISTS_MONO, - R_FORALL_INTRO, - R_FORALL_ELIM, - R_PURE_AND_INTRO, - R_PURE_AND_ELIM, - R_FACT_AS_PURE_AND_EMP, - R_FACT_TRUE, - R_FACT_FALSE, - R_FACT_SEP_L, - R_FACT_SEP_R, - R_FACT_INTRO, - R_FACT_ELIM, - R_FACT_DUP, - R_OWN_UNIT, - R_OWN_OP, - R_OWN_VALID, - R_IMPL_ADJUNCTION, - R_WAND_ADJUNCTION, - R_WAND_ELIM, - R_WAND_MONO, - R_SEP_AND_FORWARD_R, - R_SEP_AND_FORWARD_L); + r_entails_refl, + r_entails_trans, + r_entails_pointwise, + r_equiv_pointwise, + r_equiv_intro, + r_equiv_refl, + r_equiv_sym, + r_equiv_trans, + r_top_intro, + r_bottom_elim, + r_sep_assoc, + r_sep_comm, + r_sep_emp_l, + r_sep_emp_r, + r_sep_mono, + r_sep_frame_l, + r_sep_frame_r, + r_sep_exists_l, + r_sep_exists_r, + r_and_intro, + r_and_elim_l, + r_and_elim_r, + r_or_intro_l, + r_or_intro_r, + r_or_elim, + r_exists_intro, + r_exists_elim, + r_exists_mono, + r_forall_intro, + r_forall_elim, + r_pure_and_intro, + r_pure_and_elim, + r_fact_as_pure_and_emp, + r_fact_true, + r_fact_false, + r_fact_sep_l, + r_fact_sep_r, + r_fact_intro, + r_fact_elim, + r_fact_dup, + r_own_unit, + r_own_op, + r_own_valid, + r_impl_adjunction, + r_wand_adjunction, + r_wand_elim, + r_wand_mono, + r_sep_and_forward_r, + r_sep_and_forward_l); for (size_t i = 0; i < vector_size(public_theorems); ++i) { ENSURE_COND( diff --git a/theory/logic/resource_prop.h b/theory/logic/resource_prop.h index 97ce919..e65f97f 100644 --- a/theory/logic/resource_prop.h +++ b/theory/logic/resource_prop.h @@ -1,17 +1,39 @@ -#pragma once +/** + * @file resource_prop.h + * @brief Linear BI assertions over an arbitrary resource algebra. + * + * For `R:(A)ra`, an assertion is a predicate `A -> bool`. Entailment and + * logical equivalence observe only resources that are valid in `R`: + * + * ```text + * r_entails R P Q <=> forall a. ra_valid R a ==> P a ==> Q a + * r_equiv R P Q <=> r_entails R P Q && r_entails R Q P. + * ``` + * + * This interface deliberately keeps two HOL-proposition embeddings distinct: + * + * - `r_pure R phi a <=> phi` is resource-independent. It is useful in + * additive conjunctions and for carrying non-spatial side conditions. + * - `r_fact R phi a <=> phi && a == ra_unit R` is an exact-unit assertion. + * Use it when a HOL fact is a separating conjunct, including validity and + * predicate-update witnesses. + * + * Public assertion-algebra laws are stated with validity-sensitive `r_equiv`. + * Raw assertion-function equalities are implementation details declared only + * by `resource_prop_internal.h`. + */ -/* Strict linear BI over an arbitrary resource algebra. Assertions are - * predicates on the RA carrier; entailment and equivalence observe valid - * resources only. `r_pure` deliberately remains resource-independent, - * while `r_fact` is the exact-unit embedding used in spatial rules. */ +#pragma once #include "proof/theory/logic/ra.h" -/* Core observation relations. */ +/* ------------------------------------------------------------------------- */ +/* Observation relations and assertion constructors */ +/* ------------------------------------------------------------------------- */ + PROOF extern thm r_entails_def; PROOF extern thm r_equiv_def; -/* Assertion constructors. */ PROOF extern thm r_emp_def; PROOF extern thm r_sep_def; PROOF extern thm r_wand_def; @@ -24,76 +46,80 @@ PROOF extern thm r_impl_def; PROOF extern thm r_exists_def; PROOF extern thm r_forall_def; -/* `r_pure R phi resource <=> phi`. */ +/** Resource-independent embedding: `r_pure R phi resource <=> phi`. */ PROOF extern thm r_pure_def; -/* `r_fact R phi resource <=> phi && resource == ra_unit R`. */ +/** Exact-unit embedding: `r_fact R phi resource <=> phi && resource == ra_unit R`. */ PROOF extern thm r_fact_def; +/* ------------------------------------------------------------------------- */ +/* Entailment, equivalence, and connective laws */ +/* ------------------------------------------------------------------------- */ + /* Entailment and validity-sensitive equivalence. */ -PROOF extern thm R_ENTAILS_REFL; -PROOF extern thm R_ENTAILS_TRANS; -PROOF extern thm R_ENTAILS_POINTWISE; -PROOF extern thm R_EQUIV_POINTWISE; -PROOF extern thm R_EQUIV_INTRO; -PROOF extern thm R_EQUIV_REFL; -PROOF extern thm R_EQUIV_SYM; -PROOF extern thm R_EQUIV_TRANS; +PROOF extern thm r_entails_refl; +PROOF extern thm r_entails_trans; +PROOF extern thm r_entails_pointwise; +PROOF extern thm r_equiv_pointwise; +PROOF extern thm r_equiv_intro; +PROOF extern thm r_equiv_refl; +PROOF extern thm r_equiv_sym; +PROOF extern thm r_equiv_trans; /* Additive truth and falsehood. */ -PROOF extern thm R_TOP_INTRO; -PROOF extern thm R_BOTTOM_ELIM; +PROOF extern thm r_top_intro; +PROOF extern thm r_bottom_elim; /* Separating conjunction. Algebraic laws expose `r_equiv`, never raw * assertion-function equality. */ -PROOF extern thm R_SEP_ASSOC; -PROOF extern thm R_SEP_COMM; -PROOF extern thm R_SEP_EMP_L; -PROOF extern thm R_SEP_EMP_R; -PROOF extern thm R_SEP_MONO; -PROOF extern thm R_SEP_FRAME_L; -PROOF extern thm R_SEP_FRAME_R; -PROOF extern thm R_SEP_EXISTS_L; -PROOF extern thm R_SEP_EXISTS_R; +PROOF extern thm r_sep_assoc; +PROOF extern thm r_sep_comm; +PROOF extern thm r_sep_emp_l; +PROOF extern thm r_sep_emp_r; +PROOF extern thm r_sep_mono; +PROOF extern thm r_sep_frame_l; +PROOF extern thm r_sep_frame_r; +PROOF extern thm r_sep_exists_l; +PROOF extern thm r_sep_exists_r; /* Additive connectives and quantifiers. */ -PROOF extern thm R_IMPL_ADJUNCTION; -PROOF extern thm R_AND_INTRO; -PROOF extern thm R_AND_ELIM_L; -PROOF extern thm R_AND_ELIM_R; -PROOF extern thm R_OR_INTRO_L; -PROOF extern thm R_OR_INTRO_R; -PROOF extern thm R_OR_ELIM; -PROOF extern thm R_EXISTS_INTRO; -PROOF extern thm R_EXISTS_ELIM; -PROOF extern thm R_EXISTS_MONO; -PROOF extern thm R_FORALL_INTRO; -PROOF extern thm R_FORALL_ELIM; +PROOF extern thm r_impl_adjunction; +PROOF extern thm r_and_intro; +PROOF extern thm r_and_elim_l; +PROOF extern thm r_and_elim_r; +PROOF extern thm r_or_intro_l; +PROOF extern thm r_or_intro_r; +PROOF extern thm r_or_elim; +PROOF extern thm r_exists_intro; +PROOF extern thm r_exists_elim; +PROOF extern thm r_exists_mono; +PROOF extern thm r_forall_intro; +PROOF extern thm r_forall_elim; /* Magic wand. */ -PROOF extern thm R_WAND_ADJUNCTION; -PROOF extern thm R_WAND_ELIM; -PROOF extern thm R_WAND_MONO; - -/* Resource-independent pure propositions. */ -PROOF extern thm R_PURE_AND_INTRO; -PROOF extern thm R_PURE_AND_ELIM; - -/* Exact-unit facts. Equational laws below are `r_equiv` statements. */ -PROOF extern thm R_FACT_AS_PURE_AND_EMP; -PROOF extern thm R_FACT_TRUE; -PROOF extern thm R_FACT_FALSE; -PROOF extern thm R_FACT_SEP_L; -PROOF extern thm R_FACT_SEP_R; -PROOF extern thm R_FACT_INTRO; -PROOF extern thm R_FACT_ELIM; -PROOF extern thm R_FACT_DUP; - -/* Exact ownership. */ -PROOF extern thm R_OWN_UNIT; -PROOF extern thm R_OWN_OP; -PROOF extern thm R_OWN_VALID; - -/* Sound one-way distribution through additive conjunction. */ -PROOF extern thm R_SEP_AND_FORWARD_R; -PROOF extern thm R_SEP_AND_FORWARD_L; +PROOF extern thm r_wand_adjunction; +PROOF extern thm r_wand_elim; +PROOF extern thm r_wand_mono; + +/* Resource-independent pure propositions, combined additively with `r_and`. */ +PROOF extern thm r_pure_and_intro; +PROOF extern thm r_pure_and_elim; + +/* Exact-unit facts. The normalization laws below are `r_equiv` statements. */ +PROOF extern thm r_fact_as_pure_and_emp; +PROOF extern thm r_fact_true; +PROOF extern thm r_fact_false; +PROOF extern thm r_fact_sep_l; +PROOF extern thm r_fact_sep_r; +PROOF extern thm r_fact_intro; +PROOF extern thm r_fact_elim; +PROOF extern thm r_fact_dup; + +/* Exact ownership. `r_own_valid` returns validity as a spatial `r_fact`. */ +PROOF extern thm r_own_unit; +PROOF extern thm r_own_op; +PROOF extern thm r_own_valid; + +/* Sound one-way distribution of `r_sep` through additive conjunction. */ +PROOF extern thm r_sep_and_forward_r; +PROOF extern thm r_sep_and_forward_l; diff --git a/theory/logic/resource_prop_internal.h b/theory/logic/resource_prop_internal.h index 3ac6e20..bd4bb76 100644 --- a/theory/logic/resource_prop_internal.h +++ b/theory/logic/resource_prop_internal.h @@ -1,28 +1,36 @@ -#pragma once - -/* - * Raw assertion-function equalities used by logic implementations and - * adapters. Client proofs should include resource_prop.h and use the public - * validity-sensitive `r_equiv` laws instead. +/** + * @file resource_prop_internal.h + * @brief Implementation-only theorem shapes for the resource logic. + * + * Most declarations below are raw assertion-function equalities used for + * rewriting inside logic implementations and adapters. Client proofs should + * include `resource_prop.h` and use its validity-sensitive `r_equiv` laws. + * This header is not a stable proof API and must not be re-exported by an + * umbrella client header. */ +#pragma once + #include "proof/theory/logic/resource_prop.h" -PROOF extern thm R_SEP_COMM_EQ; -PROOF extern thm R_SEP_EMP_L_EQ; -PROOF extern thm R_SEP_EMP_R_EQ; -PROOF extern thm R_SEP_ASSOC_EQ; -PROOF extern thm R_SEP_EXISTS_L_EQ; -PROOF extern thm R_SEP_EXISTS_R_EQ; +/* Raw equality normalizations for separating conjunction. */ +PROOF extern thm r_sep_comm_eq; +PROOF extern thm r_sep_emp_l_eq; +PROOF extern thm r_sep_emp_r_eq; +PROOF extern thm r_sep_assoc_eq; +PROOF extern thm r_sep_exists_l_eq; +PROOF extern thm r_sep_exists_r_eq; -/* Adapter schema derived from the public projection-style R_FORALL_ELIM. */ -PROOF extern thm R_FORALL_ELIM_CONT; +/* Adapter-only continuation schema derived from public `r_forall_elim`. */ +PROOF extern thm r_forall_elim_cont; -PROOF extern thm R_FACT_AS_PURE_AND_EMP_EQ; -PROOF extern thm R_FACT_TRUE_EQ; -PROOF extern thm R_FACT_FALSE_EQ; -PROOF extern thm R_FACT_SEP_L_EQ; -PROOF extern thm R_FACT_SEP_R_EQ; +/* Raw equality normalizations for exact-unit facts. */ +PROOF extern thm r_fact_as_pure_and_emp_eq; +PROOF extern thm r_fact_true_eq; +PROOF extern thm r_fact_false_eq; +PROOF extern thm r_fact_sep_l_eq; +PROOF extern thm r_fact_sep_r_eq; -PROOF extern thm R_OWN_UNIT_EQ; -PROOF extern thm R_OWN_OP_EQ; +/* Raw equality normalizations for exact ownership. */ +PROOF extern thm r_own_unit_eq; +PROOF extern thm r_own_op_eq; diff --git a/theory/logic/unit_ra.c b/theory/logic/unit_ra.c index dd56c88..5f9d3e2 100644 --- a/theory/logic/unit_ra.c +++ b/theory/logic/unit_ra.c @@ -58,7 +58,7 @@ PROOF static thm prove_unit_ra_laws(void) { return gnode_prove(root); } -PROOF static thm UNIT_RA_LAWS = prove_unit_ra_laws(); +PROOF static thm unit_ra_laws = prove_unit_ra_laws(); PROOF static thm unit_ra_def = new_fun_definition(` unit_ra : (1)ra = @@ -72,14 +72,14 @@ PROOF static thm prove_unit_ra_unit(void) { `one:1`, `unit_ra_op:1->1->1`, `unit_ra_valid:1->bool`), - RA_UNIT_ABS), - UNIT_RA_LAWS); + ra_unit_abs), + unit_ra_laws); return pure_once_rewrite_rule( THM_LIST(gsym_rule(unit_ra_def)), computed); } -PROOF thm UNIT_RA_UNIT = prove_unit_ra_unit(); +PROOF thm unit_ra_unit = prove_unit_ra_unit(); PROOF static thm prove_unit_ra_op_fn(void) { thm computed = mp_rule( @@ -88,14 +88,14 @@ PROOF static thm prove_unit_ra_op_fn(void) { `one:1`, `unit_ra_op:1->1->1`, `unit_ra_valid:1->bool`), - RA_OP_ABS), - UNIT_RA_LAWS); + ra_op_abs), + unit_ra_laws); return pure_once_rewrite_rule( THM_LIST(gsym_rule(unit_ra_def)), computed); } -PROOF static thm UNIT_RA_OP_FN = prove_unit_ra_op_fn(); +PROOF static thm unit_ra_op_fn = prove_unit_ra_op_fn(); PROOF static thm prove_unit_ra_valid_fn(void) { thm computed = mp_rule( @@ -104,14 +104,14 @@ PROOF static thm prove_unit_ra_valid_fn(void) { `one:1`, `unit_ra_op:1->1->1`, `unit_ra_valid:1->bool`), - RA_VALID_ABS), - UNIT_RA_LAWS); + ra_valid_abs), + unit_ra_laws); return pure_once_rewrite_rule( THM_LIST(gsym_rule(unit_ra_def)), computed); } -PROOF static thm UNIT_RA_VALID_FN = prove_unit_ra_valid_fn(); +PROOF static thm unit_ra_valid_fn = prove_unit_ra_valid_fn(); PROOF static thm prove_unit_ra_op(void) { term goal_tm = ` @@ -121,12 +121,12 @@ PROOF static thm prove_unit_ra_op(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - UNIT_RA_OP_FN, + unit_ra_op_fn, unit_ra_op_def))); return gnode_prove(root); } -PROOF thm UNIT_RA_OP = prove_unit_ra_op(); +PROOF thm unit_ra_op = prove_unit_ra_op(); PROOF static thm prove_unit_ra_valid(void) { term goal_tm = ` @@ -136,12 +136,12 @@ PROOF static thm prove_unit_ra_valid(void) { CONV_TAC( root, rewrite_conv(THM_LIST( - UNIT_RA_VALID_FN, + unit_ra_valid_fn, unit_ra_valid_def))); return gnode_prove(root); } -PROOF thm UNIT_RA_VALID = prove_unit_ra_valid(); +PROOF thm unit_ra_valid = prove_unit_ra_valid(); /* The unique carrier value extends to the unique carrier value. */ PROOF static thm prove_unit_ra_included(void) { @@ -159,14 +159,14 @@ PROOF static thm prove_unit_ra_included(void) { get_theorem_by_name("one")); thm extension_is_one = ispecl_rule( TERM_LIST(`a:1`, `one:1`), - UNIT_RA_OP); + unit_ra_op); ACCEPT_TAC( body, trans_rule(b_is_one, gsym_rule(extension_is_one))); return gnode_prove(root); } -PROOF thm UNIT_RA_INCLUDED = prove_unit_ra_included(); +PROOF thm unit_ra_included = prove_unit_ra_included(); /* Every frame in the singleton carrier is the RA unit. */ PROOF static thm prove_unit_ra_exclusive(void) { @@ -181,7 +181,7 @@ PROOF static thm prove_unit_ra_exclusive(void) { gnode_list exclusive = CONJ_TAC(body); ACCEPT_TAC( exclusive[0], - ispec_rule(`a:1`, UNIT_RA_VALID)); + ispec_rule(`a:1`, unit_ra_valid)); body = GEN_TAC(exclusive[1], "frame"); body = DISCH_TAC(body, "Hcompatible"); thm frame_is_one = spec_rule( @@ -189,11 +189,11 @@ PROOF static thm prove_unit_ra_exclusive(void) { get_theorem_by_name("one")); ACCEPT_TAC( body, - trans_rule(frame_is_one, gsym_rule(UNIT_RA_UNIT))); + trans_rule(frame_is_one, gsym_rule(unit_ra_unit))); return gnode_prove(root); } -PROOF thm UNIT_RA_EXCLUSIVE = +PROOF thm unit_ra_exclusive = prove_unit_ra_exclusive(); /* Predicate update has exactly one possible result, namely `one`. */ @@ -223,7 +223,7 @@ PROOF static thm prove_unit_ra_updateP_iff(void) { selected, ispec_rule( `ra_op unit_ra (a:1) (one:1)`, - UNIT_RA_VALID)); + unit_ra_valid)); forward = ASSUME_TAC(forward, selected, "Hselected"); forward = ASMP_EXISTS_TAC(forward, "Hselected", "b"); thm predicate = conjunct1_rule(assume_rule(` @@ -249,11 +249,11 @@ PROOF static thm prove_unit_ra_updateP_iff(void) { result[1], ispec_rule( `ra_op unit_ra (one:1) (frame:1)`, - UNIT_RA_VALID)); + unit_ra_valid)); return gnode_prove(root); } -PROOF thm UNIT_RA_UPDATEP_IFF = +PROOF thm unit_ra_updateP_iff = prove_unit_ra_updateP_iff(); /* Local-update obligations normalize completely in the singleton carrier. */ @@ -270,37 +270,37 @@ PROOF static thm prove_unit_ra_local_update(void) { gnode_list result = CONJ_TAC(body); ACCEPT_TAC( result[0], - ispec_rule(`b:1`, UNIT_RA_VALID)); + ispec_rule(`b:1`, unit_ra_valid)); thm target_is_one = spec_rule( `b:1`, get_theorem_by_name("one")); thm extension_is_one = ispecl_rule( TERM_LIST(`g:1`, `residual:1`), - UNIT_RA_OP); + unit_ra_op); ACCEPT_TAC( result[1], trans_rule(target_is_one, gsym_rule(extension_is_one))); return gnode_prove(root); } -PROOF thm UNIT_RA_LOCAL_UPDATE = +PROOF thm unit_ra_local_update = prove_unit_ra_local_update(); PROOF static int audit_unit_ra(void) { thm_list audited_theorems = THM_LIST( unit_ra_op_def, unit_ra_valid_def, - UNIT_RA_LAWS, + unit_ra_laws, unit_ra_def, - UNIT_RA_UNIT, - UNIT_RA_OP_FN, - UNIT_RA_VALID_FN, - UNIT_RA_OP, - UNIT_RA_VALID, - UNIT_RA_INCLUDED, - UNIT_RA_EXCLUSIVE, - UNIT_RA_UPDATEP_IFF, - UNIT_RA_LOCAL_UPDATE); + unit_ra_unit, + unit_ra_op_fn, + unit_ra_valid_fn, + unit_ra_op, + unit_ra_valid, + unit_ra_included, + unit_ra_exclusive, + unit_ra_updateP_iff, + unit_ra_local_update); for (size_t i = 0; i < vector_size(audited_theorems); ++i) { ENSURE_COND(!IS_NULL(audited_theorems[i]), diff --git a/theory/logic/unit_ra.h b/theory/logic/unit_ra.h index d5ac9d5..c7830c2 100644 --- a/theory/logic/unit_ra.h +++ b/theory/logic/unit_ra.h @@ -1,26 +1,37 @@ #pragma once -/* Singleton resource algebra. This is the complete v2 client interface. */ +/* + * Public interface for the singleton resource algebra on HOL type `1`. + * Its only carrier value, `one`, is the unit and is always valid. + */ #include "proof/theory/logic/local_update.h" +/* ------------------------------------------------------------------------- */ +/* Algebra and validity */ +/* ------------------------------------------------------------------------- */ + /* `ra_unit unit_ra == (one:1)`. */ -PROOF extern thm UNIT_RA_UNIT; +PROOF extern thm unit_ra_unit; /* `forall a b:1. ra_op unit_ra a b == one`. */ -PROOF extern thm UNIT_RA_OP; +PROOF extern thm unit_ra_op; /* `forall a:1. ra_valid unit_ra a`. */ -PROOF extern thm UNIT_RA_VALID; +PROOF extern thm unit_ra_valid; /* `forall a b:1. ra_included unit_ra a b`. */ -PROOF extern thm UNIT_RA_INCLUDED; +PROOF extern thm unit_ra_included; /* `forall a:1. ra_exclusive unit_ra a`. */ -PROOF extern thm UNIT_RA_EXCLUSIVE; +PROOF extern thm unit_ra_exclusive; + +/* ------------------------------------------------------------------------- */ +/* Updates */ +/* ------------------------------------------------------------------------- */ /* `forall (a:1) (P:1->bool). ra_updateP unit_ra a P <=> P one`. */ -PROOF extern thm UNIT_RA_UPDATEP_IFF; +PROOF extern thm unit_ra_updateP_iff; /* `forall a f b g:1. ra_local_update unit_ra a f b g`. */ -PROOF extern thm UNIT_RA_LOCAL_UPDATE; +PROOF extern thm unit_ra_local_update; -- Gitee From 69d4d1217844418c76f284e132f25a971dfc252e Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Mon, 10 Aug 2026 20:45:49 +0800 Subject: [PATCH 31/35] Rename frame-maximal RA property Document the complete RA/SL theorem surface and distinguish frame-maximality from self-conflict exclusivity. --- docs/RA_SL_THEOREM_GUIDE.md | 801 ++++++++++++++++++++++++ docs/RA_SL_THEORY_SUMMARY.md | 26 +- test/basic_ra_constructors_regression.c | 22 +- test/dependency_v2_regression.sh | 18 +- test/ra_core_regression.c | 58 +- test/value_ra_constructors_regression.c | 6 +- theory/logic/agree_ra.c | 20 +- theory/logic/auth_ra.c | 8 +- theory/logic/excl_ra.c | 50 +- theory/logic/excl_ra.h | 6 +- theory/logic/frac_ra.c | 28 +- theory/logic/frac_ra.h | 6 +- theory/logic/local_update.c | 20 +- theory/logic/local_update.h | 4 +- theory/logic/max_nat_ra.c | 24 +- theory/logic/prod_ra.c | 149 +++-- theory/logic/prod_ra.h | 4 +- theory/logic/ra.c | 87 +-- theory/logic/ra.h | 17 +- theory/logic/ra_internal.h | 8 +- theory/logic/unit_ra.c | 18 +- theory/logic/unit_ra.h | 4 +- 22 files changed, 1105 insertions(+), 279 deletions(-) create mode 100644 docs/RA_SL_THEOREM_GUIDE.md diff --git a/docs/RA_SL_THEOREM_GUIDE.md b/docs/RA_SL_THEOREM_GUIDE.md new file mode 100644 index 0000000..6bceb39 --- /dev/null +++ b/docs/RA_SL_THEOREM_GUIDE.md @@ -0,0 +1,801 @@ +# C* RA / SL theorem guide：逐文件内容与直觉 + +本文按源码文件说明 C* RA / separation logic v2 的 theorem surface：每个模块 +证明什么、这些结论表达什么资源直觉，以及通常怎样组合使用。总体设计、形式化 +定义和依赖图见 [`RA_SL_THEORY_SUMMARY.md`](RA_SL_THEORY_SUMMARY.md)；本文更偏向 +“拿到一个 theorem handle 后该如何理解它”。 + +## 1. 阅读约定 + +- `foo.h` 是稳定 public surface；同名 `foo.c` 定义 HOL constant、完成证明并审计 + “无新增 axiom”。因此下面通常把 `.h/.c` 作为一个模块说明。 +- `*_internal.h` 只服务于 theory implementation 或 adapter，不是 client API。 +- `_def` 通常是定义展开；`_iff` 是精确刻画；`intro`/`elim` 是引入/消去； + `mono`/`frame`/`trans` 分别表示单调、保 frame、传递组合。 +- theorem handles 使用 `lower_snake_case`。若 handle 嵌入本来就带大写的 + object-language constant，则保留该片段，例如 `ra_updateP_refl`、 + `pmem_c_address_ok_Tuint64`。 +- 记 `e = ra_unit R`、`a · b = ra_op R a b`、`✓a = ra_valid R a`。 +- `P ⊢ Q` 表示 validity-sensitive entailment，`P ≡ Q` 表示双向 entailment； + assertion algebra 的 public laws 使用 `r_equiv`，不把 raw predicate equality + 暴露给普通 client。 + +推荐阅读顺序是：`ra` → 一个具体 RA instance → `resource_prop` → +`basic_update`/`product_resource` → `c_resource`/`c_ghost`。只有实现新 RA +constructor 时才需要 `ra_builder` 与各 internal header。 + +## 2. RA 核心 + +### 2.1 `theory/logic/ra.h` / `ra.c` + +文件：[`ra.h`](../theory/logic/ra.h)、[`ra.c`](../theory/logic/ra.c) + +这是所有模块的语义根。`(A)ra` 是 lawful 的交换幺半群加 downward-closed +validity；`ra_updateP` 是 primitive frame-preserving update，结果可依赖未知 +frame；`ra_update` 只是 singleton result 的特化。 + +| theorem 族 | handles | 内容与直觉 | +| --- | --- | --- | +| 派生关系 | `ra_compatible_def`, `ra_included_def`, `ra_updateP_def`, `ra_update_def`, `ra_cancellative_def`, `ra_maximal_def` | compatibility 是“合起来仍 valid”；inclusion 是“补一个 frame 得到整体”；update 要对每个兼容隐藏 frame 找到仍兼容的结果；maximal 还显式要求 source valid，避免 invalid-source vacuity。 | +| RA 固有律 | `ra_laws`, `ra_assoc`, `ra_comm`, `ra_unit_l`, `ra_unit_r`, `ra_valid_unit`, `ra_valid_op` | ownership composition 可重排、unit 不携带资源；整体 valid 时每个 fragment 都 valid。 | +| compatibility / inclusion | `ra_compat_comm`, `ra_compat_unit`, `ra_included_refl`, `ra_included_unit`, `ra_included_op_l`, `ra_included_op_r`, `ra_included_trans`, `ra_included_op_mono`, `ra_included_valid` | inclusion 是以 unit 为底的 preorder；组合对 inclusion 单调；validity 可从整体向 fragment 下传。 | +| predicate update | `ra_updateP_singleton`, `ra_updateP_refl`, `ra_updateP_mono`, `ra_updateP_trans`, `ra_updateP_valid`, `ra_updateP_frame`, `ra_updateP_op` | `updateP` 可弱化 postcondition、Kleisli 式串接、显式加 frame，也可把两个独立更新逐点组合。valid source 至少给出一个 valid witness。 | +| deterministic update | `ra_update_refl`, `ra_update_trans`, `ra_update_frame`, `ra_update_op`, `ra_update_included`, `ra_update_target_included`, `ra_update_valid` | 确定更新继承 reflexive/transitive/frame 结构；丢掉当前 fragment 的一部分总是安全，target 还可继续向 included part 弱化。 | +| 可选性质 | `ra_maximal_included`, `ra_maximal_update`, `ra_cancellative_apply` | maximal source 没有非平凡 valid extension，因而可替换为任意 valid target；cancellative RA 可取消公共 fragment。 | + +`ra_maximal R a` 表达的是强 frame-maximality：`a` 本身 valid，且任何与 +`a` 组合后仍 valid 的 frame 都必须精确等于 RA unit。它不等同于 +“`a · a` invalid”这类 self-conflict exclusive 性质；后者目前尚未在核心 +RA API 中定义。`excl_ra` 仍保留 exclusive-token 构造器语义，因为两个 +owned `Excl` token 的组合确实冲突；其 owned 元素同时还满足 `ra_maximal`。 + +最常见的证明路径是：先用 instance theorem 得到 `ra_update` 或 `ra_updateP`， +再用 `ra_update_frame`/`ra_updateP_frame` 放回显式资源，最后由 ownership theorem +提升到 view shift。 + +### 2.2 `theory/logic/ra_builder.h` + +文件：[`ra_builder.h`](../theory/logic/ra_builder.h) + +这是 constructor-author API，不是普通 RA client API。 + +| handles | 内容与直觉 | +| --- | --- | +| `ra_laws_def` | 展开 raw descriptor 需要满足的 associativity、commutativity、left unit、unit validity 与 validity projection。 | +| `ra_type_bijection`, `ra_rep_laws`, `ra_abs_rep`, `ra_abs_eta` | 在 lawful raw triple 与抽象 `(A)ra` 之间安全往返；抽象类型保证 client 不必重复携带 laws premise。 | +| `ra_unit_abs`, `ra_op_abs`, `ra_valid_abs` | 新 constructor 证明 raw laws 后，用这些 computation rules 得到其 unit/op/valid 公理化接口。 | + +直观上，`ra_builder` 是“封装证明一次，之后把结构当成合法 RA 使用”的边界。 + +### 2.3 `theory/logic/ra_internal.h` + +文件：[`ra_internal.h`](../theory/logic/ra_internal.h) + +实现层便捷规则包括： + +- operation/validity normalization：`ra_op_swap_right`、`ra_valid_op_l`、 + `ra_valid_op_r`； +- 直接应用 relation：`ra_maximal_apply`、`ra_update_apply`、 + `ra_updateP_apply`； +- inclusion/cancellation：`ra_included_op_mono_l`、`ra_included_op_mono_r`、 + `ra_included_valid_frame`、`ra_included_cancel_l`、 + `ra_maximal_valid_op_iff`； +- update bridge：`ra_updateP_of_update`、`ra_update_unit`。 + +这些 theorem 主要用于 constructor proof 中消除定义展开和 frame bookkeeping。 +例如 `ra_update_unit` 解释了为何“丢掉当前 fragment”在 frame-preserving 语义下 +总是可行，但普通 client 应使用更有语义的 instance-level `drop` theorem。 + +### 2.4 `theory/logic/local_update.h` / `local_update.c` + +文件：[`local_update.h`](../theory/logic/local_update.h)、 +[`local_update.c`](../theory/logic/local_update.c) + +五参数关系 `ra_local_update R a f b g` 表示：已知 whole/local decomposition +`a = f · residual` 时，在保持同一个未知 residual 的前提下，把 `(a,f)` 同步变成 +`(b,g)`。 + +| handles | 内容与直觉 | +| --- | --- | +| `ra_local_update_def`, `ra_local_update_apply` | 展开关系并应用到一个具体 residual。与普通 update 相比，它同时记录 whole 和当前可见 fragment。 | +| `ra_local_update_refl`, `ra_local_update_trans`, `ra_local_update_frame` | local update 可组合，并允许在两侧 local fragment 上加同一个显式 extra。 | +| `ra_local_update_preserves_included` | 在外部 fragment 存在时仍保持 target validity/inclusion，是 auth 与 gmap lifting 的关键桥。 | +| `ra_local_update_alloc` | 把一个 piece 同时加入 whole 与 visible local ownership；不是凭空复制，而是更新 decomposition。 | +| `ra_local_update_maximal` | visible fragment 已是强 frame-maximal source 时，可同步替换为 valid target。 | +| `ra_local_update_cancel`, `ra_local_update_cancellative` | 前者消去 whole/local 共有前缀；后者在 cancellative RA 中同步已知 residual。 | + +## 3. 基础 RA constructors + +### 3.1 `unit_ra.h` / `unit_ra.c` + +文件：[`unit_ra.h`](../theory/logic/unit_ra.h)、 +[`unit_ra.c`](../theory/logic/unit_ra.c) + +`unit_ra` 只有 `one`，没有可区分的资源状态。 + +- `unit_ra_unit`, `unit_ra_op`, `unit_ra_valid`, `unit_ra_included` 完全刻画其 + algebra； +- `unit_ra_maximal` 说明唯一元素的唯一 compatible frame 也是 unit； +- `unit_ra_updateP_iff` 把 predicate update 化为 `P one`； +- `unit_ra_local_update` 说明任意四个 singleton carrier 值都满足 local update。 + +直觉：它是“无 ghost information”的 payload，也常作为默认 named cell payload。 + +### 3.2 `prod_ra.h` / `prod_ra.c` + +文件：[`prod_ra.h`](../theory/logic/prod_ra.h)、 +[`prod_ra.c`](../theory/logic/prod_ra.c)、 +[`prod_ra_internal.h`](../theory/logic/prod_ra_internal.h) + +产品 RA 把两个独立资源坐标并排组合。 + +| handles | 内容与直觉 | +| --- | --- | +| `prod_ra_unit`, `prod_ra_op`, `prod_ra_valid`, `prod_ra_included` | unit/op/valid/inclusion 全部逐坐标计算。 | +| `prod_ra_cancellative_iff`, `prod_ra_maximal_iff` | 产品具有 cancellativity/maximality，当且仅当两个坐标分别具有相应性质。 | +| `prod_ra_updateP`, `prod_ra_update_left`, `prod_ra_update_right`, `prod_ra_local_update` | 两边 predicate update 可配对；确定更新可只改一个坐标；local update 也逐坐标 lifting。 | +| `prod_inl_def`, `prod_inr_def`, `prod_inl_op`, `prod_inr_op` | `inl`/`inr` 用另一坐标的 unit 嵌入一个 component，并保持 composition。 | +| `prod_inl_updateP`, `prod_inr_updateP`, `prod_inl_update`, `prod_inr_update` | component update 可提升为 exact one-sided product update。 | + +`prod_ra_internal.h` 的 `prod_ra_cancellative` 是 implementation eliminator；普通 +client 使用 public 的 iff characterization。 + +### 3.3 `option_ra.h` / `option_ra.c` + +文件：[`option_ra.h`](../theory/logic/option_ra.h)、 +[`option_ra.c`](../theory/logic/option_ra.c)、 +[`option_ra_internal.h`](../theory/logic/option_ra_internal.h) + +`option_ra R` 给 base RA 增加一个真正的 empty `NONE`；`SOME a` 表示存在的 +resource。 + +- unit/op/valid：`option_ra_unit`、`option_ra_op_none_l`、 + `option_ra_op_some_some`、`option_ra_valid_none`、`option_ra_valid_some`； +- inclusion/disjointness：`option_ra_included_none`、 + `option_ra_included_some_some`、`option_ra_not_included_some_none`、 + `option_ra_some_unit_ne_none`； +- structural property：`option_ra_not_cancellative`，因为新增 empty 会让 + `NONE` 与 `SOME (ra_unit R)` 在 composition 行为上产生不可取消情形； +- update/local update：`option_ra_updateP_iff`、`option_ra_update_iff`、 + `option_ra_local_update_iff` 把 exact `SOME` image 上的结论回落到 base RA。 + +internal 的 `option_ra_op_none_r`、`option_ra_update`、`option_ra_updateP` 是 +单向 normalization/lifting helper，不扩大 public 契约。 + +### 3.4 `excl_ra.h` / `excl_ra.c` + +文件：[`excl_ra.h`](../theory/logic/excl_ra.h)、 +[`excl_ra.c`](../theory/logic/excl_ra.c)、 +[`excl_ra_internal.h`](../theory/logic/excl_ra_internal.h) + +`excl_ra`（exclusive-token RA）表示“最多一个有效 owner”。 + +- `excl_ra_unit`, `excl_ra_owned_conflict`, `excl_ra_valid_unit`、 + `excl_ra_valid_owned`, `excl_ra_invalid` 描述 constructors 与冲突； +- `excl_ra_included_owned`, `excl_ra_maximal`, `excl_ra_cancellative` + 给出 ownership 的 inclusion、强 frame-maximality 与 cancellation；owned + token 的 self-conflict 直觉则由 `excl_ra_owned_conflict` 给出； +- `excl_ra_update_owned_iff` 说明 valid owned source 可更新到任意 valid + target；`excl_ra_local_update_iff` 给出对应 local-update characterization。 + +`excl_ra_internal.h` 公开给实现的 raw datatype/computation handles 是 +`excl_owned_op_def`、`excl_op_def`、`excl_owned_ne_unit`、 +`excl_invalid_ne_unit`、`excl_ra_op_fn`、`excl_ra_update`。直觉上这些是证明 +constructor cases 的 rewrite facts，而不是协议层规则。 + +### 3.5 `agree_ra.h` / `agree_ra.c` + +文件：[`agree_ra.h`](../theory/logic/agree_ra.h)、 +[`agree_ra.c`](../theory/logic/agree_ra.c) + +agreement RA 允许多个 fragment 共享同一值，但不同值组合即 invalid。 + +| handles | 内容与直觉 | +| --- | --- | +| `agree_ra_unit`, `agree_ra_owned_op`, `agree_ra_idempotent` | 相同 payload ownership 可幂等合并；这支持只读知识的复制式共享。 | +| `agree_ra_valid_unit`, `agree_ra_valid_owned`, `agree_ra_invalid`, `agree_ra_valid_combine_iff` | 单个 owned 总 valid；组合 valid 当且仅当所有可见 payload 一致。 | +| `agree_ra_agreement`, `agree_ra_included_owned` | 从 valid composition 提取 payload equality；owned inclusion 也强制 agreement。 | +| `agree_ra_not_cancellative` | 幂等使 cancellation 失败：`x·x=x` 无法反推出被取消部分。 | +| `agree_ra_update_iff`, `agree_ra_local_update_iff` | 只允许保持已建立的 agreement；不能 frame-preservingly 改成不同 payload。 | + +### 3.6 `max_nat_ra.h` / `max_nat_ra.c` + +文件：[`max_nat_ra.h`](../theory/logic/max_nat_ra.h)、 +[`max_nat_ra.c`](../theory/logic/max_nat_ra.c) + +handles `max_nat_ra_unit`、`max_nat_ra_op`、`max_nat_ra_valid`、 +`max_nat_ra_included`、`max_nat_ra_idempotent`、`max_nat_ra_update` 说明：unit 是 +`0`，composition 是 `MAX`，所有自然数 valid，inclusion 就是 `<=`，operation +幂等，而且任意确定 target 都是 frame-preserving update。 + +直觉：未知 frame 只会把值提高；替换 source 为任意 target 后，与同一 frame 取 +`MAX` 仍 valid，所以 update 没有额外 validity 障碍。协议通常另外施加单调状态机 +约束，而不是依赖 RA update 本身限制方向。 + +### 3.7 `frac_ra.h` / `frac_ra.c` + +文件：[`frac_ra.h`](../theory/logic/frac_ra.h)、 +[`frac_ra.c`](../theory/logic/frac_ra.c) + +fraction RA 同时记录 share 与 payload RA。 + +- constructors/composition：`frac_ra_unit`、`frac_ra_full`、 + `frac_ra_own_op`；positive shares 相加，payload 以 base `ra_op` 合并； +- validity/maximality：`frac_ra_valid_own` 要求 `0 < p <= 1` 且 payload valid， + `frac_ra_maximal_full` 说明 full share 已占满容量，因而任何 compatible + frame 都只能是 unit； +- updates：`frac_ra_update_weaken`、`frac_ra_updateP_weaken` 可在 base payload + update 的同时减小 share；`frac_ra_update_full_iff` 精确说明 full-to-full update + 只需保证 valid source 蕴含 valid target。 + +直觉：fraction 控制“还能否与隐藏 share 共存”，payload RA 控制“内容能否与隐藏 +payload 共存”。full share 排除了任何 positive hidden share，因此更新最自由。 +`frac_ra_update_full_iff` 在 invalid source 上仍按 update 定义产生 vacuous implication； +这不是一个额外的 invalid-source public shortcut，也不表示该 source 可被合法拥有。 + +## 4. Finite map、naming 与 authoritative state + +### 4.1 `finmap.h` / `finmap.c` + +文件：[`finmap.h`](../theory/logic/finmap.h)、 +[`finmap.c`](../theory/logic/finmap.c) + +这不是 RA，而是 `gmap_ra` 的 finite-support map 基础。 + +| theorem 族 | handles | 内容与直觉 | +| --- | --- | --- | +| representation | `finmap_finite_def`, `finmap_type_bijection`, `finmap_rep_finite`, `finmap_eq` | 把 abstract finite map 与 finite-support function 对接；map equality 归结为逐 key lookup。 | +| constructors | `finmap_empty_def`, `finmap_lookup_def`, `finmap_singleton_def`, `finmap_insert_def`, `finmap_delete_def`, `finmap_dom_def` | 定义 empty/lookup/singleton/insert/delete/domain。 | +| representation equations | `finmap_empty_rep`, `finmap_singleton_support`, `finmap_singleton_rep`, `finmap_insert_support`, `finmap_insert_rep`, `finmap_delete_support`, `finmap_delete_rep` | 实现证明使用的 support/function computation。 | +| lookup equations | `finmap_empty_lookup`, `finmap_singleton_lookup`, `finmap_insert_lookup`, `finmap_insert_lookup_eq`, `finmap_insert_lookup_ne`, `finmap_delete_lookup`, `finmap_delete_lookup_eq`, `finmap_delete_lookup_ne`, `finmap_eq_lookup` | 读写同 key 命中，不同 key 不受影响；逐点相同即可判 map 相同。 | +| algebra of edits | `finmap_insert_empty`, `finmap_delete_empty`, `finmap_insert_overwrite`, `finmap_insert_comm`, `finmap_delete_idempotent`, `finmap_delete_comm`, `finmap_delete_insert`, `finmap_delete_insert_ne`, `finmap_insert_delete`, `finmap_insert_id`, `finmap_delete_id`, `finmap_decompose` | insert/delete 的覆盖、交换、幂等与 decomposition 规则。 | +| finite domain | `finmap_dom_finite`, `finmap_dom_empty`, `finmap_dom_singleton`, `finmap_in_dom`, `finmap_in_dom_some`, `finmap_not_in_dom`, `finmap_dom_eq_empty`, `finmap_dom_insert`, `finmap_dom_delete` | domain 精确对应 lookup 非 `NONE`，且始终 finite。 | +| freshness | `finmap_fresh_in`, `finmap_fresh_in_pair`, `finmap_fresh`, `finmap_fresh_pair` | 从 infinite candidate/key type 中避开 finite domain，必要时同时满足两个 map 的 freshness。 | +| induction | `finmap_induct` | 以 empty 与 fresh insert 为归纳结构，适合证明 pointwise map algebra。 | + +### 4.2 `gmap_ra.h` / `gmap_ra.c` + +文件：[`gmap_ra.h`](../theory/logic/gmap_ra.h)、 +[`gmap_ra.c`](../theory/logic/gmap_ra.c)、 +[`gmap_ra_internal.h`](../theory/logic/gmap_ra_internal.h) + +`gmap_ra R` 在每个 key 上做 option/base RA composition，并保持 finite support。 + +| handles | 内容与直觉 | +| --- | --- | +| `gmap_ra_unit`, `gmap_ra_op_lookup` | unit 是 empty map；composition 在每个 key 上 pointwise 计算。 | +| `gmap_ra_valid`, `gmap_ra_valid_singleton`, `gmap_ra_valid_lookup` | whole map valid 当且仅当每个 present payload valid；validity 可投影到任意 lookup。 | +| `gmap_ra_included_lookup_iff`, `gmap_ra_included_dom`, `gmap_ra_decompose` | map inclusion 等价于逐 key inclusion，并蕴含 source domain 包含于 target domain；map 可拆成 singleton 与其余部分。 | +| `gmap_ra_local_update_at`, `gmap_ra_update_at`, `gmap_ra_updateP_at` | 在一个已存在 key 上 lifting base local/deterministic/predicate update，其他 key 属于不变 frame。 | +| `gmap_ra_drop_at` | 丢掉当前 key 的 fragment；不声称 hidden frame 或全局不存在同名 key。 | +| `gmap_ra_alloc_strong_dep`, `gmap_ra_alloc`, `gmap_ra_alloc_cofinite` | 从 infinite candidates 中选 source/frame-compatible fresh key；payload 可依赖 witness，也可避开 finite forbidden set。 | + +internal handles `gmap_ra_singleton_op`、`gmap_ra_singleton_op_fresh`、 +`gmap_ra_update_singleton`、`gmap_ra_updateP_singleton`、 +`gmap_ra_alloc_strong` 是 singleton normalization 和 allocation proof bridge。 + +### 4.3 `named_ra.h` / `named_ra.c` + +文件：[`named_ra.h`](../theory/logic/named_ra.h)、 +[`named_ra.c`](../theory/logic/named_ra.c) + +`named_ra R` 只是 `num` key 的 `gmap_ra R` specialization，不是 C resource +自动插入的一层。 + +- `named_ra_def`, `named_ra_unit`, `named_ra_singleton_op`, + `named_ra_valid_singleton` 固定 map specialization 与 singleton semantics； +- `named_ra_update_singleton`, `named_ra_updateP_singleton` lifting 固定 name 的 + payload update； +- `named_ra_drop` 丢掉当前 fragment 的 singleton contribution，不证明 global + absence； +- `named_ra_alloc` 返回 existential fresh `num` name，freshness 只在 + frame-preserving update 语义下成立。 + +### 4.4 `auth_ra.h` / `auth_ra.c` + +文件：[`auth_ra.h`](../theory/logic/auth_ra.h)、 +[`auth_ra.c`](../theory/logic/auth_ra.c) + +authoritative RA 把唯一 authority 与可组合 fragments 放在同一资源中： +`auth_auth R a`、`auth_frag f`、`auth_both a f`。 + +| theorem 族 | handles | 内容与直觉 | +| --- | --- | --- | +| composition | `auth_ra_unit`, `auth_ra_auth_frag`, `auth_ra_frag_frag`, `auth_ra_both_frag` | unit 是 empty fragment；authority 与 fragment 合成 both；fragments 通过 base op 聚合。 | +| validity/conflict | `auth_ra_valid_frag`, `auth_ra_valid_both`, `auth_ra_valid_auth`, `auth_ra_valid_both_frame`, `auth_ra_auth_conflict` | `auth_both a f` valid 恰当 `✓a` 且 `f ⪯ a`；任意 compatible hidden frame 只能贡献 fragment；两个 authority 冲突。 | +| inclusion | `auth_ra_included_frag_frag`, `auth_ra_included_frag_both`, `auth_ra_included_auth_auth`, `auth_ra_included_auth_both`, `auth_ra_included_both_both` | fragment inclusion 回落到 base；包含 authority 时 authoritative value 必须相同。 | +| structure | `auth_ra_cancellative_iff` | auth construction 是否 cancellative 精确由 base RA 决定。 | +| updates | `auth_ra_update_framewise_iff`, `auth_ra_update_local`, `auth_ra_update_auth_iff`, `auth_ra_update_alloc`, `auth_ra_update_drop_local`, `auth_ra_update_drop_auth`, `auth_ra_update_weaken_frag`, `auth_ra_alloc` | framewise theorem是总判据；base local update 可同步 authority/local fragment；可分配、弱化或分别 drop authority/local 部分，但所有变化都必须继续覆盖未知 external fragments。 | + +直觉：authority 是“全局真相”，fragment 是“客户端看到的下界/片段”。任何更新都 +必须让新 authority 继续容纳旧 frame 中可能存在的 fragment，因此不能只检查当前 +可见 fragment。 + +## 5. Linear separation logic + +### 5.1 `resource_prop.h` / `resource_prop.c` + +文件：[`resource_prop.h`](../theory/logic/resource_prop.h)、 +[`resource_prop.c`](../theory/logic/resource_prop.c)、 +[`resource_prop_internal.h`](../theory/logic/resource_prop_internal.h) + +对 `R:(A)ra`，assertion 是 `A -> bool`；entailment 只观察 valid resource： + +```text +r_entails R P Q <=> forall a. ra_valid R a ==> P a ==> Q a +r_equiv R P Q <=> r_entails R P Q && r_entails R Q P +``` + +| theorem 族 | handles | 内容与直觉 | +| --- | --- | --- | +| 定义 | `r_entails_def`, `r_equiv_def`, `r_emp_def`, `r_sep_def`, `r_wand_def`, `r_own_def`, `r_top_def`, `r_bottom_def`, `r_and_def`, `r_or_def`, `r_impl_def`, `r_exists_def`, `r_forall_def`, `r_pure_def`, `r_fact_def` | `emp` 精确 unit；`sep` 把资源分成两个 RA fragments；`own a` 精确拥有 `a`；wand 对所有 compatible extension 作承诺。 | +| entailment/equivalence | `r_entails_refl`, `r_entails_trans`, `r_entails_pointwise`, `r_equiv_pointwise`, `r_equiv_intro`, `r_equiv_refl`, `r_equiv_sym`, `r_equiv_trans` | `r_equiv` 是 valid points 上的逻辑等价，不等于 arbitrary predicate 的 raw function equality。 | +| truth/false | `r_top_intro`, `r_bottom_elim` | additive truth 可由任意 assertion 推出；bottom 可推出任意 assertion。 | +| separating conjunction | `r_sep_assoc`, `r_sep_comm`, `r_sep_emp_l`, `r_sep_emp_r`, `r_sep_mono`, `r_sep_frame_l`, `r_sep_frame_r`, `r_sep_exists_l`, `r_sep_exists_r` | 公开代数律都返回 `r_equiv`；frame rules 保留未参与推理的 linear resource；exists 可与 sep 交换 witness。 | +| additive connectives/quantifiers | `r_impl_adjunction`, `r_and_intro`, `r_and_elim_l`, `r_and_elim_r`, `r_or_intro_l`, `r_or_intro_r`, `r_or_elim`, `r_exists_intro`, `r_exists_elim`, `r_exists_mono`, `r_forall_intro`, `r_forall_elim` | additive 分支观察同一整个 resource；它们不执行 spatial split。 | +| wand | `r_wand_adjunction`, `r_wand_elim`, `r_wand_mono` | `P ** Q ⊢ S` 与 `P ⊢ Q -* S` 对应；wand 对前件反变、对后件协变。 | +| pure | `r_pure_and_intro`, `r_pure_and_elim` | resource-independent HOL side condition 只通过 additive `r_and` 携带，不可当作空资源 conjunct。 | +| fact | `r_fact_as_pure_and_emp`, `r_fact_true`, `r_fact_false`, `r_fact_sep_l`, `r_fact_sep_r`, `r_fact_intro`, `r_fact_elim`, `r_fact_dup` | `fact phi ≡ pure phi && emp`，所以它精确占有 unit，可安全进入 separating context 并可 duplicate。 | +| ownership | `r_own_unit`, `r_own_op`, `r_own_valid` | unit ownership 等价 emp；composition ownership 可 split/join；validity以 `fact(✓a) ** own a` 暴露，同时保留 ownership。 | +| 单向分配 | `r_sep_and_forward_r`, `r_sep_and_forward_l` | sep 可向 additive conjunction 单向分配；反向一般错误，因为 additive 两支可能选不同 resource decomposition。 | + +这里最容易犯错的是混淆 `r_pure` 与 `r_fact`： + +```text +r_pure R phi a <=> phi +r_fact R phi a <=> phi && a == ra_unit R +``` + +`pure` 在任意资源上成立，适合 additive guard；`fact` 只在 unit 上成立，适合 +spatial side condition。validity 与 `updateP` witness 必须使用 `fact`，否则会把 +仍然存在的资源悄悄吞掉。逻辑整体仍是 linear：除 exact-unit `fact` 外，没有一般 +weakening 或 contraction。 + +`resource_prop_internal.h` 的 raw equality handles 是： + +- sep：`r_sep_comm_eq`, `r_sep_emp_l_eq`, `r_sep_emp_r_eq`, + `r_sep_assoc_eq`, `r_sep_exists_l_eq`, `r_sep_exists_r_eq`； +- adapter schema：`r_forall_elim_cont`； +- fact：`r_fact_as_pure_and_emp_eq`, `r_fact_true_eq`, `r_fact_false_eq`, + `r_fact_sep_l_eq`, `r_fact_sep_r_eq`； +- ownership：`r_own_unit_eq`, `r_own_op_eq`。 + +这些 theorem 允许 proof engine 做 certified raw rewrite；普通 client 应使用对应 +public `r_equiv` law。 + +### 5.2 `basic_update.h` / `basic_update.c` + +文件：[`basic_update.h`](../theory/logic/basic_update.h)、 +[`basic_update.c`](../theory/logic/basic_update.c) + +`r_bupd R Q a <=> ra_updateP R a Q`，而 +`r_viewshift R P Q <=> P ⊢ r_bupd R Q`。这是对完整 `R` 的 generic update；若 +`R` 同时包含 physical state，就不能拿它作为 C command 的 ghost update。 + +| handles | 内容与直觉 | +| --- | --- | +| `r_bupd_def`, `r_viewshift_def` | 从 algebraic `ra_updateP` 提升为 assertion modality 与 assertion-to-assertion view shift。 | +| `r_bupd_intro`, `r_bupd_mono`, `r_bupd_idem`, `r_bupd_frame` | 不更新、postcondition consequence、两层 update 合并、保留 spatial frame。 | +| `r_viewshift_refl`, `r_entails_to_viewshift`, `r_viewshift_trans`, `r_viewshift_mono`, `r_viewshift_frame`, `r_viewshift_sep`, `r_viewshift_exists` | 普通 entailment 可嵌入 view shift；view shift 可串接、frame、并行组合和逐 witness lifting。 | +| `r_own_update` | `ra_update R a b` 给出 `own a ⇛ own b`。 | +| `r_own_updateP` | `ra_updateP R a P` 给出 `own a ⇛ exists b. fact(P b) ** own b`；witness side condition 是 exact-unit fact。 | + +### 5.3 `big_sep.h` / `big_sep.c` + +文件：[`big_sep.h`](../theory/logic/big_sep.h)、 +[`big_sep.c`](../theory/logic/big_sep.c) + +该模块保持为一个整体，不拆 core/extras。稳定 surface 只有 list right fold。 + +- `r_big_sep_list_def` 是 raw recursive computation：空表为 `emp`，cons 为 + `Phi x ** big_sep xs`； +- `r_big_sep_list_nil`, `r_big_sep_list_cons`, + `r_big_sep_list_singleton`, `r_big_sep_list_append` 是 public `r_equiv` + normalization； +- `r_big_sep_list_mono`, `r_big_sep_list_equiv` 只要求列表实际成员上的 pointwise + entailment/equivalence； +- `r_big_sep_list_map` 是普通 list `MAP` 的 naturality，不是 finite-map binder； +- `r_big_sep_list_sep` 在“每个元素各有两份资源”与“两份完整 big-sep”之间重排。 + +典型用法：以 append 暴露 prefix/suffix，以 cons 暴露 head，以 mono/equiv 逐元素 +推理，再用 sep theorem 把两条资源列表分组。 + +### 5.4 `product_resource.h` / `product_resource.c` + +文件：[`product_resource.h`](../theory/logic/product_resource.h)、 +[`product_resource.c`](../theory/logic/product_resource.c)、 +[`product_resource_internal.h`](../theory/logic/product_resource_internal.h) + +exact lift 要求未选中的 projection 精确为 unit： + +```text +r_lift_left R S P (left,right) <=> P left && right == ra_unit S +r_lift_right R S Q (left,right) <=> left == ra_unit R && Q right +``` + +right-only update 固定复用 source left： + +```text +r_bupd_right R S Q (left,right) <=> + ra_updateP S right (\right'. Q (left,right')) +``` + +| theorem 族 | handles | 内容与直觉 | +| --- | --- | --- | +| 定义 | `r_lift_left_def`, `r_lift_right_def`, `r_bupd_right_def`, `r_viewshift_right_def` | exact projection lifts 与只更新右 RA 的 modality。 | +| lift laws | `r_lift_left_emp`, `r_lift_right_emp`, `r_lift_left_sep`, `r_lift_right_sep`, `r_lift_left_entails`, `r_lift_right_entails` | exact lift 保持 emp、sep 与 entailment；public algebra laws 用 `r_equiv`。 | +| right bupd | `r_bupd_right_intro`, `r_bupd_right_mono`, `r_bupd_right_idem`, `r_bupd_right_frame` | 虽然 frame 可同时含左右资源，更新本身只由右坐标的 `ra_updateP` 驱动。 | +| right view shift | `r_viewshift_right_refl`, `r_viewshift_right_entails`, `r_viewshift_right_trans`, `r_viewshift_right_mono`, `r_viewshift_right_frame`, `r_viewshift_right_sep`, `r_viewshift_right_fact`, `r_viewshift_right_exists` | consequence/composition/frame/并行/量词规则；fact guard 保持 exact-unit 语义。 | +| right ownership | `r_right_own_update`, `r_right_own_updateP` | 把右 RA 的 deterministic/predicate update 提升为产品 view shift；predicate 版返回 witness、`fact(P b)` 与新 right ownership。 | + +`product_resource_internal.h` 只有 `r_lift_left_emp_eq`、 +`r_lift_right_emp_eq`、`r_lift_left_sep_eq`、`r_lift_right_sep_eq` 四个 raw +equality，供 adapter normalization 使用。 + +### 5.5 `named_logic.h` / `named_logic.c` + +文件：[`named_logic.h`](../theory/logic/named_logic.h)、 +[`named_logic.c`](../theory/logic/named_logic.c) + +`named_own R name a` 是 `named_ra R` 中 singleton map 的 exact ownership。 + +- `named_own_def` 展开 singleton ownership； +- `named_own_op` 在同一 name 下 split/join payload composition； +- `named_own_valid` 暴露 `fact (ra_valid R a)` 并保留 ownership； +- `named_own_update`, `named_own_updateP` 在固定 name 上提升 payload update， + predicate 版返回 `exists b. fact(P b) ** named_own name b`； +- `named_own_drop` 丢掉当前 singleton fragment，不证明 hidden/global absence； +- `named_own_alloc` 在 ambient assertion 外 frame-preservingly 分配 fresh name，返回 + existential name 与原 frame。 + +## 6. Adapter 与安装边界 + +### 6.1 `adapter/ra_sl.h` / `ra_sl.c` + +文件：[`ra_sl.h`](../adapter/ra_sl.h)、[`ra_sl.c`](../adapter/ra_sl.c) + +public C API 只有 `ra_sl_build(const term R, sl_theory *out)`。它要求 `R` 是 closed、 +monomorphic、类型严格为 unary `(A)ra`，然后把 generic BI theorem specialize 成 +`A -> bool` 上的 `sl_theory` bundle；它不安装 parser、不选择 C memory、不创建 +update modality。 + +bundle 中 `fact` 映射到 `r_fact`，而不是 `r_pure`。SEP ACU normalization、exists +distribution 与 `fact(T)=emp` 的 proof-engine schema 需要 internal raw equality； +这是 adapter 有意承担的 certified boundary，并不把 `_eq` theorem 变成 client API。 + +### 6.2 `adapter/ra_sl_scope.h` / `ra_sl_scope.c` + +文件：[`ra_sl_scope.h`](../adapter/ra_sl_scope.h)、 +[`ra_sl_scope.c`](../adapter/ra_sl_scope.c)、 +[`ra_sl_scope_internal.h`](../adapter/ra_sl_scope_internal.h) + +`ra_sl_scope` 保存一个 immutable alias-backed `sl_theory`，以及 scoped operators 的 +conservative definition handles：`emp_def`, `sep_def`, `wand_def`, `and_def`, +`or_def`, `exists_def`, `forall_def`, `entails_def`, `equiv_def`, `fact_def`, +`pure_def`。其中 `pure` 单独保存，不进入把 `fact` 作为 spatial proposition 的 +`sl_theory`。 + +internal functions `sl_scope_name_is_valid`、`sl_define_scope_alias`、 +`ra_sl_scope_prepare`、`ra_sl_scope_fold`、`ra_sl_scope_install`、 +`ra_sl_scope_activate` 把流程拆成 prepare、fold、commit/install、syntax activation。 +HOL constant definition 与 parser mutation 是 process-global、不可回滚；越过 commit +边界后的错误必须 fail-stop。 + +syntax 中 `-||-` 是 validity-sensitive `r_equiv`，`-|-` 才是 raw HOL assertion +equality；两者不能互换。 + +## 7. C program logic + +这一层固定： + +```text +Mem = (int,(pmem_byte_state)excl)finmap +G = 完整 global ghost RA +CRes_G = c_resource_ra G = prod_ra mem_ra G +Prop_G = carrier(CRes_G) -> bool +``` + +`G` 已经是完整 ghost algebra；`c_resource_ra` 不会暗中增加 `named_ra`。 + +### 7.1 `c_types.h` / `c_types.c` + +文件：[`c_types.h`](../theory/c_program_logic/c_types.h)、 +[`c_types.c`](../theory/c_program_logic/c_types.c) + +`sizeof_def` 给出 provisional 64-bit ABI 下的 scalar/function-pointer width；struct +layout 仍由抽象事实提供。`field_addr_prop` 把 field address 联系到 base address 与 +abstract field offset。该模块是 C type/layout vocabulary，不携带 ownership。 + +### 7.2 `mem_ra.h` / `mem_ra.c` + +文件：[`mem_ra.h`](../theory/c_program_logic/mem_ra.h)、 +[`mem_ra.c`](../theory/c_program_logic/mem_ra.c) + +物理内存 RA 是 address-keyed exclusive byte-state map：地址缺失表示无 ownership， +`PMemUninit` 与 `PMemByte value` 是两种独占 byte state。 + +| handles | 内容与直觉 | +| --- | --- | +| `mem_ra_def`, `mem_ra_unit`, `mem_ra_op_lookup`, `mem_ra_valid` | 把 physical memory 实现为 `gmap_ra excl_ra`；composition 逐地址，重叠是否合法由 exclusive byte payload 决定。 | +| `pmem_singleton_def`, `pmem_uninit_def`, `pmem_byte_def` | 构造一个地址上的 canonical uninitialized/initialized fragment。 | +| `pmem_singleton_valid`, `pmem_singleton_overlap_invalid` | 单字节 ownership valid；同地址的两个 canonical singleton 冲突。 | +| `pmem_update_uninit_byte`, `pmem_update_byte_uninit`, `pmem_update_byte_byte` | 底层 byte-state frame-preserving updates，供 certified C command semantics 使用。它们不是允许 proof-level view shift 改物理内存的接口。 | + +### 7.3 `mem_own.h` / `mem_own.c` + +文件：[`mem_own.h`](../theory/c_program_logic/mem_own.h)、 +[`mem_own.c`](../theory/c_program_logic/mem_own.c) + +`pmem_own_def` 是 `r_own mem_ra`；`pmem_uninit_at_def`、`pmem_byte_at_def` 分别 +把 canonical singleton 包成 exact physical ownership assertion。这三个是具体 +predicate 的 definition equations，不是通用 BI connective law。 + +### 7.4 `mem_value.h` / `mem_value.c` + +文件：[`mem_value.h`](../theory/c_program_logic/mem_value.h)、 +[`mem_value.c`](../theory/c_program_logic/mem_value.c) + +该模块从单字节 ownership 组装连续区域与 little-endian scalar。 + +| theorem 族 | handles | 内容与直觉 | +| --- | --- | --- | +| unknown byte | `pmem_allocated_byte_at_def` | existentially 隐藏 byte state；既可能是 `PMemUninit`，也可能是 `PMemByte v`，表示“拥有且可覆盖写，当前内容未知”。 | +| initialized byte list | `pmem_bytes_at_def`, `pmem_bytes_at_nil`, `pmem_bytes_at_cons` | 按连续地址精确拥有给定 initialized bytes。 | +| allocated range | `pmem_allocated_at_def`, `pmem_allocated_at_zero`, `pmem_allocated_at_suc`, `pmem_allocated_at_append`, `pmem_allocated_at_split` | 连续 unknown-content ownership 的递归、拼接和切分。append/split 是 carving memory range 的主规则。 | +| forget byte contents | `pmem_uninit_at_allocated_byte`, `pmem_byte_at_allocated_byte`, `pmem_bytes_at_allocated` | initialized 或 strictly-uninitialized ownership 都可弱化为 allocated/unknown ownership；逆向恢复内容不成立。 | +| little endian | `pmem_le_bytes_def`, `pmem_le_bytes_zero`, `pmem_le_bytes_suc`, `pmem_le_bytes_length` | 取 value 的低 `n` 个 base-256 digits，least-significant byte first，并证明输出长度。 | +| scalar assertions | `pmem_scalar_at_def`, `pmem_undef_scalar_at_def`, `pmem_scalar_at_zero`, `pmem_scalar_at_suc`, `pmem_undef_scalar_at_zero`, `pmem_undef_scalar_at_suc` | `scalar_at` 精确 initialized bytes；`undef_scalar_at` 要求每个 byte 都严格是 `PMemUninit`。 | +| forget scalar state | `pmem_undef_scalar_at_allocated`, `pmem_scalar_at_allocated` | initialized 或严格未初始化 scalar 都可忘记为同宽 allocated range。 | + +关键区别：`pmem_allocated_at`/后续 `undef_data_at` 表示 unknown content，不表示 +strictly uninitialized。只有 `pmem_undef_scalar_at` 才对每个字节断言 +`PMemUninit`。 + +### 7.5 `c_resource.h` / `c_resource.c` + +文件：[`c_resource.h`](../theory/c_program_logic/c_resource.h)、 +[`c_resource.c`](../theory/c_program_logic/c_resource.c) + +| handles | 内容与直觉 | +| --- | --- | +| `c_resource_ra_def`, `c_resource_ra_unit`, `c_resource_ra_op`, `c_resource_ra_valid` | `CRes_G = mem_ra × G`，unit/op/valid 逐坐标。这里的 `G` 是完整 global ghost RA。 | +| `c_lift_phys_def`, `c_lift_ghost_def` | physical/ghost assertions 分别 exact lift 到 left/right；另一个 projection 必须精确为 unit。 | +| `c_ghost_own_def` | `c_lift_ghost G (r_own G a)`，即 exact ownership of arbitrary global ghost fragment。 | +| `c_pmem_uninit_at_def`, `c_pmem_byte_at_def` | 把 canonical physical byte assertions exact lift 到 complete C resource。 | + +物理与 ghost exact lift 通过 `**` 合并后，才得到同时含两种状态的资源。需要 +numeric names 时应显式取 `G = named_ra R`。 + +### 7.6 `c_basic_update.h` / `c_basic_update.c` + +文件：[`c_basic_update.h`](../theory/c_program_logic/c_basic_update.h)、 +[`c_basic_update.c`](../theory/c_program_logic/c_basic_update.c) + +`c_bupd_def`、`c_viewshift_def` 分别 specialize 为 +`r_bupd_right mem_ra G` 与 `r_viewshift_right mem_ra G`。 +`c_bupd_preserves_phys` 给出安全边界：valid source 的任何结果都形如 +`(FST source,new_ghost)`。 + +直觉：C view shift 只能更新完整 ghost projection。物理写入、清零或初始化状态 +改变必须来自 certified C command semantics，而不是 algebraic ghost view shift。 + +### 7.7 `c_ghost.h` / `c_ghost.c` + +文件：[`c_ghost.h`](../theory/c_program_logic/c_ghost.h)、 +[`c_ghost.c`](../theory/c_program_logic/c_ghost.c) + +对任意完整 `G`： + +- `c_ghost_own_op` 以 `r_equiv` split/join `a · b`； +- `c_ghost_own_valid` 保留 ownership，并暴露 exact-unit validity fact； +- `c_ghost_own_update`, `c_ghost_own_updateP` 提升 deterministic/predicate ghost + update，predicate 版返回 existential witness、`r_fact(P b)` 与新 ownership； +- `c_ghost_own_drop` 显式放弃当前 ghost fragment。 + +对 `G = named_ra R` 的 convenience specialization： + +- `c_named_own_def`, `c_named_own_op`, `c_named_own_valid`； +- `c_named_own_update`, `c_named_own_updateP`, `c_named_own_drop`； +- `c_named_own_alloc` 在任意 physical/ghost frame 下返回 existential fresh name。 + +所有 update/drop/alloc 都使用 right-only `c_viewshift`，所以不能改变 physical +projection。“drop”只表示放弃当前 fragment 的贡献，不等价于证明 global key +不存在。 + +### 7.8 `c_memory.h` / `c_memory.c` + +文件：[`c_memory.h`](../theory/c_program_logic/c_memory.h)、 +[`c_memory.c`](../theory/c_program_logic/c_memory.c) + +该模块把 byte-level ownership 加上 C scalar ABI guard，并 exact lift 到 complete +C resource。 + +| theorem 族 | handles | 内容与直觉 | +| --- | --- | --- | +| scalar ABI | `pmem_ctype_distinct`, `pmem_c_scalar_type_def`, `pmem_c_width_def`, `pmem_c_min_def`, `pmem_c_max_def`, `pmem_c_address_ok_def`, `pmem_uint64_address_ok_def`, `pmem_ptr_address_ok_def`, `pmem_c_value_ok_def`, `pmem_c_address_ok_Tuint64` | 区分 scalar constructors，定义 1/2/4/8-byte width、signed/unsigned range、64-bit address bounds 与 natural alignment。`Tstruct`/`Tfun` 没有这里的 scalar-storage semantics。 | +| physical typed atoms | `pmem_data_at_def`, `pmem_undef_data_at_def` | `data_at` 是 address/value guard 与 initialized scalar ownership 的 additive conjunction；`undef_data_at` 是 address guard 与 unknown-content allocated range。guard 使用 resource-independent `r_pure`。 | +| physical weakening | `pmem_data_at_allocated_at`, `pmem_undef_data_at_allocated_at`, `pmem_allocated_at_to_undef_data_at`, `pmem_data_at_to_undef_data_at`, `pmem_undef_scalar_at_Tuint64` | initialized/unknown/strict-uninitialized representation 之间只按丢失信息的方向转换，不凭逻辑恢复未知值。 | +| complete-C definitions | `c_allocated_at_def`, `c_data_at_def`, `c_undef_data_at_def` | physical predicates 的 exact left lifts，ghost projection 是 unit。 | +| concrete range normalization | `c_allocated_at_zero`, `c_allocated_at_append` | 具体 allocated-range predicate 的 raw computation/normalization；不是 generic BI connective equality。 | +| complete-C entailments | `c_allocated_at_to_undef_data_at`, `c_data_at_to_undef_data_at`, `c_data_at_allocated_at`, `c_undef_data_at_allocated_at` | lifted typed/allocated assertions之间的 information-forgetting rules。 | +| value range | `c_data_at_value_range` | 保留 initialized cell，并以 separating `r_fact` 暴露 `min <= value <= max`；range fact 不消耗 cell。 | + +`pmem_data_at` 是可读且值已知；`pmem_undef_data_at` 只表示可覆盖写的 unknown +cell；`pmem_undef_scalar_at` 才表示严格未初始化。不存在从 unknown-content assertion +恢复 initialized value 的 theorem。 + +### 7.9 `c_integer.h` / `c_integer.c` + +文件：[`c_integer.h`](../theory/c_program_logic/c_integer.h)、 +[`c_integer.c`](../theory/c_program_logic/c_integer.c) + +这是独立整数/bit-operation semantics，不拥有资源。 + +- width-generic definitions：`c_exp_2_def`, `c_max_unsigned_def`, + `c_max_signed_def`, `c_min_signed_def`, `cast_unsigned_def`, + `cast_signed_def`, `unsigned_last_nbits_def`, `signed_last_nbits_def`, + `unsigned_last_nbits_id`；unsigned cast 是 modulo `2^width`，signed cast 是 + two's-complement reinterpretation； +- 32-bit signed：`i32_and_def`, `i32_or_def`, `i32_xor_def`, `i32_not_def`, + `i32_shl_def`, `i32_shr_def`； +- 32-bit unsigned：`u32_and_def`, `u32_or_def`, `u32_xor_def`, `u32_not_def`, + `u32_shl_def`, `u32_shr_def`； +- 64-bit signed：`i64_and_def`, `i64_or_def`, `i64_xor_def`, `i64_not_def`, + `i64_shl_def`, `i64_shr_def`； +- 64-bit unsigned：`u64_and_def`, `u64_or_def`, `u64_xor_def`, `u64_not_def`, + `u64_shl_def`, `u64_shr_def`。 + +signed result 使用 `ival`，unsigned result 使用 `val`；right shift 分别选择 +arithmetic/logical word shift。`c_exp_2_def` 在 searchable theorem database 中以 +`int_exp_2_def` 注册。 + +### 7.10 `c_fnspec.h` / `c_fnspec.c` + +文件：[`c_fnspec.h`](../theory/c_program_logic/c_fnspec.h)、 +[`c_fnspec.c`](../theory/c_program_logic/c_fnspec.c) + +该模块没有 public theorem equation，只声明 opaque markers： + +```text +c_fnspec G : int -> ctype -> Prop_G -> Prop_G -> Prop_G +c_fnspec_w G : int -> ctype -> (B -> Prop_G) -> (B -> Prop_G) -> Prop_G +``` + +它们的 operational meaning 属于 certified QCP/C-logic boundary，不能在普通 +RA/BI proof 中展开。 + +## 8. QCP runtime surface + +文件：[`userlib/qcp/c_logic.h`](../../userlib/qcp/c_logic.h)、 +[`userlib/qcp/c_logic.c`](../../userlib/qcp/c_logic.c)、 +[`userlib/qcp/c_logic_default.h`](../../userlib/qcp/c_logic_default.h)、 +[`userlib/qcp/c_logic_default.c`](../../userlib/qcp/c_logic_default.c)、 +[`userlib/qcp/veriftime.h`](../../userlib/qcp/veriftime.h)、 +[`userlib/qcp/veriftime.c`](../../userlib/qcp/veriftime.c) + +`c_logic_install_named(R)` 接收 closed monomorphic payload RA，并显式选择： + +```text +G = named_ra R +CRes = c_resource_ra G +``` + +调用者传 `R`，不能传已经包过的 `named_ra R`。安装定义 scoped aliases、构造 +right-only update bundle、注册 theorem names，并激活 parser；这是一次性、全局、 +fail-stop transaction。默认安装取 `R = unit_ra`。 + +`c_logic_default.h/.c` 只封装这个默认选择；`veriftime.h` 在未定义 +`CSTAR_DEFER_C_LOGIC_INSTALL` 时加载默认 installer，并提供 QCP proof-time +notation。需要自定义 payload RA 的 root 应先 defer default，再定义/export +payload vocabulary 并调用 `c_logic_install_named(R)`。`veriftime.c` 是对应 runtime +support，不定义另一套 RA/SL semantics。 + +### 8.1 `c_logic_scope` 中的 theorem families + +- physical aliases：`data_at`/`data_at_def`、 + `undef_data_at`/`undef_data_at_def`； +- opaque spec aliases：`fnspec`/`fnspec_def`、`fnspec_w`/`fnspec_w_def`； +- named ownership alias：`own`/`own_def`； +- right-only update bundle：`bupd_intro`, `bupd_mono`, `bupd_idem`, `bupd_frame`, + `viewshift_refl`, `viewshift_entails`, `viewshift_trans`, `viewshift_mono`, + `viewshift_frame`, `viewshift_sep`, `viewshift_fact`, `viewshift_exists`； +- selected memory rules：`data_at_value_range`, `allocated_at_zero`, + `allocated_at_append`, `data_at_allocated_at`, `undef_data_at_allocated_at`, + `allocated_at_to_undef_data_at`, `data_at_to_undef_data_at`； +- selected named ghost rules：`ghost_own_op`, `ghost_own_split`, + `ghost_own_join`, `ghost_own_valid`, `ghost_own_update`, + `ghost_own_updateP`, `ghost_own_drop`, `ghost_own_alloc`。 + +`ghost_own_op` 是 logical equivalence；`split` 与 `join` 是两个相反方向的 +entailment，既不是 raw equality，也不是 view shift。 + +固定 searchable theorem database names 是： + +```text +c_logic_data_at_value_range +c_logic_allocated_at_zero +c_logic_allocated_at_append +c_logic_data_at_allocated_at +c_logic_undef_data_at_allocated_at +c_logic_allocated_at_to_undef_data_at +c_logic_data_at_to_undef_data_at +c_logic_ghost_own_op +c_logic_ghost_own_split +c_logic_ghost_own_join +c_logic_ghost_own_valid +c_logic_ghost_own_update +c_logic_ghost_own_updateP +c_logic_ghost_own_drop +c_logic_ghost_own_alloc +``` + +source interface 中，`fact` 与 `pure` 保持不同；`==*=>` 是 right-only view +shift；`-||-` 是 logical equivalence；`-|-` 是 raw equality；`cprop` 只是当前 +`Prop_G` 的 parser abbreviation，不是新 HOL type。 + +## 9. 常见 theorem 组合路径 + +### 9.1 分解 ownership 并取得 validity + +1. 用 `r_own_op` 或 instance-specific `*_own_op` 把 `own(a · b)` 改写成 + `own a ** own b`。 +2. 用 `r_own_valid` 得到 `fact(✓a) ** own a`。 +3. 用 `r_fact_elim` 把 validity 放入 ordinary HOL context，同时保留 `own a`。 + +这里不能把 `fact` 替换为 `pure`；否则 side condition 会在任意资源上成立，破坏 +linear resource accounting。 + +### 9.2 deterministic / predicate update + +- deterministic：`ra_update` → `r_own_update` → `r_viewshift_frame` → + `r_viewshift_trans`； +- predicate：`ra_updateP` → `r_own_updateP` → + `exists b. fact(P b) ** own b`，随后消去 existential 与 fact； +- 两个独立更新可用 `r_viewshift_sep` 合并；普通 entailment 可先以 + `r_entails_to_viewshift` 嵌入。 + +### 9.3 named lifecycle + +- allocation：`ra_valid R a` + `named_own_alloc`/`c_named_own_alloc`； +- 同 name split/join：`named_own_op`/`c_named_own_op`； +- fixed-name update：`named_own_update(P)`/`c_named_own_update(P)`； +- release current fragment：`named_own_drop`/`c_named_own_drop`。 + +allocation 的 name 是 existential witness；drop 不提供 global freshness/absence。 + +### 9.4 physical memory + +- 区间切分：`pmem_allocated_at_append`/`pmem_allocated_at_split` 或 lifted + `c_allocated_at_append`； +- initialized cell 忘记内容：`c_data_at_to_undef_data_at` 或 + `c_data_at_allocated_at`； +- strict uninitialized `Tuint64` 变为 QCP unknown cell： + `pmem_undef_scalar_at_Tuint64`； +- 暴露 value range 且保留 cell：`c_data_at_value_range`； +- 在 physical frame 下更新 ghost：`c_named_own_update(P)` 配合 + `r_viewshift_right_frame`/installed `viewshift_frame`。 + +任何 physical byte-state 改变都应来自 certified command rule；不能用 generic +`r_bupd` 或 C ghost view shift 绕过这一边界。 + +## 10. Regression files 对应的契约 + +以下测试不是额外公理，而是把 public theorem statements 与架构边界锁定： + +- [`ra_core_regression.c`](../test/ra_core_regression.c)：RA relations、 + `ra_updateP` frame-dependent witness、valid-source exclusivity 与五参数 local update； +- [`basic_ra_constructors_regression.c`](../test/basic_ra_constructors_regression.c)、 + [`value_ra_constructors_regression.c`](../test/value_ra_constructors_regression.c)： + unit/product/option/excl/agree/max-nat/fraction constructors； +- [`gmap_ra_regression.c`](../test/gmap_ra_regression.c)、 + [`named_ra_regression.c`](../test/named_ra_regression.c)：pointwise map、drop 与 fresh + allocation； +- [`auth_ra_regression.c`](../test/auth_ra_regression.c)、 + [`auth_ra_structure_regression.c`](../test/auth_ra_structure_regression.c)： + authoritative validity/inclusion/update； +- [`sl_v2_regression.c`](../test/sl_v2_regression.c)：`r_equiv` laws、 + `pure`/`fact`、big-sep 与 right-only product update； +- [`c_resource_v2_regression.c`](../test/c_resource_v2_regression.c)：complete global + `G`、physical preservation、generic/named ghost rules； +- [`dependency_v2_regression.sh`](../test/dependency_v2_regression.sh)：RA→SL/C 依赖方向、 + public/internal 边界、lowercase theorem handles 与 removed v1 API。 diff --git a/docs/RA_SL_THEORY_SUMMARY.md b/docs/RA_SL_THEORY_SUMMARY.md index 76f3744..b801481 100644 --- a/docs/RA_SL_THEORY_SUMMARY.md +++ b/docs/RA_SL_THEORY_SUMMARY.md @@ -4,6 +4,9 @@ > 实现中的定理对象仍由 HOL 内核机械检查；各 public header 是精确 API 的最终 > 来源。v2 是一次 breaking redesign，不提供历史接口的兼容别名或转接层。 +按源码文件查阅 theorem families、直观解释和典型组合方式时，请配合 +[`RA_SL_THEOREM_GUIDE.md`](RA_SL_THEOREM_GUIDE.md) 阅读。 + ## 1. 设计边界 本理论面向“不含 later 的 first-order ghost state”。RA 是带 validity 的交换 @@ -15,8 +18,8 @@ v2 固定以下边界： - predicate update `ra_updateP` 是唯一 primitive update；`ra_update` 只是它的 singleton 特化； -- `ra_exclusive` 自带 source validity，不允许无效源通过真空蕴含被称为 - exclusive； +- `ra_maximal` 自带 source validity，不允许无效源通过真空蕴含被称为 + maximal； - 用户级 assertion algebra 统一以 `r_equiv` 表达；raw assertion-function equality 只留给实现和 adapter； - `r_pure` 与 `r_fact` 明确保留为两个不同构造：前者资源无关，后者精确占有 @@ -124,7 +127,7 @@ ra_update R a b <=> `ra_included_op_r`、`ra_included_trans`、`ra_included_op_mono`、 `ra_included_valid`。兼容性公开 `ra_compat_comm` 和 `ra_compat_unit`。 -### 2.2 cancellative 与 exclusive +### 2.2 cancellative 与 maximal ```text ra_cancellative R <=> @@ -133,15 +136,20 @@ ra_cancellative R <=> ra_op R frame a == ra_op R frame b ==> a == b -ra_exclusive R a <=> +ra_maximal R a <=> ra_valid R a && forall frame. ra_valid R (ra_op R a frame) ==> frame == ra_unit R ``` -因此 `ra_exclusive R a` 本身就能推出 `ra_valid R a`。公开使用 -`ra_exclusive_included`、`ra_exclusive_update` 与 +因此 `ra_maximal R a` 本身就能推出 `ra_valid R a`。它表达强 +frame-maximality：所有 compatible frame 都必须精确等于 unit。这不等同于 +`~ra_valid R (ra_op R a a)` 这类 self-conflict exclusive 性质，后者尚未在 +核心 RA API 中定义。`excl_ra` 仍作为 exclusive-token 构造器：其 owned +tokens 之间会冲突，并且这些 owned 元素同时满足 `ra_maximal`。 + +公开使用 `ra_maximal_included`、`ra_maximal_update` 与 `ra_cancellative_apply`；invalid-source 的真空特例不属于稳定 client API。 ### 2.3 五参数 local update @@ -168,7 +176,7 @@ ra_local_update_trans ra_local_update_frame ra_local_update_preserves_included ra_local_update_alloc -ra_local_update_exclusive +ra_local_update_maximal ra_local_update_cancel ra_local_update_cancellative ``` @@ -183,7 +191,7 @@ ra_local_update_cancellative | `excl_ra` | `ExclUnit | Excl a | ExclInvalid` | owned conflict、有效 exclusive token、替换 update | | `agree_ra` | `AgreeUnit | Agree a | AgreeInvalid` | 相同值幂等，不同值冲突，兼容性推出 payload 相等 | | `max_nat_ra` | `num`，unit `0`，operation `MAX` | inclusion 是 `<=`；base RA 上所有 deterministic update 都成立 | -| `frac_ra R` | empty 或正 share token | share 合成、full exclusivity、share weakening 与 predicate update lifting | +| `frac_ra R` | empty 或正 share token | share 合成、full maximality、share weakening 与 predicate update lifting | | `gmap_ra R` | finite map，逐 key 使用 `option_ra R` | pointwise validity/inclusion、key update、drop、fresh allocation | | `named_ra R` | `gmap_ra R`，key 固定为 `num` | numeric name 下的 singleton ownership/update/drop/allocation | | `auth_ra R` | authoritative + fragment | authoritative validity、framewise update、local-update lifting、allocation/drop | @@ -552,7 +560,7 @@ public laws。 - public headers 不重新导出 implementation-only raw equality； - update API 只有 `ra_updateP` primitive 与 singleton `ra_update`； -- exclusive 始终包含 source validity； +- maximal 始终包含 source validity，并表达“compatible frame 必为 unit”； - ownership validity/updateP 使用 `r_fact`，不混同 `r_pure`； - C update 不能改变 physical projection； - C resource 不隐式增加 naming layer； diff --git a/test/basic_ra_constructors_regression.c b/test/basic_ra_constructors_regression.c index f945786..690a42f 100644 --- a/test/basic_ra_constructors_regression.c +++ b/test/basic_ra_constructors_regression.c @@ -50,9 +50,9 @@ PROOF static int audit_unit_ra_regressions(void) { `forall a b:1. ra_included unit_ra a b`, "unit_ra_included"); check_basic_ra_theorem( - unit_ra_exclusive, - `forall a:1. ra_exclusive unit_ra a`, - "unit_ra_exclusive"); + unit_ra_maximal, + `forall a:1. ra_maximal unit_ra a`, + "unit_ra_maximal"); check_basic_ra_theorem( unit_ra_updateP_iff, `forall (a:1) (P:1->bool). @@ -106,9 +106,9 @@ PROOF static int audit_excl_ra_regressions(void) { a == b`, "excl_ra_included_owned"); check_basic_ra_theorem( - ispec_rule(a, excl_ra_exclusive), - `ra_exclusive (excl_ra:((num)excl)ra) (Excl (a:num))`, - "excl_ra_exclusive"); + ispec_rule(a, excl_ra_maximal), + `ra_maximal (excl_ra:((num)excl)ra) (Excl (a:num))`, + "excl_ra_maximal"); check_basic_ra_theorem( basic_ra_at_num(excl_ra_cancellative), `ra_cancellative (excl_ra:((num)excl)ra)`, @@ -191,13 +191,13 @@ PROOF static int audit_prod_ra_regressions(void) { ra_cancellative (excl_ra:((num)excl)ra)`, "prod_ra_cancellative_iff"); check_basic_ra_theorem( - ispecl_rule(TERM_LIST(R, S, x), prod_ra_exclusive_iff), - `ra_exclusive + ispecl_rule(TERM_LIST(R, S, x), prod_ra_maximal_iff), + `ra_maximal (prod_ra unit_ra (excl_ra:((num)excl)ra)) (x:1#(num)excl) <=> - ra_exclusive unit_ra (FST x) && - ra_exclusive excl_ra (SND x)`, - "prod_ra_exclusive_iff"); + ra_maximal unit_ra (FST x) && + ra_maximal excl_ra (SND x)`, + "prod_ra_maximal_iff"); check_basic_ra_theorem( ispecl_rule( TERM_LIST(R, S, a1, a2, P1, P2), diff --git a/test/dependency_v2_regression.sh b/test/dependency_v2_regression.sh index 6ab92bf..6c6c3da 100755 --- a/test/dependency_v2_regression.sh +++ b/test/dependency_v2_regression.sh @@ -58,6 +58,11 @@ for name in "${ra_file_names[@]}"; do fi done +ra_test_sources=() +while IFS= read -r source; do + ra_test_sources+=("$source") +done < <(find "$script_dir" -type f -name '*.c' -print) + reject_matches \ "foundational RA module depends on an SL module" \ '^[[:space:]]*#(include|require)[[:space:]]+"proof/theory/logic/(resource_prop|basic_update|big_sep|product_resource|named_logic|ghost_own|ghost_update)\.(h|c)"' \ @@ -88,9 +93,20 @@ reject_matches \ reject_matches \ "public header exposes an invalid-source vacuity theorem" \ - '^PROOF[[:space:]]+extern[[:space:]]+thm[[:space:]]+[[:alnum:]_]*(ra_update_invalid|ra_updateP_invalid|ra_invalid_exclusive)[[:alnum:]_]*;' \ + '^PROOF[[:space:]]+extern[[:space:]]+thm[[:space:]]+[[:alnum:]_]*(ra_update_invalid|ra_updateP_invalid|ra_invalid_exclusive|ra_invalid_maximal)[[:alnum:]_]*;' \ + "${public_headers[@]}" + +reject_matches \ + "public header exposes the old exclusive name for frame-maximality" \ + '\b(ra_exclusive|ra_local_update_exclusive|unit_ra_exclusive|prod_ra_exclusive_iff|excl_ra_exclusive|frac_ra_exclusive_full)\b' \ "${public_headers[@]}" +reject_matches \ + "RA implementation or test retains the old frame-maximal theorem name" \ + '\b[[:alnum:]_]*(ra_exclusive|ra_local_update_exclusive|agree_ra_not_exclusive_owned|max_nat_ra_not_exclusive|exclusive_source_valid|source_not_exclusive)[[:alnum:]_]*\b' \ + "${existing_ra_files[@]}" \ + "${ra_test_sources[@]}" + reject_matches \ "public assertion header exposes a raw-equality theorem handle" \ '^PROOF[[:space:]]+extern[[:space:]]+thm[[:space:]]+r_[[:alnum:]_]*_eq;' \ diff --git a/test/ra_core_regression.c b/test/ra_core_regression.c index 1e5e03b..e9344f2 100644 --- a/test/ra_core_regression.c +++ b/test/ra_core_regression.c @@ -32,37 +32,37 @@ err: return empty_theorem; } -/* A v2-exclusive source is valid by construction. */ -PROOF static thm prove_exclusive_source_valid(void) { +/* A frame-maximal source is valid by construction. */ +PROOF static thm prove_maximal_source_valid(void) { term goal_tm = ` forall (R:(num)ra) (a:num). - ra_exclusive R a ==> ra_valid R a + ra_maximal R a ==> ra_valid R a `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); - thm exclusive = rewrite_rule( - THM_LIST(ra_exclusive_def), - assume_rule(`ra_exclusive (R:(num)ra) (a:num)`)); - ACCEPT_TAC(body, conjunct1_rule(exclusive)); + thm maximal = rewrite_rule( + THM_LIST(ra_maximal_def), + assume_rule(`ra_maximal (R:(num)ra) (a:num)`)); + ACCEPT_TAC(body, conjunct1_rule(maximal)); return gnode_prove(root); } -/* Regression against the removed invalid-source vacuity of exclusivity. */ -PROOF static thm prove_invalid_source_not_exclusive(void) { +/* Regression against invalid-source vacuity in frame-maximality. */ +PROOF static thm prove_invalid_source_not_maximal(void) { term goal_tm = ` forall (R:(num)ra) (a:num). - ~(ra_valid R a) ==> ~(ra_exclusive R a) + ~(ra_valid R a) ==> ~(ra_maximal R a) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); - thm exclusive = rewrite_rule( - THM_LIST(ra_exclusive_def), - assume_rule(`ra_exclusive (R:(num)ra) (a:num)`)); + thm maximal = rewrite_rule( + THM_LIST(ra_maximal_def), + assume_rule(`ra_maximal (R:(num)ra) (a:num)`)); CONTR_TAC( body, not_elim_rule( assume_rule(`~(ra_valid (R:(num)ra) (a:num))`), - conjunct1_rule(exclusive))); + conjunct1_rule(maximal))); return gnode_prove(root); } @@ -106,13 +106,13 @@ PROOF static int audit_ra_core_regressions(void) { "ra_update_def"); check_ra_core_theorem( - ra_core_at_num(ra_exclusive_def), - `ra_exclusive (R:(num)ra) (a:num) <=> + ra_core_at_num(ra_maximal_def), + `ra_maximal (R:(num)ra) (a:num) <=> ra_valid R a && (forall frame:num. ra_valid R (ra_op R a frame) ==> frame == ra_unit R)`, - "ra_exclusive_def"); + "ra_maximal_def"); check_ra_core_theorem( ispecl_rule(TERM_LIST(R, a, b), ra_compat_comm), @@ -177,23 +177,23 @@ PROOF static int audit_ra_core_regressions(void) { "ra_update_op"); check_ra_core_theorem( - ispecl_rule(TERM_LIST(R, a, b), ra_exclusive_update), - `ra_exclusive (R:(num)ra) (a:num) ==> + ispecl_rule(TERM_LIST(R, a, b), ra_maximal_update), + `ra_maximal (R:(num)ra) (a:num) ==> ra_valid R (b:num) ==> ra_update R a b`, - "ra_exclusive_update"); + "ra_maximal_update"); check_ra_core_theorem( - prove_exclusive_source_valid(), + prove_maximal_source_valid(), `forall (R:(num)ra) (a:num). - ra_exclusive R a ==> ra_valid R a`, - "exclusive source validity"); + ra_maximal R a ==> ra_valid R a`, + "maximal source validity"); check_ra_core_theorem( - prove_invalid_source_not_exclusive(), + prove_invalid_source_not_maximal(), `forall (R:(num)ra) (a:num). - ~(ra_valid R a) ==> ~(ra_exclusive R a)`, - "invalid source is not exclusive"); + ~(ra_valid R a) ==> ~(ra_maximal R a)`, + "invalid source is not maximal"); check_ra_core_theorem( ra_core_at_num(ra_local_update_def), @@ -257,11 +257,11 @@ PROOF static int audit_ra_core_regressions(void) { check_ra_core_theorem( ispecl_rule( TERM_LIST(R, a, f, b), - ra_local_update_exclusive), - `ra_exclusive (R:(num)ra) (f:num) ==> + ra_local_update_maximal), + `ra_maximal (R:(num)ra) (f:num) ==> ra_valid R (b:num) ==> ra_local_update R (a:num) f b b`, - "ra_local_update_exclusive"); + "ra_local_update_maximal"); check_ra_core_theorem( ispecl_rule( diff --git a/test/value_ra_constructors_regression.c b/test/value_ra_constructors_regression.c index 536f23a..31c78ba 100644 --- a/test/value_ra_constructors_regression.c +++ b/test/value_ra_constructors_regression.c @@ -125,11 +125,11 @@ PROOF static int audit_frac_constructor_regressions(void) { p <= &1 && ra_valid R a)`, "frac_ra_valid_own"); check_value_ra_theorem( - frac_ra_exclusive_full, + frac_ra_maximal_full, `forall (R:(A)ra) (a:A). ra_valid R a ==> - ra_exclusive (frac_ra R) (frac_full a)`, - "frac_ra_exclusive_full"); + ra_maximal (frac_ra R) (frac_full a)`, + "frac_ra_maximal_full"); check_value_ra_theorem( frac_ra_update_weaken, `forall (R:(A)ra) (p:real) (q:real) (a:A) (b:A). diff --git a/theory/logic/agree_ra.c b/theory/logic/agree_ra.c index d79ab84..718b7c2 100644 --- a/theory/logic/agree_ra.c +++ b/theory/logic/agree_ra.c @@ -915,16 +915,16 @@ PROOF static thm prove_agree_ra_not_included_invalid_owned(void) { PROOF thm agree_ra_not_included_invalid_owned = prove_agree_ra_not_included_invalid_owned(); -PROOF static thm prove_agree_ra_not_exclusive_owned(void) { +PROOF static thm prove_agree_ra_not_maximal_owned(void) { term goal_tm = ` - forall a:A. ~(ra_exclusive agree_ra (Agree a)) + forall a:A. ~(ra_maximal agree_ra (Agree a)) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = GEN_TAC(root, "a"); - body = DISCH_TAC(body, "Hexclusive"); - thm exclusive = rewrite_rule( - THM_LIST(ra_exclusive_def), - assume_rule(`ra_exclusive agree_ra (Agree (a:A))`)); + body = DISCH_TAC(body, "Hmaximal"); + thm maximal = rewrite_rule( + THM_LIST(ra_maximal_def), + assume_rule(`ra_maximal agree_ra (Agree (a:A))`)); thm combined_valid = eq_mp_rule( gsym_rule(ap_term_rule( `ra_valid agree_ra:(A)agree->bool`, @@ -933,7 +933,7 @@ PROOF static thm prove_agree_ra_not_exclusive_owned(void) { thm frame_is_unit = mp_rule( spec_rule( `Agree (a:A):(A)agree`, - conjunct2_rule(exclusive)), + conjunct2_rule(maximal)), combined_valid); frame_is_unit = rewrite_rule( THM_LIST(agree_ra_unit), @@ -945,8 +945,8 @@ PROOF static thm prove_agree_ra_not_exclusive_owned(void) { return gnode_prove(root); } -PROOF thm agree_ra_not_exclusive_owned = - prove_agree_ra_not_exclusive_owned(); +PROOF thm agree_ra_not_maximal_owned = + prove_agree_ra_not_maximal_owned(); PROOF static thm prove_agree_ra_not_cancellative(void) { term goal_tm = `~(ra_cancellative (agree_ra:((A)agree)ra))`; @@ -1021,7 +1021,7 @@ PROOF static int audit_agree_ra(void) { agree_ra_included_owned_invalid, agree_ra_not_included_invalid_unit, agree_ra_not_included_invalid_owned, - agree_ra_not_exclusive_owned, + agree_ra_not_maximal_owned, agree_ra_not_cancellative, agree_ra_agreement, agree_ra_update_iff, diff --git a/theory/logic/auth_ra.c b/theory/logic/auth_ra.c index 2d98ebf..282559e 100644 --- a/theory/logic/auth_ra.c +++ b/theory/logic/auth_ra.c @@ -1314,8 +1314,8 @@ PROOF static thm prove_auth_excl_unit_included(void) { PROOF static thm auth_excl_unit_included = prove_auth_excl_unit_included(); -/* An owned exclusive element cannot extend to ExclUnit. Deriving this from - * semantic exclusivity avoids unfolding the raw exclusive operation. */ +/* An owned Excl element cannot extend to ExclUnit. Deriving this from its + * frame-maximality avoids unfolding the raw exclusive operation. */ PROOF static thm prove_auth_excl_owned_not_included_unit(void) { term goal_tm = ` forall a:A. @@ -1332,10 +1332,10 @@ PROOF static thm prove_auth_excl_owned_not_included_unit(void) { `excl_ra:((A)excl)ra`, `Excl (a:A):(A)excl`, `ExclUnit:(A)excl`), - ra_exclusive_included); + ra_maximal_included); forced_equal = mp_rule( forced_equal, - ispec_rule(`a:A`, excl_ra_exclusive)); + ispec_rule(`a:A`, excl_ra_maximal)); forced_equal = mp_rule( forced_equal, excl_ra_valid_unit); diff --git a/theory/logic/excl_ra.c b/theory/logic/excl_ra.c index 2a34527..f487a5f 100644 --- a/theory/logic/excl_ra.c +++ b/theory/logic/excl_ra.c @@ -464,27 +464,27 @@ PROOF thm excl_ra_valid_iff = prove_excl_ra_valid_iff(); /* - * An owned exclusive element is compatible only with ExclUnit. Owned and - * invalid frames both reduce the composition to ExclInvalid, contradicting - * the compatibility premise in ra_exclusive. + * An owned token is frame-maximal: it is compatible only with ExclUnit. An + * owned or invalid frame reduces the composition to ExclInvalid, contradicting + * the compatibility premise in ra_maximal. */ -PROOF static thm prove_excl_ra_exclusive(void) { +PROOF static thm prove_excl_ra_maximal(void) { term goal_tm = ` forall a:A. - ra_exclusive + ra_maximal (excl_ra:((A)excl)ra) (Excl a) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - once_rewrite_conv(THM_LIST(ra_exclusive_def))); + once_rewrite_conv(THM_LIST(ra_maximal_def))); body = GEN_TAC(body, "a"); - gnode_list exclusive = CONJ_TAC(body); + gnode_list maximal = CONJ_TAC(body); ACCEPT_TAC( - exclusive[0], + maximal[0], ispec_rule(`a:A`, excl_ra_valid_owned)); - body = GEN_TAC(exclusive[1], "frame"); + body = GEN_TAC(maximal[1], "frame"); gnode_list frame_cases = CASES_TAC( body, `frame:(A)excl`, @@ -504,8 +504,8 @@ PROOF static thm prove_excl_ra_exclusive(void) { return gnode_prove(root); } -PROOF thm excl_ra_exclusive = - prove_excl_ra_exclusive(); +PROOF thm excl_ra_maximal = + prove_excl_ra_maximal(); PROOF static thm prove_excl_ra_included_owned(void) { term goal_tm = ` @@ -616,10 +616,10 @@ PROOF static thm prove_excl_ra_included_owned_iff(void) { `excl_ra:((A)excl)ra`, `Excl (a:A):(A)excl`, `x:(A)excl`), - ra_exclusive_included); + ra_maximal_included); source_eq_unit = mp_rule( source_eq_unit, - ispec_rule(`a:A`, excl_ra_exclusive)); + ispec_rule(`a:A`, excl_ra_maximal)); thm case_unit_eq = assume_rule(gnode_get_asmps( cases[0], CONST_STRING_LIST("Hx"))[0]); thm case_unit_valid = pure_rewrite_rule( @@ -646,10 +646,10 @@ PROOF static thm prove_excl_ra_included_owned_iff(void) { `excl_ra:((A)excl)ra`, `Excl (a:A):(A)excl`, `x:(A)excl`), - ra_exclusive_included); + ra_maximal_included); source_eq_owned = mp_rule( source_eq_owned, - ispec_rule(`a:A`, excl_ra_exclusive)); + ispec_rule(`a:A`, excl_ra_maximal)); thm case_owned_eq = assume_rule(gnode_get_asmps( cases[1], CONST_STRING_LIST("Hx"))[0]); term case_owned_payload = dest_comb( @@ -869,7 +869,7 @@ PROOF static thm prove_excl_ra_cancellative(void) { PROOF thm excl_ra_cancellative = prove_excl_ra_cancellative(); -/* Any valid target may replace an exclusive source. */ +/* Any valid target may replace this frame-maximal source. */ PROOF static thm prove_excl_ra_update(void) { term a = `a:A`; term b = `b:A`; @@ -878,10 +878,10 @@ PROOF static thm prove_excl_ra_update(void) { `excl_ra:((A)excl)ra`, `Excl (a:A):(A)excl`, `Excl (b:A):(A)excl`), - ra_exclusive_update); + ra_maximal_update); result = mp_rule( result, - ispec_rule(a, excl_ra_exclusive)); + ispec_rule(a, excl_ra_maximal)); result = mp_rule( result, ispec_rule(b, excl_ra_valid_owned)); @@ -891,7 +891,7 @@ PROOF static thm prove_excl_ra_update(void) { PROOF thm excl_ra_update = prove_excl_ra_update(); -/* Generic exclusive replacement, with an arbitrary valid target. */ +/* Generic maximal replacement, with an arbitrary valid target. */ PROOF static thm prove_excl_ra_update_valid(void) { term goal_tm = ` forall (a:A) (x:(A)excl). @@ -905,10 +905,10 @@ PROOF static thm prove_excl_ra_update_valid(void) { `excl_ra:((A)excl)ra`, `Excl (a:A):(A)excl`, `x:(A)excl`), - ra_exclusive_update); + ra_maximal_update); result = mp_rule( result, - ispec_rule(`a:A`, excl_ra_exclusive)); + ispec_rule(`a:A`, excl_ra_maximal)); result = mp_rule( result, assume_rule(`ra_valid (excl_ra:((A)excl)ra) (x:(A)excl)`)); @@ -968,7 +968,7 @@ PROOF static thm prove_excl_ra_update_owned_iff(void) { PROOF thm excl_ra_update_owned_iff = prove_excl_ra_update_owned_iff(); -/* The generic exclusive local update gives full owned replacement directly. */ +/* The generic maximal local update gives full owned replacement directly. */ PROOF static thm prove_excl_ra_local_update_valid(void) { term goal_tm = ` forall (a:A) (x:(A)excl). @@ -988,10 +988,10 @@ PROOF static thm prove_excl_ra_local_update_valid(void) { `Excl (a:A):(A)excl`, `Excl (a:A):(A)excl`, `x:(A)excl`), - ra_local_update_exclusive); + ra_local_update_maximal); result = mp_rule( result, - ispec_rule(`a:A`, excl_ra_exclusive)); + ispec_rule(`a:A`, excl_ra_maximal)); result = mp_rule( result, assume_rule(`ra_valid (excl_ra:((A)excl)ra) (x:(A)excl)`)); @@ -1091,7 +1091,7 @@ PROOF static int audit_excl_ra(void) { excl_ra_valid_owned, excl_ra_invalid, excl_ra_valid_iff, - excl_ra_exclusive, + excl_ra_maximal, excl_ra_included_owned, excl_ra_included_owned_iff, excl_ra_included_invalid_iff, diff --git a/theory/logic/excl_ra.h b/theory/logic/excl_ra.h index 3e7f05b..21ab1f7 100644 --- a/theory/logic/excl_ra.h +++ b/theory/logic/excl_ra.h @@ -3,7 +3,7 @@ /* * Public semantic interface for the exclusive resource algebra. * - * `ExclUnit` is the unit, each `Excl a` is a valid exclusive token, and + * `ExclUnit` is the unit, each `Excl a` is a valid owned token, and * composing two owned tokens produces the invalid value `ExclInvalid`. * Datatype elimination, constructor distinctions, and raw operation equations * are confined to `excl_ra_internal.h`. @@ -35,8 +35,8 @@ PROOF extern thm excl_ra_invalid; /* `ra_included excl_ra (Excl a) (Excl b) <=> a == b`. */ PROOF extern thm excl_ra_included_owned; -/* Every `Excl a` is a valid exclusive element. */ -PROOF extern thm excl_ra_exclusive; +/* Every `Excl a` is frame-maximal. */ +PROOF extern thm excl_ra_maximal; /* `ra_cancellative excl_ra`. */ PROOF extern thm excl_ra_cancellative; diff --git a/theory/logic/frac_ra.c b/theory/logic/frac_ra.c index bff98f5..6051210 100644 --- a/theory/logic/frac_ra.c +++ b/theory/logic/frac_ra.c @@ -1279,7 +1279,7 @@ PROOF static thm frac_ra_included_full = prove_frac_ra_included_full(); /* ------------------------------------------------------------------------- */ -/* Exclusive elements */ +/* Frame-maximal elements */ /* ------------------------------------------------------------------------- */ /* @@ -1287,29 +1287,29 @@ PROOF static thm frac_ra_included_full = * the only compatible frame: every owned frame contributes a strictly * positive weight and would make the combined weight exceed one. */ -PROOF static thm prove_frac_ra_exclusive_full(void) { +PROOF static thm prove_frac_ra_maximal_full(void) { term goal_tm = ` forall (R:(A)ra) (a:A). ra_valid R a ==> - ra_exclusive + ra_maximal (frac_ra R) (frac_full a) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - once_rewrite_conv(THM_LIST(ra_exclusive_def))); + once_rewrite_conv(THM_LIST(ra_maximal_def))); body = AUTO_INTROS_TAC(body); - gnode_list exclusive_parts = CONJ_TAC(body); + gnode_list maximal_parts = CONJ_TAC(body); thm full_valid = eq_mp_rule( gsym_rule(ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), frac_ra_valid_full)), assume_rule(`ra_valid (R:(A)ra) (a:A)`)); - ACCEPT_TAC(exclusive_parts[0], full_valid); + ACCEPT_TAC(maximal_parts[0], full_valid); - gnode frames = AUTO_INTROS_TAC(exclusive_parts[1]); + gnode frames = AUTO_INTROS_TAC(maximal_parts[1]); gnode_list frame_cases = CASES_TAC( frames, `frame:(A)frac`, NULL); @@ -1368,8 +1368,8 @@ PROOF static thm prove_frac_ra_exclusive_full(void) { return gnode_prove(root); } -PROOF thm frac_ra_exclusive_full = - prove_frac_ra_exclusive_full(); +PROOF thm frac_ra_maximal_full = + prove_frac_ra_maximal_full(); /* ------------------------------------------------------------------------- */ /* Optional algebraic properties */ @@ -2244,10 +2244,10 @@ PROOF static thm prove_frac_ra_update_full_iff(void) { frac_ra_valid_full)), target_base_valid); - thm exclusive = mp_rule( + thm maximal = mp_rule( ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`), - frac_ra_exclusive_full), + frac_ra_maximal_full), source_base_valid); thm frame_is_unit = mp_rule( mp_rule( @@ -2256,8 +2256,8 @@ PROOF static thm prove_frac_ra_update_full_iff(void) { `frac_ra (R:(A)ra)`, `frac_full (a:A)`, `frame:(A)frac`), - ra_exclusive_apply), - exclusive), + ra_maximal_apply), + maximal), assume_rule(` ra_valid (frac_ra (R:(A)ra)) @@ -2344,7 +2344,7 @@ PROOF static int audit_frac_ra(void) { frac_ra_included_own, frac_ra_not_included_own_empty, frac_ra_included_full, - frac_ra_exclusive_full, + frac_ra_maximal_full, frac_ra_cancellative, frac_ra_update_weaken, frac_ra_updateP_weaken, diff --git a/theory/logic/frac_ra.h b/theory/logic/frac_ra.h index 934687d..835717b 100644 --- a/theory/logic/frac_ra.h +++ b/theory/logic/frac_ra.h @@ -32,7 +32,7 @@ PROOF extern thm frac_ra_full; PROOF extern thm frac_ra_own_op; /* ------------------------------------------------------------------------- */ -/* Validity and exclusivity */ +/* Validity and maximality */ /* ------------------------------------------------------------------------- */ /* @@ -45,9 +45,9 @@ PROOF extern thm frac_ra_valid_own; /* * `forall (R:(A)ra) (a:A). - * ra_valid R a ==> ra_exclusive (frac_ra R) (frac_full a)`. + * ra_valid R a ==> ra_maximal (frac_ra R) (frac_full a)`. */ -PROOF extern thm frac_ra_exclusive_full; +PROOF extern thm frac_ra_maximal_full; /* ------------------------------------------------------------------------- */ /* Share and payload updates */ diff --git a/theory/logic/local_update.c b/theory/logic/local_update.c index e211a92..19f5c16 100644 --- a/theory/logic/local_update.c +++ b/theory/logic/local_update.c @@ -319,10 +319,10 @@ PROOF static thm prove_ra_local_update_alloc(void) { PROOF thm ra_local_update_alloc = prove_ra_local_update_alloc(); -PROOF static thm prove_ra_local_update_exclusive(void) { +PROOF static thm prove_ra_local_update_maximal(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (f:A) (b:A). - ra_exclusive R f ==> + ra_maximal R f ==> ra_valid R b ==> ra_local_update R a f b b `; @@ -340,12 +340,12 @@ PROOF static thm prove_ra_local_update_exclusive(void) { ra_op (R:(A)ra) (f:A) (residual:A) `)), assume_rule(`ra_valid (R:(A)ra) (a:A)`)); - thm exclusive = rewrite_rule( - THM_LIST(ra_exclusive_def), - assume_rule(`ra_exclusive (R:(A)ra) (f:A)`)); - exclusive = conjunct2_rule(exclusive); + thm maximal = rewrite_rule( + THM_LIST(ra_maximal_def), + assume_rule(`ra_maximal (R:(A)ra) (f:A)`)); + maximal = conjunct2_rule(maximal); thm frame_is_unit = mp_rule( - spec_rule(`residual:A`, exclusive), + spec_rule(`residual:A`, maximal), source_valid); gnode_list result = CONJ_TAC(body); @@ -363,8 +363,8 @@ PROOF static thm prove_ra_local_update_exclusive(void) { return gnode_prove(root); } -PROOF thm ra_local_update_exclusive = - prove_ra_local_update_exclusive(); +PROOF thm ra_local_update_maximal = + prove_ra_local_update_maximal(); PROOF static thm prove_ra_local_update_cancel(void) { term goal_tm = ` @@ -521,7 +521,7 @@ PROOF static int audit_local_update(void) { ra_local_update_frame, ra_local_update_preserves_included, ra_local_update_alloc, - ra_local_update_exclusive, + ra_local_update_maximal, ra_local_update_cancel, ra_local_update_cancellative); diff --git a/theory/logic/local_update.h b/theory/logic/local_update.h index 21186e2..a63ff9a 100644 --- a/theory/logic/local_update.h +++ b/theory/logic/local_update.h @@ -47,8 +47,8 @@ PROOF extern thm ra_local_update_preserves_included; /* Allocate one piece into both the whole resource and visible fragment. */ PROOF extern thm ra_local_update_alloc; -/* Replace a complete exclusive visible fragment by any valid target. */ -PROOF extern thm ra_local_update_exclusive; +/* Replace a frame-maximal visible fragment by any valid target. */ +PROOF extern thm ra_local_update_maximal; /* Remove one common prefix from the whole and visible fragment. */ PROOF extern thm ra_local_update_cancel; diff --git a/theory/logic/max_nat_ra.c b/theory/logic/max_nat_ra.c index 9358443..187d9a9 100644 --- a/theory/logic/max_nat_ra.c +++ b/theory/logic/max_nat_ra.c @@ -475,20 +475,20 @@ PROOF static thm max_nat_ra_op_eq_left = prove_max_nat_ra_op_eq_left(); /* All frames are compatible because validity is total; choosing frame one - * refutes exclusivity for every source. */ -PROOF static thm prove_max_nat_ra_not_exclusive(void) { + * refutes frame-maximality for every source. */ +PROOF static thm prove_max_nat_ra_not_maximal(void) { term goal_tm = ` - forall n:num. ~(ra_exclusive max_nat_ra n) + forall n:num. ~(ra_maximal max_nat_ra n) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = GEN_TAC(root, "n"); - body = DISCH_TAC(body, "Hexclusive"); - thm exclusive = rewrite_rule( - THM_LIST(ra_exclusive_def), - assume_rule(`ra_exclusive max_nat_ra (n:num)`)); - exclusive = conjunct2_rule(exclusive); + body = DISCH_TAC(body, "Hmaximal"); + thm maximal = rewrite_rule( + THM_LIST(ra_maximal_def), + assume_rule(`ra_maximal max_nat_ra (n:num)`)); + maximal = conjunct2_rule(maximal); thm frame_is_unit = mp_rule( - spec_rule(`1`, exclusive), + spec_rule(`1`, maximal), ispec_rule( `ra_op max_nat_ra (n:num) 1`, max_nat_ra_valid)); @@ -502,8 +502,8 @@ PROOF static thm prove_max_nat_ra_not_exclusive(void) { return gnode_prove(root); } -PROOF static thm max_nat_ra_not_exclusive = - prove_max_nat_ra_not_exclusive(); +PROOF static thm max_nat_ra_not_maximal = + prove_max_nat_ra_not_maximal(); /* The common frame one absorbs both zero and one, witnessing failure of * cancellativity. */ @@ -742,7 +742,7 @@ PROOF static int audit_max_nat_ra(void) { max_nat_ra_idempotent, max_nat_ra_op_eq_right, max_nat_ra_op_eq_left, - max_nat_ra_not_exclusive, + max_nat_ra_not_maximal, max_nat_ra_not_cancellative, max_nat_ra_included_mono_right, max_nat_ra_update, diff --git a/theory/logic/prod_ra.c b/theory/logic/prod_ra.c index 219785d..e200f34 100644 --- a/theory/logic/prod_ra.c +++ b/theory/logic/prod_ra.c @@ -392,40 +392,39 @@ PROOF static thm prove_prod_ra_included(void) { PROOF thm prod_ra_included = prove_prod_ra_included(); -/* Compatible frames are units componentwise when both projections are - * exclusive. This is deliberately stronger than Iris's one-sided product - * `Exclusive` instance because the two libraries use different predicates. */ -PROOF static thm prove_prod_ra_exclusive(void) { +/* A product is frame-maximal exactly when both projections are + * frame-maximal: a compatible pair frame is then the pair of units. */ +PROOF static thm prove_prod_ra_maximal(void) { term goal_tm = ` forall (R1:(A)ra) (R2:(B)ra) (x:A#B). - ra_exclusive R1 (FST x) ==> - ra_exclusive R2 (SND x) ==> - ra_exclusive (prod_ra R1 R2) x + ra_maximal R1 (FST x) ==> + ra_maximal R2 (SND x) ==> + ra_maximal (prod_ra R1 R2) x `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(ra_exclusive_def))); - gnode_list exclusive = CONJ_TAC(body); - - thm left_exclusive = rewrite_rule( - THM_LIST(ra_exclusive_def), - assume_rule(`ra_exclusive (R1:(A)ra) (FST (x:A#B))`)); - thm right_exclusive = rewrite_rule( - THM_LIST(ra_exclusive_def), - assume_rule(`ra_exclusive (R2:(B)ra) (SND (x:A#B))`)); + once_rewrite_conv(THM_LIST(ra_maximal_def))); + gnode_list maximal = CONJ_TAC(body); + + thm left_maximal = rewrite_rule( + THM_LIST(ra_maximal_def), + assume_rule(`ra_maximal (R1:(A)ra) (FST (x:A#B))`)); + thm right_maximal = rewrite_rule( + THM_LIST(ra_maximal_def), + assume_rule(`ra_maximal (R2:(B)ra) (SND (x:A#B))`)); thm source_components = conj_rule( - conjunct1_rule(left_exclusive), - conjunct1_rule(right_exclusive)); + conjunct1_rule(left_maximal), + conjunct1_rule(right_maximal)); thm source_validity = ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), prod_ra_valid); ACCEPT_TAC( - exclusive[0], + maximal[0], eq_mp_rule(gsym_rule(source_validity), source_components)); - body = GEN_TAC(exclusive[1], "frame"); + body = GEN_TAC(maximal[1], "frame"); body = DISCH_TAC(body, "Hcompatible"); thm product_validity = ispecl_rule( @@ -456,12 +455,12 @@ PROOF static thm prove_prod_ra_exclusive(void) { thm left_frame = spec_rule( `FST (frame:A#B)`, - conjunct2_rule(left_exclusive)); + conjunct2_rule(left_maximal)); left_frame = mp_rule(left_frame, conjunct1_rule(components)); thm right_frame = spec_rule( `SND (frame:A#B)`, - conjunct2_rule(right_exclusive)); + conjunct2_rule(right_maximal)); right_frame = mp_rule(right_frame, conjunct2_rule(components)); thm pair_components = eq_mp_rule( @@ -487,32 +486,32 @@ PROOF static thm prove_prod_ra_exclusive(void) { return gnode_prove(root); } -PROOF thm prod_ra_exclusive = - prove_prod_ra_exclusive(); +PROOF thm prod_ra_maximal = + prove_prod_ra_maximal(); /* Embed a left frame together with the right unit. Validity of the source * product supplies the compatible right component needed for the embedding. */ -PROOF static thm prove_prod_ra_exclusive_elim_left(void) { +PROOF static thm prove_prod_ra_maximal_elim_left(void) { term goal_tm = ` forall (R1:(A)ra) (R2:(B)ra) (x:A#B). ra_valid (prod_ra R1 R2) x ==> - ra_exclusive (prod_ra R1 R2) x ==> - ra_exclusive R1 (FST x) + ra_maximal (prod_ra R1 R2) x ==> + ra_maximal R1 (FST x) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(ra_exclusive_def))); - gnode_list exclusive = CONJ_TAC(body); + once_rewrite_conv(THM_LIST(ra_maximal_def))); + gnode_list maximal = CONJ_TAC(body); thm source_components = eq_mp_rule( ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), prod_ra_valid), assume_rule(`ra_valid (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); - ACCEPT_TAC(exclusive[0], conjunct1_rule(source_components)); - body = GEN_TAC(exclusive[1], "frame"); + ACCEPT_TAC(maximal[0], conjunct1_rule(source_components)); + body = GEN_TAC(maximal[1], "frame"); body = DISCH_TAC(body, "Hcompatible"); thm right_unit = ispecl_rule( TERM_LIST(`R2:(B)ra`, `SND (x:A#B)`), @@ -567,12 +566,12 @@ PROOF static thm prove_prod_ra_exclusive_elim_left(void) { gsym_rule(framed_op)), framed_pair_valid); - thm product_exclusive = rewrite_rule( - THM_LIST(ra_exclusive_def), - assume_rule(`ra_exclusive (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + thm product_maximal = rewrite_rule( + THM_LIST(ra_maximal_def), + assume_rule(`ra_maximal (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); thm unit_frame = spec_rule( product_frame, - conjunct2_rule(product_exclusive)); + conjunct2_rule(product_maximal)); unit_frame = mp_rule(unit_frame, framed_valid); thm projected = ap_term_rule(`FST:(A#B)->A`, unit_frame); projected = pure_rewrite_rule( @@ -584,31 +583,31 @@ PROOF static thm prove_prod_ra_exclusive_elim_left(void) { return gnode_prove(root); } -PROOF thm prod_ra_exclusive_elim_left = - prove_prod_ra_exclusive_elim_left(); +PROOF thm prod_ra_maximal_elim_left = + prove_prod_ra_maximal_elim_left(); /* Symmetric embedding of a right frame with the left unit. */ -PROOF static thm prove_prod_ra_exclusive_elim_right(void) { +PROOF static thm prove_prod_ra_maximal_elim_right(void) { term goal_tm = ` forall (R1:(A)ra) (R2:(B)ra) (x:A#B). ra_valid (prod_ra R1 R2) x ==> - ra_exclusive (prod_ra R1 R2) x ==> - ra_exclusive R2 (SND x) + ra_maximal (prod_ra R1 R2) x ==> + ra_maximal R2 (SND x) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); body = CONV_TAC( body, - once_rewrite_conv(THM_LIST(ra_exclusive_def))); - gnode_list exclusive = CONJ_TAC(body); + once_rewrite_conv(THM_LIST(ra_maximal_def))); + gnode_list maximal = CONJ_TAC(body); thm source_components = eq_mp_rule( ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), prod_ra_valid), assume_rule(`ra_valid (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); - ACCEPT_TAC(exclusive[0], conjunct2_rule(source_components)); - body = GEN_TAC(exclusive[1], "frame"); + ACCEPT_TAC(maximal[0], conjunct2_rule(source_components)); + body = GEN_TAC(maximal[1], "frame"); body = DISCH_TAC(body, "Hcompatible"); thm left_unit = ispecl_rule( TERM_LIST(`R1:(A)ra`, `FST (x:A#B)`), @@ -663,12 +662,12 @@ PROOF static thm prove_prod_ra_exclusive_elim_right(void) { gsym_rule(framed_op)), framed_pair_valid); - thm product_exclusive = rewrite_rule( - THM_LIST(ra_exclusive_def), - assume_rule(`ra_exclusive (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + thm product_maximal = rewrite_rule( + THM_LIST(ra_maximal_def), + assume_rule(`ra_maximal (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); thm unit_frame = spec_rule( product_frame, - conjunct2_rule(product_exclusive)); + conjunct2_rule(product_maximal)); unit_frame = mp_rule(unit_frame, framed_valid); thm projected = ap_term_rule(`SND:(A#B)->B`, unit_frame); projected = pure_rewrite_rule( @@ -680,69 +679,69 @@ PROOF static thm prove_prod_ra_exclusive_elim_right(void) { return gnode_prove(root); } -PROOF thm prod_ra_exclusive_elim_right = - prove_prod_ra_exclusive_elim_right(); +PROOF thm prod_ra_maximal_elim_right = + prove_prod_ra_maximal_elim_right(); -PROOF static thm prove_prod_ra_exclusive_iff(void) { +PROOF static thm prove_prod_ra_maximal_iff(void) { term goal_tm = ` forall (R1:(A)ra) (R2:(B)ra) (x:A#B). - (ra_exclusive (prod_ra R1 R2) x <=> - ra_exclusive R1 (FST x) && - ra_exclusive R2 (SND x)) + (ra_maximal (prod_ra R1 R2) x <=> + ra_maximal R1 (FST x) && + ra_maximal R2 (SND x)) `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); gnode_list directions = EQ_TAC(body); - gnode forward = DISCH_TAC(directions[0], "Hexclusive"); - thm product_exclusive = rewrite_rule( - THM_LIST(ra_exclusive_def), - assume_rule(`ra_exclusive (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + gnode forward = DISCH_TAC(directions[0], "Hmaximal"); + thm product_maximal = rewrite_rule( + THM_LIST(ra_maximal_def), + assume_rule(`ra_maximal (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); gnode_list components = CONJ_TAC(forward); thm left = ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), - prod_ra_exclusive_elim_left); + prod_ra_maximal_elim_left); left = mp_rule( left, - conjunct1_rule(product_exclusive)); + conjunct1_rule(product_maximal)); left = mp_rule( left, - assume_rule(`ra_exclusive (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + assume_rule(`ra_maximal (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); ACCEPT_TAC(components[0], left); thm right = ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), - prod_ra_exclusive_elim_right); + prod_ra_maximal_elim_right); right = mp_rule( right, - conjunct1_rule(product_exclusive)); + conjunct1_rule(product_maximal)); right = mp_rule( right, - assume_rule(`ra_exclusive (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); + assume_rule(`ra_maximal (prod_ra (R1:(A)ra) (R2:(B)ra)) (x:A#B)`)); ACCEPT_TAC(components[1], right); gnode reverse = DISCH_TAC(directions[1], "Hcomponents"); thm result = ispecl_rule( TERM_LIST(`R1:(A)ra`, `R2:(B)ra`, `x:A#B`), - prod_ra_exclusive); + prod_ra_maximal); result = mp_rule( result, conjunct1_rule(assume_rule(` - ra_exclusive (R1:(A)ra) (FST (x:A#B)) && - ra_exclusive (R2:(B)ra) (SND x) + ra_maximal (R1:(A)ra) (FST (x:A#B)) && + ra_maximal (R2:(B)ra) (SND x) `))); result = mp_rule( result, conjunct2_rule(assume_rule(` - ra_exclusive (R1:(A)ra) (FST (x:A#B)) && - ra_exclusive (R2:(B)ra) (SND x) + ra_maximal (R1:(A)ra) (FST (x:A#B)) && + ra_maximal (R2:(B)ra) (SND x) `))); ACCEPT_TAC(reverse, result); return gnode_prove(root); } -PROOF thm prod_ra_exclusive_iff = - prove_prod_ra_exclusive_iff(); +PROOF thm prod_ra_maximal_iff = + prove_prod_ra_maximal_iff(); /* * Component cancellativity lifts to products. Product validity is @@ -2511,10 +2510,10 @@ PROOF static int audit_prod_ra(void) { prod_ra_op, prod_ra_valid, prod_ra_included, - prod_ra_exclusive, - prod_ra_exclusive_elim_left, - prod_ra_exclusive_elim_right, - prod_ra_exclusive_iff, + prod_ra_maximal, + prod_ra_maximal_elim_left, + prod_ra_maximal_elim_right, + prod_ra_maximal_iff, prod_ra_cancellative, prod_ra_cancellative_elim_left, prod_ra_cancellative_elim_right, diff --git a/theory/logic/prod_ra.h b/theory/logic/prod_ra.h index b646601..0b0f63c 100644 --- a/theory/logic/prod_ra.h +++ b/theory/logic/prod_ra.h @@ -30,9 +30,9 @@ PROOF extern thm prod_ra_valid; /* Product inclusion is exactly componentwise inclusion. */ PROOF extern thm prod_ra_included; -/* Product cancellativity/exclusivity hold exactly componentwise. */ +/* Product cancellativity and frame-maximality hold componentwise. */ PROOF extern thm prod_ra_cancellative_iff; -PROOF extern thm prod_ra_exclusive_iff; +PROOF extern thm prod_ra_maximal_iff; /* ------------------------------------------------------------------------- */ /* Componentwise updates */ diff --git a/theory/logic/ra.c b/theory/logic/ra.c index 501abfa..ed88b2c 100644 --- a/theory/logic/ra.c +++ b/theory/logic/ra.c @@ -283,12 +283,13 @@ PROOF thm ra_cancellative_def = new_fun_definition(` `); /* - * An exclusive element is valid and every compatible frame is the unit. The - * frame formulation justifies replacement by any valid target, including in - * non-cancellative resource algebras. + * A frame-maximal element is valid and every compatible frame is the unit. + * This strong formulation justifies replacement by any valid target, + * including in non-cancellative resource algebras. It is not a definition + * of self-conflict exclusivity. */ -PROOF thm ra_exclusive_def = new_fun_definition(` - ra_exclusive (R:(A)ra) (a:A) <=> +PROOF thm ra_maximal_def = new_fun_definition(` + ra_maximal (R:(A)ra) (a:A) <=> ra_valid R a && (forall frame:A. ra_valid R (ra_op R a frame) ==> @@ -577,21 +578,21 @@ PROOF thm ra_cancellative_apply = /* Direct eliminators keep goal-directed proofs from unfolding quantified * property definitions at every use site. */ -PROOF static thm prove_ra_exclusive_apply(void) { +PROOF static thm prove_ra_maximal_apply(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (frame:A). - ra_exclusive R a ==> + ra_maximal R a ==> ra_valid R (ra_op R a frame) ==> frame == ra_unit R `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = AUTO_INTROS_TAC(root); - thm exclusive = rewrite_rule( - THM_LIST(ra_exclusive_def), - assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); - exclusive = conjunct2_rule(exclusive); + thm maximal = rewrite_rule( + THM_LIST(ra_maximal_def), + assume_rule(`ra_maximal (R:(A)ra) (a:A)`)); + maximal = conjunct2_rule(maximal); thm result = mp_rule( - spec_rule(`frame:A`, exclusive), + spec_rule(`frame:A`, maximal), assume_rule(` ra_valid (R:(A)ra) @@ -601,8 +602,8 @@ PROOF static thm prove_ra_exclusive_apply(void) { return gnode_prove(root); } -PROOF thm ra_exclusive_apply = - prove_ra_exclusive_apply(); +PROOF thm ra_maximal_apply = + prove_ra_maximal_apply(); PROOF static thm prove_ra_update_apply(void) { term goal_tm = ` @@ -1113,14 +1114,14 @@ PROOF thm ra_included_cancel_l = prove_ra_included_cancel_l(); /* - * Exclusive elements are maximal among valid extensions. Unpack the + * Frame-maximal elements are maximal among valid extensions. Unpack the * inclusion witness, use validity of the extension to show that witness is * a compatible frame, then reduce it to the unit. */ -PROOF static thm prove_ra_exclusive_included(void) { +PROOF static thm prove_ra_maximal_included(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (b:A). - ra_exclusive R a ==> + ra_maximal R a ==> ra_valid R b ==> ra_included R a b ==> a == b @@ -1129,7 +1130,7 @@ PROOF static thm prove_ra_exclusive_included(void) { gnode body = GEN_TAC(root, "R"); body = GEN_TAC(body, "a"); body = GEN_TAC(body, "b"); - body = DISCH_TAC(body, "Hexclusive"); + body = DISCH_TAC(body, "Hmaximal"); body = DISCH_TAC(body, "Hvalid_b"); body = DISCH_TAC(body, "Hincluded"); @@ -1149,12 +1150,12 @@ PROOF static thm prove_ra_exclusive_included(void) { thm framed_valid = rewrite_rule( THM_LIST(extension_eq), assume_rule(`ra_valid (R:(A)ra) (b:A)`)); - thm exclusive = rewrite_rule( - THM_LIST(ra_exclusive_def), - assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); - exclusive = conjunct2_rule(exclusive); + thm maximal = rewrite_rule( + THM_LIST(ra_maximal_def), + assume_rule(`ra_maximal (R:(A)ra) (a:A)`)); + maximal = conjunct2_rule(maximal); thm frame_is_unit = mp_rule( - spec_rule(`frame:A`, exclusive), + spec_rule(`frame:A`, maximal), framed_valid); thm replace_frame = beta_rule(ap_term_rule( `\x:A. ra_op (R:(A)ra) (a:A) x`, @@ -1170,15 +1171,15 @@ PROOF static thm prove_ra_exclusive_included(void) { return gnode_prove(root); } -PROOF thm ra_exclusive_included = - prove_ra_exclusive_included(); +PROOF thm ra_maximal_included = + prove_ra_maximal_included(); -/* For an exclusive source, compatibility is exactly ordinary source +/* For a frame-maximal source, compatibility is exactly ordinary source * validity together with the unit frame. */ -PROOF static thm prove_ra_exclusive_valid_op_iff(void) { +PROOF static thm prove_ra_maximal_valid_op_iff(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (frame:A). - ra_exclusive R a ==> + ra_maximal R a ==> (ra_valid R (ra_op R a frame) <=> ra_valid R a && frame == ra_unit R) `; @@ -1202,10 +1203,10 @@ PROOF static thm prove_ra_exclusive_valid_op_iff(void) { compatible)); thm frame_is_unit = ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`, `frame:A`), - ra_exclusive_apply); + ra_maximal_apply); frame_is_unit = mp_rule( frame_is_unit, - assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); + assume_rule(`ra_maximal (R:(A)ra) (a:A)`)); frame_is_unit = mp_rule(frame_is_unit, compatible); ACCEPT_TAC(components[1], frame_is_unit); @@ -1231,8 +1232,8 @@ PROOF static thm prove_ra_exclusive_valid_op_iff(void) { return gnode_prove(root); } -PROOF thm ra_exclusive_valid_op_iff = - prove_ra_exclusive_valid_op_iff(); +PROOF thm ra_maximal_valid_op_iff = + prove_ra_maximal_valid_op_iff(); /* Deterministic update is definitionally the singleton specialization. */ PROOF static thm prove_ra_updateP_singleton(void) { @@ -1586,13 +1587,13 @@ PROOF thm ra_updateP_valid = prove_ra_updateP_valid(); /* - * General exclusive update: a source-compatible frame is the unit, so a + * General maximal update: a source-compatible frame is the unit, so a * valid target remains valid with that same frame. */ -PROOF static thm prove_ra_exclusive_update(void) { +PROOF static thm prove_ra_maximal_update(void) { term goal_tm = ` forall (R:(A)ra) (a:A) (b:A). - ra_exclusive R a ==> + ra_maximal R a ==> ra_valid R b ==> ra_update R a b `; @@ -1603,17 +1604,17 @@ PROOF static thm prove_ra_exclusive_update(void) { body = GEN_TAC(body, "R"); body = GEN_TAC(body, "a"); body = GEN_TAC(body, "b"); - body = DISCH_TAC(body, "Hexclusive"); + body = DISCH_TAC(body, "Hmaximal"); body = DISCH_TAC(body, "Hvalid_b"); body = GEN_TAC(body, "frame"); body = DISCH_TAC(body, "Hsource_valid"); thm frame_is_unit = ispecl_rule( TERM_LIST(`R:(A)ra`, `a:A`, `frame:A`), - ra_exclusive_apply); + ra_maximal_apply); frame_is_unit = mp_rule( frame_is_unit, - assume_rule(`ra_exclusive (R:(A)ra) (a:A)`)); + assume_rule(`ra_maximal (R:(A)ra) (a:A)`)); frame_is_unit = mp_rule( frame_is_unit, assume_rule(` @@ -1642,8 +1643,8 @@ PROOF static thm prove_ra_exclusive_update(void) { return gnode_prove(root); } -PROOF thm ra_exclusive_update = - prove_ra_exclusive_update(); +PROOF thm ra_maximal_update = + prove_ra_maximal_update(); PROOF static thm prove_ra_update_refl(void) { term goal_tm = ` @@ -2358,7 +2359,7 @@ PROOF static int audit_ra_core(void) { ra_updateP_def, ra_update_def, ra_cancellative_def, - ra_exclusive_def); + ra_maximal_def); thm_list public_rules = THM_LIST( ra_laws, ra_assoc, @@ -2390,8 +2391,8 @@ PROOF static int audit_ra_core(void) { ra_update_included, ra_update_target_included, ra_update_valid, - ra_exclusive_included, - ra_exclusive_update, + ra_maximal_included, + ra_maximal_update, ra_cancellative_apply); thm_list builder_theorems = THM_LIST( ra_laws_def, diff --git a/theory/logic/ra.h b/theory/logic/ra.h index 79b1941..fa51074 100644 --- a/theory/logic/ra.h +++ b/theory/logic/ra.h @@ -10,8 +10,9 @@ * `ra_internal.h`. * * `ra_updateP` is the primitive frame-preserving update. `ra_update` is its - * singleton specialization. `ra_exclusive` includes source validity, so an - * invalid element is not exclusive merely because it has no valid frames. + * singleton specialization. `ra_maximal` is the strong, frame-based notion + * of maximality: the source is valid and its only compatible frame is the + * unit. It is deliberately distinct from self-conflict exclusivity. */ #include "proof/proof_kernel.h" @@ -39,8 +40,8 @@ PROOF extern thm ra_update_def; /* Valid-source cancellation of a common left frame. */ PROOF extern thm ra_cancellative_def; -/* A valid element whose every compatible frame is the unit. */ -PROOF extern thm ra_exclusive_def; +/* Strong frame-maximality: valid, with no compatible frame except the unit. */ +PROOF extern thm ra_maximal_def; /* ------------------------------------------------------------------------- */ /* Intrinsic RA laws */ @@ -138,11 +139,11 @@ PROOF extern thm ra_update_valid; /* Optional algebraic properties */ /* ------------------------------------------------------------------------- */ -/* A valid exclusive element has no strict valid extension. */ -PROOF extern thm ra_exclusive_included; +/* A frame-maximal element has no strict valid extension. */ +PROOF extern thm ra_maximal_included; -/* A valid exclusive element may be replaced by any valid target. */ -PROOF extern thm ra_exclusive_update; +/* A frame-maximal element may be replaced by any valid target. */ +PROOF extern thm ra_maximal_update; /* Direct eliminator for `ra_cancellative`. */ PROOF extern thm ra_cancellative_apply; diff --git a/theory/logic/ra_internal.h b/theory/logic/ra_internal.h index d204e29..58e6fd5 100644 --- a/theory/logic/ra_internal.h +++ b/theory/logic/ra_internal.h @@ -21,8 +21,8 @@ PROOF extern thm ra_op_swap_right; PROOF extern thm ra_valid_op_l; PROOF extern thm ra_valid_op_r; -/* Direct eliminators for exclusivity and frame-preserving updates. */ -PROOF extern thm ra_exclusive_apply; +/* Direct eliminators for frame-maximality and frame-preserving updates. */ +PROOF extern thm ra_maximal_apply; PROOF extern thm ra_update_apply; PROOF extern thm ra_updateP_apply; @@ -40,8 +40,8 @@ PROOF extern thm ra_included_valid_frame; /* Cancel a common left operand from an inclusion in a cancellative RA. */ PROOF extern thm ra_included_cancel_l; -/* Exact valid-frame characterization for an exclusive source. */ -PROOF extern thm ra_exclusive_valid_op_iff; +/* Exact valid-frame characterization for a frame-maximal source. */ +PROOF extern thm ra_maximal_valid_op_iff; /* ------------------------------------------------------------------------- */ /* Update bridges */ diff --git a/theory/logic/unit_ra.c b/theory/logic/unit_ra.c index 5f9d3e2..0ee8793 100644 --- a/theory/logic/unit_ra.c +++ b/theory/logic/unit_ra.c @@ -169,20 +169,20 @@ PROOF static thm prove_unit_ra_included(void) { PROOF thm unit_ra_included = prove_unit_ra_included(); /* Every frame in the singleton carrier is the RA unit. */ -PROOF static thm prove_unit_ra_exclusive(void) { +PROOF static thm prove_unit_ra_maximal(void) { term goal_tm = ` - forall a:1. ra_exclusive unit_ra a + forall a:1. ra_maximal unit_ra a `; gnode root = gnode_new_with_ccl(goal_tm); gnode body = CONV_TAC( root, - once_rewrite_conv(THM_LIST(ra_exclusive_def))); + once_rewrite_conv(THM_LIST(ra_maximal_def))); body = GEN_TAC(body, "a"); - gnode_list exclusive = CONJ_TAC(body); + gnode_list maximal = CONJ_TAC(body); ACCEPT_TAC( - exclusive[0], + maximal[0], ispec_rule(`a:1`, unit_ra_valid)); - body = GEN_TAC(exclusive[1], "frame"); + body = GEN_TAC(maximal[1], "frame"); body = DISCH_TAC(body, "Hcompatible"); thm frame_is_one = spec_rule( `frame:1`, @@ -193,8 +193,8 @@ PROOF static thm prove_unit_ra_exclusive(void) { return gnode_prove(root); } -PROOF thm unit_ra_exclusive = - prove_unit_ra_exclusive(); +PROOF thm unit_ra_maximal = + prove_unit_ra_maximal(); /* Predicate update has exactly one possible result, namely `one`. */ PROOF static thm prove_unit_ra_updateP_iff(void) { @@ -298,7 +298,7 @@ PROOF static int audit_unit_ra(void) { unit_ra_op, unit_ra_valid, unit_ra_included, - unit_ra_exclusive, + unit_ra_maximal, unit_ra_updateP_iff, unit_ra_local_update); diff --git a/theory/logic/unit_ra.h b/theory/logic/unit_ra.h index c7830c2..b2c3dfe 100644 --- a/theory/logic/unit_ra.h +++ b/theory/logic/unit_ra.h @@ -23,8 +23,8 @@ PROOF extern thm unit_ra_valid; /* `forall a b:1. ra_included unit_ra a b`. */ PROOF extern thm unit_ra_included; -/* `forall a:1. ra_exclusive unit_ra a`. */ -PROOF extern thm unit_ra_exclusive; +/* The singleton carrier is frame-maximal: its only frame is its unit. */ +PROOF extern thm unit_ra_maximal; /* ------------------------------------------------------------------------- */ /* Updates */ -- Gitee From aec7f6296547800aea80d68c78c0cef83479723b Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Tue, 11 Aug 2026 10:12:34 +0800 Subject: [PATCH 32/35] Document every exported theorem conclusion --- proof_sl.h | 106 +++++----- test/dependency_v2_regression.sh | 57 ++++++ theory/c_program_logic/c_basic_update.h | 14 +- theory/c_program_logic/c_ghost.h | 142 +++++++++++-- theory/c_program_logic/c_integer.h | 145 ++++++++++++- theory/c_program_logic/c_memory.h | 193 +++++++++++++----- theory/c_program_logic/c_resource.h | 68 ++++++- theory/c_program_logic/c_types.h | 25 ++- theory/c_program_logic/mem_own.h | 6 +- theory/c_program_logic/mem_ra.h | 6 +- theory/c_program_logic/mem_value.h | 41 ++-- theory/data/int_list.h | 71 +++++-- theory/data/list.h | 21 +- theory/logic/agree_ra.h | 31 +-- theory/logic/auth_ra.h | 181 ++++++++++++++--- theory/logic/basic_update.h | 69 ++++++- theory/logic/big_sep.h | 54 ++++- theory/logic/excl_ra.h | 22 +- theory/logic/excl_ra_internal.h | 24 ++- theory/logic/finmap.h | 246 +++++++++++------------ theory/logic/frac_ra.h | 55 +++-- theory/logic/gmap_ra.h | 178 ++++++++++++++-- theory/logic/gmap_ra_internal.h | 58 +++++- theory/logic/local_update.h | 60 ++++-- theory/logic/max_nat_ra.h | 16 +- theory/logic/named_logic.h | 39 ++++ theory/logic/named_ra.h | 60 +++++- theory/logic/option_ra.h | 40 ++-- theory/logic/option_ra_internal.h | 10 +- theory/logic/prod_ra.h | 96 +++++++-- theory/logic/prod_ra_internal.h | 8 +- theory/logic/product_resource.h | 132 ++++++++++++ theory/logic/product_resource_internal.h | 20 ++ theory/logic/ra.h | 137 +++++++++---- theory/logic/ra_builder.h | 35 +++- theory/logic/ra_internal.h | 60 +++++- theory/logic/resource_prop.h | 246 ++++++++++++++++++++++- theory/logic/resource_prop_internal.h | 46 +++++ theory/logic/unit_ra.h | 14 +- 39 files changed, 2275 insertions(+), 557 deletions(-) diff --git a/proof_sl.h b/proof_sl.h index c188e82..d57b602 100644 --- a/proof_sl.h +++ b/proof_sl.h @@ -754,8 +754,8 @@ PROOF term dest_sl_fact(const term tm); /** * Globally bound theorem turning SL-assertion equality into entailment. * - * After `sl_install_theory` succeeds, the value is exactly - * `∅ ⊢ ∀H K. (H = K) ⇒ (H ⊢SL K)`. + * HOL conclusion in the installed notation: + * `forall (H:sl_prop()) (K:sl_prop()). (H = K) ==> (H ⊢SL K)`. */ PROOF extern thm sl_ent_sym_left; @@ -768,9 +768,9 @@ PROOF extern thm sl_ent_sym_left; * H ⊢SL K * ``` * - * After installation, the value is exactly - * `∅ ⊢ ∀H H1 K K1. (H = H1) ⇒ (K = K1) ⇒` - * `(H1 ⊢SL K1) ⇒ (H ⊢SL K)`. + * HOL conclusion in the installed notation: + * `forall (H:sl_prop()) (H1:sl_prop()) (K:sl_prop()) (K1:sl_prop()). + * (H = H1) ==> (K = K1) ==> (H1 ⊢SL K1) ==> (H ⊢SL K)`. */ PROOF extern thm sl_ent_restate; @@ -783,25 +783,28 @@ PROOF extern thm sl_ent_restate; * H ⊢SL K * ``` * - * After installation, the value is exactly - * `∅ ⊢ ∀H F H1 K K1. (H = F ** H1) ⇒ (K = F ** K1) ⇒` - * `(H1 ⊢SL K1) ⇒ (H ⊢SL K)`. + * HOL conclusion in the installed notation: + * `forall (H:sl_prop()) (F:sl_prop()) (H1:sl_prop()) (K:sl_prop()) + * (K1:sl_prop()). (H = F ** H1) ==> (K = F ** K1) ==> (H1 ⊢SL K1) ==> + * (H ⊢SL K)`. */ PROOF extern thm sl_frame_restate; /** * Globally bound theorem for left framing. * - * After installation, the value is exactly - * `∅ ⊢ ∀H K F. (H ⊢SL K) ⇒ (F ** H ⊢SL F ** K)`. + * HOL conclusion in the installed notation: + * `forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). (H ⊢SL K) ==> + * (F ** H ⊢SL F ** K)`. */ PROOF extern thm sl_ent_frame_left; /** * Globally bound theorem for right framing. * - * After installation, the value is exactly - * `∅ ⊢ ∀H K F. (H ⊢SL K) ⇒ (H ** F ⊢SL K ** F)`. + * HOL conclusion in the installed notation: + * `forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). (H ⊢SL K) ==> + * (H ** F ⊢SL K ** F)`. */ PROOF extern thm sl_ent_frame_right; @@ -814,9 +817,10 @@ PROOF extern thm sl_ent_frame_right; * H ** F ⊢SL G * ``` * - * After installation, the value is exactly - * `∅ ⊢ ∀H K F C G. (H = K) ⇒ (C = K ** F) ⇒` - * `(C ⊢SL G) ⇒ (H ** F ⊢SL G)`. + * HOL conclusion in the installed notation: + * `forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()) (C:sl_prop()) + * (G:sl_prop()). (H = K) ==> (C = K ** F) ==> (C ⊢SL G) ==> + * (H ** F ⊢SL G)`. */ PROOF extern thm sl_ent_subst_frame; @@ -829,29 +833,34 @@ PROOF extern thm sl_ent_subst_frame; * H ⊢SL K * ``` * - * After installation, the value is exactly - * `∅ ⊢ ∀H H1 H2 K K1 K2. (H = H1 ** H2) ⇒` - * `(K = K1 ** K2) ⇒ (H1 ⊢SL K1) ⇒ (H2 ⊢SL K2) ⇒ (H ⊢SL K)`. + * HOL conclusion in the installed notation: + * `forall (H:sl_prop()) (H1:sl_prop()) (H2:sl_prop()) (K:sl_prop()) + * (K1:sl_prop()) (K2:sl_prop()). (H = H1 ** H2) ==> (K = K1 ** K2) ==> + * (H1 ⊢SL K1) ==> (H2 ⊢SL K2) ==> (H ⊢SL K)`. */ PROOF extern thm sl_sep_combine; /** * Return the equality laws used by the HOL AC prover for `**`. * - * After installation, its exact conclusion is - * `concl(sl_sep_comm()) ∧ (concl(sl_sep_assoc()) ∧` - * `(∀H K F. H ** (K ** F) = K ** (H ** F)))`. Thus the conjunction order - * is commutativity, associativity, then lifted commutativity. Pass this theorem - * to `ac_rule`; units are not part of this AC theory. + * HOL conclusion in the installed notation: + * `(forall (H:sl_prop()) (K:sl_prop()). H ** K = K ** H) /\ ((forall + * (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). (H ** K) ** F = + * H ** (K ** F)) /\ (forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). + * H ** (K ** F) = K ** (H ** F)))`. + * + * The conjunction order is commutativity, associativity, then lifted + * commutativity. Pass this theorem to `ac_rule`; units are not part of this + * AC theory. */ PROOF extern thm sl_ac_rule; /** * Globally bound theorem for monotonicity of additive disjunction. * - * After installation, the value is exactly - * `∅ ⊢ ∀H1 H2 K1 K2. (H1 ⊢SL K1) ⇒ (H2 ⊢SL K2) ⇒` - * `((H1 || H2) ⊢SL (K1 || K2))`. + * HOL conclusion in the installed notation: + * `forall (H1:sl_prop()) (H2:sl_prop()) (K1:sl_prop()) (K2:sl_prop()). + * (H1 ⊢SL K1) ==> (H2 ⊢SL K2) ==> ((H1 || H2) ⊢SL (K1 || K2))`. */ PROOF extern thm sl_disj_mono; @@ -865,49 +874,56 @@ PROOF extern thm sl_disj_mono; * P ⊢SL G * ``` * - * After installation, the value is exactly - * `∅ ⊢ ∀H K F C₁ C₂ P G. (C₁ = H ** F) ⇒ (C₂ = K ** F) ⇒` - * `(P = (H || K) ** F) ⇒ (C₁ ⊢SL G) ⇒ (C₂ ⊢SL G) ⇒ (P ⊢SL G)`. + * HOL conclusion in the installed notation: + * `forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()) (C1:sl_prop()) + * (C2:sl_prop()) (P:sl_prop()) (G:sl_prop()). (C1 = H ** F) ==> + * (C2 = K ** F) ==> (P = (H || K) ** F) ==> (C1 ⊢SL G) ==> + * (C2 ⊢SL G) ==> (P ⊢SL G)`. */ PROOF extern thm sl_or_elim_frame; /** * Globally bound theorem for magic-wand elimination. * - * After installation, the value is exactly - * `∅ ⊢ ∀H K G. (H ⊢SL (K -* G)) ⇒ (H ** K ⊢SL G)`. + * HOL conclusion in the installed notation: + * `forall (H:sl_prop()) (K:sl_prop()) (G:sl_prop()). + * (H ⊢SL (K -* G)) ==> (H ** K ⊢SL G)`. */ PROOF extern thm sl_undisch; /** * Globally bound theorem projecting the left additive conjunct. * - * The result is exactly - * `∅ ⊢ ∀H K F. (H ⊢SL (K && F)) ⇒ (H ⊢SL K)`. + * HOL conclusion in the installed notation: + * `forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). + * (H ⊢SL (K && F)) ==> (H ⊢SL K)`. */ PROOF extern thm sl_conj1; /** * Globally bound theorem projecting the right additive conjunct. * - * The result is exactly - * `∅ ⊢ ∀H K F. (H ⊢SL (K && F)) ⇒ (H ⊢SL F)`. + * HOL conclusion in the installed notation: + * `forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). + * (H ⊢SL (K && F)) ==> (H ⊢SL F)`. */ PROOF extern thm sl_conj2; /** * Globally bound theorem injecting into the left disjunct. * - * The result is exactly - * `∅ ⊢ ∀H K F. (H ⊢SL K) ⇒ (H ⊢SL (K || F))`. + * HOL conclusion in the installed notation: + * `forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). + * (H ⊢SL K) ==> (H ⊢SL (K || F))`. */ PROOF extern thm sl_disj1_mono; /** * Globally bound theorem injecting into the right disjunct. * - * The result is exactly - * `∅ ⊢ ∀F H K. (H ⊢SL K) ⇒ (H ⊢SL (F || K))`. + * HOL conclusion in the installed notation: + * `forall (F:sl_prop()) (H:sl_prop()) (K:sl_prop()). + * (H ⊢SL K) ==> (H ⊢SL (F || K))`. */ PROOF extern thm sl_disj2_mono; @@ -918,18 +934,18 @@ PROOF extern thm sl_disj2_mono; * ∅ ⊢ (∀x. (B(x) ** F ⊢SL K)) ⇒ ((∃SL x. B(x)) ** F ⊢SL K) * ``` * - * For every type `α`, the value is exactly - * `∅ ⊢ ∀B:α→sl_prop() F K. (∀x:α. B(x) ** F ⊢SL K) ⇒` - * `((∃SL x:α. B(x)) ** F ⊢SL K)`. + * HOL conclusion in the installed notation: + * `forall (B:A->sl_prop()) (F:sl_prop()) (K:sl_prop()). + * (forall x:A. B x ** F ⊢SL K) ==> ((∃SL x:A. B x) ** F ⊢SL K)`. */ PROOF extern thm sl_exists_elim_frame; /** * Globally bound theorem for SL-existential introduction. * - * For every type `α`, return exactly - * `∅ ⊢ ∀w:α H B:α→sl_prop(). (H ⊢SL B(w)) ⇒` - * `(H ⊢SL ∃SL x:α. B(x))`. + * HOL conclusion in the installed notation: + * `forall (w:A) (H:sl_prop()) (B:A->sl_prop()). + * (H ⊢SL B w) ==> (H ⊢SL ∃SL x:A. B x)`. */ PROOF extern thm sl_exists_wit; diff --git a/test/dependency_v2_regression.sh b/test/dependency_v2_regression.sh index 6c6c3da..1c4d691 100755 --- a/test/dependency_v2_regression.sh +++ b/test/dependency_v2_regression.sh @@ -81,6 +81,12 @@ while IFS= read -r header; do public_headers+=("$header") done < <(find "$theory_dir" -type f -name '*.h' ! -name '*_internal.h' -print) +theorem_headers=() +while IFS= read -r header; do + theorem_headers+=("$header") +done < <(rg -l '^PROOF[[:space:]]+extern[[:space:]]+thm[[:space:]]+' \ + "$proof_root" --glob '*.h') + reject_matches \ "public header exposes removed ra_update_nd" \ '\bra_update_nd\b' \ @@ -141,6 +147,57 @@ done < - * c_bupd G Q resource ==> - * exists ghost'. Q (FST resource,ghost'). + * forall + * (G:(A)ra) + * (Q:(((int,(pmem_byte_state)excl)finmap)#A)->bool) + * (resource:((int,(pmem_byte_state)excl)finmap)#A). + * ra_valid (c_resource_ra G) resource ==> + * c_bupd G Q resource ==> + * exists ghost':A. Q (FST resource,ghost') * ``` */ PROOF extern thm c_bupd_preserves_phys; diff --git a/theory/c_program_logic/c_ghost.h b/theory/c_program_logic/c_ghost.h index 04c1290..4bf3f29 100644 --- a/theory/c_program_logic/c_ghost.h +++ b/theory/c_program_logic/c_ghost.h @@ -18,15 +18,62 @@ #include "proof/theory/logic/named_ra.h" /* Generic laws for an arbitrary complete global RA `G`. */ -/** Ghost ownership preserves `ra_op` splitting/joining up to `r_equiv`. */ +/** + * ```text + * forall (G:(A)ra) (a:A) (b:A). + * r_equiv + * (c_resource_ra G) + * (c_ghost_own G (ra_op G a b)) + * (r_sep (c_resource_ra G) + * (c_ghost_own G a) (c_ghost_own G b)) + * ``` + */ PROOF extern thm c_ghost_own_op; -/** Expose `ra_valid G a` as an exact-unit fact while retaining ownership. */ + +/** + * ```text + * forall (G:(A)ra) (a:A). + * r_entails + * (c_resource_ra G) + * (c_ghost_own G a) + * (r_sep (c_resource_ra G) + * (r_fact (c_resource_ra G) (ra_valid G a)) + * (c_ghost_own G a)) + * ``` + */ PROOF extern thm c_ghost_own_valid; -/** Lift a deterministic `ra_update G a b` to a ghost-only C view shift. */ + +/** + * ```text + * forall (G:(A)ra) (a:A) (b:A). + * ra_update G a b ==> + * c_viewshift G (c_ghost_own G a) (c_ghost_own G b) + * ``` + */ PROOF extern thm c_ghost_own_update; -/** Lift `ra_updateP`; return a witness, exact-unit fact, and new ownership. */ + +/** + * ```text + * forall (G:(A)ra) (a:A) (P:A->bool). + * ra_updateP G a P ==> + * c_viewshift G + * (c_ghost_own G a) + * (r_exists (c_resource_ra G) (\b:A. + * r_sep (c_resource_ra G) + * (r_fact (c_resource_ra G) (P b)) + * (c_ghost_own G b))) + * ``` + */ PROOF extern thm c_ghost_own_updateP; -/** Explicitly discard the owned global ghost fragment. */ + +/** + * ```text + * forall (G:(A)ra) (a:A). + * c_viewshift G + * (c_ghost_own G a) + * (r_emp (c_resource_ra G)) + * ``` + */ PROOF extern thm c_ghost_own_drop; /** @@ -36,17 +83,88 @@ PROOF extern thm c_ghost_own_drop; * assertion. “Drop” is intentional: this API does not call the operation * deallocation. */ -/** Exact ownership of payload `a` at `name` in `named_ra R`. */ +/** + * ```text + * c_named_own (R:(A)ra) (name:num) (a:A) = + * c_ghost_own (named_ra R) (finmap_singleton name a) + * ``` + */ PROOF extern thm c_named_own_def; -/** Named ownership preserves payload `ra_op` up to `r_equiv`. */ + +/** + * ```text + * forall (R:(A)ra) (name:num) (a:A) (b:A). + * r_equiv + * (c_resource_ra (named_ra R)) + * (c_named_own R name (ra_op R a b)) + * (r_sep (c_resource_ra (named_ra R)) + * (c_named_own R name a) + * (c_named_own R name b)) + * ``` + */ PROOF extern thm c_named_own_op; -/** Expose payload validity as an exact-unit fact and retain named ownership. */ + +/** + * ```text + * forall (R:(A)ra) (name:num) (a:A). + * r_entails + * (c_resource_ra (named_ra R)) + * (c_named_own R name a) + * (r_sep (c_resource_ra (named_ra R)) + * (r_fact (c_resource_ra (named_ra R)) (ra_valid R a)) + * (c_named_own R name a)) + * ``` + */ PROOF extern thm c_named_own_valid; -/** Update the payload at one fixed name. */ + +/** + * ```text + * forall (R:(A)ra) (name:num) (a:A) (b:A). + * ra_update R a b ==> + * c_viewshift (named_ra R) + * (c_named_own R name a) + * (c_named_own R name b) + * ``` + */ PROOF extern thm c_named_own_update; -/** Predicate-update one name and return witness, fact, and new ownership. */ + +/** + * ```text + * forall (R:(A)ra) (name:num) (a:A) (P:A->bool). + * ra_updateP R a P ==> + * c_viewshift (named_ra R) + * (c_named_own R name a) + * (r_exists (c_resource_ra (named_ra R)) (\b:A. + * r_sep (c_resource_ra (named_ra R)) + * (r_fact (c_resource_ra (named_ra R)) (P b)) + * (c_named_own R name b))) + * ``` + */ PROOF extern thm c_named_own_updateP; -/** Drop this fragment's contribution at one fixed name. */ + +/** + * ```text + * forall (R:(A)ra) (name:num) (a:A). + * c_viewshift (named_ra R) + * (c_named_own R name a) + * (r_emp (c_resource_ra (named_ra R))) + * ``` + */ PROOF extern thm c_named_own_drop; -/** Allocate a fresh name for a valid payload while framing the source. */ + +/** + * ```text + * forall + * (R:(A)ra) + * (a:A) + * (P:(((int,(pmem_byte_state)excl)finmap)#(num,A)finmap)->bool). + * ra_valid R a ==> + * c_viewshift (named_ra R) + * P + * (r_exists (c_resource_ra (named_ra R)) (\name:num. + * r_sep (c_resource_ra (named_ra R)) + * (c_named_own R name a) + * P)) + * ``` + */ PROOF extern thm c_named_own_alloc; diff --git a/theory/c_program_logic/c_integer.h b/theory/c_program_logic/c_integer.h index 2f5ac56..6a9e1a2 100644 --- a/theory/c_program_logic/c_integer.h +++ b/theory/c_program_logic/c_integer.h @@ -14,29 +14,47 @@ /* Width-generic C integer conversion */ /* ------------------------------------------------------------------------- */ -/** `exp_2 n = &(2 EXP num_of_int n)`. */ +/** `exp_2 (width:int) = &(2 EXP num_of_int width)`. */ PROOF extern thm c_exp_2_def; -/** `max_unsigned n = exp_2 n - 1`. */ +/** `max_unsigned (width:int) = exp_2 width - &1`. */ PROOF extern thm c_max_unsigned_def; -/** `max_signed n = exp_2 (n - 1) - 1`. */ +/** `max_signed (width:int) = exp_2 (width - &1) - &1`. */ PROOF extern thm c_max_signed_def; -/** `min_signed n = -exp_2 (n - 1)`. */ +/** `min_signed (width:int) = --(exp_2 (width - &1))`. */ PROOF extern thm c_min_signed_def; -/** `cast_unsigned n z = z rem exp_2 n`. */ +/** `cast_unsigned (width:int) (value:int) = value rem exp_2 width`. */ PROOF extern thm cast_unsigned_def; -/** Width-generic two's-complement signed conversion. */ + +/** + * ```text + * cast_signed (width:int) (value:int) = + * let unsigned_value = cast_unsigned width value in + * if unsigned_value < exp_2 (width - &1) + * then unsigned_value + * else unsigned_value - exp_2 width. + * ``` + */ PROOF extern thm cast_signed_def; -/** `unsigned_last_nbits x n = cast_unsigned n x`. */ + +/** + * `unsigned_last_nbits (value:int) (width:int) = + * cast_unsigned width value`. + */ PROOF extern thm unsigned_last_nbits_def; -/** `signed_last_nbits x n = cast_signed n x`. */ + +/** + * `signed_last_nbits (value:int) (width:int) = + * cast_signed width value`. + */ PROOF extern thm signed_last_nbits_def; /** * Conversion identity in the unsigned range: * * ```text - * |- forall x n. 0 <= x /\ x < exp_2 n ==> - * unsigned_last_nbits x n = x + * forall (value:int) (width:int). + * &0 <= value && value < exp_2 width ==> + * unsigned_last_nbits value width = value * ``` */ PROOF extern thm unsigned_last_nbits_id; @@ -45,27 +63,134 @@ PROOF extern thm unsigned_last_nbits_id; /* Fixed-width bit operations */ /* ------------------------------------------------------------------------- */ +/** + * `i32_and (x:int) (y:int) = + * ival (word_and ((iword x):(32)word) ((iword y):(32)word))`. + */ PROOF extern thm i32_and_def; + +/** + * `i32_or (x:int) (y:int) = + * ival (word_or ((iword x):(32)word) ((iword y):(32)word))`. + */ PROOF extern thm i32_or_def; + +/** + * `i32_xor (x:int) (y:int) = + * ival (word_xor ((iword x):(32)word) ((iword y):(32)word))`. + */ PROOF extern thm i32_xor_def; + +/** `i32_not (x:int) = ival (word_not ((iword x):(32)word))`. */ PROOF extern thm i32_not_def; + +/** + * `i32_shl (x:int) (y:int) = + * ival (word_shl ((iword x):(32)word) (num_of_int y))`. + */ PROOF extern thm i32_shl_def; + +/** + * `i32_shr (x:int) (y:int) = + * ival (word_ishr ((iword x):(32)word) (num_of_int y))`. + */ PROOF extern thm i32_shr_def; + +/** + * `u32_and (x:int) (y:int) = + * &(val (word_and ((iword x):(32)word) ((iword y):(32)word)))`. + */ PROOF extern thm u32_and_def; + +/** + * `u32_or (x:int) (y:int) = + * &(val (word_or ((iword x):(32)word) ((iword y):(32)word)))`. + */ PROOF extern thm u32_or_def; + +/** + * `u32_xor (x:int) (y:int) = + * &(val (word_xor ((iword x):(32)word) ((iword y):(32)word)))`. + */ PROOF extern thm u32_xor_def; + +/** `u32_not (x:int) = &(val (word_not ((iword x):(32)word)))`. */ PROOF extern thm u32_not_def; + +/** + * `u32_shl (x:int) (y:int) = + * &(val (word_shl ((iword x):(32)word) (num_of_int y)))`. + */ PROOF extern thm u32_shl_def; + +/** + * `u32_shr (x:int) (y:int) = + * &(val (word_ushr ((iword x):(32)word) (num_of_int y)))`. + */ PROOF extern thm u32_shr_def; + +/** + * `i64_and (x:int) (y:int) = + * ival (word_and ((iword x):(64)word) ((iword y):(64)word))`. + */ PROOF extern thm i64_and_def; + +/** + * `i64_or (x:int) (y:int) = + * ival (word_or ((iword x):(64)word) ((iword y):(64)word))`. + */ PROOF extern thm i64_or_def; + +/** + * `i64_xor (x:int) (y:int) = + * ival (word_xor ((iword x):(64)word) ((iword y):(64)word))`. + */ PROOF extern thm i64_xor_def; + +/** `i64_not (x:int) = ival (word_not ((iword x):(64)word))`. */ PROOF extern thm i64_not_def; + +/** + * `i64_shl (x:int) (y:int) = + * ival (word_shl ((iword x):(64)word) (num_of_int y))`. + */ PROOF extern thm i64_shl_def; + +/** + * `i64_shr (x:int) (y:int) = + * ival (word_ishr ((iword x):(64)word) (num_of_int y))`. + */ PROOF extern thm i64_shr_def; + +/** + * `u64_and (x:int) (y:int) = + * &(val (word_and ((iword x):(64)word) ((iword y):(64)word)))`. + */ PROOF extern thm u64_and_def; + +/** + * `u64_or (x:int) (y:int) = + * &(val (word_or ((iword x):(64)word) ((iword y):(64)word)))`. + */ PROOF extern thm u64_or_def; + +/** + * `u64_xor (x:int) (y:int) = + * &(val (word_xor ((iword x):(64)word) ((iword y):(64)word)))`. + */ PROOF extern thm u64_xor_def; + +/** `u64_not (x:int) = &(val (word_not ((iword x):(64)word)))`. */ PROOF extern thm u64_not_def; + +/** + * `u64_shl (x:int) (y:int) = + * &(val (word_shl ((iword x):(64)word) (num_of_int y)))`. + */ PROOF extern thm u64_shl_def; + +/** + * `u64_shr (x:int) (y:int) = + * &(val (word_ushr ((iword x):(64)word) (num_of_int y)))`. + */ PROOF extern thm u64_shr_def; diff --git a/theory/c_program_logic/c_memory.h b/theory/c_program_logic/c_memory.h index d14fb6e..cdfc819 100644 --- a/theory/c_program_logic/c_memory.h +++ b/theory/c_program_logic/c_memory.h @@ -48,7 +48,11 @@ * Constructor distinctness for the built-in `ctype` datatype. This theorem * is obtained from HOL Light's datatype package (not postulated): * - * Ti <> Tj for every pair of distinct `ctype` constructors Ti,Tj. + * ~(Ti args_i == Tj args_j) + * + * for every pair of distinct `ctype` constructors `Ti` and `Tj`, with all + * constructor arguments universally quantified. This is the conjunction + * returned by `get_datatype_distinctness("ctype")`. * * It is deliberately a proof-side normalization rule. Clients specialize a * memory theorem to a concrete `ctype`, rewrite with this theorem, and only @@ -72,36 +76,50 @@ PROOF extern thm pmem_ctype_distinct; PROOF extern thm pmem_c_scalar_type_def; /* - * Total scalar width in bytes: - * - * Tchar/Tuchar -> 1 - * Tshort/Tushort -> 2 - * Tint/Tuint -> 4 - * Tint64/Tuint64/Tptr-> 8 - * unsupported type -> 0. + * ```text + * pmem_c_width (ty:ctype) = + * if ty == Tchar then 1 else + * if ty == Tuchar then 1 else + * if ty == Tshort then 2 else + * if ty == Tushort then 2 else + * if ty == Tint then 4 else + * if ty == Tuint then 4 else + * if ty == Tint64 then 8 else + * if ty == Tuint64 then 8 else + * if ty == Tptr then 8 else 0 + * ``` */ PROOF extern thm pmem_c_width_def; /* - * Total minimum scalar value: - * - * Tchar -> -128 Tuchar -> 0 - * Tshort -> -32768 Tushort -> 0 - * Tint -> -2147483648 Tuint -> 0 - * Tint64 -> -9223372036854775808 Tuint64 -> 0 - * Tptr -> 0 fallback-> 0. + * ```text + * pmem_c_min (ty:ctype) = + * if ty == Tchar then --(&128) else + * if ty == Tuchar then &0 else + * if ty == Tshort then --(&32768) else + * if ty == Tushort then &0 else + * if ty == Tint then --(&2147483648) else + * if ty == Tuint then &0 else + * if ty == Tint64 then --(&9223372036854775808) else + * if ty == Tuint64 then &0 else + * if ty == Tptr then &0 else &0 + * ``` */ PROOF extern thm pmem_c_min_def; /* - * Total maximum scalar value: - * - * Tchar -> 127 Tuchar -> 255 - * Tshort -> 32767 Tushort -> 65535 - * Tint -> 2147483647 Tuint -> 4294967295 - * Tint64 -> 9223372036854775807 - * Tuint64/Tptr -> 18446744073709551615 - * fallback -> 0. + * ```text + * pmem_c_max (ty:ctype) = + * if ty == Tchar then &127 else + * if ty == Tuchar then &255 else + * if ty == Tshort then &32767 else + * if ty == Tushort then &65535 else + * if ty == Tint then &2147483647 else + * if ty == Tuint then &4294967295 else + * if ty == Tint64 then &9223372036854775807 else + * if ty == Tuint64 then &18446744073709551615 else + * if ty == Tptr then &18446744073709551615 else &0 + * ``` */ PROOF extern thm pmem_c_max_def; @@ -128,15 +146,21 @@ PROOF extern thm pmem_c_address_ok_def; */ PROOF extern thm pmem_uint64_address_ok_def; -/** QCP-safe pointer specialization of `pmem_c_address_ok`. */ +/** + * `pmem_ptr_address_ok (address:int) <=> + * pmem_c_address_ok address Tptr`. + */ PROOF extern thm pmem_ptr_address_ok_def; /* * Scalar value range: * - * pmem_c_value_ok ty value ⇔ + * ```text + * pmem_c_value_ok ty integer_value ⇔ * pmem_c_scalar_type ty ∧ - * pmem_c_min ty <= value ∧ value <= pmem_c_max ty. + * pmem_c_min ty <= integer_value ∧ + * integer_value <= pmem_c_max ty. + * ``` */ PROOF extern thm pmem_c_value_ok_def; @@ -163,12 +187,14 @@ PROOF extern thm pmem_c_address_ok_Tuint64; /* * Initialized scalar storage: * - * pmem_data_at address ty value == + * ```text + * pmem_data_at address ty integer_value == * r_and mem_ra * (r_pure mem_ra * (pmem_c_address_ok address ty ∧ - * pmem_c_value_ok ty value)) - * (pmem_scalar_at address (pmem_c_width ty) value). + * pmem_c_value_ok ty integer_value)) + * (pmem_scalar_at address (pmem_c_width ty) integer_value). + * ``` * * The second conjunct owns the exact little-endian bytes; the first imposes * the C ABI side conditions without consuming a second resource. @@ -178,10 +204,12 @@ PROOF extern thm pmem_data_at_def; /* * Owned scalar storage of unknown current contents at a valid C address: * + * ```text * pmem_undef_data_at address ty == * r_and mem_ra * (r_pure mem_ra (pmem_c_address_ok address ty)) * (pmem_allocated_at address (pmem_c_width ty)). + * ``` * * Each byte may be physically uninitialized or initialized. The predicate * grants writable ownership but no readable value; QCP therefore permits an @@ -190,10 +218,24 @@ PROOF extern thm pmem_data_at_def; */ PROOF extern thm pmem_undef_data_at_def; -/** Initialized typed storage entails its allocated byte range. */ +/** + * ```text + * forall (address:int) (ty:ctype) (integer_value:int). + * r_entails mem_ra + * (pmem_data_at address ty integer_value) + * (pmem_allocated_at address (pmem_c_width ty)) + * ``` + */ PROOF extern thm pmem_data_at_allocated_at; -/** Unknown-content typed storage entails its allocated byte range. */ +/** + * ```text + * forall (address:int) (ty:ctype). + * r_entails mem_ra + * (pmem_undef_data_at address ty) + * (pmem_allocated_at address (pmem_c_width ty)) + * ``` + */ PROOF extern thm pmem_undef_data_at_allocated_at; /** @@ -201,14 +243,23 @@ PROOF extern thm pmem_undef_data_at_allocated_at; * storage: * * ```text - * ⊢ address_ok address ty ⇒ - * pmem_allocated_at address (width ty) ⊢_mem - * pmem_undef_data_at address ty. + * forall (address:int) (ty:ctype). + * pmem_c_address_ok address ty ==> + * r_entails mem_ra + * (pmem_allocated_at address (pmem_c_width ty)) + * (pmem_undef_data_at address ty) * ``` */ PROOF extern thm pmem_allocated_at_to_undef_data_at; -/** Initialized typed storage may forget its value and initialization detail. */ +/** + * ```text + * forall (address:int) (ty:ctype) (integer_value:int). + * r_entails mem_ra + * (pmem_data_at address ty integer_value) + * (pmem_undef_data_at address ty) + * ``` + */ PROOF extern thm pmem_data_at_to_undef_data_at; /** @@ -242,21 +293,28 @@ PROOF extern thm c_allocated_at_def; /* * Exact physical lift with an empty ghost projection: * - * c_data_at G address ty value == - * c_lift_phys G (pmem_data_at address ty value). + * ```text + * c_data_at G address ty integer_value == + * c_lift_phys G (pmem_data_at address ty integer_value). + * ``` */ PROOF extern thm c_data_at_def; /* * Exact physical lift with an empty ghost projection: * + * ```text * c_undef_data_at G address ty == * c_lift_phys G (pmem_undef_data_at address ty). + * ``` */ PROOF extern thm c_undef_data_at_def; /** - * Concrete normalization: zero allocated bytes are the separating unit. + * ```text + * forall (G:(A)ra) (address:int). + * c_allocated_at G address 0 == r_emp (c_resource_ra G) + * ``` * This is a raw equation for the named memory predicate, not a generic BI * connective law. */ @@ -278,27 +336,68 @@ PROOF extern thm c_allocated_at_zero; */ PROOF extern thm c_allocated_at_append; -/** Lifted allocated-to-unknown typed view, requiring C address validity. */ +/** + * ```text + * forall (G:(A)ra) (address:int) (ty:ctype). + * pmem_c_address_ok address ty ==> + * r_entails (c_resource_ra G) + * (c_allocated_at G address (pmem_c_width ty)) + * (c_undef_data_at G address ty) + * ``` + */ PROOF extern thm c_allocated_at_to_undef_data_at; -/** Lifted initialized storage entails the QCP unknown-content memory atom. */ +/** + * ```text + * forall (G:(A)ra) (address:int) (ty:ctype) (integer_value:int). + * r_entails (c_resource_ra G) + * (c_data_at G address ty integer_value) + * (c_undef_data_at G address ty) + * ``` + */ PROOF extern thm c_data_at_to_undef_data_at; -/** Lifted initialized typed storage entails arbitrary allocated bytes. */ +/** + * ```text + * forall (G:(A)ra) (address:int) (ty:ctype) (integer_value:int). + * r_entails (c_resource_ra G) + * (c_data_at G address ty integer_value) + * (c_allocated_at G address (pmem_c_width ty)) + * ``` + */ PROOF extern thm c_data_at_allocated_at; -/** Lifted unknown-content typed storage entails allocated bytes. */ +/** + * ```text + * forall (G:(A)ra) (address:int) (ty:ctype). + * r_entails (c_resource_ra G) + * (c_undef_data_at G address ty) + * (c_allocated_at G address (pmem_c_width ty)) + * ``` + */ PROOF extern thm c_undef_data_at_allocated_at; /** * Initialized scalar ownership exposes its represented-value bounds while * retaining the cell: * - * c_data_at G address ty value ⊢_G - * r_sep (c_resource_ra G) - * (c_data_at G address ty value) - * (r_fact (c_resource_ra G) - * (pmem_c_min ty <= value /\ value <= pmem_c_max ty)). + * ```text + * forall + * (G:(A)ra) + * (address:int) + * (ty:ctype) + * (integer_value:int). + * r_entails + * (c_resource_ra G) + * (c_data_at G address ty integer_value) + * (r_sep + * (c_resource_ra G) + * (c_data_at G address ty integer_value) + * (r_fact + * (c_resource_ra G) + * (pmem_c_min ty <= integer_value && + * integer_value <= pmem_c_max ty))) + * ``` * * `r_fact`, rather than resource-independent `r_pure`, makes the exposed * bounds an exact-unit spatial conjunct. diff --git a/theory/c_program_logic/c_resource.h b/theory/c_program_logic/c_resource.h index f384c0f..9b1b7ea 100644 --- a/theory/c_program_logic/c_resource.h +++ b/theory/c_program_logic/c_resource.h @@ -27,27 +27,77 @@ #include "proof/theory/logic/product_resource.h" /* Complete C resource and its componentwise algebra. */ -/** `c_resource_ra G == prod_ra mem_ra G`. */ +/** + * ```text + * c_resource_ra (G:(A)ra) == prod_ra mem_ra G + * ``` + * Both sides have type + * `(((int,(pmem_byte_state)excl)finmap)#A)ra`. + */ PROOF extern thm c_resource_ra_def; -/** The unit of `c_resource_ra G` is `(ra_unit mem_ra, ra_unit G)`. */ + +/** + * `forall G:(A)ra. ra_unit (c_resource_ra G) == + * (ra_unit mem_ra,ra_unit G)`. + */ PROOF extern thm c_resource_ra_unit; -/** Composition in `c_resource_ra G` is componentwise. */ + +/** + * ```text + * forall (G:(A)ra) (x:Mem#A) (y:Mem#A). + * ra_op (c_resource_ra G) x y == + * (ra_op mem_ra (FST x) (FST y), + * ra_op G (SND x) (SND y)) + * ``` + * Here `Mem` abbreviates `(int,(pmem_byte_state)excl)finmap`. + */ PROOF extern thm c_resource_ra_op; -/** Validity in `c_resource_ra G` is validity of both projections. */ + +/** + * ```text + * forall (G:(A)ra) (resource:Mem#A). + * ra_valid (c_resource_ra G) resource <=> + * ra_valid mem_ra (FST resource) && + * ra_valid G (SND resource) + * ``` + * Here `Mem` abbreviates `(int,(pmem_byte_state)excl)finmap`. + */ PROOF extern thm c_resource_ra_valid; /* Exact product lifts; the unselected projection is exactly unit. */ -/** `c_lift_phys G P == r_lift_left mem_ra G P`. */ +/** + * `c_lift_phys (G:(A)ra) (P:Mem->bool) = + * r_lift_left mem_ra G P`, where + * `Mem = (int,(pmem_byte_state)excl)finmap`. + */ PROOF extern thm c_lift_phys_def; -/** `c_lift_ghost G Q == r_lift_right mem_ra G Q`. */ + +/** + * `c_lift_ghost (G:(A)ra) (Q:A->bool) = + * r_lift_right mem_ra G Q`. + */ PROOF extern thm c_lift_ghost_def; /* Exact ownership of an arbitrary fragment of the complete global ghost RA. */ -/** `c_ghost_own G a == c_lift_ghost G (r_own G a)`. */ +/** + * `c_ghost_own (G:(A)ra) (ghost:A) = + * c_lift_ghost G (r_own G ghost)`. + */ PROOF extern thm c_ghost_own_def; /* Exact physical lifts of canonical uninitialized and initialized bytes. */ -/** Lift exact ownership of `pmem_uninit address` into `c_resource_ra G`. */ +/** + * ```text + * c_pmem_uninit_at (G:(A)ra) (address:int) = + * c_lift_phys G (r_own mem_ra (pmem_uninit address)) + * ``` + */ PROOF extern thm c_pmem_uninit_at_def; -/** Lift exact ownership of `pmem_byte address byte` into `c_resource_ra G`. */ + +/** + * ```text + * c_pmem_byte_at (G:(A)ra) (address:int) (byte:int) = + * c_lift_phys G (r_own mem_ra (pmem_byte address byte)) + * ``` + */ PROOF extern thm c_pmem_byte_at_def; diff --git a/theory/c_program_logic/c_types.h b/theory/c_program_logic/c_types.h index 696803f..fd7efb9 100644 --- a/theory/c_program_logic/c_types.h +++ b/theory/c_program_logic/c_types.h @@ -31,14 +31,29 @@ PROOF extern indtype ctype_type; /** - * Defining equations for `sizeof : ctype -> int`. Scalar sizes are 1/2/4/8 - * bytes. `Tfun` has the provisional pointer width 8. A structure has abstract - * natural size `&(c_struct_size name field_names field_types)`. + * ```text + * (sizeof Tchar = &1) /\ + * (sizeof Tuchar = &1) /\ + * (sizeof Tshort = &2) /\ + * (sizeof Tushort = &2) /\ + * (sizeof Tint = &4) /\ + * (sizeof Tuint = &4) /\ + * (sizeof Tint64 = &8) /\ + * (sizeof Tuint64 = &8) /\ + * (sizeof Tptr = &8) /\ + * (!argument_names argument_types return_type. + * sizeof (Tfun argument_names argument_types return_type) = &8) /\ + * (!name field_names field_types. + * sizeof (Tstruct name field_names field_types) = + * &(c_struct_size name field_names field_types)) + * ``` */ PROOF extern thm sizeof_def; /** - * `field_addr (base:int) structure field = - * base + field_offset structure field`. + * ```text + * field_addr (base:int) (structure:struct_name) (field_name:field) == + * base + field_offset structure field_name + * ``` */ PROOF extern thm field_addr_prop; diff --git a/theory/c_program_logic/mem_own.h b/theory/c_program_logic/mem_own.h index 1d0e77e..585acf8 100644 --- a/theory/c_program_logic/mem_own.h +++ b/theory/c_program_logic/mem_own.h @@ -19,19 +19,19 @@ /** * Defining theorem for exact memory ownership: - * `⊢ ∀memory. pmem_own memory == r_own mem_ra memory`. + * `pmem_own memory == r_own mem_ra memory`. */ PROOF extern thm pmem_own_def; /** * Defining theorem for one allocated, uninitialized byte: - * `⊢ ∀address. pmem_uninit_at address == pmem_own (pmem_uninit address)`. + * `pmem_uninit_at address == pmem_own (pmem_uninit address)`. */ PROOF extern thm pmem_uninit_at_def; /** * Defining theorem for one initialized byte: - * `⊢ ∀address byte. pmem_byte_at address byte == + * `pmem_byte_at address byte == * pmem_own (pmem_byte address byte)`. */ PROOF extern thm pmem_byte_at_def; diff --git a/theory/c_program_logic/mem_ra.h b/theory/c_program_logic/mem_ra.h index 7d1da6a..8ed2ab3 100644 --- a/theory/c_program_logic/mem_ra.h +++ b/theory/c_program_logic/mem_ra.h @@ -94,21 +94,21 @@ PROOF extern thm mem_ra_valid; /** * Canonical singleton definition: - * `⊢ ∀address state. pmem_singleton address state = + * `pmem_singleton address state == * finmap_singleton address (Excl state)`. */ PROOF extern thm pmem_singleton_def; /** * Uninitialized singleton definition: - * `⊢ ∀address. pmem_uninit address = + * `pmem_uninit address == * pmem_singleton address PMemUninit`. */ PROOF extern thm pmem_uninit_def; /** * Initialized singleton definition: - * `⊢ ∀address byte. pmem_byte address byte = + * `pmem_byte address byte == * pmem_singleton address (PMemByte byte)`. */ PROOF extern thm pmem_byte_def; diff --git a/theory/c_program_logic/mem_value.h b/theory/c_program_logic/mem_value.h index 020a0a6..4c72596 100644 --- a/theory/c_program_logic/mem_value.h +++ b/theory/c_program_logic/mem_value.h @@ -34,11 +34,10 @@ /** * One allocated byte with unspecified initialization state: * - * ⊢ ∀address:int. - * pmem_allocated_byte_at address = - * r_exists mem_ra - * (\state:pmem_byte_state. - * pmem_own (pmem_singleton address state)). + * pmem_allocated_byte_at (address:int) == + * r_exists mem_ra + * (\state:pmem_byte_state. + * pmem_own (pmem_singleton address state)). * * Hence the witness may be `PMemUninit` or `PMemByte byte`. This is the * content-forgetting assertion used for raw allocated memory. It is strictly @@ -52,11 +51,13 @@ PROOF extern thm pmem_allocated_byte_at_def; /* * Exact ownership of initialized bytes at consecutive addresses: * - * pmem_bytes_at base [] == r_emp mem_ra + * ```text + * pmem_bytes_at base [] == r_emp mem_ra && * pmem_bytes_at base (byte :: bytes) == * r_sep mem_ra * (pmem_byte_at base byte) * (pmem_bytes_at (base + &1) bytes). + * ``` */ PROOF extern thm pmem_bytes_at_def; @@ -74,7 +75,7 @@ PROOF extern thm pmem_bytes_at_cons; * Exact ownership of `count` consecutive allocated bytes with unspecified * contents: * - * pmem_allocated_at base 0 == r_emp mem_ra + * pmem_allocated_at base 0 == r_emp mem_ra && * pmem_allocated_at base (SUC count) == * r_sep mem_ra * (pmem_allocated_byte_at base) @@ -125,30 +126,36 @@ PROOF extern thm pmem_allocated_at_split; /* * An actually uninitialized singleton entails unspecified allocation: * + * ```text * ⊢ ∀address:int. * r_entails mem_ra * (pmem_uninit_at address) * (pmem_allocated_byte_at address). + * ``` */ PROOF extern thm pmem_uninit_at_allocated_byte; /* * An initialized singleton entails unspecified allocation: * + * ```text * ⊢ ∀(address:int) (byte:int). * r_entails mem_ra * (pmem_byte_at address byte) * (pmem_allocated_byte_at address). + * ``` */ PROOF extern thm pmem_byte_at_allocated_byte; /* * Initialized consecutive bytes may be forgotten to allocated bytes: * + * ```text * ⊢ ∀(bytes:int list) (base:int). * r_entails mem_ra * (pmem_bytes_at base bytes) * (pmem_allocated_at base (LENGTH bytes)). + * ``` */ PROOF extern thm pmem_bytes_at_allocated; @@ -160,10 +167,10 @@ PROOF extern thm pmem_bytes_at_allocated; * `pmem_le_bytes count value` is the low `count` base-256 digits of `value`, * least-significant digit first: * - * pmem_le_bytes 0 value == [] - * pmem_le_bytes (SUC count) value == - * (value rem &256) :: - * pmem_le_bytes count (value div &256). + * pmem_le_bytes 0 integer_value == [] && + * pmem_le_bytes (SUC count) integer_value == + * (integer_value rem &256) :: + * pmem_le_bytes count (integer_value div &256). * * Fixed-width recursion also gives negative HOL integers their usual * truncated two's-complement byte representation; range and signedness are @@ -187,15 +194,15 @@ PROOF extern thm pmem_le_bytes_length; /* * Exact initialized scalar storage at byte width `count`: * - * pmem_scalar_at base count value == - * pmem_bytes_at base (pmem_le_bytes count value). + * pmem_scalar_at base count integer_value == + * pmem_bytes_at base (pmem_le_bytes count integer_value). */ PROOF extern thm pmem_scalar_at_def; /* * Strictly uninitialized scalar storage: * - * pmem_undef_scalar_at base 0 == r_emp mem_ra + * pmem_undef_scalar_at base 0 == r_emp mem_ra && * pmem_undef_scalar_at base (SUC count) == * r_sep mem_ra * (pmem_uninit_at base) @@ -215,12 +222,14 @@ PROOF extern thm pmem_scalar_at_zero; /* * Little-endian head/tail equation: * + * ```text * ⊢ ∀(base:int)(count:num)(value:int). * pmem_scalar_at base (SUC count) value == * r_sep mem_ra * (pmem_byte_at base (value rem &256)) * (pmem_scalar_at * (base + &1) count (value div &256)). + * ``` */ PROOF extern thm pmem_scalar_at_suc; @@ -233,11 +242,13 @@ PROOF extern thm pmem_undef_scalar_at_zero; /* * Uninitialized scalar storage unfolds by one uninitialized byte: * + * ```text * ⊢ ∀(base:int)(count:num). * pmem_undef_scalar_at base (SUC count) == * r_sep mem_ra * (pmem_uninit_at base) * (pmem_undef_scalar_at (base + &1) count). + * ``` */ PROOF extern thm pmem_undef_scalar_at_suc; @@ -257,9 +268,11 @@ PROOF extern thm pmem_undef_scalar_at_allocated; * Initialized scalar contents can soundly be forgotten only to arbitrary * allocated storage, not to uninitialized storage: * + * ```text * ⊢ ∀(base:int) (count:num) (value:int). * r_entails mem_ra * (pmem_scalar_at base count value) * (pmem_allocated_at base count). + * ``` */ PROOF extern thm pmem_scalar_at_allocated; diff --git a/theory/data/int_list.h b/theory/data/int_list.h index 6766c79..e86958b 100644 --- a/theory/data/int_list.h +++ b/theory/data/int_list.h @@ -13,30 +13,75 @@ #include "proof/proof_kernel.h" -/** Recursive integer-valued list length. */ +/** + * HOL conclusion: + * `(ilength ([]:(A)list) = &0) && (ilength ((head:A) :: (tail:(A)list)) = &1 + + * ilength tail)`. + */ PROOF extern thm ILENGTH_DEF; -/** Partial natural-number list indexing equations. */ +/** + * HOL conclusion: + * `(NTH 0 ((head:A) :: (tail:(A)list)) = head) && (NTH (SUC index) + * (head :: tail) = NTH index tail)`. + */ PROOF extern thm NTH_DEF; -/** `inth i xs = NTH (num_of_int i) xs`. */ +/** + * HOL conclusion: + * `inth (index:int) (values:(A)list) = NTH (num_of_int index) values`. + */ PROOF extern thm INTH_DEF; -/** Natural-number functional list replacement equations. */ +/** + * HOL conclusion: + * `(REPLACE_NTH index (value:A) [] = []) && (REPLACE_NTH 0 value ((head:A) :: + * tail) = value :: tail) && (REPLACE_NTH (SUC index) value (head :: tail) = + * head :: REPLACE_NTH index value tail)`. + */ PROOF extern thm REPLACE_NTH_DEF; -/** `replace_inth i x xs = REPLACE_NTH (num_of_int i) x xs`. */ +/** + * HOL conclusion: + * `replace_inth (index:int) (value:A) (values:(A)list) = REPLACE_NTH + * (num_of_int index) value values`. + */ PROOF extern thm REPLACE_INTH_DEF; -/** Truncating natural-number prefix equations. */ +/** + * HOL conclusion: + * `(FIRSTN 0 (values:(A)list) = []) && (FIRSTN (SUC count) ([]:(A)list) = []) + * && (FIRSTN (SUC count) ((head:A) :: tail) = head :: FIRSTN count tail)`. + */ PROOF extern thm FIRSTN_DEF; -/** Integer-indexed prefix wrapper. */ +/** + * HOL conclusion: + * `ifirstn (count:int) (values:(A)list) = FIRSTN (num_of_int count) values`. + */ PROOF extern thm IFIRSTN_DEF; -/** Truncating natural-number suffix equations. */ +/** + * HOL conclusion: + * `(SKIPN 0 (values:(A)list) = values) && (SKIPN (SUC count) ([]:(A)list) = + * []) && (SKIPN (SUC count) ((head:A) :: tail) = SKIPN count tail)`. + */ PROOF extern thm SKIPN_DEF; -/** Integer-indexed suffix wrapper. */ +/** + * HOL conclusion: + * `iskipn (count:int) (values:(A)list) = SKIPN (num_of_int count) values`. + */ PROOF extern thm ISKIPN_DEF; -/** `ireplicate n x = REPLICATE (num_of_int n) x`. */ +/** + * HOL conclusion: + * `ireplicate (count:int) (value:A) = REPLICATE (num_of_int count) value`. + */ PROOF extern thm IREPLICATE_DEF; -/** Absolute-endpoint slice `SKIPN lo (FIRSTN hi xs)`. */ +/** + * HOL conclusion: + * `sublist (lower:int) (upper:int) (values:(A)list) = SKIPN (num_of_int lower) + * (FIRSTN (num_of_int upper) values)`. + */ PROOF extern thm SUBLIST_DEF; -/** `|- forall xs:(A)list. 0 <= ilength xs`. */ +/** HOL conclusion: `forall values:(A)list. &0 <= ilength values`. */ PROOF extern thm ILENGTH_NONNEG; -/** `|- ilength (xs ++ ys) = ilength xs + ilength ys`. */ +/** + * HOL conclusion: + * `forall left:(A)list. forall right:(A)list. ilength (left ++ right) = + * ilength left + ilength right`. + */ PROOF extern thm ILENGTH_APPEND; diff --git a/theory/data/list.h b/theory/data/list.h index 21575e9..6c4ef53 100644 --- a/theory/data/list.h +++ b/theory/data/list.h @@ -13,23 +13,26 @@ #include "proof/proof_kernel.h" /** - * `|- LENGTH ([]:(A)list) = 0 /\ - * (!h:A. !t. LENGTH (CONS h t) = SUC (LENGTH t))`. + * HOL conclusion: + * `(LENGTH ([]:(A)list) = 0) /\ (!h:A. !t. LENGTH (CONS h t) = SUC + * (LENGTH t))`. */ PROOF extern thm HOL_LENGTH; /** - * `|- (!l:(A)list. APPEND [] l = l) /\ - * (!h:A. !t l. APPEND (CONS h t) l = CONS h (APPEND t l))`. + * HOL conclusion: + * `(!l:(A)list. APPEND [] l = l) /\ (!h:A. !t l. APPEND (CONS h t) l = + * CONS h (APPEND t l))`. */ PROOF extern thm HOL_APPEND; /** - * `|- REVERSE ([]:(A)list) = [] /\ - * REVERSE (CONS (x:A) l) = - * APPEND (REVERSE l) (CONS x [])`. + * HOL conclusion: + * `(REVERSE ([]:(A)list) = []) /\ (REVERSE (CONS (x:A) l) = APPEND + * (REVERSE l) (CONS x []))`. */ PROOF extern thm HOL_REVERSE; /** - * `|- REPLICATE 0 (x:A) = [] /\ - * REPLICATE (SUC n) x = CONS x (REPLICATE n x)`. + * HOL conclusion: + * `(REPLICATE 0 (x:A) = []) /\ (REPLICATE (SUC n) x = CONS x + * (REPLICATE n x))`. */ PROOF extern thm HOL_REPLICATE; diff --git a/theory/logic/agree_ra.h b/theory/logic/agree_ra.h index f900d41..f5f9c82 100644 --- a/theory/logic/agree_ra.h +++ b/theory/logic/agree_ra.h @@ -14,47 +14,54 @@ /* Operation and validity */ /* ------------------------------------------------------------------------- */ -/* `ra_unit agree_ra == AgreeUnit`. */ +/* `ra_unit agree_ra == AgreeUnit` */ PROOF extern thm agree_ra_unit; /* - * `ra_op agree_ra (Agree a) (Agree b) == - * (if a == b then Agree a else AgreeInvalid)`. + * `forall a b. + * ra_op agree_ra (Agree a) (Agree b) == + * (if a == b then Agree a else AgreeInvalid)` */ PROOF extern thm agree_ra_owned_op; -/* `ra_op agree_ra (Agree a) (Agree a) == Agree a`. */ +/* `forall a. ra_op agree_ra (Agree a) (Agree a) == Agree a` */ PROOF extern thm agree_ra_idempotent; -/* The unit and every single owned agreement token are valid. */ +/* `ra_valid agree_ra AgreeUnit` */ PROOF extern thm agree_ra_valid_unit; + +/* `forall a. ra_valid agree_ra (Agree a)` */ PROOF extern thm agree_ra_valid_owned; -/* `~ra_valid agree_ra AgreeInvalid`. */ +/* `~ra_valid agree_ra AgreeInvalid` */ PROOF extern thm agree_ra_invalid; /* ------------------------------------------------------------------------- */ /* Agreement, inclusion, and cancellation */ /* ------------------------------------------------------------------------- */ -/* A composition of two owned tokens is valid exactly when payloads agree. */ +/* `forall a b. ra_valid agree_ra (ra_op agree_ra (Agree a) (Agree b)) <=> a == b` */ PROOF extern thm agree_ra_valid_combine_iff; -/* Compatible owned tokens have equal payloads. */ +/* `forall a b. ra_compatible agree_ra (Agree a) (Agree b) ==> a == b` */ PROOF extern thm agree_ra_agreement; -/* Owned-to-owned inclusion is exactly payload equality. */ +/* `forall a b. ra_included agree_ra (Agree a) (Agree b) <=> a == b` */ PROOF extern thm agree_ra_included_owned; -/* Idempotence makes the agreement RA non-cancellative. */ +/* `~ra_cancellative agree_ra` */ PROOF extern thm agree_ra_not_cancellative; /* ------------------------------------------------------------------------- */ /* Agreement-preserving updates */ /* ------------------------------------------------------------------------- */ -/* `Agree a` updates to `Agree b` exactly when `a == b`. */ +/* `forall a b. ra_update agree_ra (Agree a) (Agree b) <=> a == b` */ PROOF extern thm agree_ra_update_iff; -/* A complete owned local pair changes payload exactly when it stays equal. */ +/* + * `forall a b. + * ra_local_update agree_ra (Agree a) (Agree a) (Agree b) (Agree b) <=> + * a == b` + */ PROOF extern thm agree_ra_local_update_iff; diff --git a/theory/logic/auth_ra.h b/theory/logic/auth_ra.h index 6433f2b..8ac7501 100644 --- a/theory/logic/auth_ra.h +++ b/theory/logic/auth_ra.h @@ -17,66 +17,129 @@ /* Unit and composition */ /* ------------------------------------------------------------------------- */ -/* `ra_unit (auth_ra R) == auth_frag (ra_unit R)`. */ +/* + * `forall R:(A)ra. + * ra_unit (auth_ra R) == auth_frag (ra_unit R)` + */ PROOF extern thm auth_ra_unit; -/* Authority composed with a fragment yields a combined resource. */ +/* + * `forall (R:(A)ra) (a:A) (fragment:A). + * ra_op + * (auth_ra R) + * (auth_auth R a) + * (auth_frag fragment) == + * auth_both a fragment` + */ PROOF extern thm auth_ra_auth_frag; -/* Fragment-only resources compose through the base RA. */ +/* + * `forall (R:(A)ra) (f:A) (g:A). + * ra_op (auth_ra R) (auth_frag f) (auth_frag g) == + * auth_frag (ra_op R f g)` + */ PROOF extern thm auth_ra_frag_frag; -/* A combined resource absorbs an additional base fragment. */ +/* + * `forall (R:(A)ra) (a:A) (f:A) (g:A). + * ra_op (auth_ra R) (auth_both a f) (auth_frag g) == + * auth_both a (ra_op R f g)` + */ PROOF extern thm auth_ra_both_frag; /* ------------------------------------------------------------------------- */ /* Validity and compatibility */ /* ------------------------------------------------------------------------- */ -/* `ra_valid (auth_ra R) (auth_frag f) <=> ra_valid R f`. */ +/* + * `forall (R:(A)ra) (fragment:A). + * ra_valid (auth_ra R) (auth_frag fragment) <=> + * ra_valid R fragment` + */ PROOF extern thm auth_ra_valid_frag; /* - * `ra_valid (auth_ra R) (auth_both a f) <=> - * ra_valid R a && ra_included R f a`. + * `forall (R:(A)ra) (a:A) (fragment:A). + * ra_valid (auth_ra R) (auth_both a fragment) <=> + * ra_valid R a && ra_included R fragment a` */ PROOF extern thm auth_ra_valid_both; -/* `ra_valid (auth_ra R) (auth_auth R a) <=> ra_valid R a`. */ +/* + * `forall (R:(A)ra) (a:A). + * ra_valid (auth_ra R) (auth_auth R a) <=> + * ra_valid R a` + */ PROOF extern thm auth_ra_valid_auth; /* - * Characterize every valid hidden frame of `auth_both a f`: it must be an - * `auth_frag external`, and `ra_op R f external` must be included in `a`. + * `forall + * (R:(A)ra) + * (a:A) + * (f:A) + * (frame:(A)excl#A). + * ra_valid + * (auth_ra R) + * (ra_op (auth_ra R) (auth_both a f) frame) <=> + * exists external:A. + * frame == auth_frag external && + * ra_valid R a && + * ra_included R (ra_op R f external) a` */ PROOF extern thm auth_ra_valid_both_frame; -/* Two authority-only resources are never compatible. */ +/* + * `forall (R:(A)ra) (a:A) (b:A). + * ~(ra_compatible + * (auth_ra R) + * (auth_auth R a) + * (auth_auth R b))` + */ PROOF extern thm auth_ra_auth_conflict; /* ------------------------------------------------------------------------- */ /* Inclusion */ /* ------------------------------------------------------------------------- */ -/* Fragment-to-fragment inclusion is exactly base inclusion. */ +/* + * `forall (R:(A)ra) (f:A) (g:A). + * ra_included (auth_ra R) (auth_frag f) (auth_frag g) <=> + * ra_included R f g` + */ PROOF extern thm auth_ra_included_frag_frag; -/* A fragment is included in `auth_both a g` exactly when included in `g`. */ +/* + * `forall (R:(A)ra) (f:A) (a:A) (g:A). + * ra_included (auth_ra R) (auth_frag f) (auth_both a g) <=> + * ra_included R f g` + */ PROOF extern thm auth_ra_included_frag_both; -/* Authority-only inclusion requires equality of authoritative values. */ +/* + * `forall (R:(A)ra) (a:A) (b:A). + * ra_included (auth_ra R) (auth_auth R a) (auth_auth R b) <=> + * a == b` + */ PROOF extern thm auth_ra_included_auth_auth; -/* Authority-only is included in a combined value exactly at equal authority. */ +/* + * `forall (R:(A)ra) (a:A) (b:A) (g:A). + * ra_included (auth_ra R) (auth_auth R a) (auth_both b g) <=> + * a == b` + */ PROOF extern thm auth_ra_included_auth_both; /* - * Combined inclusion preserves the authoritative value and uses base - * inclusion for the fragment coordinate. + * `forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + * ra_included (auth_ra R) (auth_both a f) (auth_both b g) <=> + * a == b && ra_included R f g` */ PROOF extern thm auth_ra_included_both_both; -/* The authoritative construction preserves cancellativity exactly. */ +/* + * `forall R:(A)ra. + * ra_cancellative (auth_ra R) <=> ra_cancellative R` + */ PROOF extern thm auth_ra_cancellative_iff; /* ------------------------------------------------------------------------- */ @@ -84,38 +147,94 @@ PROOF extern thm auth_ra_cancellative_iff; /* ------------------------------------------------------------------------- */ /* - * Exact framewise characterization of - * `ra_update (auth_ra R) (auth_both a f) (auth_both b g)` over every external - * base fragment compatible with the source authority. + * `forall + * (R:(A)ra) + * (a:A) + * (f:A) + * (b:A) + * (g:A). + * ra_update + * (auth_ra R) + * (auth_both a f) + * (auth_both b g) <=> + * forall external:A. + * ra_valid R a && + * ra_included R (ra_op R f external) a ==> + * ra_valid R b && + * ra_included R (ra_op R g external) b` */ PROOF extern thm auth_ra_update_framewise_iff; -/* Lift a five-argument base local update to an authoritative update. */ +/* + * `forall + * (R:(A)ra) + * (a:A) + * (f:A) + * (b:A) + * (g:A). + * ra_local_update R a f b g ==> + * ra_update + * (auth_ra R) + * (auth_both a f) + * (auth_both b g)` + */ PROOF extern thm auth_ra_update_local; /* - * Authority-only update characterization: a valid source must lead to a valid - * target that includes the old authoritative value. + * `forall (R:(A)ra) (a:A) (b:A). + * ra_update + * (auth_ra R) + * (auth_auth R a) + * (auth_auth R b) <=> + * (ra_valid R a ==> + * ra_valid R b && ra_included R a b)` */ PROOF extern thm auth_ra_update_auth_iff; /* - * Allocate a local fragment through a base local update from - * `(a,ra_unit R)` to `(b,g)`. + * `forall (R:(A)ra) (a:A) (b:A) (g:A). + * ra_local_update R a (ra_unit R) b g ==> + * ra_update + * (auth_ra R) + * (auth_auth R a) + * (auth_both b g)` */ PROOF extern thm auth_ra_update_alloc; -/* Drop the local fragment from `auth_both a f`, retaining `auth_auth R a`. */ +/* + * `forall (R:(A)ra) (a:A) (f:A). + * ra_update + * (auth_ra R) + * (auth_both a f) + * (auth_auth R a)` + */ PROOF extern thm auth_ra_update_drop_local; -/* Drop authority from `auth_both a f`, retaining `auth_frag f`. */ +/* + * `forall (R:(A)ra) (a:A) (f:A). + * ra_update + * (auth_ra R) + * (auth_both a f) + * (auth_frag f)` + */ PROOF extern thm auth_ra_update_drop_auth; -/* Keep authority fixed while weakening the local fragment to an included part. */ +/* + * `forall (R:(A)ra) (a:A) (f:A) (g:A). + * ra_included R g f ==> + * ra_update + * (auth_ra R) + * (auth_both a f) + * (auth_both a g)` + */ PROOF extern thm auth_ra_update_weaken_frag; /* - * Extend authority by `piece` and simultaneously allocate that same piece as - * a local fragment, provided the extended authoritative value is valid. + * `forall (R:(A)ra) (a:A) (piece:A). + * ra_valid R (ra_op R a piece) ==> + * ra_update + * (auth_ra R) + * (auth_auth R a) + * (auth_both (ra_op R a piece) piece)` */ PROOF extern thm auth_ra_alloc; diff --git a/theory/logic/basic_update.h b/theory/logic/basic_update.h index bdd6756..7b17007 100644 --- a/theory/logic/basic_update.h +++ b/theory/logic/basic_update.h @@ -13,29 +13,94 @@ #include "proof/theory/logic/resource_prop.h" -/** `r_bupd R Q owned <=> ra_updateP R owned Q`. */ +/** HOL conclusion: `r_bupd (R:(A)ra) (Q:A->bool) (owned:A) <=> ra_updateP R owned Q`. */ PROOF extern thm r_bupd_def; -/** `r_viewshift R P Q <=> r_entails R P (r_bupd R Q)`. */ +/** + * HOL conclusion: + * `r_viewshift (R:(A)ra) (P:A->bool) (Q:A->bool) <=> r_entails R P + * (r_bupd R Q)`. + */ PROOF extern thm r_viewshift_def; /* Basic-update modality laws. */ +/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_entails R P (r_bupd R P)`. */ PROOF extern thm r_bupd_intro; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R P Q ==> r_entails R + * (r_bupd R P) (r_bupd R Q)`. + */ PROOF extern thm r_bupd_mono; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool). r_entails R (r_bupd R (r_bupd R P)) (r_bupd R + * P)`. + */ PROOF extern thm r_bupd_idem; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (frame_pred:A->bool). r_entails R (r_sep R + * (r_bupd R P) frame_pred) (r_bupd R (r_sep R P frame_pred))`. + */ PROOF extern thm r_bupd_frame; /* View-shift consequence, composition, framing, and logical lifting. */ +/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_viewshift R P P`. */ PROOF extern thm r_viewshift_refl; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R P Q ==> r_viewshift R + * P Q`. + */ PROOF extern thm r_entails_to_viewshift; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_viewshift R P Q ==> + * r_viewshift R Q S ==> r_viewshift R P S`. + */ PROOF extern thm r_viewshift_trans; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P2:A->bool) (P:A->bool) (Q:A->bool) (Q2:A->bool). + * r_entails R P2 P ==> r_viewshift R P Q ==> r_entails R Q Q2 ==> r_viewshift + * R P2 Q2`. + */ PROOF extern thm r_viewshift_mono; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (frame_pred:A->bool). r_viewshift R + * P Q ==> r_viewshift R (r_sep R P frame_pred) (r_sep R Q frame_pred)`. + */ PROOF extern thm r_viewshift_frame; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P1:A->bool) (Q1:A->bool) (P2:A->bool) (Q2:A->bool). + * r_viewshift R P1 Q1 ==> r_viewshift R P2 Q2 ==> r_viewshift R (r_sep R P1 + * P2) (r_sep R Q1 Q2)`. + */ PROOF extern thm r_viewshift_sep; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:B->A->bool) (Q:B->A->bool). (forall witness:B. + * r_viewshift R (P witness) (Q witness)) ==> r_viewshift R (r_exists R + * (\bound:B. P bound)) (r_exists R (\bound:B. Q bound))`. + */ PROOF extern thm r_viewshift_exists; /* Ownership rules induced by deterministic and predicate RA updates. */ +/** + * HOL conclusion: + * `forall (R:(A)ra) (a:A) (b:A). ra_update R a b ==> r_viewshift R (r_own R a) + * (r_own R b)`. + */ PROOF extern thm r_own_update; /* The predicate rule returns a witness, an exact-unit `r_fact`, and ownership. */ +/** + * HOL conclusion: + * `forall (R:(A)ra) (a:A) (result_pred:A->bool). ra_updateP R a result_pred ==> + * r_viewshift R (r_own R a) (r_exists R (\selected:A. r_sep R (r_fact R + * (result_pred selected)) (r_own R selected)))`. + */ PROOF extern thm r_own_updateP; diff --git a/theory/logic/big_sep.h b/theory/logic/big_sep.h index d12545d..ce1b389 100644 --- a/theory/logic/big_sep.h +++ b/theory/logic/big_sep.h @@ -18,22 +18,68 @@ #include "proof/theory/data/list.h" #include "proof/theory/logic/resource_prop.h" -/** Direct right fold: - * r_big_sep_list R Phi [] == r_emp R - * r_big_sep_list R Phi (x::xs) == - * r_sep R (Phi x) (r_big_sep_list R Phi xs). */ +/** + * HOL conclusion: + * `(r_big_sep_list (R:(A)ra) (Phi:B->A->bool) ([]:(B)list) = r_emp R) && + * (r_big_sep_list R Phi ((x:B) :: (xs:(B)list)) = r_sep R (Phi x) + * (r_big_sep_list R Phi xs))`. + */ PROOF extern thm r_big_sep_list_def; /* Fold computation and append laws, exposed as `r_equiv`. */ +/** + * HOL conclusion: + * `forall (R:(A)ra) (Phi:B->A->bool). r_equiv R (r_big_sep_list R Phi + * ([]:(B)list)) (r_emp R)`. + */ PROOF extern thm r_big_sep_list_nil; +/** + * HOL conclusion: + * `forall (R:(A)ra) (Phi:B->A->bool) (x:B) (xs:(B)list). r_equiv R + * (r_big_sep_list R Phi (x :: xs)) (r_sep R (Phi x) (r_big_sep_list R Phi xs))`. + */ PROOF extern thm r_big_sep_list_cons; +/** + * HOL conclusion: + * `forall (R:(A)ra) (Phi:B->A->bool) (x:B). r_equiv R (r_big_sep_list R Phi (x + * :: [])) (Phi x)`. + */ PROOF extern thm r_big_sep_list_singleton; +/** + * HOL conclusion: + * `forall (R:(A)ra) (Phi:B->A->bool) (left:(B)list) (right:(B)list). r_equiv R + * (r_big_sep_list R Phi (APPEND left right)) (r_sep R (r_big_sep_list R Phi + * left) (r_big_sep_list R Phi right))`. + */ PROOF extern thm r_big_sep_list_append; /* Member-restricted pointwise entailment and equivalence lifting. */ +/** + * HOL conclusion: + * `forall (R:(A)ra) (Phi:B->A->bool) (Psi:B->A->bool) (xs:(B)list). (forall + * x:B. MEM x xs ==> r_entails R (Phi x) (Psi x)) ==> r_entails R + * (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs)`. + */ PROOF extern thm r_big_sep_list_mono; +/** + * HOL conclusion: + * `forall (R:(A)ra) (Phi:B->A->bool) (Psi:B->A->bool) (xs:(B)list). (forall + * x:B. MEM x xs ==> r_equiv R (Phi x) (Psi x)) ==> r_equiv R (r_big_sep_list R + * Phi xs) (r_big_sep_list R Psi xs)`. + */ PROOF extern thm r_big_sep_list_equiv; /* List MAP naturality and pointwise separation. */ +/** + * HOL conclusion: + * `forall (R:(A)ra) (Phi:B->A->bool) (f:C->B) (xs:(C)list). r_equiv R + * (r_big_sep_list R Phi (MAP f xs)) (r_big_sep_list R (\x:C. Phi (f x)) xs)`. + */ PROOF extern thm r_big_sep_list_map; +/** + * HOL conclusion: + * `forall (R:(A)ra) (Phi:B->A->bool) (Psi:B->A->bool) (xs:(B)list). r_equiv R + * (r_big_sep_list R (\x:B. r_sep R (Phi x) (Psi x)) xs) (r_sep R + * (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs))`. + */ PROOF extern thm r_big_sep_list_sep; diff --git a/theory/logic/excl_ra.h b/theory/logic/excl_ra.h index 21ab1f7..30eb406 100644 --- a/theory/logic/excl_ra.h +++ b/theory/logic/excl_ra.h @@ -15,41 +15,43 @@ /* Operation and validity */ /* ------------------------------------------------------------------------- */ -/* `ra_unit excl_ra == ExclUnit`. */ +/* `ra_unit excl_ra == ExclUnit` */ PROOF extern thm excl_ra_unit; -/* `ra_op excl_ra (Excl a) (Excl b) == ExclInvalid`. */ +/* `forall a b. ra_op excl_ra (Excl a) (Excl b) == ExclInvalid` */ PROOF extern thm excl_ra_owned_conflict; -/* The unit and every single owned token are valid. */ +/* `ra_valid excl_ra ExclUnit` */ PROOF extern thm excl_ra_valid_unit; + +/* `forall a. ra_valid excl_ra (Excl a)` */ PROOF extern thm excl_ra_valid_owned; -/* `~ra_valid excl_ra ExclInvalid`. */ +/* `~ra_valid excl_ra ExclInvalid` */ PROOF extern thm excl_ra_invalid; /* ------------------------------------------------------------------------- */ /* Inclusion and algebraic properties */ /* ------------------------------------------------------------------------- */ -/* `ra_included excl_ra (Excl a) (Excl b) <=> a == b`. */ +/* `forall a b. ra_included excl_ra (Excl a) (Excl b) <=> a == b` */ PROOF extern thm excl_ra_included_owned; -/* Every `Excl a` is frame-maximal. */ +/* `forall a. ra_maximal excl_ra (Excl a)` */ PROOF extern thm excl_ra_maximal; -/* `ra_cancellative excl_ra`. */ +/* `ra_cancellative excl_ra` */ PROOF extern thm excl_ra_cancellative; /* ------------------------------------------------------------------------- */ /* Replacement updates */ /* ------------------------------------------------------------------------- */ -/* `ra_update excl_ra (Excl a) x <=> ra_valid excl_ra x`. */ +/* `forall a x. ra_update excl_ra (Excl a) x <=> ra_valid excl_ra x` */ PROOF extern thm excl_ra_update_owned_iff; /* - * `ra_local_update excl_ra (Excl a) (Excl a) x x <=> - * ra_valid excl_ra x`. + * `forall a x. + * ra_local_update excl_ra (Excl a) (Excl a) x x <=> ra_valid excl_ra x` */ PROOF extern thm excl_ra_local_update_iff; diff --git a/theory/logic/excl_ra_internal.h b/theory/logic/excl_ra_internal.h index 1162774..283184b 100644 --- a/theory/logic/excl_ra_internal.h +++ b/theory/logic/excl_ra_internal.h @@ -18,26 +18,32 @@ /* Datatype package for `excl = ExclUnit | Excl A | ExclInvalid`. */ PROOF extern indtype excl_type; -/* Case equations for the owned-left operation helper. */ +/* + * `excl_owned_op a ExclUnit == Excl a && + * excl_owned_op a (Excl b) == ExclInvalid && + * excl_owned_op a ExclInvalid == ExclInvalid` + */ PROOF extern thm excl_owned_op_def; -/* Case equations for the raw commutative operation `excl_op`. */ +/* + * `excl_op ExclUnit y == y && + * excl_op (Excl a) y == excl_owned_op a y && + * excl_op ExclInvalid y == ExclInvalid` + */ PROOF extern thm excl_op_def; /* ------------------------------------------------------------------------- */ /* Representation normalization */ /* ------------------------------------------------------------------------- */ -/* Constructor distinctions needed by implementation case analyses. */ +/* `forall a. ~(Excl a == ExclUnit)` */ PROOF extern thm excl_owned_ne_unit; + +/* `~(ExclInvalid == ExclUnit)` */ PROOF extern thm excl_invalid_ne_unit; -/* `ra_op excl_ra == excl_op`. */ +/* `ra_op excl_ra == excl_op` */ PROOF extern thm excl_ra_op_fn; -/* - * Direct owned-token replacement: `Excl a` may update to `Excl b`. - * Physical-memory construction uses this convenience form; protocol clients - * use the exact public rule `excl_ra_update_owned_iff`. - */ +/* `forall a b. ra_update excl_ra (Excl a) (Excl b)` */ PROOF extern thm excl_ra_update; diff --git a/theory/logic/finmap.h b/theory/logic/finmap.h index b75f1ca..eee0fad 100644 --- a/theory/logic/finmap.h +++ b/theory/logic/finmap.h @@ -23,10 +23,7 @@ /* Core representation */ /* ------------------------------------------------------------------------- */ -/* - * forall f:K->V option. - * finmap_finite f <=> FINITE {k:K | ~(f k == NONE)} - */ +/* `finmap_finite (f:K->V option) <=> FINITE {k:K | ~(f k == NONE)}` */ PROOF extern thm finmap_finite_def; /* @@ -34,11 +31,11 @@ PROOF extern thm finmap_finite_def; * `finmap_abs:(K->V option)->(K,V)finmap` and * `finmap_rep:(K,V)finmap->K->V option`: * - * (forall m:(K,V)finmap. + * `(forall m:(K,V)finmap. * finmap_abs (finmap_rep m) == m) && * (forall f:K->V option. * finmap_finite f <=> - * finmap_rep (finmap_abs f) == f) + * finmap_rep (finmap_abs f) == f)` */ PROOF extern thm finmap_type_bijection; @@ -46,8 +43,8 @@ PROOF extern thm finmap_type_bijection; PROOF extern thm finmap_rep_finite; /* - * forall (m:(K,V)finmap) (n:(K,V)finmap). - * m == n <=> finmap_rep m == finmap_rep n + * `forall (m:(K,V)finmap) (n:(K,V)finmap). + * m == n <=> finmap_rep m == finmap_rep n` */ PROOF extern thm finmap_eq; @@ -58,41 +55,30 @@ PROOF extern thm finmap_eq; /* `finmap_empty:(K,V)finmap == finmap_abs (\k:K. NONE)`. */ PROOF extern thm finmap_empty_def; -/* - * forall (m:(K,V)finmap) (k:K). - * finmap_lookup m k == finmap_rep m k - */ +/* `finmap_lookup (m:(K,V)finmap) (k:K) == finmap_rep m k` */ PROOF extern thm finmap_lookup_def; /* - * forall (key:K) (v:V). - * finmap_singleton key v == - * finmap_abs - * (\k:K. if k == key then SOME v else NONE) + * `finmap_singleton (key:K) (v:V) == + * finmap_abs (\k:K. if k == key then SOME v else NONE)` */ PROOF extern thm finmap_singleton_def; /* - * forall (key:K) (v:V) (m:(K,V)finmap). - * finmap_insert key v m == - * finmap_abs - * (\k:K. - * if k == key then SOME v else finmap_rep m k) + * `finmap_insert (key:K) (v:V) (m:(K,V)finmap) == + * finmap_abs (\k:K. if k == key then SOME v else finmap_rep m k)` */ PROOF extern thm finmap_insert_def; /* - * forall (key:K) (m:(K,V)finmap). - * finmap_delete key m == - * finmap_abs - * (\k:K. - * if k == key then NONE else finmap_rep m k) + * `finmap_delete (key:K) (m:(K,V)finmap) == + * finmap_abs (\k:K. if k == key then NONE else finmap_rep m k)` */ PROOF extern thm finmap_delete_def; /* - * forall m:(K,V)finmap. - * finmap_dom m == {k:K | ~(finmap_lookup m k == NONE)} + * `finmap_dom (m:(K,V)finmap) == + * {k:K | ~(finmap_lookup m k == NONE)}` */ PROOF extern thm finmap_dom_def; @@ -107,107 +93,107 @@ PROOF extern thm finmap_empty_rep; PROOF extern thm finmap_empty_lookup; /* - * forall (key:K) (v:V). - * {k:K | ~((if k == key then SOME v else NONE) == NONE)} == - * {key} + * `forall (key:K) (v:V). + * {k:K | ~((if k == key then SOME v else NONE) == NONE)} == + * {key}` */ PROOF extern thm finmap_singleton_support; /* - * forall (key:K) (v:V). - * finmap_rep (finmap_singleton key v) == - * (\k:K. if k == key then SOME v else NONE) + * `forall (key:K) (v:V). + * finmap_rep (finmap_singleton key v) == + * (\k:K. if k == key then SOME v else NONE)` */ PROOF extern thm finmap_singleton_rep; /* - * forall (key:K) (v:V) (k:K). - * finmap_lookup (finmap_singleton key v) k == - * if k == key then SOME v else NONE + * `forall (key:K) (v:V) (k:K). + * finmap_lookup (finmap_singleton key v) k == + * if k == key then SOME v else NONE` */ PROOF extern thm finmap_singleton_lookup; /* - * forall (key:K) (v:V) (f:K->V option). - * {k:K | ~((if k == key then SOME v else f k) == NONE)} == - * key INSERT {k:K | ~(f k == NONE)} + * `forall (key:K) (v:V) (f:K->V option). + * {k:K | ~((if k == key then SOME v else f k) == NONE)} == + * key INSERT {k:K | ~(f k == NONE)}` */ PROOF extern thm finmap_insert_support; /* - * forall (key:K) (v:V) (m:(K,V)finmap). - * finmap_rep (finmap_insert key v m) == - * (\k:K. - * if k == key then SOME v else finmap_rep m k) + * `forall (key:K) (v:V) (m:(K,V)finmap). + * finmap_rep (finmap_insert key v m) == + * (\k:K. + * if k == key then SOME v else finmap_rep m k)` */ PROOF extern thm finmap_insert_rep; /* - * forall + * `forall * (key:K) * (v:V) * (m:(K,V)finmap) * (k:K). * finmap_lookup (finmap_insert key v m) k == - * if k == key then SOME v else finmap_lookup m k + * if k == key then SOME v else finmap_lookup m k` */ PROOF extern thm finmap_insert_lookup; /* - * forall (key:K) (v:V) (m:(K,V)finmap). - * finmap_lookup (finmap_insert key v m) key == SOME v + * `forall (key:K) (v:V) (m:(K,V)finmap). + * finmap_lookup (finmap_insert key v m) key == SOME v` */ PROOF extern thm finmap_insert_lookup_eq; /* - * forall + * `forall * (key:K) * (v:V) * (m:(K,V)finmap) * (k:K). * ~(k == key) ==> - * finmap_lookup (finmap_insert key v m) k == finmap_lookup m k + * finmap_lookup (finmap_insert key v m) k == finmap_lookup m k` */ PROOF extern thm finmap_insert_lookup_ne; /* - * forall (key:K) (f:K->V option). - * {k:K | ~((if k == key then NONE else f k) == NONE)} == - * {k:K | ~(f k == NONE)} DELETE key + * `forall (key:K) (f:K->V option). + * {k:K | ~((if k == key then NONE else f k) == NONE)} == + * {k:K | ~(f k == NONE)} DELETE key` */ PROOF extern thm finmap_delete_support; /* - * forall (key:K) (m:(K,V)finmap). - * finmap_rep (finmap_delete key m) == - * (\k:K. if k == key then NONE else finmap_rep m k) + * `forall (key:K) (m:(K,V)finmap). + * finmap_rep (finmap_delete key m) == + * (\k:K. if k == key then NONE else finmap_rep m k)` */ PROOF extern thm finmap_delete_rep; /* - * forall (key:K) (m:(K,V)finmap) (k:K). - * finmap_lookup (finmap_delete key m) k == - * if k == key then NONE else finmap_lookup m k + * `forall (key:K) (m:(K,V)finmap) (k:K). + * finmap_lookup (finmap_delete key m) k == + * if k == key then NONE else finmap_lookup m k` */ PROOF extern thm finmap_delete_lookup; /* - * forall (key:K) (m:(K,V)finmap). - * finmap_lookup (finmap_delete key m) key == NONE + * `forall (key:K) (m:(K,V)finmap). + * finmap_lookup (finmap_delete key m) key == NONE` */ PROOF extern thm finmap_delete_lookup_eq; /* - * forall (key:K) (m:(K,V)finmap) (k:K). - * ~(k == key) ==> - * finmap_lookup (finmap_delete key m) k == finmap_lookup m k + * `forall (key:K) (m:(K,V)finmap) (k:K). + * ~(k == key) ==> + * finmap_lookup (finmap_delete key m) k == finmap_lookup m k` */ PROOF extern thm finmap_delete_lookup_ne; /* - * forall (m:(K,V)finmap) (n:(K,V)finmap). - * m == n <=> - * forall k:K. finmap_lookup m k == finmap_lookup n k + * `forall (m:(K,V)finmap) (n:(K,V)finmap). + * m == n <=> + * forall k:K. finmap_lookup m k == finmap_lookup n k` */ PROOF extern thm finmap_eq_lookup; @@ -216,31 +202,31 @@ PROOF extern thm finmap_eq_lookup; /* ------------------------------------------------------------------------- */ /* - * forall (key:K) (v:V). - * finmap_insert key v (finmap_empty:(K,V)finmap) == - * finmap_singleton key v + * `forall (key:K) (v:V). + * finmap_insert key v (finmap_empty:(K,V)finmap) == + * finmap_singleton key v` */ PROOF extern thm finmap_insert_empty; /* - * forall key:K. - * finmap_delete key (finmap_empty:(K,V)finmap) == finmap_empty + * `forall key:K. + * finmap_delete key (finmap_empty:(K,V)finmap) == finmap_empty` */ PROOF extern thm finmap_delete_empty; /* - * forall + * `forall * (key:K) * (v:V) * (w:V) * (m:(K,V)finmap). * finmap_insert key v (finmap_insert key w m) == - * finmap_insert key v m + * finmap_insert key v m` */ PROOF extern thm finmap_insert_overwrite; /* - * forall + * `forall * (key1:K) * (v1:V) * (key2:K) @@ -248,68 +234,68 @@ PROOF extern thm finmap_insert_overwrite; * (m:(K,V)finmap). * ~(key1 == key2) ==> * finmap_insert key1 v1 (finmap_insert key2 v2 m) == - * finmap_insert key2 v2 (finmap_insert key1 v1 m) + * finmap_insert key2 v2 (finmap_insert key1 v1 m)` */ PROOF extern thm finmap_insert_comm; /* - * forall (key:K) (m:(K,V)finmap). - * finmap_delete key (finmap_delete key m) == finmap_delete key m + * `forall (key:K) (m:(K,V)finmap). + * finmap_delete key (finmap_delete key m) == finmap_delete key m` */ PROOF extern thm finmap_delete_idempotent; /* - * forall (key1:K) (key2:K) (m:(K,V)finmap). - * finmap_delete key1 (finmap_delete key2 m) == - * finmap_delete key2 (finmap_delete key1 m) + * `forall (key1:K) (key2:K) (m:(K,V)finmap). + * finmap_delete key1 (finmap_delete key2 m) == + * finmap_delete key2 (finmap_delete key1 m)` */ PROOF extern thm finmap_delete_comm; /* - * forall (key:K) (v:V) (m:(K,V)finmap). - * finmap_delete key (finmap_insert key v m) == finmap_delete key m + * `forall (key:K) (v:V) (m:(K,V)finmap). + * finmap_delete key (finmap_insert key v m) == finmap_delete key m` */ PROOF extern thm finmap_delete_insert; /* * Deletion commutes with insertion at a different key: * - * forall + * `forall * (deleted:K) * (inserted:K) * (v:V) * (m:(K,V)finmap). * ~(deleted == inserted) ==> * finmap_delete deleted (finmap_insert inserted v m) == - * finmap_insert inserted v (finmap_delete deleted m) + * finmap_insert inserted v (finmap_delete deleted m)` */ PROOF extern thm finmap_delete_insert_ne; /* - * forall (key:K) (v:V) (m:(K,V)finmap). - * finmap_insert key v (finmap_delete key m) == - * finmap_insert key v m + * `forall (key:K) (v:V) (m:(K,V)finmap). + * finmap_insert key v (finmap_delete key m) == + * finmap_insert key v m` */ PROOF extern thm finmap_insert_delete; /* - * forall (key:K) (v:V) (m:(K,V)finmap). - * finmap_lookup m key == SOME v ==> - * finmap_insert key v m == m + * `forall (key:K) (v:V) (m:(K,V)finmap). + * finmap_lookup m key == SOME v ==> + * finmap_insert key v m == m` */ PROOF extern thm finmap_insert_id; /* - * forall (key:K) (m:(K,V)finmap). - * finmap_lookup m key == NONE ==> - * finmap_delete key m == m + * `forall (key:K) (m:(K,V)finmap). + * finmap_lookup m key == NONE ==> + * finmap_delete key m == m` */ PROOF extern thm finmap_delete_id; /* - * forall (key:K) (v:V) (m:(K,V)finmap). - * finmap_lookup m key == SOME v ==> - * finmap_insert key v (finmap_delete key m) == m + * `forall (key:K) (v:V) (m:(K,V)finmap). + * finmap_lookup m key == SOME v ==> + * finmap_insert key v (finmap_delete key m) == m` */ PROOF extern thm finmap_decompose; @@ -324,45 +310,45 @@ PROOF extern thm finmap_dom_finite; PROOF extern thm finmap_dom_empty; /* - * forall (key:K) (v:V). - * finmap_dom (finmap_singleton key v) == {key} + * `forall (key:K) (v:V). + * finmap_dom (finmap_singleton key v) == {key}` */ PROOF extern thm finmap_dom_singleton; /* - * forall (key:K) (m:(K,V)finmap). - * key IN finmap_dom m <=> ~(finmap_lookup m key == NONE) + * `forall (key:K) (m:(K,V)finmap). + * key IN finmap_dom m <=> ~(finmap_lookup m key == NONE)` */ PROOF extern thm finmap_in_dom; /* - * forall (key:K) (m:(K,V)finmap). - * key IN finmap_dom m <=> - * exists v:V. finmap_lookup m key == SOME v + * `forall (key:K) (m:(K,V)finmap). + * key IN finmap_dom m <=> + * exists v:V. finmap_lookup m key == SOME v` */ PROOF extern thm finmap_in_dom_some; /* - * forall (key:K) (m:(K,V)finmap). - * ~(key IN finmap_dom m) <=> finmap_lookup m key == NONE + * `forall (key:K) (m:(K,V)finmap). + * ~(key IN finmap_dom m) <=> finmap_lookup m key == NONE` */ PROOF extern thm finmap_not_in_dom; /* * An infinite candidate set contains a key outside any one finite map: * - * forall (candidates:K->bool) (m:(K,V)finmap). - * INFINITE candidates ==> - * exists key:K. - * key IN candidates && - * finmap_lookup m key == NONE + * `forall (candidates:K->bool) (m:(K,V)finmap). + * INFINITE candidates ==> + * exists key:K. + * key IN candidates && + * finmap_lookup m key == NONE` */ PROOF extern thm finmap_fresh_in; /* * An infinite candidate set contains a key outside two finite maps at once: * - * forall + * `forall * (candidates:K->bool) * (m:(K,V)finmap) * (n:(K,W)finmap). @@ -370,49 +356,49 @@ PROOF extern thm finmap_fresh_in; * exists key:K. * key IN candidates && * finmap_lookup m key == NONE && - * finmap_lookup n key == NONE + * finmap_lookup n key == NONE` */ PROOF extern thm finmap_fresh_in_pair; /* * If the key type is infinite, every finite map has a fresh key: * - * forall m:(K,V)finmap. - * INFINITE (UNIV:K->bool) ==> - * exists key:K. - * finmap_lookup m key == NONE + * `forall m:(K,V)finmap. + * INFINITE (UNIV:K->bool) ==> + * exists key:K. + * finmap_lookup m key == NONE` */ PROOF extern thm finmap_fresh; /* * If the key type is infinite, two finite maps have a common fresh key: * - * forall + * `forall * (m:(K,V)finmap) * (n:(K,W)finmap). * INFINITE (UNIV:K->bool) ==> * exists key:K. * finmap_lookup m key == NONE && - * finmap_lookup n key == NONE + * finmap_lookup n key == NONE` */ PROOF extern thm finmap_fresh_pair; /* - * forall m:(K,V)finmap. - * finmap_dom m == {} <=> m == finmap_empty + * `forall m:(K,V)finmap. + * finmap_dom m == {} <=> m == finmap_empty` */ PROOF extern thm finmap_dom_eq_empty; /* - * forall (key:K) (v:V) (m:(K,V)finmap). - * finmap_dom (finmap_insert key v m) == - * key INSERT finmap_dom m + * `forall (key:K) (v:V) (m:(K,V)finmap). + * finmap_dom (finmap_insert key v m) == + * key INSERT finmap_dom m` */ PROOF extern thm finmap_dom_insert; /* - * forall (key:K) (m:(K,V)finmap). - * finmap_dom (finmap_delete key m) == finmap_dom m DELETE key + * `forall (key:K) (m:(K,V)finmap). + * finmap_dom (finmap_delete key m) == finmap_dom m DELETE key` */ PROOF extern thm finmap_dom_delete; @@ -423,15 +409,15 @@ PROOF extern thm finmap_dom_delete; /* * Fresh-key induction: * - * forall P:((K,V)finmap)->bool. - * P finmap_empty ==> - * (forall + * `forall P:((K,V)finmap)->bool. + * P finmap_empty ==> + * (forall * (key:K) * (v:V) * (m:(K,V)finmap). * finmap_lookup m key == NONE ==> * P m ==> * P (finmap_insert key v m)) ==> - * forall m:(K,V)finmap. P m + * forall m:(K,V)finmap. P m` */ PROOF extern thm finmap_induct; diff --git a/theory/logic/frac_ra.h b/theory/logic/frac_ra.h index 835717b..e4e8ee1 100644 --- a/theory/logic/frac_ra.h +++ b/theory/logic/frac_ra.h @@ -15,19 +15,18 @@ /* Constructors and composition */ /* ------------------------------------------------------------------------- */ -/* `forall R:(A)ra. ra_unit (frac_ra R) == (frac_empty:(A)frac)`. */ +/* `forall R. ra_unit (frac_ra R) == frac_empty` */ PROOF extern thm frac_ra_unit; -/* `forall a:A. frac_full a == frac_own (&1) a`. */ +/* `forall a. frac_full a == frac_own (&1) a` */ PROOF extern thm frac_ra_full; /* - * Positive shares join (and, by symmetry, split) exactly: - * - * `forall (R:(A)ra) (p q:real) (a b:A). - * &0 < p ==> &0 < q ==> - * ra_op (frac_ra R) (frac_own p a) (frac_own q b) == - * frac_own (p + q) (ra_op R a b)`. + * `forall R p q a b. + * &0 < p + * ==> &0 < q + * ==> ra_op (frac_ra R) (frac_own p a) (frac_own q b) == + * frac_own (p + q) (ra_op R a b)` */ PROOF extern thm frac_ra_own_op; @@ -36,17 +35,13 @@ PROOF extern thm frac_ra_own_op; /* ------------------------------------------------------------------------- */ /* - * `forall (R:(A)ra) (p:real) (a:A). - * &0 < p ==> - * (ra_valid (frac_ra R) (frac_own p a) <=> - * p <= &1 && ra_valid R a)`. + * `forall R p a. + * &0 < p + * ==> (ra_valid (frac_ra R) (frac_own p a) <=> p <= &1 && ra_valid R a)` */ PROOF extern thm frac_ra_valid_own; -/* - * `forall (R:(A)ra) (a:A). - * ra_valid R a ==> ra_maximal (frac_ra R) (frac_full a)`. - */ +/* `forall R a. ra_valid R a ==> ra_maximal (frac_ra R) (frac_full a)` */ PROOF extern thm frac_ra_maximal_full; /* ------------------------------------------------------------------------- */ @@ -54,27 +49,27 @@ PROOF extern thm frac_ra_maximal_full; /* ------------------------------------------------------------------------- */ /* - * `forall (R:(A)ra) (p q:real) (a b:A). - * &0 < q ==> q <= p ==> ra_update R a b ==> - * ra_update (frac_ra R) (frac_own p a) (frac_own q b)`. + * `forall R p q a b. + * &0 < q + * ==> q <= p + * ==> ra_update R a b + * ==> ra_update (frac_ra R) (frac_own p a) (frac_own q b)` */ PROOF extern thm frac_ra_update_weaken; /* - * Predicate-update weakening with an exact fixed-share image: - * - * `forall (R:(A)ra) (p q:real) (a:A) (P:A->bool). - * &0 < q ==> q <= p ==> ra_updateP R a P ==> - * ra_updateP - * (frac_ra R) - * (frac_own p a) - * (\x. exists b. P b && x == frac_own q b)`. + * `forall R p q a P. + * &0 < q + * ==> q <= p + * ==> ra_updateP R a P + * ==> ra_updateP (frac_ra R) (frac_own p a) + * (\x. exists b. P b && x == frac_own q b)` */ PROOF extern thm frac_ra_updateP_weaken; /* - * `forall (R:(A)ra) (a b:A). - * (ra_update (frac_ra R) (frac_full a) (frac_full b) <=> - * (ra_valid R a ==> ra_valid R b))`. + * `forall R a b. + * ra_update (frac_ra R) (frac_full a) (frac_full b) <=> + * ra_valid R a ==> ra_valid R b` */ PROOF extern thm frac_ra_update_full_iff; diff --git a/theory/logic/gmap_ra.h b/theory/logic/gmap_ra.h index c66bda2..edcb69d 100644 --- a/theory/logic/gmap_ra.h +++ b/theory/logic/gmap_ra.h @@ -17,37 +17,93 @@ /* Pointwise algebra and validity */ /* ------------------------------------------------------------------------- */ -/* `ra_unit (gmap_ra R) == finmap_empty`. */ +/* + * `forall R:(V)ra. + * ra_unit (gmap_ra R) == (finmap_empty:(K,V)finmap)` + */ PROOF extern thm gmap_ra_unit; /* - * `finmap_lookup (ra_op (gmap_ra R) m n) key == - * ra_op (option_ra R) (finmap_lookup m key) (finmap_lookup n key)`. + * `forall + * (R:(V)ra) + * (m:(K,V)finmap) + * (n:(K,V)finmap) + * (k:K). + * finmap_lookup (ra_op (gmap_ra R) m n) k == + * ra_op + * (option_ra R) + * (finmap_lookup m k) + * (finmap_lookup n k)` */ PROOF extern thm gmap_ra_op_lookup; -/* Map validity is exactly pointwise validity in `option_ra R`. */ +/* + * `forall (R:(V)ra) (m:(K,V)finmap). + * ra_valid (gmap_ra R) m <=> + * forall k:K. + * ra_valid (option_ra R) (finmap_lookup m k)` + */ PROOF extern thm gmap_ra_valid; -/* Singleton-map validity is exactly payload validity. */ +/* + * `forall (R:(V)ra) (key:K) (a:V). + * ra_valid (gmap_ra R) (finmap_singleton key a) <=> + * ra_valid R a` + */ PROOF extern thm gmap_ra_valid_singleton; -/* A present lookup in a valid map has a valid payload. */ +/* + * `forall + * (R:(V)ra) + * (key:K) + * (a:V) + * (m:(K,V)finmap). + * ra_valid (gmap_ra R) m ==> + * finmap_lookup m key == SOME a ==> + * ra_valid R a` + */ PROOF extern thm gmap_ra_valid_lookup; /* ------------------------------------------------------------------------- */ /* Inclusion and decomposition */ /* ------------------------------------------------------------------------- */ -/* Map inclusion is exactly pointwise inclusion in `option_ra R`. */ +/* + * `forall + * (R:(V)ra) + * (m:(K,V)finmap) + * (n:(K,V)finmap). + * ra_included (gmap_ra R) m n <=> + * forall k:K. + * ra_included + * (option_ra R) + * (finmap_lookup m k) + * (finmap_lookup n k)` + */ PROOF extern thm gmap_ra_included_lookup_iff; -/* Inclusion can only grow the finite domain. */ +/* + * `forall + * (R:(V)ra) + * (m:(K,V)finmap) + * (n:(K,V)finmap). + * ra_included (gmap_ra R) m n ==> + * finmap_dom m SUBSET finmap_dom n` + */ PROOF extern thm gmap_ra_included_dom; /* - * A present binding decomposes into its singleton fragment and the map with - * that key deleted. + * `forall + * (R:(V)ra) + * (key:K) + * (a:V) + * (m:(K,V)finmap). + * finmap_lookup m key == SOME a ==> + * m == + * ra_op + * (gmap_ra R) + * (finmap_singleton key a) + * (finmap_delete key m)` */ PROOF extern thm gmap_ra_decompose; @@ -55,21 +111,58 @@ PROOF extern thm gmap_ra_decompose; /* Existing-key transformations */ /* ------------------------------------------------------------------------- */ -/* Lift a payload local update at a key whose current payload is known. */ +/* + * `forall + * (R:(V)ra) + * (key:K) + * (a:V) (f:V) + * (b:V) (g:V) + * (m:(K,V)finmap). + * finmap_lookup m key == SOME a ==> + * ra_local_update R a f b g ==> + * ra_local_update + * (gmap_ra R) + * m + * (finmap_singleton key f) + * (finmap_insert key b m) + * (finmap_singleton key g)` + */ PROOF extern thm gmap_ra_local_update_at; -/* Lift a deterministic payload update at an existing key. */ +/* + * `forall + * (R:(V)ra) + * (key:K) + * (a:V) + * (b:V) + * (m:(K,V)finmap). + * finmap_lookup m key == SOME a ==> + * ra_update R a b ==> + * ra_update (gmap_ra R) m (finmap_insert key b m)` + */ PROOF extern thm gmap_ra_update_at; /* - * Lift a payload predicate update at an existing key, exposing an exact - * `finmap_insert` result for the selected payload. + * `forall + * (R:(V)ra) + * (key:K) + * (a:V) + * (P:V->bool) + * (m:(K,V)finmap). + * finmap_lookup m key == SOME a ==> + * ra_updateP R a P ==> + * ra_updateP + * (gmap_ra R) + * m + * (\result:(K,V)finmap. + * exists b:V. + * P b && result == finmap_insert key b m)` */ PROOF extern thm gmap_ra_updateP_at; /* - * Delete this fragment's contribution at one key. This does not assert that - * the key is absent from a hidden frame or globally absent. + * `forall (R:(V)ra) (key:K) (m:(K,V)finmap). + * ra_update (gmap_ra R) m (finmap_delete key m)` */ PROOF extern thm gmap_ra_drop_at; @@ -78,14 +171,57 @@ PROOF extern thm gmap_ra_drop_at; /* ------------------------------------------------------------------------- */ /* - * Allocate a key-dependent valid payload from an infinite candidate set. - * The chosen fresh key remains inside the `ra_updateP` result predicate and - * may therefore depend on the hidden frame. + * `forall + * (R:(V)ra) + * (candidates:K->bool) + * (payload:K->V) + * (m:(K,V)finmap). + * INFINITE candidates ==> + * (forall key:K. + * key IN candidates ==> + * finmap_lookup m key == NONE ==> + * ra_valid R (payload key)) ==> + * ra_updateP + * (gmap_ra R) + * m + * (\result:(K,V)finmap. + * exists key:K. + * key IN candidates && + * finmap_lookup m key == NONE && + * result == finmap_insert key (payload key) m)` */ PROOF extern thm gmap_ra_alloc_strong_dep; -/* Allocate a fixed valid payload when the key type is infinite. */ +/* + * `forall (R:(V)ra) (m:(K,V)finmap) (a:V). + * INFINITE (UNIV:K->bool) ==> + * ra_valid R a ==> + * ra_updateP + * (gmap_ra R) + * m + * (\result:(K,V)finmap. + * exists key:K. + * finmap_lookup m key == NONE && + * result == finmap_insert key a m)` + */ PROOF extern thm gmap_ra_alloc; -/* Allocate a fixed valid payload while avoiding a finite forbidden set. */ +/* + * `forall + * (R:(V)ra) + * (forbidden:K->bool) + * (m:(K,V)finmap) + * (a:V). + * INFINITE (UNIV:K->bool) ==> + * FINITE forbidden ==> + * ra_valid R a ==> + * ra_updateP + * (gmap_ra R) + * m + * (\result:(K,V)finmap. + * exists key:K. + * ~(key IN forbidden) && + * finmap_lookup m key == NONE && + * result == finmap_insert key a m)` + */ PROOF extern thm gmap_ra_alloc_cofinite; diff --git a/theory/logic/gmap_ra_internal.h b/theory/logic/gmap_ra_internal.h index 0dfb3b4..a721cc9 100644 --- a/theory/logic/gmap_ra_internal.h +++ b/theory/logic/gmap_ra_internal.h @@ -7,15 +7,65 @@ #include "proof/theory/logic/gmap_ra.h" -/* Same-key singleton composition. */ +/* + * `forall (R:(V)ra) (key:K) (a:V) (b:V). + * ra_op + * (gmap_ra R) + * (finmap_singleton key a) + * (finmap_singleton key b) == + * finmap_singleton key (ra_op R a b)` + */ PROOF extern thm gmap_ra_singleton_op; -/* Compose a singleton with a map at a fresh key to obtain `finmap_insert`. */ +/* + * `forall + * (R:(V)ra) + * (key:K) + * (a:V) + * (m:(K,V)finmap). + * finmap_lookup m key == NONE ==> + * ra_op (gmap_ra R) (finmap_singleton key a) m == + * finmap_insert key a m` + */ PROOF extern thm gmap_ra_singleton_op_fresh; -/* Lift deterministic and predicate updates to exact singleton-map images. */ +/* + * `forall (R:(V)ra) (key:K) (a:V) (b:V). + * ra_update R a b ==> + * ra_update + * (gmap_ra R) + * (finmap_singleton key a) + * (finmap_singleton key b)` + */ PROOF extern thm gmap_ra_update_singleton; + +/* + * `forall (R:(V)ra) (key:K) (a:V) (P:V->bool). + * ra_updateP R a P ==> + * ra_updateP + * (gmap_ra R) + * (finmap_singleton key a) + * (\m:(K,V)finmap. + * exists b:V. + * P b && m == finmap_singleton key b)` + */ PROOF extern thm gmap_ra_updateP_singleton; -/* Fixed-payload allocation from an arbitrary infinite candidate set. */ +/* + * `forall + * (R:(V)ra) + * (candidates:K->bool) + * (m:(K,V)finmap) + * (a:V). + * INFINITE candidates ==> + * ra_valid R a ==> + * ra_updateP + * (gmap_ra R) + * m + * (\result:(K,V)finmap. + * exists key:K. + * key IN candidates && + * finmap_lookup m key == NONE && + * result == finmap_insert key a m)` + */ PROOF extern thm gmap_ra_alloc_strong; diff --git a/theory/logic/local_update.h b/theory/logic/local_update.h index a63ff9a..f8c1c00 100644 --- a/theory/logic/local_update.h +++ b/theory/logic/local_update.h @@ -16,42 +16,78 @@ /* * `ra_local_update R a f b g <=> - * forall residual. - * ra_valid R a ==> - * a == ra_op R f residual ==> - * ra_valid R b && b == ra_op R g residual`. + * (forall residual. + * ra_valid R a + * ==> a == ra_op R f residual + * ==> ra_valid R b && b == ra_op R g residual)` */ PROOF extern thm ra_local_update_def; -/* Apply a local update to one explicit residual decomposition. */ +/* + * `forall R a f b g residual. + * ra_local_update R a f b g + * ==> ra_valid R a + * ==> a == ra_op R f residual + * ==> ra_valid R b && b == ra_op R g residual` + */ PROOF extern thm ra_local_update_apply; /* ------------------------------------------------------------------------- */ /* Structural rules */ /* ------------------------------------------------------------------------- */ -/* Local updates are reflexive and compose while preserving the residual. */ +/* `forall R a f. ra_local_update R a f a f` */ PROOF extern thm ra_local_update_refl; + +/* + * `forall R a f b g c h. + * ra_local_update R a f b g + * ==> ra_local_update R b g c h + * ==> ra_local_update R a f c h` + */ PROOF extern thm ra_local_update_trans; -/* Add the same explicit extra resource to both visible local fragments. */ +/* + * `forall R a f b g extra. + * ra_local_update R a f b g + * ==> ra_local_update R a (ra_op R f extra) b (ra_op R g extra)` + */ PROOF extern thm ra_local_update_frame; -/* Preserve validity and inclusion in the presence of an external fragment. */ +/* + * `forall R a f b g external. + * ra_local_update R a f b g + * ==> ra_valid R a + * ==> ra_included R (ra_op R f external) a + * ==> ra_valid R b && ra_included R (ra_op R g external) b` + */ PROOF extern thm ra_local_update_preserves_included; /* ------------------------------------------------------------------------- */ /* Standard local updates */ /* ------------------------------------------------------------------------- */ -/* Allocate one piece into both the whole resource and visible fragment. */ +/* + * `forall R a f piece. + * ra_valid R (ra_op R a piece) + * ==> ra_local_update R a f (ra_op R a piece) (ra_op R f piece)` + */ PROOF extern thm ra_local_update_alloc; -/* Replace a frame-maximal visible fragment by any valid target. */ +/* `forall R a f b. ra_maximal R f ==> ra_valid R b ==> ra_local_update R a f b b` */ PROOF extern thm ra_local_update_maximal; -/* Remove one common prefix from the whole and visible fragment. */ +/* + * `forall R common a f. + * ra_cancellative R + * ==> ra_local_update R (ra_op R common a) (ra_op R common f) a f` + */ PROOF extern thm ra_local_update_cancel; -/* Synchronize a known residual across source and target in a cancellative RA. */ +/* + * `forall R a b common. + * ra_cancellative R + * ==> ra_valid R (ra_op R b common) + * ==> ra_local_update R (ra_op R a common) a (ra_op R b common) b` + */ PROOF extern thm ra_local_update_cancellative; diff --git a/theory/logic/max_nat_ra.h b/theory/logic/max_nat_ra.h index 04f9d82..f1a0673 100644 --- a/theory/logic/max_nat_ra.h +++ b/theory/logic/max_nat_ra.h @@ -15,28 +15,24 @@ /* Algebra, validity, and order */ /* ------------------------------------------------------------------------- */ -/* `ra_unit max_nat_ra == 0`. */ +/* `ra_unit max_nat_ra == 0` */ PROOF extern thm max_nat_ra_unit; -/* `forall a b:num. ra_op max_nat_ra a b == MAX a b`. */ +/* `forall a b. ra_op max_nat_ra a b == MAX a b` */ PROOF extern thm max_nat_ra_op; -/* `forall n:num. ra_valid max_nat_ra n`. */ +/* `forall n. ra_valid max_nat_ra n` */ PROOF extern thm max_nat_ra_valid; -/* `forall a b:num. ra_included max_nat_ra a b <=> a <= b`. */ +/* `forall a b. ra_included max_nat_ra a b <=> a <= b` */ PROOF extern thm max_nat_ra_included; -/* `forall n:num. ra_op max_nat_ra n n == n`. */ +/* `forall n. ra_op max_nat_ra n n == n` */ PROOF extern thm max_nat_ra_idempotent; /* ------------------------------------------------------------------------- */ /* Updates */ /* ------------------------------------------------------------------------- */ -/* - * `forall a b:num. ra_update max_nat_ra a b`. - * Monotonicity is imposed by an enclosing authority protocol, not this base - * RA's frame-preserving update relation. - */ +/* `forall old new. ra_update max_nat_ra old new` */ PROOF extern thm max_nat_ra_update; diff --git a/theory/logic/named_logic.h b/theory/logic/named_logic.h index 560e134..e1b604b 100644 --- a/theory/logic/named_logic.h +++ b/theory/logic/named_logic.h @@ -5,10 +5,49 @@ #include "proof/theory/logic/basic_update.h" #include "proof/theory/logic/named_ra.h" +/** + * HOL conclusion: + * `named_own (R:(A)ra) (name:num) (a:A) : (num,A)finmap->bool = r_own (named_ra + * R) (finmap_singleton name a)`. + */ PROOF extern thm named_own_def; +/** + * HOL conclusion: + * `forall (R:(A)ra) (name:num) (a:A) (b:A). r_equiv (named_ra R) (named_own R + * name (ra_op R a b)) (r_sep (named_ra R) (named_own R name a) (named_own R + * name b))`. + */ PROOF extern thm named_own_op; +/** + * HOL conclusion: + * `forall (R:(A)ra) (name:num) (a:A). r_entails (named_ra R) (named_own R name + * a) (r_sep (named_ra R) (r_fact (named_ra R) (ra_valid R a)) (named_own R + * name a))`. + */ PROOF extern thm named_own_valid; +/** + * HOL conclusion: + * `forall (R:(A)ra) (name:num) (a:A) (b:A). ra_update R a b ==> r_viewshift + * (named_ra R) (named_own R name a) (named_own R name b)`. + */ PROOF extern thm named_own_update; +/** + * HOL conclusion: + * `forall (R:(A)ra) (name:num) (a:A) (P:A->bool). ra_updateP R a P ==> + * r_viewshift (named_ra R) (named_own R name a) (r_exists (named_ra R) (\b:A. + * r_sep (named_ra R) (r_fact (named_ra R) (P b)) (named_own R name b)))`. + */ PROOF extern thm named_own_updateP; +/** + * HOL conclusion: + * `forall (R:(A)ra) (name:num) (a:A). r_viewshift (named_ra R) (named_own R + * name a) (r_emp (named_ra R))`. + */ PROOF extern thm named_own_drop; +/** + * HOL conclusion: + * `forall (R:(A)ra) (a:A) (P:(num,A)finmap->bool). ra_valid R a ==> r_viewshift + * (named_ra R) P (r_exists (named_ra R) (\name:num. r_sep (named_ra R) + * (named_own R name a) P))`. + */ PROOF extern thm named_own_alloc; diff --git a/theory/logic/named_ra.h b/theory/logic/named_ra.h index d33a02f..c629274 100644 --- a/theory/logic/named_ra.h +++ b/theory/logic/named_ra.h @@ -14,26 +14,55 @@ /* Specialization and pointwise semantics */ /* ------------------------------------------------------------------------- */ -/* `named_ra R == (gmap_ra R:((num,A)finmap)ra)`. */ +/* `named_ra (R:(A)ra) == (gmap_ra R:((num,A)finmap)ra)` */ PROOF extern thm named_ra_def; -/* `ra_unit (named_ra R) == (finmap_empty:(num,A)finmap)`. */ +/* + * `forall R:(A)ra. + * ra_unit (named_ra R) == (finmap_empty:(num,A)finmap)` + */ PROOF extern thm named_ra_unit; -/* Same-name singleton fragments compose in the payload RA. */ +/* + * `forall (R:(A)ra) (name:num) (a:A) (b:A). + * ra_op + * (named_ra R) + * (finmap_singleton name a) + * (finmap_singleton name b) == + * finmap_singleton name (ra_op R a b)` + */ PROOF extern thm named_ra_singleton_op; -/* A named singleton is valid exactly when its payload is valid. */ +/* + * `forall (R:(A)ra) (name:num) (a:A). + * ra_valid (named_ra R) (finmap_singleton name a) <=> + * ra_valid R a` + */ PROOF extern thm named_ra_valid_singleton; /* ------------------------------------------------------------------------- */ /* Fixed-name updates */ /* ------------------------------------------------------------------------- */ -/* Lift a deterministic payload update at one fixed name. */ +/* + * `forall (R:(A)ra) (name:num) (a:A) (b:A). + * ra_update R a b ==> + * ra_update + * (named_ra R) + * (finmap_singleton name a) + * (finmap_singleton name b)` + */ PROOF extern thm named_ra_update_singleton; -/* Lift a predicate payload update to an exact singleton-map result. */ +/* + * `forall (R:(A)ra) (name:num) (a:A) (P:A->bool). + * ra_updateP R a P ==> + * ra_updateP + * (named_ra R) + * (finmap_singleton name a) + * (\m:(num,A)finmap. + * exists b:A. P b && m == finmap_singleton name b)` + */ PROOF extern thm named_ra_updateP_singleton; /* ------------------------------------------------------------------------- */ @@ -41,14 +70,23 @@ PROOF extern thm named_ra_updateP_singleton; /* ------------------------------------------------------------------------- */ /* - * Drop a singleton fragment to the empty map. This does not prove that the - * same name is absent from a hidden frame or globally absent. + * `forall (R:(A)ra) (name:num) (a:A). + * ra_update + * (named_ra R) + * (finmap_singleton name a) + * (finmap_empty:(num,A)finmap)` */ PROOF extern thm named_ra_drop; /* - * Allocate a valid payload at a source-map-fresh natural-number name. The - * chosen name remains existential inside the `ra_updateP` result predicate and - * may depend on the hidden frame. + * `forall (R:(A)ra) (m:(num,A)finmap) (a:A). + * ra_valid R a ==> + * ra_updateP + * (named_ra R) + * m + * (\result:(num,A)finmap. + * exists name:num. + * finmap_lookup m name == NONE && + * result == finmap_insert name a m)` */ PROOF extern thm named_ra_alloc; diff --git a/theory/logic/option_ra.h b/theory/logic/option_ra.h index 6bbbaf2..f72e601 100644 --- a/theory/logic/option_ra.h +++ b/theory/logic/option_ra.h @@ -14,52 +14,60 @@ /* Operation and validity */ /* ------------------------------------------------------------------------- */ -/* `ra_unit (option_ra R) == NONE`. */ +/* `forall R. ra_unit (option_ra R) == NONE` */ PROOF extern thm option_ra_unit; -/* `ra_op (option_ra R) NONE x == x`. */ +/* `forall R x. ra_op (option_ra R) NONE x == x` */ PROOF extern thm option_ra_op_none_l; -/* - * `ra_op (option_ra R) (SOME a) (SOME b) == - * SOME (ra_op R a b)`. - */ +/* `forall R a b. ra_op (option_ra R) (SOME a) (SOME b) == SOME (ra_op R a b)` */ PROOF extern thm option_ra_op_some_some; -/* `ra_valid (option_ra R) NONE`. */ +/* `forall R. ra_valid (option_ra R) NONE` */ PROOF extern thm option_ra_valid_none; -/* `ra_valid (option_ra R) (SOME a) <=> ra_valid R a`. */ +/* `forall R a. ra_valid (option_ra R) (SOME a) <=> ra_valid R a` */ PROOF extern thm option_ra_valid_some; /* ------------------------------------------------------------------------- */ /* Inclusion and algebraic properties */ /* ------------------------------------------------------------------------- */ -/* `NONE` is included in every option resource. */ +/* `forall R x. ra_included (option_ra R) NONE x` */ PROOF extern thm option_ra_included_none; -/* Present-to-present inclusion is exactly base-RA inclusion. */ +/* + * `forall R a b. + * ra_included (option_ra R) (SOME a) (SOME b) <=> ra_included R a b` + */ PROOF extern thm option_ra_included_some_some; -/* A present resource is never included in `NONE`. */ +/* `forall R a. ~ra_included (option_ra R) (SOME a) NONE` */ PROOF extern thm option_ra_not_included_some_none; -/* `~(SOME (ra_unit R) == NONE)`. */ +/* `forall R. ~(SOME (ra_unit R) == NONE)` */ PROOF extern thm option_ra_some_unit_ne_none; -/* Adjoining a distinct unit makes `option_ra R` non-cancellative. */ +/* `forall R. ~ra_cancellative (option_ra R)` */ PROOF extern thm option_ra_not_cancellative; /* ------------------------------------------------------------------------- */ /* Exact lifting rules */ /* ------------------------------------------------------------------------- */ -/* Predicate updates lift exactly to a predicate over `SOME` results. */ +/* + * `forall R a P. + * ra_updateP (option_ra R) (SOME a) (\x. exists b. P b && x == SOME b) <=> + * ra_updateP R a P` + */ PROOF extern thm option_ra_updateP_iff; -/* `SOME a` updates to `SOME b` exactly when `a` updates to `b` in `R`. */ +/* `forall R a b. ra_update (option_ra R) (SOME a) (SOME b) <=> ra_update R a b` */ PROOF extern thm option_ra_update_iff; -/* Five-argument local updates lift exactly through `SOME`. */ +/* + * `forall R a f b g. + * ra_local_update (option_ra R) (SOME a) (SOME f) (SOME b) (SOME g) <=> + * ra_local_update R a f b g` + */ PROOF extern thm option_ra_local_update_iff; diff --git a/theory/logic/option_ra_internal.h b/theory/logic/option_ra_internal.h index 6b7f903..437bc64 100644 --- a/theory/logic/option_ra_internal.h +++ b/theory/logic/option_ra_internal.h @@ -7,9 +7,15 @@ #include "proof/theory/logic/option_ra.h" -/* Right-unit computation, retained internally as a direct rewrite rule. */ +/* `forall R x. ra_op (option_ra R) x NONE == x` */ PROOF extern thm option_ra_op_none_r; -/* One-way deterministic and predicate-update lifting through `SOME`. */ +/* `forall R a b. ra_update R a b ==> ra_update (option_ra R) (SOME a) (SOME b)` */ PROOF extern thm option_ra_update; + +/* + * `forall R a P. + * ra_updateP R a P + * ==> ra_updateP (option_ra R) (SOME a) (\x. exists b. P b && x == SOME b)` + */ PROOF extern thm option_ra_updateP; diff --git a/theory/logic/prod_ra.h b/theory/logic/prod_ra.h index 0b0f63c..21bd61a 100644 --- a/theory/logic/prod_ra.h +++ b/theory/logic/prod_ra.h @@ -15,23 +15,41 @@ /* Pointwise algebra */ /* ------------------------------------------------------------------------- */ -/* `ra_unit (prod_ra R S) == (ra_unit R,ra_unit S)`. */ +/* `forall R1 R2. ra_unit (prod_ra R1 R2) == ra_unit R1,ra_unit R2` */ PROOF extern thm prod_ra_unit; /* - * `ra_op (prod_ra R S) x y == - * (ra_op R (FST x) (FST y),ra_op S (SND x) (SND y))`. + * `forall R1 R2 x y. + * ra_op (prod_ra R1 R2) x y == + * ra_op R1 (FST x) (FST y),ra_op R2 (SND x) (SND y)` */ PROOF extern thm prod_ra_op; -/* Product validity is exactly componentwise validity. */ +/* + * `forall R1 R2 x. + * ra_valid (prod_ra R1 R2) x <=> ra_valid R1 (FST x) && ra_valid R2 (SND x)` + */ PROOF extern thm prod_ra_valid; -/* Product inclusion is exactly componentwise inclusion. */ +/* + * `forall R1 R2 x y. + * ra_included (prod_ra R1 R2) x y <=> + * ra_included R1 (FST x) (FST y) && ra_included R2 (SND x) (SND y)` + */ PROOF extern thm prod_ra_included; -/* Product cancellativity and frame-maximality hold componentwise. */ +/* + * `forall R1 R2. + * ra_cancellative (prod_ra R1 R2) <=> + * ra_cancellative R1 && ra_cancellative R2` + */ PROOF extern thm prod_ra_cancellative_iff; + +/* + * `forall R1 R2 x. + * ra_maximal (prod_ra R1 R2) x <=> + * ra_maximal R1 (FST x) && ra_maximal R2 (SND x)` + */ PROOF extern thm prod_ra_maximal_iff; /* ------------------------------------------------------------------------- */ @@ -39,36 +57,84 @@ PROOF extern thm prod_ra_maximal_iff; /* ------------------------------------------------------------------------- */ /* - * Combine two predicate updates, exposing only exact result pairs selected by - * the two component predicates. + * `forall R1 R2 a1 a2 P1 P2. + * ra_updateP R1 a1 P1 + * ==> ra_updateP R2 a2 P2 + * ==> ra_updateP (prod_ra R1 R2) (a1,a2) + * (\x. exists b1 b2. P1 b1 && P2 b2 && x == b1,b2)` */ PROOF extern thm prod_ra_updateP; -/* Lift a deterministic update in one coordinate and preserve the other. */ +/* + * `forall R1 R2 a1 a2 b1. + * ra_update R1 a1 b1 ==> ra_update (prod_ra R1 R2) (a1,a2) (b1,a2)` + */ PROOF extern thm prod_ra_update_left; + +/* + * `forall R1 R2 a1 a2 b2. + * ra_update R2 a2 b2 ==> ra_update (prod_ra R1 R2) (a1,a2) (a1,b2)` + */ PROOF extern thm prod_ra_update_right; -/* Lift two five-argument local updates componentwise. */ +/* + * `forall R1 R2 a1 f1 b1 g1 a2 f2 b2 g2. + * ra_local_update R1 a1 f1 b1 g1 + * ==> ra_local_update R2 a2 f2 b2 g2 + * ==> ra_local_update (prod_ra R1 R2) (a1,a2) (f1,f2) (b1,b2) (g1,g2)` + */ PROOF extern thm prod_ra_local_update; /* ------------------------------------------------------------------------- */ /* Canonical component embeddings */ /* ------------------------------------------------------------------------- */ -/* `prod_inl R S a == (a,ra_unit S)`. */ +/* `forall R S a. prod_inl R S a == a,ra_unit S` */ PROOF extern thm prod_inl_def; -/* `prod_inr R S b == (ra_unit R,b)`. */ +/* `forall R S b. prod_inr R S b == ra_unit R,b` */ PROOF extern thm prod_inr_def; -/* Each embedding preserves the RA operation. */ +/* + * `forall R S a b. + * prod_inl R S (ra_op R a b) == + * ra_op (prod_ra R S) (prod_inl R S a) (prod_inl R S b)` + */ PROOF extern thm prod_inl_op; + +/* + * `forall R S a b. + * prod_inr R S (ra_op S a b) == + * ra_op (prod_ra R S) (prod_inr R S a) (prod_inr R S b)` + */ PROOF extern thm prod_inr_op; -/* Lift predicate updates to the exact image of the corresponding embedding. */ +/* + * `forall R S a P. + * ra_updateP R a P + * ==> ra_updateP (prod_ra R S) (prod_inl R S a) + * (\x. exists b. P b && x == prod_inl R S b)` + */ PROOF extern thm prod_inl_updateP; + +/* + * `forall R S a P. + * ra_updateP S a P + * ==> ra_updateP (prod_ra R S) (prod_inr R S a) + * (\x. exists b. P b && x == prod_inr R S b)` + */ PROOF extern thm prod_inr_updateP; -/* Lift deterministic updates through the corresponding embedding. */ +/* + * `forall R S a b. + * ra_update R a b + * ==> ra_update (prod_ra R S) (prod_inl R S a) (prod_inl R S b)` + */ PROOF extern thm prod_inl_update; + +/* + * `forall R S a b. + * ra_update S a b + * ==> ra_update (prod_ra R S) (prod_inr R S a) (prod_inr R S b)` + */ PROOF extern thm prod_inr_update; diff --git a/theory/logic/prod_ra_internal.h b/theory/logic/prod_ra_internal.h index 5b888d5..d7aacd1 100644 --- a/theory/logic/prod_ra_internal.h +++ b/theory/logic/prod_ra_internal.h @@ -8,9 +8,9 @@ #include "proof/theory/logic/prod_ra.h" /* - * One-way constructor rule: - * `ra_cancellative R ==> ra_cancellative S ==> - * ra_cancellative (prod_ra R S)`. - * Public clients use `prod_ra_cancellative_iff`. + * `forall R1 R2. + * ra_cancellative R1 + * ==> ra_cancellative R2 + * ==> ra_cancellative (prod_ra R1 R2)` */ PROOF extern thm prod_ra_cancellative; diff --git a/theory/logic/product_resource.h b/theory/logic/product_resource.h index e7c28d4..5e86272 100644 --- a/theory/logic/product_resource.h +++ b/theory/logic/product_resource.h @@ -24,37 +24,169 @@ #include "proof/theory/logic/prod_ra.h" #include "proof/theory/logic/resource_prop.h" +/** + * HOL conclusion: + * `r_lift_left (R:(A)ra) (S:(B)ra) (P:A->bool) (resource:A#B) <=> P (FST + * resource) && SND resource == ra_unit S`. + */ PROOF extern thm r_lift_left_def; +/** + * HOL conclusion: + * `r_lift_right (R:(A)ra) (S:(B)ra) (Q:B->bool) (resource:A#B) <=> FST resource + * == ra_unit R && Q (SND resource)`. + */ PROOF extern thm r_lift_right_def; /* Exact-lift separating-monoid and entailment laws. */ +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra). r_equiv (prod_ra R S) (r_lift_left R S (r_emp + * R)) (r_emp (prod_ra R S))`. + */ PROOF extern thm r_lift_left_emp; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra). r_equiv (prod_ra R S) (r_lift_right R S (r_emp + * S)) (r_emp (prod_ra R S))`. + */ PROOF extern thm r_lift_right_emp; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (P:A->bool) (Q:A->bool). r_equiv (prod_ra R S) + * (r_lift_left R S (r_sep R P Q)) (r_sep (prod_ra R S) (r_lift_left R S P) + * (r_lift_left R S Q))`. + */ PROOF extern thm r_lift_left_sep; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (P:B->bool) (Q:B->bool). r_equiv (prod_ra R S) + * (r_lift_right R S (r_sep S P Q)) (r_sep (prod_ra R S) (r_lift_right R S P) + * (r_lift_right R S Q))`. + */ PROOF extern thm r_lift_right_sep; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (P:A->bool) (Q:A->bool). r_entails R P Q ==> + * r_entails (prod_ra R S) (r_lift_left R S P) (r_lift_left R S Q)`. + */ PROOF extern thm r_lift_left_entails; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (P:B->bool) (Q:B->bool). r_entails S P Q ==> + * r_entails (prod_ra R S) (r_lift_right R S P) (r_lift_right R S Q)`. + */ PROOF extern thm r_lift_right_entails; /* Right-only basic update and view shift. */ +/** + * HOL conclusion: + * `r_bupd_right (R:(A)ra) (S:(B)ra) (Q:(A#B)->bool) (resource:A#B) <=> + * ra_updateP S (SND resource) (\right':B. Q (FST resource,right'))`. + */ PROOF extern thm r_bupd_right_def; +/** + * HOL conclusion: + * `r_viewshift_right (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Q:(A#B)->bool) <=> + * r_entails (prod_ra R S) P (r_bupd_right R S Q)`. + */ PROOF extern thm r_viewshift_right_def; /* Right-only basic-update modality laws. */ +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool). r_entails (prod_ra R S) P + * (r_bupd_right R S P)`. + */ PROOF extern thm r_bupd_right_intro; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Q:(A#B)->bool). r_entails + * (prod_ra R S) P Q ==> r_entails (prod_ra R S) (r_bupd_right R S P) + * (r_bupd_right R S Q)`. + */ PROOF extern thm r_bupd_right_mono; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool). r_entails (prod_ra R S) + * (r_bupd_right R S (r_bupd_right R S P)) (r_bupd_right R S P)`. + */ PROOF extern thm r_bupd_right_idem; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Frame:(A#B)->bool). r_entails + * (prod_ra R S) (r_sep (prod_ra R S) (r_bupd_right R S P) Frame) (r_bupd_right + * R S (r_sep (prod_ra R S) P Frame))`. + */ PROOF extern thm r_bupd_right_frame; /* Right-only view-shift laws, including exact-fact and existential lifting. */ +/** HOL conclusion: `forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool). r_viewshift_right R S P P`. */ PROOF extern thm r_viewshift_right_refl; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Q:(A#B)->bool). r_entails + * (prod_ra R S) P Q ==> r_viewshift_right R S P Q`. + */ PROOF extern thm r_viewshift_right_entails; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Q:(A#B)->bool) (U:(A#B)->bool). + * r_viewshift_right R S P Q ==> r_viewshift_right R S Q U ==> + * r_viewshift_right R S P U`. + */ PROOF extern thm r_viewshift_right_trans; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (P2:(A#B)->bool) (P:(A#B)->bool) (Q:(A#B)->bool) + * (Q2:(A#B)->bool). r_entails (prod_ra R S) P2 P ==> r_viewshift_right R S P Q + * ==> r_entails (prod_ra R S) Q Q2 ==> r_viewshift_right R S P2 Q2`. + */ PROOF extern thm r_viewshift_right_mono; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Q:(A#B)->bool) + * (Frame:(A#B)->bool). r_viewshift_right R S P Q ==> r_viewshift_right R S + * (r_sep (prod_ra R S) P Frame) (r_sep (prod_ra R S) Q Frame)`. + */ PROOF extern thm r_viewshift_right_frame; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (P1:(A#B)->bool) (Q1:(A#B)->bool) + * (P2:(A#B)->bool) (Q2:(A#B)->bool). r_viewshift_right R S P1 Q1 ==> + * r_viewshift_right R S P2 Q2 ==> r_viewshift_right R S (r_sep (prod_ra R S) + * P1 P2) (r_sep (prod_ra R S) Q1 Q2)`. + */ PROOF extern thm r_viewshift_right_sep; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (guard:bool) (P:(A#B)->bool) (Q:(A#B)->bool). + * (guard ==> r_viewshift_right R S P Q) ==> r_viewshift_right R S (r_sep + * (prod_ra R S) (r_fact (prod_ra R S) guard) P) (r_sep (prod_ra R S) (r_fact + * (prod_ra R S) guard) Q)`. + */ PROOF extern thm r_viewshift_right_fact; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (P:C->(A#B)->bool) (Q:C->(A#B)->bool). (forall + * witness:C. r_viewshift_right R S (P witness) (Q witness)) ==> + * r_viewshift_right R S (r_exists (prod_ra R S) (\bound:C. P bound)) (r_exists + * (prod_ra R S) (\bound:C. Q bound))`. + */ PROOF extern thm r_viewshift_right_exists; /* Ownership rules for deterministic and predicate updates of the right RA. */ +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (a:B) (b:B). ra_update S a b ==> + * r_viewshift_right R S (r_lift_right R S (r_own S a)) (r_lift_right R S + * (r_own S b))`. + */ PROOF extern thm r_right_own_update; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (a:B) (P:B->bool). ra_updateP S a P ==> + * r_viewshift_right R S (r_lift_right R S (r_own S a)) (r_exists (prod_ra R S) + * (\b:B. r_sep (prod_ra R S) (r_fact (prod_ra R S) (P b)) (r_lift_right R S + * (r_own S b))))`. + */ PROOF extern thm r_right_own_updateP; diff --git a/theory/logic/product_resource_internal.h b/theory/logic/product_resource_internal.h index 270e98b..42f8481 100644 --- a/theory/logic/product_resource_internal.h +++ b/theory/logic/product_resource_internal.h @@ -11,7 +11,27 @@ #include "proof/theory/logic/product_resource.h" +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra). r_lift_left R S (r_emp R) == r_emp + * (prod_ra R S)`. + */ PROOF extern thm r_lift_left_emp_eq; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra). r_lift_right R S (r_emp S) == r_emp (prod_ra R + * S)`. + */ PROOF extern thm r_lift_right_emp_eq; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (P:A->bool) (Q:A->bool). r_lift_left R S (r_sep R + * P Q) == r_sep (prod_ra R S) (r_lift_left R S P) (r_lift_left R S Q)`. + */ PROOF extern thm r_lift_left_sep_eq; +/** + * HOL conclusion: + * `forall (R:(A)ra) (S:(B)ra) (P:B->bool) (Q:B->bool). r_lift_right R S (r_sep + * S P Q) == r_sep (prod_ra R S) (r_lift_right R S P) (r_lift_right R S Q)`. + */ PROOF extern thm r_lift_right_sep_eq; diff --git a/theory/logic/ra.h b/theory/logic/ra.h index fa51074..58152aa 100644 --- a/theory/logic/ra.h +++ b/theory/logic/ra.h @@ -21,129 +21,198 @@ /* Derived relations */ /* ------------------------------------------------------------------------- */ -/* `ra_compatible R a b <=> ra_valid R (ra_op R a b)`. */ +/* `ra_compatible R a b <=> ra_valid R (ra_op R a b)` */ PROOF extern thm ra_compatible_def; -/* `ra_included R a b <=> exists frame. b == ra_op R a frame`. */ +/* `ra_included R a b <=> (exists frame. b == ra_op R a frame)` */ PROOF extern thm ra_included_def; /* - * `ra_updateP R a P` holds when every frame valid with `a` admits a - * frame-compatible result selected by `P`. The result may depend on the - * hidden frame. + * `ra_updateP R a result <=> + * (forall frame. + * ra_valid R (ra_op R a frame) + * ==> (exists b. result b && ra_valid R (ra_op R b frame)))` */ PROOF extern thm ra_updateP_def; -/* `ra_update R a b <=> ra_updateP R a (\x. x == b)`. */ +/* `ra_update R a b <=> ra_updateP R a (\x. x == b)` */ PROOF extern thm ra_update_def; -/* Valid-source cancellation of a common left frame. */ +/* + * `ra_cancellative R <=> + * (forall frame a b. + * ra_valid R (ra_op R frame a) + * ==> ra_op R frame a == ra_op R frame b + * ==> a == b)` + */ PROOF extern thm ra_cancellative_def; -/* Strong frame-maximality: valid, with no compatible frame except the unit. */ +/* + * `ra_maximal R a <=> + * ra_valid R a && + * (forall frame. ra_valid R (ra_op R a frame) ==> frame == ra_unit R)` + */ PROOF extern thm ra_maximal_def; /* ------------------------------------------------------------------------- */ /* Intrinsic RA laws */ /* ------------------------------------------------------------------------- */ -/* `forall R. ra_laws (ra_unit R) (ra_op R) (ra_valid R)`. */ +/* `forall R. ra_laws (ra_unit R) (ra_op R) (ra_valid R)` */ PROOF extern thm ra_laws; -/* `ra_op R (ra_op R a b) c == ra_op R a (ra_op R b c)`. */ +/* `forall R a b c. ra_op R (ra_op R a b) c == ra_op R a (ra_op R b c)` */ PROOF extern thm ra_assoc; -/* `ra_op R a b == ra_op R b a`. */ +/* `forall R a b. ra_op R a b == ra_op R b a` */ PROOF extern thm ra_comm; -/* `ra_op R (ra_unit R) a == a`. */ +/* `forall R a. ra_op R (ra_unit R) a == a` */ PROOF extern thm ra_unit_l; -/* `ra_op R a (ra_unit R) == a`. */ +/* `forall R a. ra_op R a (ra_unit R) == a` */ PROOF extern thm ra_unit_r; -/* `ra_valid R (ra_unit R)`. */ +/* `forall R. ra_valid R (ra_unit R)` */ PROOF extern thm ra_valid_unit; -/* `ra_valid R (ra_op R a b) ==> ra_valid R a && ra_valid R b`. */ +/* `forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R a && ra_valid R b` */ PROOF extern thm ra_valid_op; /* ------------------------------------------------------------------------- */ /* Compatibility and inclusion */ /* ------------------------------------------------------------------------- */ -/* `ra_compatible R a b <=> ra_compatible R b a`. */ +/* `forall R a b. ra_compatible R a b <=> ra_compatible R b a` */ PROOF extern thm ra_compat_comm; -/* `ra_compatible R a (ra_unit R) <=> ra_valid R a`. */ +/* `forall R a. ra_compatible R a (ra_unit R) <=> ra_valid R a` */ PROOF extern thm ra_compat_unit; -/* Inclusion is a preorder whose bottom element is the RA unit. */ +/* `forall R a. ra_included R a a` */ PROOF extern thm ra_included_refl; + +/* `forall R a. ra_included R (ra_unit R) a` */ PROOF extern thm ra_included_unit; -/* Each operand is included in its composition. */ +/* `forall R a b. ra_included R a (ra_op R a b)` */ PROOF extern thm ra_included_op_l; + +/* `forall R a b. ra_included R b (ra_op R a b)` */ PROOF extern thm ra_included_op_r; -/* Inclusion is transitive and composition is monotone in both operands. */ +/* `forall R a b c. ra_included R a b ==> ra_included R b c ==> ra_included R a c` */ PROOF extern thm ra_included_trans; + +/* + * `forall R a1 a2 b1 b2. + * ra_included R a1 a2 + * ==> ra_included R b1 b2 + * ==> ra_included R (ra_op R a1 b1) (ra_op R a2 b2)` + */ PROOF extern thm ra_included_op_mono; -/* `ra_included R a b ==> ra_valid R b ==> ra_valid R a`. */ +/* `forall R a b. ra_included R a b ==> ra_valid R b ==> ra_valid R a` */ PROOF extern thm ra_included_valid; /* ------------------------------------------------------------------------- */ /* Predicate updates */ /* ------------------------------------------------------------------------- */ -/* `ra_updateP R a (\x. x == b) <=> ra_update R a b`. */ +/* `forall R a b. ra_updateP R a (\x. x == b) <=> ra_update R a b` */ PROOF extern thm ra_updateP_singleton; -/* Predicate updates are reflexive, monotone in their result, and transitive. */ +/* `forall R a. ra_updateP R a (\x. x == a)` */ PROOF extern thm ra_updateP_refl; + +/* + * `forall R a P Q. + * ra_updateP R a P ==> (forall b. P b ==> Q b) ==> ra_updateP R a Q` + */ PROOF extern thm ra_updateP_mono; + +/* + * `forall R a P Q. + * ra_updateP R a P + * ==> (forall b. P b ==> ra_updateP R b Q) + * ==> ra_updateP R a Q` + */ PROOF extern thm ra_updateP_trans; -/* A valid source selects at least one valid result satisfying the predicate. */ +/* + * `forall R a P. + * ra_updateP R a P ==> ra_valid R a ==> (exists b. P b && ra_valid R b)` + */ PROOF extern thm ra_updateP_valid; -/* Lift a predicate update while retaining one explicit owned frame. */ +/* + * `forall R a P extra. + * ra_updateP R a P + * ==> ra_updateP R (ra_op R a extra) + * (\x. exists b. P b && x == ra_op R b extra)` + */ PROOF extern thm ra_updateP_frame; -/* Combine two predicate updates under the RA operation. */ +/* + * `forall R a c P Q. + * ra_updateP R a P + * ==> ra_updateP R c Q + * ==> ra_updateP R (ra_op R a c) + * (\x. exists b d. P b && Q d && x == ra_op R b d)` + */ PROOF extern thm ra_updateP_op; /* ------------------------------------------------------------------------- */ /* Deterministic updates */ /* ------------------------------------------------------------------------- */ -/* Deterministic updates are reflexive and transitive. */ +/* `forall R a. ra_update R a a` */ PROOF extern thm ra_update_refl; + +/* `forall R a b c. ra_update R a b ==> ra_update R b c ==> ra_update R a c` */ PROOF extern thm ra_update_trans; -/* Retain one frame, or combine two independent deterministic updates. */ +/* + * `forall R a b extra. + * ra_update R a b ==> ra_update R (ra_op R a extra) (ra_op R b extra)` + */ PROOF extern thm ra_update_frame; + +/* + * `forall R a b c d. + * ra_update R a b + * ==> ra_update R c d + * ==> ra_update R (ra_op R a c) (ra_op R b d)` + */ PROOF extern thm ra_update_op; -/* A resource may update to an included part. */ +/* `forall R a b. ra_included R b a ==> ra_update R a b` */ PROOF extern thm ra_update_included; -/* An update target may be weakened further to one of its included parts. */ +/* `forall R a b c. ra_update R a b ==> ra_included R c b ==> ra_update R a c` */ PROOF extern thm ra_update_target_included; -/* `ra_update R a b ==> ra_valid R a ==> ra_valid R b`. */ +/* `forall R a b. ra_update R a b ==> ra_valid R a ==> ra_valid R b` */ PROOF extern thm ra_update_valid; /* ------------------------------------------------------------------------- */ /* Optional algebraic properties */ /* ------------------------------------------------------------------------- */ -/* A frame-maximal element has no strict valid extension. */ +/* + * `forall R a b. + * ra_maximal R a ==> ra_valid R b ==> ra_included R a b ==> a == b` + */ PROOF extern thm ra_maximal_included; -/* A frame-maximal element may be replaced by any valid target. */ +/* `forall R a b. ra_maximal R a ==> ra_valid R b ==> ra_update R a b` */ PROOF extern thm ra_maximal_update; -/* Direct eliminator for `ra_cancellative`. */ +/* + * `forall R frame a b. + * ra_cancellative R + * ==> ra_valid R (ra_op R frame a) + * ==> ra_op R frame a == ra_op R frame b + * ==> a == b` + */ PROOF extern thm ra_cancellative_apply; diff --git a/theory/logic/ra_builder.h b/theory/logic/ra_builder.h index 7a4aa1e..8ab0078 100644 --- a/theory/logic/ra_builder.h +++ b/theory/logic/ra_builder.h @@ -16,28 +16,49 @@ /* ------------------------------------------------------------------------- */ /* - * `ra_laws e op valid` requires associativity, commutativity, a left unit, - * unit validity, and validity closure under taking an operand of `op`. + * `ra_laws e op valid <=> + * (forall a b c. op (op a b) c == op a (op b c)) && + * (forall a b. op a b == op b a) && + * (forall a. op e a == a) && + * valid e && + * (forall a b. valid (op a b) ==> valid a)` */ PROOF extern thm ra_laws_def; -/* Bijection between lawful raw descriptors and the abstract `(A)ra` type. */ +/* + * `(forall a. ra_abs (ra_rep a) == a) && + * (forall r. + * ra_laws (FST r) (FST (SND r)) (SND (SND r)) <=> ra_rep (ra_abs r) == r)` + */ PROOF extern thm ra_type_bijection; -/* The representation of every abstract RA satisfies `ra_laws`. */ +/* + * `forall R. + * ra_laws (FST (ra_rep R)) (FST (SND (ra_rep R))) (SND (SND (ra_rep R)))` + */ PROOF extern thm ra_rep_laws; -/* A lawful descriptor survives the `ra_abs`/`ra_rep` round trip. */ +/* + * `forall e op valid. + * ra_laws e op valid ==> ra_rep (ra_abs (e,op,valid)) == e,op,valid` + */ PROOF extern thm ra_abs_rep; /* ------------------------------------------------------------------------- */ /* Constructor computation rules */ /* ------------------------------------------------------------------------- */ -/* Compute the unit, operation, and validity of a lawful `ra_abs` descriptor. */ +/* `forall e op valid. ra_laws e op valid ==> ra_unit (ra_abs (e,op,valid)) == e` */ PROOF extern thm ra_unit_abs; + +/* `forall e op valid. ra_laws e op valid ==> ra_op (ra_abs (e,op,valid)) == op` */ PROOF extern thm ra_op_abs; + +/* + * `forall e op valid. + * ra_laws e op valid ==> ra_valid (ra_abs (e,op,valid)) == valid` + */ PROOF extern thm ra_valid_abs; -/* `ra_abs (ra_unit R,(ra_op R,ra_valid R)) == R`. */ +/* `forall R. ra_abs (ra_unit R,ra_op R,ra_valid R) == R` */ PROOF extern thm ra_abs_eta; diff --git a/theory/logic/ra_internal.h b/theory/logic/ra_internal.h index 58e6fd5..6e7d819 100644 --- a/theory/logic/ra_internal.h +++ b/theory/logic/ra_internal.h @@ -14,41 +14,83 @@ /* Operation and validity normalization */ /* ------------------------------------------------------------------------- */ -/* `(a · b) · c == (a · c) · b`, with the left operand fixed. */ +/* `forall R a b c. ra_op R (ra_op R a b) c == ra_op R (ra_op R a c) b` */ PROOF extern thm ra_op_swap_right; -/* Project either valid operand from a valid composition. */ +/* `forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R a` */ PROOF extern thm ra_valid_op_l; + +/* `forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R b` */ PROOF extern thm ra_valid_op_r; -/* Direct eliminators for frame-maximality and frame-preserving updates. */ +/* + * `forall R a frame. + * ra_maximal R a ==> ra_valid R (ra_op R a frame) ==> frame == ra_unit R` + */ PROOF extern thm ra_maximal_apply; + +/* + * `forall R a b frame. + * ra_update R a b + * ==> ra_valid R (ra_op R a frame) + * ==> ra_valid R (ra_op R b frame)` + */ PROOF extern thm ra_update_apply; + +/* + * `forall R a P frame. + * ra_updateP R a P + * ==> ra_valid R (ra_op R a frame) + * ==> (exists b. P b && ra_valid R (ra_op R b frame))` + */ PROOF extern thm ra_updateP_apply; /* ------------------------------------------------------------------------- */ /* Inclusion and cancellation helpers */ /* ------------------------------------------------------------------------- */ -/* One-coordinate forms of public two-coordinate inclusion monotonicity. */ +/* + * `forall R a1 a2 b. + * ra_included R a1 a2 ==> ra_included R (ra_op R a1 b) (ra_op R a2 b)` + */ PROOF extern thm ra_included_op_mono_l; + +/* + * `forall R a1 a2 b. + * ra_included R a1 a2 ==> ra_included R (ra_op R b a1) (ra_op R b a2)` + */ PROOF extern thm ra_included_op_mono_r; -/* A valid framed extension implies validity of the same frame on its part. */ +/* + * `forall R a b frame. + * ra_included R a b + * ==> ra_valid R (ra_op R b frame) + * ==> ra_valid R (ra_op R a frame)` + */ PROOF extern thm ra_included_valid_frame; -/* Cancel a common left operand from an inclusion in a cancellative RA. */ +/* + * `forall R common a b. + * ra_cancellative R + * ==> ra_valid R (ra_op R common b) + * ==> ra_included R (ra_op R common a) (ra_op R common b) + * ==> ra_included R a b` + */ PROOF extern thm ra_included_cancel_l; -/* Exact valid-frame characterization for a frame-maximal source. */ +/* + * `forall R a frame. + * ra_maximal R a + * ==> (ra_valid R (ra_op R a frame) <=> ra_valid R a && frame == ra_unit R)` + */ PROOF extern thm ra_maximal_valid_op_iff; /* ------------------------------------------------------------------------- */ /* Update bridges */ /* ------------------------------------------------------------------------- */ -/* Lift a deterministic update whose target satisfies a result predicate. */ +/* `forall R a b P. ra_update R a b ==> P b ==> ra_updateP R a P` */ PROOF extern thm ra_updateP_of_update; -/* Every resource can update to the RA unit. */ +/* `forall R a. ra_update R a (ra_unit R)` */ PROOF extern thm ra_update_unit; diff --git a/theory/logic/resource_prop.h b/theory/logic/resource_prop.h index e65f97f..fab0c3c 100644 --- a/theory/logic/resource_prop.h +++ b/theory/logic/resource_prop.h @@ -31,25 +31,75 @@ /* Observation relations and assertion constructors */ /* ------------------------------------------------------------------------- */ +/** + * HOL conclusion: + * `r_entails (R:(A)ra) (P:A->bool) (Q:A->bool) <=> forall resource:A. ra_valid + * R resource ==> P resource ==> Q resource`. + */ PROOF extern thm r_entails_def; +/** + * HOL conclusion: + * `r_equiv (R:(A)ra) (P:A->bool) (Q:A->bool) <=> r_entails R P Q && r_entails R + * Q P`. + */ PROOF extern thm r_equiv_def; +/** HOL conclusion: `r_emp (R:(A)ra) (resource:A) <=> resource == ra_unit R`. */ PROOF extern thm r_emp_def; +/** + * HOL conclusion: + * `r_sep (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> exists left + * right:A. resource == ra_op R left right && P left && Q right`. + */ PROOF extern thm r_sep_def; +/** + * HOL conclusion: + * `r_wand (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> forall frame:A. + * ra_valid R (ra_op R resource frame) ==> P frame ==> Q (ra_op R resource + * frame)`. + */ PROOF extern thm r_wand_def; +/** HOL conclusion: `r_own (R:(A)ra) (owned:A) (resource:A) <=> resource == owned`. */ PROOF extern thm r_own_def; +/** HOL conclusion: `r_top (R:(A)ra) (resource:A) <=> T`. */ PROOF extern thm r_top_def; +/** HOL conclusion: `r_bottom (R:(A)ra) (resource:A) <=> F`. */ PROOF extern thm r_bottom_def; +/** + * HOL conclusion: + * `r_and (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> P resource && Q + * resource`. + */ PROOF extern thm r_and_def; +/** + * HOL conclusion: + * `r_or (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> P resource || Q + * resource`. + */ PROOF extern thm r_or_def; +/** + * HOL conclusion: + * `r_impl (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> P resource ==> Q + * resource`. + */ PROOF extern thm r_impl_def; +/** + * HOL conclusion: + * `r_exists (R:(A)ra) (P:B->A->bool) (resource:A) <=> exists witness:B. P + * witness resource`. + */ PROOF extern thm r_exists_def; +/** + * HOL conclusion: + * `r_forall (R:(A)ra) (P:B->A->bool) (resource:A) <=> forall witness:B. P + * witness resource`. + */ PROOF extern thm r_forall_def; -/** Resource-independent embedding: `r_pure R phi resource <=> phi`. */ +/** HOL conclusion: `r_pure (R:(A)ra) (phi:bool) (resource:A) <=> phi`. */ PROOF extern thm r_pure_def; -/** Exact-unit embedding: `r_fact R phi resource <=> phi && resource == ra_unit R`. */ +/** HOL conclusion: `r_fact (R:(A)ra) (phi:bool) (resource:A) <=> phi && resource == ra_unit R`. */ PROOF extern thm r_fact_def; /* ------------------------------------------------------------------------- */ @@ -57,69 +107,261 @@ PROOF extern thm r_fact_def; /* ------------------------------------------------------------------------- */ /* Entailment and validity-sensitive equivalence. */ +/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_entails R P P`. */ PROOF extern thm r_entails_refl; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R P Q ==> + * r_entails R Q S ==> r_entails R P S`. + */ PROOF extern thm r_entails_trans; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool). (forall resource:A. P resource ==> + * Q resource) ==> r_entails R P Q`. + */ PROOF extern thm r_entails_pointwise; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_equiv R P Q <=> forall + * resource:A. ra_valid R resource ==> (P resource <=> Q resource)`. + */ PROOF extern thm r_equiv_pointwise; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R P Q ==> r_entails R Q + * P ==> r_equiv R P Q`. + */ PROOF extern thm r_equiv_intro; +/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_equiv R P P`. */ PROOF extern thm r_equiv_refl; +/** HOL conclusion: `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_equiv R P Q ==> r_equiv R Q P`. */ PROOF extern thm r_equiv_sym; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_equiv R P Q ==> + * r_equiv R Q S ==> r_equiv R P S`. + */ PROOF extern thm r_equiv_trans; /* Additive truth and falsehood. */ +/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_entails R P (r_top R)`. */ PROOF extern thm r_top_intro; +/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_entails R (r_bottom R) P`. */ PROOF extern thm r_bottom_elim; /* Separating conjunction. Algebraic laws expose `r_equiv`, never raw * assertion-function equality. */ +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_equiv R (r_sep R + * (r_sep R P Q) S) (r_sep R P (r_sep R Q S))`. + */ PROOF extern thm r_sep_assoc; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_equiv R (r_sep R P Q) (r_sep R Q + * P)`. + */ PROOF extern thm r_sep_comm; +/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_equiv R (r_sep R (r_emp R) P) P`. */ PROOF extern thm r_sep_emp_l; +/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_equiv R (r_sep R P (r_emp R)) P`. */ PROOF extern thm r_sep_emp_r; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (P2:A->bool) (Q:A->bool) (Q2:A->bool). + * r_entails R P P2 ==> r_entails R Q Q2 ==> r_entails R (r_sep R P Q) (r_sep R + * P2 Q2)`. + */ PROOF extern thm r_sep_mono; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (frame_pred:A->bool). r_entails R P + * Q ==> r_entails R (r_sep R P frame_pred) (r_sep R Q frame_pred)`. + */ PROOF extern thm r_sep_frame_l; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (frame_pred:A->bool). r_entails R P + * Q ==> r_entails R (r_sep R frame_pred P) (r_sep R frame_pred Q)`. + */ PROOF extern thm r_sep_frame_r; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:B->A->bool) (Q:A->bool). r_equiv R (r_sep R (r_exists R + * (\x:B. P x)) Q) (r_exists R (\x:B. r_sep R (P x) Q))`. + */ PROOF extern thm r_sep_exists_l; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:B->A->bool). r_equiv R (r_sep R P (r_exists + * R (\x:B. Q x))) (r_exists R (\x:B. r_sep R P (Q x)))`. + */ PROOF extern thm r_sep_exists_r; /* Additive connectives and quantifiers. */ +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R (r_and R P + * Q) S <=> r_entails R P (r_impl R Q S)`. + */ PROOF extern thm r_impl_adjunction; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R P Q ==> + * r_entails R P S ==> r_entails R P (r_and R Q S)`. + */ PROOF extern thm r_and_intro; +/** HOL conclusion: `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R (r_and R P Q) P`. */ PROOF extern thm r_and_elim_l; +/** HOL conclusion: `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R (r_and R P Q) Q`. */ PROOF extern thm r_and_elim_r; +/** HOL conclusion: `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R P (r_or R P Q)`. */ PROOF extern thm r_or_intro_l; +/** HOL conclusion: `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R Q (r_or R P Q)`. */ PROOF extern thm r_or_intro_r; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R P S ==> + * r_entails R Q S ==> r_entails R (r_or R P Q) S`. + */ PROOF extern thm r_or_elim; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:B->A->bool) (witness:B). r_entails R (P witness) + * (r_exists R (\bound:B. P bound))`. + */ PROOF extern thm r_exists_intro; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:B->A->bool) (Q:A->bool). (forall witness:B. r_entails R + * (P witness) Q) ==> r_entails R (r_exists R (\bound:B. P bound)) Q`. + */ PROOF extern thm r_exists_elim; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:B->A->bool) (Q:B->A->bool). (forall witness:B. r_entails + * R (P witness) (Q witness)) ==> r_entails R (r_exists R (\bound:B. P bound)) + * (r_exists R (\bound:B. Q bound))`. + */ PROOF extern thm r_exists_mono; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:B->A->bool). (forall witness:B. r_entails R + * P (Q witness)) ==> r_entails R P (r_forall R (\bound:B. Q bound))`. + */ PROOF extern thm r_forall_intro; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:B->A->bool) (witness:B). r_entails R (r_forall R P) (P + * witness)`. + */ PROOF extern thm r_forall_elim; /* Magic wand. */ +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R (r_sep R P + * Q) S <=> r_entails R P (r_wand R Q S)`. + */ PROOF extern thm r_wand_adjunction; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R (r_sep R (r_wand R P + * Q) P) Q`. + */ PROOF extern thm r_wand_elim; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P2:A->bool) (P:A->bool) (Q:A->bool) (Q2:A->bool). + * r_entails R P2 P ==> r_entails R Q Q2 ==> r_entails R (r_wand R P Q) (r_wand + * R P2 Q2)`. + */ PROOF extern thm r_wand_mono; /* Resource-independent pure propositions, combined additively with `r_and`. */ +/** + * HOL conclusion: + * `forall (R:(A)ra) (phi:bool) (P:A->bool) (Q:A->bool). phi ==> r_entails R P Q + * ==> r_entails R P (r_and R (r_pure R phi) Q)`. + */ PROOF extern thm r_pure_and_intro; +/** + * HOL conclusion: + * `forall (R:(A)ra) (phi:bool) (P:A->bool) (Q:A->bool). (phi ==> r_entails R P + * Q) ==> r_entails R (r_and R (r_pure R phi) P) Q`. + */ PROOF extern thm r_pure_and_elim; /* Exact-unit facts. The normalization laws below are `r_equiv` statements. */ +/** + * HOL conclusion: + * `forall (R:(A)ra) (phi:bool). r_equiv R (r_fact R phi) (r_and R (r_pure R + * phi) (r_emp R))`. + */ PROOF extern thm r_fact_as_pure_and_emp; +/** HOL conclusion: `forall R:(A)ra. r_equiv R (r_fact R T) (r_emp R)`. */ PROOF extern thm r_fact_true; +/** HOL conclusion: `forall R:(A)ra. r_equiv R (r_fact R F) (r_bottom R)`. */ PROOF extern thm r_fact_false; +/** + * HOL conclusion: + * `forall (R:(A)ra) (phi:bool) (P:A->bool). r_equiv R (r_sep R (r_fact R phi) + * P) (r_and R (r_pure R phi) P)`. + */ PROOF extern thm r_fact_sep_l; +/** + * HOL conclusion: + * `forall (R:(A)ra) (phi:bool) (P:A->bool). r_equiv R (r_sep R P (r_fact R + * phi)) (r_and R (r_pure R phi) P)`. + */ PROOF extern thm r_fact_sep_r; +/** + * HOL conclusion: + * `forall (R:(A)ra) (phi:bool) (P:A->bool) (Q:A->bool). phi ==> r_entails R P Q + * ==> r_entails R P (r_sep R (r_fact R phi) Q)`. + */ PROOF extern thm r_fact_intro; +/** + * HOL conclusion: + * `forall (R:(A)ra) (phi:bool) (P:A->bool) (Q:A->bool). (phi ==> r_entails R P + * Q) ==> r_entails R (r_sep R (r_fact R phi) P) Q`. + */ PROOF extern thm r_fact_elim; +/** + * HOL conclusion: + * `forall (R:(A)ra) (phi:bool). r_entails R (r_fact R phi) (r_sep R (r_fact R + * phi) (r_fact R phi))`. + */ PROOF extern thm r_fact_dup; /* Exact ownership. `r_own_valid` returns validity as a spatial `r_fact`. */ +/** HOL conclusion: `forall R:(A)ra. r_equiv R (r_own R (ra_unit R)) (r_emp R)`. */ PROOF extern thm r_own_unit; +/** + * HOL conclusion: + * `forall (R:(A)ra) (a:A) (b:A). r_equiv R (r_own R (ra_op R a b)) (r_sep R + * (r_own R a) (r_own R b))`. + */ PROOF extern thm r_own_op; +/** + * HOL conclusion: + * `forall (R:(A)ra) (a:A). r_entails R (r_own R a) (r_sep R (r_fact R (ra_valid + * R a)) (r_own R a))`. + */ PROOF extern thm r_own_valid; /* Sound one-way distribution of `r_sep` through additive conjunction. */ +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R (r_sep R P + * (r_and R Q S)) (r_and R (r_sep R P Q) (r_sep R P S))`. + */ PROOF extern thm r_sep_and_forward_r; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R (r_sep R + * (r_and R Q S) P) (r_and R (r_sep R Q P) (r_sep R S P))`. + */ PROOF extern thm r_sep_and_forward_l; diff --git a/theory/logic/resource_prop_internal.h b/theory/logic/resource_prop_internal.h index bd4bb76..1102b3e 100644 --- a/theory/logic/resource_prop_internal.h +++ b/theory/logic/resource_prop_internal.h @@ -14,23 +14,69 @@ #include "proof/theory/logic/resource_prop.h" /* Raw equality normalizations for separating conjunction. */ +/** HOL conclusion: `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_sep R P Q == r_sep R Q P`. */ PROOF extern thm r_sep_comm_eq; +/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_sep R (r_emp R) P == P`. */ PROOF extern thm r_sep_emp_l_eq; +/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_sep R P (r_emp R) == P`. */ PROOF extern thm r_sep_emp_r_eq; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_sep R (r_sep R P Q) + * S == r_sep R P (r_sep R Q S)`. + */ PROOF extern thm r_sep_assoc_eq; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:B->A->bool) (Q:A->bool). r_sep R (r_exists R (\x:B. P + * x)) Q == r_exists R (\witness:B. r_sep R (P witness) Q)`. + */ PROOF extern thm r_sep_exists_l_eq; +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:A->bool) (Q:B->A->bool). r_sep R P (r_exists R (\x:B. Q + * x)) == r_exists R (\witness:B. r_sep R P (Q witness))`. + */ PROOF extern thm r_sep_exists_r_eq; /* Adapter-only continuation schema derived from public `r_forall_elim`. */ +/** + * HOL conclusion: + * `forall (R:(A)ra) (P:B->A->bool) (Q:A->bool) (witness:B). r_entails R (P + * witness) Q ==> r_entails R (r_forall R (\x:B. P x)) Q`. + */ PROOF extern thm r_forall_elim_cont; /* Raw equality normalizations for exact-unit facts. */ +/** + * HOL conclusion: + * `forall (R:(A)ra) (phi:bool). r_fact R phi == r_and R (r_pure R phi) (r_emp + * R)`. + */ PROOF extern thm r_fact_as_pure_and_emp_eq; +/** HOL conclusion: `forall R:(A)ra. r_fact R T == r_emp R`. */ PROOF extern thm r_fact_true_eq; +/** HOL conclusion: `forall R:(A)ra. r_fact R F == r_bottom R`. */ PROOF extern thm r_fact_false_eq; +/** + * HOL conclusion: + * `forall (R:(A)ra) (phi:bool) (P:A->bool). r_sep R (r_fact R phi) P == r_and R + * (r_pure R phi) P`. + */ PROOF extern thm r_fact_sep_l_eq; +/** + * HOL conclusion: + * `forall (R:(A)ra) (phi:bool) (P:A->bool). r_sep R P (r_fact R phi) == r_and R + * (r_pure R phi) P`. + */ PROOF extern thm r_fact_sep_r_eq; /* Raw equality normalizations for exact ownership. */ +/** HOL conclusion: `forall R:(A)ra. r_own R (ra_unit R) == r_emp R`. */ PROOF extern thm r_own_unit_eq; +/** + * HOL conclusion: + * `forall (R:(A)ra) (a:A) (b:A). r_own R (ra_op R a b) == r_sep R (r_own R a) + * (r_own R b)`. + */ PROOF extern thm r_own_op_eq; diff --git a/theory/logic/unit_ra.h b/theory/logic/unit_ra.h index b2c3dfe..03d978e 100644 --- a/theory/logic/unit_ra.h +++ b/theory/logic/unit_ra.h @@ -11,27 +11,27 @@ /* Algebra and validity */ /* ------------------------------------------------------------------------- */ -/* `ra_unit unit_ra == (one:1)`. */ +/* `ra_unit unit_ra == one` */ PROOF extern thm unit_ra_unit; -/* `forall a b:1. ra_op unit_ra a b == one`. */ +/* `forall a b. ra_op unit_ra a b == one` */ PROOF extern thm unit_ra_op; -/* `forall a:1. ra_valid unit_ra a`. */ +/* `forall a. ra_valid unit_ra a` */ PROOF extern thm unit_ra_valid; -/* `forall a b:1. ra_included unit_ra a b`. */ +/* `forall a b. ra_included unit_ra a b` */ PROOF extern thm unit_ra_included; -/* The singleton carrier is frame-maximal: its only frame is its unit. */ +/* `forall a. ra_maximal unit_ra a` */ PROOF extern thm unit_ra_maximal; /* ------------------------------------------------------------------------- */ /* Updates */ /* ------------------------------------------------------------------------- */ -/* `forall (a:1) (P:1->bool). ra_updateP unit_ra a P <=> P one`. */ +/* `forall a P. ra_updateP unit_ra a P <=> P one` */ PROOF extern thm unit_ra_updateP_iff; -/* `forall a f b g:1. ra_local_update unit_ra a f b g`. */ +/* `forall a f b g. ra_local_update unit_ra a f b g` */ PROOF extern thm unit_ra_local_update; -- Gitee From 43a6fa14d053a2693d539a45cc3fd640c52537b8 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Tue, 11 Aug 2026 10:26:08 +0800 Subject: [PATCH 33/35] Format theorem conclusions as raw text blocks --- proof_sl.h | 75 +++- test/dependency_v2_regression.sh | 57 --- theory/c_program_logic/c_basic_update.h | 12 +- theory/c_program_logic/c_integer.h | 186 ++++++--- theory/c_program_logic/c_memory.h | 46 ++- theory/c_program_logic/c_resource.h | 27 +- theory/c_program_logic/mem_own.h | 17 +- theory/c_program_logic/mem_ra.h | 45 ++- theory/c_program_logic/mem_value.h | 108 ++++-- theory/data/int_list.h | 84 +++- theory/data/list.h | 28 +- theory/logic/agree_ra.h | 72 +++- theory/logic/auth_ra.h | 138 ++++--- theory/logic/basic_update.h | 108 ++++-- theory/logic/big_sep.h | 63 ++- theory/logic/excl_ra.h | 60 ++- theory/logic/excl_ra_internal.h | 36 +- theory/logic/finmap.h | 312 ++++++++++----- theory/logic/frac_ra.h | 48 ++- theory/logic/gmap_ra.h | 90 +++-- theory/logic/gmap_ra_internal.h | 30 +- theory/logic/local_update.h | 60 ++- theory/logic/max_nat_ra.h | 36 +- theory/logic/named_logic.h | 49 ++- theory/logic/named_ra.h | 48 ++- theory/logic/option_ra.h | 78 +++- theory/logic/option_ra_internal.h | 18 +- theory/logic/prod_ra.h | 108 ++++-- theory/logic/prod_ra_internal.h | 6 +- theory/logic/product_resource.h | 169 +++++--- theory/logic/product_resource_internal.h | 28 +- theory/logic/ra.h | 234 +++++++++--- theory/logic/ra_builder.h | 48 ++- theory/logic/ra_internal.h | 78 +++- theory/logic/resource_prop.h | 468 +++++++++++++++++------ theory/logic/resource_prop_internal.h | 104 +++-- theory/logic/unit_ra.h | 42 +- 37 files changed, 2320 insertions(+), 896 deletions(-) diff --git a/proof_sl.h b/proof_sl.h index d57b602..35e13f7 100644 --- a/proof_sl.h +++ b/proof_sl.h @@ -755,7 +755,10 @@ PROOF term dest_sl_fact(const term tm); * Globally bound theorem turning SL-assertion equality into entailment. * * HOL conclusion in the installed notation: - * `forall (H:sl_prop()) (K:sl_prop()). (H = K) ==> (H ⊢SL K)`. + * + * ```text + * forall (H:sl_prop()) (K:sl_prop()). (H = K) ==> (H ⊢SL K) + * ``` */ PROOF extern thm sl_ent_sym_left; @@ -794,8 +797,11 @@ PROOF extern thm sl_frame_restate; * Globally bound theorem for left framing. * * HOL conclusion in the installed notation: - * `forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). (H ⊢SL K) ==> - * (F ** H ⊢SL F ** K)`. + * + * ```text + * forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). (H ⊢SL K) ==> + * (F ** H ⊢SL F ** K) + * ``` */ PROOF extern thm sl_ent_frame_left; @@ -803,8 +809,11 @@ PROOF extern thm sl_ent_frame_left; * Globally bound theorem for right framing. * * HOL conclusion in the installed notation: - * `forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). (H ⊢SL K) ==> - * (H ** F ⊢SL K ** F)`. + * + * ```text + * forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). (H ⊢SL K) ==> + * (H ** F ⊢SL K ** F) + * ``` */ PROOF extern thm sl_ent_frame_right; @@ -844,10 +853,13 @@ PROOF extern thm sl_sep_combine; * Return the equality laws used by the HOL AC prover for `**`. * * HOL conclusion in the installed notation: - * `(forall (H:sl_prop()) (K:sl_prop()). H ** K = K ** H) /\ ((forall + * + * ```text + * (forall (H:sl_prop()) (K:sl_prop()). H ** K = K ** H) /\ ((forall * (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). (H ** K) ** F = * H ** (K ** F)) /\ (forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). - * H ** (K ** F) = K ** (H ** F)))`. + * H ** (K ** F) = K ** (H ** F))) + * ``` * * The conjunction order is commutativity, associativity, then lifted * commutativity. Pass this theorem to `ac_rule`; units are not part of this @@ -859,8 +871,11 @@ PROOF extern thm sl_ac_rule; * Globally bound theorem for monotonicity of additive disjunction. * * HOL conclusion in the installed notation: - * `forall (H1:sl_prop()) (H2:sl_prop()) (K1:sl_prop()) (K2:sl_prop()). - * (H1 ⊢SL K1) ==> (H2 ⊢SL K2) ==> ((H1 || H2) ⊢SL (K1 || K2))`. + * + * ```text + * forall (H1:sl_prop()) (H2:sl_prop()) (K1:sl_prop()) (K2:sl_prop()). + * (H1 ⊢SL K1) ==> (H2 ⊢SL K2) ==> ((H1 || H2) ⊢SL (K1 || K2)) + * ``` */ PROOF extern thm sl_disj_mono; @@ -886,8 +901,11 @@ PROOF extern thm sl_or_elim_frame; * Globally bound theorem for magic-wand elimination. * * HOL conclusion in the installed notation: - * `forall (H:sl_prop()) (K:sl_prop()) (G:sl_prop()). - * (H ⊢SL (K -* G)) ==> (H ** K ⊢SL G)`. + * + * ```text + * forall (H:sl_prop()) (K:sl_prop()) (G:sl_prop()). + * (H ⊢SL (K -* G)) ==> (H ** K ⊢SL G) + * ``` */ PROOF extern thm sl_undisch; @@ -895,8 +913,11 @@ PROOF extern thm sl_undisch; * Globally bound theorem projecting the left additive conjunct. * * HOL conclusion in the installed notation: - * `forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). - * (H ⊢SL (K && F)) ==> (H ⊢SL K)`. + * + * ```text + * forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). + * (H ⊢SL (K && F)) ==> (H ⊢SL K) + * ``` */ PROOF extern thm sl_conj1; @@ -904,8 +925,11 @@ PROOF extern thm sl_conj1; * Globally bound theorem projecting the right additive conjunct. * * HOL conclusion in the installed notation: - * `forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). - * (H ⊢SL (K && F)) ==> (H ⊢SL F)`. + * + * ```text + * forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). + * (H ⊢SL (K && F)) ==> (H ⊢SL F) + * ``` */ PROOF extern thm sl_conj2; @@ -913,8 +937,11 @@ PROOF extern thm sl_conj2; * Globally bound theorem injecting into the left disjunct. * * HOL conclusion in the installed notation: - * `forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). - * (H ⊢SL K) ==> (H ⊢SL (K || F))`. + * + * ```text + * forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). + * (H ⊢SL K) ==> (H ⊢SL (K || F)) + * ``` */ PROOF extern thm sl_disj1_mono; @@ -922,8 +949,11 @@ PROOF extern thm sl_disj1_mono; * Globally bound theorem injecting into the right disjunct. * * HOL conclusion in the installed notation: - * `forall (F:sl_prop()) (H:sl_prop()) (K:sl_prop()). - * (H ⊢SL K) ==> (H ⊢SL (F || K))`. + * + * ```text + * forall (F:sl_prop()) (H:sl_prop()) (K:sl_prop()). + * (H ⊢SL K) ==> (H ⊢SL (F || K)) + * ``` */ PROOF extern thm sl_disj2_mono; @@ -944,8 +974,11 @@ PROOF extern thm sl_exists_elim_frame; * Globally bound theorem for SL-existential introduction. * * HOL conclusion in the installed notation: - * `forall (w:A) (H:sl_prop()) (B:A->sl_prop()). - * (H ⊢SL B w) ==> (H ⊢SL ∃SL x:A. B x)`. + * + * ```text + * forall (w:A) (H:sl_prop()) (B:A->sl_prop()). + * (H ⊢SL B w) ==> (H ⊢SL ∃SL x:A. B x) + * ``` */ PROOF extern thm sl_exists_wit; diff --git a/test/dependency_v2_regression.sh b/test/dependency_v2_regression.sh index 1c4d691..6c6c3da 100755 --- a/test/dependency_v2_regression.sh +++ b/test/dependency_v2_regression.sh @@ -81,12 +81,6 @@ while IFS= read -r header; do public_headers+=("$header") done < <(find "$theory_dir" -type f -name '*.h' ! -name '*_internal.h' -print) -theorem_headers=() -while IFS= read -r header; do - theorem_headers+=("$header") -done < <(rg -l '^PROOF[[:space:]]+extern[[:space:]]+thm[[:space:]]+' \ - "$proof_root" --glob '*.h') - reject_matches \ "public header exposes removed ra_update_nd" \ '\bra_update_nd\b' \ @@ -147,57 +141,6 @@ done < - * pmem_c_address_ok address Tptr`. + * ```text + * pmem_ptr_address_ok (address:int) <=> + * pmem_c_address_ok address Tptr + * ``` */ PROOF extern thm pmem_ptr_address_ok_def; diff --git a/theory/c_program_logic/c_resource.h b/theory/c_program_logic/c_resource.h index 9b1b7ea..02f7e4f 100644 --- a/theory/c_program_logic/c_resource.h +++ b/theory/c_program_logic/c_resource.h @@ -37,8 +37,10 @@ PROOF extern thm c_resource_ra_def; /** - * `forall G:(A)ra. ra_unit (c_resource_ra G) == - * (ra_unit mem_ra,ra_unit G)`. + * ```text + * forall G:(A)ra. ra_unit (c_resource_ra G) == + * (ra_unit mem_ra,ra_unit G) + * ``` */ PROOF extern thm c_resource_ra_unit; @@ -66,22 +68,29 @@ PROOF extern thm c_resource_ra_valid; /* Exact product lifts; the unselected projection is exactly unit. */ /** - * `c_lift_phys (G:(A)ra) (P:Mem->bool) = - * r_lift_left mem_ra G P`, where - * `Mem = (int,(pmem_byte_state)excl)finmap`. + * ```text + * c_lift_phys (G:(A)ra) (P:Mem->bool) = + * r_lift_left mem_ra G P + * ``` + * + * Here `Mem` abbreviates `(int,(pmem_byte_state)excl)finmap`. */ PROOF extern thm c_lift_phys_def; /** - * `c_lift_ghost (G:(A)ra) (Q:A->bool) = - * r_lift_right mem_ra G Q`. + * ```text + * c_lift_ghost (G:(A)ra) (Q:A->bool) = + * r_lift_right mem_ra G Q + * ``` */ PROOF extern thm c_lift_ghost_def; /* Exact ownership of an arbitrary fragment of the complete global ghost RA. */ /** - * `c_ghost_own (G:(A)ra) (ghost:A) = - * c_lift_ghost G (r_own G ghost)`. + * ```text + * c_ghost_own (G:(A)ra) (ghost:A) = + * c_lift_ghost G (r_own G ghost) + * ``` */ PROOF extern thm c_ghost_own_def; diff --git a/theory/c_program_logic/mem_own.h b/theory/c_program_logic/mem_own.h index 585acf8..3870496 100644 --- a/theory/c_program_logic/mem_own.h +++ b/theory/c_program_logic/mem_own.h @@ -19,19 +19,28 @@ /** * Defining theorem for exact memory ownership: - * `pmem_own memory == r_own mem_ra memory`. + * + * ```text + * pmem_own memory == r_own mem_ra memory + * ``` */ PROOF extern thm pmem_own_def; /** * Defining theorem for one allocated, uninitialized byte: - * `pmem_uninit_at address == pmem_own (pmem_uninit address)`. + * + * ```text + * pmem_uninit_at address == pmem_own (pmem_uninit address) + * ``` */ PROOF extern thm pmem_uninit_at_def; /** * Defining theorem for one initialized byte: - * `pmem_byte_at address byte == - * pmem_own (pmem_byte address byte)`. + * + * ```text + * pmem_byte_at address byte == + * pmem_own (pmem_byte address byte) + * ``` */ PROOF extern thm pmem_byte_at_def; diff --git a/theory/c_program_logic/mem_ra.h b/theory/c_program_logic/mem_ra.h index 8ed2ab3..71cd62c 100644 --- a/theory/c_program_logic/mem_ra.h +++ b/theory/c_program_logic/mem_ra.h @@ -94,26 +94,39 @@ PROOF extern thm mem_ra_valid; /** * Canonical singleton definition: - * `pmem_singleton address state == - * finmap_singleton address (Excl state)`. + * + * ```text + * pmem_singleton address state == + * finmap_singleton address (Excl state) + * ``` */ PROOF extern thm pmem_singleton_def; /** * Uninitialized singleton definition: - * `pmem_uninit address == - * pmem_singleton address PMemUninit`. + * + * ```text + * pmem_uninit address == + * pmem_singleton address PMemUninit + * ``` */ PROOF extern thm pmem_uninit_def; /** * Initialized singleton definition: - * `pmem_byte address byte == - * pmem_singleton address (PMemByte byte)`. + * + * ```text + * pmem_byte address byte == + * pmem_singleton address (PMemByte byte) + * ``` */ PROOF extern thm pmem_byte_def; -/** `⊢ ∀address state. ra_valid mem_ra (pmem_singleton address state)`. */ +/** + * ```text + * ⊢ ∀address state. ra_valid mem_ra (pmem_singleton address state) + * ``` + */ PROOF extern thm pmem_singleton_valid; /** @@ -141,20 +154,26 @@ PROOF extern thm pmem_singleton_overlap_invalid; */ /** - * `⊢ ∀address byte. ra_update mem_ra (pmem_uninit address) - * (pmem_byte address byte)`. + * ```text + * ⊢ ∀address byte. ra_update mem_ra (pmem_uninit address) + * (pmem_byte address byte) + * ``` */ PROOF extern thm pmem_update_uninit_byte; /** - * `⊢ ∀address byte. ra_update mem_ra (pmem_byte address byte) - * (pmem_uninit address)`. + * ```text + * ⊢ ∀address byte. ra_update mem_ra (pmem_byte address byte) + * (pmem_uninit address) + * ``` */ PROOF extern thm pmem_update_byte_uninit; /** - * `⊢ ∀address old_byte new_byte. + * ```text + * ⊢ ∀address old_byte new_byte. * ra_update mem_ra (pmem_byte address old_byte) - * (pmem_byte address new_byte)`. + * (pmem_byte address new_byte) + * ``` */ PROOF extern thm pmem_update_byte_byte; diff --git a/theory/c_program_logic/mem_value.h b/theory/c_program_logic/mem_value.h index 4c72596..4bbb9cd 100644 --- a/theory/c_program_logic/mem_value.h +++ b/theory/c_program_logic/mem_value.h @@ -34,10 +34,12 @@ /** * One allocated byte with unspecified initialization state: * - * pmem_allocated_byte_at (address:int) == - * r_exists mem_ra - * (\state:pmem_byte_state. - * pmem_own (pmem_singleton address state)). + * ```text + * pmem_allocated_byte_at (address:int) == + * r_exists mem_ra + * (\state:pmem_byte_state. + * pmem_own (pmem_singleton address state)) + * ``` * * Hence the witness may be `PMemUninit` or `PMemByte byte`. This is the * content-forgetting assertion used for raw allocated memory. It is strictly @@ -61,13 +63,22 @@ PROOF extern thm pmem_allocated_byte_at_def; */ PROOF extern thm pmem_bytes_at_def; -/** Raw computation equation: `⊢ ∀base. pmem_bytes_at base [] == r_emp mem_ra`. */ +/** + * Raw computation equation: + * + * ```text + * ⊢ ∀base. pmem_bytes_at base [] == r_emp mem_ra + * ``` + */ PROOF extern thm pmem_bytes_at_nil; /** * Step equation: - * `⊢ ∀base byte bytes. pmem_bytes_at base (byte::bytes) == - * pmem_byte_at base byte **_mem pmem_bytes_at (base + &1) bytes`. + * + * ```text + * ⊢ ∀base byte bytes. pmem_bytes_at base (byte::bytes) == + * pmem_byte_at base byte **_mem pmem_bytes_at (base + &1) bytes + * ``` */ PROOF extern thm pmem_bytes_at_cons; @@ -75,25 +86,33 @@ PROOF extern thm pmem_bytes_at_cons; * Exact ownership of `count` consecutive allocated bytes with unspecified * contents: * - * pmem_allocated_at base 0 == r_emp mem_ra && - * pmem_allocated_at base (SUC count) == - * r_sep mem_ra - * (pmem_allocated_byte_at base) - * (pmem_allocated_at (base + &1) count). + * ```text + * pmem_allocated_at base 0 == r_emp mem_ra && + * pmem_allocated_at base (SUC count) == + * r_sep mem_ra + * (pmem_allocated_byte_at base) + * (pmem_allocated_at (base + &1) count) + * ``` */ PROOF extern thm pmem_allocated_at_def; /** * Raw computation equation: - * `⊢ ∀base. pmem_allocated_at base 0 == r_emp mem_ra`. + * + * ```text + * ⊢ ∀base. pmem_allocated_at base 0 == r_emp mem_ra + * ``` */ PROOF extern thm pmem_allocated_at_zero; /** * Step equation: - * `⊢ ∀base count. pmem_allocated_at base (SUC count) == + * + * ```text + * ⊢ ∀base count. pmem_allocated_at base (SUC count) == * pmem_allocated_byte_at base **_mem - * pmem_allocated_at (base + &1) count`. + * pmem_allocated_at (base + &1) count + * ``` */ PROOF extern thm pmem_allocated_at_suc; @@ -167,10 +186,12 @@ PROOF extern thm pmem_bytes_at_allocated; * `pmem_le_bytes count value` is the low `count` base-256 digits of `value`, * least-significant digit first: * - * pmem_le_bytes 0 integer_value == [] && - * pmem_le_bytes (SUC count) integer_value == - * (integer_value rem &256) :: - * pmem_le_bytes count (integer_value div &256). + * ```text + * pmem_le_bytes 0 integer_value == [] && + * pmem_le_bytes (SUC count) integer_value == + * (integer_value rem &256) :: + * pmem_le_bytes count (integer_value div &256) + * ``` * * Fixed-width recursion also gives negative HOL integers their usual * truncated two's-complement byte representation; range and signedness are @@ -178,35 +199,52 @@ PROOF extern thm pmem_bytes_at_allocated; */ PROOF extern thm pmem_le_bytes_def; -/** Data computation: `⊢ ∀value. pmem_le_bytes 0 value == []`. */ +/** + * Data computation: + * + * ```text + * ⊢ ∀value. pmem_le_bytes 0 value == [] + * ``` + */ PROOF extern thm pmem_le_bytes_zero; /** * Step equation: - * `⊢ ∀count value. pmem_le_bytes (SUC count) value == - * (value rem &256)::pmem_le_bytes count (value div &256)`. + * + * ```text + * ⊢ ∀count value. pmem_le_bytes (SUC count) value == + * (value rem &256)::pmem_le_bytes count (value div &256) + * ``` */ PROOF extern thm pmem_le_bytes_suc; -/** `⊢ ∀(count:num)(value:int). LENGTH (pmem_le_bytes count value) == count`. */ +/** + * ```text + * ⊢ ∀(count:num)(value:int). LENGTH (pmem_le_bytes count value) == count + * ``` + */ PROOF extern thm pmem_le_bytes_length; /* * Exact initialized scalar storage at byte width `count`: * - * pmem_scalar_at base count integer_value == - * pmem_bytes_at base (pmem_le_bytes count integer_value). + * ```text + * pmem_scalar_at base count integer_value == + * pmem_bytes_at base (pmem_le_bytes count integer_value) + * ``` */ PROOF extern thm pmem_scalar_at_def; /* * Strictly uninitialized scalar storage: * - * pmem_undef_scalar_at base 0 == r_emp mem_ra && - * pmem_undef_scalar_at base (SUC count) == - * r_sep mem_ra - * (pmem_uninit_at base) - * (pmem_undef_scalar_at (base + &1) count). + * ```text + * pmem_undef_scalar_at base 0 == r_emp mem_ra && + * pmem_undef_scalar_at base (SUC count) == + * r_sep mem_ra + * (pmem_uninit_at base) + * (pmem_undef_scalar_at (base + &1) count) + * ``` * * Every owned byte is exactly `PMemUninit`; this assertion does not admit an * initialized byte with an existentially hidden value. @@ -215,7 +253,10 @@ PROOF extern thm pmem_undef_scalar_at_def; /** * Empty initialized scalar storage: - * `⊢ ∀(base:int)(value:int). pmem_scalar_at base 0 value == r_emp mem_ra`. + * + * ```text + * ⊢ ∀(base:int)(value:int). pmem_scalar_at base 0 value == r_emp mem_ra + * ``` */ PROOF extern thm pmem_scalar_at_zero; @@ -235,7 +276,10 @@ PROOF extern thm pmem_scalar_at_suc; /** * Empty uninitialized scalar storage: - * `⊢ ∀base:int. pmem_undef_scalar_at base 0 == r_emp mem_ra`. + * + * ```text + * ⊢ ∀base:int. pmem_undef_scalar_at base 0 == r_emp mem_ra + * ``` */ PROOF extern thm pmem_undef_scalar_at_zero; diff --git a/theory/data/int_list.h b/theory/data/int_list.h index e86958b..496be4a 100644 --- a/theory/data/int_list.h +++ b/theory/data/int_list.h @@ -15,73 +15,115 @@ /** * HOL conclusion: - * `(ilength ([]:(A)list) = &0) && (ilength ((head:A) :: (tail:(A)list)) = &1 + - * ilength tail)`. + * + * ```text + * (ilength ([]:(A)list) = &0) && (ilength ((head:A) :: (tail:(A)list)) = &1 + + * ilength tail) + * ``` */ PROOF extern thm ILENGTH_DEF; /** * HOL conclusion: - * `(NTH 0 ((head:A) :: (tail:(A)list)) = head) && (NTH (SUC index) - * (head :: tail) = NTH index tail)`. + * + * ```text + * (NTH 0 ((head:A) :: (tail:(A)list)) = head) && (NTH (SUC index) + * (head :: tail) = NTH index tail) + * ``` */ PROOF extern thm NTH_DEF; /** * HOL conclusion: - * `inth (index:int) (values:(A)list) = NTH (num_of_int index) values`. + * + * ```text + * inth (index:int) (values:(A)list) = NTH (num_of_int index) values + * ``` */ PROOF extern thm INTH_DEF; /** * HOL conclusion: - * `(REPLACE_NTH index (value:A) [] = []) && (REPLACE_NTH 0 value ((head:A) :: + * + * ```text + * (REPLACE_NTH index (value:A) [] = []) && (REPLACE_NTH 0 value ((head:A) :: * tail) = value :: tail) && (REPLACE_NTH (SUC index) value (head :: tail) = - * head :: REPLACE_NTH index value tail)`. + * head :: REPLACE_NTH index value tail) + * ``` */ PROOF extern thm REPLACE_NTH_DEF; /** * HOL conclusion: - * `replace_inth (index:int) (value:A) (values:(A)list) = REPLACE_NTH - * (num_of_int index) value values`. + * + * ```text + * replace_inth (index:int) (value:A) (values:(A)list) = REPLACE_NTH + * (num_of_int index) value values + * ``` */ PROOF extern thm REPLACE_INTH_DEF; /** * HOL conclusion: - * `(FIRSTN 0 (values:(A)list) = []) && (FIRSTN (SUC count) ([]:(A)list) = []) - * && (FIRSTN (SUC count) ((head:A) :: tail) = head :: FIRSTN count tail)`. + * + * ```text + * (FIRSTN 0 (values:(A)list) = []) && (FIRSTN (SUC count) ([]:(A)list) = []) + * && (FIRSTN (SUC count) ((head:A) :: tail) = head :: FIRSTN count tail) + * ``` */ PROOF extern thm FIRSTN_DEF; /** * HOL conclusion: - * `ifirstn (count:int) (values:(A)list) = FIRSTN (num_of_int count) values`. + * + * ```text + * ifirstn (count:int) (values:(A)list) = FIRSTN (num_of_int count) values + * ``` */ PROOF extern thm IFIRSTN_DEF; /** * HOL conclusion: - * `(SKIPN 0 (values:(A)list) = values) && (SKIPN (SUC count) ([]:(A)list) = - * []) && (SKIPN (SUC count) ((head:A) :: tail) = SKIPN count tail)`. + * + * ```text + * (SKIPN 0 (values:(A)list) = values) && (SKIPN (SUC count) ([]:(A)list) = + * []) && (SKIPN (SUC count) ((head:A) :: tail) = SKIPN count tail) + * ``` */ PROOF extern thm SKIPN_DEF; /** * HOL conclusion: - * `iskipn (count:int) (values:(A)list) = SKIPN (num_of_int count) values`. + * + * ```text + * iskipn (count:int) (values:(A)list) = SKIPN (num_of_int count) values + * ``` */ PROOF extern thm ISKIPN_DEF; /** * HOL conclusion: - * `ireplicate (count:int) (value:A) = REPLICATE (num_of_int count) value`. + * + * ```text + * ireplicate (count:int) (value:A) = REPLICATE (num_of_int count) value + * ``` */ PROOF extern thm IREPLICATE_DEF; /** * HOL conclusion: - * `sublist (lower:int) (upper:int) (values:(A)list) = SKIPN (num_of_int lower) - * (FIRSTN (num_of_int upper) values)`. + * + * ```text + * sublist (lower:int) (upper:int) (values:(A)list) = SKIPN (num_of_int lower) + * (FIRSTN (num_of_int upper) values) + * ``` */ PROOF extern thm SUBLIST_DEF; -/** HOL conclusion: `forall values:(A)list. &0 <= ilength values`. */ +/** + * HOL conclusion: + * + * ```text + * forall values:(A)list. &0 <= ilength values + * ``` + */ PROOF extern thm ILENGTH_NONNEG; /** * HOL conclusion: - * `forall left:(A)list. forall right:(A)list. ilength (left ++ right) = - * ilength left + ilength right`. + * + * ```text + * forall left:(A)list. forall right:(A)list. ilength (left ++ right) = + * ilength left + ilength right + * ``` */ PROOF extern thm ILENGTH_APPEND; diff --git a/theory/data/list.h b/theory/data/list.h index 6c4ef53..583abce 100644 --- a/theory/data/list.h +++ b/theory/data/list.h @@ -14,25 +14,37 @@ /** * HOL conclusion: - * `(LENGTH ([]:(A)list) = 0) /\ (!h:A. !t. LENGTH (CONS h t) = SUC - * (LENGTH t))`. + * + * ```text + * (LENGTH ([]:(A)list) = 0) /\ (!h:A. !t. LENGTH (CONS h t) = SUC + * (LENGTH t)) + * ``` */ PROOF extern thm HOL_LENGTH; /** * HOL conclusion: - * `(!l:(A)list. APPEND [] l = l) /\ (!h:A. !t l. APPEND (CONS h t) l = - * CONS h (APPEND t l))`. + * + * ```text + * (!l:(A)list. APPEND [] l = l) /\ (!h:A. !t l. APPEND (CONS h t) l = + * CONS h (APPEND t l)) + * ``` */ PROOF extern thm HOL_APPEND; /** * HOL conclusion: - * `(REVERSE ([]:(A)list) = []) /\ (REVERSE (CONS (x:A) l) = APPEND - * (REVERSE l) (CONS x []))`. + * + * ```text + * (REVERSE ([]:(A)list) = []) /\ (REVERSE (CONS (x:A) l) = APPEND + * (REVERSE l) (CONS x [])) + * ``` */ PROOF extern thm HOL_REVERSE; /** * HOL conclusion: - * `(REPLICATE 0 (x:A) = []) /\ (REPLICATE (SUC n) x = CONS x - * (REPLICATE n x))`. + * + * ```text + * (REPLICATE 0 (x:A) = []) /\ (REPLICATE (SUC n) x = CONS x + * (REPLICATE n x)) + * ``` */ PROOF extern thm HOL_REPLICATE; diff --git a/theory/logic/agree_ra.h b/theory/logic/agree_ra.h index f5f9c82..f9fc10a 100644 --- a/theory/logic/agree_ra.h +++ b/theory/logic/agree_ra.h @@ -14,54 +14,98 @@ /* Operation and validity */ /* ------------------------------------------------------------------------- */ -/* `ra_unit agree_ra == AgreeUnit` */ +/* + * ```text + * ra_unit agree_ra == AgreeUnit + * ``` + */ PROOF extern thm agree_ra_unit; /* - * `forall a b. + * ```text + * forall a b. * ra_op agree_ra (Agree a) (Agree b) == - * (if a == b then Agree a else AgreeInvalid)` + * (if a == b then Agree a else AgreeInvalid) + * ``` */ PROOF extern thm agree_ra_owned_op; -/* `forall a. ra_op agree_ra (Agree a) (Agree a) == Agree a` */ +/* + * ```text + * forall a. ra_op agree_ra (Agree a) (Agree a) == Agree a + * ``` + */ PROOF extern thm agree_ra_idempotent; -/* `ra_valid agree_ra AgreeUnit` */ +/* + * ```text + * ra_valid agree_ra AgreeUnit + * ``` + */ PROOF extern thm agree_ra_valid_unit; -/* `forall a. ra_valid agree_ra (Agree a)` */ +/* + * ```text + * forall a. ra_valid agree_ra (Agree a) + * ``` + */ PROOF extern thm agree_ra_valid_owned; -/* `~ra_valid agree_ra AgreeInvalid` */ +/* + * ```text + * ~ra_valid agree_ra AgreeInvalid + * ``` + */ PROOF extern thm agree_ra_invalid; /* ------------------------------------------------------------------------- */ /* Agreement, inclusion, and cancellation */ /* ------------------------------------------------------------------------- */ -/* `forall a b. ra_valid agree_ra (ra_op agree_ra (Agree a) (Agree b)) <=> a == b` */ +/* + * ```text + * forall a b. ra_valid agree_ra (ra_op agree_ra (Agree a) (Agree b)) <=> a == b + * ``` + */ PROOF extern thm agree_ra_valid_combine_iff; -/* `forall a b. ra_compatible agree_ra (Agree a) (Agree b) ==> a == b` */ +/* + * ```text + * forall a b. ra_compatible agree_ra (Agree a) (Agree b) ==> a == b + * ``` + */ PROOF extern thm agree_ra_agreement; -/* `forall a b. ra_included agree_ra (Agree a) (Agree b) <=> a == b` */ +/* + * ```text + * forall a b. ra_included agree_ra (Agree a) (Agree b) <=> a == b + * ``` + */ PROOF extern thm agree_ra_included_owned; -/* `~ra_cancellative agree_ra` */ +/* + * ```text + * ~ra_cancellative agree_ra + * ``` + */ PROOF extern thm agree_ra_not_cancellative; /* ------------------------------------------------------------------------- */ /* Agreement-preserving updates */ /* ------------------------------------------------------------------------- */ -/* `forall a b. ra_update agree_ra (Agree a) (Agree b) <=> a == b` */ +/* + * ```text + * forall a b. ra_update agree_ra (Agree a) (Agree b) <=> a == b + * ``` + */ PROOF extern thm agree_ra_update_iff; /* - * `forall a b. + * ```text + * forall a b. * ra_local_update agree_ra (Agree a) (Agree a) (Agree b) (Agree b) <=> - * a == b` + * a == b + * ``` */ PROOF extern thm agree_ra_local_update_iff; diff --git a/theory/logic/auth_ra.h b/theory/logic/auth_ra.h index 8ac7501..0065acd 100644 --- a/theory/logic/auth_ra.h +++ b/theory/logic/auth_ra.h @@ -18,32 +18,40 @@ /* ------------------------------------------------------------------------- */ /* - * `forall R:(A)ra. - * ra_unit (auth_ra R) == auth_frag (ra_unit R)` + * ```text + * forall R:(A)ra. + * ra_unit (auth_ra R) == auth_frag (ra_unit R) + * ``` */ PROOF extern thm auth_ra_unit; /* - * `forall (R:(A)ra) (a:A) (fragment:A). + * ```text + * forall (R:(A)ra) (a:A) (fragment:A). * ra_op * (auth_ra R) * (auth_auth R a) * (auth_frag fragment) == - * auth_both a fragment` + * auth_both a fragment + * ``` */ PROOF extern thm auth_ra_auth_frag; /* - * `forall (R:(A)ra) (f:A) (g:A). + * ```text + * forall (R:(A)ra) (f:A) (g:A). * ra_op (auth_ra R) (auth_frag f) (auth_frag g) == - * auth_frag (ra_op R f g)` + * auth_frag (ra_op R f g) + * ``` */ PROOF extern thm auth_ra_frag_frag; /* - * `forall (R:(A)ra) (a:A) (f:A) (g:A). + * ```text + * forall (R:(A)ra) (a:A) (f:A) (g:A). * ra_op (auth_ra R) (auth_both a f) (auth_frag g) == - * auth_both a (ra_op R f g)` + * auth_both a (ra_op R f g) + * ``` */ PROOF extern thm auth_ra_both_frag; @@ -52,28 +60,35 @@ PROOF extern thm auth_ra_both_frag; /* ------------------------------------------------------------------------- */ /* - * `forall (R:(A)ra) (fragment:A). + * ```text + * forall (R:(A)ra) (fragment:A). * ra_valid (auth_ra R) (auth_frag fragment) <=> - * ra_valid R fragment` + * ra_valid R fragment + * ``` */ PROOF extern thm auth_ra_valid_frag; /* - * `forall (R:(A)ra) (a:A) (fragment:A). + * ```text + * forall (R:(A)ra) (a:A) (fragment:A). * ra_valid (auth_ra R) (auth_both a fragment) <=> - * ra_valid R a && ra_included R fragment a` + * ra_valid R a && ra_included R fragment a + * ``` */ PROOF extern thm auth_ra_valid_both; /* - * `forall (R:(A)ra) (a:A). + * ```text + * forall (R:(A)ra) (a:A). * ra_valid (auth_ra R) (auth_auth R a) <=> - * ra_valid R a` + * ra_valid R a + * ``` */ PROOF extern thm auth_ra_valid_auth; /* - * `forall + * ```text + * forall * (R:(A)ra) * (a:A) * (f:A) @@ -84,16 +99,19 @@ PROOF extern thm auth_ra_valid_auth; * exists external:A. * frame == auth_frag external && * ra_valid R a && - * ra_included R (ra_op R f external) a` + * ra_included R (ra_op R f external) a + * ``` */ PROOF extern thm auth_ra_valid_both_frame; /* - * `forall (R:(A)ra) (a:A) (b:A). + * ```text + * forall (R:(A)ra) (a:A) (b:A). * ~(ra_compatible * (auth_ra R) * (auth_auth R a) - * (auth_auth R b))` + * (auth_auth R b)) + * ``` */ PROOF extern thm auth_ra_auth_conflict; @@ -102,43 +120,55 @@ PROOF extern thm auth_ra_auth_conflict; /* ------------------------------------------------------------------------- */ /* - * `forall (R:(A)ra) (f:A) (g:A). + * ```text + * forall (R:(A)ra) (f:A) (g:A). * ra_included (auth_ra R) (auth_frag f) (auth_frag g) <=> - * ra_included R f g` + * ra_included R f g + * ``` */ PROOF extern thm auth_ra_included_frag_frag; /* - * `forall (R:(A)ra) (f:A) (a:A) (g:A). + * ```text + * forall (R:(A)ra) (f:A) (a:A) (g:A). * ra_included (auth_ra R) (auth_frag f) (auth_both a g) <=> - * ra_included R f g` + * ra_included R f g + * ``` */ PROOF extern thm auth_ra_included_frag_both; /* - * `forall (R:(A)ra) (a:A) (b:A). + * ```text + * forall (R:(A)ra) (a:A) (b:A). * ra_included (auth_ra R) (auth_auth R a) (auth_auth R b) <=> - * a == b` + * a == b + * ``` */ PROOF extern thm auth_ra_included_auth_auth; /* - * `forall (R:(A)ra) (a:A) (b:A) (g:A). + * ```text + * forall (R:(A)ra) (a:A) (b:A) (g:A). * ra_included (auth_ra R) (auth_auth R a) (auth_both b g) <=> - * a == b` + * a == b + * ``` */ PROOF extern thm auth_ra_included_auth_both; /* - * `forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). + * ```text + * forall (R:(A)ra) (a:A) (f:A) (b:A) (g:A). * ra_included (auth_ra R) (auth_both a f) (auth_both b g) <=> - * a == b && ra_included R f g` + * a == b && ra_included R f g + * ``` */ PROOF extern thm auth_ra_included_both_both; /* - * `forall R:(A)ra. - * ra_cancellative (auth_ra R) <=> ra_cancellative R` + * ```text + * forall R:(A)ra. + * ra_cancellative (auth_ra R) <=> ra_cancellative R + * ``` */ PROOF extern thm auth_ra_cancellative_iff; @@ -147,7 +177,8 @@ PROOF extern thm auth_ra_cancellative_iff; /* ------------------------------------------------------------------------- */ /* - * `forall + * ```text + * forall * (R:(A)ra) * (a:A) * (f:A) @@ -161,12 +192,14 @@ PROOF extern thm auth_ra_cancellative_iff; * ra_valid R a && * ra_included R (ra_op R f external) a ==> * ra_valid R b && - * ra_included R (ra_op R g external) b` + * ra_included R (ra_op R g external) b + * ``` */ PROOF extern thm auth_ra_update_framewise_iff; /* - * `forall + * ```text + * forall * (R:(A)ra) * (a:A) * (f:A) @@ -176,65 +209,78 @@ PROOF extern thm auth_ra_update_framewise_iff; * ra_update * (auth_ra R) * (auth_both a f) - * (auth_both b g)` + * (auth_both b g) + * ``` */ PROOF extern thm auth_ra_update_local; /* - * `forall (R:(A)ra) (a:A) (b:A). + * ```text + * forall (R:(A)ra) (a:A) (b:A). * ra_update * (auth_ra R) * (auth_auth R a) * (auth_auth R b) <=> * (ra_valid R a ==> - * ra_valid R b && ra_included R a b)` + * ra_valid R b && ra_included R a b) + * ``` */ PROOF extern thm auth_ra_update_auth_iff; /* - * `forall (R:(A)ra) (a:A) (b:A) (g:A). + * ```text + * forall (R:(A)ra) (a:A) (b:A) (g:A). * ra_local_update R a (ra_unit R) b g ==> * ra_update * (auth_ra R) * (auth_auth R a) - * (auth_both b g)` + * (auth_both b g) + * ``` */ PROOF extern thm auth_ra_update_alloc; /* - * `forall (R:(A)ra) (a:A) (f:A). + * ```text + * forall (R:(A)ra) (a:A) (f:A). * ra_update * (auth_ra R) * (auth_both a f) - * (auth_auth R a)` + * (auth_auth R a) + * ``` */ PROOF extern thm auth_ra_update_drop_local; /* - * `forall (R:(A)ra) (a:A) (f:A). + * ```text + * forall (R:(A)ra) (a:A) (f:A). * ra_update * (auth_ra R) * (auth_both a f) - * (auth_frag f)` + * (auth_frag f) + * ``` */ PROOF extern thm auth_ra_update_drop_auth; /* - * `forall (R:(A)ra) (a:A) (f:A) (g:A). + * ```text + * forall (R:(A)ra) (a:A) (f:A) (g:A). * ra_included R g f ==> * ra_update * (auth_ra R) * (auth_both a f) - * (auth_both a g)` + * (auth_both a g) + * ``` */ PROOF extern thm auth_ra_update_weaken_frag; /* - * `forall (R:(A)ra) (a:A) (piece:A). + * ```text + * forall (R:(A)ra) (a:A) (piece:A). * ra_valid R (ra_op R a piece) ==> * ra_update * (auth_ra R) * (auth_auth R a) - * (auth_both (ra_op R a piece) piece)` + * (auth_both (ra_op R a piece) piece) + * ``` */ PROOF extern thm auth_ra_alloc; diff --git a/theory/logic/basic_update.h b/theory/logic/basic_update.h index 7b17007..d29320d 100644 --- a/theory/logic/basic_update.h +++ b/theory/logic/basic_update.h @@ -13,94 +13,148 @@ #include "proof/theory/logic/resource_prop.h" -/** HOL conclusion: `r_bupd (R:(A)ra) (Q:A->bool) (owned:A) <=> ra_updateP R owned Q`. */ +/** + * HOL conclusion: + * + * ```text + * r_bupd (R:(A)ra) (Q:A->bool) (owned:A) <=> ra_updateP R owned Q + * ``` + */ PROOF extern thm r_bupd_def; /** * HOL conclusion: - * `r_viewshift (R:(A)ra) (P:A->bool) (Q:A->bool) <=> r_entails R P - * (r_bupd R Q)`. + * + * ```text + * r_viewshift (R:(A)ra) (P:A->bool) (Q:A->bool) <=> r_entails R P + * (r_bupd R Q) + * ``` */ PROOF extern thm r_viewshift_def; /* Basic-update modality laws. */ -/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_entails R P (r_bupd R P)`. */ +/** + * HOL conclusion: + * + * ```text + * forall (R:(A)ra) (P:A->bool). r_entails R P (r_bupd R P) + * ``` + */ PROOF extern thm r_bupd_intro; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R P Q ==> r_entails R - * (r_bupd R P) (r_bupd R Q)`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R P Q ==> r_entails R + * (r_bupd R P) (r_bupd R Q) + * ``` */ PROOF extern thm r_bupd_mono; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool). r_entails R (r_bupd R (r_bupd R P)) (r_bupd R - * P)`. + * + * ```text + * forall (R:(A)ra) (P:A->bool). r_entails R (r_bupd R (r_bupd R P)) (r_bupd R + * P) + * ``` */ PROOF extern thm r_bupd_idem; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (frame_pred:A->bool). r_entails R (r_sep R - * (r_bupd R P) frame_pred) (r_bupd R (r_sep R P frame_pred))`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (frame_pred:A->bool). r_entails R (r_sep R + * (r_bupd R P) frame_pred) (r_bupd R (r_sep R P frame_pred)) + * ``` */ PROOF extern thm r_bupd_frame; /* View-shift consequence, composition, framing, and logical lifting. */ -/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_viewshift R P P`. */ +/** + * HOL conclusion: + * + * ```text + * forall (R:(A)ra) (P:A->bool). r_viewshift R P P + * ``` + */ PROOF extern thm r_viewshift_refl; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R P Q ==> r_viewshift R - * P Q`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R P Q ==> r_viewshift R + * P Q + * ``` */ PROOF extern thm r_entails_to_viewshift; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_viewshift R P Q ==> - * r_viewshift R Q S ==> r_viewshift R P S`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_viewshift R P Q ==> + * r_viewshift R Q S ==> r_viewshift R P S + * ``` */ PROOF extern thm r_viewshift_trans; /** * HOL conclusion: - * `forall (R:(A)ra) (P2:A->bool) (P:A->bool) (Q:A->bool) (Q2:A->bool). + * + * ```text + * forall (R:(A)ra) (P2:A->bool) (P:A->bool) (Q:A->bool) (Q2:A->bool). * r_entails R P2 P ==> r_viewshift R P Q ==> r_entails R Q Q2 ==> r_viewshift - * R P2 Q2`. + * R P2 Q2 + * ``` */ PROOF extern thm r_viewshift_mono; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (frame_pred:A->bool). r_viewshift R - * P Q ==> r_viewshift R (r_sep R P frame_pred) (r_sep R Q frame_pred)`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (frame_pred:A->bool). r_viewshift R + * P Q ==> r_viewshift R (r_sep R P frame_pred) (r_sep R Q frame_pred) + * ``` */ PROOF extern thm r_viewshift_frame; /** * HOL conclusion: - * `forall (R:(A)ra) (P1:A->bool) (Q1:A->bool) (P2:A->bool) (Q2:A->bool). + * + * ```text + * forall (R:(A)ra) (P1:A->bool) (Q1:A->bool) (P2:A->bool) (Q2:A->bool). * r_viewshift R P1 Q1 ==> r_viewshift R P2 Q2 ==> r_viewshift R (r_sep R P1 - * P2) (r_sep R Q1 Q2)`. + * P2) (r_sep R Q1 Q2) + * ``` */ PROOF extern thm r_viewshift_sep; /** * HOL conclusion: - * `forall (R:(A)ra) (P:B->A->bool) (Q:B->A->bool). (forall witness:B. + * + * ```text + * forall (R:(A)ra) (P:B->A->bool) (Q:B->A->bool). (forall witness:B. * r_viewshift R (P witness) (Q witness)) ==> r_viewshift R (r_exists R - * (\bound:B. P bound)) (r_exists R (\bound:B. Q bound))`. + * (\bound:B. P bound)) (r_exists R (\bound:B. Q bound)) + * ``` */ PROOF extern thm r_viewshift_exists; /* Ownership rules induced by deterministic and predicate RA updates. */ /** * HOL conclusion: - * `forall (R:(A)ra) (a:A) (b:A). ra_update R a b ==> r_viewshift R (r_own R a) - * (r_own R b)`. + * + * ```text + * forall (R:(A)ra) (a:A) (b:A). ra_update R a b ==> r_viewshift R (r_own R a) + * (r_own R b) + * ``` */ PROOF extern thm r_own_update; /* The predicate rule returns a witness, an exact-unit `r_fact`, and ownership. */ /** * HOL conclusion: - * `forall (R:(A)ra) (a:A) (result_pred:A->bool). ra_updateP R a result_pred ==> + * + * ```text + * forall (R:(A)ra) (a:A) (result_pred:A->bool). ra_updateP R a result_pred ==> * r_viewshift R (r_own R a) (r_exists R (\selected:A. r_sep R (r_fact R - * (result_pred selected)) (r_own R selected)))`. + * (result_pred selected)) (r_own R selected))) + * ``` */ PROOF extern thm r_own_updateP; diff --git a/theory/logic/big_sep.h b/theory/logic/big_sep.h index ce1b389..93abd23 100644 --- a/theory/logic/big_sep.h +++ b/theory/logic/big_sep.h @@ -20,66 +20,93 @@ /** * HOL conclusion: - * `(r_big_sep_list (R:(A)ra) (Phi:B->A->bool) ([]:(B)list) = r_emp R) && + * + * ```text + * (r_big_sep_list (R:(A)ra) (Phi:B->A->bool) ([]:(B)list) = r_emp R) && * (r_big_sep_list R Phi ((x:B) :: (xs:(B)list)) = r_sep R (Phi x) - * (r_big_sep_list R Phi xs))`. + * (r_big_sep_list R Phi xs)) + * ``` */ PROOF extern thm r_big_sep_list_def; /* Fold computation and append laws, exposed as `r_equiv`. */ /** * HOL conclusion: - * `forall (R:(A)ra) (Phi:B->A->bool). r_equiv R (r_big_sep_list R Phi - * ([]:(B)list)) (r_emp R)`. + * + * ```text + * forall (R:(A)ra) (Phi:B->A->bool). r_equiv R (r_big_sep_list R Phi + * ([]:(B)list)) (r_emp R) + * ``` */ PROOF extern thm r_big_sep_list_nil; /** * HOL conclusion: - * `forall (R:(A)ra) (Phi:B->A->bool) (x:B) (xs:(B)list). r_equiv R - * (r_big_sep_list R Phi (x :: xs)) (r_sep R (Phi x) (r_big_sep_list R Phi xs))`. + * + * ```text + * forall (R:(A)ra) (Phi:B->A->bool) (x:B) (xs:(B)list). r_equiv R + * (r_big_sep_list R Phi (x :: xs)) (r_sep R (Phi x) (r_big_sep_list R Phi xs)) + * ``` */ PROOF extern thm r_big_sep_list_cons; /** * HOL conclusion: - * `forall (R:(A)ra) (Phi:B->A->bool) (x:B). r_equiv R (r_big_sep_list R Phi (x - * :: [])) (Phi x)`. + * + * ```text + * forall (R:(A)ra) (Phi:B->A->bool) (x:B). r_equiv R (r_big_sep_list R Phi (x + * :: [])) (Phi x) + * ``` */ PROOF extern thm r_big_sep_list_singleton; /** * HOL conclusion: - * `forall (R:(A)ra) (Phi:B->A->bool) (left:(B)list) (right:(B)list). r_equiv R + * + * ```text + * forall (R:(A)ra) (Phi:B->A->bool) (left:(B)list) (right:(B)list). r_equiv R * (r_big_sep_list R Phi (APPEND left right)) (r_sep R (r_big_sep_list R Phi - * left) (r_big_sep_list R Phi right))`. + * left) (r_big_sep_list R Phi right)) + * ``` */ PROOF extern thm r_big_sep_list_append; /* Member-restricted pointwise entailment and equivalence lifting. */ /** * HOL conclusion: - * `forall (R:(A)ra) (Phi:B->A->bool) (Psi:B->A->bool) (xs:(B)list). (forall + * + * ```text + * forall (R:(A)ra) (Phi:B->A->bool) (Psi:B->A->bool) (xs:(B)list). (forall * x:B. MEM x xs ==> r_entails R (Phi x) (Psi x)) ==> r_entails R - * (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs)`. + * (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs) + * ``` */ PROOF extern thm r_big_sep_list_mono; /** * HOL conclusion: - * `forall (R:(A)ra) (Phi:B->A->bool) (Psi:B->A->bool) (xs:(B)list). (forall + * + * ```text + * forall (R:(A)ra) (Phi:B->A->bool) (Psi:B->A->bool) (xs:(B)list). (forall * x:B. MEM x xs ==> r_equiv R (Phi x) (Psi x)) ==> r_equiv R (r_big_sep_list R - * Phi xs) (r_big_sep_list R Psi xs)`. + * Phi xs) (r_big_sep_list R Psi xs) + * ``` */ PROOF extern thm r_big_sep_list_equiv; /* List MAP naturality and pointwise separation. */ /** * HOL conclusion: - * `forall (R:(A)ra) (Phi:B->A->bool) (f:C->B) (xs:(C)list). r_equiv R - * (r_big_sep_list R Phi (MAP f xs)) (r_big_sep_list R (\x:C. Phi (f x)) xs)`. + * + * ```text + * forall (R:(A)ra) (Phi:B->A->bool) (f:C->B) (xs:(C)list). r_equiv R + * (r_big_sep_list R Phi (MAP f xs)) (r_big_sep_list R (\x:C. Phi (f x)) xs) + * ``` */ PROOF extern thm r_big_sep_list_map; /** * HOL conclusion: - * `forall (R:(A)ra) (Phi:B->A->bool) (Psi:B->A->bool) (xs:(B)list). r_equiv R + * + * ```text + * forall (R:(A)ra) (Phi:B->A->bool) (Psi:B->A->bool) (xs:(B)list). r_equiv R * (r_big_sep_list R (\x:B. r_sep R (Phi x) (Psi x)) xs) (r_sep R - * (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs))`. + * (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs)) + * ``` */ PROOF extern thm r_big_sep_list_sep; diff --git a/theory/logic/excl_ra.h b/theory/logic/excl_ra.h index 30eb406..96913dd 100644 --- a/theory/logic/excl_ra.h +++ b/theory/logic/excl_ra.h @@ -15,43 +15,81 @@ /* Operation and validity */ /* ------------------------------------------------------------------------- */ -/* `ra_unit excl_ra == ExclUnit` */ +/* + * ```text + * ra_unit excl_ra == ExclUnit + * ``` + */ PROOF extern thm excl_ra_unit; -/* `forall a b. ra_op excl_ra (Excl a) (Excl b) == ExclInvalid` */ +/* + * ```text + * forall a b. ra_op excl_ra (Excl a) (Excl b) == ExclInvalid + * ``` + */ PROOF extern thm excl_ra_owned_conflict; -/* `ra_valid excl_ra ExclUnit` */ +/* + * ```text + * ra_valid excl_ra ExclUnit + * ``` + */ PROOF extern thm excl_ra_valid_unit; -/* `forall a. ra_valid excl_ra (Excl a)` */ +/* + * ```text + * forall a. ra_valid excl_ra (Excl a) + * ``` + */ PROOF extern thm excl_ra_valid_owned; -/* `~ra_valid excl_ra ExclInvalid` */ +/* + * ```text + * ~ra_valid excl_ra ExclInvalid + * ``` + */ PROOF extern thm excl_ra_invalid; /* ------------------------------------------------------------------------- */ /* Inclusion and algebraic properties */ /* ------------------------------------------------------------------------- */ -/* `forall a b. ra_included excl_ra (Excl a) (Excl b) <=> a == b` */ +/* + * ```text + * forall a b. ra_included excl_ra (Excl a) (Excl b) <=> a == b + * ``` + */ PROOF extern thm excl_ra_included_owned; -/* `forall a. ra_maximal excl_ra (Excl a)` */ +/* + * ```text + * forall a. ra_maximal excl_ra (Excl a) + * ``` + */ PROOF extern thm excl_ra_maximal; -/* `ra_cancellative excl_ra` */ +/* + * ```text + * ra_cancellative excl_ra + * ``` + */ PROOF extern thm excl_ra_cancellative; /* ------------------------------------------------------------------------- */ /* Replacement updates */ /* ------------------------------------------------------------------------- */ -/* `forall a x. ra_update excl_ra (Excl a) x <=> ra_valid excl_ra x` */ +/* + * ```text + * forall a x. ra_update excl_ra (Excl a) x <=> ra_valid excl_ra x + * ``` + */ PROOF extern thm excl_ra_update_owned_iff; /* - * `forall a x. - * ra_local_update excl_ra (Excl a) (Excl a) x x <=> ra_valid excl_ra x` + * ```text + * forall a x. + * ra_local_update excl_ra (Excl a) (Excl a) x x <=> ra_valid excl_ra x + * ``` */ PROOF extern thm excl_ra_local_update_iff; diff --git a/theory/logic/excl_ra_internal.h b/theory/logic/excl_ra_internal.h index 283184b..0d03c07 100644 --- a/theory/logic/excl_ra_internal.h +++ b/theory/logic/excl_ra_internal.h @@ -19,16 +19,20 @@ PROOF extern indtype excl_type; /* - * `excl_owned_op a ExclUnit == Excl a && + * ```text + * excl_owned_op a ExclUnit == Excl a && * excl_owned_op a (Excl b) == ExclInvalid && - * excl_owned_op a ExclInvalid == ExclInvalid` + * excl_owned_op a ExclInvalid == ExclInvalid + * ``` */ PROOF extern thm excl_owned_op_def; /* - * `excl_op ExclUnit y == y && + * ```text + * excl_op ExclUnit y == y && * excl_op (Excl a) y == excl_owned_op a y && - * excl_op ExclInvalid y == ExclInvalid` + * excl_op ExclInvalid y == ExclInvalid + * ``` */ PROOF extern thm excl_op_def; @@ -36,14 +40,30 @@ PROOF extern thm excl_op_def; /* Representation normalization */ /* ------------------------------------------------------------------------- */ -/* `forall a. ~(Excl a == ExclUnit)` */ +/* + * ```text + * forall a. ~(Excl a == ExclUnit) + * ``` + */ PROOF extern thm excl_owned_ne_unit; -/* `~(ExclInvalid == ExclUnit)` */ +/* + * ```text + * ~(ExclInvalid == ExclUnit) + * ``` + */ PROOF extern thm excl_invalid_ne_unit; -/* `ra_op excl_ra == excl_op` */ +/* + * ```text + * ra_op excl_ra == excl_op + * ``` + */ PROOF extern thm excl_ra_op_fn; -/* `forall a b. ra_update excl_ra (Excl a) (Excl b)` */ +/* + * ```text + * forall a b. ra_update excl_ra (Excl a) (Excl b) + * ``` + */ PROOF extern thm excl_ra_update; diff --git a/theory/logic/finmap.h b/theory/logic/finmap.h index eee0fad..480a61a 100644 --- a/theory/logic/finmap.h +++ b/theory/logic/finmap.h @@ -23,7 +23,11 @@ /* Core representation */ /* ------------------------------------------------------------------------- */ -/* `finmap_finite (f:K->V option) <=> FINITE {k:K | ~(f k == NONE)}` */ +/* + * ```text + * finmap_finite (f:K->V option) <=> FINITE {k:K | ~(f k == NONE)} + * ``` + */ PROOF extern thm finmap_finite_def; /* @@ -31,20 +35,28 @@ PROOF extern thm finmap_finite_def; * `finmap_abs:(K->V option)->(K,V)finmap` and * `finmap_rep:(K,V)finmap->K->V option`: * - * `(forall m:(K,V)finmap. + * ```text + * (forall m:(K,V)finmap. * finmap_abs (finmap_rep m) == m) && * (forall f:K->V option. * finmap_finite f <=> - * finmap_rep (finmap_abs f) == f)` + * finmap_rep (finmap_abs f) == f) + * ``` */ PROOF extern thm finmap_type_bijection; -/* `forall m:(K,V)finmap. finmap_finite (finmap_rep m)`. */ +/* + * ```text + * forall m:(K,V)finmap. finmap_finite (finmap_rep m) + * ``` + */ PROOF extern thm finmap_rep_finite; /* - * `forall (m:(K,V)finmap) (n:(K,V)finmap). - * m == n <=> finmap_rep m == finmap_rep n` + * ```text + * forall (m:(K,V)finmap) (n:(K,V)finmap). + * m == n <=> finmap_rep m == finmap_rep n + * ``` */ PROOF extern thm finmap_eq; @@ -52,33 +64,49 @@ PROOF extern thm finmap_eq; /* Constructors and observations */ /* ------------------------------------------------------------------------- */ -/* `finmap_empty:(K,V)finmap == finmap_abs (\k:K. NONE)`. */ +/* + * ```text + * finmap_empty:(K,V)finmap == finmap_abs (\k:K. NONE) + * ``` + */ PROOF extern thm finmap_empty_def; -/* `finmap_lookup (m:(K,V)finmap) (k:K) == finmap_rep m k` */ +/* + * ```text + * finmap_lookup (m:(K,V)finmap) (k:K) == finmap_rep m k + * ``` + */ PROOF extern thm finmap_lookup_def; /* - * `finmap_singleton (key:K) (v:V) == - * finmap_abs (\k:K. if k == key then SOME v else NONE)` + * ```text + * finmap_singleton (key:K) (v:V) == + * finmap_abs (\k:K. if k == key then SOME v else NONE) + * ``` */ PROOF extern thm finmap_singleton_def; /* - * `finmap_insert (key:K) (v:V) (m:(K,V)finmap) == - * finmap_abs (\k:K. if k == key then SOME v else finmap_rep m k)` + * ```text + * finmap_insert (key:K) (v:V) (m:(K,V)finmap) == + * finmap_abs (\k:K. if k == key then SOME v else finmap_rep m k) + * ``` */ PROOF extern thm finmap_insert_def; /* - * `finmap_delete (key:K) (m:(K,V)finmap) == - * finmap_abs (\k:K. if k == key then NONE else finmap_rep m k)` + * ```text + * finmap_delete (key:K) (m:(K,V)finmap) == + * finmap_abs (\k:K. if k == key then NONE else finmap_rep m k) + * ``` */ PROOF extern thm finmap_delete_def; /* - * `finmap_dom (m:(K,V)finmap) == - * {k:K | ~(finmap_lookup m k == NONE)}` + * ```text + * finmap_dom (m:(K,V)finmap) == + * {k:K | ~(finmap_lookup m k == NONE)} + * ``` */ PROOF extern thm finmap_dom_def; @@ -86,114 +114,150 @@ PROOF extern thm finmap_dom_def; /* Laws: representation and lookup */ /* ------------------------------------------------------------------------- */ -/* `finmap_rep (finmap_empty:(K,V)finmap) == (\k:K. NONE)`. */ +/* + * ```text + * finmap_rep (finmap_empty:(K,V)finmap) == (\k:K. NONE) + * ``` + */ PROOF extern thm finmap_empty_rep; -/* `forall k:K. finmap_lookup (finmap_empty:(K,V)finmap) k == NONE`. */ +/* + * ```text + * forall k:K. finmap_lookup (finmap_empty:(K,V)finmap) k == NONE + * ``` + */ PROOF extern thm finmap_empty_lookup; /* - * `forall (key:K) (v:V). + * ```text + * forall (key:K) (v:V). * {k:K | ~((if k == key then SOME v else NONE) == NONE)} == - * {key}` + * {key} + * ``` */ PROOF extern thm finmap_singleton_support; /* - * `forall (key:K) (v:V). + * ```text + * forall (key:K) (v:V). * finmap_rep (finmap_singleton key v) == - * (\k:K. if k == key then SOME v else NONE)` + * (\k:K. if k == key then SOME v else NONE) + * ``` */ PROOF extern thm finmap_singleton_rep; /* - * `forall (key:K) (v:V) (k:K). + * ```text + * forall (key:K) (v:V) (k:K). * finmap_lookup (finmap_singleton key v) k == - * if k == key then SOME v else NONE` + * if k == key then SOME v else NONE + * ``` */ PROOF extern thm finmap_singleton_lookup; /* - * `forall (key:K) (v:V) (f:K->V option). + * ```text + * forall (key:K) (v:V) (f:K->V option). * {k:K | ~((if k == key then SOME v else f k) == NONE)} == - * key INSERT {k:K | ~(f k == NONE)}` + * key INSERT {k:K | ~(f k == NONE)} + * ``` */ PROOF extern thm finmap_insert_support; /* - * `forall (key:K) (v:V) (m:(K,V)finmap). + * ```text + * forall (key:K) (v:V) (m:(K,V)finmap). * finmap_rep (finmap_insert key v m) == * (\k:K. - * if k == key then SOME v else finmap_rep m k)` + * if k == key then SOME v else finmap_rep m k) + * ``` */ PROOF extern thm finmap_insert_rep; /* - * `forall + * ```text + * forall * (key:K) * (v:V) * (m:(K,V)finmap) * (k:K). * finmap_lookup (finmap_insert key v m) k == - * if k == key then SOME v else finmap_lookup m k` + * if k == key then SOME v else finmap_lookup m k + * ``` */ PROOF extern thm finmap_insert_lookup; /* - * `forall (key:K) (v:V) (m:(K,V)finmap). - * finmap_lookup (finmap_insert key v m) key == SOME v` + * ```text + * forall (key:K) (v:V) (m:(K,V)finmap). + * finmap_lookup (finmap_insert key v m) key == SOME v + * ``` */ PROOF extern thm finmap_insert_lookup_eq; /* - * `forall + * ```text + * forall * (key:K) * (v:V) * (m:(K,V)finmap) * (k:K). * ~(k == key) ==> - * finmap_lookup (finmap_insert key v m) k == finmap_lookup m k` + * finmap_lookup (finmap_insert key v m) k == finmap_lookup m k + * ``` */ PROOF extern thm finmap_insert_lookup_ne; /* - * `forall (key:K) (f:K->V option). + * ```text + * forall (key:K) (f:K->V option). * {k:K | ~((if k == key then NONE else f k) == NONE)} == - * {k:K | ~(f k == NONE)} DELETE key` + * {k:K | ~(f k == NONE)} DELETE key + * ``` */ PROOF extern thm finmap_delete_support; /* - * `forall (key:K) (m:(K,V)finmap). + * ```text + * forall (key:K) (m:(K,V)finmap). * finmap_rep (finmap_delete key m) == - * (\k:K. if k == key then NONE else finmap_rep m k)` + * (\k:K. if k == key then NONE else finmap_rep m k) + * ``` */ PROOF extern thm finmap_delete_rep; /* - * `forall (key:K) (m:(K,V)finmap) (k:K). + * ```text + * forall (key:K) (m:(K,V)finmap) (k:K). * finmap_lookup (finmap_delete key m) k == - * if k == key then NONE else finmap_lookup m k` + * if k == key then NONE else finmap_lookup m k + * ``` */ PROOF extern thm finmap_delete_lookup; /* - * `forall (key:K) (m:(K,V)finmap). - * finmap_lookup (finmap_delete key m) key == NONE` + * ```text + * forall (key:K) (m:(K,V)finmap). + * finmap_lookup (finmap_delete key m) key == NONE + * ``` */ PROOF extern thm finmap_delete_lookup_eq; /* - * `forall (key:K) (m:(K,V)finmap) (k:K). + * ```text + * forall (key:K) (m:(K,V)finmap) (k:K). * ~(k == key) ==> - * finmap_lookup (finmap_delete key m) k == finmap_lookup m k` + * finmap_lookup (finmap_delete key m) k == finmap_lookup m k + * ``` */ PROOF extern thm finmap_delete_lookup_ne; /* - * `forall (m:(K,V)finmap) (n:(K,V)finmap). + * ```text + * forall (m:(K,V)finmap) (n:(K,V)finmap). * m == n <=> - * forall k:K. finmap_lookup m k == finmap_lookup n k` + * forall k:K. finmap_lookup m k == finmap_lookup n k + * ``` */ PROOF extern thm finmap_eq_lookup; @@ -202,31 +266,38 @@ PROOF extern thm finmap_eq_lookup; /* ------------------------------------------------------------------------- */ /* - * `forall (key:K) (v:V). + * ```text + * forall (key:K) (v:V). * finmap_insert key v (finmap_empty:(K,V)finmap) == - * finmap_singleton key v` + * finmap_singleton key v + * ``` */ PROOF extern thm finmap_insert_empty; /* - * `forall key:K. - * finmap_delete key (finmap_empty:(K,V)finmap) == finmap_empty` + * ```text + * forall key:K. + * finmap_delete key (finmap_empty:(K,V)finmap) == finmap_empty + * ``` */ PROOF extern thm finmap_delete_empty; /* - * `forall + * ```text + * forall * (key:K) * (v:V) * (w:V) * (m:(K,V)finmap). * finmap_insert key v (finmap_insert key w m) == - * finmap_insert key v m` + * finmap_insert key v m + * ``` */ PROOF extern thm finmap_insert_overwrite; /* - * `forall + * ```text + * forall * (key1:K) * (v1:V) * (key2:K) @@ -234,68 +305,85 @@ PROOF extern thm finmap_insert_overwrite; * (m:(K,V)finmap). * ~(key1 == key2) ==> * finmap_insert key1 v1 (finmap_insert key2 v2 m) == - * finmap_insert key2 v2 (finmap_insert key1 v1 m)` + * finmap_insert key2 v2 (finmap_insert key1 v1 m) + * ``` */ PROOF extern thm finmap_insert_comm; /* - * `forall (key:K) (m:(K,V)finmap). - * finmap_delete key (finmap_delete key m) == finmap_delete key m` + * ```text + * forall (key:K) (m:(K,V)finmap). + * finmap_delete key (finmap_delete key m) == finmap_delete key m + * ``` */ PROOF extern thm finmap_delete_idempotent; /* - * `forall (key1:K) (key2:K) (m:(K,V)finmap). + * ```text + * forall (key1:K) (key2:K) (m:(K,V)finmap). * finmap_delete key1 (finmap_delete key2 m) == - * finmap_delete key2 (finmap_delete key1 m)` + * finmap_delete key2 (finmap_delete key1 m) + * ``` */ PROOF extern thm finmap_delete_comm; /* - * `forall (key:K) (v:V) (m:(K,V)finmap). - * finmap_delete key (finmap_insert key v m) == finmap_delete key m` + * ```text + * forall (key:K) (v:V) (m:(K,V)finmap). + * finmap_delete key (finmap_insert key v m) == finmap_delete key m + * ``` */ PROOF extern thm finmap_delete_insert; /* * Deletion commutes with insertion at a different key: * - * `forall + * ```text + * forall * (deleted:K) * (inserted:K) * (v:V) * (m:(K,V)finmap). * ~(deleted == inserted) ==> * finmap_delete deleted (finmap_insert inserted v m) == - * finmap_insert inserted v (finmap_delete deleted m)` + * finmap_insert inserted v (finmap_delete deleted m) + * ``` */ PROOF extern thm finmap_delete_insert_ne; /* - * `forall (key:K) (v:V) (m:(K,V)finmap). + * ```text + * forall (key:K) (v:V) (m:(K,V)finmap). * finmap_insert key v (finmap_delete key m) == - * finmap_insert key v m` + * finmap_insert key v m + * ``` */ PROOF extern thm finmap_insert_delete; /* - * `forall (key:K) (v:V) (m:(K,V)finmap). + * ```text + * forall (key:K) (v:V) (m:(K,V)finmap). * finmap_lookup m key == SOME v ==> - * finmap_insert key v m == m` + * finmap_insert key v m == m + * ``` */ PROOF extern thm finmap_insert_id; /* - * `forall (key:K) (m:(K,V)finmap). + * ```text + * forall (key:K) (m:(K,V)finmap). * finmap_lookup m key == NONE ==> - * finmap_delete key m == m` + * finmap_delete key m == m + * ``` */ PROOF extern thm finmap_delete_id; /* - * `forall (key:K) (v:V) (m:(K,V)finmap). + * ```text + * forall (key:K) (v:V) (m:(K,V)finmap). * finmap_lookup m key == SOME v ==> - * finmap_insert key v (finmap_delete key m) == m` + * finmap_insert key v (finmap_delete key m) == m + * ``` */ PROOF extern thm finmap_decompose; @@ -303,52 +391,71 @@ PROOF extern thm finmap_decompose; /* Laws: finite domain */ /* ------------------------------------------------------------------------- */ -/* `forall m:(K,V)finmap. FINITE (finmap_dom m)`. */ +/* + * ```text + * forall m:(K,V)finmap. FINITE (finmap_dom m) + * ``` + */ PROOF extern thm finmap_dom_finite; -/* `finmap_dom (finmap_empty:(K,V)finmap) == {}`. */ +/* + * ```text + * finmap_dom (finmap_empty:(K,V)finmap) == {} + * ``` + */ PROOF extern thm finmap_dom_empty; /* - * `forall (key:K) (v:V). - * finmap_dom (finmap_singleton key v) == {key}` + * ```text + * forall (key:K) (v:V). + * finmap_dom (finmap_singleton key v) == {key} + * ``` */ PROOF extern thm finmap_dom_singleton; /* - * `forall (key:K) (m:(K,V)finmap). - * key IN finmap_dom m <=> ~(finmap_lookup m key == NONE)` + * ```text + * forall (key:K) (m:(K,V)finmap). + * key IN finmap_dom m <=> ~(finmap_lookup m key == NONE) + * ``` */ PROOF extern thm finmap_in_dom; /* - * `forall (key:K) (m:(K,V)finmap). + * ```text + * forall (key:K) (m:(K,V)finmap). * key IN finmap_dom m <=> - * exists v:V. finmap_lookup m key == SOME v` + * exists v:V. finmap_lookup m key == SOME v + * ``` */ PROOF extern thm finmap_in_dom_some; /* - * `forall (key:K) (m:(K,V)finmap). - * ~(key IN finmap_dom m) <=> finmap_lookup m key == NONE` + * ```text + * forall (key:K) (m:(K,V)finmap). + * ~(key IN finmap_dom m) <=> finmap_lookup m key == NONE + * ``` */ PROOF extern thm finmap_not_in_dom; /* * An infinite candidate set contains a key outside any one finite map: * - * `forall (candidates:K->bool) (m:(K,V)finmap). + * ```text + * forall (candidates:K->bool) (m:(K,V)finmap). * INFINITE candidates ==> * exists key:K. * key IN candidates && - * finmap_lookup m key == NONE` + * finmap_lookup m key == NONE + * ``` */ PROOF extern thm finmap_fresh_in; /* * An infinite candidate set contains a key outside two finite maps at once: * - * `forall + * ```text + * forall * (candidates:K->bool) * (m:(K,V)finmap) * (n:(K,W)finmap). @@ -356,49 +463,60 @@ PROOF extern thm finmap_fresh_in; * exists key:K. * key IN candidates && * finmap_lookup m key == NONE && - * finmap_lookup n key == NONE` + * finmap_lookup n key == NONE + * ``` */ PROOF extern thm finmap_fresh_in_pair; /* * If the key type is infinite, every finite map has a fresh key: * - * `forall m:(K,V)finmap. + * ```text + * forall m:(K,V)finmap. * INFINITE (UNIV:K->bool) ==> * exists key:K. - * finmap_lookup m key == NONE` + * finmap_lookup m key == NONE + * ``` */ PROOF extern thm finmap_fresh; /* * If the key type is infinite, two finite maps have a common fresh key: * - * `forall + * ```text + * forall * (m:(K,V)finmap) * (n:(K,W)finmap). * INFINITE (UNIV:K->bool) ==> * exists key:K. * finmap_lookup m key == NONE && - * finmap_lookup n key == NONE` + * finmap_lookup n key == NONE + * ``` */ PROOF extern thm finmap_fresh_pair; /* - * `forall m:(K,V)finmap. - * finmap_dom m == {} <=> m == finmap_empty` + * ```text + * forall m:(K,V)finmap. + * finmap_dom m == {} <=> m == finmap_empty + * ``` */ PROOF extern thm finmap_dom_eq_empty; /* - * `forall (key:K) (v:V) (m:(K,V)finmap). + * ```text + * forall (key:K) (v:V) (m:(K,V)finmap). * finmap_dom (finmap_insert key v m) == - * key INSERT finmap_dom m` + * key INSERT finmap_dom m + * ``` */ PROOF extern thm finmap_dom_insert; /* - * `forall (key:K) (m:(K,V)finmap). - * finmap_dom (finmap_delete key m) == finmap_dom m DELETE key` + * ```text + * forall (key:K) (m:(K,V)finmap). + * finmap_dom (finmap_delete key m) == finmap_dom m DELETE key + * ``` */ PROOF extern thm finmap_dom_delete; @@ -409,7 +527,8 @@ PROOF extern thm finmap_dom_delete; /* * Fresh-key induction: * - * `forall P:((K,V)finmap)->bool. + * ```text + * forall P:((K,V)finmap)->bool. * P finmap_empty ==> * (forall * (key:K) @@ -418,6 +537,7 @@ PROOF extern thm finmap_dom_delete; * finmap_lookup m key == NONE ==> * P m ==> * P (finmap_insert key v m)) ==> - * forall m:(K,V)finmap. P m` + * forall m:(K,V)finmap. P m + * ``` */ PROOF extern thm finmap_induct; diff --git a/theory/logic/frac_ra.h b/theory/logic/frac_ra.h index e4e8ee1..9eada80 100644 --- a/theory/logic/frac_ra.h +++ b/theory/logic/frac_ra.h @@ -15,18 +15,28 @@ /* Constructors and composition */ /* ------------------------------------------------------------------------- */ -/* `forall R. ra_unit (frac_ra R) == frac_empty` */ +/* + * ```text + * forall R. ra_unit (frac_ra R) == frac_empty + * ``` + */ PROOF extern thm frac_ra_unit; -/* `forall a. frac_full a == frac_own (&1) a` */ +/* + * ```text + * forall a. frac_full a == frac_own (&1) a + * ``` + */ PROOF extern thm frac_ra_full; /* - * `forall R p q a b. + * ```text + * forall R p q a b. * &0 < p * ==> &0 < q * ==> ra_op (frac_ra R) (frac_own p a) (frac_own q b) == - * frac_own (p + q) (ra_op R a b)` + * frac_own (p + q) (ra_op R a b) + * ``` */ PROOF extern thm frac_ra_own_op; @@ -35,13 +45,19 @@ PROOF extern thm frac_ra_own_op; /* ------------------------------------------------------------------------- */ /* - * `forall R p a. + * ```text + * forall R p a. * &0 < p - * ==> (ra_valid (frac_ra R) (frac_own p a) <=> p <= &1 && ra_valid R a)` + * ==> (ra_valid (frac_ra R) (frac_own p a) <=> p <= &1 && ra_valid R a) + * ``` */ PROOF extern thm frac_ra_valid_own; -/* `forall R a. ra_valid R a ==> ra_maximal (frac_ra R) (frac_full a)` */ +/* + * ```text + * forall R a. ra_valid R a ==> ra_maximal (frac_ra R) (frac_full a) + * ``` + */ PROOF extern thm frac_ra_maximal_full; /* ------------------------------------------------------------------------- */ @@ -49,27 +65,33 @@ PROOF extern thm frac_ra_maximal_full; /* ------------------------------------------------------------------------- */ /* - * `forall R p q a b. + * ```text + * forall R p q a b. * &0 < q * ==> q <= p * ==> ra_update R a b - * ==> ra_update (frac_ra R) (frac_own p a) (frac_own q b)` + * ==> ra_update (frac_ra R) (frac_own p a) (frac_own q b) + * ``` */ PROOF extern thm frac_ra_update_weaken; /* - * `forall R p q a P. + * ```text + * forall R p q a P. * &0 < q * ==> q <= p * ==> ra_updateP R a P * ==> ra_updateP (frac_ra R) (frac_own p a) - * (\x. exists b. P b && x == frac_own q b)` + * (\x. exists b. P b && x == frac_own q b) + * ``` */ PROOF extern thm frac_ra_updateP_weaken; /* - * `forall R a b. + * ```text + * forall R a b. * ra_update (frac_ra R) (frac_full a) (frac_full b) <=> - * ra_valid R a ==> ra_valid R b` + * ra_valid R a ==> ra_valid R b + * ``` */ PROOF extern thm frac_ra_update_full_iff; diff --git a/theory/logic/gmap_ra.h b/theory/logic/gmap_ra.h index edcb69d..6ec663c 100644 --- a/theory/logic/gmap_ra.h +++ b/theory/logic/gmap_ra.h @@ -18,13 +18,16 @@ /* ------------------------------------------------------------------------- */ /* - * `forall R:(V)ra. - * ra_unit (gmap_ra R) == (finmap_empty:(K,V)finmap)` + * ```text + * forall R:(V)ra. + * ra_unit (gmap_ra R) == (finmap_empty:(K,V)finmap) + * ``` */ PROOF extern thm gmap_ra_unit; /* - * `forall + * ```text + * forall * (R:(V)ra) * (m:(K,V)finmap) * (n:(K,V)finmap) @@ -33,34 +36,41 @@ PROOF extern thm gmap_ra_unit; * ra_op * (option_ra R) * (finmap_lookup m k) - * (finmap_lookup n k)` + * (finmap_lookup n k) + * ``` */ PROOF extern thm gmap_ra_op_lookup; /* - * `forall (R:(V)ra) (m:(K,V)finmap). + * ```text + * forall (R:(V)ra) (m:(K,V)finmap). * ra_valid (gmap_ra R) m <=> * forall k:K. - * ra_valid (option_ra R) (finmap_lookup m k)` + * ra_valid (option_ra R) (finmap_lookup m k) + * ``` */ PROOF extern thm gmap_ra_valid; /* - * `forall (R:(V)ra) (key:K) (a:V). + * ```text + * forall (R:(V)ra) (key:K) (a:V). * ra_valid (gmap_ra R) (finmap_singleton key a) <=> - * ra_valid R a` + * ra_valid R a + * ``` */ PROOF extern thm gmap_ra_valid_singleton; /* - * `forall + * ```text + * forall * (R:(V)ra) * (key:K) * (a:V) * (m:(K,V)finmap). * ra_valid (gmap_ra R) m ==> * finmap_lookup m key == SOME a ==> - * ra_valid R a` + * ra_valid R a + * ``` */ PROOF extern thm gmap_ra_valid_lookup; @@ -69,7 +79,8 @@ PROOF extern thm gmap_ra_valid_lookup; /* ------------------------------------------------------------------------- */ /* - * `forall + * ```text + * forall * (R:(V)ra) * (m:(K,V)finmap) * (n:(K,V)finmap). @@ -78,22 +89,26 @@ PROOF extern thm gmap_ra_valid_lookup; * ra_included * (option_ra R) * (finmap_lookup m k) - * (finmap_lookup n k)` + * (finmap_lookup n k) + * ``` */ PROOF extern thm gmap_ra_included_lookup_iff; /* - * `forall + * ```text + * forall * (R:(V)ra) * (m:(K,V)finmap) * (n:(K,V)finmap). * ra_included (gmap_ra R) m n ==> - * finmap_dom m SUBSET finmap_dom n` + * finmap_dom m SUBSET finmap_dom n + * ``` */ PROOF extern thm gmap_ra_included_dom; /* - * `forall + * ```text + * forall * (R:(V)ra) * (key:K) * (a:V) @@ -103,7 +118,8 @@ PROOF extern thm gmap_ra_included_dom; * ra_op * (gmap_ra R) * (finmap_singleton key a) - * (finmap_delete key m)` + * (finmap_delete key m) + * ``` */ PROOF extern thm gmap_ra_decompose; @@ -112,7 +128,8 @@ PROOF extern thm gmap_ra_decompose; /* ------------------------------------------------------------------------- */ /* - * `forall + * ```text + * forall * (R:(V)ra) * (key:K) * (a:V) (f:V) @@ -125,12 +142,14 @@ PROOF extern thm gmap_ra_decompose; * m * (finmap_singleton key f) * (finmap_insert key b m) - * (finmap_singleton key g)` + * (finmap_singleton key g) + * ``` */ PROOF extern thm gmap_ra_local_update_at; /* - * `forall + * ```text + * forall * (R:(V)ra) * (key:K) * (a:V) @@ -138,12 +157,14 @@ PROOF extern thm gmap_ra_local_update_at; * (m:(K,V)finmap). * finmap_lookup m key == SOME a ==> * ra_update R a b ==> - * ra_update (gmap_ra R) m (finmap_insert key b m)` + * ra_update (gmap_ra R) m (finmap_insert key b m) + * ``` */ PROOF extern thm gmap_ra_update_at; /* - * `forall + * ```text + * forall * (R:(V)ra) * (key:K) * (a:V) @@ -156,13 +177,16 @@ PROOF extern thm gmap_ra_update_at; * m * (\result:(K,V)finmap. * exists b:V. - * P b && result == finmap_insert key b m)` + * P b && result == finmap_insert key b m) + * ``` */ PROOF extern thm gmap_ra_updateP_at; /* - * `forall (R:(V)ra) (key:K) (m:(K,V)finmap). - * ra_update (gmap_ra R) m (finmap_delete key m)` + * ```text + * forall (R:(V)ra) (key:K) (m:(K,V)finmap). + * ra_update (gmap_ra R) m (finmap_delete key m) + * ``` */ PROOF extern thm gmap_ra_drop_at; @@ -171,7 +195,8 @@ PROOF extern thm gmap_ra_drop_at; /* ------------------------------------------------------------------------- */ /* - * `forall + * ```text + * forall * (R:(V)ra) * (candidates:K->bool) * (payload:K->V) @@ -188,12 +213,14 @@ PROOF extern thm gmap_ra_drop_at; * exists key:K. * key IN candidates && * finmap_lookup m key == NONE && - * result == finmap_insert key (payload key) m)` + * result == finmap_insert key (payload key) m) + * ``` */ PROOF extern thm gmap_ra_alloc_strong_dep; /* - * `forall (R:(V)ra) (m:(K,V)finmap) (a:V). + * ```text + * forall (R:(V)ra) (m:(K,V)finmap) (a:V). * INFINITE (UNIV:K->bool) ==> * ra_valid R a ==> * ra_updateP @@ -202,12 +229,14 @@ PROOF extern thm gmap_ra_alloc_strong_dep; * (\result:(K,V)finmap. * exists key:K. * finmap_lookup m key == NONE && - * result == finmap_insert key a m)` + * result == finmap_insert key a m) + * ``` */ PROOF extern thm gmap_ra_alloc; /* - * `forall + * ```text + * forall * (R:(V)ra) * (forbidden:K->bool) * (m:(K,V)finmap) @@ -222,6 +251,7 @@ PROOF extern thm gmap_ra_alloc; * exists key:K. * ~(key IN forbidden) && * finmap_lookup m key == NONE && - * result == finmap_insert key a m)` + * result == finmap_insert key a m) + * ``` */ PROOF extern thm gmap_ra_alloc_cofinite; diff --git a/theory/logic/gmap_ra_internal.h b/theory/logic/gmap_ra_internal.h index a721cc9..56c32ff 100644 --- a/theory/logic/gmap_ra_internal.h +++ b/theory/logic/gmap_ra_internal.h @@ -8,51 +8,60 @@ #include "proof/theory/logic/gmap_ra.h" /* - * `forall (R:(V)ra) (key:K) (a:V) (b:V). + * ```text + * forall (R:(V)ra) (key:K) (a:V) (b:V). * ra_op * (gmap_ra R) * (finmap_singleton key a) * (finmap_singleton key b) == - * finmap_singleton key (ra_op R a b)` + * finmap_singleton key (ra_op R a b) + * ``` */ PROOF extern thm gmap_ra_singleton_op; /* - * `forall + * ```text + * forall * (R:(V)ra) * (key:K) * (a:V) * (m:(K,V)finmap). * finmap_lookup m key == NONE ==> * ra_op (gmap_ra R) (finmap_singleton key a) m == - * finmap_insert key a m` + * finmap_insert key a m + * ``` */ PROOF extern thm gmap_ra_singleton_op_fresh; /* - * `forall (R:(V)ra) (key:K) (a:V) (b:V). + * ```text + * forall (R:(V)ra) (key:K) (a:V) (b:V). * ra_update R a b ==> * ra_update * (gmap_ra R) * (finmap_singleton key a) - * (finmap_singleton key b)` + * (finmap_singleton key b) + * ``` */ PROOF extern thm gmap_ra_update_singleton; /* - * `forall (R:(V)ra) (key:K) (a:V) (P:V->bool). + * ```text + * forall (R:(V)ra) (key:K) (a:V) (P:V->bool). * ra_updateP R a P ==> * ra_updateP * (gmap_ra R) * (finmap_singleton key a) * (\m:(K,V)finmap. * exists b:V. - * P b && m == finmap_singleton key b)` + * P b && m == finmap_singleton key b) + * ``` */ PROOF extern thm gmap_ra_updateP_singleton; /* - * `forall + * ```text + * forall * (R:(V)ra) * (candidates:K->bool) * (m:(K,V)finmap) @@ -66,6 +75,7 @@ PROOF extern thm gmap_ra_updateP_singleton; * exists key:K. * key IN candidates && * finmap_lookup m key == NONE && - * result == finmap_insert key a m)` + * result == finmap_insert key a m) + * ``` */ PROOF extern thm gmap_ra_alloc_strong; diff --git a/theory/logic/local_update.h b/theory/logic/local_update.h index f8c1c00..4704d2b 100644 --- a/theory/logic/local_update.h +++ b/theory/logic/local_update.h @@ -15,20 +15,24 @@ /* ------------------------------------------------------------------------- */ /* - * `ra_local_update R a f b g <=> + * ```text + * ra_local_update R a f b g <=> * (forall residual. * ra_valid R a * ==> a == ra_op R f residual - * ==> ra_valid R b && b == ra_op R g residual)` + * ==> ra_valid R b && b == ra_op R g residual) + * ``` */ PROOF extern thm ra_local_update_def; /* - * `forall R a f b g residual. + * ```text + * forall R a f b g residual. * ra_local_update R a f b g * ==> ra_valid R a * ==> a == ra_op R f residual - * ==> ra_valid R b && b == ra_op R g residual` + * ==> ra_valid R b && b == ra_op R g residual + * ``` */ PROOF extern thm ra_local_update_apply; @@ -36,30 +40,40 @@ PROOF extern thm ra_local_update_apply; /* Structural rules */ /* ------------------------------------------------------------------------- */ -/* `forall R a f. ra_local_update R a f a f` */ +/* + * ```text + * forall R a f. ra_local_update R a f a f + * ``` + */ PROOF extern thm ra_local_update_refl; /* - * `forall R a f b g c h. + * ```text + * forall R a f b g c h. * ra_local_update R a f b g * ==> ra_local_update R b g c h - * ==> ra_local_update R a f c h` + * ==> ra_local_update R a f c h + * ``` */ PROOF extern thm ra_local_update_trans; /* - * `forall R a f b g extra. + * ```text + * forall R a f b g extra. * ra_local_update R a f b g - * ==> ra_local_update R a (ra_op R f extra) b (ra_op R g extra)` + * ==> ra_local_update R a (ra_op R f extra) b (ra_op R g extra) + * ``` */ PROOF extern thm ra_local_update_frame; /* - * `forall R a f b g external. + * ```text + * forall R a f b g external. * ra_local_update R a f b g * ==> ra_valid R a * ==> ra_included R (ra_op R f external) a - * ==> ra_valid R b && ra_included R (ra_op R g external) b` + * ==> ra_valid R b && ra_included R (ra_op R g external) b + * ``` */ PROOF extern thm ra_local_update_preserves_included; @@ -68,26 +82,36 @@ PROOF extern thm ra_local_update_preserves_included; /* ------------------------------------------------------------------------- */ /* - * `forall R a f piece. + * ```text + * forall R a f piece. * ra_valid R (ra_op R a piece) - * ==> ra_local_update R a f (ra_op R a piece) (ra_op R f piece)` + * ==> ra_local_update R a f (ra_op R a piece) (ra_op R f piece) + * ``` */ PROOF extern thm ra_local_update_alloc; -/* `forall R a f b. ra_maximal R f ==> ra_valid R b ==> ra_local_update R a f b b` */ +/* + * ```text + * forall R a f b. ra_maximal R f ==> ra_valid R b ==> ra_local_update R a f b b + * ``` + */ PROOF extern thm ra_local_update_maximal; /* - * `forall R common a f. + * ```text + * forall R common a f. * ra_cancellative R - * ==> ra_local_update R (ra_op R common a) (ra_op R common f) a f` + * ==> ra_local_update R (ra_op R common a) (ra_op R common f) a f + * ``` */ PROOF extern thm ra_local_update_cancel; /* - * `forall R a b common. + * ```text + * forall R a b common. * ra_cancellative R * ==> ra_valid R (ra_op R b common) - * ==> ra_local_update R (ra_op R a common) a (ra_op R b common) b` + * ==> ra_local_update R (ra_op R a common) a (ra_op R b common) b + * ``` */ PROOF extern thm ra_local_update_cancellative; diff --git a/theory/logic/max_nat_ra.h b/theory/logic/max_nat_ra.h index f1a0673..fed4a05 100644 --- a/theory/logic/max_nat_ra.h +++ b/theory/logic/max_nat_ra.h @@ -15,24 +15,48 @@ /* Algebra, validity, and order */ /* ------------------------------------------------------------------------- */ -/* `ra_unit max_nat_ra == 0` */ +/* + * ```text + * ra_unit max_nat_ra == 0 + * ``` + */ PROOF extern thm max_nat_ra_unit; -/* `forall a b. ra_op max_nat_ra a b == MAX a b` */ +/* + * ```text + * forall a b. ra_op max_nat_ra a b == MAX a b + * ``` + */ PROOF extern thm max_nat_ra_op; -/* `forall n. ra_valid max_nat_ra n` */ +/* + * ```text + * forall n. ra_valid max_nat_ra n + * ``` + */ PROOF extern thm max_nat_ra_valid; -/* `forall a b. ra_included max_nat_ra a b <=> a <= b` */ +/* + * ```text + * forall a b. ra_included max_nat_ra a b <=> a <= b + * ``` + */ PROOF extern thm max_nat_ra_included; -/* `forall n. ra_op max_nat_ra n n == n` */ +/* + * ```text + * forall n. ra_op max_nat_ra n n == n + * ``` + */ PROOF extern thm max_nat_ra_idempotent; /* ------------------------------------------------------------------------- */ /* Updates */ /* ------------------------------------------------------------------------- */ -/* `forall old new. ra_update max_nat_ra old new` */ +/* + * ```text + * forall old new. ra_update max_nat_ra old new + * ``` + */ PROOF extern thm max_nat_ra_update; diff --git a/theory/logic/named_logic.h b/theory/logic/named_logic.h index e1b604b..b8942f8 100644 --- a/theory/logic/named_logic.h +++ b/theory/logic/named_logic.h @@ -7,47 +7,68 @@ /** * HOL conclusion: - * `named_own (R:(A)ra) (name:num) (a:A) : (num,A)finmap->bool = r_own (named_ra - * R) (finmap_singleton name a)`. + * + * ```text + * named_own (R:(A)ra) (name:num) (a:A) : (num,A)finmap->bool = r_own (named_ra + * R) (finmap_singleton name a) + * ``` */ PROOF extern thm named_own_def; /** * HOL conclusion: - * `forall (R:(A)ra) (name:num) (a:A) (b:A). r_equiv (named_ra R) (named_own R + * + * ```text + * forall (R:(A)ra) (name:num) (a:A) (b:A). r_equiv (named_ra R) (named_own R * name (ra_op R a b)) (r_sep (named_ra R) (named_own R name a) (named_own R - * name b))`. + * name b)) + * ``` */ PROOF extern thm named_own_op; /** * HOL conclusion: - * `forall (R:(A)ra) (name:num) (a:A). r_entails (named_ra R) (named_own R name + * + * ```text + * forall (R:(A)ra) (name:num) (a:A). r_entails (named_ra R) (named_own R name * a) (r_sep (named_ra R) (r_fact (named_ra R) (ra_valid R a)) (named_own R - * name a))`. + * name a)) + * ``` */ PROOF extern thm named_own_valid; /** * HOL conclusion: - * `forall (R:(A)ra) (name:num) (a:A) (b:A). ra_update R a b ==> r_viewshift - * (named_ra R) (named_own R name a) (named_own R name b)`. + * + * ```text + * forall (R:(A)ra) (name:num) (a:A) (b:A). ra_update R a b ==> r_viewshift + * (named_ra R) (named_own R name a) (named_own R name b) + * ``` */ PROOF extern thm named_own_update; /** * HOL conclusion: - * `forall (R:(A)ra) (name:num) (a:A) (P:A->bool). ra_updateP R a P ==> + * + * ```text + * forall (R:(A)ra) (name:num) (a:A) (P:A->bool). ra_updateP R a P ==> * r_viewshift (named_ra R) (named_own R name a) (r_exists (named_ra R) (\b:A. - * r_sep (named_ra R) (r_fact (named_ra R) (P b)) (named_own R name b)))`. + * r_sep (named_ra R) (r_fact (named_ra R) (P b)) (named_own R name b))) + * ``` */ PROOF extern thm named_own_updateP; /** * HOL conclusion: - * `forall (R:(A)ra) (name:num) (a:A). r_viewshift (named_ra R) (named_own R - * name a) (r_emp (named_ra R))`. + * + * ```text + * forall (R:(A)ra) (name:num) (a:A). r_viewshift (named_ra R) (named_own R + * name a) (r_emp (named_ra R)) + * ``` */ PROOF extern thm named_own_drop; /** * HOL conclusion: - * `forall (R:(A)ra) (a:A) (P:(num,A)finmap->bool). ra_valid R a ==> r_viewshift + * + * ```text + * forall (R:(A)ra) (a:A) (P:(num,A)finmap->bool). ra_valid R a ==> r_viewshift * (named_ra R) P (r_exists (named_ra R) (\name:num. r_sep (named_ra R) - * (named_own R name a) P))`. + * (named_own R name a) P)) + * ``` */ PROOF extern thm named_own_alloc; diff --git a/theory/logic/named_ra.h b/theory/logic/named_ra.h index c629274..8f99cb8 100644 --- a/theory/logic/named_ra.h +++ b/theory/logic/named_ra.h @@ -14,29 +14,39 @@ /* Specialization and pointwise semantics */ /* ------------------------------------------------------------------------- */ -/* `named_ra (R:(A)ra) == (gmap_ra R:((num,A)finmap)ra)` */ +/* + * ```text + * named_ra (R:(A)ra) == (gmap_ra R:((num,A)finmap)ra) + * ``` + */ PROOF extern thm named_ra_def; /* - * `forall R:(A)ra. - * ra_unit (named_ra R) == (finmap_empty:(num,A)finmap)` + * ```text + * forall R:(A)ra. + * ra_unit (named_ra R) == (finmap_empty:(num,A)finmap) + * ``` */ PROOF extern thm named_ra_unit; /* - * `forall (R:(A)ra) (name:num) (a:A) (b:A). + * ```text + * forall (R:(A)ra) (name:num) (a:A) (b:A). * ra_op * (named_ra R) * (finmap_singleton name a) * (finmap_singleton name b) == - * finmap_singleton name (ra_op R a b)` + * finmap_singleton name (ra_op R a b) + * ``` */ PROOF extern thm named_ra_singleton_op; /* - * `forall (R:(A)ra) (name:num) (a:A). + * ```text + * forall (R:(A)ra) (name:num) (a:A). * ra_valid (named_ra R) (finmap_singleton name a) <=> - * ra_valid R a` + * ra_valid R a + * ``` */ PROOF extern thm named_ra_valid_singleton; @@ -45,23 +55,27 @@ PROOF extern thm named_ra_valid_singleton; /* ------------------------------------------------------------------------- */ /* - * `forall (R:(A)ra) (name:num) (a:A) (b:A). + * ```text + * forall (R:(A)ra) (name:num) (a:A) (b:A). * ra_update R a b ==> * ra_update * (named_ra R) * (finmap_singleton name a) - * (finmap_singleton name b)` + * (finmap_singleton name b) + * ``` */ PROOF extern thm named_ra_update_singleton; /* - * `forall (R:(A)ra) (name:num) (a:A) (P:A->bool). + * ```text + * forall (R:(A)ra) (name:num) (a:A) (P:A->bool). * ra_updateP R a P ==> * ra_updateP * (named_ra R) * (finmap_singleton name a) * (\m:(num,A)finmap. - * exists b:A. P b && m == finmap_singleton name b)` + * exists b:A. P b && m == finmap_singleton name b) + * ``` */ PROOF extern thm named_ra_updateP_singleton; @@ -70,16 +84,19 @@ PROOF extern thm named_ra_updateP_singleton; /* ------------------------------------------------------------------------- */ /* - * `forall (R:(A)ra) (name:num) (a:A). + * ```text + * forall (R:(A)ra) (name:num) (a:A). * ra_update * (named_ra R) * (finmap_singleton name a) - * (finmap_empty:(num,A)finmap)` + * (finmap_empty:(num,A)finmap) + * ``` */ PROOF extern thm named_ra_drop; /* - * `forall (R:(A)ra) (m:(num,A)finmap) (a:A). + * ```text + * forall (R:(A)ra) (m:(num,A)finmap) (a:A). * ra_valid R a ==> * ra_updateP * (named_ra R) @@ -87,6 +104,7 @@ PROOF extern thm named_ra_drop; * (\result:(num,A)finmap. * exists name:num. * finmap_lookup m name == NONE && - * result == finmap_insert name a m)` + * result == finmap_insert name a m) + * ``` */ PROOF extern thm named_ra_alloc; diff --git a/theory/logic/option_ra.h b/theory/logic/option_ra.h index f72e601..ae7590d 100644 --- a/theory/logic/option_ra.h +++ b/theory/logic/option_ra.h @@ -14,41 +14,79 @@ /* Operation and validity */ /* ------------------------------------------------------------------------- */ -/* `forall R. ra_unit (option_ra R) == NONE` */ +/* + * ```text + * forall R. ra_unit (option_ra R) == NONE + * ``` + */ PROOF extern thm option_ra_unit; -/* `forall R x. ra_op (option_ra R) NONE x == x` */ +/* + * ```text + * forall R x. ra_op (option_ra R) NONE x == x + * ``` + */ PROOF extern thm option_ra_op_none_l; -/* `forall R a b. ra_op (option_ra R) (SOME a) (SOME b) == SOME (ra_op R a b)` */ +/* + * ```text + * forall R a b. ra_op (option_ra R) (SOME a) (SOME b) == SOME (ra_op R a b) + * ``` + */ PROOF extern thm option_ra_op_some_some; -/* `forall R. ra_valid (option_ra R) NONE` */ +/* + * ```text + * forall R. ra_valid (option_ra R) NONE + * ``` + */ PROOF extern thm option_ra_valid_none; -/* `forall R a. ra_valid (option_ra R) (SOME a) <=> ra_valid R a` */ +/* + * ```text + * forall R a. ra_valid (option_ra R) (SOME a) <=> ra_valid R a + * ``` + */ PROOF extern thm option_ra_valid_some; /* ------------------------------------------------------------------------- */ /* Inclusion and algebraic properties */ /* ------------------------------------------------------------------------- */ -/* `forall R x. ra_included (option_ra R) NONE x` */ +/* + * ```text + * forall R x. ra_included (option_ra R) NONE x + * ``` + */ PROOF extern thm option_ra_included_none; /* - * `forall R a b. - * ra_included (option_ra R) (SOME a) (SOME b) <=> ra_included R a b` + * ```text + * forall R a b. + * ra_included (option_ra R) (SOME a) (SOME b) <=> ra_included R a b + * ``` */ PROOF extern thm option_ra_included_some_some; -/* `forall R a. ~ra_included (option_ra R) (SOME a) NONE` */ +/* + * ```text + * forall R a. ~ra_included (option_ra R) (SOME a) NONE + * ``` + */ PROOF extern thm option_ra_not_included_some_none; -/* `forall R. ~(SOME (ra_unit R) == NONE)` */ +/* + * ```text + * forall R. ~(SOME (ra_unit R) == NONE) + * ``` + */ PROOF extern thm option_ra_some_unit_ne_none; -/* `forall R. ~ra_cancellative (option_ra R)` */ +/* + * ```text + * forall R. ~ra_cancellative (option_ra R) + * ``` + */ PROOF extern thm option_ra_not_cancellative; /* ------------------------------------------------------------------------- */ @@ -56,18 +94,26 @@ PROOF extern thm option_ra_not_cancellative; /* ------------------------------------------------------------------------- */ /* - * `forall R a P. + * ```text + * forall R a P. * ra_updateP (option_ra R) (SOME a) (\x. exists b. P b && x == SOME b) <=> - * ra_updateP R a P` + * ra_updateP R a P + * ``` */ PROOF extern thm option_ra_updateP_iff; -/* `forall R a b. ra_update (option_ra R) (SOME a) (SOME b) <=> ra_update R a b` */ +/* + * ```text + * forall R a b. ra_update (option_ra R) (SOME a) (SOME b) <=> ra_update R a b + * ``` + */ PROOF extern thm option_ra_update_iff; /* - * `forall R a f b g. + * ```text + * forall R a f b g. * ra_local_update (option_ra R) (SOME a) (SOME f) (SOME b) (SOME g) <=> - * ra_local_update R a f b g` + * ra_local_update R a f b g + * ``` */ PROOF extern thm option_ra_local_update_iff; diff --git a/theory/logic/option_ra_internal.h b/theory/logic/option_ra_internal.h index 437bc64..ea21a16 100644 --- a/theory/logic/option_ra_internal.h +++ b/theory/logic/option_ra_internal.h @@ -7,15 +7,25 @@ #include "proof/theory/logic/option_ra.h" -/* `forall R x. ra_op (option_ra R) x NONE == x` */ +/* + * ```text + * forall R x. ra_op (option_ra R) x NONE == x + * ``` + */ PROOF extern thm option_ra_op_none_r; -/* `forall R a b. ra_update R a b ==> ra_update (option_ra R) (SOME a) (SOME b)` */ +/* + * ```text + * forall R a b. ra_update R a b ==> ra_update (option_ra R) (SOME a) (SOME b) + * ``` + */ PROOF extern thm option_ra_update; /* - * `forall R a P. + * ```text + * forall R a P. * ra_updateP R a P - * ==> ra_updateP (option_ra R) (SOME a) (\x. exists b. P b && x == SOME b)` + * ==> ra_updateP (option_ra R) (SOME a) (\x. exists b. P b && x == SOME b) + * ``` */ PROOF extern thm option_ra_updateP; diff --git a/theory/logic/prod_ra.h b/theory/logic/prod_ra.h index 21bd61a..45a7904 100644 --- a/theory/logic/prod_ra.h +++ b/theory/logic/prod_ra.h @@ -15,40 +15,54 @@ /* Pointwise algebra */ /* ------------------------------------------------------------------------- */ -/* `forall R1 R2. ra_unit (prod_ra R1 R2) == ra_unit R1,ra_unit R2` */ +/* + * ```text + * forall R1 R2. ra_unit (prod_ra R1 R2) == ra_unit R1,ra_unit R2 + * ``` + */ PROOF extern thm prod_ra_unit; /* - * `forall R1 R2 x y. + * ```text + * forall R1 R2 x y. * ra_op (prod_ra R1 R2) x y == - * ra_op R1 (FST x) (FST y),ra_op R2 (SND x) (SND y)` + * ra_op R1 (FST x) (FST y),ra_op R2 (SND x) (SND y) + * ``` */ PROOF extern thm prod_ra_op; /* - * `forall R1 R2 x. - * ra_valid (prod_ra R1 R2) x <=> ra_valid R1 (FST x) && ra_valid R2 (SND x)` + * ```text + * forall R1 R2 x. + * ra_valid (prod_ra R1 R2) x <=> ra_valid R1 (FST x) && ra_valid R2 (SND x) + * ``` */ PROOF extern thm prod_ra_valid; /* - * `forall R1 R2 x y. + * ```text + * forall R1 R2 x y. * ra_included (prod_ra R1 R2) x y <=> - * ra_included R1 (FST x) (FST y) && ra_included R2 (SND x) (SND y)` + * ra_included R1 (FST x) (FST y) && ra_included R2 (SND x) (SND y) + * ``` */ PROOF extern thm prod_ra_included; /* - * `forall R1 R2. + * ```text + * forall R1 R2. * ra_cancellative (prod_ra R1 R2) <=> - * ra_cancellative R1 && ra_cancellative R2` + * ra_cancellative R1 && ra_cancellative R2 + * ``` */ PROOF extern thm prod_ra_cancellative_iff; /* - * `forall R1 R2 x. + * ```text + * forall R1 R2 x. * ra_maximal (prod_ra R1 R2) x <=> - * ra_maximal R1 (FST x) && ra_maximal R2 (SND x)` + * ra_maximal R1 (FST x) && ra_maximal R2 (SND x) + * ``` */ PROOF extern thm prod_ra_maximal_iff; @@ -57,31 +71,39 @@ PROOF extern thm prod_ra_maximal_iff; /* ------------------------------------------------------------------------- */ /* - * `forall R1 R2 a1 a2 P1 P2. + * ```text + * forall R1 R2 a1 a2 P1 P2. * ra_updateP R1 a1 P1 * ==> ra_updateP R2 a2 P2 * ==> ra_updateP (prod_ra R1 R2) (a1,a2) - * (\x. exists b1 b2. P1 b1 && P2 b2 && x == b1,b2)` + * (\x. exists b1 b2. P1 b1 && P2 b2 && x == b1,b2) + * ``` */ PROOF extern thm prod_ra_updateP; /* - * `forall R1 R2 a1 a2 b1. - * ra_update R1 a1 b1 ==> ra_update (prod_ra R1 R2) (a1,a2) (b1,a2)` + * ```text + * forall R1 R2 a1 a2 b1. + * ra_update R1 a1 b1 ==> ra_update (prod_ra R1 R2) (a1,a2) (b1,a2) + * ``` */ PROOF extern thm prod_ra_update_left; /* - * `forall R1 R2 a1 a2 b2. - * ra_update R2 a2 b2 ==> ra_update (prod_ra R1 R2) (a1,a2) (a1,b2)` + * ```text + * forall R1 R2 a1 a2 b2. + * ra_update R2 a2 b2 ==> ra_update (prod_ra R1 R2) (a1,a2) (a1,b2) + * ``` */ PROOF extern thm prod_ra_update_right; /* - * `forall R1 R2 a1 f1 b1 g1 a2 f2 b2 g2. + * ```text + * forall R1 R2 a1 f1 b1 g1 a2 f2 b2 g2. * ra_local_update R1 a1 f1 b1 g1 * ==> ra_local_update R2 a2 f2 b2 g2 - * ==> ra_local_update (prod_ra R1 R2) (a1,a2) (f1,f2) (b1,b2) (g1,g2)` + * ==> ra_local_update (prod_ra R1 R2) (a1,a2) (f1,f2) (b1,b2) (g1,g2) + * ``` */ PROOF extern thm prod_ra_local_update; @@ -89,52 +111,72 @@ PROOF extern thm prod_ra_local_update; /* Canonical component embeddings */ /* ------------------------------------------------------------------------- */ -/* `forall R S a. prod_inl R S a == a,ra_unit S` */ +/* + * ```text + * forall R S a. prod_inl R S a == a,ra_unit S + * ``` + */ PROOF extern thm prod_inl_def; -/* `forall R S b. prod_inr R S b == ra_unit R,b` */ +/* + * ```text + * forall R S b. prod_inr R S b == ra_unit R,b + * ``` + */ PROOF extern thm prod_inr_def; /* - * `forall R S a b. + * ```text + * forall R S a b. * prod_inl R S (ra_op R a b) == - * ra_op (prod_ra R S) (prod_inl R S a) (prod_inl R S b)` + * ra_op (prod_ra R S) (prod_inl R S a) (prod_inl R S b) + * ``` */ PROOF extern thm prod_inl_op; /* - * `forall R S a b. + * ```text + * forall R S a b. * prod_inr R S (ra_op S a b) == - * ra_op (prod_ra R S) (prod_inr R S a) (prod_inr R S b)` + * ra_op (prod_ra R S) (prod_inr R S a) (prod_inr R S b) + * ``` */ PROOF extern thm prod_inr_op; /* - * `forall R S a P. + * ```text + * forall R S a P. * ra_updateP R a P * ==> ra_updateP (prod_ra R S) (prod_inl R S a) - * (\x. exists b. P b && x == prod_inl R S b)` + * (\x. exists b. P b && x == prod_inl R S b) + * ``` */ PROOF extern thm prod_inl_updateP; /* - * `forall R S a P. + * ```text + * forall R S a P. * ra_updateP S a P * ==> ra_updateP (prod_ra R S) (prod_inr R S a) - * (\x. exists b. P b && x == prod_inr R S b)` + * (\x. exists b. P b && x == prod_inr R S b) + * ``` */ PROOF extern thm prod_inr_updateP; /* - * `forall R S a b. + * ```text + * forall R S a b. * ra_update R a b - * ==> ra_update (prod_ra R S) (prod_inl R S a) (prod_inl R S b)` + * ==> ra_update (prod_ra R S) (prod_inl R S a) (prod_inl R S b) + * ``` */ PROOF extern thm prod_inl_update; /* - * `forall R S a b. + * ```text + * forall R S a b. * ra_update S a b - * ==> ra_update (prod_ra R S) (prod_inr R S a) (prod_inr R S b)` + * ==> ra_update (prod_ra R S) (prod_inr R S a) (prod_inr R S b) + * ``` */ PROOF extern thm prod_inr_update; diff --git a/theory/logic/prod_ra_internal.h b/theory/logic/prod_ra_internal.h index d7aacd1..eaa6f03 100644 --- a/theory/logic/prod_ra_internal.h +++ b/theory/logic/prod_ra_internal.h @@ -8,9 +8,11 @@ #include "proof/theory/logic/prod_ra.h" /* - * `forall R1 R2. + * ```text + * forall R1 R2. * ra_cancellative R1 * ==> ra_cancellative R2 - * ==> ra_cancellative (prod_ra R1 R2)` + * ==> ra_cancellative (prod_ra R1 R2) + * ``` */ PROOF extern thm prod_ra_cancellative; diff --git a/theory/logic/product_resource.h b/theory/logic/product_resource.h index 5e86272..bd631fa 100644 --- a/theory/logic/product_resource.h +++ b/theory/logic/product_resource.h @@ -26,167 +26,242 @@ /** * HOL conclusion: - * `r_lift_left (R:(A)ra) (S:(B)ra) (P:A->bool) (resource:A#B) <=> P (FST - * resource) && SND resource == ra_unit S`. + * + * ```text + * r_lift_left (R:(A)ra) (S:(B)ra) (P:A->bool) (resource:A#B) <=> P (FST + * resource) && SND resource == ra_unit S + * ``` */ PROOF extern thm r_lift_left_def; /** * HOL conclusion: - * `r_lift_right (R:(A)ra) (S:(B)ra) (Q:B->bool) (resource:A#B) <=> FST resource - * == ra_unit R && Q (SND resource)`. + * + * ```text + * r_lift_right (R:(A)ra) (S:(B)ra) (Q:B->bool) (resource:A#B) <=> FST resource + * == ra_unit R && Q (SND resource) + * ``` */ PROOF extern thm r_lift_right_def; /* Exact-lift separating-monoid and entailment laws. */ /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra). r_equiv (prod_ra R S) (r_lift_left R S (r_emp - * R)) (r_emp (prod_ra R S))`. + * + * ```text + * forall (R:(A)ra) (S:(B)ra). r_equiv (prod_ra R S) (r_lift_left R S (r_emp + * R)) (r_emp (prod_ra R S)) + * ``` */ PROOF extern thm r_lift_left_emp; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra). r_equiv (prod_ra R S) (r_lift_right R S (r_emp - * S)) (r_emp (prod_ra R S))`. + * + * ```text + * forall (R:(A)ra) (S:(B)ra). r_equiv (prod_ra R S) (r_lift_right R S (r_emp + * S)) (r_emp (prod_ra R S)) + * ``` */ PROOF extern thm r_lift_right_emp; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (P:A->bool) (Q:A->bool). r_equiv (prod_ra R S) + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (P:A->bool) (Q:A->bool). r_equiv (prod_ra R S) * (r_lift_left R S (r_sep R P Q)) (r_sep (prod_ra R S) (r_lift_left R S P) - * (r_lift_left R S Q))`. + * (r_lift_left R S Q)) + * ``` */ PROOF extern thm r_lift_left_sep; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (P:B->bool) (Q:B->bool). r_equiv (prod_ra R S) + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (P:B->bool) (Q:B->bool). r_equiv (prod_ra R S) * (r_lift_right R S (r_sep S P Q)) (r_sep (prod_ra R S) (r_lift_right R S P) - * (r_lift_right R S Q))`. + * (r_lift_right R S Q)) + * ``` */ PROOF extern thm r_lift_right_sep; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (P:A->bool) (Q:A->bool). r_entails R P Q ==> - * r_entails (prod_ra R S) (r_lift_left R S P) (r_lift_left R S Q)`. + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (P:A->bool) (Q:A->bool). r_entails R P Q ==> + * r_entails (prod_ra R S) (r_lift_left R S P) (r_lift_left R S Q) + * ``` */ PROOF extern thm r_lift_left_entails; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (P:B->bool) (Q:B->bool). r_entails S P Q ==> - * r_entails (prod_ra R S) (r_lift_right R S P) (r_lift_right R S Q)`. + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (P:B->bool) (Q:B->bool). r_entails S P Q ==> + * r_entails (prod_ra R S) (r_lift_right R S P) (r_lift_right R S Q) + * ``` */ PROOF extern thm r_lift_right_entails; /* Right-only basic update and view shift. */ /** * HOL conclusion: - * `r_bupd_right (R:(A)ra) (S:(B)ra) (Q:(A#B)->bool) (resource:A#B) <=> - * ra_updateP S (SND resource) (\right':B. Q (FST resource,right'))`. + * + * ```text + * r_bupd_right (R:(A)ra) (S:(B)ra) (Q:(A#B)->bool) (resource:A#B) <=> + * ra_updateP S (SND resource) (\right':B. Q (FST resource,right')) + * ``` */ PROOF extern thm r_bupd_right_def; /** * HOL conclusion: - * `r_viewshift_right (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Q:(A#B)->bool) <=> - * r_entails (prod_ra R S) P (r_bupd_right R S Q)`. + * + * ```text + * r_viewshift_right (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Q:(A#B)->bool) <=> + * r_entails (prod_ra R S) P (r_bupd_right R S Q) + * ``` */ PROOF extern thm r_viewshift_right_def; /* Right-only basic-update modality laws. */ /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool). r_entails (prod_ra R S) P - * (r_bupd_right R S P)`. + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool). r_entails (prod_ra R S) P + * (r_bupd_right R S P) + * ``` */ PROOF extern thm r_bupd_right_intro; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Q:(A#B)->bool). r_entails + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Q:(A#B)->bool). r_entails * (prod_ra R S) P Q ==> r_entails (prod_ra R S) (r_bupd_right R S P) - * (r_bupd_right R S Q)`. + * (r_bupd_right R S Q) + * ``` */ PROOF extern thm r_bupd_right_mono; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool). r_entails (prod_ra R S) - * (r_bupd_right R S (r_bupd_right R S P)) (r_bupd_right R S P)`. + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool). r_entails (prod_ra R S) + * (r_bupd_right R S (r_bupd_right R S P)) (r_bupd_right R S P) + * ``` */ PROOF extern thm r_bupd_right_idem; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Frame:(A#B)->bool). r_entails + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Frame:(A#B)->bool). r_entails * (prod_ra R S) (r_sep (prod_ra R S) (r_bupd_right R S P) Frame) (r_bupd_right - * R S (r_sep (prod_ra R S) P Frame))`. + * R S (r_sep (prod_ra R S) P Frame)) + * ``` */ PROOF extern thm r_bupd_right_frame; /* Right-only view-shift laws, including exact-fact and existential lifting. */ -/** HOL conclusion: `forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool). r_viewshift_right R S P P`. */ +/** + * HOL conclusion: + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool). r_viewshift_right R S P P + * ``` + */ PROOF extern thm r_viewshift_right_refl; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Q:(A#B)->bool). r_entails - * (prod_ra R S) P Q ==> r_viewshift_right R S P Q`. + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Q:(A#B)->bool). r_entails + * (prod_ra R S) P Q ==> r_viewshift_right R S P Q + * ``` */ PROOF extern thm r_viewshift_right_entails; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Q:(A#B)->bool) (U:(A#B)->bool). + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Q:(A#B)->bool) (U:(A#B)->bool). * r_viewshift_right R S P Q ==> r_viewshift_right R S Q U ==> - * r_viewshift_right R S P U`. + * r_viewshift_right R S P U + * ``` */ PROOF extern thm r_viewshift_right_trans; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (P2:(A#B)->bool) (P:(A#B)->bool) (Q:(A#B)->bool) + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (P2:(A#B)->bool) (P:(A#B)->bool) (Q:(A#B)->bool) * (Q2:(A#B)->bool). r_entails (prod_ra R S) P2 P ==> r_viewshift_right R S P Q - * ==> r_entails (prod_ra R S) Q Q2 ==> r_viewshift_right R S P2 Q2`. + * ==> r_entails (prod_ra R S) Q Q2 ==> r_viewshift_right R S P2 Q2 + * ``` */ PROOF extern thm r_viewshift_right_mono; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Q:(A#B)->bool) + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Q:(A#B)->bool) * (Frame:(A#B)->bool). r_viewshift_right R S P Q ==> r_viewshift_right R S - * (r_sep (prod_ra R S) P Frame) (r_sep (prod_ra R S) Q Frame)`. + * (r_sep (prod_ra R S) P Frame) (r_sep (prod_ra R S) Q Frame) + * ``` */ PROOF extern thm r_viewshift_right_frame; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (P1:(A#B)->bool) (Q1:(A#B)->bool) + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (P1:(A#B)->bool) (Q1:(A#B)->bool) * (P2:(A#B)->bool) (Q2:(A#B)->bool). r_viewshift_right R S P1 Q1 ==> * r_viewshift_right R S P2 Q2 ==> r_viewshift_right R S (r_sep (prod_ra R S) - * P1 P2) (r_sep (prod_ra R S) Q1 Q2)`. + * P1 P2) (r_sep (prod_ra R S) Q1 Q2) + * ``` */ PROOF extern thm r_viewshift_right_sep; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (guard:bool) (P:(A#B)->bool) (Q:(A#B)->bool). + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (guard:bool) (P:(A#B)->bool) (Q:(A#B)->bool). * (guard ==> r_viewshift_right R S P Q) ==> r_viewshift_right R S (r_sep * (prod_ra R S) (r_fact (prod_ra R S) guard) P) (r_sep (prod_ra R S) (r_fact - * (prod_ra R S) guard) Q)`. + * (prod_ra R S) guard) Q) + * ``` */ PROOF extern thm r_viewshift_right_fact; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (P:C->(A#B)->bool) (Q:C->(A#B)->bool). (forall + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (P:C->(A#B)->bool) (Q:C->(A#B)->bool). (forall * witness:C. r_viewshift_right R S (P witness) (Q witness)) ==> * r_viewshift_right R S (r_exists (prod_ra R S) (\bound:C. P bound)) (r_exists - * (prod_ra R S) (\bound:C. Q bound))`. + * (prod_ra R S) (\bound:C. Q bound)) + * ``` */ PROOF extern thm r_viewshift_right_exists; /* Ownership rules for deterministic and predicate updates of the right RA. */ /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (a:B) (b:B). ra_update S a b ==> + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (a:B) (b:B). ra_update S a b ==> * r_viewshift_right R S (r_lift_right R S (r_own S a)) (r_lift_right R S - * (r_own S b))`. + * (r_own S b)) + * ``` */ PROOF extern thm r_right_own_update; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (a:B) (P:B->bool). ra_updateP S a P ==> + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (a:B) (P:B->bool). ra_updateP S a P ==> * r_viewshift_right R S (r_lift_right R S (r_own S a)) (r_exists (prod_ra R S) * (\b:B. r_sep (prod_ra R S) (r_fact (prod_ra R S) (P b)) (r_lift_right R S - * (r_own S b))))`. + * (r_own S b)))) + * ``` */ PROOF extern thm r_right_own_updateP; diff --git a/theory/logic/product_resource_internal.h b/theory/logic/product_resource_internal.h index 42f8481..a023cbd 100644 --- a/theory/logic/product_resource_internal.h +++ b/theory/logic/product_resource_internal.h @@ -13,25 +13,37 @@ /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra). r_lift_left R S (r_emp R) == r_emp - * (prod_ra R S)`. + * + * ```text + * forall (R:(A)ra) (S:(B)ra). r_lift_left R S (r_emp R) == r_emp + * (prod_ra R S) + * ``` */ PROOF extern thm r_lift_left_emp_eq; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra). r_lift_right R S (r_emp S) == r_emp (prod_ra R - * S)`. + * + * ```text + * forall (R:(A)ra) (S:(B)ra). r_lift_right R S (r_emp S) == r_emp (prod_ra R + * S) + * ``` */ PROOF extern thm r_lift_right_emp_eq; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (P:A->bool) (Q:A->bool). r_lift_left R S (r_sep R - * P Q) == r_sep (prod_ra R S) (r_lift_left R S P) (r_lift_left R S Q)`. + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (P:A->bool) (Q:A->bool). r_lift_left R S (r_sep R + * P Q) == r_sep (prod_ra R S) (r_lift_left R S P) (r_lift_left R S Q) + * ``` */ PROOF extern thm r_lift_left_sep_eq; /** * HOL conclusion: - * `forall (R:(A)ra) (S:(B)ra) (P:B->bool) (Q:B->bool). r_lift_right R S (r_sep - * S P Q) == r_sep (prod_ra R S) (r_lift_right R S P) (r_lift_right R S Q)`. + * + * ```text + * forall (R:(A)ra) (S:(B)ra) (P:B->bool) (Q:B->bool). r_lift_right R S (r_sep + * S P Q) == r_sep (prod_ra R S) (r_lift_right R S P) (r_lift_right R S Q) + * ``` */ PROOF extern thm r_lift_right_sep_eq; diff --git a/theory/logic/ra.h b/theory/logic/ra.h index 58152aa..f2c4f59 100644 --- a/theory/logic/ra.h +++ b/theory/logic/ra.h @@ -21,36 +21,54 @@ /* Derived relations */ /* ------------------------------------------------------------------------- */ -/* `ra_compatible R a b <=> ra_valid R (ra_op R a b)` */ +/* + * ```text + * ra_compatible R a b <=> ra_valid R (ra_op R a b) + * ``` + */ PROOF extern thm ra_compatible_def; -/* `ra_included R a b <=> (exists frame. b == ra_op R a frame)` */ +/* + * ```text + * ra_included R a b <=> (exists frame. b == ra_op R a frame) + * ``` + */ PROOF extern thm ra_included_def; /* - * `ra_updateP R a result <=> + * ```text + * ra_updateP R a result <=> * (forall frame. * ra_valid R (ra_op R a frame) - * ==> (exists b. result b && ra_valid R (ra_op R b frame)))` + * ==> (exists b. result b && ra_valid R (ra_op R b frame))) + * ``` */ PROOF extern thm ra_updateP_def; -/* `ra_update R a b <=> ra_updateP R a (\x. x == b)` */ +/* + * ```text + * ra_update R a b <=> ra_updateP R a (\x. x == b) + * ``` + */ PROOF extern thm ra_update_def; /* - * `ra_cancellative R <=> + * ```text + * ra_cancellative R <=> * (forall frame a b. * ra_valid R (ra_op R frame a) * ==> ra_op R frame a == ra_op R frame b - * ==> a == b)` + * ==> a == b) + * ``` */ PROOF extern thm ra_cancellative_def; /* - * `ra_maximal R a <=> + * ```text + * ra_maximal R a <=> * ra_valid R a && - * (forall frame. ra_valid R (ra_op R a frame) ==> frame == ra_unit R)` + * (forall frame. ra_valid R (ra_op R a frame) ==> frame == ra_unit R) + * ``` */ PROOF extern thm ra_maximal_def; @@ -58,107 +76,187 @@ PROOF extern thm ra_maximal_def; /* Intrinsic RA laws */ /* ------------------------------------------------------------------------- */ -/* `forall R. ra_laws (ra_unit R) (ra_op R) (ra_valid R)` */ +/* + * ```text + * forall R. ra_laws (ra_unit R) (ra_op R) (ra_valid R) + * ``` + */ PROOF extern thm ra_laws; -/* `forall R a b c. ra_op R (ra_op R a b) c == ra_op R a (ra_op R b c)` */ +/* + * ```text + * forall R a b c. ra_op R (ra_op R a b) c == ra_op R a (ra_op R b c) + * ``` + */ PROOF extern thm ra_assoc; -/* `forall R a b. ra_op R a b == ra_op R b a` */ +/* + * ```text + * forall R a b. ra_op R a b == ra_op R b a + * ``` + */ PROOF extern thm ra_comm; -/* `forall R a. ra_op R (ra_unit R) a == a` */ +/* + * ```text + * forall R a. ra_op R (ra_unit R) a == a + * ``` + */ PROOF extern thm ra_unit_l; -/* `forall R a. ra_op R a (ra_unit R) == a` */ +/* + * ```text + * forall R a. ra_op R a (ra_unit R) == a + * ``` + */ PROOF extern thm ra_unit_r; -/* `forall R. ra_valid R (ra_unit R)` */ +/* + * ```text + * forall R. ra_valid R (ra_unit R) + * ``` + */ PROOF extern thm ra_valid_unit; -/* `forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R a && ra_valid R b` */ +/* + * ```text + * forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R a && ra_valid R b + * ``` + */ PROOF extern thm ra_valid_op; /* ------------------------------------------------------------------------- */ /* Compatibility and inclusion */ /* ------------------------------------------------------------------------- */ -/* `forall R a b. ra_compatible R a b <=> ra_compatible R b a` */ +/* + * ```text + * forall R a b. ra_compatible R a b <=> ra_compatible R b a + * ``` + */ PROOF extern thm ra_compat_comm; -/* `forall R a. ra_compatible R a (ra_unit R) <=> ra_valid R a` */ +/* + * ```text + * forall R a. ra_compatible R a (ra_unit R) <=> ra_valid R a + * ``` + */ PROOF extern thm ra_compat_unit; -/* `forall R a. ra_included R a a` */ +/* + * ```text + * forall R a. ra_included R a a + * ``` + */ PROOF extern thm ra_included_refl; -/* `forall R a. ra_included R (ra_unit R) a` */ +/* + * ```text + * forall R a. ra_included R (ra_unit R) a + * ``` + */ PROOF extern thm ra_included_unit; -/* `forall R a b. ra_included R a (ra_op R a b)` */ +/* + * ```text + * forall R a b. ra_included R a (ra_op R a b) + * ``` + */ PROOF extern thm ra_included_op_l; -/* `forall R a b. ra_included R b (ra_op R a b)` */ +/* + * ```text + * forall R a b. ra_included R b (ra_op R a b) + * ``` + */ PROOF extern thm ra_included_op_r; -/* `forall R a b c. ra_included R a b ==> ra_included R b c ==> ra_included R a c` */ +/* + * ```text + * forall R a b c. ra_included R a b ==> ra_included R b c ==> ra_included R a c + * ``` + */ PROOF extern thm ra_included_trans; /* - * `forall R a1 a2 b1 b2. + * ```text + * forall R a1 a2 b1 b2. * ra_included R a1 a2 * ==> ra_included R b1 b2 - * ==> ra_included R (ra_op R a1 b1) (ra_op R a2 b2)` + * ==> ra_included R (ra_op R a1 b1) (ra_op R a2 b2) + * ``` */ PROOF extern thm ra_included_op_mono; -/* `forall R a b. ra_included R a b ==> ra_valid R b ==> ra_valid R a` */ +/* + * ```text + * forall R a b. ra_included R a b ==> ra_valid R b ==> ra_valid R a + * ``` + */ PROOF extern thm ra_included_valid; /* ------------------------------------------------------------------------- */ /* Predicate updates */ /* ------------------------------------------------------------------------- */ -/* `forall R a b. ra_updateP R a (\x. x == b) <=> ra_update R a b` */ +/* + * ```text + * forall R a b. ra_updateP R a (\x. x == b) <=> ra_update R a b + * ``` + */ PROOF extern thm ra_updateP_singleton; -/* `forall R a. ra_updateP R a (\x. x == a)` */ +/* + * ```text + * forall R a. ra_updateP R a (\x. x == a) + * ``` + */ PROOF extern thm ra_updateP_refl; /* - * `forall R a P Q. - * ra_updateP R a P ==> (forall b. P b ==> Q b) ==> ra_updateP R a Q` + * ```text + * forall R a P Q. + * ra_updateP R a P ==> (forall b. P b ==> Q b) ==> ra_updateP R a Q + * ``` */ PROOF extern thm ra_updateP_mono; /* - * `forall R a P Q. + * ```text + * forall R a P Q. * ra_updateP R a P * ==> (forall b. P b ==> ra_updateP R b Q) - * ==> ra_updateP R a Q` + * ==> ra_updateP R a Q + * ``` */ PROOF extern thm ra_updateP_trans; /* - * `forall R a P. - * ra_updateP R a P ==> ra_valid R a ==> (exists b. P b && ra_valid R b)` + * ```text + * forall R a P. + * ra_updateP R a P ==> ra_valid R a ==> (exists b. P b && ra_valid R b) + * ``` */ PROOF extern thm ra_updateP_valid; /* - * `forall R a P extra. + * ```text + * forall R a P extra. * ra_updateP R a P * ==> ra_updateP R (ra_op R a extra) - * (\x. exists b. P b && x == ra_op R b extra)` + * (\x. exists b. P b && x == ra_op R b extra) + * ``` */ PROOF extern thm ra_updateP_frame; /* - * `forall R a c P Q. + * ```text + * forall R a c P Q. * ra_updateP R a P * ==> ra_updateP R c Q * ==> ra_updateP R (ra_op R a c) - * (\x. exists b d. P b && Q d && x == ra_op R b d)` + * (\x. exists b d. P b && Q d && x == ra_op R b d) + * ``` */ PROOF extern thm ra_updateP_op; @@ -166,33 +264,57 @@ PROOF extern thm ra_updateP_op; /* Deterministic updates */ /* ------------------------------------------------------------------------- */ -/* `forall R a. ra_update R a a` */ +/* + * ```text + * forall R a. ra_update R a a + * ``` + */ PROOF extern thm ra_update_refl; -/* `forall R a b c. ra_update R a b ==> ra_update R b c ==> ra_update R a c` */ +/* + * ```text + * forall R a b c. ra_update R a b ==> ra_update R b c ==> ra_update R a c + * ``` + */ PROOF extern thm ra_update_trans; /* - * `forall R a b extra. - * ra_update R a b ==> ra_update R (ra_op R a extra) (ra_op R b extra)` + * ```text + * forall R a b extra. + * ra_update R a b ==> ra_update R (ra_op R a extra) (ra_op R b extra) + * ``` */ PROOF extern thm ra_update_frame; /* - * `forall R a b c d. + * ```text + * forall R a b c d. * ra_update R a b * ==> ra_update R c d - * ==> ra_update R (ra_op R a c) (ra_op R b d)` + * ==> ra_update R (ra_op R a c) (ra_op R b d) + * ``` */ PROOF extern thm ra_update_op; -/* `forall R a b. ra_included R b a ==> ra_update R a b` */ +/* + * ```text + * forall R a b. ra_included R b a ==> ra_update R a b + * ``` + */ PROOF extern thm ra_update_included; -/* `forall R a b c. ra_update R a b ==> ra_included R c b ==> ra_update R a c` */ +/* + * ```text + * forall R a b c. ra_update R a b ==> ra_included R c b ==> ra_update R a c + * ``` + */ PROOF extern thm ra_update_target_included; -/* `forall R a b. ra_update R a b ==> ra_valid R a ==> ra_valid R b` */ +/* + * ```text + * forall R a b. ra_update R a b ==> ra_valid R a ==> ra_valid R b + * ``` + */ PROOF extern thm ra_update_valid; /* ------------------------------------------------------------------------- */ @@ -200,19 +322,27 @@ PROOF extern thm ra_update_valid; /* ------------------------------------------------------------------------- */ /* - * `forall R a b. - * ra_maximal R a ==> ra_valid R b ==> ra_included R a b ==> a == b` + * ```text + * forall R a b. + * ra_maximal R a ==> ra_valid R b ==> ra_included R a b ==> a == b + * ``` */ PROOF extern thm ra_maximal_included; -/* `forall R a b. ra_maximal R a ==> ra_valid R b ==> ra_update R a b` */ +/* + * ```text + * forall R a b. ra_maximal R a ==> ra_valid R b ==> ra_update R a b + * ``` + */ PROOF extern thm ra_maximal_update; /* - * `forall R frame a b. + * ```text + * forall R frame a b. * ra_cancellative R * ==> ra_valid R (ra_op R frame a) * ==> ra_op R frame a == ra_op R frame b - * ==> a == b` + * ==> a == b + * ``` */ PROOF extern thm ra_cancellative_apply; diff --git a/theory/logic/ra_builder.h b/theory/logic/ra_builder.h index 8ab0078..78ecf79 100644 --- a/theory/logic/ra_builder.h +++ b/theory/logic/ra_builder.h @@ -16,31 +16,39 @@ /* ------------------------------------------------------------------------- */ /* - * `ra_laws e op valid <=> + * ```text + * ra_laws e op valid <=> * (forall a b c. op (op a b) c == op a (op b c)) && * (forall a b. op a b == op b a) && * (forall a. op e a == a) && * valid e && - * (forall a b. valid (op a b) ==> valid a)` + * (forall a b. valid (op a b) ==> valid a) + * ``` */ PROOF extern thm ra_laws_def; /* - * `(forall a. ra_abs (ra_rep a) == a) && + * ```text + * (forall a. ra_abs (ra_rep a) == a) && * (forall r. - * ra_laws (FST r) (FST (SND r)) (SND (SND r)) <=> ra_rep (ra_abs r) == r)` + * ra_laws (FST r) (FST (SND r)) (SND (SND r)) <=> ra_rep (ra_abs r) == r) + * ``` */ PROOF extern thm ra_type_bijection; /* - * `forall R. - * ra_laws (FST (ra_rep R)) (FST (SND (ra_rep R))) (SND (SND (ra_rep R)))` + * ```text + * forall R. + * ra_laws (FST (ra_rep R)) (FST (SND (ra_rep R))) (SND (SND (ra_rep R))) + * ``` */ PROOF extern thm ra_rep_laws; /* - * `forall e op valid. - * ra_laws e op valid ==> ra_rep (ra_abs (e,op,valid)) == e,op,valid` + * ```text + * forall e op valid. + * ra_laws e op valid ==> ra_rep (ra_abs (e,op,valid)) == e,op,valid + * ``` */ PROOF extern thm ra_abs_rep; @@ -48,17 +56,31 @@ PROOF extern thm ra_abs_rep; /* Constructor computation rules */ /* ------------------------------------------------------------------------- */ -/* `forall e op valid. ra_laws e op valid ==> ra_unit (ra_abs (e,op,valid)) == e` */ +/* + * ```text + * forall e op valid. ra_laws e op valid ==> ra_unit (ra_abs (e,op,valid)) == e + * ``` + */ PROOF extern thm ra_unit_abs; -/* `forall e op valid. ra_laws e op valid ==> ra_op (ra_abs (e,op,valid)) == op` */ +/* + * ```text + * forall e op valid. ra_laws e op valid ==> ra_op (ra_abs (e,op,valid)) == op + * ``` + */ PROOF extern thm ra_op_abs; /* - * `forall e op valid. - * ra_laws e op valid ==> ra_valid (ra_abs (e,op,valid)) == valid` + * ```text + * forall e op valid. + * ra_laws e op valid ==> ra_valid (ra_abs (e,op,valid)) == valid + * ``` */ PROOF extern thm ra_valid_abs; -/* `forall R. ra_abs (ra_unit R,ra_op R,ra_valid R) == R` */ +/* + * ```text + * forall R. ra_abs (ra_unit R,ra_op R,ra_valid R) == R + * ``` + */ PROOF extern thm ra_abs_eta; diff --git a/theory/logic/ra_internal.h b/theory/logic/ra_internal.h index 6e7d819..d9007c1 100644 --- a/theory/logic/ra_internal.h +++ b/theory/logic/ra_internal.h @@ -14,34 +14,52 @@ /* Operation and validity normalization */ /* ------------------------------------------------------------------------- */ -/* `forall R a b c. ra_op R (ra_op R a b) c == ra_op R (ra_op R a c) b` */ +/* + * ```text + * forall R a b c. ra_op R (ra_op R a b) c == ra_op R (ra_op R a c) b + * ``` + */ PROOF extern thm ra_op_swap_right; -/* `forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R a` */ +/* + * ```text + * forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R a + * ``` + */ PROOF extern thm ra_valid_op_l; -/* `forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R b` */ +/* + * ```text + * forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R b + * ``` + */ PROOF extern thm ra_valid_op_r; /* - * `forall R a frame. - * ra_maximal R a ==> ra_valid R (ra_op R a frame) ==> frame == ra_unit R` + * ```text + * forall R a frame. + * ra_maximal R a ==> ra_valid R (ra_op R a frame) ==> frame == ra_unit R + * ``` */ PROOF extern thm ra_maximal_apply; /* - * `forall R a b frame. + * ```text + * forall R a b frame. * ra_update R a b * ==> ra_valid R (ra_op R a frame) - * ==> ra_valid R (ra_op R b frame)` + * ==> ra_valid R (ra_op R b frame) + * ``` */ PROOF extern thm ra_update_apply; /* - * `forall R a P frame. + * ```text + * forall R a P frame. * ra_updateP R a P * ==> ra_valid R (ra_op R a frame) - * ==> (exists b. P b && ra_valid R (ra_op R b frame))` + * ==> (exists b. P b && ra_valid R (ra_op R b frame)) + * ``` */ PROOF extern thm ra_updateP_apply; @@ -50,38 +68,48 @@ PROOF extern thm ra_updateP_apply; /* ------------------------------------------------------------------------- */ /* - * `forall R a1 a2 b. - * ra_included R a1 a2 ==> ra_included R (ra_op R a1 b) (ra_op R a2 b)` + * ```text + * forall R a1 a2 b. + * ra_included R a1 a2 ==> ra_included R (ra_op R a1 b) (ra_op R a2 b) + * ``` */ PROOF extern thm ra_included_op_mono_l; /* - * `forall R a1 a2 b. - * ra_included R a1 a2 ==> ra_included R (ra_op R b a1) (ra_op R b a2)` + * ```text + * forall R a1 a2 b. + * ra_included R a1 a2 ==> ra_included R (ra_op R b a1) (ra_op R b a2) + * ``` */ PROOF extern thm ra_included_op_mono_r; /* - * `forall R a b frame. + * ```text + * forall R a b frame. * ra_included R a b * ==> ra_valid R (ra_op R b frame) - * ==> ra_valid R (ra_op R a frame)` + * ==> ra_valid R (ra_op R a frame) + * ``` */ PROOF extern thm ra_included_valid_frame; /* - * `forall R common a b. + * ```text + * forall R common a b. * ra_cancellative R * ==> ra_valid R (ra_op R common b) * ==> ra_included R (ra_op R common a) (ra_op R common b) - * ==> ra_included R a b` + * ==> ra_included R a b + * ``` */ PROOF extern thm ra_included_cancel_l; /* - * `forall R a frame. + * ```text + * forall R a frame. * ra_maximal R a - * ==> (ra_valid R (ra_op R a frame) <=> ra_valid R a && frame == ra_unit R)` + * ==> (ra_valid R (ra_op R a frame) <=> ra_valid R a && frame == ra_unit R) + * ``` */ PROOF extern thm ra_maximal_valid_op_iff; @@ -89,8 +117,16 @@ PROOF extern thm ra_maximal_valid_op_iff; /* Update bridges */ /* ------------------------------------------------------------------------- */ -/* `forall R a b P. ra_update R a b ==> P b ==> ra_updateP R a P` */ +/* + * ```text + * forall R a b P. ra_update R a b ==> P b ==> ra_updateP R a P + * ``` + */ PROOF extern thm ra_updateP_of_update; -/* `forall R a. ra_update R a (ra_unit R)` */ +/* + * ```text + * forall R a. ra_update R a (ra_unit R) + * ``` + */ PROOF extern thm ra_update_unit; diff --git a/theory/logic/resource_prop.h b/theory/logic/resource_prop.h index fab0c3c..b933492 100644 --- a/theory/logic/resource_prop.h +++ b/theory/logic/resource_prop.h @@ -33,73 +33,136 @@ /** * HOL conclusion: - * `r_entails (R:(A)ra) (P:A->bool) (Q:A->bool) <=> forall resource:A. ra_valid - * R resource ==> P resource ==> Q resource`. + * + * ```text + * r_entails (R:(A)ra) (P:A->bool) (Q:A->bool) <=> forall resource:A. ra_valid + * R resource ==> P resource ==> Q resource + * ``` */ PROOF extern thm r_entails_def; /** * HOL conclusion: - * `r_equiv (R:(A)ra) (P:A->bool) (Q:A->bool) <=> r_entails R P Q && r_entails R - * Q P`. + * + * ```text + * r_equiv (R:(A)ra) (P:A->bool) (Q:A->bool) <=> r_entails R P Q && r_entails R + * Q P + * ``` */ PROOF extern thm r_equiv_def; -/** HOL conclusion: `r_emp (R:(A)ra) (resource:A) <=> resource == ra_unit R`. */ +/** + * HOL conclusion: + * + * ```text + * r_emp (R:(A)ra) (resource:A) <=> resource == ra_unit R + * ``` + */ PROOF extern thm r_emp_def; /** * HOL conclusion: - * `r_sep (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> exists left - * right:A. resource == ra_op R left right && P left && Q right`. + * + * ```text + * r_sep (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> exists left + * right:A. resource == ra_op R left right && P left && Q right + * ``` */ PROOF extern thm r_sep_def; /** * HOL conclusion: - * `r_wand (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> forall frame:A. + * + * ```text + * r_wand (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> forall frame:A. * ra_valid R (ra_op R resource frame) ==> P frame ==> Q (ra_op R resource - * frame)`. + * frame) + * ``` */ PROOF extern thm r_wand_def; -/** HOL conclusion: `r_own (R:(A)ra) (owned:A) (resource:A) <=> resource == owned`. */ +/** + * HOL conclusion: + * + * ```text + * r_own (R:(A)ra) (owned:A) (resource:A) <=> resource == owned + * ``` + */ PROOF extern thm r_own_def; -/** HOL conclusion: `r_top (R:(A)ra) (resource:A) <=> T`. */ +/** + * HOL conclusion: + * + * ```text + * r_top (R:(A)ra) (resource:A) <=> T + * ``` + */ PROOF extern thm r_top_def; -/** HOL conclusion: `r_bottom (R:(A)ra) (resource:A) <=> F`. */ +/** + * HOL conclusion: + * + * ```text + * r_bottom (R:(A)ra) (resource:A) <=> F + * ``` + */ PROOF extern thm r_bottom_def; /** * HOL conclusion: - * `r_and (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> P resource && Q - * resource`. + * + * ```text + * r_and (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> P resource && Q + * resource + * ``` */ PROOF extern thm r_and_def; /** * HOL conclusion: - * `r_or (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> P resource || Q - * resource`. + * + * ```text + * r_or (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> P resource || Q + * resource + * ``` */ PROOF extern thm r_or_def; /** * HOL conclusion: - * `r_impl (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> P resource ==> Q - * resource`. + * + * ```text + * r_impl (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> P resource ==> Q + * resource + * ``` */ PROOF extern thm r_impl_def; /** * HOL conclusion: - * `r_exists (R:(A)ra) (P:B->A->bool) (resource:A) <=> exists witness:B. P - * witness resource`. + * + * ```text + * r_exists (R:(A)ra) (P:B->A->bool) (resource:A) <=> exists witness:B. P + * witness resource + * ``` */ PROOF extern thm r_exists_def; /** * HOL conclusion: - * `r_forall (R:(A)ra) (P:B->A->bool) (resource:A) <=> forall witness:B. P - * witness resource`. + * + * ```text + * r_forall (R:(A)ra) (P:B->A->bool) (resource:A) <=> forall witness:B. P + * witness resource + * ``` */ PROOF extern thm r_forall_def; -/** HOL conclusion: `r_pure (R:(A)ra) (phi:bool) (resource:A) <=> phi`. */ +/** + * HOL conclusion: + * + * ```text + * r_pure (R:(A)ra) (phi:bool) (resource:A) <=> phi + * ``` + */ PROOF extern thm r_pure_def; -/** HOL conclusion: `r_fact (R:(A)ra) (phi:bool) (resource:A) <=> phi && resource == ra_unit R`. */ +/** + * HOL conclusion: + * + * ```text + * r_fact (R:(A)ra) (phi:bool) (resource:A) <=> phi && resource == ra_unit R + * ``` + */ PROOF extern thm r_fact_def; /* ------------------------------------------------------------------------- */ @@ -107,261 +170,450 @@ PROOF extern thm r_fact_def; /* ------------------------------------------------------------------------- */ /* Entailment and validity-sensitive equivalence. */ -/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_entails R P P`. */ +/** + * HOL conclusion: + * + * ```text + * forall (R:(A)ra) (P:A->bool). r_entails R P P + * ``` + */ PROOF extern thm r_entails_refl; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R P Q ==> - * r_entails R Q S ==> r_entails R P S`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R P Q ==> + * r_entails R Q S ==> r_entails R P S + * ``` */ PROOF extern thm r_entails_trans; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool). (forall resource:A. P resource ==> - * Q resource) ==> r_entails R P Q`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool). (forall resource:A. P resource ==> + * Q resource) ==> r_entails R P Q + * ``` */ PROOF extern thm r_entails_pointwise; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_equiv R P Q <=> forall - * resource:A. ra_valid R resource ==> (P resource <=> Q resource)`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_equiv R P Q <=> forall + * resource:A. ra_valid R resource ==> (P resource <=> Q resource) + * ``` */ PROOF extern thm r_equiv_pointwise; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R P Q ==> r_entails R Q - * P ==> r_equiv R P Q`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R P Q ==> r_entails R Q + * P ==> r_equiv R P Q + * ``` */ PROOF extern thm r_equiv_intro; -/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_equiv R P P`. */ +/** + * HOL conclusion: + * + * ```text + * forall (R:(A)ra) (P:A->bool). r_equiv R P P + * ``` + */ PROOF extern thm r_equiv_refl; -/** HOL conclusion: `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_equiv R P Q ==> r_equiv R Q P`. */ +/** + * HOL conclusion: + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_equiv R P Q ==> r_equiv R Q P + * ``` + */ PROOF extern thm r_equiv_sym; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_equiv R P Q ==> - * r_equiv R Q S ==> r_equiv R P S`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_equiv R P Q ==> + * r_equiv R Q S ==> r_equiv R P S + * ``` */ PROOF extern thm r_equiv_trans; /* Additive truth and falsehood. */ -/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_entails R P (r_top R)`. */ +/** + * HOL conclusion: + * + * ```text + * forall (R:(A)ra) (P:A->bool). r_entails R P (r_top R) + * ``` + */ PROOF extern thm r_top_intro; -/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_entails R (r_bottom R) P`. */ +/** + * HOL conclusion: + * + * ```text + * forall (R:(A)ra) (P:A->bool). r_entails R (r_bottom R) P + * ``` + */ PROOF extern thm r_bottom_elim; /* Separating conjunction. Algebraic laws expose `r_equiv`, never raw * assertion-function equality. */ /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_equiv R (r_sep R - * (r_sep R P Q) S) (r_sep R P (r_sep R Q S))`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_equiv R (r_sep R + * (r_sep R P Q) S) (r_sep R P (r_sep R Q S)) + * ``` */ PROOF extern thm r_sep_assoc; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_equiv R (r_sep R P Q) (r_sep R Q - * P)`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_equiv R (r_sep R P Q) (r_sep R Q + * P) + * ``` */ PROOF extern thm r_sep_comm; -/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_equiv R (r_sep R (r_emp R) P) P`. */ +/** + * HOL conclusion: + * + * ```text + * forall (R:(A)ra) (P:A->bool). r_equiv R (r_sep R (r_emp R) P) P + * ``` + */ PROOF extern thm r_sep_emp_l; -/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_equiv R (r_sep R P (r_emp R)) P`. */ +/** + * HOL conclusion: + * + * ```text + * forall (R:(A)ra) (P:A->bool). r_equiv R (r_sep R P (r_emp R)) P + * ``` + */ PROOF extern thm r_sep_emp_r; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (P2:A->bool) (Q:A->bool) (Q2:A->bool). + * + * ```text + * forall (R:(A)ra) (P:A->bool) (P2:A->bool) (Q:A->bool) (Q2:A->bool). * r_entails R P P2 ==> r_entails R Q Q2 ==> r_entails R (r_sep R P Q) (r_sep R - * P2 Q2)`. + * P2 Q2) + * ``` */ PROOF extern thm r_sep_mono; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (frame_pred:A->bool). r_entails R P - * Q ==> r_entails R (r_sep R P frame_pred) (r_sep R Q frame_pred)`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (frame_pred:A->bool). r_entails R P + * Q ==> r_entails R (r_sep R P frame_pred) (r_sep R Q frame_pred) + * ``` */ PROOF extern thm r_sep_frame_l; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (frame_pred:A->bool). r_entails R P - * Q ==> r_entails R (r_sep R frame_pred P) (r_sep R frame_pred Q)`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (frame_pred:A->bool). r_entails R P + * Q ==> r_entails R (r_sep R frame_pred P) (r_sep R frame_pred Q) + * ``` */ PROOF extern thm r_sep_frame_r; /** * HOL conclusion: - * `forall (R:(A)ra) (P:B->A->bool) (Q:A->bool). r_equiv R (r_sep R (r_exists R - * (\x:B. P x)) Q) (r_exists R (\x:B. r_sep R (P x) Q))`. + * + * ```text + * forall (R:(A)ra) (P:B->A->bool) (Q:A->bool). r_equiv R (r_sep R (r_exists R + * (\x:B. P x)) Q) (r_exists R (\x:B. r_sep R (P x) Q)) + * ``` */ PROOF extern thm r_sep_exists_l; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:B->A->bool). r_equiv R (r_sep R P (r_exists - * R (\x:B. Q x))) (r_exists R (\x:B. r_sep R P (Q x)))`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:B->A->bool). r_equiv R (r_sep R P (r_exists + * R (\x:B. Q x))) (r_exists R (\x:B. r_sep R P (Q x))) + * ``` */ PROOF extern thm r_sep_exists_r; /* Additive connectives and quantifiers. */ /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R (r_and R P - * Q) S <=> r_entails R P (r_impl R Q S)`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R (r_and R P + * Q) S <=> r_entails R P (r_impl R Q S) + * ``` */ PROOF extern thm r_impl_adjunction; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R P Q ==> - * r_entails R P S ==> r_entails R P (r_and R Q S)`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R P Q ==> + * r_entails R P S ==> r_entails R P (r_and R Q S) + * ``` */ PROOF extern thm r_and_intro; -/** HOL conclusion: `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R (r_and R P Q) P`. */ +/** + * HOL conclusion: + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R (r_and R P Q) P + * ``` + */ PROOF extern thm r_and_elim_l; -/** HOL conclusion: `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R (r_and R P Q) Q`. */ +/** + * HOL conclusion: + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R (r_and R P Q) Q + * ``` + */ PROOF extern thm r_and_elim_r; -/** HOL conclusion: `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R P (r_or R P Q)`. */ +/** + * HOL conclusion: + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R P (r_or R P Q) + * ``` + */ PROOF extern thm r_or_intro_l; -/** HOL conclusion: `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R Q (r_or R P Q)`. */ +/** + * HOL conclusion: + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R Q (r_or R P Q) + * ``` + */ PROOF extern thm r_or_intro_r; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R P S ==> - * r_entails R Q S ==> r_entails R (r_or R P Q) S`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R P S ==> + * r_entails R Q S ==> r_entails R (r_or R P Q) S + * ``` */ PROOF extern thm r_or_elim; /** * HOL conclusion: - * `forall (R:(A)ra) (P:B->A->bool) (witness:B). r_entails R (P witness) - * (r_exists R (\bound:B. P bound))`. + * + * ```text + * forall (R:(A)ra) (P:B->A->bool) (witness:B). r_entails R (P witness) + * (r_exists R (\bound:B. P bound)) + * ``` */ PROOF extern thm r_exists_intro; /** * HOL conclusion: - * `forall (R:(A)ra) (P:B->A->bool) (Q:A->bool). (forall witness:B. r_entails R - * (P witness) Q) ==> r_entails R (r_exists R (\bound:B. P bound)) Q`. + * + * ```text + * forall (R:(A)ra) (P:B->A->bool) (Q:A->bool). (forall witness:B. r_entails R + * (P witness) Q) ==> r_entails R (r_exists R (\bound:B. P bound)) Q + * ``` */ PROOF extern thm r_exists_elim; /** * HOL conclusion: - * `forall (R:(A)ra) (P:B->A->bool) (Q:B->A->bool). (forall witness:B. r_entails + * + * ```text + * forall (R:(A)ra) (P:B->A->bool) (Q:B->A->bool). (forall witness:B. r_entails * R (P witness) (Q witness)) ==> r_entails R (r_exists R (\bound:B. P bound)) - * (r_exists R (\bound:B. Q bound))`. + * (r_exists R (\bound:B. Q bound)) + * ``` */ PROOF extern thm r_exists_mono; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:B->A->bool). (forall witness:B. r_entails R - * P (Q witness)) ==> r_entails R P (r_forall R (\bound:B. Q bound))`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:B->A->bool). (forall witness:B. r_entails R + * P (Q witness)) ==> r_entails R P (r_forall R (\bound:B. Q bound)) + * ``` */ PROOF extern thm r_forall_intro; /** * HOL conclusion: - * `forall (R:(A)ra) (P:B->A->bool) (witness:B). r_entails R (r_forall R P) (P - * witness)`. + * + * ```text + * forall (R:(A)ra) (P:B->A->bool) (witness:B). r_entails R (r_forall R P) (P + * witness) + * ``` */ PROOF extern thm r_forall_elim; /* Magic wand. */ /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R (r_sep R P - * Q) S <=> r_entails R P (r_wand R Q S)`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R (r_sep R P + * Q) S <=> r_entails R P (r_wand R Q S) + * ``` */ PROOF extern thm r_wand_adjunction; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R (r_sep R (r_wand R P - * Q) P) Q`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R (r_sep R (r_wand R P + * Q) P) Q + * ``` */ PROOF extern thm r_wand_elim; /** * HOL conclusion: - * `forall (R:(A)ra) (P2:A->bool) (P:A->bool) (Q:A->bool) (Q2:A->bool). + * + * ```text + * forall (R:(A)ra) (P2:A->bool) (P:A->bool) (Q:A->bool) (Q2:A->bool). * r_entails R P2 P ==> r_entails R Q Q2 ==> r_entails R (r_wand R P Q) (r_wand - * R P2 Q2)`. + * R P2 Q2) + * ``` */ PROOF extern thm r_wand_mono; /* Resource-independent pure propositions, combined additively with `r_and`. */ /** * HOL conclusion: - * `forall (R:(A)ra) (phi:bool) (P:A->bool) (Q:A->bool). phi ==> r_entails R P Q - * ==> r_entails R P (r_and R (r_pure R phi) Q)`. + * + * ```text + * forall (R:(A)ra) (phi:bool) (P:A->bool) (Q:A->bool). phi ==> r_entails R P Q + * ==> r_entails R P (r_and R (r_pure R phi) Q) + * ``` */ PROOF extern thm r_pure_and_intro; /** * HOL conclusion: - * `forall (R:(A)ra) (phi:bool) (P:A->bool) (Q:A->bool). (phi ==> r_entails R P - * Q) ==> r_entails R (r_and R (r_pure R phi) P) Q`. + * + * ```text + * forall (R:(A)ra) (phi:bool) (P:A->bool) (Q:A->bool). (phi ==> r_entails R P + * Q) ==> r_entails R (r_and R (r_pure R phi) P) Q + * ``` */ PROOF extern thm r_pure_and_elim; /* Exact-unit facts. The normalization laws below are `r_equiv` statements. */ /** * HOL conclusion: - * `forall (R:(A)ra) (phi:bool). r_equiv R (r_fact R phi) (r_and R (r_pure R - * phi) (r_emp R))`. + * + * ```text + * forall (R:(A)ra) (phi:bool). r_equiv R (r_fact R phi) (r_and R (r_pure R + * phi) (r_emp R)) + * ``` */ PROOF extern thm r_fact_as_pure_and_emp; -/** HOL conclusion: `forall R:(A)ra. r_equiv R (r_fact R T) (r_emp R)`. */ +/** + * HOL conclusion: + * + * ```text + * forall R:(A)ra. r_equiv R (r_fact R T) (r_emp R) + * ``` + */ PROOF extern thm r_fact_true; -/** HOL conclusion: `forall R:(A)ra. r_equiv R (r_fact R F) (r_bottom R)`. */ +/** + * HOL conclusion: + * + * ```text + * forall R:(A)ra. r_equiv R (r_fact R F) (r_bottom R) + * ``` + */ PROOF extern thm r_fact_false; /** * HOL conclusion: - * `forall (R:(A)ra) (phi:bool) (P:A->bool). r_equiv R (r_sep R (r_fact R phi) - * P) (r_and R (r_pure R phi) P)`. + * + * ```text + * forall (R:(A)ra) (phi:bool) (P:A->bool). r_equiv R (r_sep R (r_fact R phi) + * P) (r_and R (r_pure R phi) P) + * ``` */ PROOF extern thm r_fact_sep_l; /** * HOL conclusion: - * `forall (R:(A)ra) (phi:bool) (P:A->bool). r_equiv R (r_sep R P (r_fact R - * phi)) (r_and R (r_pure R phi) P)`. + * + * ```text + * forall (R:(A)ra) (phi:bool) (P:A->bool). r_equiv R (r_sep R P (r_fact R + * phi)) (r_and R (r_pure R phi) P) + * ``` */ PROOF extern thm r_fact_sep_r; /** * HOL conclusion: - * `forall (R:(A)ra) (phi:bool) (P:A->bool) (Q:A->bool). phi ==> r_entails R P Q - * ==> r_entails R P (r_sep R (r_fact R phi) Q)`. + * + * ```text + * forall (R:(A)ra) (phi:bool) (P:A->bool) (Q:A->bool). phi ==> r_entails R P Q + * ==> r_entails R P (r_sep R (r_fact R phi) Q) + * ``` */ PROOF extern thm r_fact_intro; /** * HOL conclusion: - * `forall (R:(A)ra) (phi:bool) (P:A->bool) (Q:A->bool). (phi ==> r_entails R P - * Q) ==> r_entails R (r_sep R (r_fact R phi) P) Q`. + * + * ```text + * forall (R:(A)ra) (phi:bool) (P:A->bool) (Q:A->bool). (phi ==> r_entails R P + * Q) ==> r_entails R (r_sep R (r_fact R phi) P) Q + * ``` */ PROOF extern thm r_fact_elim; /** * HOL conclusion: - * `forall (R:(A)ra) (phi:bool). r_entails R (r_fact R phi) (r_sep R (r_fact R - * phi) (r_fact R phi))`. + * + * ```text + * forall (R:(A)ra) (phi:bool). r_entails R (r_fact R phi) (r_sep R (r_fact R + * phi) (r_fact R phi)) + * ``` */ PROOF extern thm r_fact_dup; /* Exact ownership. `r_own_valid` returns validity as a spatial `r_fact`. */ -/** HOL conclusion: `forall R:(A)ra. r_equiv R (r_own R (ra_unit R)) (r_emp R)`. */ +/** + * HOL conclusion: + * + * ```text + * forall R:(A)ra. r_equiv R (r_own R (ra_unit R)) (r_emp R) + * ``` + */ PROOF extern thm r_own_unit; /** * HOL conclusion: - * `forall (R:(A)ra) (a:A) (b:A). r_equiv R (r_own R (ra_op R a b)) (r_sep R - * (r_own R a) (r_own R b))`. + * + * ```text + * forall (R:(A)ra) (a:A) (b:A). r_equiv R (r_own R (ra_op R a b)) (r_sep R + * (r_own R a) (r_own R b)) + * ``` */ PROOF extern thm r_own_op; /** * HOL conclusion: - * `forall (R:(A)ra) (a:A). r_entails R (r_own R a) (r_sep R (r_fact R (ra_valid - * R a)) (r_own R a))`. + * + * ```text + * forall (R:(A)ra) (a:A). r_entails R (r_own R a) (r_sep R (r_fact R (ra_valid + * R a)) (r_own R a)) + * ``` */ PROOF extern thm r_own_valid; /* Sound one-way distribution of `r_sep` through additive conjunction. */ /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R (r_sep R P - * (r_and R Q S)) (r_and R (r_sep R P Q) (r_sep R P S))`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R (r_sep R P + * (r_and R Q S)) (r_and R (r_sep R P Q) (r_sep R P S)) + * ``` */ PROOF extern thm r_sep_and_forward_r; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R (r_sep R - * (r_and R Q S) P) (r_and R (r_sep R Q P) (r_sep R S P))`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R (r_sep R + * (r_and R Q S) P) (r_and R (r_sep R Q P) (r_sep R S P)) + * ``` */ PROOF extern thm r_sep_and_forward_l; diff --git a/theory/logic/resource_prop_internal.h b/theory/logic/resource_prop_internal.h index 1102b3e..5be326b 100644 --- a/theory/logic/resource_prop_internal.h +++ b/theory/logic/resource_prop_internal.h @@ -14,69 +14,129 @@ #include "proof/theory/logic/resource_prop.h" /* Raw equality normalizations for separating conjunction. */ -/** HOL conclusion: `forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_sep R P Q == r_sep R Q P`. */ +/** + * HOL conclusion: + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_sep R P Q == r_sep R Q P + * ``` + */ PROOF extern thm r_sep_comm_eq; -/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_sep R (r_emp R) P == P`. */ +/** + * HOL conclusion: + * + * ```text + * forall (R:(A)ra) (P:A->bool). r_sep R (r_emp R) P == P + * ``` + */ PROOF extern thm r_sep_emp_l_eq; -/** HOL conclusion: `forall (R:(A)ra) (P:A->bool). r_sep R P (r_emp R) == P`. */ +/** + * HOL conclusion: + * + * ```text + * forall (R:(A)ra) (P:A->bool). r_sep R P (r_emp R) == P + * ``` + */ PROOF extern thm r_sep_emp_r_eq; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_sep R (r_sep R P Q) - * S == r_sep R P (r_sep R Q S)`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_sep R (r_sep R P Q) + * S == r_sep R P (r_sep R Q S) + * ``` */ PROOF extern thm r_sep_assoc_eq; /** * HOL conclusion: - * `forall (R:(A)ra) (P:B->A->bool) (Q:A->bool). r_sep R (r_exists R (\x:B. P - * x)) Q == r_exists R (\witness:B. r_sep R (P witness) Q)`. + * + * ```text + * forall (R:(A)ra) (P:B->A->bool) (Q:A->bool). r_sep R (r_exists R (\x:B. P + * x)) Q == r_exists R (\witness:B. r_sep R (P witness) Q) + * ``` */ PROOF extern thm r_sep_exists_l_eq; /** * HOL conclusion: - * `forall (R:(A)ra) (P:A->bool) (Q:B->A->bool). r_sep R P (r_exists R (\x:B. Q - * x)) == r_exists R (\witness:B. r_sep R P (Q witness))`. + * + * ```text + * forall (R:(A)ra) (P:A->bool) (Q:B->A->bool). r_sep R P (r_exists R (\x:B. Q + * x)) == r_exists R (\witness:B. r_sep R P (Q witness)) + * ``` */ PROOF extern thm r_sep_exists_r_eq; /* Adapter-only continuation schema derived from public `r_forall_elim`. */ /** * HOL conclusion: - * `forall (R:(A)ra) (P:B->A->bool) (Q:A->bool) (witness:B). r_entails R (P - * witness) Q ==> r_entails R (r_forall R (\x:B. P x)) Q`. + * + * ```text + * forall (R:(A)ra) (P:B->A->bool) (Q:A->bool) (witness:B). r_entails R (P + * witness) Q ==> r_entails R (r_forall R (\x:B. P x)) Q + * ``` */ PROOF extern thm r_forall_elim_cont; /* Raw equality normalizations for exact-unit facts. */ /** * HOL conclusion: - * `forall (R:(A)ra) (phi:bool). r_fact R phi == r_and R (r_pure R phi) (r_emp - * R)`. + * + * ```text + * forall (R:(A)ra) (phi:bool). r_fact R phi == r_and R (r_pure R phi) (r_emp + * R) + * ``` */ PROOF extern thm r_fact_as_pure_and_emp_eq; -/** HOL conclusion: `forall R:(A)ra. r_fact R T == r_emp R`. */ +/** + * HOL conclusion: + * + * ```text + * forall R:(A)ra. r_fact R T == r_emp R + * ``` + */ PROOF extern thm r_fact_true_eq; -/** HOL conclusion: `forall R:(A)ra. r_fact R F == r_bottom R`. */ +/** + * HOL conclusion: + * + * ```text + * forall R:(A)ra. r_fact R F == r_bottom R + * ``` + */ PROOF extern thm r_fact_false_eq; /** * HOL conclusion: - * `forall (R:(A)ra) (phi:bool) (P:A->bool). r_sep R (r_fact R phi) P == r_and R - * (r_pure R phi) P`. + * + * ```text + * forall (R:(A)ra) (phi:bool) (P:A->bool). r_sep R (r_fact R phi) P == r_and R + * (r_pure R phi) P + * ``` */ PROOF extern thm r_fact_sep_l_eq; /** * HOL conclusion: - * `forall (R:(A)ra) (phi:bool) (P:A->bool). r_sep R P (r_fact R phi) == r_and R - * (r_pure R phi) P`. + * + * ```text + * forall (R:(A)ra) (phi:bool) (P:A->bool). r_sep R P (r_fact R phi) == r_and R + * (r_pure R phi) P + * ``` */ PROOF extern thm r_fact_sep_r_eq; /* Raw equality normalizations for exact ownership. */ -/** HOL conclusion: `forall R:(A)ra. r_own R (ra_unit R) == r_emp R`. */ +/** + * HOL conclusion: + * + * ```text + * forall R:(A)ra. r_own R (ra_unit R) == r_emp R + * ``` + */ PROOF extern thm r_own_unit_eq; /** * HOL conclusion: - * `forall (R:(A)ra) (a:A) (b:A). r_own R (ra_op R a b) == r_sep R (r_own R a) - * (r_own R b)`. + * + * ```text + * forall (R:(A)ra) (a:A) (b:A). r_own R (ra_op R a b) == r_sep R (r_own R a) + * (r_own R b) + * ``` */ PROOF extern thm r_own_op_eq; diff --git a/theory/logic/unit_ra.h b/theory/logic/unit_ra.h index 03d978e..0e7a80c 100644 --- a/theory/logic/unit_ra.h +++ b/theory/logic/unit_ra.h @@ -11,27 +11,55 @@ /* Algebra and validity */ /* ------------------------------------------------------------------------- */ -/* `ra_unit unit_ra == one` */ +/* + * ```text + * ra_unit unit_ra == one + * ``` + */ PROOF extern thm unit_ra_unit; -/* `forall a b. ra_op unit_ra a b == one` */ +/* + * ```text + * forall a b. ra_op unit_ra a b == one + * ``` + */ PROOF extern thm unit_ra_op; -/* `forall a. ra_valid unit_ra a` */ +/* + * ```text + * forall a. ra_valid unit_ra a + * ``` + */ PROOF extern thm unit_ra_valid; -/* `forall a b. ra_included unit_ra a b` */ +/* + * ```text + * forall a b. ra_included unit_ra a b + * ``` + */ PROOF extern thm unit_ra_included; -/* `forall a. ra_maximal unit_ra a` */ +/* + * ```text + * forall a. ra_maximal unit_ra a + * ``` + */ PROOF extern thm unit_ra_maximal; /* ------------------------------------------------------------------------- */ /* Updates */ /* ------------------------------------------------------------------------- */ -/* `forall a P. ra_updateP unit_ra a P <=> P one` */ +/* + * ```text + * forall a P. ra_updateP unit_ra a P <=> P one + * ``` + */ PROOF extern thm unit_ra_updateP_iff; -/* `forall a f b g. ra_local_update unit_ra a f b g` */ +/* + * ```text + * forall a f b g. ra_local_update unit_ra a f b g + * ``` + */ PROOF extern thm unit_ra_local_update; -- Gitee From b170e2088d07dc35814b32e521a35b8aed5740d4 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Tue, 11 Aug 2026 13:48:22 +0800 Subject: [PATCH 34/35] Add Chinese explanations for theorem docs --- proof_sl.h | 34 ++++++ theory/c_program_logic/c_basic_update.h | 6 ++ theory/c_program_logic/c_ghost.h | 24 +++++ theory/c_program_logic/c_integer.h | 66 ++++++++++++ theory/c_program_logic/c_memory.h | 54 ++++++++++ theory/c_program_logic/c_resource.h | 18 ++++ theory/c_program_logic/c_types.h | 4 + theory/c_program_logic/mem_own.h | 6 ++ theory/c_program_logic/mem_ra.h | 24 +++++ theory/c_program_logic/mem_value.h | 48 +++++++++ theory/data/int_list.h | 26 +++++ theory/data/list.h | 8 ++ theory/logic/agree_ra.h | 24 +++++ theory/logic/auth_ra.h | 46 ++++++++ theory/logic/basic_update.h | 30 ++++++ theory/logic/big_sep.h | 18 ++++ theory/logic/excl_ra.h | 20 ++++ theory/logic/excl_ra_internal.h | 12 +++ theory/logic/finmap.h | 104 ++++++++++++++++++ theory/logic/frac_ra.h | 16 +++ theory/logic/gmap_ra.h | 30 ++++++ theory/logic/gmap_ra_internal.h | 10 ++ theory/logic/local_update.h | 20 ++++ theory/logic/max_nat_ra.h | 12 +++ theory/logic/named_logic.h | 14 +++ theory/logic/named_ra.h | 16 +++ theory/logic/option_ra.h | 26 +++++ theory/logic/option_ra_internal.h | 6 ++ theory/logic/prod_ra.h | 36 +++++++ theory/logic/prod_ra_internal.h | 2 + theory/logic/product_resource.h | 48 +++++++++ theory/logic/product_resource_internal.h | 8 ++ theory/logic/ra.h | 78 ++++++++++++++ theory/logic/ra_builder.h | 16 +++ theory/logic/ra_internal.h | 26 +++++ theory/logic/resource_prop.h | 128 +++++++++++++++++++++++ theory/logic/resource_prop_internal.h | 28 +++++ theory/logic/unit_ra.h | 14 +++ 38 files changed, 1106 insertions(+) diff --git a/proof_sl.h b/proof_sl.h index 35e13f7..17bf51f 100644 --- a/proof_sl.h +++ b/proof_sl.h @@ -759,6 +759,8 @@ PROOF term dest_sl_fact(const term tm); * ```text * forall (H:sl_prop()) (K:sl_prop()). (H = K) ==> (H ⊢SL K) * ``` + * + * 中文说明：说明断言的 HOL 等式可以转换为对应的 SL 蕴含。 */ PROOF extern thm sl_ent_sym_left; @@ -774,6 +776,8 @@ PROOF extern thm sl_ent_sym_left; * HOL conclusion in the installed notation: * `forall (H:sl_prop()) (H1:sl_prop()) (K:sl_prop()) (K1:sl_prop()). * (H = H1) ==> (K = K1) ==> (H1 ⊢SL K1) ==> (H ⊢SL K)`. + * + * 中文说明：说明逻辑蕴含的组合、改写或框架规则。 */ PROOF extern thm sl_ent_restate; @@ -790,6 +794,8 @@ PROOF extern thm sl_ent_restate; * `forall (H:sl_prop()) (F:sl_prop()) (H1:sl_prop()) (K:sl_prop()) * (K1:sl_prop()). (H = F ** H1) ==> (K = F ** K1) ==> (H1 ⊢SL K1) ==> * (H ⊢SL K)`. + * + * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 */ PROOF extern thm sl_frame_restate; @@ -802,6 +808,8 @@ PROOF extern thm sl_frame_restate; * forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). (H ⊢SL K) ==> * (F ** H ⊢SL F ** K) * ``` + * + * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 */ PROOF extern thm sl_ent_frame_left; @@ -814,6 +822,8 @@ PROOF extern thm sl_ent_frame_left; * forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). (H ⊢SL K) ==> * (H ** F ⊢SL K ** F) * ``` + * + * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 */ PROOF extern thm sl_ent_frame_right; @@ -830,6 +840,8 @@ PROOF extern thm sl_ent_frame_right; * `forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()) (C:sl_prop()) * (G:sl_prop()). (H = K) ==> (C = K ** F) ==> (C ⊢SL G) ==> * (H ** F ⊢SL G)`. + * + * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 */ PROOF extern thm sl_ent_subst_frame; @@ -846,6 +858,8 @@ PROOF extern thm sl_ent_subst_frame; * `forall (H:sl_prop()) (H1:sl_prop()) (H2:sl_prop()) (K:sl_prop()) * (K1:sl_prop()) (K2:sl_prop()). (H = H1 ** H2) ==> (K = K1 ** K2) ==> * (H1 ⊢SL K1) ==> (H2 ⊢SL K2) ==> (H ⊢SL K)`. + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm sl_sep_combine; @@ -864,6 +878,8 @@ PROOF extern thm sl_sep_combine; * The conjunction order is commutativity, associativity, then lifted * commutativity. Pass this theorem to `ac_rule`; units are not part of this * AC theory. + * + * 中文说明：汇总 sep 的交换律、结合律和提升交换律，供 AC 归一化使用。 */ PROOF extern thm sl_ac_rule; @@ -876,6 +892,8 @@ PROOF extern thm sl_ac_rule; * forall (H1:sl_prop()) (H2:sl_prop()) (K1:sl_prop()) (K2:sl_prop()). * (H1 ⊢SL K1) ==> (H2 ⊢SL K2) ==> ((H1 || H2) ⊢SL (K1 || K2)) * ``` + * + * 中文说明：说明该构造对蕴含或底层关系保持单调。 */ PROOF extern thm sl_disj_mono; @@ -894,6 +912,8 @@ PROOF extern thm sl_disj_mono; * (C2:sl_prop()) (P:sl_prop()) (G:sl_prop()). (C1 = H ** F) ==> * (C2 = K ** F) ==> (P = (H || K) ** F) ==> (C1 ⊢SL G) ==> * (C2 ⊢SL G) ==> (P ⊢SL G)`. + * + * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 */ PROOF extern thm sl_or_elim_frame; @@ -906,6 +926,8 @@ PROOF extern thm sl_or_elim_frame; * forall (H:sl_prop()) (K:sl_prop()) (G:sl_prop()). * (H ⊢SL (K -* G)) ==> (H ** K ⊢SL G) * ``` + * + * 中文说明：说明 SL 证明规则如何组合、改写或规范化蕴含。 */ PROOF extern thm sl_undisch; @@ -918,6 +940,8 @@ PROOF extern thm sl_undisch; * forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). * (H ⊢SL (K && F)) ==> (H ⊢SL K) * ``` + * + * 中文说明：说明加法合取的引入、投影或分配规则。 */ PROOF extern thm sl_conj1; @@ -930,6 +954,8 @@ PROOF extern thm sl_conj1; * forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). * (H ⊢SL (K && F)) ==> (H ⊢SL F) * ``` + * + * 中文说明：说明加法合取的引入、投影或分配规则。 */ PROOF extern thm sl_conj2; @@ -942,6 +968,8 @@ PROOF extern thm sl_conj2; * forall (H:sl_prop()) (K:sl_prop()) (F:sl_prop()). * (H ⊢SL K) ==> (H ⊢SL (K || F)) * ``` + * + * 中文说明：说明该构造对蕴含或底层关系保持单调。 */ PROOF extern thm sl_disj1_mono; @@ -954,6 +982,8 @@ PROOF extern thm sl_disj1_mono; * forall (F:sl_prop()) (H:sl_prop()) (K:sl_prop()). * (H ⊢SL K) ==> (H ⊢SL (F || K)) * ``` + * + * 中文说明：说明该构造对蕴含或底层关系保持单调。 */ PROOF extern thm sl_disj2_mono; @@ -967,6 +997,8 @@ PROOF extern thm sl_disj2_mono; * HOL conclusion in the installed notation: * `forall (B:A->sl_prop()) (F:sl_prop()) (K:sl_prop()). * (forall x:A. B x ** F ⊢SL K) ==> ((∃SL x:A. B x) ** F ⊢SL K)`. + * + * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 */ PROOF extern thm sl_exists_elim_frame; @@ -979,6 +1011,8 @@ PROOF extern thm sl_exists_elim_frame; * forall (w:A) (H:sl_prop()) (B:A->sl_prop()). * (H ⊢SL B w) ==> (H ⊢SL ∃SL x:A. B x) * ``` + * + * 中文说明：说明存在量词的引入、消去、单调性或与 sep 的交换。 */ PROOF extern thm sl_exists_wit; diff --git a/theory/c_program_logic/c_basic_update.h b/theory/c_program_logic/c_basic_update.h index d31e448..1035a5d 100644 --- a/theory/c_program_logic/c_basic_update.h +++ b/theory/c_program_logic/c_basic_update.h @@ -17,6 +17,8 @@ * ```text * c_bupd (G:(A)ra) == r_bupd_right mem_ra G * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm c_bupd_def; @@ -24,6 +26,8 @@ PROOF extern thm c_bupd_def; * ```text * c_viewshift (G:(A)ra) == r_viewshift_right mem_ra G * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm c_viewshift_def; @@ -39,5 +43,7 @@ PROOF extern thm c_viewshift_def; * c_bupd G Q resource ==> * exists ghost':A. Q (FST resource,ghost') * ``` + * + * 中文说明：说明 C basic update 只更新 ghost 投影，不改变物理内存投影。 */ PROOF extern thm c_bupd_preserves_phys; diff --git a/theory/c_program_logic/c_ghost.h b/theory/c_program_logic/c_ghost.h index 4bf3f29..b099023 100644 --- a/theory/c_program_logic/c_ghost.h +++ b/theory/c_program_logic/c_ghost.h @@ -27,6 +27,8 @@ * (r_sep (c_resource_ra G) * (c_ghost_own G a) (c_ghost_own G b)) * ``` + * + * 中文说明：说明精确所有权如何反映 RA 的单位元、运算或有效性。 */ PROOF extern thm c_ghost_own_op; @@ -40,6 +42,8 @@ PROOF extern thm c_ghost_own_op; * (r_fact (c_resource_ra G) (ra_valid G a)) * (c_ghost_own G a)) * ``` + * + * 中文说明：说明该资源或构造满足相应的有效性条件。 */ PROOF extern thm c_ghost_own_valid; @@ -49,6 +53,8 @@ PROOF extern thm c_ghost_own_valid; * ra_update G a b ==> * c_viewshift G (c_ghost_own G a) (c_ghost_own G b) * ``` + * + * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 */ PROOF extern thm c_ghost_own_update; @@ -63,6 +69,8 @@ PROOF extern thm c_ghost_own_update; * (r_fact (c_resource_ra G) (P b)) * (c_ghost_own G b))) * ``` + * + * 中文说明：说明 C ghost 谓词更新返回新 witness、fact 与更新后的所有权。 */ PROOF extern thm c_ghost_own_updateP; @@ -73,6 +81,8 @@ PROOF extern thm c_ghost_own_updateP; * (c_ghost_own G a) * (r_emp (c_resource_ra G)) * ``` + * + * 中文说明：说明当前拥有的片段可以被丢弃为单位资源。 */ PROOF extern thm c_ghost_own_drop; @@ -88,6 +98,8 @@ PROOF extern thm c_ghost_own_drop; * c_named_own (R:(A)ra) (name:num) (a:A) = * c_ghost_own (named_ra R) (finmap_singleton name a) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm c_named_own_def; @@ -101,6 +113,8 @@ PROOF extern thm c_named_own_def; * (c_named_own R name a) * (c_named_own R name b)) * ``` + * + * 中文说明：说明 C 命名所有权在固定名字下的组合、有效性或更新规则。 */ PROOF extern thm c_named_own_op; @@ -114,6 +128,8 @@ PROOF extern thm c_named_own_op; * (r_fact (c_resource_ra (named_ra R)) (ra_valid R a)) * (c_named_own R name a)) * ``` + * + * 中文说明：说明 C 命名所有权在固定名字下的组合、有效性或更新规则。 */ PROOF extern thm c_named_own_valid; @@ -125,6 +141,8 @@ PROOF extern thm c_named_own_valid; * (c_named_own R name a) * (c_named_own R name b) * ``` + * + * 中文说明：说明 C 命名所有权在固定名字下的组合、有效性或更新规则。 */ PROOF extern thm c_named_own_update; @@ -139,6 +157,8 @@ PROOF extern thm c_named_own_update; * (r_fact (c_resource_ra (named_ra R)) (P b)) * (c_named_own R name b))) * ``` + * + * 中文说明：说明 C 命名所有权在固定名字下的组合、有效性或更新规则。 */ PROOF extern thm c_named_own_updateP; @@ -149,6 +169,8 @@ PROOF extern thm c_named_own_updateP; * (c_named_own R name a) * (r_emp (c_resource_ra (named_ra R))) * ``` + * + * 中文说明：说明可通过 C view shift 丢弃当前固定名字的 singleton 片段。 */ PROOF extern thm c_named_own_drop; @@ -166,5 +188,7 @@ PROOF extern thm c_named_own_drop; * (c_named_own R name a) * P)) * ``` + * + * 中文说明：说明 C 逻辑可分配新名字，并把命名所有权与原断言分离组合。 */ PROOF extern thm c_named_own_alloc; diff --git a/theory/c_program_logic/c_integer.h b/theory/c_program_logic/c_integer.h index 27e496e..f796f1e 100644 --- a/theory/c_program_logic/c_integer.h +++ b/theory/c_program_logic/c_integer.h @@ -18,30 +18,40 @@ * ```text * exp_2 (width:int) = &(2 EXP num_of_int width) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm c_exp_2_def; /** * ```text * max_unsigned (width:int) = exp_2 width - &1 * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm c_max_unsigned_def; /** * ```text * max_signed (width:int) = exp_2 (width - &1) - &1 * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm c_max_signed_def; /** * ```text * min_signed (width:int) = --(exp_2 (width - &1)) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm c_min_signed_def; /** * ```text * cast_unsigned (width:int) (value:int) = value rem exp_2 width * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm cast_unsigned_def; @@ -53,6 +63,8 @@ PROOF extern thm cast_unsigned_def; * then unsigned_value * else unsigned_value - exp_2 width. * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm cast_signed_def; @@ -61,6 +73,8 @@ PROOF extern thm cast_signed_def; * unsigned_last_nbits (value:int) (width:int) = * cast_unsigned width value * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm unsigned_last_nbits_def; @@ -69,6 +83,8 @@ PROOF extern thm unsigned_last_nbits_def; * signed_last_nbits (value:int) (width:int) = * cast_signed width value * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm signed_last_nbits_def; @@ -80,6 +96,8 @@ PROOF extern thm signed_last_nbits_def; * &0 <= value && value < exp_2 width ==> * unsigned_last_nbits value width = value * ``` + * + * 中文说明：给出固定宽度 C 整数运算或转换的精确计算规则。 */ PROOF extern thm unsigned_last_nbits_id; @@ -92,6 +110,8 @@ PROOF extern thm unsigned_last_nbits_id; * i32_and (x:int) (y:int) = * ival (word_and ((iword x):(32)word) ((iword y):(32)word)) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm i32_and_def; @@ -100,6 +120,8 @@ PROOF extern thm i32_and_def; * i32_or (x:int) (y:int) = * ival (word_or ((iword x):(32)word) ((iword y):(32)word)) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm i32_or_def; @@ -108,6 +130,8 @@ PROOF extern thm i32_or_def; * i32_xor (x:int) (y:int) = * ival (word_xor ((iword x):(32)word) ((iword y):(32)word)) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm i32_xor_def; @@ -115,6 +139,8 @@ PROOF extern thm i32_xor_def; * ```text * i32_not (x:int) = ival (word_not ((iword x):(32)word)) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm i32_not_def; @@ -123,6 +149,8 @@ PROOF extern thm i32_not_def; * i32_shl (x:int) (y:int) = * ival (word_shl ((iword x):(32)word) (num_of_int y)) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm i32_shl_def; @@ -131,6 +159,8 @@ PROOF extern thm i32_shl_def; * i32_shr (x:int) (y:int) = * ival (word_ishr ((iword x):(32)word) (num_of_int y)) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm i32_shr_def; @@ -139,6 +169,8 @@ PROOF extern thm i32_shr_def; * u32_and (x:int) (y:int) = * &(val (word_and ((iword x):(32)word) ((iword y):(32)word))) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm u32_and_def; @@ -147,6 +179,8 @@ PROOF extern thm u32_and_def; * u32_or (x:int) (y:int) = * &(val (word_or ((iword x):(32)word) ((iword y):(32)word))) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm u32_or_def; @@ -155,6 +189,8 @@ PROOF extern thm u32_or_def; * u32_xor (x:int) (y:int) = * &(val (word_xor ((iword x):(32)word) ((iword y):(32)word))) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm u32_xor_def; @@ -162,6 +198,8 @@ PROOF extern thm u32_xor_def; * ```text * u32_not (x:int) = &(val (word_not ((iword x):(32)word))) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm u32_not_def; @@ -170,6 +208,8 @@ PROOF extern thm u32_not_def; * u32_shl (x:int) (y:int) = * &(val (word_shl ((iword x):(32)word) (num_of_int y))) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm u32_shl_def; @@ -178,6 +218,8 @@ PROOF extern thm u32_shl_def; * u32_shr (x:int) (y:int) = * &(val (word_ushr ((iword x):(32)word) (num_of_int y))) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm u32_shr_def; @@ -186,6 +228,8 @@ PROOF extern thm u32_shr_def; * i64_and (x:int) (y:int) = * ival (word_and ((iword x):(64)word) ((iword y):(64)word)) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm i64_and_def; @@ -194,6 +238,8 @@ PROOF extern thm i64_and_def; * i64_or (x:int) (y:int) = * ival (word_or ((iword x):(64)word) ((iword y):(64)word)) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm i64_or_def; @@ -202,6 +248,8 @@ PROOF extern thm i64_or_def; * i64_xor (x:int) (y:int) = * ival (word_xor ((iword x):(64)word) ((iword y):(64)word)) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm i64_xor_def; @@ -209,6 +257,8 @@ PROOF extern thm i64_xor_def; * ```text * i64_not (x:int) = ival (word_not ((iword x):(64)word)) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm i64_not_def; @@ -217,6 +267,8 @@ PROOF extern thm i64_not_def; * i64_shl (x:int) (y:int) = * ival (word_shl ((iword x):(64)word) (num_of_int y)) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm i64_shl_def; @@ -225,6 +277,8 @@ PROOF extern thm i64_shl_def; * i64_shr (x:int) (y:int) = * ival (word_ishr ((iword x):(64)word) (num_of_int y)) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm i64_shr_def; @@ -233,6 +287,8 @@ PROOF extern thm i64_shr_def; * u64_and (x:int) (y:int) = * &(val (word_and ((iword x):(64)word) ((iword y):(64)word))) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm u64_and_def; @@ -241,6 +297,8 @@ PROOF extern thm u64_and_def; * u64_or (x:int) (y:int) = * &(val (word_or ((iword x):(64)word) ((iword y):(64)word))) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm u64_or_def; @@ -249,6 +307,8 @@ PROOF extern thm u64_or_def; * u64_xor (x:int) (y:int) = * &(val (word_xor ((iword x):(64)word) ((iword y):(64)word))) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm u64_xor_def; @@ -256,6 +316,8 @@ PROOF extern thm u64_xor_def; * ```text * u64_not (x:int) = &(val (word_not ((iword x):(64)word))) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm u64_not_def; @@ -264,6 +326,8 @@ PROOF extern thm u64_not_def; * u64_shl (x:int) (y:int) = * &(val (word_shl ((iword x):(64)word) (num_of_int y))) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm u64_shl_def; @@ -272,5 +336,7 @@ PROOF extern thm u64_shl_def; * u64_shr (x:int) (y:int) = * &(val (word_ushr ((iword x):(64)word) (num_of_int y))) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm u64_shr_def; diff --git a/theory/c_program_logic/c_memory.h b/theory/c_program_logic/c_memory.h index 33bff26..4cdd2a9 100644 --- a/theory/c_program_logic/c_memory.h +++ b/theory/c_program_logic/c_memory.h @@ -59,6 +59,8 @@ * It is deliberately a proof-side normalization rule. Clients specialize a * memory theorem to a concrete `ctype`, rewrite with this theorem, and only * then expose the resulting `ctype`-free assertion to QCP. + * + * 中文说明：说明不同 C 类型构造子互不相等，可用于具体类型的归一化。 */ PROOF extern thm pmem_ctype_distinct; @@ -76,6 +78,8 @@ PROOF extern thm pmem_ctype_distinct; * * In particular every `Tstruct name fields types` and * `Tfun argument_names argument_types return_type` yields false. + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm pmem_c_scalar_type_def; @@ -92,6 +96,8 @@ PROOF extern thm pmem_c_scalar_type_def; * if ty == Tuint64 then 8 else * if ty == Tptr then 8 else 0 * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm pmem_c_width_def; @@ -108,6 +114,8 @@ PROOF extern thm pmem_c_width_def; * if ty == Tuint64 then &0 else * if ty == Tptr then &0 else &0 * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm pmem_c_min_def; @@ -124,6 +132,8 @@ PROOF extern thm pmem_c_min_def; * if ty == Tuint64 then &18446744073709551615 else * if ty == Tptr then &18446744073709551615 else &0 * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm pmem_c_max_def; @@ -141,6 +151,8 @@ PROOF extern thm pmem_c_max_def; * * Thus the complete byte interval is in the concrete 64-bit address space * and the base is naturally aligned to the scalar width. + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm pmem_c_address_ok_def; @@ -153,6 +165,8 @@ PROOF extern thm pmem_c_address_ok_def; * * The unary predicate avoids placing a `ctype` term inside an ordinary QCP * pure predicate. + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm pmem_uint64_address_ok_def; @@ -161,6 +175,8 @@ PROOF extern thm pmem_uint64_address_ok_def; * pmem_ptr_address_ok (address:int) <=> * pmem_c_address_ok address Tptr * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm pmem_ptr_address_ok_def; @@ -173,6 +189,8 @@ PROOF extern thm pmem_ptr_address_ok_def; * pmem_c_min ty <= integer_value ∧ * integer_value <= pmem_c_max ty. * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm pmem_c_value_ok_def; @@ -189,6 +207,8 @@ PROOF extern thm pmem_c_value_ok_def; * In particular, ownership of eight consecutive bytes does not imply this * theorem's alignment conjunct; callers carving a typed cell must establish * it as a separate resource-independent HOL side condition. + * + * 中文说明：把 Tuint64 地址有效性展开为范围、八字节跨度与八字节对齐条件。 */ PROOF extern thm pmem_c_address_ok_Tuint64; @@ -210,6 +230,8 @@ PROOF extern thm pmem_c_address_ok_Tuint64; * * The second conjunct owns the exact little-endian bytes; the first imposes * the C ABI side conditions without consuming a second resource. + * + * 中文说明：说明 data-at 同时携带地址与取值约束以及精确字节所有权。 */ PROOF extern thm pmem_data_at_def; @@ -227,6 +249,8 @@ PROOF extern thm pmem_data_at_def; * grants writable ownership but no readable value; QCP therefore permits an * overwriting store but not a load. `pmem_undef_scalar_at` remains available * separately when strict physical uninitialization matters to a proof. + * + * 中文说明：说明 undef-data-at 只保证可写的已分配字节，不保证物理未初始化。 */ PROOF extern thm pmem_undef_data_at_def; @@ -237,6 +261,8 @@ PROOF extern thm pmem_undef_data_at_def; * (pmem_data_at address ty integer_value) * (pmem_allocated_at address (pmem_c_width ty)) * ``` + * + * 中文说明：说明物理 data-at 所有权可遗忘为 allocated 区域。 */ PROOF extern thm pmem_data_at_allocated_at; @@ -247,6 +273,8 @@ PROOF extern thm pmem_data_at_allocated_at; * (pmem_undef_data_at address ty) * (pmem_allocated_at address (pmem_c_width ty)) * ``` + * + * 中文说明：说明物理 undef-data-at 所有权可遗忘为 allocated 区域。 */ PROOF extern thm pmem_undef_data_at_allocated_at; @@ -261,6 +289,8 @@ PROOF extern thm pmem_undef_data_at_allocated_at; * (pmem_allocated_at address (pmem_c_width ty)) * (pmem_undef_data_at address ty) * ``` + * + * 中文说明：说明满足地址约束的物理 allocated 区域可视为 undef-data-at。 */ PROOF extern thm pmem_allocated_at_to_undef_data_at; @@ -271,6 +301,8 @@ PROOF extern thm pmem_allocated_at_to_undef_data_at; * (pmem_data_at address ty integer_value) * (pmem_undef_data_at address ty) * ``` + * + * 中文说明：说明物理 data-at 可遗忘具体值而视为 undef-data-at。 */ PROOF extern thm pmem_data_at_to_undef_data_at; @@ -283,6 +315,8 @@ PROOF extern thm pmem_data_at_to_undef_data_at; * pmem_undef_scalar_at address 8 ⊢_mem * pmem_undef_data_at address Tuint64. * ``` + * + * 中文说明：说明满足地址约束时，八个严格未初始化字节可视为 Tuint64 的 undef-data-at。 */ PROOF extern thm pmem_undef_scalar_at_Tuint64; @@ -299,6 +333,8 @@ PROOF extern thm pmem_undef_scalar_at_Tuint64; * c_allocated_at G address count == * c_lift_phys G (pmem_allocated_at address count). * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm c_allocated_at_def; @@ -309,6 +345,8 @@ PROOF extern thm c_allocated_at_def; * c_data_at G address ty integer_value == * c_lift_phys G (pmem_data_at address ty integer_value). * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm c_data_at_def; @@ -319,6 +357,8 @@ PROOF extern thm c_data_at_def; * c_undef_data_at G address ty == * c_lift_phys G (pmem_undef_data_at address ty). * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm c_undef_data_at_def; @@ -329,6 +369,8 @@ PROOF extern thm c_undef_data_at_def; * ``` * This is a raw equation for the named memory predicate, not a generic BI * connective law. + * + * 中文说明：说明零长度的 C allocated 区域等价于 emp。 */ PROOF extern thm c_allocated_at_zero; @@ -345,6 +387,8 @@ PROOF extern thm c_allocated_at_zero; * * The equation only regroups the same physical byte range. It adds neither * C typing nor initialization information. + * + * 中文说明：说明相邻的 C allocated 区域可通过 sep 合并为一个区域。 */ PROOF extern thm c_allocated_at_append; @@ -356,6 +400,8 @@ PROOF extern thm c_allocated_at_append; * (c_allocated_at G address (pmem_c_width ty)) * (c_undef_data_at G address ty) * ``` + * + * 中文说明：说明满足地址约束的 C allocated 区域可视为 undef-data-at。 */ PROOF extern thm c_allocated_at_to_undef_data_at; @@ -366,6 +412,8 @@ PROOF extern thm c_allocated_at_to_undef_data_at; * (c_data_at G address ty integer_value) * (c_undef_data_at G address ty) * ``` + * + * 中文说明：说明完整 C data-at 可遗忘具体值而视为 undef-data-at。 */ PROOF extern thm c_data_at_to_undef_data_at; @@ -376,6 +424,8 @@ PROOF extern thm c_data_at_to_undef_data_at; * (c_data_at G address ty integer_value) * (c_allocated_at G address (pmem_c_width ty)) * ``` + * + * 中文说明：说明精确 C data-at 所有权可遗忘为 allocated 区域。 */ PROOF extern thm c_data_at_allocated_at; @@ -386,6 +436,8 @@ PROOF extern thm c_data_at_allocated_at; * (c_undef_data_at G address ty) * (c_allocated_at G address (pmem_c_width ty)) * ``` + * + * 中文说明：说明 C undef-data-at 所有权可遗忘为 allocated 区域。 */ PROOF extern thm c_undef_data_at_allocated_at; @@ -413,5 +465,7 @@ PROOF extern thm c_undef_data_at_allocated_at; * * `r_fact`, rather than resource-independent `r_pure`, makes the exposed * bounds an exact-unit spatial conjunct. + * + * 中文说明：说明 C data-at 可在保留单元所有权的同时导出取值上下界 fact。 */ PROOF extern thm c_data_at_value_range; diff --git a/theory/c_program_logic/c_resource.h b/theory/c_program_logic/c_resource.h index 02f7e4f..ffb2101 100644 --- a/theory/c_program_logic/c_resource.h +++ b/theory/c_program_logic/c_resource.h @@ -33,6 +33,8 @@ * ``` * Both sides have type * `(((int,(pmem_byte_state)excl)finmap)#A)ra`. + * + * 中文说明：说明完整 C 资源由物理内存 RA 与完整 ghost RA 的乘积组成。 */ PROOF extern thm c_resource_ra_def; @@ -41,6 +43,8 @@ PROOF extern thm c_resource_ra_def; * forall G:(A)ra. ra_unit (c_resource_ra G) == * (ra_unit mem_ra,ra_unit G) * ``` + * + * 中文说明：说明完整 C 资源的单位元由内存 unit 与 ghost unit 配对组成。 */ PROOF extern thm c_resource_ra_unit; @@ -52,6 +56,8 @@ PROOF extern thm c_resource_ra_unit; * ra_op G (SND x) (SND y)) * ``` * Here `Mem` abbreviates `(int,(pmem_byte_state)excl)finmap`. + * + * 中文说明：说明完整 C 资源的组合运算分别作用于物理与 ghost 投影。 */ PROOF extern thm c_resource_ra_op; @@ -63,6 +69,8 @@ PROOF extern thm c_resource_ra_op; * ra_valid G (SND resource) * ``` * Here `Mem` abbreviates `(int,(pmem_byte_state)excl)finmap`. + * + * 中文说明：说明完整 C 资源有效，当且仅当物理与 ghost 投影分别有效。 */ PROOF extern thm c_resource_ra_valid; @@ -74,6 +82,8 @@ PROOF extern thm c_resource_ra_valid; * ``` * * Here `Mem` abbreviates `(int,(pmem_byte_state)excl)finmap`. + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm c_lift_phys_def; @@ -82,6 +92,8 @@ PROOF extern thm c_lift_phys_def; * c_lift_ghost (G:(A)ra) (Q:A->bool) = * r_lift_right mem_ra G Q * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm c_lift_ghost_def; @@ -91,6 +103,8 @@ PROOF extern thm c_lift_ghost_def; * c_ghost_own (G:(A)ra) (ghost:A) = * c_lift_ghost G (r_own G ghost) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm c_ghost_own_def; @@ -100,6 +114,8 @@ PROOF extern thm c_ghost_own_def; * c_pmem_uninit_at (G:(A)ra) (address:int) = * c_lift_phys G (r_own mem_ra (pmem_uninit address)) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm c_pmem_uninit_at_def; @@ -108,5 +124,7 @@ PROOF extern thm c_pmem_uninit_at_def; * c_pmem_byte_at (G:(A)ra) (address:int) (byte:int) = * c_lift_phys G (r_own mem_ra (pmem_byte address byte)) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm c_pmem_byte_at_def; diff --git a/theory/c_program_logic/c_types.h b/theory/c_program_logic/c_types.h index fd7efb9..4a611d0 100644 --- a/theory/c_program_logic/c_types.h +++ b/theory/c_program_logic/c_types.h @@ -47,6 +47,8 @@ PROOF extern indtype ctype_type; * sizeof (Tstruct name field_names field_types) = * &(c_struct_size name field_names field_types)) * ``` + * + * 中文说明：给出各类 C 类型的大小计算规则。 */ PROOF extern thm sizeof_def; @@ -55,5 +57,7 @@ PROOF extern thm sizeof_def; * field_addr (base:int) (structure:struct_name) (field_name:field) == * base + field_offset structure field_name * ``` + * + * 中文说明：说明字段地址等于结构体基址加字段偏移。 */ PROOF extern thm field_addr_prop; diff --git a/theory/c_program_logic/mem_own.h b/theory/c_program_logic/mem_own.h index 3870496..54d4473 100644 --- a/theory/c_program_logic/mem_own.h +++ b/theory/c_program_logic/mem_own.h @@ -23,6 +23,8 @@ * ```text * pmem_own memory == r_own mem_ra memory * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm pmem_own_def; @@ -32,6 +34,8 @@ PROOF extern thm pmem_own_def; * ```text * pmem_uninit_at address == pmem_own (pmem_uninit address) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm pmem_uninit_at_def; @@ -42,5 +46,7 @@ PROOF extern thm pmem_uninit_at_def; * pmem_byte_at address byte == * pmem_own (pmem_byte address byte) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm pmem_byte_at_def; diff --git a/theory/c_program_logic/mem_ra.h b/theory/c_program_logic/mem_ra.h index 71cd62c..0a220bf 100644 --- a/theory/c_program_logic/mem_ra.h +++ b/theory/c_program_logic/mem_ra.h @@ -49,6 +49,8 @@ PROOF extern indtype pmem_byte_state_type; * ```text * ⊢ mem_ra == gmap_ra (excl_ra : ((pmem_byte_state)excl)ra). * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm mem_ra_def; @@ -59,6 +61,8 @@ PROOF extern thm mem_ra_def; * ⊢ ra_unit mem_ra = * (finmap_empty : (int,(pmem_byte_state)excl)finmap). * ``` + * + * 中文说明：说明物理内存 RA 的单位元是空有限映射。 */ PROOF extern thm mem_ra_unit; @@ -72,6 +76,8 @@ PROOF extern thm mem_ra_unit; * (finmap_lookup left address) * (finmap_lookup right address). * ``` + * + * 中文说明：说明内存组合在每个地址上按 option/exclusive 运算逐点计算。 */ PROOF extern thm mem_ra_op_lookup; @@ -85,6 +91,8 @@ PROOF extern thm mem_ra_op_lookup; * ra_valid (option_ra (excl_ra : ((pmem_byte_state)excl)ra)) * (finmap_lookup memory address). * ``` + * + * 中文说明：说明内存有限映射有效，当且仅当每个地址的 option/exclusive 条目有效。 */ PROOF extern thm mem_ra_valid; @@ -99,6 +107,8 @@ PROOF extern thm mem_ra_valid; * pmem_singleton address state == * finmap_singleton address (Excl state) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm pmem_singleton_def; @@ -109,6 +119,8 @@ PROOF extern thm pmem_singleton_def; * pmem_uninit address == * pmem_singleton address PMemUninit * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm pmem_uninit_def; @@ -119,6 +131,8 @@ PROOF extern thm pmem_uninit_def; * pmem_byte address byte == * pmem_singleton address (PMemByte byte) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm pmem_byte_def; @@ -126,6 +140,8 @@ PROOF extern thm pmem_byte_def; * ```text * ⊢ ∀address state. ra_valid mem_ra (pmem_singleton address state) * ``` + * + * 中文说明：说明该资源或构造满足相应的有效性条件。 */ PROOF extern thm pmem_singleton_valid; @@ -139,6 +155,8 @@ PROOF extern thm pmem_singleton_valid; * (ra_op mem_ra (pmem_singleton address left) * (pmem_singleton address right)). * ``` + * + * 中文说明：说明同一地址上的两个 owned 单点内存片段组合后无效。 */ PROOF extern thm pmem_singleton_overlap_invalid; @@ -158,6 +176,8 @@ PROOF extern thm pmem_singleton_overlap_invalid; * ⊢ ∀address byte. ra_update mem_ra (pmem_uninit address) * (pmem_byte address byte) * ``` + * + * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 */ PROOF extern thm pmem_update_uninit_byte; @@ -166,6 +186,8 @@ PROOF extern thm pmem_update_uninit_byte; * ⊢ ∀address byte. ra_update mem_ra (pmem_byte address byte) * (pmem_uninit address) * ``` + * + * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 */ PROOF extern thm pmem_update_byte_uninit; @@ -175,5 +197,7 @@ PROOF extern thm pmem_update_byte_uninit; * ra_update mem_ra (pmem_byte address old_byte) * (pmem_byte address new_byte) * ``` + * + * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 */ PROOF extern thm pmem_update_byte_byte; diff --git a/theory/c_program_logic/mem_value.h b/theory/c_program_logic/mem_value.h index 4bbb9cd..a70eeb9 100644 --- a/theory/c_program_logic/mem_value.h +++ b/theory/c_program_logic/mem_value.h @@ -47,6 +47,8 @@ * also the per-byte basis of unknown-content `pmem_undef_data_at`; despite that * later name, only `pmem_undef_scalar_at` guarantees physical `PMemUninit` * states. + * + * 中文说明：说明 allocated byte 隐藏初始化状态，只保证拥有该地址的一字节。 */ PROOF extern thm pmem_allocated_byte_at_def; @@ -60,6 +62,8 @@ PROOF extern thm pmem_allocated_byte_at_def; * (pmem_byte_at base byte) * (pmem_bytes_at (base + &1) bytes). * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm pmem_bytes_at_def; @@ -69,6 +73,8 @@ PROOF extern thm pmem_bytes_at_def; * ```text * ⊢ ∀base. pmem_bytes_at base [] == r_emp mem_ra * ``` + * + * 中文说明：说明空字节列表的精确所有权等于 emp。 */ PROOF extern thm pmem_bytes_at_nil; @@ -79,6 +85,8 @@ PROOF extern thm pmem_bytes_at_nil; * ⊢ ∀base byte bytes. pmem_bytes_at base (byte::bytes) == * pmem_byte_at base byte **_mem pmem_bytes_at (base + &1) bytes * ``` + * + * 中文说明：给出非空字节列表所有权的 head 与 tail 分离展开。 */ PROOF extern thm pmem_bytes_at_cons; @@ -93,6 +101,8 @@ PROOF extern thm pmem_bytes_at_cons; * (pmem_allocated_byte_at base) * (pmem_allocated_at (base + &1) count) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm pmem_allocated_at_def; @@ -102,6 +112,8 @@ PROOF extern thm pmem_allocated_at_def; * ```text * ⊢ ∀base. pmem_allocated_at base 0 == r_emp mem_ra * ``` + * + * 中文说明：说明零长度 allocated 区域等于 emp。 */ PROOF extern thm pmem_allocated_at_zero; @@ -113,6 +125,8 @@ PROOF extern thm pmem_allocated_at_zero; * pmem_allocated_byte_at base **_mem * pmem_allocated_at (base + &1) count * ``` + * + * 中文说明：给出非空 allocated 区域的逐字节递归展开。 */ PROOF extern thm pmem_allocated_at_suc; @@ -126,6 +140,8 @@ PROOF extern thm pmem_allocated_at_suc; * (pmem_allocated_at base m) * (pmem_allocated_at (base + &m) n). * ``` + * + * 中文说明：说明两个相邻 allocated 区域可通过 sep 合并。 */ PROOF extern thm pmem_allocated_at_append; @@ -139,6 +155,8 @@ PROOF extern thm pmem_allocated_at_append; * (pmem_allocated_at base k) * (pmem_allocated_at (base + &k) (n - k)). * ``` + * + * 中文说明：说明 allocated 区域可在指定长度处分裂为两个相邻区域。 */ PROOF extern thm pmem_allocated_at_split; @@ -151,6 +169,8 @@ PROOF extern thm pmem_allocated_at_split; * (pmem_uninit_at address) * (pmem_allocated_byte_at address). * ``` + * + * 中文说明：说明未初始化单字节所有权可遗忘为 allocated byte。 */ PROOF extern thm pmem_uninit_at_allocated_byte; @@ -163,6 +183,8 @@ PROOF extern thm pmem_uninit_at_allocated_byte; * (pmem_byte_at address byte) * (pmem_allocated_byte_at address). * ``` + * + * 中文说明：说明已初始化单字节所有权可遗忘为 allocated byte。 */ PROOF extern thm pmem_byte_at_allocated_byte; @@ -175,6 +197,8 @@ PROOF extern thm pmem_byte_at_allocated_byte; * (pmem_bytes_at base bytes) * (pmem_allocated_at base (LENGTH bytes)). * ``` + * + * 中文说明：说明连续已初始化字节所有权可遗忘为同长度 allocated 区域。 */ PROOF extern thm pmem_bytes_at_allocated; @@ -196,6 +220,8 @@ PROOF extern thm pmem_bytes_at_allocated; * Fixed-width recursion also gives negative HOL integers their usual * truncated two's-complement byte representation; range and signedness are * imposed only by the later C scalar-type layer. + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm pmem_le_bytes_def; @@ -205,6 +231,8 @@ PROOF extern thm pmem_le_bytes_def; * ```text * ⊢ ∀value. pmem_le_bytes 0 value == [] * ``` + * + * 中文说明：说明零字节小端编码结果为空列表。 */ PROOF extern thm pmem_le_bytes_zero; @@ -215,6 +243,8 @@ PROOF extern thm pmem_le_bytes_zero; * ⊢ ∀count value. pmem_le_bytes (SUC count) value == * (value rem &256)::pmem_le_bytes count (value div &256) * ``` + * + * 中文说明：给出小端编码的低字节与递归剩余字节。 */ PROOF extern thm pmem_le_bytes_suc; @@ -222,6 +252,8 @@ PROOF extern thm pmem_le_bytes_suc; * ```text * ⊢ ∀(count:num)(value:int). LENGTH (pmem_le_bytes count value) == count * ``` + * + * 中文说明：给出列表操作的递归方程或长度、索引性质。 */ PROOF extern thm pmem_le_bytes_length; @@ -232,6 +264,8 @@ PROOF extern thm pmem_le_bytes_length; * pmem_scalar_at base count integer_value == * pmem_bytes_at base (pmem_le_bytes count integer_value) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm pmem_scalar_at_def; @@ -248,6 +282,8 @@ PROOF extern thm pmem_scalar_at_def; * * Every owned byte is exactly `PMemUninit`; this assertion does not admit an * initialized byte with an existentially hidden value. + * + * 中文说明：说明严格未初始化标量由连续的 PMemUninit 字节组成。 */ PROOF extern thm pmem_undef_scalar_at_def; @@ -257,6 +293,8 @@ PROOF extern thm pmem_undef_scalar_at_def; * ```text * ⊢ ∀(base:int)(value:int). pmem_scalar_at base 0 value == r_emp mem_ra * ``` + * + * 中文说明：说明零宽度标量所有权等于 emp。 */ PROOF extern thm pmem_scalar_at_zero; @@ -271,6 +309,8 @@ PROOF extern thm pmem_scalar_at_zero; * (pmem_scalar_at * (base + &1) count (value div &256)). * ``` + * + * 中文说明：给出非零宽度标量所有权的首字节与剩余字节展开。 */ PROOF extern thm pmem_scalar_at_suc; @@ -280,6 +320,8 @@ PROOF extern thm pmem_scalar_at_suc; * ```text * ⊢ ∀base:int. pmem_undef_scalar_at base 0 == r_emp mem_ra * ``` + * + * 中文说明：说明零宽度严格未初始化标量等于 emp。 */ PROOF extern thm pmem_undef_scalar_at_zero; @@ -293,6 +335,8 @@ PROOF extern thm pmem_undef_scalar_at_zero; * (pmem_uninit_at base) * (pmem_undef_scalar_at (base + &1) count). * ``` + * + * 中文说明：给出非零宽度严格未初始化标量的逐字节展开。 */ PROOF extern thm pmem_undef_scalar_at_suc; @@ -305,6 +349,8 @@ PROOF extern thm pmem_undef_scalar_at_suc; * pmem_undef_scalar_at base count ⊢_mem * pmem_allocated_at base count. * ``` + * + * 中文说明：说明严格未初始化标量所有权可遗忘为 allocated 区域。 */ PROOF extern thm pmem_undef_scalar_at_allocated; @@ -318,5 +364,7 @@ PROOF extern thm pmem_undef_scalar_at_allocated; * (pmem_scalar_at base count value) * (pmem_allocated_at base count). * ``` + * + * 中文说明：说明已初始化标量所有权可遗忘为 allocated 区域。 */ PROOF extern thm pmem_scalar_at_allocated; diff --git a/theory/data/int_list.h b/theory/data/int_list.h index 496be4a..8e26d3e 100644 --- a/theory/data/int_list.h +++ b/theory/data/int_list.h @@ -20,6 +20,8 @@ * (ilength ([]:(A)list) = &0) && (ilength ((head:A) :: (tail:(A)list)) = &1 + * ilength tail) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm ILENGTH_DEF; /** @@ -29,6 +31,8 @@ PROOF extern thm ILENGTH_DEF; * (NTH 0 ((head:A) :: (tail:(A)list)) = head) && (NTH (SUC index) * (head :: tail) = NTH index tail) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm NTH_DEF; /** @@ -37,6 +41,8 @@ PROOF extern thm NTH_DEF; * ```text * inth (index:int) (values:(A)list) = NTH (num_of_int index) values * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm INTH_DEF; /** @@ -47,6 +53,8 @@ PROOF extern thm INTH_DEF; * tail) = value :: tail) && (REPLACE_NTH (SUC index) value (head :: tail) = * head :: REPLACE_NTH index value tail) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm REPLACE_NTH_DEF; /** @@ -56,6 +64,8 @@ PROOF extern thm REPLACE_NTH_DEF; * replace_inth (index:int) (value:A) (values:(A)list) = REPLACE_NTH * (num_of_int index) value values * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm REPLACE_INTH_DEF; /** @@ -65,6 +75,8 @@ PROOF extern thm REPLACE_INTH_DEF; * (FIRSTN 0 (values:(A)list) = []) && (FIRSTN (SUC count) ([]:(A)list) = []) * && (FIRSTN (SUC count) ((head:A) :: tail) = head :: FIRSTN count tail) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm FIRSTN_DEF; /** @@ -73,6 +85,8 @@ PROOF extern thm FIRSTN_DEF; * ```text * ifirstn (count:int) (values:(A)list) = FIRSTN (num_of_int count) values * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm IFIRSTN_DEF; /** @@ -82,6 +96,8 @@ PROOF extern thm IFIRSTN_DEF; * (SKIPN 0 (values:(A)list) = values) && (SKIPN (SUC count) ([]:(A)list) = * []) && (SKIPN (SUC count) ((head:A) :: tail) = SKIPN count tail) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm SKIPN_DEF; /** @@ -90,6 +106,8 @@ PROOF extern thm SKIPN_DEF; * ```text * iskipn (count:int) (values:(A)list) = SKIPN (num_of_int count) values * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm ISKIPN_DEF; /** @@ -98,6 +116,8 @@ PROOF extern thm ISKIPN_DEF; * ```text * ireplicate (count:int) (value:A) = REPLICATE (num_of_int count) value * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm IREPLICATE_DEF; /** @@ -107,6 +127,8 @@ PROOF extern thm IREPLICATE_DEF; * sublist (lower:int) (upper:int) (values:(A)list) = SKIPN (num_of_int lower) * (FIRSTN (num_of_int upper) values) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm SUBLIST_DEF; @@ -116,6 +138,8 @@ PROOF extern thm SUBLIST_DEF; * ```text * forall values:(A)list. &0 <= ilength values * ``` + * + * 中文说明：给出列表操作的递归方程或长度、索引性质。 */ PROOF extern thm ILENGTH_NONNEG; /** @@ -125,5 +149,7 @@ PROOF extern thm ILENGTH_NONNEG; * forall left:(A)list. forall right:(A)list. ilength (left ++ right) = * ilength left + ilength right * ``` + * + * 中文说明：给出列表操作的递归方程或长度、索引性质。 */ PROOF extern thm ILENGTH_APPEND; diff --git a/theory/data/list.h b/theory/data/list.h index 583abce..2212b7a 100644 --- a/theory/data/list.h +++ b/theory/data/list.h @@ -19,6 +19,8 @@ * (LENGTH ([]:(A)list) = 0) /\ (!h:A. !t. LENGTH (CONS h t) = SUC * (LENGTH t)) * ``` + * + * 中文说明：给出列表操作的递归方程或长度、索引性质。 */ PROOF extern thm HOL_LENGTH; /** @@ -28,6 +30,8 @@ PROOF extern thm HOL_LENGTH; * (!l:(A)list. APPEND [] l = l) /\ (!h:A. !t l. APPEND (CONS h t) l = * CONS h (APPEND t l)) * ``` + * + * 中文说明：给出列表操作的递归方程或长度、索引性质。 */ PROOF extern thm HOL_APPEND; /** @@ -37,6 +41,8 @@ PROOF extern thm HOL_APPEND; * (REVERSE ([]:(A)list) = []) /\ (REVERSE (CONS (x:A) l) = APPEND * (REVERSE l) (CONS x [])) * ``` + * + * 中文说明：给出列表操作的递归方程或长度、索引性质。 */ PROOF extern thm HOL_REVERSE; /** @@ -46,5 +52,7 @@ PROOF extern thm HOL_REVERSE; * (REPLICATE 0 (x:A) = []) /\ (REPLICATE (SUC n) x = CONS x * (REPLICATE n x)) * ``` + * + * 中文说明：给出列表操作的递归方程或长度、索引性质。 */ PROOF extern thm HOL_REPLICATE; diff --git a/theory/logic/agree_ra.h b/theory/logic/agree_ra.h index f9fc10a..aa0f420 100644 --- a/theory/logic/agree_ra.h +++ b/theory/logic/agree_ra.h @@ -18,6 +18,8 @@ * ```text * ra_unit agree_ra == AgreeUnit * ``` + * + * 中文说明：说明 agree RA 只允许相同 owned 值有效组合。 */ PROOF extern thm agree_ra_unit; @@ -27,6 +29,8 @@ PROOF extern thm agree_ra_unit; * ra_op agree_ra (Agree a) (Agree b) == * (if a == b then Agree a else AgreeInvalid) * ``` + * + * 中文说明：说明精确所有权如何反映 RA 的单位元、运算或有效性。 */ PROOF extern thm agree_ra_owned_op; @@ -34,6 +38,8 @@ PROOF extern thm agree_ra_owned_op; * ```text * forall a. ra_op agree_ra (Agree a) (Agree a) == Agree a * ``` + * + * 中文说明：说明该运算或变换是幂等的，重复应用不会产生额外变化。 */ PROOF extern thm agree_ra_idempotent; @@ -41,6 +47,8 @@ PROOF extern thm agree_ra_idempotent; * ```text * ra_valid agree_ra AgreeUnit * ``` + * + * 中文说明：说明 agree RA 的单位元 AgreeUnit 是有效资源。 */ PROOF extern thm agree_ra_valid_unit; @@ -48,6 +56,8 @@ PROOF extern thm agree_ra_valid_unit; * ```text * forall a. ra_valid agree_ra (Agree a) * ``` + * + * 中文说明：说明该资源或构造满足相应的有效性条件。 */ PROOF extern thm agree_ra_valid_owned; @@ -55,6 +65,8 @@ PROOF extern thm agree_ra_valid_owned; * ```text * ~ra_valid agree_ra AgreeInvalid * ``` + * + * 中文说明：说明 AgreeInvalid 不是有效的 agree RA 资源。 */ PROOF extern thm agree_ra_invalid; @@ -66,6 +78,8 @@ PROOF extern thm agree_ra_invalid; * ```text * forall a b. ra_valid agree_ra (ra_op agree_ra (Agree a) (Agree b)) <=> a == b * ``` + * + * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 */ PROOF extern thm agree_ra_valid_combine_iff; @@ -73,6 +87,8 @@ PROOF extern thm agree_ra_valid_combine_iff; * ```text * forall a b. ra_compatible agree_ra (Agree a) (Agree b) ==> a == b * ``` + * + * 中文说明：说明 agree RA 只允许相同 owned 值有效组合。 */ PROOF extern thm agree_ra_agreement; @@ -80,6 +96,8 @@ PROOF extern thm agree_ra_agreement; * ```text * forall a b. ra_included agree_ra (Agree a) (Agree b) <=> a == b * ``` + * + * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 */ PROOF extern thm agree_ra_included_owned; @@ -87,6 +105,8 @@ PROOF extern thm agree_ra_included_owned; * ```text * ~ra_cancellative agree_ra * ``` + * + * 中文说明：说明该资源代数满足或不满足消去性质。 */ PROOF extern thm agree_ra_not_cancellative; @@ -98,6 +118,8 @@ PROOF extern thm agree_ra_not_cancellative; * ```text * forall a b. ra_update agree_ra (Agree a) (Agree b) <=> a == b * ``` + * + * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 */ PROOF extern thm agree_ra_update_iff; @@ -107,5 +129,7 @@ PROOF extern thm agree_ra_update_iff; * ra_local_update agree_ra (Agree a) (Agree a) (Agree b) (Agree b) <=> * a == b * ``` + * + * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 */ PROOF extern thm agree_ra_local_update_iff; diff --git a/theory/logic/auth_ra.h b/theory/logic/auth_ra.h index 0065acd..d1baa2c 100644 --- a/theory/logic/auth_ra.h +++ b/theory/logic/auth_ra.h @@ -22,6 +22,8 @@ * forall R:(A)ra. * ra_unit (auth_ra R) == auth_frag (ra_unit R) * ``` + * + * 中文说明：说明两个 authoritative owner 不能组成有效资源。 */ PROOF extern thm auth_ra_unit; @@ -34,6 +36,8 @@ PROOF extern thm auth_ra_unit; * (auth_frag fragment) == * auth_both a fragment * ``` + * + * 中文说明：说明 authoritative 与 fragment 组合后的标准形状。 */ PROOF extern thm auth_ra_auth_frag; @@ -43,6 +47,8 @@ PROOF extern thm auth_ra_auth_frag; * ra_op (auth_ra R) (auth_frag f) (auth_frag g) == * auth_frag (ra_op R f g) * ``` + * + * 中文说明：说明 authoritative 与 fragment 组合后的标准形状。 */ PROOF extern thm auth_ra_frag_frag; @@ -52,6 +58,8 @@ PROOF extern thm auth_ra_frag_frag; * ra_op (auth_ra R) (auth_both a f) (auth_frag g) == * auth_both a (ra_op R f g) * ``` + * + * 中文说明：说明 authoritative 与 fragment 组合后的标准形状。 */ PROOF extern thm auth_ra_both_frag; @@ -65,6 +73,8 @@ PROOF extern thm auth_ra_both_frag; * ra_valid (auth_ra R) (auth_frag fragment) <=> * ra_valid R fragment * ``` + * + * 中文说明：刻画 authoritative/fragment 资源的有效性条件。 */ PROOF extern thm auth_ra_valid_frag; @@ -74,6 +84,8 @@ PROOF extern thm auth_ra_valid_frag; * ra_valid (auth_ra R) (auth_both a fragment) <=> * ra_valid R a && ra_included R fragment a * ``` + * + * 中文说明：刻画 authoritative/fragment 资源的有效性条件。 */ PROOF extern thm auth_ra_valid_both; @@ -83,6 +95,8 @@ PROOF extern thm auth_ra_valid_both; * ra_valid (auth_ra R) (auth_auth R a) <=> * ra_valid R a * ``` + * + * 中文说明：刻画 authoritative/fragment 资源的有效性条件。 */ PROOF extern thm auth_ra_valid_auth; @@ -101,6 +115,8 @@ PROOF extern thm auth_ra_valid_auth; * ra_valid R a && * ra_included R (ra_op R f external) a * ``` + * + * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 */ PROOF extern thm auth_ra_valid_both_frame; @@ -112,6 +128,8 @@ PROOF extern thm auth_ra_valid_both_frame; * (auth_auth R a) * (auth_auth R b)) * ``` + * + * 中文说明：给出 authoritative RA 的基础代数性质。 */ PROOF extern thm auth_ra_auth_conflict; @@ -125,6 +143,8 @@ PROOF extern thm auth_ra_auth_conflict; * ra_included (auth_ra R) (auth_frag f) (auth_frag g) <=> * ra_included R f g * ``` + * + * 中文说明：说明 authoritative 与 fragment 组合后的标准形状。 */ PROOF extern thm auth_ra_included_frag_frag; @@ -134,6 +154,8 @@ PROOF extern thm auth_ra_included_frag_frag; * ra_included (auth_ra R) (auth_frag f) (auth_both a g) <=> * ra_included R f g * ``` + * + * 中文说明：刻画 authoritative/fragment 资源之间的包含关系。 */ PROOF extern thm auth_ra_included_frag_both; @@ -143,6 +165,8 @@ PROOF extern thm auth_ra_included_frag_both; * ra_included (auth_ra R) (auth_auth R a) (auth_auth R b) <=> * a == b * ``` + * + * 中文说明：刻画 authoritative/fragment 资源之间的包含关系。 */ PROOF extern thm auth_ra_included_auth_auth; @@ -152,6 +176,8 @@ PROOF extern thm auth_ra_included_auth_auth; * ra_included (auth_ra R) (auth_auth R a) (auth_both b g) <=> * a == b * ``` + * + * 中文说明：刻画 authoritative/fragment 资源之间的包含关系。 */ PROOF extern thm auth_ra_included_auth_both; @@ -161,6 +187,8 @@ PROOF extern thm auth_ra_included_auth_both; * ra_included (auth_ra R) (auth_both a f) (auth_both b g) <=> * a == b && ra_included R f g * ``` + * + * 中文说明：刻画 authoritative/fragment 资源之间的包含关系。 */ PROOF extern thm auth_ra_included_both_both; @@ -169,6 +197,8 @@ PROOF extern thm auth_ra_included_both_both; * forall R:(A)ra. * ra_cancellative (auth_ra R) <=> ra_cancellative R * ``` + * + * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 */ PROOF extern thm auth_ra_cancellative_iff; @@ -194,6 +224,8 @@ PROOF extern thm auth_ra_cancellative_iff; * ra_valid R b && * ra_included R (ra_op R g external) b * ``` + * + * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 */ PROOF extern thm auth_ra_update_framewise_iff; @@ -211,6 +243,8 @@ PROOF extern thm auth_ra_update_framewise_iff; * (auth_both a f) * (auth_both b g) * ``` + * + * 中文说明：说明 authoritative 资源如何执行一致更新、分配或丢弃。 */ PROOF extern thm auth_ra_update_local; @@ -224,6 +258,8 @@ PROOF extern thm auth_ra_update_local; * (ra_valid R a ==> * ra_valid R b && ra_included R a b) * ``` + * + * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 */ PROOF extern thm auth_ra_update_auth_iff; @@ -236,6 +272,8 @@ PROOF extern thm auth_ra_update_auth_iff; * (auth_auth R a) * (auth_both b g) * ``` + * + * 中文说明：说明 authoritative 资源如何执行一致更新、分配或丢弃。 */ PROOF extern thm auth_ra_update_alloc; @@ -247,6 +285,8 @@ PROOF extern thm auth_ra_update_alloc; * (auth_both a f) * (auth_auth R a) * ``` + * + * 中文说明：说明 authoritative 资源如何执行一致更新、分配或丢弃。 */ PROOF extern thm auth_ra_update_drop_local; @@ -258,6 +298,8 @@ PROOF extern thm auth_ra_update_drop_local; * (auth_both a f) * (auth_frag f) * ``` + * + * 中文说明：说明 authoritative 资源如何执行一致更新、分配或丢弃。 */ PROOF extern thm auth_ra_update_drop_auth; @@ -270,6 +312,8 @@ PROOF extern thm auth_ra_update_drop_auth; * (auth_both a f) * (auth_both a g) * ``` + * + * 中文说明：说明 authoritative 资源如何执行一致更新、分配或丢弃。 */ PROOF extern thm auth_ra_update_weaken_frag; @@ -282,5 +326,7 @@ PROOF extern thm auth_ra_update_weaken_frag; * (auth_auth R a) * (auth_both (ra_op R a piece) piece) * ``` + * + * 中文说明：说明 authoritative 资源如何执行一致更新、分配或丢弃。 */ PROOF extern thm auth_ra_alloc; diff --git a/theory/logic/basic_update.h b/theory/logic/basic_update.h index d29320d..ae43d36 100644 --- a/theory/logic/basic_update.h +++ b/theory/logic/basic_update.h @@ -19,6 +19,8 @@ * ```text * r_bupd (R:(A)ra) (Q:A->bool) (owned:A) <=> ra_updateP R owned Q * ``` + * + * 中文说明：说明 basic update 直接采用底层 RA 的谓词更新语义。 */ PROOF extern thm r_bupd_def; @@ -29,6 +31,8 @@ PROOF extern thm r_bupd_def; * r_viewshift (R:(A)ra) (P:A->bool) (Q:A->bool) <=> r_entails R P * (r_bupd R Q) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm r_viewshift_def; @@ -39,6 +43,8 @@ PROOF extern thm r_viewshift_def; * ```text * forall (R:(A)ra) (P:A->bool). r_entails R P (r_bupd R P) * ``` + * + * 中文说明：给出该逻辑构造的引入规则。 */ PROOF extern thm r_bupd_intro; /** @@ -48,6 +54,8 @@ PROOF extern thm r_bupd_intro; * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R P Q ==> r_entails R * (r_bupd R P) (r_bupd R Q) * ``` + * + * 中文说明：说明该构造对蕴含或底层关系保持单调。 */ PROOF extern thm r_bupd_mono; /** @@ -57,6 +65,8 @@ PROOF extern thm r_bupd_mono; * forall (R:(A)ra) (P:A->bool). r_entails R (r_bupd R (r_bupd R P)) (r_bupd R * P) * ``` + * + * 中文说明：说明该运算或变换是幂等的，重复应用不会产生额外变化。 */ PROOF extern thm r_bupd_idem; /** @@ -66,6 +76,8 @@ PROOF extern thm r_bupd_idem; * forall (R:(A)ra) (P:A->bool) (frame_pred:A->bool). r_entails R (r_sep R * (r_bupd R P) frame_pred) (r_bupd R (r_sep R P frame_pred)) * ``` + * + * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 */ PROOF extern thm r_bupd_frame; @@ -76,6 +88,8 @@ PROOF extern thm r_bupd_frame; * ```text * forall (R:(A)ra) (P:A->bool). r_viewshift R P P * ``` + * + * 中文说明：说明该关系具有自反性。 */ PROOF extern thm r_viewshift_refl; /** @@ -85,6 +99,8 @@ PROOF extern thm r_viewshift_refl; * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R P Q ==> r_viewshift R * P Q * ``` + * + * 中文说明：说明逻辑蕴含的组合、改写或框架规则。 */ PROOF extern thm r_entails_to_viewshift; /** @@ -94,6 +110,8 @@ PROOF extern thm r_entails_to_viewshift; * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_viewshift R P Q ==> * r_viewshift R Q S ==> r_viewshift R P S * ``` + * + * 中文说明：说明该关系或变换可以传递地串联。 */ PROOF extern thm r_viewshift_trans; /** @@ -104,6 +122,8 @@ PROOF extern thm r_viewshift_trans; * r_entails R P2 P ==> r_viewshift R P Q ==> r_entails R Q Q2 ==> r_viewshift * R P2 Q2 * ``` + * + * 中文说明：说明该构造对蕴含或底层关系保持单调。 */ PROOF extern thm r_viewshift_mono; /** @@ -113,6 +133,8 @@ PROOF extern thm r_viewshift_mono; * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (frame_pred:A->bool). r_viewshift R * P Q ==> r_viewshift R (r_sep R P frame_pred) (r_sep R Q frame_pred) * ``` + * + * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 */ PROOF extern thm r_viewshift_frame; /** @@ -123,6 +145,8 @@ PROOF extern thm r_viewshift_frame; * r_viewshift R P1 Q1 ==> r_viewshift R P2 Q2 ==> r_viewshift R (r_sep R P1 * P2) (r_sep R Q1 Q2) * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_viewshift_sep; /** @@ -133,6 +157,8 @@ PROOF extern thm r_viewshift_sep; * r_viewshift R (P witness) (Q witness)) ==> r_viewshift R (r_exists R * (\bound:B. P bound)) (r_exists R (\bound:B. Q bound)) * ``` + * + * 中文说明：说明存在量词的引入、消去、单调性或与 sep 的交换。 */ PROOF extern thm r_viewshift_exists; @@ -144,6 +170,8 @@ PROOF extern thm r_viewshift_exists; * forall (R:(A)ra) (a:A) (b:A). ra_update R a b ==> r_viewshift R (r_own R a) * (r_own R b) * ``` + * + * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 */ PROOF extern thm r_own_update; @@ -156,5 +184,7 @@ PROOF extern thm r_own_update; * r_viewshift R (r_own R a) (r_exists R (\selected:A. r_sep R (r_fact R * (result_pred selected)) (r_own R selected))) * ``` + * + * 中文说明：说明谓词更新允许选择任意满足目标谓词的新资源。 */ PROOF extern thm r_own_updateP; diff --git a/theory/logic/big_sep.h b/theory/logic/big_sep.h index 93abd23..a297317 100644 --- a/theory/logic/big_sep.h +++ b/theory/logic/big_sep.h @@ -26,6 +26,8 @@ * (r_big_sep_list R Phi ((x:B) :: (xs:(B)list)) = r_sep R (Phi x) * (r_big_sep_list R Phi xs)) * ``` + * + * 中文说明：说明列表 big-sep 以 emp 为基例、以 sep 为递归步骤。 */ PROOF extern thm r_big_sep_list_def; @@ -37,6 +39,8 @@ PROOF extern thm r_big_sep_list_def; * forall (R:(A)ra) (Phi:B->A->bool). r_equiv R (r_big_sep_list R Phi * ([]:(B)list)) (r_emp R) * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_big_sep_list_nil; /** @@ -46,6 +50,8 @@ PROOF extern thm r_big_sep_list_nil; * forall (R:(A)ra) (Phi:B->A->bool) (x:B) (xs:(B)list). r_equiv R * (r_big_sep_list R Phi (x :: xs)) (r_sep R (Phi x) (r_big_sep_list R Phi xs)) * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_big_sep_list_cons; /** @@ -55,6 +61,8 @@ PROOF extern thm r_big_sep_list_cons; * forall (R:(A)ra) (Phi:B->A->bool) (x:B). r_equiv R (r_big_sep_list R Phi (x * :: [])) (Phi x) * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_big_sep_list_singleton; /** @@ -65,6 +73,8 @@ PROOF extern thm r_big_sep_list_singleton; * (r_big_sep_list R Phi (APPEND left right)) (r_sep R (r_big_sep_list R Phi * left) (r_big_sep_list R Phi right)) * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_big_sep_list_append; @@ -77,6 +87,8 @@ PROOF extern thm r_big_sep_list_append; * x:B. MEM x xs ==> r_entails R (Phi x) (Psi x)) ==> r_entails R * (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs) * ``` + * + * 中文说明：说明该构造对蕴含或底层关系保持单调。 */ PROOF extern thm r_big_sep_list_mono; /** @@ -87,6 +99,8 @@ PROOF extern thm r_big_sep_list_mono; * x:B. MEM x xs ==> r_equiv R (Phi x) (Psi x)) ==> r_equiv R (r_big_sep_list R * Phi xs) (r_big_sep_list R Psi xs) * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_big_sep_list_equiv; @@ -98,6 +112,8 @@ PROOF extern thm r_big_sep_list_equiv; * forall (R:(A)ra) (Phi:B->A->bool) (f:C->B) (xs:(C)list). r_equiv R * (r_big_sep_list R Phi (MAP f xs)) (r_big_sep_list R (\x:C. Phi (f x)) xs) * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_big_sep_list_map; /** @@ -108,5 +124,7 @@ PROOF extern thm r_big_sep_list_map; * (r_big_sep_list R (\x:B. r_sep R (Phi x) (Psi x)) xs) (r_sep R * (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs)) * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_big_sep_list_sep; diff --git a/theory/logic/excl_ra.h b/theory/logic/excl_ra.h index 96913dd..584f649 100644 --- a/theory/logic/excl_ra.h +++ b/theory/logic/excl_ra.h @@ -19,6 +19,8 @@ * ```text * ra_unit excl_ra == ExclUnit * ``` + * + * 中文说明：说明 exclusive RA 的单位、owned 值、冲突或更新性质。 */ PROOF extern thm excl_ra_unit; @@ -26,6 +28,8 @@ PROOF extern thm excl_ra_unit; * ```text * forall a b. ra_op excl_ra (Excl a) (Excl b) == ExclInvalid * ``` + * + * 中文说明：说明该构造得到无效资源或互斥组合。 */ PROOF extern thm excl_ra_owned_conflict; @@ -33,6 +37,8 @@ PROOF extern thm excl_ra_owned_conflict; * ```text * ra_valid excl_ra ExclUnit * ``` + * + * 中文说明：说明 exclusive RA 的单位元是有效资源。 */ PROOF extern thm excl_ra_valid_unit; @@ -40,6 +46,8 @@ PROOF extern thm excl_ra_valid_unit; * ```text * forall a. ra_valid excl_ra (Excl a) * ``` + * + * 中文说明：说明该资源或构造满足相应的有效性条件。 */ PROOF extern thm excl_ra_valid_owned; @@ -47,6 +55,8 @@ PROOF extern thm excl_ra_valid_owned; * ```text * ~ra_valid excl_ra ExclInvalid * ``` + * + * 中文说明：说明 ExclInvalid 不是有效的 exclusive RA 资源。 */ PROOF extern thm excl_ra_invalid; @@ -58,6 +68,8 @@ PROOF extern thm excl_ra_invalid; * ```text * forall a b. ra_included excl_ra (Excl a) (Excl b) <=> a == b * ``` + * + * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 */ PROOF extern thm excl_ra_included_owned; @@ -65,6 +77,8 @@ PROOF extern thm excl_ra_included_owned; * ```text * forall a. ra_maximal excl_ra (Excl a) * ``` + * + * 中文说明：说明 frame-maximal 资源只能与单位 frame 兼容。 */ PROOF extern thm excl_ra_maximal; @@ -72,6 +86,8 @@ PROOF extern thm excl_ra_maximal; * ```text * ra_cancellative excl_ra * ``` + * + * 中文说明：说明该资源代数满足或不满足消去性质。 */ PROOF extern thm excl_ra_cancellative; @@ -83,6 +99,8 @@ PROOF extern thm excl_ra_cancellative; * ```text * forall a x. ra_update excl_ra (Excl a) x <=> ra_valid excl_ra x * ``` + * + * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 */ PROOF extern thm excl_ra_update_owned_iff; @@ -91,5 +109,7 @@ PROOF extern thm excl_ra_update_owned_iff; * forall a x. * ra_local_update excl_ra (Excl a) (Excl a) x x <=> ra_valid excl_ra x * ``` + * + * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 */ PROOF extern thm excl_ra_local_update_iff; diff --git a/theory/logic/excl_ra_internal.h b/theory/logic/excl_ra_internal.h index 0d03c07..2de78b7 100644 --- a/theory/logic/excl_ra_internal.h +++ b/theory/logic/excl_ra_internal.h @@ -24,6 +24,8 @@ PROOF extern indtype excl_type; * excl_owned_op a (Excl b) == ExclInvalid && * excl_owned_op a ExclInvalid == ExclInvalid * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm excl_owned_op_def; @@ -33,6 +35,8 @@ PROOF extern thm excl_owned_op_def; * excl_op (Excl a) y == excl_owned_op a y && * excl_op ExclInvalid y == ExclInvalid * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm excl_op_def; @@ -44,6 +48,8 @@ PROOF extern thm excl_op_def; * ```text * forall a. ~(Excl a == ExclUnit) * ``` + * + * 中文说明：说明该构造得到无效资源或互斥组合。 */ PROOF extern thm excl_owned_ne_unit; @@ -51,6 +57,8 @@ PROOF extern thm excl_owned_ne_unit; * ```text * ~(ExclInvalid == ExclUnit) * ``` + * + * 中文说明：说明 ExclInvalid 与 exclusive RA 的单位元不同。 */ PROOF extern thm excl_invalid_ne_unit; @@ -58,6 +66,8 @@ PROOF extern thm excl_invalid_ne_unit; * ```text * ra_op excl_ra == excl_op * ``` + * + * 中文说明：说明 exclusive RA 的单位、owned 值、冲突或更新性质。 */ PROOF extern thm excl_ra_op_fn; @@ -65,5 +75,7 @@ PROOF extern thm excl_ra_op_fn; * ```text * forall a b. ra_update excl_ra (Excl a) (Excl b) * ``` + * + * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 */ PROOF extern thm excl_ra_update; diff --git a/theory/logic/finmap.h b/theory/logic/finmap.h index 480a61a..3706490 100644 --- a/theory/logic/finmap.h +++ b/theory/logic/finmap.h @@ -27,6 +27,8 @@ * ```text * finmap_finite (f:K->V option) <=> FINITE {k:K | ~(f k == NONE)} * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm finmap_finite_def; @@ -42,6 +44,8 @@ PROOF extern thm finmap_finite_def; * finmap_finite f <=> * finmap_rep (finmap_abs f) == f) * ``` + * + * 中文说明：给出有限映射按键查找或外延相等的规则。 */ PROOF extern thm finmap_type_bijection; @@ -49,6 +53,8 @@ PROOF extern thm finmap_type_bijection; * ```text * forall m:(K,V)finmap. finmap_finite (finmap_rep m) * ``` + * + * 中文说明：给出有限映射按键查找或外延相等的规则。 */ PROOF extern thm finmap_rep_finite; @@ -57,6 +63,8 @@ PROOF extern thm finmap_rep_finite; * forall (m:(K,V)finmap) (n:(K,V)finmap). * m == n <=> finmap_rep m == finmap_rep n * ``` + * + * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 */ PROOF extern thm finmap_eq; @@ -68,6 +76,8 @@ PROOF extern thm finmap_eq; * ```text * finmap_empty:(K,V)finmap == finmap_abs (\k:K. NONE) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm finmap_empty_def; @@ -75,6 +85,8 @@ PROOF extern thm finmap_empty_def; * ```text * finmap_lookup (m:(K,V)finmap) (k:K) == finmap_rep m k * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm finmap_lookup_def; @@ -83,6 +95,8 @@ PROOF extern thm finmap_lookup_def; * finmap_singleton (key:K) (v:V) == * finmap_abs (\k:K. if k == key then SOME v else NONE) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm finmap_singleton_def; @@ -91,6 +105,8 @@ PROOF extern thm finmap_singleton_def; * finmap_insert (key:K) (v:V) (m:(K,V)finmap) == * finmap_abs (\k:K. if k == key then SOME v else finmap_rep m k) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm finmap_insert_def; @@ -99,6 +115,8 @@ PROOF extern thm finmap_insert_def; * finmap_delete (key:K) (m:(K,V)finmap) == * finmap_abs (\k:K. if k == key then NONE else finmap_rep m k) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm finmap_delete_def; @@ -107,6 +125,8 @@ PROOF extern thm finmap_delete_def; * finmap_dom (m:(K,V)finmap) == * {k:K | ~(finmap_lookup m k == NONE)} * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm finmap_dom_def; @@ -118,6 +138,8 @@ PROOF extern thm finmap_dom_def; * ```text * finmap_rep (finmap_empty:(K,V)finmap) == (\k:K. NONE) * ``` + * + * 中文说明：说明有限映射在空映射或单点映射上的标准行为。 */ PROOF extern thm finmap_empty_rep; @@ -125,6 +147,8 @@ PROOF extern thm finmap_empty_rep; * ```text * forall k:K. finmap_lookup (finmap_empty:(K,V)finmap) k == NONE * ``` + * + * 中文说明：说明有限映射在空映射或单点映射上的标准行为。 */ PROOF extern thm finmap_empty_lookup; @@ -134,6 +158,8 @@ PROOF extern thm finmap_empty_lookup; * {k:K | ~((if k == key then SOME v else NONE) == NONE)} == * {key} * ``` + * + * 中文说明：说明有限映射在空映射或单点映射上的标准行为。 */ PROOF extern thm finmap_singleton_support; @@ -143,6 +169,8 @@ PROOF extern thm finmap_singleton_support; * finmap_rep (finmap_singleton key v) == * (\k:K. if k == key then SOME v else NONE) * ``` + * + * 中文说明：说明有限映射在空映射或单点映射上的标准行为。 */ PROOF extern thm finmap_singleton_rep; @@ -152,6 +180,8 @@ PROOF extern thm finmap_singleton_rep; * finmap_lookup (finmap_singleton key v) k == * if k == key then SOME v else NONE * ``` + * + * 中文说明：说明有限映射在空映射或单点映射上的标准行为。 */ PROOF extern thm finmap_singleton_lookup; @@ -161,6 +191,8 @@ PROOF extern thm finmap_singleton_lookup; * {k:K | ~((if k == key then SOME v else f k) == NONE)} == * key INSERT {k:K | ~(f k == NONE)} * ``` + * + * 中文说明：说明有限映射插入操作对查找、定义域或结构的影响。 */ PROOF extern thm finmap_insert_support; @@ -171,6 +203,8 @@ PROOF extern thm finmap_insert_support; * (\k:K. * if k == key then SOME v else finmap_rep m k) * ``` + * + * 中文说明：说明有限映射插入操作对查找、定义域或结构的影响。 */ PROOF extern thm finmap_insert_rep; @@ -184,6 +218,8 @@ PROOF extern thm finmap_insert_rep; * finmap_lookup (finmap_insert key v m) k == * if k == key then SOME v else finmap_lookup m k * ``` + * + * 中文说明：说明有限映射插入操作对查找、定义域或结构的影响。 */ PROOF extern thm finmap_insert_lookup; @@ -192,6 +228,8 @@ PROOF extern thm finmap_insert_lookup; * forall (key:K) (v:V) (m:(K,V)finmap). * finmap_lookup (finmap_insert key v m) key == SOME v * ``` + * + * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 */ PROOF extern thm finmap_insert_lookup_eq; @@ -205,6 +243,8 @@ PROOF extern thm finmap_insert_lookup_eq; * ~(k == key) ==> * finmap_lookup (finmap_insert key v m) k == finmap_lookup m k * ``` + * + * 中文说明：说明有限映射插入操作对查找、定义域或结构的影响。 */ PROOF extern thm finmap_insert_lookup_ne; @@ -214,6 +254,8 @@ PROOF extern thm finmap_insert_lookup_ne; * {k:K | ~((if k == key then NONE else f k) == NONE)} == * {k:K | ~(f k == NONE)} DELETE key * ``` + * + * 中文说明：说明有限映射删除操作对查找、定义域或结构的影响。 */ PROOF extern thm finmap_delete_support; @@ -223,6 +265,8 @@ PROOF extern thm finmap_delete_support; * finmap_rep (finmap_delete key m) == * (\k:K. if k == key then NONE else finmap_rep m k) * ``` + * + * 中文说明：说明有限映射删除操作对查找、定义域或结构的影响。 */ PROOF extern thm finmap_delete_rep; @@ -232,6 +276,8 @@ PROOF extern thm finmap_delete_rep; * finmap_lookup (finmap_delete key m) k == * if k == key then NONE else finmap_lookup m k * ``` + * + * 中文说明：说明有限映射删除操作对查找、定义域或结构的影响。 */ PROOF extern thm finmap_delete_lookup; @@ -240,6 +286,8 @@ PROOF extern thm finmap_delete_lookup; * forall (key:K) (m:(K,V)finmap). * finmap_lookup (finmap_delete key m) key == NONE * ``` + * + * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 */ PROOF extern thm finmap_delete_lookup_eq; @@ -249,6 +297,8 @@ PROOF extern thm finmap_delete_lookup_eq; * ~(k == key) ==> * finmap_lookup (finmap_delete key m) k == finmap_lookup m k * ``` + * + * 中文说明：说明有限映射删除操作对查找、定义域或结构的影响。 */ PROOF extern thm finmap_delete_lookup_ne; @@ -258,6 +308,8 @@ PROOF extern thm finmap_delete_lookup_ne; * m == n <=> * forall k:K. finmap_lookup m k == finmap_lookup n k * ``` + * + * 中文说明：给出有限映射按键查找或外延相等的规则。 */ PROOF extern thm finmap_eq_lookup; @@ -271,6 +323,8 @@ PROOF extern thm finmap_eq_lookup; * finmap_insert key v (finmap_empty:(K,V)finmap) == * finmap_singleton key v * ``` + * + * 中文说明：说明有限映射插入操作对查找、定义域或结构的影响。 */ PROOF extern thm finmap_insert_empty; @@ -279,6 +333,8 @@ PROOF extern thm finmap_insert_empty; * forall key:K. * finmap_delete key (finmap_empty:(K,V)finmap) == finmap_empty * ``` + * + * 中文说明：说明有限映射删除操作对查找、定义域或结构的影响。 */ PROOF extern thm finmap_delete_empty; @@ -292,6 +348,8 @@ PROOF extern thm finmap_delete_empty; * finmap_insert key v (finmap_insert key w m) == * finmap_insert key v m * ``` + * + * 中文说明：说明有限映射插入操作对查找、定义域或结构的影响。 */ PROOF extern thm finmap_insert_overwrite; @@ -307,6 +365,8 @@ PROOF extern thm finmap_insert_overwrite; * finmap_insert key1 v1 (finmap_insert key2 v2 m) == * finmap_insert key2 v2 (finmap_insert key1 v1 m) * ``` + * + * 中文说明：说明该运算满足交换律，交换两个操作数不会改变结果。 */ PROOF extern thm finmap_insert_comm; @@ -315,6 +375,8 @@ PROOF extern thm finmap_insert_comm; * forall (key:K) (m:(K,V)finmap). * finmap_delete key (finmap_delete key m) == finmap_delete key m * ``` + * + * 中文说明：说明该运算或变换是幂等的，重复应用不会产生额外变化。 */ PROOF extern thm finmap_delete_idempotent; @@ -324,6 +386,8 @@ PROOF extern thm finmap_delete_idempotent; * finmap_delete key1 (finmap_delete key2 m) == * finmap_delete key2 (finmap_delete key1 m) * ``` + * + * 中文说明：说明该运算满足交换律，交换两个操作数不会改变结果。 */ PROOF extern thm finmap_delete_comm; @@ -332,6 +396,8 @@ PROOF extern thm finmap_delete_comm; * forall (key:K) (v:V) (m:(K,V)finmap). * finmap_delete key (finmap_insert key v m) == finmap_delete key m * ``` + * + * 中文说明：说明有限映射删除操作对查找、定义域或结构的影响。 */ PROOF extern thm finmap_delete_insert; @@ -348,6 +414,8 @@ PROOF extern thm finmap_delete_insert; * finmap_delete deleted (finmap_insert inserted v m) == * finmap_insert inserted v (finmap_delete deleted m) * ``` + * + * 中文说明：说明有限映射删除操作对查找、定义域或结构的影响。 */ PROOF extern thm finmap_delete_insert_ne; @@ -357,6 +425,8 @@ PROOF extern thm finmap_delete_insert_ne; * finmap_insert key v (finmap_delete key m) == * finmap_insert key v m * ``` + * + * 中文说明：说明有限映射插入操作对查找、定义域或结构的影响。 */ PROOF extern thm finmap_insert_delete; @@ -366,6 +436,8 @@ PROOF extern thm finmap_insert_delete; * finmap_lookup m key == SOME v ==> * finmap_insert key v m == m * ``` + * + * 中文说明：说明有限映射插入操作对查找、定义域或结构的影响。 */ PROOF extern thm finmap_insert_id; @@ -375,6 +447,8 @@ PROOF extern thm finmap_insert_id; * finmap_lookup m key == NONE ==> * finmap_delete key m == m * ``` + * + * 中文说明：说明有限映射删除操作对查找、定义域或结构的影响。 */ PROOF extern thm finmap_delete_id; @@ -384,6 +458,8 @@ PROOF extern thm finmap_delete_id; * finmap_lookup m key == SOME v ==> * finmap_insert key v (finmap_delete key m) == m * ``` + * + * 中文说明：说明有限映射可以按指定键拆分或重组。 */ PROOF extern thm finmap_decompose; @@ -395,6 +471,8 @@ PROOF extern thm finmap_decompose; * ```text * forall m:(K,V)finmap. FINITE (finmap_dom m) * ``` + * + * 中文说明：刻画有限映射定义域与键是否存在之间的关系。 */ PROOF extern thm finmap_dom_finite; @@ -402,6 +480,8 @@ PROOF extern thm finmap_dom_finite; * ```text * finmap_dom (finmap_empty:(K,V)finmap) == {} * ``` + * + * 中文说明：刻画有限映射定义域与键是否存在之间的关系。 */ PROOF extern thm finmap_dom_empty; @@ -410,6 +490,8 @@ PROOF extern thm finmap_dom_empty; * forall (key:K) (v:V). * finmap_dom (finmap_singleton key v) == {key} * ``` + * + * 中文说明：刻画有限映射定义域与键是否存在之间的关系。 */ PROOF extern thm finmap_dom_singleton; @@ -418,6 +500,8 @@ PROOF extern thm finmap_dom_singleton; * forall (key:K) (m:(K,V)finmap). * key IN finmap_dom m <=> ~(finmap_lookup m key == NONE) * ``` + * + * 中文说明：刻画有限映射定义域与键是否存在之间的关系。 */ PROOF extern thm finmap_in_dom; @@ -427,6 +511,8 @@ PROOF extern thm finmap_in_dom; * key IN finmap_dom m <=> * exists v:V. finmap_lookup m key == SOME v * ``` + * + * 中文说明：刻画有限映射定义域与键是否存在之间的关系。 */ PROOF extern thm finmap_in_dom_some; @@ -435,6 +521,8 @@ PROOF extern thm finmap_in_dom_some; * forall (key:K) (m:(K,V)finmap). * ~(key IN finmap_dom m) <=> finmap_lookup m key == NONE * ``` + * + * 中文说明：刻画有限映射定义域与键是否存在之间的关系。 */ PROOF extern thm finmap_not_in_dom; @@ -448,6 +536,8 @@ PROOF extern thm finmap_not_in_dom; * key IN candidates && * finmap_lookup m key == NONE * ``` + * + * 中文说明：说明可从候选集合中选择不在有限映射中的新键。 */ PROOF extern thm finmap_fresh_in; @@ -465,6 +555,8 @@ PROOF extern thm finmap_fresh_in; * finmap_lookup m key == NONE && * finmap_lookup n key == NONE * ``` + * + * 中文说明：说明可从候选集合中选择不在有限映射中的新键。 */ PROOF extern thm finmap_fresh_in_pair; @@ -477,6 +569,8 @@ PROOF extern thm finmap_fresh_in_pair; * exists key:K. * finmap_lookup m key == NONE * ``` + * + * 中文说明：说明可从候选集合中选择不在有限映射中的新键。 */ PROOF extern thm finmap_fresh; @@ -492,6 +586,8 @@ PROOF extern thm finmap_fresh; * finmap_lookup m key == NONE && * finmap_lookup n key == NONE * ``` + * + * 中文说明：说明可从候选集合中选择不在有限映射中的新键。 */ PROOF extern thm finmap_fresh_pair; @@ -500,6 +596,8 @@ PROOF extern thm finmap_fresh_pair; * forall m:(K,V)finmap. * finmap_dom m == {} <=> m == finmap_empty * ``` + * + * 中文说明：刻画有限映射定义域与键是否存在之间的关系。 */ PROOF extern thm finmap_dom_eq_empty; @@ -509,6 +607,8 @@ PROOF extern thm finmap_dom_eq_empty; * finmap_dom (finmap_insert key v m) == * key INSERT finmap_dom m * ``` + * + * 中文说明：刻画有限映射定义域与键是否存在之间的关系。 */ PROOF extern thm finmap_dom_insert; @@ -517,6 +617,8 @@ PROOF extern thm finmap_dom_insert; * forall (key:K) (m:(K,V)finmap). * finmap_dom (finmap_delete key m) == finmap_dom m DELETE key * ``` + * + * 中文说明：刻画有限映射定义域与键是否存在之间的关系。 */ PROOF extern thm finmap_dom_delete; @@ -539,5 +641,7 @@ PROOF extern thm finmap_dom_delete; * P (finmap_insert key v m)) ==> * forall m:(K,V)finmap. P m * ``` + * + * 中文说明：给出有限映射的结构归纳原则。 */ PROOF extern thm finmap_induct; diff --git a/theory/logic/frac_ra.h b/theory/logic/frac_ra.h index 9eada80..fdaa204 100644 --- a/theory/logic/frac_ra.h +++ b/theory/logic/frac_ra.h @@ -19,6 +19,8 @@ * ```text * forall R. ra_unit (frac_ra R) == frac_empty * ``` + * + * 中文说明：说明分数所有权的组合、有效性或更新性质。 */ PROOF extern thm frac_ra_unit; @@ -26,6 +28,8 @@ PROOF extern thm frac_ra_unit; * ```text * forall a. frac_full a == frac_own (&1) a * ``` + * + * 中文说明：说明分数所有权的组合、有效性或更新性质。 */ PROOF extern thm frac_ra_full; @@ -37,6 +41,8 @@ PROOF extern thm frac_ra_full; * ==> ra_op (frac_ra R) (frac_own p a) (frac_own q b) == * frac_own (p + q) (ra_op R a b) * ``` + * + * 中文说明：说明精确所有权如何反映 RA 的单位元、运算或有效性。 */ PROOF extern thm frac_ra_own_op; @@ -50,6 +56,8 @@ PROOF extern thm frac_ra_own_op; * &0 < p * ==> (ra_valid (frac_ra R) (frac_own p a) <=> p <= &1 && ra_valid R a) * ``` + * + * 中文说明：说明该资源或构造满足相应的有效性条件。 */ PROOF extern thm frac_ra_valid_own; @@ -57,6 +65,8 @@ PROOF extern thm frac_ra_valid_own; * ```text * forall R a. ra_valid R a ==> ra_maximal (frac_ra R) (frac_full a) * ``` + * + * 中文说明：说明 frame-maximal 资源只能与单位 frame 兼容。 */ PROOF extern thm frac_ra_maximal_full; @@ -72,6 +82,8 @@ PROOF extern thm frac_ra_maximal_full; * ==> ra_update R a b * ==> ra_update (frac_ra R) (frac_own p a) (frac_own q b) * ``` + * + * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 */ PROOF extern thm frac_ra_update_weaken; @@ -84,6 +96,8 @@ PROOF extern thm frac_ra_update_weaken; * ==> ra_updateP (frac_ra R) (frac_own p a) * (\x. exists b. P b && x == frac_own q b) * ``` + * + * 中文说明：说明谓词更新允许选择任意满足目标谓词的新资源。 */ PROOF extern thm frac_ra_updateP_weaken; @@ -93,5 +107,7 @@ PROOF extern thm frac_ra_updateP_weaken; * ra_update (frac_ra R) (frac_full a) (frac_full b) <=> * ra_valid R a ==> ra_valid R b * ``` + * + * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 */ PROOF extern thm frac_ra_update_full_iff; diff --git a/theory/logic/gmap_ra.h b/theory/logic/gmap_ra.h index 6ec663c..63015b8 100644 --- a/theory/logic/gmap_ra.h +++ b/theory/logic/gmap_ra.h @@ -22,6 +22,8 @@ * forall R:(V)ra. * ra_unit (gmap_ra R) == (finmap_empty:(K,V)finmap) * ``` + * + * 中文说明：说明 gmap 的运算和有效性按键逐点提升自 payload RA。 */ PROOF extern thm gmap_ra_unit; @@ -38,6 +40,8 @@ PROOF extern thm gmap_ra_unit; * (finmap_lookup m k) * (finmap_lookup n k) * ``` + * + * 中文说明：说明 gmap 的运算和有效性按键逐点提升自 payload RA。 */ PROOF extern thm gmap_ra_op_lookup; @@ -48,6 +52,8 @@ PROOF extern thm gmap_ra_op_lookup; * forall k:K. * ra_valid (option_ra R) (finmap_lookup m k) * ``` + * + * 中文说明：说明 gmap 的运算和有效性按键逐点提升自 payload RA。 */ PROOF extern thm gmap_ra_valid; @@ -57,6 +63,8 @@ PROOF extern thm gmap_ra_valid; * ra_valid (gmap_ra R) (finmap_singleton key a) <=> * ra_valid R a * ``` + * + * 中文说明：说明 gmap 的运算和有效性按键逐点提升自 payload RA。 */ PROOF extern thm gmap_ra_valid_singleton; @@ -71,6 +79,8 @@ PROOF extern thm gmap_ra_valid_singleton; * finmap_lookup m key == SOME a ==> * ra_valid R a * ``` + * + * 中文说明：说明 gmap 的运算和有效性按键逐点提升自 payload RA。 */ PROOF extern thm gmap_ra_valid_lookup; @@ -91,6 +101,8 @@ PROOF extern thm gmap_ra_valid_lookup; * (finmap_lookup m k) * (finmap_lookup n k) * ``` + * + * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 */ PROOF extern thm gmap_ra_included_lookup_iff; @@ -103,6 +115,8 @@ PROOF extern thm gmap_ra_included_lookup_iff; * ra_included (gmap_ra R) m n ==> * finmap_dom m SUBSET finmap_dom n * ``` + * + * 中文说明：刻画 gmap 的包含、查找或按键分解性质。 */ PROOF extern thm gmap_ra_included_dom; @@ -120,6 +134,8 @@ PROOF extern thm gmap_ra_included_dom; * (finmap_singleton key a) * (finmap_delete key m) * ``` + * + * 中文说明：刻画 gmap 的包含、查找或按键分解性质。 */ PROOF extern thm gmap_ra_decompose; @@ -144,6 +160,8 @@ PROOF extern thm gmap_ra_decompose; * (finmap_insert key b m) * (finmap_singleton key g) * ``` + * + * 中文说明：说明 gmap 可在指定键处提升局部更新或谓词更新。 */ PROOF extern thm gmap_ra_local_update_at; @@ -159,6 +177,8 @@ PROOF extern thm gmap_ra_local_update_at; * ra_update R a b ==> * ra_update (gmap_ra R) m (finmap_insert key b m) * ``` + * + * 中文说明：说明 gmap 可在指定键处提升局部更新或谓词更新。 */ PROOF extern thm gmap_ra_update_at; @@ -179,6 +199,8 @@ PROOF extern thm gmap_ra_update_at; * exists b:V. * P b && result == finmap_insert key b m) * ``` + * + * 中文说明：说明 gmap 可在指定键处提升局部更新或谓词更新。 */ PROOF extern thm gmap_ra_updateP_at; @@ -187,6 +209,8 @@ PROOF extern thm gmap_ra_updateP_at; * forall (R:(V)ra) (key:K) (m:(K,V)finmap). * ra_update (gmap_ra R) m (finmap_delete key m) * ``` + * + * 中文说明：说明 gmap 在指定键处删除当前片段。 */ PROOF extern thm gmap_ra_drop_at; @@ -215,6 +239,8 @@ PROOF extern thm gmap_ra_drop_at; * finmap_lookup m key == NONE && * result == finmap_insert key (payload key) m) * ``` + * + * 中文说明：说明 gmap 可选择新键并加入有效 payload。 */ PROOF extern thm gmap_ra_alloc_strong_dep; @@ -231,6 +257,8 @@ PROOF extern thm gmap_ra_alloc_strong_dep; * finmap_lookup m key == NONE && * result == finmap_insert key a m) * ``` + * + * 中文说明：说明 gmap 可选择新键并加入有效 payload。 */ PROOF extern thm gmap_ra_alloc; @@ -253,5 +281,7 @@ PROOF extern thm gmap_ra_alloc; * finmap_lookup m key == NONE && * result == finmap_insert key a m) * ``` + * + * 中文说明：说明 gmap 可选择新键并加入有效 payload。 */ PROOF extern thm gmap_ra_alloc_cofinite; diff --git a/theory/logic/gmap_ra_internal.h b/theory/logic/gmap_ra_internal.h index 56c32ff..ae5f172 100644 --- a/theory/logic/gmap_ra_internal.h +++ b/theory/logic/gmap_ra_internal.h @@ -16,6 +16,8 @@ * (finmap_singleton key b) == * finmap_singleton key (ra_op R a b) * ``` + * + * 中文说明：刻画 gmap 的包含、查找或按键分解性质。 */ PROOF extern thm gmap_ra_singleton_op; @@ -30,6 +32,8 @@ PROOF extern thm gmap_ra_singleton_op; * ra_op (gmap_ra R) (finmap_singleton key a) m == * finmap_insert key a m * ``` + * + * 中文说明：刻画 gmap 的包含、查找或按键分解性质。 */ PROOF extern thm gmap_ra_singleton_op_fresh; @@ -42,6 +46,8 @@ PROOF extern thm gmap_ra_singleton_op_fresh; * (finmap_singleton key a) * (finmap_singleton key b) * ``` + * + * 中文说明：说明 gmap 可在指定键处提升局部更新或谓词更新。 */ PROOF extern thm gmap_ra_update_singleton; @@ -56,6 +62,8 @@ PROOF extern thm gmap_ra_update_singleton; * exists b:V. * P b && m == finmap_singleton key b) * ``` + * + * 中文说明：说明 gmap 可在指定键处提升局部更新或谓词更新。 */ PROOF extern thm gmap_ra_updateP_singleton; @@ -77,5 +85,7 @@ PROOF extern thm gmap_ra_updateP_singleton; * finmap_lookup m key == NONE && * result == finmap_insert key a m) * ``` + * + * 中文说明：说明 gmap 可选择新键并加入有效 payload。 */ PROOF extern thm gmap_ra_alloc_strong; diff --git a/theory/logic/local_update.h b/theory/logic/local_update.h index 4704d2b..298c4ea 100644 --- a/theory/logic/local_update.h +++ b/theory/logic/local_update.h @@ -22,6 +22,8 @@ * ==> a == ra_op R f residual * ==> ra_valid R b && b == ra_op R g residual) * ``` + * + * 中文说明：说明局部更新在保留同一 residual 的同时替换可见片段。 */ PROOF extern thm ra_local_update_def; @@ -33,6 +35,8 @@ PROOF extern thm ra_local_update_def; * ==> a == ra_op R f residual * ==> ra_valid R b && b == ra_op R g residual * ``` + * + * 中文说明：说明局部更新在保留外部 residual 时替换内部片段。 */ PROOF extern thm ra_local_update_apply; @@ -44,6 +48,8 @@ PROOF extern thm ra_local_update_apply; * ```text * forall R a f. ra_local_update R a f a f * ``` + * + * 中文说明：说明该关系具有自反性。 */ PROOF extern thm ra_local_update_refl; @@ -54,6 +60,8 @@ PROOF extern thm ra_local_update_refl; * ==> ra_local_update R b g c h * ==> ra_local_update R a f c h * ``` + * + * 中文说明：说明该关系或变换可以传递地串联。 */ PROOF extern thm ra_local_update_trans; @@ -63,6 +71,8 @@ PROOF extern thm ra_local_update_trans; * ra_local_update R a f b g * ==> ra_local_update R a (ra_op R f extra) b (ra_op R g extra) * ``` + * + * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 */ PROOF extern thm ra_local_update_frame; @@ -74,6 +84,8 @@ PROOF extern thm ra_local_update_frame; * ==> ra_included R (ra_op R f external) a * ==> ra_valid R b && ra_included R (ra_op R g external) b * ``` + * + * 中文说明：说明局部更新在保留外部 residual 时替换内部片段。 */ PROOF extern thm ra_local_update_preserves_included; @@ -87,6 +99,8 @@ PROOF extern thm ra_local_update_preserves_included; * ra_valid R (ra_op R a piece) * ==> ra_local_update R a f (ra_op R a piece) (ra_op R f piece) * ``` + * + * 中文说明：说明局部更新在保留外部 residual 时替换内部片段。 */ PROOF extern thm ra_local_update_alloc; @@ -94,6 +108,8 @@ PROOF extern thm ra_local_update_alloc; * ```text * forall R a f b. ra_maximal R f ==> ra_valid R b ==> ra_local_update R a f b b * ``` + * + * 中文说明：说明局部更新在保留外部 residual 时替换内部片段。 */ PROOF extern thm ra_local_update_maximal; @@ -103,6 +119,8 @@ PROOF extern thm ra_local_update_maximal; * ra_cancellative R * ==> ra_local_update R (ra_op R common a) (ra_op R common f) a f * ``` + * + * 中文说明：说明局部更新在保留外部 residual 时替换内部片段。 */ PROOF extern thm ra_local_update_cancel; @@ -113,5 +131,7 @@ PROOF extern thm ra_local_update_cancel; * ==> ra_valid R (ra_op R b common) * ==> ra_local_update R (ra_op R a common) a (ra_op R b common) b * ``` + * + * 中文说明：说明局部更新在保留外部 residual 时替换内部片段。 */ PROOF extern thm ra_local_update_cancellative; diff --git a/theory/logic/max_nat_ra.h b/theory/logic/max_nat_ra.h index fed4a05..4a2723d 100644 --- a/theory/logic/max_nat_ra.h +++ b/theory/logic/max_nat_ra.h @@ -19,6 +19,8 @@ * ```text * ra_unit max_nat_ra == 0 * ``` + * + * 中文说明：说明 max-nat RA 的最大值运算及其包含、更新性质。 */ PROOF extern thm max_nat_ra_unit; @@ -26,6 +28,8 @@ PROOF extern thm max_nat_ra_unit; * ```text * forall a b. ra_op max_nat_ra a b == MAX a b * ``` + * + * 中文说明：说明 max-nat RA 的最大值运算及其包含、更新性质。 */ PROOF extern thm max_nat_ra_op; @@ -33,6 +37,8 @@ PROOF extern thm max_nat_ra_op; * ```text * forall n. ra_valid max_nat_ra n * ``` + * + * 中文说明：说明该资源或构造满足相应的有效性条件。 */ PROOF extern thm max_nat_ra_valid; @@ -40,6 +46,8 @@ PROOF extern thm max_nat_ra_valid; * ```text * forall a b. ra_included max_nat_ra a b <=> a <= b * ``` + * + * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 */ PROOF extern thm max_nat_ra_included; @@ -47,6 +55,8 @@ PROOF extern thm max_nat_ra_included; * ```text * forall n. ra_op max_nat_ra n n == n * ``` + * + * 中文说明：说明该运算或变换是幂等的，重复应用不会产生额外变化。 */ PROOF extern thm max_nat_ra_idempotent; @@ -58,5 +68,7 @@ PROOF extern thm max_nat_ra_idempotent; * ```text * forall old new. ra_update max_nat_ra old new * ``` + * + * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 */ PROOF extern thm max_nat_ra_update; diff --git a/theory/logic/named_logic.h b/theory/logic/named_logic.h index b8942f8..a99711e 100644 --- a/theory/logic/named_logic.h +++ b/theory/logic/named_logic.h @@ -12,6 +12,8 @@ * named_own (R:(A)ra) (name:num) (a:A) : (num,A)finmap->bool = r_own (named_ra * R) (finmap_singleton name a) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm named_own_def; /** @@ -22,6 +24,8 @@ PROOF extern thm named_own_def; * name (ra_op R a b)) (r_sep (named_ra R) (named_own R name a) (named_own R * name b)) * ``` + * + * 中文说明：说明命名所有权在固定名字下的组合、有效性或更新规则。 */ PROOF extern thm named_own_op; /** @@ -32,6 +36,8 @@ PROOF extern thm named_own_op; * a) (r_sep (named_ra R) (r_fact (named_ra R) (ra_valid R a)) (named_own R * name a)) * ``` + * + * 中文说明：说明命名所有权在固定名字下的组合、有效性或更新规则。 */ PROOF extern thm named_own_valid; /** @@ -41,6 +47,8 @@ PROOF extern thm named_own_valid; * forall (R:(A)ra) (name:num) (a:A) (b:A). ra_update R a b ==> r_viewshift * (named_ra R) (named_own R name a) (named_own R name b) * ``` + * + * 中文说明：说明命名所有权在固定名字下的组合、有效性或更新规则。 */ PROOF extern thm named_own_update; /** @@ -51,6 +59,8 @@ PROOF extern thm named_own_update; * r_viewshift (named_ra R) (named_own R name a) (r_exists (named_ra R) (\b:A. * r_sep (named_ra R) (r_fact (named_ra R) (P b)) (named_own R name b))) * ``` + * + * 中文说明：说明命名所有权在固定名字下的组合、有效性或更新规则。 */ PROOF extern thm named_own_updateP; /** @@ -60,6 +70,8 @@ PROOF extern thm named_own_updateP; * forall (R:(A)ra) (name:num) (a:A). r_viewshift (named_ra R) (named_own R * name a) (r_emp (named_ra R)) * ``` + * + * 中文说明：说明 drop 只丢弃当前 singleton 片段，并不声称全局不存在同名资源。 */ PROOF extern thm named_own_drop; /** @@ -70,5 +82,7 @@ PROOF extern thm named_own_drop; * (named_ra R) P (r_exists (named_ra R) (\name:num. r_sep (named_ra R) * (named_own R name a) P)) * ``` + * + * 中文说明：说明可在保留原 frame 的同时分配一个新名字及其所有权。 */ PROOF extern thm named_own_alloc; diff --git a/theory/logic/named_ra.h b/theory/logic/named_ra.h index 8f99cb8..633ecb2 100644 --- a/theory/logic/named_ra.h +++ b/theory/logic/named_ra.h @@ -18,6 +18,8 @@ * ```text * named_ra (R:(A)ra) == (gmap_ra R:((num,A)finmap)ra) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm named_ra_def; @@ -26,6 +28,8 @@ PROOF extern thm named_ra_def; * forall R:(A)ra. * ra_unit (named_ra R) == (finmap_empty:(num,A)finmap) * ``` + * + * 中文说明：说明命名 RA 将底层 payload 规则提升到固定名字。 */ PROOF extern thm named_ra_unit; @@ -38,6 +42,8 @@ PROOF extern thm named_ra_unit; * (finmap_singleton name b) == * finmap_singleton name (ra_op R a b) * ``` + * + * 中文说明：说明命名 RA 将底层 payload 规则提升到固定名字。 */ PROOF extern thm named_ra_singleton_op; @@ -47,6 +53,8 @@ PROOF extern thm named_ra_singleton_op; * ra_valid (named_ra R) (finmap_singleton name a) <=> * ra_valid R a * ``` + * + * 中文说明：说明命名 RA 将底层 payload 规则提升到固定名字。 */ PROOF extern thm named_ra_valid_singleton; @@ -63,6 +71,8 @@ PROOF extern thm named_ra_valid_singleton; * (finmap_singleton name a) * (finmap_singleton name b) * ``` + * + * 中文说明：说明命名 RA 将底层 payload 规则提升到固定名字。 */ PROOF extern thm named_ra_update_singleton; @@ -76,6 +86,8 @@ PROOF extern thm named_ra_update_singleton; * (\m:(num,A)finmap. * exists b:A. P b && m == finmap_singleton name b) * ``` + * + * 中文说明：说明命名 RA 将底层 payload 规则提升到固定名字。 */ PROOF extern thm named_ra_updateP_singleton; @@ -91,6 +103,8 @@ PROOF extern thm named_ra_updateP_singleton; * (finmap_singleton name a) * (finmap_empty:(num,A)finmap) * ``` + * + * 中文说明：说明固定名字下的 singleton 片段可更新为命名 RA 的单位元。 */ PROOF extern thm named_ra_drop; @@ -106,5 +120,7 @@ PROOF extern thm named_ra_drop; * finmap_lookup m name == NONE && * result == finmap_insert name a m) * ``` + * + * 中文说明：说明可选择一个新名字并向命名 RA 中插入有效 payload。 */ PROOF extern thm named_ra_alloc; diff --git a/theory/logic/option_ra.h b/theory/logic/option_ra.h index ae7590d..6f45169 100644 --- a/theory/logic/option_ra.h +++ b/theory/logic/option_ra.h @@ -18,6 +18,8 @@ * ```text * forall R. ra_unit (option_ra R) == NONE * ``` + * + * 中文说明：说明 option RA 如何处理 NONE、SOME 及底层 payload。 */ PROOF extern thm option_ra_unit; @@ -25,6 +27,8 @@ PROOF extern thm option_ra_unit; * ```text * forall R x. ra_op (option_ra R) NONE x == x * ``` + * + * 中文说明：说明 option RA 如何处理 NONE、SOME 及底层 payload。 */ PROOF extern thm option_ra_op_none_l; @@ -32,6 +36,8 @@ PROOF extern thm option_ra_op_none_l; * ```text * forall R a b. ra_op (option_ra R) (SOME a) (SOME b) == SOME (ra_op R a b) * ``` + * + * 中文说明：说明 option RA 如何处理 NONE、SOME 及底层 payload。 */ PROOF extern thm option_ra_op_some_some; @@ -39,6 +45,8 @@ PROOF extern thm option_ra_op_some_some; * ```text * forall R. ra_valid (option_ra R) NONE * ``` + * + * 中文说明：说明该资源或构造满足相应的有效性条件。 */ PROOF extern thm option_ra_valid_none; @@ -46,6 +54,8 @@ PROOF extern thm option_ra_valid_none; * ```text * forall R a. ra_valid (option_ra R) (SOME a) <=> ra_valid R a * ``` + * + * 中文说明：说明该资源或构造满足相应的有效性条件。 */ PROOF extern thm option_ra_valid_some; @@ -57,6 +67,8 @@ PROOF extern thm option_ra_valid_some; * ```text * forall R x. ra_included (option_ra R) NONE x * ``` + * + * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 */ PROOF extern thm option_ra_included_none; @@ -65,6 +77,8 @@ PROOF extern thm option_ra_included_none; * forall R a b. * ra_included (option_ra R) (SOME a) (SOME b) <=> ra_included R a b * ``` + * + * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 */ PROOF extern thm option_ra_included_some_some; @@ -72,6 +86,8 @@ PROOF extern thm option_ra_included_some_some; * ```text * forall R a. ~ra_included (option_ra R) (SOME a) NONE * ``` + * + * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 */ PROOF extern thm option_ra_not_included_some_none; @@ -79,6 +95,8 @@ PROOF extern thm option_ra_not_included_some_none; * ```text * forall R. ~(SOME (ra_unit R) == NONE) * ``` + * + * 中文说明：说明该构造得到无效资源或互斥组合。 */ PROOF extern thm option_ra_some_unit_ne_none; @@ -86,6 +104,8 @@ PROOF extern thm option_ra_some_unit_ne_none; * ```text * forall R. ~ra_cancellative (option_ra R) * ``` + * + * 中文说明：说明该资源代数满足或不满足消去性质。 */ PROOF extern thm option_ra_not_cancellative; @@ -99,6 +119,8 @@ PROOF extern thm option_ra_not_cancellative; * ra_updateP (option_ra R) (SOME a) (\x. exists b. P b && x == SOME b) <=> * ra_updateP R a P * ``` + * + * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 */ PROOF extern thm option_ra_updateP_iff; @@ -106,6 +128,8 @@ PROOF extern thm option_ra_updateP_iff; * ```text * forall R a b. ra_update (option_ra R) (SOME a) (SOME b) <=> ra_update R a b * ``` + * + * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 */ PROOF extern thm option_ra_update_iff; @@ -115,5 +139,7 @@ PROOF extern thm option_ra_update_iff; * ra_local_update (option_ra R) (SOME a) (SOME f) (SOME b) (SOME g) <=> * ra_local_update R a f b g * ``` + * + * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 */ PROOF extern thm option_ra_local_update_iff; diff --git a/theory/logic/option_ra_internal.h b/theory/logic/option_ra_internal.h index ea21a16..59263d6 100644 --- a/theory/logic/option_ra_internal.h +++ b/theory/logic/option_ra_internal.h @@ -11,6 +11,8 @@ * ```text * forall R x. ra_op (option_ra R) x NONE == x * ``` + * + * 中文说明：说明 option RA 如何处理 NONE、SOME 及底层 payload。 */ PROOF extern thm option_ra_op_none_r; @@ -18,6 +20,8 @@ PROOF extern thm option_ra_op_none_r; * ```text * forall R a b. ra_update R a b ==> ra_update (option_ra R) (SOME a) (SOME b) * ``` + * + * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 */ PROOF extern thm option_ra_update; @@ -27,5 +31,7 @@ PROOF extern thm option_ra_update; * ra_updateP R a P * ==> ra_updateP (option_ra R) (SOME a) (\x. exists b. P b && x == SOME b) * ``` + * + * 中文说明：说明谓词更新允许选择任意满足目标谓词的新资源。 */ PROOF extern thm option_ra_updateP; diff --git a/theory/logic/prod_ra.h b/theory/logic/prod_ra.h index 45a7904..3eab171 100644 --- a/theory/logic/prod_ra.h +++ b/theory/logic/prod_ra.h @@ -19,6 +19,8 @@ * ```text * forall R1 R2. ra_unit (prod_ra R1 R2) == ra_unit R1,ra_unit R2 * ``` + * + * 中文说明：说明乘积 RA 的运算、投影或更新由两个分量共同决定。 */ PROOF extern thm prod_ra_unit; @@ -28,6 +30,8 @@ PROOF extern thm prod_ra_unit; * ra_op (prod_ra R1 R2) x y == * ra_op R1 (FST x) (FST y),ra_op R2 (SND x) (SND y) * ``` + * + * 中文说明：说明乘积 RA 的运算、投影或更新由两个分量共同决定。 */ PROOF extern thm prod_ra_op; @@ -36,6 +40,8 @@ PROOF extern thm prod_ra_op; * forall R1 R2 x. * ra_valid (prod_ra R1 R2) x <=> ra_valid R1 (FST x) && ra_valid R2 (SND x) * ``` + * + * 中文说明：说明该资源或构造满足相应的有效性条件。 */ PROOF extern thm prod_ra_valid; @@ -45,6 +51,8 @@ PROOF extern thm prod_ra_valid; * ra_included (prod_ra R1 R2) x y <=> * ra_included R1 (FST x) (FST y) && ra_included R2 (SND x) (SND y) * ``` + * + * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 */ PROOF extern thm prod_ra_included; @@ -54,6 +62,8 @@ PROOF extern thm prod_ra_included; * ra_cancellative (prod_ra R1 R2) <=> * ra_cancellative R1 && ra_cancellative R2 * ``` + * + * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 */ PROOF extern thm prod_ra_cancellative_iff; @@ -63,6 +73,8 @@ PROOF extern thm prod_ra_cancellative_iff; * ra_maximal (prod_ra R1 R2) x <=> * ra_maximal R1 (FST x) && ra_maximal R2 (SND x) * ``` + * + * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 */ PROOF extern thm prod_ra_maximal_iff; @@ -78,6 +90,8 @@ PROOF extern thm prod_ra_maximal_iff; * ==> ra_updateP (prod_ra R1 R2) (a1,a2) * (\x. exists b1 b2. P1 b1 && P2 b2 && x == b1,b2) * ``` + * + * 中文说明：说明谓词更新允许选择任意满足目标谓词的新资源。 */ PROOF extern thm prod_ra_updateP; @@ -86,6 +100,8 @@ PROOF extern thm prod_ra_updateP; * forall R1 R2 a1 a2 b1. * ra_update R1 a1 b1 ==> ra_update (prod_ra R1 R2) (a1,a2) (b1,a2) * ``` + * + * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 */ PROOF extern thm prod_ra_update_left; @@ -94,6 +110,8 @@ PROOF extern thm prod_ra_update_left; * forall R1 R2 a1 a2 b2. * ra_update R2 a2 b2 ==> ra_update (prod_ra R1 R2) (a1,a2) (a1,b2) * ``` + * + * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 */ PROOF extern thm prod_ra_update_right; @@ -104,6 +122,8 @@ PROOF extern thm prod_ra_update_right; * ==> ra_local_update R2 a2 f2 b2 g2 * ==> ra_local_update (prod_ra R1 R2) (a1,a2) (f1,f2) (b1,b2) (g1,g2) * ``` + * + * 中文说明：说明局部更新在保留外部 residual 时替换内部片段。 */ PROOF extern thm prod_ra_local_update; @@ -115,6 +135,8 @@ PROOF extern thm prod_ra_local_update; * ```text * forall R S a. prod_inl R S a == a,ra_unit S * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm prod_inl_def; @@ -122,6 +144,8 @@ PROOF extern thm prod_inl_def; * ```text * forall R S b. prod_inr R S b == ra_unit R,b * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm prod_inr_def; @@ -131,6 +155,8 @@ PROOF extern thm prod_inr_def; * prod_inl R S (ra_op R a b) == * ra_op (prod_ra R S) (prod_inl R S a) (prod_inl R S b) * ``` + * + * 中文说明：说明乘积 RA 的运算、投影或更新由两个分量共同决定。 */ PROOF extern thm prod_inl_op; @@ -140,6 +166,8 @@ PROOF extern thm prod_inl_op; * prod_inr R S (ra_op S a b) == * ra_op (prod_ra R S) (prod_inr R S a) (prod_inr R S b) * ``` + * + * 中文说明：说明乘积 RA 的运算、投影或更新由两个分量共同决定。 */ PROOF extern thm prod_inr_op; @@ -150,6 +178,8 @@ PROOF extern thm prod_inr_op; * ==> ra_updateP (prod_ra R S) (prod_inl R S a) * (\x. exists b. P b && x == prod_inl R S b) * ``` + * + * 中文说明：说明谓词更新允许选择任意满足目标谓词的新资源。 */ PROOF extern thm prod_inl_updateP; @@ -160,6 +190,8 @@ PROOF extern thm prod_inl_updateP; * ==> ra_updateP (prod_ra R S) (prod_inr R S a) * (\x. exists b. P b && x == prod_inr R S b) * ``` + * + * 中文说明：说明谓词更新允许选择任意满足目标谓词的新资源。 */ PROOF extern thm prod_inr_updateP; @@ -169,6 +201,8 @@ PROOF extern thm prod_inr_updateP; * ra_update R a b * ==> ra_update (prod_ra R S) (prod_inl R S a) (prod_inl R S b) * ``` + * + * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 */ PROOF extern thm prod_inl_update; @@ -178,5 +212,7 @@ PROOF extern thm prod_inl_update; * ra_update S a b * ==> ra_update (prod_ra R S) (prod_inr R S a) (prod_inr R S b) * ``` + * + * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 */ PROOF extern thm prod_inr_update; diff --git a/theory/logic/prod_ra_internal.h b/theory/logic/prod_ra_internal.h index eaa6f03..4d2b43c 100644 --- a/theory/logic/prod_ra_internal.h +++ b/theory/logic/prod_ra_internal.h @@ -14,5 +14,7 @@ * ==> ra_cancellative R2 * ==> ra_cancellative (prod_ra R1 R2) * ``` + * + * 中文说明：说明该资源代数满足或不满足消去性质。 */ PROOF extern thm prod_ra_cancellative; diff --git a/theory/logic/product_resource.h b/theory/logic/product_resource.h index bd631fa..00d82eb 100644 --- a/theory/logic/product_resource.h +++ b/theory/logic/product_resource.h @@ -31,6 +31,8 @@ * r_lift_left (R:(A)ra) (S:(B)ra) (P:A->bool) (resource:A#B) <=> P (FST * resource) && SND resource == ra_unit S * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm r_lift_left_def; /** @@ -40,6 +42,8 @@ PROOF extern thm r_lift_left_def; * r_lift_right (R:(A)ra) (S:(B)ra) (Q:B->bool) (resource:A#B) <=> FST resource * == ra_unit R && Q (SND resource) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm r_lift_right_def; @@ -51,6 +55,8 @@ PROOF extern thm r_lift_right_def; * forall (R:(A)ra) (S:(B)ra). r_equiv (prod_ra R S) (r_lift_left R S (r_emp * R)) (r_emp (prod_ra R S)) * ``` + * + * 中文说明：说明把左侧 emp 精确提升到乘积后等价于乘积 emp。 */ PROOF extern thm r_lift_left_emp; /** @@ -60,6 +66,8 @@ PROOF extern thm r_lift_left_emp; * forall (R:(A)ra) (S:(B)ra). r_equiv (prod_ra R S) (r_lift_right R S (r_emp * S)) (r_emp (prod_ra R S)) * ``` + * + * 中文说明：说明把右侧 emp 精确提升到乘积后等价于乘积 emp。 */ PROOF extern thm r_lift_right_emp; /** @@ -70,6 +78,8 @@ PROOF extern thm r_lift_right_emp; * (r_lift_left R S (r_sep R P Q)) (r_sep (prod_ra R S) (r_lift_left R S P) * (r_lift_left R S Q)) * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_lift_left_sep; /** @@ -80,6 +90,8 @@ PROOF extern thm r_lift_left_sep; * (r_lift_right R S (r_sep S P Q)) (r_sep (prod_ra R S) (r_lift_right R S P) * (r_lift_right R S Q)) * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_lift_right_sep; /** @@ -89,6 +101,8 @@ PROOF extern thm r_lift_right_sep; * forall (R:(A)ra) (S:(B)ra) (P:A->bool) (Q:A->bool). r_entails R P Q ==> * r_entails (prod_ra R S) (r_lift_left R S P) (r_lift_left R S Q) * ``` + * + * 中文说明：说明逻辑蕴含的组合、改写或框架规则。 */ PROOF extern thm r_lift_left_entails; /** @@ -98,6 +112,8 @@ PROOF extern thm r_lift_left_entails; * forall (R:(A)ra) (S:(B)ra) (P:B->bool) (Q:B->bool). r_entails S P Q ==> * r_entails (prod_ra R S) (r_lift_right R S P) (r_lift_right R S Q) * ``` + * + * 中文说明：说明逻辑蕴含的组合、改写或框架规则。 */ PROOF extern thm r_lift_right_entails; @@ -109,6 +125,8 @@ PROOF extern thm r_lift_right_entails; * r_bupd_right (R:(A)ra) (S:(B)ra) (Q:(A#B)->bool) (resource:A#B) <=> * ra_updateP S (SND resource) (\right':B. Q (FST resource,right')) * ``` + * + * 中文说明：说明右侧 basic update 只改变产品资源的右投影。 */ PROOF extern thm r_bupd_right_def; /** @@ -118,6 +136,8 @@ PROOF extern thm r_bupd_right_def; * r_viewshift_right (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Q:(A#B)->bool) <=> * r_entails (prod_ra R S) P (r_bupd_right R S Q) * ``` + * + * 中文说明：说明右侧 view shift 是基于右投影更新的逻辑蕴含。 */ PROOF extern thm r_viewshift_right_def; @@ -129,6 +149,8 @@ PROOF extern thm r_viewshift_right_def; * forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool). r_entails (prod_ra R S) P * (r_bupd_right R S P) * ``` + * + * 中文说明：给出该逻辑构造的引入规则。 */ PROOF extern thm r_bupd_right_intro; /** @@ -139,6 +161,8 @@ PROOF extern thm r_bupd_right_intro; * (prod_ra R S) P Q ==> r_entails (prod_ra R S) (r_bupd_right R S P) * (r_bupd_right R S Q) * ``` + * + * 中文说明：说明该构造对蕴含或底层关系保持单调。 */ PROOF extern thm r_bupd_right_mono; /** @@ -148,6 +172,8 @@ PROOF extern thm r_bupd_right_mono; * forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool). r_entails (prod_ra R S) * (r_bupd_right R S (r_bupd_right R S P)) (r_bupd_right R S P) * ``` + * + * 中文说明：说明该运算或变换是幂等的，重复应用不会产生额外变化。 */ PROOF extern thm r_bupd_right_idem; /** @@ -158,6 +184,8 @@ PROOF extern thm r_bupd_right_idem; * (prod_ra R S) (r_sep (prod_ra R S) (r_bupd_right R S P) Frame) (r_bupd_right * R S (r_sep (prod_ra R S) P Frame)) * ``` + * + * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 */ PROOF extern thm r_bupd_right_frame; @@ -168,6 +196,8 @@ PROOF extern thm r_bupd_right_frame; * ```text * forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool). r_viewshift_right R S P P * ``` + * + * 中文说明：说明该关系具有自反性。 */ PROOF extern thm r_viewshift_right_refl; /** @@ -177,6 +207,8 @@ PROOF extern thm r_viewshift_right_refl; * forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool) (Q:(A#B)->bool). r_entails * (prod_ra R S) P Q ==> r_viewshift_right R S P Q * ``` + * + * 中文说明：说明逻辑蕴含的组合、改写或框架规则。 */ PROOF extern thm r_viewshift_right_entails; /** @@ -187,6 +219,8 @@ PROOF extern thm r_viewshift_right_entails; * r_viewshift_right R S P Q ==> r_viewshift_right R S Q U ==> * r_viewshift_right R S P U * ``` + * + * 中文说明：说明该关系或变换可以传递地串联。 */ PROOF extern thm r_viewshift_right_trans; /** @@ -197,6 +231,8 @@ PROOF extern thm r_viewshift_right_trans; * (Q2:(A#B)->bool). r_entails (prod_ra R S) P2 P ==> r_viewshift_right R S P Q * ==> r_entails (prod_ra R S) Q Q2 ==> r_viewshift_right R S P2 Q2 * ``` + * + * 中文说明：说明该构造对蕴含或底层关系保持单调。 */ PROOF extern thm r_viewshift_right_mono; /** @@ -207,6 +243,8 @@ PROOF extern thm r_viewshift_right_mono; * (Frame:(A#B)->bool). r_viewshift_right R S P Q ==> r_viewshift_right R S * (r_sep (prod_ra R S) P Frame) (r_sep (prod_ra R S) Q Frame) * ``` + * + * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 */ PROOF extern thm r_viewshift_right_frame; /** @@ -218,6 +256,8 @@ PROOF extern thm r_viewshift_right_frame; * r_viewshift_right R S P2 Q2 ==> r_viewshift_right R S (r_sep (prod_ra R S) * P1 P2) (r_sep (prod_ra R S) Q1 Q2) * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_viewshift_right_sep; /** @@ -229,6 +269,8 @@ PROOF extern thm r_viewshift_right_sep; * (prod_ra R S) (r_fact (prod_ra R S) guard) P) (r_sep (prod_ra R S) (r_fact * (prod_ra R S) guard) Q) * ``` + * + * 中文说明：说明 spatial fact 的构造、消去、复制或与 sep 的关系。 */ PROOF extern thm r_viewshift_right_fact; /** @@ -240,6 +282,8 @@ PROOF extern thm r_viewshift_right_fact; * r_viewshift_right R S (r_exists (prod_ra R S) (\bound:C. P bound)) (r_exists * (prod_ra R S) (\bound:C. Q bound)) * ``` + * + * 中文说明：说明存在量词的引入、消去、单调性或与 sep 的交换。 */ PROOF extern thm r_viewshift_right_exists; @@ -252,6 +296,8 @@ PROOF extern thm r_viewshift_right_exists; * r_viewshift_right R S (r_lift_right R S (r_own S a)) (r_lift_right R S * (r_own S b)) * ``` + * + * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 */ PROOF extern thm r_right_own_update; /** @@ -263,5 +309,7 @@ PROOF extern thm r_right_own_update; * (\b:B. r_sep (prod_ra R S) (r_fact (prod_ra R S) (P b)) (r_lift_right R S * (r_own S b)))) * ``` + * + * 中文说明：说明右侧谓词更新返回新 witness、对应 fact 和新所有权。 */ PROOF extern thm r_right_own_updateP; diff --git a/theory/logic/product_resource_internal.h b/theory/logic/product_resource_internal.h index a023cbd..1e3aa3e 100644 --- a/theory/logic/product_resource_internal.h +++ b/theory/logic/product_resource_internal.h @@ -18,6 +18,8 @@ * forall (R:(A)ra) (S:(B)ra). r_lift_left R S (r_emp R) == r_emp * (prod_ra R S) * ``` + * + * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 */ PROOF extern thm r_lift_left_emp_eq; /** @@ -27,6 +29,8 @@ PROOF extern thm r_lift_left_emp_eq; * forall (R:(A)ra) (S:(B)ra). r_lift_right R S (r_emp S) == r_emp (prod_ra R * S) * ``` + * + * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 */ PROOF extern thm r_lift_right_emp_eq; /** @@ -36,6 +40,8 @@ PROOF extern thm r_lift_right_emp_eq; * forall (R:(A)ra) (S:(B)ra) (P:A->bool) (Q:A->bool). r_lift_left R S (r_sep R * P Q) == r_sep (prod_ra R S) (r_lift_left R S P) (r_lift_left R S Q) * ``` + * + * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 */ PROOF extern thm r_lift_left_sep_eq; /** @@ -45,5 +51,7 @@ PROOF extern thm r_lift_left_sep_eq; * forall (R:(A)ra) (S:(B)ra) (P:B->bool) (Q:B->bool). r_lift_right R S (r_sep * S P Q) == r_sep (prod_ra R S) (r_lift_right R S P) (r_lift_right R S Q) * ``` + * + * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 */ PROOF extern thm r_lift_right_sep_eq; diff --git a/theory/logic/ra.h b/theory/logic/ra.h index f2c4f59..4d02661 100644 --- a/theory/logic/ra.h +++ b/theory/logic/ra.h @@ -25,6 +25,8 @@ * ```text * ra_compatible R a b <=> ra_valid R (ra_op R a b) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm ra_compatible_def; @@ -32,6 +34,8 @@ PROOF extern thm ra_compatible_def; * ```text * ra_included R a b <=> (exists frame. b == ra_op R a frame) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm ra_included_def; @@ -42,6 +46,8 @@ PROOF extern thm ra_included_def; * ra_valid R (ra_op R a frame) * ==> (exists b. result b && ra_valid R (ra_op R b frame))) * ``` + * + * 中文说明：说明谓词更新要求每个兼容 frame 都存在满足目标谓词的新资源。 */ PROOF extern thm ra_updateP_def; @@ -49,6 +55,8 @@ PROOF extern thm ra_updateP_def; * ```text * ra_update R a b <=> ra_updateP R a (\x. x == b) * ``` + * + * 中文说明：说明确定性更新是目标谓词为单点集合时的谓词更新。 */ PROOF extern thm ra_update_def; @@ -60,6 +68,8 @@ PROOF extern thm ra_update_def; * ==> ra_op R frame a == ra_op R frame b * ==> a == b) * ``` + * + * 中文说明：说明可消去性允许在有效组合中消去相同的 frame。 */ PROOF extern thm ra_cancellative_def; @@ -69,6 +79,8 @@ PROOF extern thm ra_cancellative_def; * ra_valid R a && * (forall frame. ra_valid R (ra_op R a frame) ==> frame == ra_unit R) * ``` + * + * 中文说明：说明 maximal 表示源资源有效，且唯一兼容 frame 是 unit。 */ PROOF extern thm ra_maximal_def; @@ -80,6 +92,8 @@ PROOF extern thm ra_maximal_def; * ```text * forall R. ra_laws (ra_unit R) (ra_op R) (ra_valid R) * ``` + * + * 中文说明：汇总资源代数的结合、交换、单位元、单位有效及向下封闭规律。 */ PROOF extern thm ra_laws; @@ -87,6 +101,8 @@ PROOF extern thm ra_laws; * ```text * forall R a b c. ra_op R (ra_op R a b) c == ra_op R a (ra_op R b c) * ``` + * + * 中文说明：说明该运算满足结合律，改变括号结构不会改变结果。 */ PROOF extern thm ra_assoc; @@ -94,6 +110,8 @@ PROOF extern thm ra_assoc; * ```text * forall R a b. ra_op R a b == ra_op R b a * ``` + * + * 中文说明：说明该运算满足交换律，交换两个操作数不会改变结果。 */ PROOF extern thm ra_comm; @@ -101,6 +119,8 @@ PROOF extern thm ra_comm; * ```text * forall R a. ra_op R (ra_unit R) a == a * ``` + * + * 中文说明：说明单位元在组合运算左侧不改变资源。 */ PROOF extern thm ra_unit_l; @@ -108,6 +128,8 @@ PROOF extern thm ra_unit_l; * ```text * forall R a. ra_op R a (ra_unit R) == a * ``` + * + * 中文说明：说明单位元在组合运算右侧不改变资源。 */ PROOF extern thm ra_unit_r; @@ -115,6 +137,8 @@ PROOF extern thm ra_unit_r; * ```text * forall R. ra_valid R (ra_unit R) * ``` + * + * 中文说明：说明该资源或构造满足相应的有效性条件。 */ PROOF extern thm ra_valid_unit; @@ -122,6 +146,8 @@ PROOF extern thm ra_valid_unit; * ```text * forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R a && ra_valid R b * ``` + * + * 中文说明：说明该资源或构造满足相应的有效性条件。 */ PROOF extern thm ra_valid_op; @@ -133,6 +159,8 @@ PROOF extern thm ra_valid_op; * ```text * forall R a b. ra_compatible R a b <=> ra_compatible R b a * ``` + * + * 中文说明：说明资源兼容性是对称的，交换两个资源不影响兼容性。 */ PROOF extern thm ra_compat_comm; @@ -140,6 +168,8 @@ PROOF extern thm ra_compat_comm; * ```text * forall R a. ra_compatible R a (ra_unit R) <=> ra_valid R a * ``` + * + * 中文说明：刻画两个资源能否有效组合。 */ PROOF extern thm ra_compat_unit; @@ -147,6 +177,8 @@ PROOF extern thm ra_compat_unit; * ```text * forall R a. ra_included R a a * ``` + * + * 中文说明：说明该关系具有自反性。 */ PROOF extern thm ra_included_refl; @@ -154,6 +186,8 @@ PROOF extern thm ra_included_refl; * ```text * forall R a. ra_included R (ra_unit R) a * ``` + * + * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 */ PROOF extern thm ra_included_unit; @@ -161,6 +195,8 @@ PROOF extern thm ra_included_unit; * ```text * forall R a b. ra_included R a (ra_op R a b) * ``` + * + * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 */ PROOF extern thm ra_included_op_l; @@ -168,6 +204,8 @@ PROOF extern thm ra_included_op_l; * ```text * forall R a b. ra_included R b (ra_op R a b) * ``` + * + * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 */ PROOF extern thm ra_included_op_r; @@ -175,6 +213,8 @@ PROOF extern thm ra_included_op_r; * ```text * forall R a b c. ra_included R a b ==> ra_included R b c ==> ra_included R a c * ``` + * + * 中文说明：说明该关系或变换可以传递地串联。 */ PROOF extern thm ra_included_trans; @@ -185,6 +225,8 @@ PROOF extern thm ra_included_trans; * ==> ra_included R b1 b2 * ==> ra_included R (ra_op R a1 b1) (ra_op R a2 b2) * ``` + * + * 中文说明：说明该构造对蕴含或底层关系保持单调。 */ PROOF extern thm ra_included_op_mono; @@ -192,6 +234,8 @@ PROOF extern thm ra_included_op_mono; * ```text * forall R a b. ra_included R a b ==> ra_valid R b ==> ra_valid R a * ``` + * + * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 */ PROOF extern thm ra_included_valid; @@ -203,6 +247,8 @@ PROOF extern thm ra_included_valid; * ```text * forall R a b. ra_updateP R a (\x. x == b) <=> ra_update R a b * ``` + * + * 中文说明：说明单点目标的谓词更新与确定性更新等价。 */ PROOF extern thm ra_updateP_singleton; @@ -210,6 +256,8 @@ PROOF extern thm ra_updateP_singleton; * ```text * forall R a. ra_updateP R a (\x. x == a) * ``` + * + * 中文说明：说明该关系具有自反性。 */ PROOF extern thm ra_updateP_refl; @@ -218,6 +266,8 @@ PROOF extern thm ra_updateP_refl; * forall R a P Q. * ra_updateP R a P ==> (forall b. P b ==> Q b) ==> ra_updateP R a Q * ``` + * + * 中文说明：说明该构造对蕴含或底层关系保持单调。 */ PROOF extern thm ra_updateP_mono; @@ -228,6 +278,8 @@ PROOF extern thm ra_updateP_mono; * ==> (forall b. P b ==> ra_updateP R b Q) * ==> ra_updateP R a Q * ``` + * + * 中文说明：说明该关系或变换可以传递地串联。 */ PROOF extern thm ra_updateP_trans; @@ -236,6 +288,8 @@ PROOF extern thm ra_updateP_trans; * forall R a P. * ra_updateP R a P ==> ra_valid R a ==> (exists b. P b && ra_valid R b) * ``` + * + * 中文说明：说明有效源上的谓词更新至少产生一个有效 witness。 */ PROOF extern thm ra_updateP_valid; @@ -246,6 +300,8 @@ PROOF extern thm ra_updateP_valid; * ==> ra_updateP R (ra_op R a extra) * (\x. exists b. P b && x == ra_op R b extra) * ``` + * + * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 */ PROOF extern thm ra_updateP_frame; @@ -257,6 +313,8 @@ PROOF extern thm ra_updateP_frame; * ==> ra_updateP R (ra_op R a c) * (\x. exists b d. P b && Q d && x == ra_op R b d) * ``` + * + * 中文说明：说明两个谓词更新可以在 RA 组合运算下同步执行。 */ PROOF extern thm ra_updateP_op; @@ -268,6 +326,8 @@ PROOF extern thm ra_updateP_op; * ```text * forall R a. ra_update R a a * ``` + * + * 中文说明：说明该关系具有自反性。 */ PROOF extern thm ra_update_refl; @@ -275,6 +335,8 @@ PROOF extern thm ra_update_refl; * ```text * forall R a b c. ra_update R a b ==> ra_update R b c ==> ra_update R a c * ``` + * + * 中文说明：说明该关系或变换可以传递地串联。 */ PROOF extern thm ra_update_trans; @@ -283,6 +345,8 @@ PROOF extern thm ra_update_trans; * forall R a b extra. * ra_update R a b ==> ra_update R (ra_op R a extra) (ra_op R b extra) * ``` + * + * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 */ PROOF extern thm ra_update_frame; @@ -293,6 +357,8 @@ PROOF extern thm ra_update_frame; * ==> ra_update R c d * ==> ra_update R (ra_op R a c) (ra_op R b d) * ``` + * + * 中文说明：说明两个确定性更新可以在 RA 组合运算下同步执行。 */ PROOF extern thm ra_update_op; @@ -300,6 +366,8 @@ PROOF extern thm ra_update_op; * ```text * forall R a b. ra_included R b a ==> ra_update R a b * ``` + * + * 中文说明：说明资源总能更新为它已经包含的有效片段。 */ PROOF extern thm ra_update_included; @@ -307,6 +375,8 @@ PROOF extern thm ra_update_included; * ```text * forall R a b c. ra_update R a b ==> ra_included R c b ==> ra_update R a c * ``` + * + * 中文说明：说明更新目标可进一步缩小为其包含的片段。 */ PROOF extern thm ra_update_target_included; @@ -314,6 +384,8 @@ PROOF extern thm ra_update_target_included; * ```text * forall R a b. ra_update R a b ==> ra_valid R a ==> ra_valid R b * ``` + * + * 中文说明：说明确定性更新把有效源映射为有效目标。 */ PROOF extern thm ra_update_valid; @@ -326,6 +398,8 @@ PROOF extern thm ra_update_valid; * forall R a b. * ra_maximal R a ==> ra_valid R b ==> ra_included R a b ==> a == b * ``` + * + * 中文说明：说明有效资源若包含 maximal 源，则只能等于该源。 */ PROOF extern thm ra_maximal_included; @@ -333,6 +407,8 @@ PROOF extern thm ra_maximal_included; * ```text * forall R a b. ra_maximal R a ==> ra_valid R b ==> ra_update R a b * ``` + * + * 中文说明：说明 maximal 源可以更新到任意有效目标。 */ PROOF extern thm ra_maximal_update; @@ -344,5 +420,7 @@ PROOF extern thm ra_maximal_update; * ==> ra_op R frame a == ra_op R frame b * ==> a == b * ``` + * + * 中文说明：说明该资源代数满足或不满足消去性质。 */ PROOF extern thm ra_cancellative_apply; diff --git a/theory/logic/ra_builder.h b/theory/logic/ra_builder.h index 78ecf79..3ea4a98 100644 --- a/theory/logic/ra_builder.h +++ b/theory/logic/ra_builder.h @@ -24,6 +24,8 @@ * valid e && * (forall a b. valid (op a b) ==> valid a) * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm ra_laws_def; @@ -33,6 +35,8 @@ PROOF extern thm ra_laws_def; * (forall r. * ra_laws (FST r) (FST (SND r)) (SND (SND r)) <=> ra_rep (ra_abs r) == r) * ``` + * + * 中文说明：说明 RA 抽象值与满足 RA laws 的表示三元组构成双射。 */ PROOF extern thm ra_type_bijection; @@ -41,6 +45,8 @@ PROOF extern thm ra_type_bijection; * forall R. * ra_laws (FST (ra_rep R)) (FST (SND (ra_rep R))) (SND (SND (ra_rep R))) * ``` + * + * 中文说明：说明任意 RA 的底层表示都满足 RA laws。 */ PROOF extern thm ra_rep_laws; @@ -49,6 +55,8 @@ PROOF extern thm ra_rep_laws; * forall e op valid. * ra_laws e op valid ==> ra_rep (ra_abs (e,op,valid)) == e,op,valid * ``` + * + * 中文说明：说明满足 RA laws 的表示三元组经过抽象再表示后保持不变。 */ PROOF extern thm ra_abs_rep; @@ -60,6 +68,8 @@ PROOF extern thm ra_abs_rep; * ```text * forall e op valid. ra_laws e op valid ==> ra_unit (ra_abs (e,op,valid)) == e * ``` + * + * 中文说明：说明由合法三元组构造的 RA 具有给定单位元。 */ PROOF extern thm ra_unit_abs; @@ -67,6 +77,8 @@ PROOF extern thm ra_unit_abs; * ```text * forall e op valid. ra_laws e op valid ==> ra_op (ra_abs (e,op,valid)) == op * ``` + * + * 中文说明：说明由合法三元组构造的 RA 具有给定组合运算。 */ PROOF extern thm ra_op_abs; @@ -75,6 +87,8 @@ PROOF extern thm ra_op_abs; * forall e op valid. * ra_laws e op valid ==> ra_valid (ra_abs (e,op,valid)) == valid * ``` + * + * 中文说明：说明该资源或构造满足相应的有效性条件。 */ PROOF extern thm ra_valid_abs; @@ -82,5 +96,7 @@ PROOF extern thm ra_valid_abs; * ```text * forall R. ra_abs (ra_unit R,ra_op R,ra_valid R) == R * ``` + * + * 中文说明：说明从任意 RA 的三个投影重建后得到原 RA。 */ PROOF extern thm ra_abs_eta; diff --git a/theory/logic/ra_internal.h b/theory/logic/ra_internal.h index d9007c1..68184e3 100644 --- a/theory/logic/ra_internal.h +++ b/theory/logic/ra_internal.h @@ -18,6 +18,8 @@ * ```text * forall R a b c. ra_op R (ra_op R a b) c == ra_op R (ra_op R a c) b * ``` + * + * 中文说明：说明可由结合律和交换律交换组合式右侧的两个分量。 */ PROOF extern thm ra_op_swap_right; @@ -25,6 +27,8 @@ PROOF extern thm ra_op_swap_right; * ```text * forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R a * ``` + * + * 中文说明：说明该资源或构造满足相应的有效性条件。 */ PROOF extern thm ra_valid_op_l; @@ -32,6 +36,8 @@ PROOF extern thm ra_valid_op_l; * ```text * forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R b * ``` + * + * 中文说明：说明该资源或构造满足相应的有效性条件。 */ PROOF extern thm ra_valid_op_r; @@ -40,6 +46,8 @@ PROOF extern thm ra_valid_op_r; * forall R a frame. * ra_maximal R a ==> ra_valid R (ra_op R a frame) ==> frame == ra_unit R * ``` + * + * 中文说明：说明 frame-maximal 资源只能与单位 frame 兼容。 */ PROOF extern thm ra_maximal_apply; @@ -50,6 +58,8 @@ PROOF extern thm ra_maximal_apply; * ==> ra_valid R (ra_op R a frame) * ==> ra_valid R (ra_op R b frame) * ``` + * + * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 */ PROOF extern thm ra_update_apply; @@ -60,6 +70,8 @@ PROOF extern thm ra_update_apply; * ==> ra_valid R (ra_op R a frame) * ==> (exists b. P b && ra_valid R (ra_op R b frame)) * ``` + * + * 中文说明：说明谓词更新允许选择任意满足目标谓词的新资源。 */ PROOF extern thm ra_updateP_apply; @@ -72,6 +84,8 @@ PROOF extern thm ra_updateP_apply; * forall R a1 a2 b. * ra_included R a1 a2 ==> ra_included R (ra_op R a1 b) (ra_op R a2 b) * ``` + * + * 中文说明：说明该构造对蕴含或底层关系保持单调。 */ PROOF extern thm ra_included_op_mono_l; @@ -80,6 +94,8 @@ PROOF extern thm ra_included_op_mono_l; * forall R a1 a2 b. * ra_included R a1 a2 ==> ra_included R (ra_op R b a1) (ra_op R b a2) * ``` + * + * 中文说明：说明该构造对蕴含或底层关系保持单调。 */ PROOF extern thm ra_included_op_mono_r; @@ -90,6 +106,8 @@ PROOF extern thm ra_included_op_mono_r; * ==> ra_valid R (ra_op R b frame) * ==> ra_valid R (ra_op R a frame) * ``` + * + * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 */ PROOF extern thm ra_included_valid_frame; @@ -101,6 +119,8 @@ PROOF extern thm ra_included_valid_frame; * ==> ra_included R (ra_op R common a) (ra_op R common b) * ==> ra_included R a b * ``` + * + * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 */ PROOF extern thm ra_included_cancel_l; @@ -110,6 +130,8 @@ PROOF extern thm ra_included_cancel_l; * ra_maximal R a * ==> (ra_valid R (ra_op R a frame) <=> ra_valid R a && frame == ra_unit R) * ``` + * + * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 */ PROOF extern thm ra_maximal_valid_op_iff; @@ -121,6 +143,8 @@ PROOF extern thm ra_maximal_valid_op_iff; * ```text * forall R a b P. ra_update R a b ==> P b ==> ra_updateP R a P * ``` + * + * 中文说明：说明谓词更新允许选择任意满足目标谓词的新资源。 */ PROOF extern thm ra_updateP_of_update; @@ -128,5 +152,7 @@ PROOF extern thm ra_updateP_of_update; * ```text * forall R a. ra_update R a (ra_unit R) * ``` + * + * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 */ PROOF extern thm ra_update_unit; diff --git a/theory/logic/resource_prop.h b/theory/logic/resource_prop.h index b933492..cfa6857 100644 --- a/theory/logic/resource_prop.h +++ b/theory/logic/resource_prop.h @@ -38,6 +38,8 @@ * r_entails (R:(A)ra) (P:A->bool) (Q:A->bool) <=> forall resource:A. ra_valid * R resource ==> P resource ==> Q resource * ``` + * + * 中文说明：说明蕴含只需在有效资源上逐点成立。 */ PROOF extern thm r_entails_def; /** @@ -47,6 +49,8 @@ PROOF extern thm r_entails_def; * r_equiv (R:(A)ra) (P:A->bool) (Q:A->bool) <=> r_entails R P Q && r_entails R * Q P * ``` + * + * 中文说明：说明逻辑等价由两个方向的有效资源蕴含组成。 */ PROOF extern thm r_equiv_def; @@ -56,6 +60,8 @@ PROOF extern thm r_equiv_def; * ```text * r_emp (R:(A)ra) (resource:A) <=> resource == ra_unit R * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm r_emp_def; /** @@ -65,6 +71,8 @@ PROOF extern thm r_emp_def; * r_sep (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> exists left * right:A. resource == ra_op R left right && P left && Q right * ``` + * + * 中文说明：说明分离合取通过 RA 运算把当前资源拆成左右两部分。 */ PROOF extern thm r_sep_def; /** @@ -75,6 +83,8 @@ PROOF extern thm r_sep_def; * ra_valid R (ra_op R resource frame) ==> P frame ==> Q (ra_op R resource * frame) * ``` + * + * 中文说明：说明魔法棒量化所有能与当前资源有效组合的 frame。 */ PROOF extern thm r_wand_def; /** @@ -83,6 +93,8 @@ PROOF extern thm r_wand_def; * ```text * r_own (R:(A)ra) (owned:A) (resource:A) <=> resource == owned * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm r_own_def; /** @@ -91,6 +103,8 @@ PROOF extern thm r_own_def; * ```text * r_top (R:(A)ra) (resource:A) <=> T * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm r_top_def; /** @@ -99,6 +113,8 @@ PROOF extern thm r_top_def; * ```text * r_bottom (R:(A)ra) (resource:A) <=> F * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm r_bottom_def; /** @@ -108,6 +124,8 @@ PROOF extern thm r_bottom_def; * r_and (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> P resource && Q * resource * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm r_and_def; /** @@ -117,6 +135,8 @@ PROOF extern thm r_and_def; * r_or (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> P resource || Q * resource * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm r_or_def; /** @@ -126,6 +146,8 @@ PROOF extern thm r_or_def; * r_impl (R:(A)ra) (P:A->bool) (Q:A->bool) (resource:A) <=> P resource ==> Q * resource * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm r_impl_def; /** @@ -135,6 +157,8 @@ PROOF extern thm r_impl_def; * r_exists (R:(A)ra) (P:B->A->bool) (resource:A) <=> exists witness:B. P * witness resource * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm r_exists_def; /** @@ -144,6 +168,8 @@ PROOF extern thm r_exists_def; * r_forall (R:(A)ra) (P:B->A->bool) (resource:A) <=> forall witness:B. P * witness resource * ``` + * + * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 */ PROOF extern thm r_forall_def; @@ -153,6 +179,8 @@ PROOF extern thm r_forall_def; * ```text * r_pure (R:(A)ra) (phi:bool) (resource:A) <=> phi * ``` + * + * 中文说明：说明 pure 只记录命题真假，与当前资源无关。 */ PROOF extern thm r_pure_def; @@ -162,6 +190,8 @@ PROOF extern thm r_pure_def; * ```text * r_fact (R:(A)ra) (phi:bool) (resource:A) <=> phi && resource == ra_unit R * ``` + * + * 中文说明：说明 fact 要求命题为真，并且当前资源精确为 unit。 */ PROOF extern thm r_fact_def; @@ -176,6 +206,8 @@ PROOF extern thm r_fact_def; * ```text * forall (R:(A)ra) (P:A->bool). r_entails R P P * ``` + * + * 中文说明：说明该关系具有自反性。 */ PROOF extern thm r_entails_refl; /** @@ -185,6 +217,8 @@ PROOF extern thm r_entails_refl; * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R P Q ==> * r_entails R Q S ==> r_entails R P S * ``` + * + * 中文说明：说明该关系或变换可以传递地串联。 */ PROOF extern thm r_entails_trans; /** @@ -194,6 +228,8 @@ PROOF extern thm r_entails_trans; * forall (R:(A)ra) (P:A->bool) (Q:A->bool). (forall resource:A. P resource ==> * Q resource) ==> r_entails R P Q * ``` + * + * 中文说明：给出逐点条件与整体逻辑关系之间的对应。 */ PROOF extern thm r_entails_pointwise; /** @@ -203,6 +239,8 @@ PROOF extern thm r_entails_pointwise; * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_equiv R P Q <=> forall * resource:A. ra_valid R resource ==> (P resource <=> Q resource) * ``` + * + * 中文说明：给出逐点条件与整体逻辑关系之间的对应。 */ PROOF extern thm r_equiv_pointwise; /** @@ -212,6 +250,8 @@ PROOF extern thm r_equiv_pointwise; * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R P Q ==> r_entails R Q * P ==> r_equiv R P Q * ``` + * + * 中文说明：给出该逻辑构造的引入规则。 */ PROOF extern thm r_equiv_intro; /** @@ -220,6 +260,8 @@ PROOF extern thm r_equiv_intro; * ```text * forall (R:(A)ra) (P:A->bool). r_equiv R P P * ``` + * + * 中文说明：说明该关系具有自反性。 */ PROOF extern thm r_equiv_refl; /** @@ -228,6 +270,8 @@ PROOF extern thm r_equiv_refl; * ```text * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_equiv R P Q ==> r_equiv R Q P * ``` + * + * 中文说明：说明该关系具有对称性，可交换关系两端。 */ PROOF extern thm r_equiv_sym; /** @@ -237,6 +281,8 @@ PROOF extern thm r_equiv_sym; * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_equiv R P Q ==> * r_equiv R Q S ==> r_equiv R P S * ``` + * + * 中文说明：说明该关系或变换可以传递地串联。 */ PROOF extern thm r_equiv_trans; @@ -247,6 +293,8 @@ PROOF extern thm r_equiv_trans; * ```text * forall (R:(A)ra) (P:A->bool). r_entails R P (r_top R) * ``` + * + * 中文说明：给出该逻辑构造的引入规则。 */ PROOF extern thm r_top_intro; /** @@ -255,6 +303,8 @@ PROOF extern thm r_top_intro; * ```text * forall (R:(A)ra) (P:A->bool). r_entails R (r_bottom R) P * ``` + * + * 中文说明：给出该逻辑构造的消去或投影规则。 */ PROOF extern thm r_bottom_elim; @@ -267,6 +317,8 @@ PROOF extern thm r_bottom_elim; * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_equiv R (r_sep R * (r_sep R P Q) S) (r_sep R P (r_sep R Q S)) * ``` + * + * 中文说明：说明该运算满足结合律，改变括号结构不会改变结果。 */ PROOF extern thm r_sep_assoc; /** @@ -276,6 +328,8 @@ PROOF extern thm r_sep_assoc; * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_equiv R (r_sep R P Q) (r_sep R Q * P) * ``` + * + * 中文说明：说明该运算满足交换律，交换两个操作数不会改变结果。 */ PROOF extern thm r_sep_comm; /** @@ -284,6 +338,8 @@ PROOF extern thm r_sep_comm; * ```text * forall (R:(A)ra) (P:A->bool). r_equiv R (r_sep R (r_emp R) P) P * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_sep_emp_l; /** @@ -292,6 +348,8 @@ PROOF extern thm r_sep_emp_l; * ```text * forall (R:(A)ra) (P:A->bool). r_equiv R (r_sep R P (r_emp R)) P * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_sep_emp_r; /** @@ -302,6 +360,8 @@ PROOF extern thm r_sep_emp_r; * r_entails R P P2 ==> r_entails R Q Q2 ==> r_entails R (r_sep R P Q) (r_sep R * P2 Q2) * ``` + * + * 中文说明：说明该构造对蕴含或底层关系保持单调。 */ PROOF extern thm r_sep_mono; /** @@ -311,6 +371,8 @@ PROOF extern thm r_sep_mono; * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (frame_pred:A->bool). r_entails R P * Q ==> r_entails R (r_sep R P frame_pred) (r_sep R Q frame_pred) * ``` + * + * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 */ PROOF extern thm r_sep_frame_l; /** @@ -320,6 +382,8 @@ PROOF extern thm r_sep_frame_l; * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (frame_pred:A->bool). r_entails R P * Q ==> r_entails R (r_sep R frame_pred P) (r_sep R frame_pred Q) * ``` + * + * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 */ PROOF extern thm r_sep_frame_r; /** @@ -329,6 +393,8 @@ PROOF extern thm r_sep_frame_r; * forall (R:(A)ra) (P:B->A->bool) (Q:A->bool). r_equiv R (r_sep R (r_exists R * (\x:B. P x)) Q) (r_exists R (\x:B. r_sep R (P x) Q)) * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_sep_exists_l; /** @@ -338,6 +404,8 @@ PROOF extern thm r_sep_exists_l; * forall (R:(A)ra) (P:A->bool) (Q:B->A->bool). r_equiv R (r_sep R P (r_exists * R (\x:B. Q x))) (r_exists R (\x:B. r_sep R P (Q x))) * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_sep_exists_r; @@ -349,6 +417,8 @@ PROOF extern thm r_sep_exists_r; * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R (r_and R P * Q) S <=> r_entails R P (r_impl R Q S) * ``` + * + * 中文说明：说明该伴随关系可在分离合取与对应连接词之间双向转换。 */ PROOF extern thm r_impl_adjunction; /** @@ -358,6 +428,8 @@ PROOF extern thm r_impl_adjunction; * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R P Q ==> * r_entails R P S ==> r_entails R P (r_and R Q S) * ``` + * + * 中文说明：给出该逻辑构造的引入规则。 */ PROOF extern thm r_and_intro; /** @@ -366,6 +438,8 @@ PROOF extern thm r_and_intro; * ```text * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R (r_and R P Q) P * ``` + * + * 中文说明：给出该逻辑构造的消去或投影规则。 */ PROOF extern thm r_and_elim_l; /** @@ -374,6 +448,8 @@ PROOF extern thm r_and_elim_l; * ```text * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R (r_and R P Q) Q * ``` + * + * 中文说明：给出该逻辑构造的消去或投影规则。 */ PROOF extern thm r_and_elim_r; /** @@ -382,6 +458,8 @@ PROOF extern thm r_and_elim_r; * ```text * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R P (r_or R P Q) * ``` + * + * 中文说明：给出该逻辑构造的引入规则。 */ PROOF extern thm r_or_intro_l; /** @@ -390,6 +468,8 @@ PROOF extern thm r_or_intro_l; * ```text * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R Q (r_or R P Q) * ``` + * + * 中文说明：给出该逻辑构造的引入规则。 */ PROOF extern thm r_or_intro_r; /** @@ -399,6 +479,8 @@ PROOF extern thm r_or_intro_r; * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R P S ==> * r_entails R Q S ==> r_entails R (r_or R P Q) S * ``` + * + * 中文说明：给出该逻辑构造的消去或投影规则。 */ PROOF extern thm r_or_elim; /** @@ -408,6 +490,8 @@ PROOF extern thm r_or_elim; * forall (R:(A)ra) (P:B->A->bool) (witness:B). r_entails R (P witness) * (r_exists R (\bound:B. P bound)) * ``` + * + * 中文说明：给出该逻辑构造的引入规则。 */ PROOF extern thm r_exists_intro; /** @@ -417,6 +501,8 @@ PROOF extern thm r_exists_intro; * forall (R:(A)ra) (P:B->A->bool) (Q:A->bool). (forall witness:B. r_entails R * (P witness) Q) ==> r_entails R (r_exists R (\bound:B. P bound)) Q * ``` + * + * 中文说明：给出该逻辑构造的消去或投影规则。 */ PROOF extern thm r_exists_elim; /** @@ -427,6 +513,8 @@ PROOF extern thm r_exists_elim; * R (P witness) (Q witness)) ==> r_entails R (r_exists R (\bound:B. P bound)) * (r_exists R (\bound:B. Q bound)) * ``` + * + * 中文说明：说明该构造对蕴含或底层关系保持单调。 */ PROOF extern thm r_exists_mono; /** @@ -436,6 +524,8 @@ PROOF extern thm r_exists_mono; * forall (R:(A)ra) (P:A->bool) (Q:B->A->bool). (forall witness:B. r_entails R * P (Q witness)) ==> r_entails R P (r_forall R (\bound:B. Q bound)) * ``` + * + * 中文说明：给出该逻辑构造的引入规则。 */ PROOF extern thm r_forall_intro; /** @@ -445,6 +535,8 @@ PROOF extern thm r_forall_intro; * forall (R:(A)ra) (P:B->A->bool) (witness:B). r_entails R (r_forall R P) (P * witness) * ``` + * + * 中文说明：给出该逻辑构造的消去或投影规则。 */ PROOF extern thm r_forall_elim; @@ -456,6 +548,8 @@ PROOF extern thm r_forall_elim; * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R (r_sep R P * Q) S <=> r_entails R P (r_wand R Q S) * ``` + * + * 中文说明：说明该伴随关系可在分离合取与对应连接词之间双向转换。 */ PROOF extern thm r_wand_adjunction; /** @@ -465,6 +559,8 @@ PROOF extern thm r_wand_adjunction; * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R (r_sep R (r_wand R P * Q) P) Q * ``` + * + * 中文说明：给出该逻辑构造的消去或投影规则。 */ PROOF extern thm r_wand_elim; /** @@ -475,6 +571,8 @@ PROOF extern thm r_wand_elim; * r_entails R P2 P ==> r_entails R Q Q2 ==> r_entails R (r_wand R P Q) (r_wand * R P2 Q2) * ``` + * + * 中文说明：说明该构造对蕴含或底层关系保持单调。 */ PROOF extern thm r_wand_mono; @@ -486,6 +584,8 @@ PROOF extern thm r_wand_mono; * forall (R:(A)ra) (phi:bool) (P:A->bool) (Q:A->bool). phi ==> r_entails R P Q * ==> r_entails R P (r_and R (r_pure R phi) Q) * ``` + * + * 中文说明：给出该逻辑构造的引入规则。 */ PROOF extern thm r_pure_and_intro; /** @@ -495,6 +595,8 @@ PROOF extern thm r_pure_and_intro; * forall (R:(A)ra) (phi:bool) (P:A->bool) (Q:A->bool). (phi ==> r_entails R P * Q) ==> r_entails R (r_and R (r_pure R phi) P) Q * ``` + * + * 中文说明：给出该逻辑构造的消去或投影规则。 */ PROOF extern thm r_pure_and_elim; @@ -506,6 +608,8 @@ PROOF extern thm r_pure_and_elim; * forall (R:(A)ra) (phi:bool). r_equiv R (r_fact R phi) (r_and R (r_pure R * phi) (r_emp R)) * ``` + * + * 中文说明：说明 fact 等价于资源无关的 pure 与精确 emp 的合取。 */ PROOF extern thm r_fact_as_pure_and_emp; /** @@ -514,6 +618,8 @@ PROOF extern thm r_fact_as_pure_and_emp; * ```text * forall R:(A)ra. r_equiv R (r_fact R T) (r_emp R) * ``` + * + * 中文说明：说明 spatial fact 的构造、消去、复制或与 sep 的关系。 */ PROOF extern thm r_fact_true; /** @@ -522,6 +628,8 @@ PROOF extern thm r_fact_true; * ```text * forall R:(A)ra. r_equiv R (r_fact R F) (r_bottom R) * ``` + * + * 中文说明：说明 spatial fact 的构造、消去、复制或与 sep 的关系。 */ PROOF extern thm r_fact_false; /** @@ -531,6 +639,8 @@ PROOF extern thm r_fact_false; * forall (R:(A)ra) (phi:bool) (P:A->bool). r_equiv R (r_sep R (r_fact R phi) * P) (r_and R (r_pure R phi) P) * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_fact_sep_l; /** @@ -540,6 +650,8 @@ PROOF extern thm r_fact_sep_l; * forall (R:(A)ra) (phi:bool) (P:A->bool). r_equiv R (r_sep R P (r_fact R * phi)) (r_and R (r_pure R phi) P) * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_fact_sep_r; /** @@ -549,6 +661,8 @@ PROOF extern thm r_fact_sep_r; * forall (R:(A)ra) (phi:bool) (P:A->bool) (Q:A->bool). phi ==> r_entails R P Q * ==> r_entails R P (r_sep R (r_fact R phi) Q) * ``` + * + * 中文说明：给出该逻辑构造的引入规则。 */ PROOF extern thm r_fact_intro; /** @@ -558,6 +672,8 @@ PROOF extern thm r_fact_intro; * forall (R:(A)ra) (phi:bool) (P:A->bool) (Q:A->bool). (phi ==> r_entails R P * Q) ==> r_entails R (r_sep R (r_fact R phi) P) Q * ``` + * + * 中文说明：给出该逻辑构造的消去或投影规则。 */ PROOF extern thm r_fact_elim; /** @@ -567,6 +683,8 @@ PROOF extern thm r_fact_elim; * forall (R:(A)ra) (phi:bool). r_entails R (r_fact R phi) (r_sep R (r_fact R * phi) (r_fact R phi)) * ``` + * + * 中文说明：说明 spatial fact 的构造、消去、复制或与 sep 的关系。 */ PROOF extern thm r_fact_dup; @@ -577,6 +695,8 @@ PROOF extern thm r_fact_dup; * ```text * forall R:(A)ra. r_equiv R (r_own R (ra_unit R)) (r_emp R) * ``` + * + * 中文说明：说明精确所有权如何反映 RA 的单位元、运算或有效性。 */ PROOF extern thm r_own_unit; /** @@ -586,6 +706,8 @@ PROOF extern thm r_own_unit; * forall (R:(A)ra) (a:A) (b:A). r_equiv R (r_own R (ra_op R a b)) (r_sep R * (r_own R a) (r_own R b)) * ``` + * + * 中文说明：说明精确所有权如何反映 RA 的单位元、运算或有效性。 */ PROOF extern thm r_own_op; /** @@ -595,6 +717,8 @@ PROOF extern thm r_own_op; * forall (R:(A)ra) (a:A). r_entails R (r_own R a) (r_sep R (r_fact R (ra_valid * R a)) (r_own R a)) * ``` + * + * 中文说明：说明精确所有权可导出资源有效性，同时保留原所有权。 */ PROOF extern thm r_own_valid; @@ -606,6 +730,8 @@ PROOF extern thm r_own_valid; * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R (r_sep R P * (r_and R Q S)) (r_and R (r_sep R P Q) (r_sep R P S)) * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_sep_and_forward_r; /** @@ -615,5 +741,7 @@ PROOF extern thm r_sep_and_forward_r; * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_entails R (r_sep R * (r_and R Q S) P) (r_and R (r_sep R Q P) (r_sep R S P)) * ``` + * + * 中文说明：说明分离合取如何组合、拆分或重排资源。 */ PROOF extern thm r_sep_and_forward_l; diff --git a/theory/logic/resource_prop_internal.h b/theory/logic/resource_prop_internal.h index 5be326b..037a3e6 100644 --- a/theory/logic/resource_prop_internal.h +++ b/theory/logic/resource_prop_internal.h @@ -20,6 +20,8 @@ * ```text * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_sep R P Q == r_sep R Q P * ``` + * + * 中文说明：说明该运算满足交换律，交换两个操作数不会改变结果。 */ PROOF extern thm r_sep_comm_eq; /** @@ -28,6 +30,8 @@ PROOF extern thm r_sep_comm_eq; * ```text * forall (R:(A)ra) (P:A->bool). r_sep R (r_emp R) P == P * ``` + * + * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 */ PROOF extern thm r_sep_emp_l_eq; /** @@ -36,6 +40,8 @@ PROOF extern thm r_sep_emp_l_eq; * ```text * forall (R:(A)ra) (P:A->bool). r_sep R P (r_emp R) == P * ``` + * + * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 */ PROOF extern thm r_sep_emp_r_eq; /** @@ -45,6 +51,8 @@ PROOF extern thm r_sep_emp_r_eq; * forall (R:(A)ra) (P:A->bool) (Q:A->bool) (S:A->bool). r_sep R (r_sep R P Q) * S == r_sep R P (r_sep R Q S) * ``` + * + * 中文说明：说明该运算满足结合律，改变括号结构不会改变结果。 */ PROOF extern thm r_sep_assoc_eq; /** @@ -54,6 +62,8 @@ PROOF extern thm r_sep_assoc_eq; * forall (R:(A)ra) (P:B->A->bool) (Q:A->bool). r_sep R (r_exists R (\x:B. P * x)) Q == r_exists R (\witness:B. r_sep R (P witness) Q) * ``` + * + * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 */ PROOF extern thm r_sep_exists_l_eq; /** @@ -63,6 +73,8 @@ PROOF extern thm r_sep_exists_l_eq; * forall (R:(A)ra) (P:A->bool) (Q:B->A->bool). r_sep R P (r_exists R (\x:B. Q * x)) == r_exists R (\witness:B. r_sep R P (Q witness)) * ``` + * + * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 */ PROOF extern thm r_sep_exists_r_eq; @@ -74,6 +86,8 @@ PROOF extern thm r_sep_exists_r_eq; * forall (R:(A)ra) (P:B->A->bool) (Q:A->bool) (witness:B). r_entails R (P * witness) Q ==> r_entails R (r_forall R (\x:B. P x)) Q * ``` + * + * 中文说明：给出该逻辑构造的消去或投影规则。 */ PROOF extern thm r_forall_elim_cont; @@ -85,6 +99,8 @@ PROOF extern thm r_forall_elim_cont; * forall (R:(A)ra) (phi:bool). r_fact R phi == r_and R (r_pure R phi) (r_emp * R) * ``` + * + * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 */ PROOF extern thm r_fact_as_pure_and_emp_eq; /** @@ -93,6 +109,8 @@ PROOF extern thm r_fact_as_pure_and_emp_eq; * ```text * forall R:(A)ra. r_fact R T == r_emp R * ``` + * + * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 */ PROOF extern thm r_fact_true_eq; /** @@ -101,6 +119,8 @@ PROOF extern thm r_fact_true_eq; * ```text * forall R:(A)ra. r_fact R F == r_bottom R * ``` + * + * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 */ PROOF extern thm r_fact_false_eq; /** @@ -110,6 +130,8 @@ PROOF extern thm r_fact_false_eq; * forall (R:(A)ra) (phi:bool) (P:A->bool). r_sep R (r_fact R phi) P == r_and R * (r_pure R phi) P * ``` + * + * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 */ PROOF extern thm r_fact_sep_l_eq; /** @@ -119,6 +141,8 @@ PROOF extern thm r_fact_sep_l_eq; * forall (R:(A)ra) (phi:bool) (P:A->bool). r_sep R P (r_fact R phi) == r_and R * (r_pure R phi) P * ``` + * + * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 */ PROOF extern thm r_fact_sep_r_eq; @@ -129,6 +153,8 @@ PROOF extern thm r_fact_sep_r_eq; * ```text * forall R:(A)ra. r_own R (ra_unit R) == r_emp R * ``` + * + * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 */ PROOF extern thm r_own_unit_eq; /** @@ -138,5 +164,7 @@ PROOF extern thm r_own_unit_eq; * forall (R:(A)ra) (a:A) (b:A). r_own R (ra_op R a b) == r_sep R (r_own R a) * (r_own R b) * ``` + * + * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 */ PROOF extern thm r_own_op_eq; diff --git a/theory/logic/unit_ra.h b/theory/logic/unit_ra.h index 0e7a80c..511a27b 100644 --- a/theory/logic/unit_ra.h +++ b/theory/logic/unit_ra.h @@ -15,6 +15,8 @@ * ```text * ra_unit unit_ra == one * ``` + * + * 中文说明：说明单位 RA 只有一个资源值，因此相应关系均退化为单位情形。 */ PROOF extern thm unit_ra_unit; @@ -22,6 +24,8 @@ PROOF extern thm unit_ra_unit; * ```text * forall a b. ra_op unit_ra a b == one * ``` + * + * 中文说明：说明单位 RA 只有一个资源值，因此相应关系均退化为单位情形。 */ PROOF extern thm unit_ra_op; @@ -29,6 +33,8 @@ PROOF extern thm unit_ra_op; * ```text * forall a. ra_valid unit_ra a * ``` + * + * 中文说明：说明该资源或构造满足相应的有效性条件。 */ PROOF extern thm unit_ra_valid; @@ -36,6 +42,8 @@ PROOF extern thm unit_ra_valid; * ```text * forall a b. ra_included unit_ra a b * ``` + * + * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 */ PROOF extern thm unit_ra_included; @@ -43,6 +51,8 @@ PROOF extern thm unit_ra_included; * ```text * forall a. ra_maximal unit_ra a * ``` + * + * 中文说明：说明 frame-maximal 资源只能与单位 frame 兼容。 */ PROOF extern thm unit_ra_maximal; @@ -54,6 +64,8 @@ PROOF extern thm unit_ra_maximal; * ```text * forall a P. ra_updateP unit_ra a P <=> P one * ``` + * + * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 */ PROOF extern thm unit_ra_updateP_iff; @@ -61,5 +73,7 @@ PROOF extern thm unit_ra_updateP_iff; * ```text * forall a f b g. ra_local_update unit_ra a f b g * ``` + * + * 中文说明：说明局部更新在保留外部 residual 时替换内部片段。 */ PROOF extern thm unit_ra_local_update; -- Gitee From 10aaf033230432912ce31304b0e2b31093f13ea4 Mon Sep 17 00:00:00 2001 From: yiyuan-cao Date: Tue, 11 Aug 2026 14:25:31 +0800 Subject: [PATCH 35/35] Improve Chinese theorem explanations --- proof_sl.h | 34 +++--- theory/c_program_logic/c_basic_update.h | 6 +- theory/c_program_logic/c_ghost.h | 24 ++--- theory/c_program_logic/c_integer.h | 66 ++++++------ theory/c_program_logic/c_memory.h | 54 +++++----- theory/c_program_logic/c_resource.h | 18 ++-- theory/c_program_logic/c_types.h | 4 +- theory/c_program_logic/mem_own.h | 6 +- theory/c_program_logic/mem_ra.h | 24 ++--- theory/c_program_logic/mem_value.h | 48 ++++----- theory/data/int_list.h | 26 ++--- theory/data/list.h | 8 +- theory/logic/agree_ra.h | 24 ++--- theory/logic/auth_ra.h | 46 ++++---- theory/logic/basic_update.h | 30 +++--- theory/logic/big_sep.h | 18 ++-- theory/logic/excl_ra.h | 20 ++-- theory/logic/excl_ra_internal.h | 12 +-- theory/logic/finmap.h | 104 +++++++++--------- theory/logic/frac_ra.h | 16 +-- theory/logic/gmap_ra.h | 30 +++--- theory/logic/gmap_ra_internal.h | 10 +- theory/logic/local_update.h | 20 ++-- theory/logic/max_nat_ra.h | 12 +-- theory/logic/named_logic.h | 14 +-- theory/logic/named_ra.h | 16 +-- theory/logic/option_ra.h | 26 ++--- theory/logic/option_ra_internal.h | 6 +- theory/logic/prod_ra.h | 36 +++---- theory/logic/prod_ra_internal.h | 2 +- theory/logic/product_resource.h | 48 ++++----- theory/logic/product_resource_internal.h | 8 +- theory/logic/ra.h | 78 +++++++------- theory/logic/ra_builder.h | 16 +-- theory/logic/ra_internal.h | 26 ++--- theory/logic/resource_prop.h | 128 +++++++++++------------ theory/logic/resource_prop_internal.h | 28 ++--- theory/logic/unit_ra.h | 14 +-- 38 files changed, 553 insertions(+), 553 deletions(-) diff --git a/proof_sl.h b/proof_sl.h index 17bf51f..8233982 100644 --- a/proof_sl.h +++ b/proof_sl.h @@ -760,7 +760,7 @@ PROOF term dest_sl_fact(const term tm); * forall (H:sl_prop()) (K:sl_prop()). (H = K) ==> (H ⊢SL K) * ``` * - * 中文说明：说明断言的 HOL 等式可以转换为对应的 SL 蕴含。 + * 两个断言在 HOL 中相等时，前者在 SL 中蕴含后者。 */ PROOF extern thm sl_ent_sym_left; @@ -777,7 +777,7 @@ PROOF extern thm sl_ent_sym_left; * `forall (H:sl_prop()) (H1:sl_prop()) (K:sl_prop()) (K1:sl_prop()). * (H = H1) ==> (K = K1) ==> (H1 ⊢SL K1) ==> (H ⊢SL K)`. * - * 中文说明：说明逻辑蕴含的组合、改写或框架规则。 + * 若等式把蕴含两端改写为 `H'` 与 `K'`，则可将 `H' ⊢SL K'` 还原为 `H ⊢SL K`。 */ PROOF extern thm sl_ent_restate; @@ -795,7 +795,7 @@ PROOF extern thm sl_ent_restate; * (K1:sl_prop()). (H = F ** H1) ==> (K = F ** K1) ==> (H1 ⊢SL K1) ==> * (H ⊢SL K)`. * - * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 + * 将蕴含两端改写为带同一左框架 `F` 的形式后，可由框架内的蕴含推出原目标。 */ PROOF extern thm sl_frame_restate; @@ -809,7 +809,7 @@ PROOF extern thm sl_frame_restate; * (F ** H ⊢SL F ** K) * ``` * - * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 + * `H ⊢SL K` 在左侧加入同一框架 `F` 后仍成立。 */ PROOF extern thm sl_ent_frame_left; @@ -823,7 +823,7 @@ PROOF extern thm sl_ent_frame_left; * (H ** F ⊢SL K ** F) * ``` * - * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 + * `H ⊢SL K` 在右侧加入同一框架 `F` 后仍成立。 */ PROOF extern thm sl_ent_frame_right; @@ -841,7 +841,7 @@ PROOF extern thm sl_ent_frame_right; * (G:sl_prop()). (H = K) ==> (C = K ** F) ==> (C ⊢SL G) ==> * (H ** F ⊢SL G)`. * - * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 + * 若 `H` 可改写为 `K`，且已证明 `K ** F ⊢SL G`，则得到 `H ** F ⊢SL G`。 */ PROOF extern thm sl_ent_subst_frame; @@ -859,7 +859,7 @@ PROOF extern thm sl_ent_subst_frame; * (K1:sl_prop()) (K2:sl_prop()). (H = H1 ** H2) ==> (K = K1 ** K2) ==> * (H1 ⊢SL K1) ==> (H2 ⊢SL K2) ==> (H ⊢SL K)`. * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * 两个分量的蕴含可逐项合成为对应分离合取之间的蕴含。 */ PROOF extern thm sl_sep_combine; @@ -879,7 +879,7 @@ PROOF extern thm sl_sep_combine; * commutativity. Pass this theorem to `ac_rule`; units are not part of this * AC theory. * - * 中文说明：汇总 sep 的交换律、结合律和提升交换律，供 AC 归一化使用。 + * 将分离合取的交换律、结合律及嵌套交换律打包为不含单位元的 AC 重写规则。 */ PROOF extern thm sl_ac_rule; @@ -893,7 +893,7 @@ PROOF extern thm sl_ac_rule; * (H1 ⊢SL K1) ==> (H2 ⊢SL K2) ==> ((H1 || H2) ⊢SL (K1 || K2)) * ``` * - * 中文说明：说明该构造对蕴含或底层关系保持单调。 + * 两个分支分别按蕴含替换时，它们的加法析取也保持同方向的蕴含。 */ PROOF extern thm sl_disj_mono; @@ -913,7 +913,7 @@ PROOF extern thm sl_disj_mono; * (C2 = K ** F) ==> (P = (H || K) ** F) ==> (C1 ⊢SL G) ==> * (C2 ⊢SL G) ==> (P ⊢SL G)`. * - * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 + * 若两个析取分支与共享框架 `F` 合并后都蕴含 `G`，则整个带框架的析取也蕴含 `G`。 */ PROOF extern thm sl_or_elim_frame; @@ -927,7 +927,7 @@ PROOF extern thm sl_or_elim_frame; * (H ⊢SL (K -* G)) ==> (H ** K ⊢SL G) * ``` * - * 中文说明：说明 SL 证明规则如何组合、改写或规范化蕴含。 + * 若 `H` 蕴含从 `K` 到 `G` 的魔杖，则把 `K` 分离合取进来即可推出 `G`。 */ PROOF extern thm sl_undisch; @@ -941,7 +941,7 @@ PROOF extern thm sl_undisch; * (H ⊢SL (K && F)) ==> (H ⊢SL K) * ``` * - * 中文说明：说明加法合取的引入、投影或分配规则。 + * 从 `H ⊢SL K && F` 可投影出左合取支 `H ⊢SL K`。 */ PROOF extern thm sl_conj1; @@ -955,7 +955,7 @@ PROOF extern thm sl_conj1; * (H ⊢SL (K && F)) ==> (H ⊢SL F) * ``` * - * 中文说明：说明加法合取的引入、投影或分配规则。 + * 从 `H ⊢SL K && F` 可投影出右合取支 `H ⊢SL F`。 */ PROOF extern thm sl_conj2; @@ -969,7 +969,7 @@ PROOF extern thm sl_conj2; * (H ⊢SL K) ==> (H ⊢SL (K || F)) * ``` * - * 中文说明：说明该构造对蕴含或底层关系保持单调。 + * `H` 蕴含 `K` 时，也蕴含以 `K` 为左分支的析取 `K || F`。 */ PROOF extern thm sl_disj1_mono; @@ -983,7 +983,7 @@ PROOF extern thm sl_disj1_mono; * (H ⊢SL K) ==> (H ⊢SL (F || K)) * ``` * - * 中文说明：说明该构造对蕴含或底层关系保持单调。 + * `H` 蕴含 `K` 时，也蕴含以 `K` 为右分支的析取 `F || K`。 */ PROOF extern thm sl_disj2_mono; @@ -998,7 +998,7 @@ PROOF extern thm sl_disj2_mono; * `forall (B:A->sl_prop()) (F:sl_prop()) (K:sl_prop()). * (forall x:A. B x ** F ⊢SL K) ==> ((∃SL x:A. B x) ** F ⊢SL K)`. * - * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 + * 若每个见证对应的 `B(x) ** F` 都蕴含 `K`，则消去存在量词时可保留共享框架 `F`。 */ PROOF extern thm sl_exists_elim_frame; @@ -1012,7 +1012,7 @@ PROOF extern thm sl_exists_elim_frame; * (H ⊢SL B w) ==> (H ⊢SL ∃SL x:A. B x) * ``` * - * 中文说明：说明存在量词的引入、消去、单调性或与 sep 的交换。 + * 给定见证 `w`，由 `H ⊢SL B(w)` 可引入存在断言 `H ⊢SL ∃x. B(x)`。 */ PROOF extern thm sl_exists_wit; diff --git a/theory/c_program_logic/c_basic_update.h b/theory/c_program_logic/c_basic_update.h index 1035a5d..6f8a12b 100644 --- a/theory/c_program_logic/c_basic_update.h +++ b/theory/c_program_logic/c_basic_update.h @@ -18,7 +18,7 @@ * c_bupd (G:(A)ra) == r_bupd_right mem_ra G * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `c_bupd G` 是完整 C 资源上的右侧 basic update：物理内存固定，仅允许 ghost 分量按 `G` 更新。 */ PROOF extern thm c_bupd_def; @@ -27,7 +27,7 @@ PROOF extern thm c_bupd_def; * c_viewshift (G:(A)ra) == r_viewshift_right mem_ra G * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `c_viewshift G` 是完整 C 资源上的右侧 view shift，其代数更新能力只作用于 ghost 分量。 */ PROOF extern thm c_viewshift_def; @@ -44,6 +44,6 @@ PROOF extern thm c_viewshift_def; * exists ghost':A. Q (FST resource,ghost') * ``` * - * 中文说明：说明 C basic update 只更新 ghost 投影，不改变物理内存投影。 + * 若有效资源满足 `c_bupd G Q`，则 `Q` 接受某个物理投影仍为 `FST resource`、仅 ghost 投影改变的目标资源。 */ PROOF extern thm c_bupd_preserves_phys; diff --git a/theory/c_program_logic/c_ghost.h b/theory/c_program_logic/c_ghost.h index b099023..f5fca1b 100644 --- a/theory/c_program_logic/c_ghost.h +++ b/theory/c_program_logic/c_ghost.h @@ -28,7 +28,7 @@ * (c_ghost_own G a) (c_ghost_own G b)) * ``` * - * 中文说明：说明精确所有权如何反映 RA 的单位元、运算或有效性。 + * 在完整 C 资源中，拥有 ghost 组合 `ra_op G a b` 与分别拥有 `a`、`b` 的分离合取在 `r_equiv` 下等价。 */ PROOF extern thm c_ghost_own_op; @@ -43,7 +43,7 @@ PROOF extern thm c_ghost_own_op; * (c_ghost_own G a)) * ``` * - * 中文说明：说明该资源或构造满足相应的有效性条件。 + * 拥有 ghost 片段 `a` 可分离出 `ra_valid G a` 这一 exact-unit fact，同时保留原所有权。 */ PROOF extern thm c_ghost_own_valid; @@ -54,7 +54,7 @@ PROOF extern thm c_ghost_own_valid; * c_viewshift G (c_ghost_own G a) (c_ghost_own G b) * ``` * - * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 + * ghost RA 中从 `a` 到 `b` 的 frame-preserving update 可提升为保持物理内存不变的 C view shift。 */ PROOF extern thm c_ghost_own_update; @@ -70,7 +70,7 @@ PROOF extern thm c_ghost_own_update; * (c_ghost_own G b))) * ``` * - * 中文说明：说明 C ghost 谓词更新返回新 witness、fact 与更新后的所有权。 + * 对 `a` 的谓词更新可经 C view shift 选择 `b`，分离得到 `P b` 的 exact-unit fact 和 ghost 所有权；物理投影不变。 */ PROOF extern thm c_ghost_own_updateP; @@ -82,7 +82,7 @@ PROOF extern thm c_ghost_own_updateP; * (r_emp (c_resource_ra G)) * ``` * - * 中文说明：说明当前拥有的片段可以被丢弃为单位资源。 + * 任意 ghost 片段的精确所有权都可经 C view shift 丢弃为 `emp`；该 shift 只更新 ghost，物理 frame 保持不变。 */ PROOF extern thm c_ghost_own_drop; @@ -99,7 +99,7 @@ PROOF extern thm c_ghost_own_drop; * c_ghost_own (named_ra R) (finmap_singleton name a) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `c_named_own R name a` 精确拥有 `named_ra R` 中键 `name` 映射到载荷 `a` 的单点 ghost 片段。 */ PROOF extern thm c_named_own_def; @@ -114,7 +114,7 @@ PROOF extern thm c_named_own_def; * (c_named_own R name b)) * ``` * - * 中文说明：说明 C 命名所有权在固定名字下的组合、有效性或更新规则。 + * 同一名字下拥有组合载荷 `ra_op R a b`，与在该名字下分别拥有 `a`、`b` 的分离合取在 `r_equiv` 下等价。 */ PROOF extern thm c_named_own_op; @@ -129,7 +129,7 @@ PROOF extern thm c_named_own_op; * (c_named_own R name a)) * ``` * - * 中文说明：说明 C 命名所有权在固定名字下的组合、有效性或更新规则。 + * 固定名字下拥有载荷 `a` 可分离出 `ra_valid R a` 的 exact-unit fact，并保留该命名所有权。 */ PROOF extern thm c_named_own_valid; @@ -142,7 +142,7 @@ PROOF extern thm c_named_own_valid; * (c_named_own R name b) * ``` * - * 中文说明：说明 C 命名所有权在固定名字下的组合、有效性或更新规则。 + * 若载荷可由 `a` frame-preserving update 为 `b`，则固定名字的所有权可经 C view shift 同步更新。 */ PROOF extern thm c_named_own_update; @@ -158,7 +158,7 @@ PROOF extern thm c_named_own_update; * (c_named_own R name b))) * ``` * - * 中文说明：说明 C 命名所有权在固定名字下的组合、有效性或更新规则。 + * 载荷谓词更新可在固定名字下选择某个 `b`，返回 `P b` 的 exact-unit fact 与更新后的命名所有权。 */ PROOF extern thm c_named_own_updateP; @@ -170,7 +170,7 @@ PROOF extern thm c_named_own_updateP; * (r_emp (c_resource_ra (named_ra R))) * ``` * - * 中文说明：说明可通过 C view shift 丢弃当前固定名字的 singleton 片段。 + * 固定名字的单点 ghost 所有权可经 C view shift 丢弃为 `emp`；这只移除当前 singleton，不断言 frame 中没有同名资源。 */ PROOF extern thm c_named_own_drop; @@ -189,6 +189,6 @@ PROOF extern thm c_named_own_drop; * P)) * ``` * - * 中文说明：说明 C 逻辑可分配新名字，并把命名所有权与原断言分离组合。 + * 对有效载荷 `a`，任意断言 `P` 可经 C view shift 分配一个与其 frame 兼容的新名字，并得到该命名所有权 `** P`。 */ PROOF extern thm c_named_own_alloc; diff --git a/theory/c_program_logic/c_integer.h b/theory/c_program_logic/c_integer.h index f796f1e..5aec158 100644 --- a/theory/c_program_logic/c_integer.h +++ b/theory/c_program_logic/c_integer.h @@ -19,7 +19,7 @@ * exp_2 (width:int) = &(2 EXP num_of_int width) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `exp_2 width` 是整数 `2^(num_of_int width)`；负的 `width` 先由 `num_of_int` 截为零。 */ PROOF extern thm c_exp_2_def; /** @@ -27,7 +27,7 @@ PROOF extern thm c_exp_2_def; * max_unsigned (width:int) = exp_2 width - &1 * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `max_unsigned width` 定义为 `exp_2 width - 1`；`width >= 0` 时即通常的 `2^width - 1`。 */ PROOF extern thm c_max_unsigned_def; /** @@ -35,7 +35,7 @@ PROOF extern thm c_max_unsigned_def; * max_signed (width:int) = exp_2 (width - &1) - &1 * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `max_signed width` 定义为 `exp_2 (width - 1) - 1`；`width >= 1` 时即 `2^(width-1)-1`。 */ PROOF extern thm c_max_signed_def; /** @@ -43,7 +43,7 @@ PROOF extern thm c_max_signed_def; * min_signed (width:int) = --(exp_2 (width - &1)) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `min_signed width` 定义为 `-exp_2 (width - 1)`；`width >= 1` 时即 `-2^(width-1)`。 */ PROOF extern thm c_min_signed_def; /** @@ -51,7 +51,7 @@ PROOF extern thm c_min_signed_def; * cast_unsigned (width:int) (value:int) = value rem exp_2 width * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `cast_unsigned width value` 取 `value rem exp_2 width`；非负宽度时即保留低 `width` 位。 */ PROOF extern thm cast_unsigned_def; @@ -64,7 +64,7 @@ PROOF extern thm cast_unsigned_def; * else unsigned_value - exp_2 width. * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 令 `u = cast_unsigned width value`；低于 `exp_2(width-1)` 时返回 `u`，否则返回 `u - exp_2 width`。 */ PROOF extern thm cast_signed_def; @@ -74,7 +74,7 @@ PROOF extern thm cast_signed_def; * cast_unsigned width value * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `unsigned_last_nbits value width` 严格定义为 `cast_unsigned width value`；非负宽度时表示截取低位。 */ PROOF extern thm unsigned_last_nbits_def; @@ -84,7 +84,7 @@ PROOF extern thm unsigned_last_nbits_def; * cast_signed width value * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `signed_last_nbits value width` 严格定义为 `cast_signed width value`；正宽度时采用补码解释。 */ PROOF extern thm signed_last_nbits_def; @@ -97,7 +97,7 @@ PROOF extern thm signed_last_nbits_def; * unsigned_last_nbits value width = value * ``` * - * 中文说明：给出固定宽度 C 整数运算或转换的精确计算规则。 + * 若 `0 <= value < exp_2 width`，则无符号截取不改变 `value`，也就是模运算保持模范围内的数。 */ PROOF extern thm unsigned_last_nbits_id; @@ -111,7 +111,7 @@ PROOF extern thm unsigned_last_nbits_id; * ival (word_and ((iword x):(32)word) ((iword y):(32)word)) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `i32_and` 在 32 位字表示上逐位与，并把结果按 32 位有符号整数解释。 */ PROOF extern thm i32_and_def; @@ -121,7 +121,7 @@ PROOF extern thm i32_and_def; * ival (word_or ((iword x):(32)word) ((iword y):(32)word)) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `i32_or` 在 32 位字表示上逐位或，并把结果按 32 位有符号整数解释。 */ PROOF extern thm i32_or_def; @@ -131,7 +131,7 @@ PROOF extern thm i32_or_def; * ival (word_xor ((iword x):(32)word) ((iword y):(32)word)) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `i32_xor` 在 32 位字表示上逐位异或，并把结果按 32 位有符号整数解释。 */ PROOF extern thm i32_xor_def; @@ -140,7 +140,7 @@ PROOF extern thm i32_xor_def; * i32_not (x:int) = ival (word_not ((iword x):(32)word)) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `i32_not` 对 32 位字表示逐位取反，并把结果按 32 位有符号整数解释。 */ PROOF extern thm i32_not_def; @@ -150,7 +150,7 @@ PROOF extern thm i32_not_def; * ival (word_shl ((iword x):(32)word) (num_of_int y)) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `i32_shl` 将 32 位字表示左移 `num_of_int y` 位，再按 32 位有符号整数解释结果。 */ PROOF extern thm i32_shl_def; @@ -160,7 +160,7 @@ PROOF extern thm i32_shl_def; * ival (word_ishr ((iword x):(32)word) (num_of_int y)) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `i32_shr` 将 32 位字表示算术右移 `num_of_int y` 位，再用 `ival` 作有符号解释。 */ PROOF extern thm i32_shr_def; @@ -170,7 +170,7 @@ PROOF extern thm i32_shr_def; * &(val (word_and ((iword x):(32)word) ((iword y):(32)word))) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `u32_and` 在 32 位字表示上逐位与，并把结果解释为非负无符号整数。 */ PROOF extern thm u32_and_def; @@ -180,7 +180,7 @@ PROOF extern thm u32_and_def; * &(val (word_or ((iword x):(32)word) ((iword y):(32)word))) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `u32_or` 在 32 位字表示上逐位或，并把结果解释为非负无符号整数。 */ PROOF extern thm u32_or_def; @@ -190,7 +190,7 @@ PROOF extern thm u32_or_def; * &(val (word_xor ((iword x):(32)word) ((iword y):(32)word))) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `u32_xor` 在 32 位字表示上逐位异或，并把结果解释为非负无符号整数。 */ PROOF extern thm u32_xor_def; @@ -199,7 +199,7 @@ PROOF extern thm u32_xor_def; * u32_not (x:int) = &(val (word_not ((iword x):(32)word))) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `u32_not` 对 32 位字表示逐位取反，并把结果解释为非负无符号整数。 */ PROOF extern thm u32_not_def; @@ -209,7 +209,7 @@ PROOF extern thm u32_not_def; * &(val (word_shl ((iword x):(32)word) (num_of_int y))) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `u32_shl` 将 32 位字表示左移 `num_of_int y` 位，并以无符号整数读出截断后的结果。 */ PROOF extern thm u32_shl_def; @@ -219,7 +219,7 @@ PROOF extern thm u32_shl_def; * &(val (word_ushr ((iword x):(32)word) (num_of_int y))) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `u32_shr` 将 32 位字表示逻辑右移 `num_of_int y` 位，再用 `val` 读为非负整数。 */ PROOF extern thm u32_shr_def; @@ -229,7 +229,7 @@ PROOF extern thm u32_shr_def; * ival (word_and ((iword x):(64)word) ((iword y):(64)word)) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `i64_and` 在 64 位字表示上逐位与，并把结果按 64 位有符号整数解释。 */ PROOF extern thm i64_and_def; @@ -239,7 +239,7 @@ PROOF extern thm i64_and_def; * ival (word_or ((iword x):(64)word) ((iword y):(64)word)) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `i64_or` 在 64 位字表示上逐位或，并把结果按 64 位有符号整数解释。 */ PROOF extern thm i64_or_def; @@ -249,7 +249,7 @@ PROOF extern thm i64_or_def; * ival (word_xor ((iword x):(64)word) ((iword y):(64)word)) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `i64_xor` 在 64 位字表示上逐位异或，并把结果按 64 位有符号整数解释。 */ PROOF extern thm i64_xor_def; @@ -258,7 +258,7 @@ PROOF extern thm i64_xor_def; * i64_not (x:int) = ival (word_not ((iword x):(64)word)) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `i64_not` 对 64 位字表示逐位取反，并把结果按 64 位有符号整数解释。 */ PROOF extern thm i64_not_def; @@ -268,7 +268,7 @@ PROOF extern thm i64_not_def; * ival (word_shl ((iword x):(64)word) (num_of_int y)) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `i64_shl` 将 64 位字表示左移 `num_of_int y` 位，再按 64 位有符号整数解释结果。 */ PROOF extern thm i64_shl_def; @@ -278,7 +278,7 @@ PROOF extern thm i64_shl_def; * ival (word_ishr ((iword x):(64)word) (num_of_int y)) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `i64_shr` 将 64 位字表示算术右移 `num_of_int y` 位，再用 `ival` 作有符号解释。 */ PROOF extern thm i64_shr_def; @@ -288,7 +288,7 @@ PROOF extern thm i64_shr_def; * &(val (word_and ((iword x):(64)word) ((iword y):(64)word))) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `u64_and` 在 64 位字表示上逐位与，并把结果解释为非负无符号整数。 */ PROOF extern thm u64_and_def; @@ -298,7 +298,7 @@ PROOF extern thm u64_and_def; * &(val (word_or ((iword x):(64)word) ((iword y):(64)word))) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `u64_or` 在 64 位字表示上逐位或，并把结果解释为非负无符号整数。 */ PROOF extern thm u64_or_def; @@ -308,7 +308,7 @@ PROOF extern thm u64_or_def; * &(val (word_xor ((iword x):(64)word) ((iword y):(64)word))) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `u64_xor` 在 64 位字表示上逐位异或，并把结果解释为非负无符号整数。 */ PROOF extern thm u64_xor_def; @@ -317,7 +317,7 @@ PROOF extern thm u64_xor_def; * u64_not (x:int) = &(val (word_not ((iword x):(64)word))) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `u64_not` 对 64 位字表示逐位取反，并把结果解释为非负无符号整数。 */ PROOF extern thm u64_not_def; @@ -327,7 +327,7 @@ PROOF extern thm u64_not_def; * &(val (word_shl ((iword x):(64)word) (num_of_int y))) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `u64_shl` 将 64 位字表示左移 `num_of_int y` 位，并以无符号整数读出截断后的结果。 */ PROOF extern thm u64_shl_def; @@ -337,6 +337,6 @@ PROOF extern thm u64_shl_def; * &(val (word_ushr ((iword x):(64)word) (num_of_int y))) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `u64_shr` 将 64 位字表示逻辑右移 `num_of_int y` 位，再用 `val` 读为非负整数。 */ PROOF extern thm u64_shr_def; diff --git a/theory/c_program_logic/c_memory.h b/theory/c_program_logic/c_memory.h index 4cdd2a9..26b45b5 100644 --- a/theory/c_program_logic/c_memory.h +++ b/theory/c_program_logic/c_memory.h @@ -60,7 +60,7 @@ * memory theorem to a concrete `ctype`, rewrite with this theorem, and only * then expose the resulting `ctype`-free assertion to QCP. * - * 中文说明：说明不同 C 类型构造子互不相等，可用于具体类型的归一化。 + * `ctype` 的任意两个不同构造子都不相等，具体类型实例因而可用这些判别式消去不可能分支。 */ PROOF extern thm pmem_ctype_distinct; @@ -79,7 +79,7 @@ PROOF extern thm pmem_ctype_distinct; * In particular every `Tstruct name fields types` and * `Tfun argument_names argument_types return_type` yields false. * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `pmem_c_scalar_type` 只接受九种内建整数或指针类型，并明确排除结构体与函数类型。 */ PROOF extern thm pmem_c_scalar_type_def; @@ -97,7 +97,7 @@ PROOF extern thm pmem_c_scalar_type_def; * if ty == Tptr then 8 else 0 * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * C 标量宽度依次为 1、2、4 或 8 字节；不受支持的结构体和函数类型落到零宽度。 */ PROOF extern thm pmem_c_width_def; @@ -115,7 +115,7 @@ PROOF extern thm pmem_c_width_def; * if ty == Tptr then &0 else &0 * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 有符号标量的下界分别采用对应补码最小值，无符号整数和指针下界为零，不支持类型也返回零。 */ PROOF extern thm pmem_c_min_def; @@ -133,7 +133,7 @@ PROOF extern thm pmem_c_min_def; * if ty == Tptr then &18446744073709551615 else &0 * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 各标量上界按其 8、16、32 或 64 位有符号性计算，64 位指针与 `Tuint64` 共用 `2^64-1`。 */ PROOF extern thm pmem_c_max_def; @@ -152,7 +152,7 @@ PROOF extern thm pmem_c_max_def; * Thus the complete byte interval is in the concrete 64-bit address space * and the base is naturally aligned to the scalar width. * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 地址合法要求类型为受支持标量、完整字节区间落在 64 位地址空间内，并按标量宽度自然对齐。 */ PROOF extern thm pmem_c_address_ok_def; @@ -166,7 +166,7 @@ PROOF extern thm pmem_c_address_ok_def; * The unary predicate avoids placing a `ctype` term inside an ordinary QCP * pure predicate. * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `pmem_uint64_address_ok` 是 `Tuint64` 地址合法性的闭合一元版本，便于在不暴露 `ctype` 参数时使用。 */ PROOF extern thm pmem_uint64_address_ok_def; @@ -176,7 +176,7 @@ PROOF extern thm pmem_uint64_address_ok_def; * pmem_c_address_ok address Tptr * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `pmem_ptr_address_ok` 恰好把通用 C 地址合法性专门化到 64 位指针类型 `Tptr`。 */ PROOF extern thm pmem_ptr_address_ok_def; @@ -190,7 +190,7 @@ PROOF extern thm pmem_ptr_address_ok_def; * integer_value <= pmem_c_max ty. * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 值合法要求 `ty` 是受支持标量，且整数值位于该类型的闭区间 `[pmem_c_min ty, pmem_c_max ty]`。 */ PROOF extern thm pmem_c_value_ok_def; @@ -208,7 +208,7 @@ PROOF extern thm pmem_c_value_ok_def; * theorem's alignment conjunct; callers carving a typed cell must establish * it as a separate resource-independent HOL side condition. * - * 中文说明：把 Tuint64 地址有效性展开为范围、八字节跨度与八字节对齐条件。 + * `Tuint64` 的合法基址恰好是非负、八字节区间不越过 `2^64-1` 且能被 8 整除的地址。 */ PROOF extern thm pmem_c_address_ok_Tuint64; @@ -231,7 +231,7 @@ PROOF extern thm pmem_c_address_ok_Tuint64; * The second conjunct owns the exact little-endian bytes; the first imposes * the C ABI side conditions without consuming a second resource. * - * 中文说明：说明 data-at 同时携带地址与取值约束以及精确字节所有权。 + * `pmem_data_at` 在同一资源上同时要求地址和值满足 C ABI，并精确拥有该值按类型宽度编码的小端字节。 */ PROOF extern thm pmem_data_at_def; @@ -250,7 +250,7 @@ PROOF extern thm pmem_data_at_def; * overwriting store but not a load. `pmem_undef_scalar_at` remains available * separately when strict physical uninitialization matters to a proof. * - * 中文说明：说明 undef-data-at 只保证可写的已分配字节，不保证物理未初始化。 + * `pmem_undef_data_at` 要求合法类型地址并拥有相应宽度的任意状态字节；它保证可写分配，但不声称字节为 `PMemUninit`。 */ PROOF extern thm pmem_undef_data_at_def; @@ -262,7 +262,7 @@ PROOF extern thm pmem_undef_data_at_def; * (pmem_allocated_at address (pmem_c_width ty)) * ``` * - * 中文说明：说明物理 data-at 所有权可遗忘为 allocated 区域。 + * 精确的物理 `data_at` 可遗忘类型约束和具体字节值，留下同地址、类型宽度大小的 allocated 区域。 */ PROOF extern thm pmem_data_at_allocated_at; @@ -274,7 +274,7 @@ PROOF extern thm pmem_data_at_allocated_at; * (pmem_allocated_at address (pmem_c_width ty)) * ``` * - * 中文说明：说明物理 undef-data-at 所有权可遗忘为 allocated 区域。 + * 物理 `undef_data_at` 可遗忘其合法地址守卫，留下同地址、类型宽度大小的任意状态 allocated 区域。 */ PROOF extern thm pmem_undef_data_at_allocated_at; @@ -290,7 +290,7 @@ PROOF extern thm pmem_undef_data_at_allocated_at; * (pmem_undef_data_at address ty) * ``` * - * 中文说明：说明满足地址约束的物理 allocated 区域可视为 undef-data-at。 + * 若地址对类型 `ty` 合法，则该地址起 `pmem_c_width ty` 个 allocated 字节足以建立物理 `undef_data_at`。 */ PROOF extern thm pmem_allocated_at_to_undef_data_at; @@ -302,7 +302,7 @@ PROOF extern thm pmem_allocated_at_to_undef_data_at; * (pmem_undef_data_at address ty) * ``` * - * 中文说明：说明物理 data-at 可遗忘具体值而视为 undef-data-at。 + * 物理 `data_at` 可遗忘已初始化字节承载的具体值，得到同地址同类型的 unknown-content `undef_data_at`。 */ PROOF extern thm pmem_data_at_to_undef_data_at; @@ -316,7 +316,7 @@ PROOF extern thm pmem_data_at_to_undef_data_at; * pmem_undef_data_at address Tuint64. * ``` * - * 中文说明：说明满足地址约束时，八个严格未初始化字节可视为 Tuint64 的 undef-data-at。 + * 在独立证明 `Tuint64` 地址合法后，连续八个确为 `PMemUninit` 的字节可弱化为该地址的 `Tuint64` unknown-content 单元。 */ PROOF extern thm pmem_undef_scalar_at_Tuint64; @@ -334,7 +334,7 @@ PROOF extern thm pmem_undef_scalar_at_Tuint64; * c_lift_phys G (pmem_allocated_at address count). * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `c_allocated_at G address count` 精确提升物理 allocated 区域到完整 C 资源，并要求 ghost 投影为空。 */ PROOF extern thm c_allocated_at_def; @@ -346,7 +346,7 @@ PROOF extern thm c_allocated_at_def; * c_lift_phys G (pmem_data_at address ty integer_value). * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `c_data_at G address ty value` 精确提升物理 typed initialized 单元到完整 C 资源，不携带 ghost 片段。 */ PROOF extern thm c_data_at_def; @@ -358,7 +358,7 @@ PROOF extern thm c_data_at_def; * c_lift_phys G (pmem_undef_data_at address ty). * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `c_undef_data_at G address ty` 精确提升物理 unknown-content typed 单元到完整 C 资源，不携带 ghost 片段。 */ PROOF extern thm c_undef_data_at_def; @@ -370,7 +370,7 @@ PROOF extern thm c_undef_data_at_def; * This is a raw equation for the named memory predicate, not a generic BI * connective law. * - * 中文说明：说明零长度的 C allocated 区域等价于 emp。 + * 零长度 `c_allocated_at` 不占有物理字节且 ghost 投影为空，因此原始断言等于完整 C 资源的 `emp`。 */ PROOF extern thm c_allocated_at_zero; @@ -388,7 +388,7 @@ PROOF extern thm c_allocated_at_zero; * The equation only regroups the same physical byte range. It adds neither * C typing nor initialization information. * - * 中文说明：说明相邻的 C allocated 区域可通过 sep 合并为一个区域。 + * 长度 `m+n` 的 C allocated 区域等于长度 `m` 的前缀与从 `address+m` 开始的长度 `n` 后缀之分离合取。 */ PROOF extern thm c_allocated_at_append; @@ -401,7 +401,7 @@ PROOF extern thm c_allocated_at_append; * (c_undef_data_at G address ty) * ``` * - * 中文说明：说明满足地址约束的 C allocated 区域可视为 undef-data-at。 + * 若 `address` 对 `ty` 合法，则完整 C 资源中的类型宽度 allocated 区域蕴含同地址同类型的 `c_undef_data_at`。 */ PROOF extern thm c_allocated_at_to_undef_data_at; @@ -413,7 +413,7 @@ PROOF extern thm c_allocated_at_to_undef_data_at; * (c_undef_data_at G address ty) * ``` * - * 中文说明：说明完整 C data-at 可遗忘具体值而视为 undef-data-at。 + * 完整 C 资源中的 `c_data_at` 可遗忘具体已初始化值，得到同地址同类型的 `c_undef_data_at`。 */ PROOF extern thm c_data_at_to_undef_data_at; @@ -425,7 +425,7 @@ PROOF extern thm c_data_at_to_undef_data_at; * (c_allocated_at G address (pmem_c_width ty)) * ``` * - * 中文说明：说明精确 C data-at 所有权可遗忘为 allocated 区域。 + * 完整 C 资源中的 `c_data_at` 可遗忘类型和值，得到同地址、类型宽度大小的 `c_allocated_at`。 */ PROOF extern thm c_data_at_allocated_at; @@ -437,7 +437,7 @@ PROOF extern thm c_data_at_allocated_at; * (c_allocated_at G address (pmem_c_width ty)) * ``` * - * 中文说明：说明 C undef-data-at 所有权可遗忘为 allocated 区域。 + * 完整 C 资源中的 `c_undef_data_at` 可遗忘合法地址守卫，得到同地址、类型宽度大小的 `c_allocated_at`。 */ PROOF extern thm c_undef_data_at_allocated_at; @@ -466,6 +466,6 @@ PROOF extern thm c_undef_data_at_allocated_at; * `r_fact`, rather than resource-independent `r_pure`, makes the exposed * bounds an exact-unit spatial conjunct. * - * 中文说明：说明 C data-at 可在保留单元所有权的同时导出取值上下界 fact。 + * `c_data_at` 可保留原 typed 单元所有权，同时分离出 `value` 位于该类型上下界之间的 exact-unit fact。 */ PROOF extern thm c_data_at_value_range; diff --git a/theory/c_program_logic/c_resource.h b/theory/c_program_logic/c_resource.h index ffb2101..aecf699 100644 --- a/theory/c_program_logic/c_resource.h +++ b/theory/c_program_logic/c_resource.h @@ -34,7 +34,7 @@ * Both sides have type * `(((int,(pmem_byte_state)excl)finmap)#A)ra`. * - * 中文说明：说明完整 C 资源由物理内存 RA 与完整 ghost RA 的乘积组成。 + * 完整 C 资源代数正是物理内存 `mem_ra` 与调用者提供的全局 ghost 代数 `G` 的乘积。 */ PROOF extern thm c_resource_ra_def; @@ -44,7 +44,7 @@ PROOF extern thm c_resource_ra_def; * (ra_unit mem_ra,ra_unit G) * ``` * - * 中文说明：说明完整 C 资源的单位元由内存 unit 与 ghost unit 配对组成。 + * 完整 C 资源的单位元逐分量组成，即空物理内存与 `G` 的单位元配对。 */ PROOF extern thm c_resource_ra_unit; @@ -57,7 +57,7 @@ PROOF extern thm c_resource_ra_unit; * ``` * Here `Mem` abbreviates `(int,(pmem_byte_state)excl)finmap`. * - * 中文说明：说明完整 C 资源的组合运算分别作用于物理与 ghost 投影。 + * 两个完整 C 资源组合时，物理投影按 `mem_ra` 组合，ghost 投影独立按 `G` 组合。 */ PROOF extern thm c_resource_ra_op; @@ -70,7 +70,7 @@ PROOF extern thm c_resource_ra_op; * ``` * Here `Mem` abbreviates `(int,(pmem_byte_state)excl)finmap`. * - * 中文说明：说明完整 C 资源有效，当且仅当物理与 ghost 投影分别有效。 + * 一对完整 C 资源有效，当且仅当其物理内存投影和 ghost 投影在各自代数中都有效。 */ PROOF extern thm c_resource_ra_valid; @@ -83,7 +83,7 @@ PROOF extern thm c_resource_ra_valid; * * Here `Mem` abbreviates `(int,(pmem_byte_state)excl)finmap`. * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `c_lift_phys G P` 将物理断言 `P` 精确嵌入乘积资源，并要求 ghost 投影恰为 `G` 的单位元。 */ PROOF extern thm c_lift_phys_def; @@ -93,7 +93,7 @@ PROOF extern thm c_lift_phys_def; * r_lift_right mem_ra G Q * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `c_lift_ghost G Q` 将 ghost 断言 `Q` 精确嵌入乘积资源，并要求物理投影恰为空内存单位元。 */ PROOF extern thm c_lift_ghost_def; @@ -104,7 +104,7 @@ PROOF extern thm c_lift_ghost_def; * c_lift_ghost G (r_own G ghost) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `c_ghost_own G ghost` 是 `r_own G ghost` 的精确 ghost 提升，因此不携带任何物理内存资源。 */ PROOF extern thm c_ghost_own_def; @@ -115,7 +115,7 @@ PROOF extern thm c_ghost_own_def; * c_lift_phys G (r_own mem_ra (pmem_uninit address)) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `c_pmem_uninit_at G address` 精确拥有地址处一个物理未初始化字节，并要求 ghost 投影为空。 */ PROOF extern thm c_pmem_uninit_at_def; @@ -125,6 +125,6 @@ PROOF extern thm c_pmem_uninit_at_def; * c_lift_phys G (r_own mem_ra (pmem_byte address byte)) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `c_pmem_byte_at G address byte` 精确拥有地址处值为 `byte` 的已初始化物理字节，并要求 ghost 投影为空。 */ PROOF extern thm c_pmem_byte_at_def; diff --git a/theory/c_program_logic/c_types.h b/theory/c_program_logic/c_types.h index 4a611d0..a2f5234 100644 --- a/theory/c_program_logic/c_types.h +++ b/theory/c_program_logic/c_types.h @@ -48,7 +48,7 @@ PROOF extern indtype ctype_type; * &(c_struct_size name field_names field_types)) * ``` * - * 中文说明：给出各类 C 类型的大小计算规则。 + * 字符、短整型、32 位量和 64 位量分别取 1、2、4、8 字节；结构体使用抽象布局，`Tfun` 按当前布局约定返回 8。 */ PROOF extern thm sizeof_def; @@ -58,6 +58,6 @@ PROOF extern thm sizeof_def; * base + field_offset structure field_name * ``` * - * 中文说明：说明字段地址等于结构体基址加字段偏移。 + * 结构体字段的地址由对象基址加上该结构体中字段的抽象偏移量得到。 */ PROOF extern thm field_addr_prop; diff --git a/theory/c_program_logic/mem_own.h b/theory/c_program_logic/mem_own.h index 54d4473..ddfc1c2 100644 --- a/theory/c_program_logic/mem_own.h +++ b/theory/c_program_logic/mem_own.h @@ -24,7 +24,7 @@ * pmem_own memory == r_own mem_ra memory * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `pmem_own memory` 就是在物理内存代数中精确拥有有限映射片段 `memory`。 */ PROOF extern thm pmem_own_def; @@ -35,7 +35,7 @@ PROOF extern thm pmem_own_def; * pmem_uninit_at address == pmem_own (pmem_uninit address) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `pmem_uninit_at address` 精确拥有地址 `address` 处一个状态为 `PMemUninit` 的字节。 */ PROOF extern thm pmem_uninit_at_def; @@ -47,6 +47,6 @@ PROOF extern thm pmem_uninit_at_def; * pmem_own (pmem_byte address byte) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `pmem_byte_at address byte` 精确拥有地址 `address` 处一个已初始化且值为 `byte` 的字节。 */ PROOF extern thm pmem_byte_at_def; diff --git a/theory/c_program_logic/mem_ra.h b/theory/c_program_logic/mem_ra.h index 0a220bf..ff5cb80 100644 --- a/theory/c_program_logic/mem_ra.h +++ b/theory/c_program_logic/mem_ra.h @@ -50,7 +50,7 @@ PROOF extern indtype pmem_byte_state_type; * ⊢ mem_ra == gmap_ra (excl_ra : ((pmem_byte_state)excl)ra). * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 物理内存代数由“地址到 exclusive 字节状态”的有限映射代数构造而成。 */ PROOF extern thm mem_ra_def; @@ -62,7 +62,7 @@ PROOF extern thm mem_ra_def; * (finmap_empty : (int,(pmem_byte_state)excl)finmap). * ``` * - * 中文说明：说明物理内存 RA 的单位元是空有限映射。 + * 物理内存代数的单位元是不拥有任何地址的空有限映射。 */ PROOF extern thm mem_ra_unit; @@ -77,7 +77,7 @@ PROOF extern thm mem_ra_unit; * (finmap_lookup right address). * ``` * - * 中文说明：说明内存组合在每个地址上按 option/exclusive 运算逐点计算。 + * 两个内存片段组合后，每个地址的查询结果由对应两个可选 exclusive 条目逐点组合得到。 */ PROOF extern thm mem_ra_op_lookup; @@ -92,7 +92,7 @@ PROOF extern thm mem_ra_op_lookup; * (finmap_lookup memory address). * ``` * - * 中文说明：说明内存有限映射有效，当且仅当每个地址的 option/exclusive 条目有效。 + * 内存有限映射有效，当且仅当每个地址查询到的可选 exclusive 字节状态都有效。 */ PROOF extern thm mem_ra_valid; @@ -108,7 +108,7 @@ PROOF extern thm mem_ra_valid; * finmap_singleton address (Excl state) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `pmem_singleton address state` 是仅在 `address` 处存放 canonical `Excl state` 的内存片段。 */ PROOF extern thm pmem_singleton_def; @@ -120,7 +120,7 @@ PROOF extern thm pmem_singleton_def; * pmem_singleton address PMemUninit * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `pmem_uninit address` 是仅拥有 `address` 处一个未初始化字节的 canonical 单点片段。 */ PROOF extern thm pmem_uninit_def; @@ -132,7 +132,7 @@ PROOF extern thm pmem_uninit_def; * pmem_singleton address (PMemByte byte) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `pmem_byte address byte` 是仅拥有 `address` 处一个值为 `byte` 的已初始化字节的 canonical 单点片段。 */ PROOF extern thm pmem_byte_def; @@ -141,7 +141,7 @@ PROOF extern thm pmem_byte_def; * ⊢ ∀address state. ra_valid mem_ra (pmem_singleton address state) * ``` * - * 中文说明：说明该资源或构造满足相应的有效性条件。 + * 任意地址和任意字节状态构成的 canonical 单点内存片段都有效。 */ PROOF extern thm pmem_singleton_valid; @@ -156,7 +156,7 @@ PROOF extern thm pmem_singleton_valid; * (pmem_singleton address right)). * ``` * - * 中文说明：说明同一地址上的两个 owned 单点内存片段组合后无效。 + * 无论各自字节状态为何，两个拥有同一地址的 canonical 单点片段组合都会因 exclusive 冲突而无效。 */ PROOF extern thm pmem_singleton_overlap_invalid; @@ -177,7 +177,7 @@ PROOF extern thm pmem_singleton_overlap_invalid; * (pmem_byte address byte) * ``` * - * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 + * 同一地址的未初始化单点可更新为任意给定字节值；这是 `mem_ra` 层的代数更新，不是 C view shift。 */ PROOF extern thm pmem_update_uninit_byte; @@ -187,7 +187,7 @@ PROOF extern thm pmem_update_uninit_byte; * (pmem_uninit address) * ``` * - * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 + * 同一地址的已初始化单点可更新回未初始化单点；这是 `mem_ra` 层的代数更新，不是 C view shift。 */ PROOF extern thm pmem_update_byte_uninit; @@ -198,6 +198,6 @@ PROOF extern thm pmem_update_byte_uninit; * (pmem_byte address new_byte) * ``` * - * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 + * 同一地址的已初始化单点可改写为任意目标字节值；这是 `mem_ra` 层的代数更新，不是 C view shift。 */ PROOF extern thm pmem_update_byte_byte; diff --git a/theory/c_program_logic/mem_value.h b/theory/c_program_logic/mem_value.h index a70eeb9..08a7b4c 100644 --- a/theory/c_program_logic/mem_value.h +++ b/theory/c_program_logic/mem_value.h @@ -48,7 +48,7 @@ * later name, only `pmem_undef_scalar_at` guarantees physical `PMemUninit` * states. * - * 中文说明：说明 allocated byte 隐藏初始化状态，只保证拥有该地址的一字节。 + * `pmem_allocated_byte_at address` 存在性地隐藏字节状态，因此既接受 `PMemUninit`，也接受任意 `PMemByte byte`。 */ PROOF extern thm pmem_allocated_byte_at_def; @@ -63,7 +63,7 @@ PROOF extern thm pmem_allocated_byte_at_def; * (pmem_bytes_at (base + &1) bytes). * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 连续已初始化字节的所有权按列表递归：空列表为 `emp`，非空列表分离拥有基址处首字节与后续地址的尾列表。 */ PROOF extern thm pmem_bytes_at_def; @@ -74,7 +74,7 @@ PROOF extern thm pmem_bytes_at_def; * ⊢ ∀base. pmem_bytes_at base [] == r_emp mem_ra * ``` * - * 中文说明：说明空字节列表的精确所有权等于 emp。 + * 从任意基址开始拥有空字节列表，恰好就是物理内存代数的 `emp`。 */ PROOF extern thm pmem_bytes_at_nil; @@ -86,7 +86,7 @@ PROOF extern thm pmem_bytes_at_nil; * pmem_byte_at base byte **_mem pmem_bytes_at (base + &1) bytes * ``` * - * 中文说明：给出非空字节列表所有权的 head 与 tail 分离展开。 + * 非空字节列表在 `base` 处分解为首字节的精确所有权，以及从 `base + 1` 开始的尾列表所有权。 */ PROOF extern thm pmem_bytes_at_cons; @@ -102,7 +102,7 @@ PROOF extern thm pmem_bytes_at_cons; * (pmem_allocated_at (base + &1) count) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 连续 allocated 区域按长度递归：零字节为 `emp`，后继长度分离拥有当前任意状态字节与下一地址的剩余区域。 */ PROOF extern thm pmem_allocated_at_def; @@ -113,7 +113,7 @@ PROOF extern thm pmem_allocated_at_def; * ⊢ ∀base. pmem_allocated_at base 0 == r_emp mem_ra * ``` * - * 中文说明：说明零长度 allocated 区域等于 emp。 + * 从任意基址开始的零长度 allocated 区域不占有字节，因而等于 `emp`。 */ PROOF extern thm pmem_allocated_at_zero; @@ -126,7 +126,7 @@ PROOF extern thm pmem_allocated_at_zero; * pmem_allocated_at (base + &1) count * ``` * - * 中文说明：给出非空 allocated 区域的逐字节递归展开。 + * 长度 `SUC count` 的 allocated 区域分解为 `base` 处任意状态的一字节和从 `base + 1` 开始的 `count` 字节。 */ PROOF extern thm pmem_allocated_at_suc; @@ -141,7 +141,7 @@ PROOF extern thm pmem_allocated_at_suc; * (pmem_allocated_at (base + &m) n). * ``` * - * 中文说明：说明两个相邻 allocated 区域可通过 sep 合并。 + * 从 `base` 开始的 `m+n` 个 allocated 字节，等于长度 `m` 的前缀与从 `base+m` 开始的长度 `n` 后缀之分离合取。 */ PROOF extern thm pmem_allocated_at_append; @@ -156,7 +156,7 @@ PROOF extern thm pmem_allocated_at_append; * (pmem_allocated_at (base + &k) (n - k)). * ``` * - * 中文说明：说明 allocated 区域可在指定长度处分裂为两个相邻区域。 + * 若 `k ≤ n`，长度 `n` 的 allocated 区域可在偏移 `k` 处分为长度 `k` 与 `n-k` 的两个相邻片段。 */ PROOF extern thm pmem_allocated_at_split; @@ -170,7 +170,7 @@ PROOF extern thm pmem_allocated_at_split; * (pmem_allocated_byte_at address). * ``` * - * 中文说明：说明未初始化单字节所有权可遗忘为 allocated byte。 + * 精确拥有一个 `PMemUninit` 字节时，可遗忘初始化状态而得到同地址的 allocated-byte 所有权。 */ PROOF extern thm pmem_uninit_at_allocated_byte; @@ -184,7 +184,7 @@ PROOF extern thm pmem_uninit_at_allocated_byte; * (pmem_allocated_byte_at address). * ``` * - * 中文说明：说明已初始化单字节所有权可遗忘为 allocated byte。 + * 精确拥有地址处值为 `byte` 的已初始化字节时，可遗忘其值和初始化状态而得到 allocated-byte 所有权。 */ PROOF extern thm pmem_byte_at_allocated_byte; @@ -198,7 +198,7 @@ PROOF extern thm pmem_byte_at_allocated_byte; * (pmem_allocated_at base (LENGTH bytes)). * ``` * - * 中文说明：说明连续已初始化字节所有权可遗忘为同长度 allocated 区域。 + * 连续拥有列表 `bytes` 中的具体字节，可逐字节遗忘内容为从同一基址开始、长度 `LENGTH bytes` 的 allocated 区域。 */ PROOF extern thm pmem_bytes_at_allocated; @@ -221,7 +221,7 @@ PROOF extern thm pmem_bytes_at_allocated; * truncated two's-complement byte representation; range and signedness are * imposed only by the later C scalar-type layer. * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `pmem_le_bytes count value` 递归取 `value` 的低 `count` 个 base-256 数位，并按最低有效字节在前排列。 */ PROOF extern thm pmem_le_bytes_def; @@ -232,7 +232,7 @@ PROOF extern thm pmem_le_bytes_def; * ⊢ ∀value. pmem_le_bytes 0 value == [] * ``` * - * 中文说明：说明零字节小端编码结果为空列表。 + * 任意整数截取零个小端字节都得到空列表。 */ PROOF extern thm pmem_le_bytes_zero; @@ -244,7 +244,7 @@ PROOF extern thm pmem_le_bytes_zero; * (value rem &256)::pmem_le_bytes count (value div &256) * ``` * - * 中文说明：给出小端编码的低字节与递归剩余字节。 + * 非零长度的小端编码以 `value rem 256` 为首字节，并递归编码 `value div 256` 的剩余字节。 */ PROOF extern thm pmem_le_bytes_suc; @@ -253,7 +253,7 @@ PROOF extern thm pmem_le_bytes_suc; * ⊢ ∀(count:num)(value:int). LENGTH (pmem_le_bytes count value) == count * ``` * - * 中文说明：给出列表操作的递归方程或长度、索引性质。 + * `pmem_le_bytes count value` 对任意整数都恰好产生 `count` 个字节。 */ PROOF extern thm pmem_le_bytes_length; @@ -265,7 +265,7 @@ PROOF extern thm pmem_le_bytes_length; * pmem_bytes_at base (pmem_le_bytes count integer_value) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `pmem_scalar_at base count value` 精确拥有从 `base` 起存放 `value` 的 `count` 字节小端编码。 */ PROOF extern thm pmem_scalar_at_def; @@ -283,7 +283,7 @@ PROOF extern thm pmem_scalar_at_def; * Every owned byte is exactly `PMemUninit`; this assertion does not admit an * initialized byte with an existentially hidden value. * - * 中文说明：说明严格未初始化标量由连续的 PMemUninit 字节组成。 + * `pmem_undef_scalar_at` 递归要求范围内每个字节都精确处于 `PMemUninit`，而非仅隐藏其内容。 */ PROOF extern thm pmem_undef_scalar_at_def; @@ -294,7 +294,7 @@ PROOF extern thm pmem_undef_scalar_at_def; * ⊢ ∀(base:int)(value:int). pmem_scalar_at base 0 value == r_emp mem_ra * ``` * - * 中文说明：说明零宽度标量所有权等于 emp。 + * 零宽度的已初始化标量不占有任何物理字节，因此等于 `emp`，与 `base` 和 `value` 无关。 */ PROOF extern thm pmem_scalar_at_zero; @@ -310,7 +310,7 @@ PROOF extern thm pmem_scalar_at_zero; * (base + &1) count (value div &256)). * ``` * - * 中文说明：给出非零宽度标量所有权的首字节与剩余字节展开。 + * 非零宽度标量在 `base` 处存低字节 `value rem 256`，其余 `count` 字节在下一地址存 `value div 256`。 */ PROOF extern thm pmem_scalar_at_suc; @@ -321,7 +321,7 @@ PROOF extern thm pmem_scalar_at_suc; * ⊢ ∀base:int. pmem_undef_scalar_at base 0 == r_emp mem_ra * ``` * - * 中文说明：说明零宽度严格未初始化标量等于 emp。 + * 零宽度的严格未初始化标量不占有任何字节，因而等于 `emp`。 */ PROOF extern thm pmem_undef_scalar_at_zero; @@ -336,7 +336,7 @@ PROOF extern thm pmem_undef_scalar_at_zero; * (pmem_undef_scalar_at (base + &1) count). * ``` * - * 中文说明：给出非零宽度严格未初始化标量的逐字节展开。 + * 非零宽度的严格未初始化标量分离拥有 `base` 处一个 `PMemUninit` 字节及下一地址起的剩余字节。 */ PROOF extern thm pmem_undef_scalar_at_suc; @@ -350,7 +350,7 @@ PROOF extern thm pmem_undef_scalar_at_suc; * pmem_allocated_at base count. * ``` * - * 中文说明：说明严格未初始化标量所有权可遗忘为 allocated 区域。 + * 连续 `count` 个确为 `PMemUninit` 的字节可遗忘其状态，得到同地址、同长度的 allocated 区域。 */ PROOF extern thm pmem_undef_scalar_at_allocated; @@ -365,6 +365,6 @@ PROOF extern thm pmem_undef_scalar_at_allocated; * (pmem_allocated_at base count). * ``` * - * 中文说明：说明已初始化标量所有权可遗忘为 allocated 区域。 + * 存放具体标量值的 `count` 个已初始化字节可遗忘其内容，得到同地址、同长度的 allocated 区域。 */ PROOF extern thm pmem_scalar_at_allocated; diff --git a/theory/data/int_list.h b/theory/data/int_list.h index 8e26d3e..621c221 100644 --- a/theory/data/int_list.h +++ b/theory/data/int_list.h @@ -21,7 +21,7 @@ * ilength tail) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 整数长度在空列表上为零，在非空列表上等于表尾长度加一。 */ PROOF extern thm ILENGTH_DEF; /** @@ -32,7 +32,7 @@ PROOF extern thm ILENGTH_DEF; * (head :: tail) = NTH index tail) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 非空列表的第零项是表头，第 `SUC index` 项递归为表尾的第 `index` 项。 */ PROOF extern thm NTH_DEF; /** @@ -42,7 +42,7 @@ PROOF extern thm NTH_DEF; * inth (index:int) (values:(A)list) = NTH (num_of_int index) values * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 整数索引访问先用 `num_of_int` 转为自然数，再调用 `NTH`。 */ PROOF extern thm INTH_DEF; /** @@ -54,7 +54,7 @@ PROOF extern thm INTH_DEF; * head :: REPLACE_NTH index value tail) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 按自然数索引替换时，空列表不变、零索引替换表头、后继索引递归替换表尾。 */ PROOF extern thm REPLACE_NTH_DEF; /** @@ -65,7 +65,7 @@ PROOF extern thm REPLACE_NTH_DEF; * (num_of_int index) value values * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 整数索引替换先把索引转为自然数，再调用 `REPLACE_NTH`。 */ PROOF extern thm REPLACE_INTH_DEF; /** @@ -76,7 +76,7 @@ PROOF extern thm REPLACE_INTH_DEF; * && (FIRSTN (SUC count) ((head:A) :: tail) = head :: FIRSTN count tail) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `FIRSTN` 在计数为零或列表为空时返回空表，否则保留表头并递归取剩余前缀。 */ PROOF extern thm FIRSTN_DEF; /** @@ -86,7 +86,7 @@ PROOF extern thm FIRSTN_DEF; * ifirstn (count:int) (values:(A)list) = FIRSTN (num_of_int count) values * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 整数计数的前缀操作先转为自然数计数，再调用 `FIRSTN`。 */ PROOF extern thm IFIRSTN_DEF; /** @@ -97,7 +97,7 @@ PROOF extern thm IFIRSTN_DEF; * []) && (SKIPN (SUC count) ((head:A) :: tail) = SKIPN count tail) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `SKIPN` 在计数为零时返回原表，正计数时逐个丢弃表头，空表始终返回空表。 */ PROOF extern thm SKIPN_DEF; /** @@ -107,7 +107,7 @@ PROOF extern thm SKIPN_DEF; * iskipn (count:int) (values:(A)list) = SKIPN (num_of_int count) values * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 整数计数的跳过操作先转为自然数计数，再调用 `SKIPN`。 */ PROOF extern thm ISKIPN_DEF; /** @@ -117,7 +117,7 @@ PROOF extern thm ISKIPN_DEF; * ireplicate (count:int) (value:A) = REPLICATE (num_of_int count) value * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 整数次数的复制先把次数转为自然数，再调用 `REPLICATE`。 */ PROOF extern thm IREPLICATE_DEF; /** @@ -128,7 +128,7 @@ PROOF extern thm IREPLICATE_DEF; * (FIRSTN (num_of_int upper) values) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 子列表先截取到整数上界对应的前缀，再跳过整数下界对应的元素数。 */ PROOF extern thm SUBLIST_DEF; @@ -139,7 +139,7 @@ PROOF extern thm SUBLIST_DEF; * forall values:(A)list. &0 <= ilength values * ``` * - * 中文说明：给出列表操作的递归方程或长度、索引性质。 + * 任意列表的整数长度都不小于零。 */ PROOF extern thm ILENGTH_NONNEG; /** @@ -150,6 +150,6 @@ PROOF extern thm ILENGTH_NONNEG; * ilength left + ilength right * ``` * - * 中文说明：给出列表操作的递归方程或长度、索引性质。 + * 两个列表拼接后的整数长度等于各自整数长度之和。 */ PROOF extern thm ILENGTH_APPEND; diff --git a/theory/data/list.h b/theory/data/list.h index 2212b7a..9f4160e 100644 --- a/theory/data/list.h +++ b/theory/data/list.h @@ -20,7 +20,7 @@ * (LENGTH t)) * ``` * - * 中文说明：给出列表操作的递归方程或长度、索引性质。 + * 空列表长度为零，向表头加入一个元素会使长度增加一。 */ PROOF extern thm HOL_LENGTH; /** @@ -31,7 +31,7 @@ PROOF extern thm HOL_LENGTH; * CONS h (APPEND t l)) * ``` * - * 中文说明：给出列表操作的递归方程或长度、索引性质。 + * 空列表作为左参数时拼接不变，非空左参数的表头保留并递归拼接表尾。 */ PROOF extern thm HOL_APPEND; /** @@ -42,7 +42,7 @@ PROOF extern thm HOL_APPEND; * (REVERSE l) (CONS x [])) * ``` * - * 中文说明：给出列表操作的递归方程或长度、索引性质。 + * 空列表反转后仍为空，非空列表反转时把原表头追加到反转后表尾。 */ PROOF extern thm HOL_REVERSE; /** @@ -53,6 +53,6 @@ PROOF extern thm HOL_REVERSE; * (REPLICATE n x)) * ``` * - * 中文说明：给出列表操作的递归方程或长度、索引性质。 + * 重复零次得到空列表，重复后继次数会在递归结果前再加入一个给定元素。 */ PROOF extern thm HOL_REPLICATE; diff --git a/theory/logic/agree_ra.h b/theory/logic/agree_ra.h index aa0f420..6d5299b 100644 --- a/theory/logic/agree_ra.h +++ b/theory/logic/agree_ra.h @@ -19,7 +19,7 @@ * ra_unit agree_ra == AgreeUnit * ``` * - * 中文说明：说明 agree RA 只允许相同 owned 值有效组合。 + * agree RA 的 unit 是不持有 payload 的 `AgreeUnit`。 */ PROOF extern thm agree_ra_unit; @@ -30,7 +30,7 @@ PROOF extern thm agree_ra_unit; * (if a == b then Agree a else AgreeInvalid) * ``` * - * 中文说明：说明精确所有权如何反映 RA 的单位元、运算或有效性。 + * 两个 agreement token 的 payload 相等时组合为同一 token，不相等时则组合为 `AgreeInvalid`。 */ PROOF extern thm agree_ra_owned_op; @@ -39,7 +39,7 @@ PROOF extern thm agree_ra_owned_op; * forall a. ra_op agree_ra (Agree a) (Agree a) == Agree a * ``` * - * 中文说明：说明该运算或变换是幂等的，重复应用不会产生额外变化。 + * 同一 agreement token `Agree a` 与自身组合仍等于 `Agree a`。 */ PROOF extern thm agree_ra_idempotent; @@ -48,7 +48,7 @@ PROOF extern thm agree_ra_idempotent; * ra_valid agree_ra AgreeUnit * ``` * - * 中文说明：说明 agree RA 的单位元 AgreeUnit 是有效资源。 + * agree RA 的 unit `AgreeUnit` 是有效资源。 */ PROOF extern thm agree_ra_valid_unit; @@ -57,7 +57,7 @@ PROOF extern thm agree_ra_valid_unit; * forall a. ra_valid agree_ra (Agree a) * ``` * - * 中文说明：说明该资源或构造满足相应的有效性条件。 + * 每个 agreement token `Agree a` 都是有效资源。 */ PROOF extern thm agree_ra_valid_owned; @@ -66,7 +66,7 @@ PROOF extern thm agree_ra_valid_owned; * ~ra_valid agree_ra AgreeInvalid * ``` * - * 中文说明：说明 AgreeInvalid 不是有效的 agree RA 资源。 + * 冲突值 `AgreeInvalid` 在 agree RA 中无效。 */ PROOF extern thm agree_ra_invalid; @@ -79,7 +79,7 @@ PROOF extern thm agree_ra_invalid; * forall a b. ra_valid agree_ra (ra_op agree_ra (Agree a) (Agree b)) <=> a == b * ``` * - * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 + * `Agree a` 与 `Agree b` 的组合有效，当且仅当 payload `a` 与 `b` 相等。 */ PROOF extern thm agree_ra_valid_combine_iff; @@ -88,7 +88,7 @@ PROOF extern thm agree_ra_valid_combine_iff; * forall a b. ra_compatible agree_ra (Agree a) (Agree b) ==> a == b * ``` * - * 中文说明：说明 agree RA 只允许相同 owned 值有效组合。 + * 若两个 agreement token 兼容，则它们的 payload 必须相等。 */ PROOF extern thm agree_ra_agreement; @@ -97,7 +97,7 @@ PROOF extern thm agree_ra_agreement; * forall a b. ra_included agree_ra (Agree a) (Agree b) <=> a == b * ``` * - * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 + * agreement token `Agree a` 包含于 `Agree b`，当且仅当 payload `a` 与 `b` 相等。 */ PROOF extern thm agree_ra_included_owned; @@ -106,7 +106,7 @@ PROOF extern thm agree_ra_included_owned; * ~ra_cancellative agree_ra * ``` * - * 中文说明：说明该资源代数满足或不满足消去性质。 + * agree RA 不可消去，因为 agreement token 的幂等组合会隐去是否额外组合了同值 token。 */ PROOF extern thm agree_ra_not_cancellative; @@ -119,7 +119,7 @@ PROOF extern thm agree_ra_not_cancellative; * forall a b. ra_update agree_ra (Agree a) (Agree b) <=> a == b * ``` * - * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 + * agreement token `Agree a` 可更新为 `Agree b`，当且仅当 payload 不变，即 `a = b`。 */ PROOF extern thm agree_ra_update_iff; @@ -130,6 +130,6 @@ PROOF extern thm agree_ra_update_iff; * a == b * ``` * - * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 + * whole/local 均为 `Agree a` 的对可局部更新为 `(Agree b,Agree b)`，当且仅当 `a = b`。 */ PROOF extern thm agree_ra_local_update_iff; diff --git a/theory/logic/auth_ra.h b/theory/logic/auth_ra.h index d1baa2c..3714ffa 100644 --- a/theory/logic/auth_ra.h +++ b/theory/logic/auth_ra.h @@ -23,7 +23,7 @@ * ra_unit (auth_ra R) == auth_frag (ra_unit R) * ``` * - * 中文说明：说明两个 authoritative owner 不能组成有效资源。 + * authoritative RA 的 unit 是不含 authority、且 fragment 为底层 unit 的资源。 */ PROOF extern thm auth_ra_unit; @@ -37,7 +37,7 @@ PROOF extern thm auth_ra_unit; * auth_both a fragment * ``` * - * 中文说明：说明 authoritative 与 fragment 组合后的标准形状。 + * 单独的 authority `a` 与 fragment `fragment` 组合后得到同时持有二者的 `auth_both a fragment`。 */ PROOF extern thm auth_ra_auth_frag; @@ -48,7 +48,7 @@ PROOF extern thm auth_ra_auth_frag; * auth_frag (ra_op R f g) * ``` * - * 中文说明：说明 authoritative 与 fragment 组合后的标准形状。 + * 两个 fragment 组合后仍是 fragment，其 payload 是底层组合 `ra_op R f g`。 */ PROOF extern thm auth_ra_frag_frag; @@ -59,7 +59,7 @@ PROOF extern thm auth_ra_frag_frag; * auth_both a (ra_op R f g) * ``` * - * 中文说明：说明 authoritative 与 fragment 组合后的标准形状。 + * `auth_both a f` 与 fragment `g` 组合时保留 authority `a`，并将 fragment 合并为 `ra_op R f g`。 */ PROOF extern thm auth_ra_both_frag; @@ -74,7 +74,7 @@ PROOF extern thm auth_ra_both_frag; * ra_valid R fragment * ``` * - * 中文说明：刻画 authoritative/fragment 资源的有效性条件。 + * 纯 fragment 在 authoritative RA 中有效，当且仅当其 payload 在底层 `R` 中有效。 */ PROOF extern thm auth_ra_valid_frag; @@ -85,7 +85,7 @@ PROOF extern thm auth_ra_valid_frag; * ra_valid R a && ra_included R fragment a * ``` * - * 中文说明：刻画 authoritative/fragment 资源的有效性条件。 + * `auth_both a fragment` 有效，当且仅当 authority `a` 有效，且可见 fragment `fragment` 在底层 `R` 中包含于 `a`。 */ PROOF extern thm auth_ra_valid_both; @@ -96,7 +96,7 @@ PROOF extern thm auth_ra_valid_both; * ra_valid R a * ``` * - * 中文说明：刻画 authoritative/fragment 资源的有效性条件。 + * 纯 authority `auth_auth R a` 有效，当且仅当 `a` 在底层 `R` 中有效。 */ PROOF extern thm auth_ra_valid_auth; @@ -116,7 +116,7 @@ PROOF extern thm auth_ra_valid_auth; * ra_included R (ra_op R f external) a * ``` * - * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 + * `auth_both a f` 与 frame 的组合有效，当且仅当该 frame 是某个纯 fragment `external`，且 `a` 有效并包含 `f ⋅ external`。 */ PROOF extern thm auth_ra_valid_both_frame; @@ -129,7 +129,7 @@ PROOF extern thm auth_ra_valid_both_frame; * (auth_auth R b)) * ``` * - * 中文说明：给出 authoritative RA 的基础代数性质。 + * 任意两个纯 authority 都不兼容，因为 authoritative owner 具有排他性。 */ PROOF extern thm auth_ra_auth_conflict; @@ -144,7 +144,7 @@ PROOF extern thm auth_ra_auth_conflict; * ra_included R f g * ``` * - * 中文说明：说明 authoritative 与 fragment 组合后的标准形状。 + * 纯 fragment `f` 在 authoritative RA 中包含于纯 fragment `g`，当且仅当 `f` 在底层 `R` 中包含于 `g`。 */ PROOF extern thm auth_ra_included_frag_frag; @@ -155,7 +155,7 @@ PROOF extern thm auth_ra_included_frag_frag; * ra_included R f g * ``` * - * 中文说明：刻画 authoritative/fragment 资源之间的包含关系。 + * 纯 fragment `f` 包含于 `auth_both a g`，当且仅当 `f` 在底层 `R` 中包含于可见 fragment `g`。 */ PROOF extern thm auth_ra_included_frag_both; @@ -166,7 +166,7 @@ PROOF extern thm auth_ra_included_frag_both; * a == b * ``` * - * 中文说明：刻画 authoritative/fragment 资源之间的包含关系。 + * 纯 authority `a` 包含于纯 authority `b`，当且仅当两个 authoritative payload 相等。 */ PROOF extern thm auth_ra_included_auth_auth; @@ -177,7 +177,7 @@ PROOF extern thm auth_ra_included_auth_auth; * a == b * ``` * - * 中文说明：刻画 authoritative/fragment 资源之间的包含关系。 + * 纯 authority `a` 包含于 `auth_both b g`，当且仅当 authoritative payload `a` 与 `b` 相等。 */ PROOF extern thm auth_ra_included_auth_both; @@ -188,7 +188,7 @@ PROOF extern thm auth_ra_included_auth_both; * a == b && ra_included R f g * ``` * - * 中文说明：刻画 authoritative/fragment 资源之间的包含关系。 + * `auth_both a f` 包含于 `auth_both b g`，当且仅当 authority 相等且 `f` 在底层 `R` 中包含于 `g`。 */ PROOF extern thm auth_ra_included_both_both; @@ -198,7 +198,7 @@ PROOF extern thm auth_ra_included_both_both; * ra_cancellative (auth_ra R) <=> ra_cancellative R * ``` * - * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 + * authoritative RA 可消去，当且仅当底层 RA `R` 可消去。 */ PROOF extern thm auth_ra_cancellative_iff; @@ -225,7 +225,7 @@ PROOF extern thm auth_ra_cancellative_iff; * ra_included R (ra_op R g external) b * ``` * - * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 + * 将 `auth_both a f` 更新为 `auth_both b g` 可行，当且仅当对任意外部 fragment `external`，`a` 有效且包含 `f ⋅ external` 都能推出 `b` 有效且包含 `g ⋅ external`。 */ PROOF extern thm auth_ra_update_framewise_iff; @@ -244,7 +244,7 @@ PROOF extern thm auth_ra_update_framewise_iff; * (auth_both b g) * ``` * - * 中文说明：说明 authoritative 资源如何执行一致更新、分配或丢弃。 + * 底层的局部更新 `(a,f) -> (b,g)` 可提升为 authoritative RA 中从 `auth_both a f` 到 `auth_both b g` 的更新。 */ PROOF extern thm auth_ra_update_local; @@ -259,7 +259,7 @@ PROOF extern thm auth_ra_update_local; * ra_valid R b && ra_included R a b) * ``` * - * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 + * 纯 authority `a` 可更新为 `b`，当且仅当 `a` 一旦有效，`b` 就有效且在底层 `R` 中包含 `a`。 */ PROOF extern thm auth_ra_update_auth_iff; @@ -273,7 +273,7 @@ PROOF extern thm auth_ra_update_auth_iff; * (auth_both b g) * ``` * - * 中文说明：说明 authoritative 资源如何执行一致更新、分配或丢弃。 + * 若底层局部更新能把 `(a, unit)` 变为 `(b,g)`，则纯 authority `a` 可更新为同时持有 authority `b` 和 fragment `g`。 */ PROOF extern thm auth_ra_update_alloc; @@ -286,7 +286,7 @@ PROOF extern thm auth_ra_update_alloc; * (auth_auth R a) * ``` * - * 中文说明：说明 authoritative 资源如何执行一致更新、分配或丢弃。 + * `auth_both a f` 可更新为纯 authority `a`，即丢弃本地持有的 fragment `f`。 */ PROOF extern thm auth_ra_update_drop_local; @@ -299,7 +299,7 @@ PROOF extern thm auth_ra_update_drop_local; * (auth_frag f) * ``` * - * 中文说明：说明 authoritative 资源如何执行一致更新、分配或丢弃。 + * `auth_both a f` 可更新为纯 fragment `f`，即丢弃排他的 authoritative owner。 */ PROOF extern thm auth_ra_update_drop_auth; @@ -313,7 +313,7 @@ PROOF extern thm auth_ra_update_drop_auth; * (auth_both a g) * ``` * - * 中文说明：说明 authoritative 资源如何执行一致更新、分配或丢弃。 + * 若 `g` 在底层 `R` 中包含于 `f`，则可保留 authority `a` 不变并将可见 fragment 从 `f` 弱化为 `g`。 */ PROOF extern thm auth_ra_update_weaken_frag; @@ -327,6 +327,6 @@ PROOF extern thm auth_ra_update_weaken_frag; * (auth_both (ra_op R a piece) piece) * ``` * - * 中文说明：说明 authoritative 资源如何执行一致更新、分配或丢弃。 + * 若 `a ⋅ piece` 在底层 `R` 中有效，则纯 authority `a` 可更新为 authority `a ⋅ piece` 并同时分配 fragment `piece`。 */ PROOF extern thm auth_ra_alloc; diff --git a/theory/logic/basic_update.h b/theory/logic/basic_update.h index ae43d36..f55c4b5 100644 --- a/theory/logic/basic_update.h +++ b/theory/logic/basic_update.h @@ -20,7 +20,7 @@ * r_bupd (R:(A)ra) (Q:A->bool) (owned:A) <=> ra_updateP R owned Q * ``` * - * 中文说明：说明 basic update 直接采用底层 RA 的谓词更新语义。 + * `r_bupd R Q` 对整份 `R` 资源执行 `ra_updateP`，允许更新当前拥有资源的任意部分。 */ PROOF extern thm r_bupd_def; @@ -32,7 +32,7 @@ PROOF extern thm r_bupd_def; * (r_bupd R Q) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 从 `P` 到 `Q` 的 view shift 定义为 `P` 蕴含一次可到达 `Q` 的完整 RA 更新。 */ PROOF extern thm r_viewshift_def; @@ -44,7 +44,7 @@ PROOF extern thm r_viewshift_def; * forall (R:(A)ra) (P:A->bool). r_entails R P (r_bupd R P) * ``` * - * 中文说明：给出该逻辑构造的引入规则。 + * 不改变资源的自反更新把任意 `P` 引入为 `r_bupd P`。 */ PROOF extern thm r_bupd_intro; /** @@ -55,7 +55,7 @@ PROOF extern thm r_bupd_intro; * (r_bupd R P) (r_bupd R Q) * ``` * - * 中文说明：说明该构造对蕴含或底层关系保持单调。 + * 若 `P` 蕴含 `Q`，则更新后满足 `P` 也蕴含更新后满足 `Q`。 */ PROOF extern thm r_bupd_mono; /** @@ -66,7 +66,7 @@ PROOF extern thm r_bupd_mono; * P) * ``` * - * 中文说明：说明该运算或变换是幂等的，重复应用不会产生额外变化。 + * 两层连续 basic update 可合并为一层，即 `bupd (bupd P) ⊢ bupd P`。 */ PROOF extern thm r_bupd_idem; /** @@ -77,7 +77,7 @@ PROOF extern thm r_bupd_idem; * (r_bupd R P) frame_pred) (r_bupd R (r_sep R P frame_pred)) * ``` * - * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 + * 若一部分资源可 basic-update 到 `P`，则与 `frame` 分离合取后，整体可更新到 `P ** frame`，且框架保持不变。 */ PROOF extern thm r_bupd_frame; @@ -89,7 +89,7 @@ PROOF extern thm r_bupd_frame; * forall (R:(A)ra) (P:A->bool). r_viewshift R P P * ``` * - * 中文说明：说明该关系具有自反性。 + * 任意断言都可通过不改变资源的更新 view shift 到自身。 */ PROOF extern thm r_viewshift_refl; /** @@ -100,7 +100,7 @@ PROOF extern thm r_viewshift_refl; * P Q * ``` * - * 中文说明：说明逻辑蕴含的组合、改写或框架规则。 + * 普通资源蕴含可提升为完整 RA 的 view shift。 */ PROOF extern thm r_entails_to_viewshift; /** @@ -111,7 +111,7 @@ PROOF extern thm r_entails_to_viewshift; * r_viewshift R Q S ==> r_viewshift R P S * ``` * - * 中文说明：说明该关系或变换可以传递地串联。 + * 从 `P` 更新到 `Q` 再从 `Q` 更新到 `S`，可合成为从 `P` 到 `S` 的 view shift。 */ PROOF extern thm r_viewshift_trans; /** @@ -123,7 +123,7 @@ PROOF extern thm r_viewshift_trans; * R P2 Q2 * ``` * - * 中文说明：说明该构造对蕴含或底层关系保持单调。 + * `P2 ⊢ P` 可加强 view shift 的前件，`Q ⊢ Q2` 可放宽后件，从而由 `P ⇛ Q` 得到 `P2 ⇛ Q2`。 */ PROOF extern thm r_viewshift_mono; /** @@ -134,7 +134,7 @@ PROOF extern thm r_viewshift_mono; * P Q ==> r_viewshift R (r_sep R P frame_pred) (r_sep R Q frame_pred) * ``` * - * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 + * 从 `P` 到 `Q` 的完整 RA 更新可携带同一分离框架，得到 `P ** frame ⇛ Q ** frame`。 */ PROOF extern thm r_viewshift_frame; /** @@ -146,7 +146,7 @@ PROOF extern thm r_viewshift_frame; * P2) (r_sep R Q1 Q2) * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * 两个 view shift 可逐分量组合为分离合取整体上的 view shift。 */ PROOF extern thm r_viewshift_sep; /** @@ -158,7 +158,7 @@ PROOF extern thm r_viewshift_sep; * (\bound:B. P bound)) (r_exists R (\bound:B. Q bound)) * ``` * - * 中文说明：说明存在量词的引入、消去、单调性或与 sep 的交换。 + * 若每个见证下 `P(w)` 都可更新到 `Q(w)`，则取存在量词后仍可执行该 view shift。 */ PROOF extern thm r_viewshift_exists; @@ -171,7 +171,7 @@ PROOF extern thm r_viewshift_exists; * (r_own R b) * ``` * - * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 + * 确定性 RA 更新 `a ↝ b` 可将 `a` 的精确所有权 view shift 为 `b` 的精确所有权。 */ PROOF extern thm r_own_update; @@ -185,6 +185,6 @@ PROOF extern thm r_own_update; * (result_pred selected)) (r_own R selected))) * ``` * - * 中文说明：说明谓词更新允许选择任意满足目标谓词的新资源。 + * 谓词更新可从 `own(a)` 选择目标 `selected`，并分离返回 exact-unit 的 `result_pred(selected)` fact 与 `own(selected)`。 */ PROOF extern thm r_own_updateP; diff --git a/theory/logic/big_sep.h b/theory/logic/big_sep.h index a297317..c1665e3 100644 --- a/theory/logic/big_sep.h +++ b/theory/logic/big_sep.h @@ -27,7 +27,7 @@ * (r_big_sep_list R Phi xs)) * ``` * - * 中文说明：说明列表 big-sep 以 emp 为基例、以 sep 为递归步骤。 + * 列表 big-sep 是右折叠：空表得到 `emp`，非空表把表头断言与表尾结果分离合取。 */ PROOF extern thm r_big_sep_list_def; @@ -40,7 +40,7 @@ PROOF extern thm r_big_sep_list_def; * ([]:(B)list)) (r_emp R) * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * 空列表的 big-sep 在 `r_equiv` 下等价于 `emp`。 */ PROOF extern thm r_big_sep_list_nil; /** @@ -51,7 +51,7 @@ PROOF extern thm r_big_sep_list_nil; * (r_big_sep_list R Phi (x :: xs)) (r_sep R (Phi x) (r_big_sep_list R Phi xs)) * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * 非空列表的 big-sep 等价于表头对应断言与表尾 big-sep 的分离合取。 */ PROOF extern thm r_big_sep_list_cons; /** @@ -62,7 +62,7 @@ PROOF extern thm r_big_sep_list_cons; * :: [])) (Phi x) * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * 单元素列表的 big-sep 等价于该元素对应的断言。 */ PROOF extern thm r_big_sep_list_singleton; /** @@ -74,7 +74,7 @@ PROOF extern thm r_big_sep_list_singleton; * left) (r_big_sep_list R Phi right)) * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * 拼接列表的 big-sep 等价于左右两个列表 big-sep 的分离合取。 */ PROOF extern thm r_big_sep_list_append; @@ -88,7 +88,7 @@ PROOF extern thm r_big_sep_list_append; * (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs) * ``` * - * 中文说明：说明该构造对蕴含或底层关系保持单调。 + * 只要列表中每个元素的 `Phi` 都蕴含 `Psi`，整个列表的两个 big-sep 就保持该蕴含。 */ PROOF extern thm r_big_sep_list_mono; /** @@ -100,7 +100,7 @@ PROOF extern thm r_big_sep_list_mono; * Phi xs) (r_big_sep_list R Psi xs) * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * 只要列表中每个元素的 `Phi` 与 `Psi` 等价，两个列表 big-sep 就在 `r_equiv` 下等价。 */ PROOF extern thm r_big_sep_list_equiv; @@ -113,7 +113,7 @@ PROOF extern thm r_big_sep_list_equiv; * (r_big_sep_list R Phi (MAP f xs)) (r_big_sep_list R (\x:C. Phi (f x)) xs) * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * 对普通列表先执行 `MAP f` 再取 big-sep，等价于在原列表上逐项使用 `Phi(f(x))`。 */ PROOF extern thm r_big_sep_list_map; /** @@ -125,6 +125,6 @@ PROOF extern thm r_big_sep_list_map; * (r_big_sep_list R Phi xs) (r_big_sep_list R Psi xs)) * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * 逐项分离合取后再做 big-sep，等价于分别聚合全部 `Phi`、`Psi` 后再分离合取。 */ PROOF extern thm r_big_sep_list_sep; diff --git a/theory/logic/excl_ra.h b/theory/logic/excl_ra.h index 584f649..13d0cea 100644 --- a/theory/logic/excl_ra.h +++ b/theory/logic/excl_ra.h @@ -20,7 +20,7 @@ * ra_unit excl_ra == ExclUnit * ``` * - * 中文说明：说明 exclusive RA 的单位、owned 值、冲突或更新性质。 + * exclusive RA 的 unit 是不持有 payload 的 `ExclUnit`。 */ PROOF extern thm excl_ra_unit; @@ -29,7 +29,7 @@ PROOF extern thm excl_ra_unit; * forall a b. ra_op excl_ra (Excl a) (Excl b) == ExclInvalid * ``` * - * 中文说明：说明该构造得到无效资源或互斥组合。 + * 任意两个 owned token `Excl a` 与 `Excl b` 组合都产生冲突值 `ExclInvalid`。 */ PROOF extern thm excl_ra_owned_conflict; @@ -38,7 +38,7 @@ PROOF extern thm excl_ra_owned_conflict; * ra_valid excl_ra ExclUnit * ``` * - * 中文说明：说明 exclusive RA 的单位元是有效资源。 + * exclusive RA 的 unit `ExclUnit` 是有效资源。 */ PROOF extern thm excl_ra_valid_unit; @@ -47,7 +47,7 @@ PROOF extern thm excl_ra_valid_unit; * forall a. ra_valid excl_ra (Excl a) * ``` * - * 中文说明：说明该资源或构造满足相应的有效性条件。 + * 每个 owned token `Excl a` 在 exclusive RA 中都有效。 */ PROOF extern thm excl_ra_valid_owned; @@ -56,7 +56,7 @@ PROOF extern thm excl_ra_valid_owned; * ~ra_valid excl_ra ExclInvalid * ``` * - * 中文说明：说明 ExclInvalid 不是有效的 exclusive RA 资源。 + * 冲突值 `ExclInvalid` 在 exclusive RA 中无效。 */ PROOF extern thm excl_ra_invalid; @@ -69,7 +69,7 @@ PROOF extern thm excl_ra_invalid; * forall a b. ra_included excl_ra (Excl a) (Excl b) <=> a == b * ``` * - * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 + * owned token `Excl a` 包含于 `Excl b`，当且仅当它们的 payload `a` 与 `b` 相等。 */ PROOF extern thm excl_ra_included_owned; @@ -78,7 +78,7 @@ PROOF extern thm excl_ra_included_owned; * forall a. ra_maximal excl_ra (Excl a) * ``` * - * 中文说明：说明 frame-maximal 资源只能与单位 frame 兼容。 + * 每个 owned token `Excl a` 都是 maximal，因为它只能与 `ExclUnit` frame 兼容。 */ PROOF extern thm excl_ra_maximal; @@ -87,7 +87,7 @@ PROOF extern thm excl_ra_maximal; * ra_cancellative excl_ra * ``` * - * 中文说明：说明该资源代数满足或不满足消去性质。 + * exclusive RA 满足消去性。 */ PROOF extern thm excl_ra_cancellative; @@ -100,7 +100,7 @@ PROOF extern thm excl_ra_cancellative; * forall a x. ra_update excl_ra (Excl a) x <=> ra_valid excl_ra x * ``` * - * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 + * owned token `Excl a` 可更新为 `x`，当且仅当目标 `x` 在 exclusive RA 中有效。 */ PROOF extern thm excl_ra_update_owned_iff; @@ -110,6 +110,6 @@ PROOF extern thm excl_ra_update_owned_iff; * ra_local_update excl_ra (Excl a) (Excl a) x x <=> ra_valid excl_ra x * ``` * - * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 + * whole/local 均为 `Excl a` 的对可局部更新为 `(x,x)`，当且仅当 `x` 有效。 */ PROOF extern thm excl_ra_local_update_iff; diff --git a/theory/logic/excl_ra_internal.h b/theory/logic/excl_ra_internal.h index 2de78b7..fe806e7 100644 --- a/theory/logic/excl_ra_internal.h +++ b/theory/logic/excl_ra_internal.h @@ -25,7 +25,7 @@ PROOF extern indtype excl_type; * excl_owned_op a ExclInvalid == ExclInvalid * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `excl_owned_op a` 遇到 unit 时返回 `Excl a`，遇到 owned token 或已无效值时都返回 `ExclInvalid`。 */ PROOF extern thm excl_owned_op_def; @@ -36,7 +36,7 @@ PROOF extern thm excl_owned_op_def; * excl_op ExclInvalid y == ExclInvalid * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `excl_op` 以 `ExclUnit` 为左 unit，对左侧 owned token 调用 `excl_owned_op`，而左侧已无效时始终返回 `ExclInvalid`。 */ PROOF extern thm excl_op_def; @@ -49,7 +49,7 @@ PROOF extern thm excl_op_def; * forall a. ~(Excl a == ExclUnit) * ``` * - * 中文说明：说明该构造得到无效资源或互斥组合。 + * 任意 owned token `Excl a` 都不等于 unit `ExclUnit`。 */ PROOF extern thm excl_owned_ne_unit; @@ -58,7 +58,7 @@ PROOF extern thm excl_owned_ne_unit; * ~(ExclInvalid == ExclUnit) * ``` * - * 中文说明：说明 ExclInvalid 与 exclusive RA 的单位元不同。 + * 冲突值 `ExclInvalid` 不等于 unit `ExclUnit`。 */ PROOF extern thm excl_invalid_ne_unit; @@ -67,7 +67,7 @@ PROOF extern thm excl_invalid_ne_unit; * ra_op excl_ra == excl_op * ``` * - * 中文说明：说明 exclusive RA 的单位、owned 值、冲突或更新性质。 + * exclusive RA 的组合函数正是原始操作 `excl_op`。 */ PROOF extern thm excl_ra_op_fn; @@ -76,6 +76,6 @@ PROOF extern thm excl_ra_op_fn; * forall a b. ra_update excl_ra (Excl a) (Excl b) * ``` * - * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 + * 任意 owned token `Excl a` 都可更新为另一个 owned token `Excl b`。 */ PROOF extern thm excl_ra_update; diff --git a/theory/logic/finmap.h b/theory/logic/finmap.h index 3706490..84f6c42 100644 --- a/theory/logic/finmap.h +++ b/theory/logic/finmap.h @@ -28,7 +28,7 @@ * finmap_finite (f:K->V option) <=> FINITE {k:K | ~(f k == NONE)} * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 函数 `f` 表示有限映射，当且仅当取值不为 `NONE` 的键只有有限个。 */ PROOF extern thm finmap_finite_def; @@ -45,7 +45,7 @@ PROOF extern thm finmap_finite_def; * finmap_rep (finmap_abs f) == f) * ``` * - * 中文说明：给出有限映射按键查找或外延相等的规则。 + * `finmap_abs` 与 `finmap_rep` 在有限支撑函数和有限映射之间构成互逆对应。 */ PROOF extern thm finmap_type_bijection; @@ -54,7 +54,7 @@ PROOF extern thm finmap_type_bijection; * forall m:(K,V)finmap. finmap_finite (finmap_rep m) * ``` * - * 中文说明：给出有限映射按键查找或外延相等的规则。 + * 任意有限映射的表示函数都只在有限个键上取非 `NONE` 值。 */ PROOF extern thm finmap_rep_finite; @@ -64,7 +64,7 @@ PROOF extern thm finmap_rep_finite; * m == n <=> finmap_rep m == finmap_rep n * ``` * - * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 + * 两个有限映射相等，当且仅当它们的表示函数相等。 */ PROOF extern thm finmap_eq; @@ -77,7 +77,7 @@ PROOF extern thm finmap_eq; * finmap_empty:(K,V)finmap == finmap_abs (\k:K. NONE) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 空映射由处处返回 `NONE` 的函数抽象而成。 */ PROOF extern thm finmap_empty_def; @@ -86,7 +86,7 @@ PROOF extern thm finmap_empty_def; * finmap_lookup (m:(K,V)finmap) (k:K) == finmap_rep m k * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 在键 `k` 上查找映射 `m` 就是计算其表示函数 `finmap_rep m k`。 */ PROOF extern thm finmap_lookup_def; @@ -96,7 +96,7 @@ PROOF extern thm finmap_lookup_def; * finmap_abs (\k:K. if k == key then SOME v else NONE) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 单点映射只在 `key` 处返回 `SOME v`，其他键均返回 `NONE`。 */ PROOF extern thm finmap_singleton_def; @@ -106,7 +106,7 @@ PROOF extern thm finmap_singleton_def; * finmap_abs (\k:K. if k == key then SOME v else finmap_rep m k) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 插入 `key -> v` 会覆盖 `key` 处的值，并保留 `m` 在其他键上的值。 */ PROOF extern thm finmap_insert_def; @@ -116,7 +116,7 @@ PROOF extern thm finmap_insert_def; * finmap_abs (\k:K. if k == key then NONE else finmap_rep m k) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 删除 `key` 会使该键返回 `NONE`，并保留 `m` 在其他键上的值。 */ PROOF extern thm finmap_delete_def; @@ -126,7 +126,7 @@ PROOF extern thm finmap_delete_def; * {k:K | ~(finmap_lookup m k == NONE)} * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `finmap_dom m` 正是在 `m` 中查找结果不为 `NONE` 的键集合。 */ PROOF extern thm finmap_dom_def; @@ -139,7 +139,7 @@ PROOF extern thm finmap_dom_def; * finmap_rep (finmap_empty:(K,V)finmap) == (\k:K. NONE) * ``` * - * 中文说明：说明有限映射在空映射或单点映射上的标准行为。 + * 空映射的表示函数处处为 `NONE`。 */ PROOF extern thm finmap_empty_rep; @@ -148,7 +148,7 @@ PROOF extern thm finmap_empty_rep; * forall k:K. finmap_lookup (finmap_empty:(K,V)finmap) k == NONE * ``` * - * 中文说明：说明有限映射在空映射或单点映射上的标准行为。 + * 在空映射中查找任意键都得到 `NONE`。 */ PROOF extern thm finmap_empty_lookup; @@ -159,7 +159,7 @@ PROOF extern thm finmap_empty_lookup; * {key} * ``` * - * 中文说明：说明有限映射在空映射或单点映射上的标准行为。 + * 单点函数的非 `NONE` 支撑集恰为 `{key}`。 */ PROOF extern thm finmap_singleton_support; @@ -170,7 +170,7 @@ PROOF extern thm finmap_singleton_support; * (\k:K. if k == key then SOME v else NONE) * ``` * - * 中文说明：说明有限映射在空映射或单点映射上的标准行为。 + * 单点映射的表示函数仅在 `key` 处取 `SOME v`。 */ PROOF extern thm finmap_singleton_rep; @@ -181,7 +181,7 @@ PROOF extern thm finmap_singleton_rep; * if k == key then SOME v else NONE * ``` * - * 中文说明：说明有限映射在空映射或单点映射上的标准行为。 + * 在单点映射中，查找 `key` 得到 `SOME v`，查找其他键得到 `NONE`。 */ PROOF extern thm finmap_singleton_lookup; @@ -192,7 +192,7 @@ PROOF extern thm finmap_singleton_lookup; * key INSERT {k:K | ~(f k == NONE)} * ``` * - * 中文说明：说明有限映射插入操作对查找、定义域或结构的影响。 + * 将 `key` 设为 `SOME v` 后，函数的非 `NONE` 支撑集等于原支撑集加上 `key`。 */ PROOF extern thm finmap_insert_support; @@ -204,7 +204,7 @@ PROOF extern thm finmap_insert_support; * if k == key then SOME v else finmap_rep m k) * ``` * - * 中文说明：说明有限映射插入操作对查找、定义域或结构的影响。 + * 插入后的表示函数在 `key` 处取 `SOME v`，其他键沿用 `m` 的表示。 */ PROOF extern thm finmap_insert_rep; @@ -219,7 +219,7 @@ PROOF extern thm finmap_insert_rep; * if k == key then SOME v else finmap_lookup m k * ``` * - * 中文说明：说明有限映射插入操作对查找、定义域或结构的影响。 + * 插入 `key -> v` 后，查找 `key` 返回 `SOME v`，查找其他键与原映射相同。 */ PROOF extern thm finmap_insert_lookup; @@ -229,7 +229,7 @@ PROOF extern thm finmap_insert_lookup; * finmap_lookup (finmap_insert key v m) key == SOME v * ``` * - * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 + * 插入 `key -> v` 后立即查找 `key` 必得 `SOME v`。 */ PROOF extern thm finmap_insert_lookup_eq; @@ -244,7 +244,7 @@ PROOF extern thm finmap_insert_lookup_eq; * finmap_lookup (finmap_insert key v m) k == finmap_lookup m k * ``` * - * 中文说明：说明有限映射插入操作对查找、定义域或结构的影响。 + * 当 `k` 不等于插入键 `key` 时，插入前后在 `k` 处的查找结果不变。 */ PROOF extern thm finmap_insert_lookup_ne; @@ -255,7 +255,7 @@ PROOF extern thm finmap_insert_lookup_ne; * {k:K | ~(f k == NONE)} DELETE key * ``` * - * 中文说明：说明有限映射删除操作对查找、定义域或结构的影响。 + * 将 `key` 设为 `NONE` 后，函数的非 `NONE` 支撑集等于原支撑集删去 `key`。 */ PROOF extern thm finmap_delete_support; @@ -266,7 +266,7 @@ PROOF extern thm finmap_delete_support; * (\k:K. if k == key then NONE else finmap_rep m k) * ``` * - * 中文说明：说明有限映射删除操作对查找、定义域或结构的影响。 + * 删除后的表示函数在 `key` 处取 `NONE`，其他键沿用 `m` 的表示。 */ PROOF extern thm finmap_delete_rep; @@ -277,7 +277,7 @@ PROOF extern thm finmap_delete_rep; * if k == key then NONE else finmap_lookup m k * ``` * - * 中文说明：说明有限映射删除操作对查找、定义域或结构的影响。 + * 删除 `key` 后，查找 `key` 返回 `NONE`，查找其他键与原映射相同。 */ PROOF extern thm finmap_delete_lookup; @@ -287,7 +287,7 @@ PROOF extern thm finmap_delete_lookup; * finmap_lookup (finmap_delete key m) key == NONE * ``` * - * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 + * 删除 `key` 后立即查找该键必得 `NONE`。 */ PROOF extern thm finmap_delete_lookup_eq; @@ -298,7 +298,7 @@ PROOF extern thm finmap_delete_lookup_eq; * finmap_lookup (finmap_delete key m) k == finmap_lookup m k * ``` * - * 中文说明：说明有限映射删除操作对查找、定义域或结构的影响。 + * 当 `k` 不等于被删键 `key` 时，删除前后在 `k` 处的查找结果不变。 */ PROOF extern thm finmap_delete_lookup_ne; @@ -309,7 +309,7 @@ PROOF extern thm finmap_delete_lookup_ne; * forall k:K. finmap_lookup m k == finmap_lookup n k * ``` * - * 中文说明：给出有限映射按键查找或外延相等的规则。 + * 两个有限映射相等，当且仅当它们在每个键上的查找结果都相等。 */ PROOF extern thm finmap_eq_lookup; @@ -324,7 +324,7 @@ PROOF extern thm finmap_eq_lookup; * finmap_singleton key v * ``` * - * 中文说明：说明有限映射插入操作对查找、定义域或结构的影响。 + * 向空映射插入 `key -> v` 恰得单点映射 `finmap_singleton key v`。 */ PROOF extern thm finmap_insert_empty; @@ -334,7 +334,7 @@ PROOF extern thm finmap_insert_empty; * finmap_delete key (finmap_empty:(K,V)finmap) == finmap_empty * ``` * - * 中文说明：说明有限映射删除操作对查找、定义域或结构的影响。 + * 从空映射删除任意键仍然得到空映射。 */ PROOF extern thm finmap_delete_empty; @@ -349,7 +349,7 @@ PROOF extern thm finmap_delete_empty; * finmap_insert key v m * ``` * - * 中文说明：说明有限映射插入操作对查找、定义域或结构的影响。 + * 对同一键连续插入时，最后插入的 `v` 覆盖先前的 `w`。 */ PROOF extern thm finmap_insert_overwrite; @@ -366,7 +366,7 @@ PROOF extern thm finmap_insert_overwrite; * finmap_insert key2 v2 (finmap_insert key1 v1 m) * ``` * - * 中文说明：说明该运算满足交换律，交换两个操作数不会改变结果。 + * 对两个不同键的插入可以互换顺序。 */ PROOF extern thm finmap_insert_comm; @@ -376,7 +376,7 @@ PROOF extern thm finmap_insert_comm; * finmap_delete key (finmap_delete key m) == finmap_delete key m * ``` * - * 中文说明：说明该运算或变换是幂等的，重复应用不会产生额外变化。 + * 对同一键删除两次与删除一次的结果相同。 */ PROOF extern thm finmap_delete_idempotent; @@ -387,7 +387,7 @@ PROOF extern thm finmap_delete_idempotent; * finmap_delete key2 (finmap_delete key1 m) * ``` * - * 中文说明：说明该运算满足交换律，交换两个操作数不会改变结果。 + * 删除两个键的顺序不影响最终映射。 */ PROOF extern thm finmap_delete_comm; @@ -397,7 +397,7 @@ PROOF extern thm finmap_delete_comm; * finmap_delete key (finmap_insert key v m) == finmap_delete key m * ``` * - * 中文说明：说明有限映射删除操作对查找、定义域或结构的影响。 + * 在 `key` 处插入后再删除该键，结果等于直接从原映射删除 `key`。 */ PROOF extern thm finmap_delete_insert; @@ -415,7 +415,7 @@ PROOF extern thm finmap_delete_insert; * finmap_insert inserted v (finmap_delete deleted m) * ``` * - * 中文说明：说明有限映射删除操作对查找、定义域或结构的影响。 + * 删除键与在另一不同键上插入可以互换顺序。 */ PROOF extern thm finmap_delete_insert_ne; @@ -426,7 +426,7 @@ PROOF extern thm finmap_delete_insert_ne; * finmap_insert key v m * ``` * - * 中文说明：说明有限映射插入操作对查找、定义域或结构的影响。 + * 先删除 `key` 再插入 `key -> v`，结果等于直接覆盖该键。 */ PROOF extern thm finmap_insert_delete; @@ -437,7 +437,7 @@ PROOF extern thm finmap_insert_delete; * finmap_insert key v m == m * ``` * - * 中文说明：说明有限映射插入操作对查找、定义域或结构的影响。 + * 若 `m` 在 `key` 处已是 `SOME v`，再插入同一键值不改变 `m`。 */ PROOF extern thm finmap_insert_id; @@ -448,7 +448,7 @@ PROOF extern thm finmap_insert_id; * finmap_delete key m == m * ``` * - * 中文说明：说明有限映射删除操作对查找、定义域或结构的影响。 + * 若 `key` 本就不在 `m` 中，删除它不改变 `m`。 */ PROOF extern thm finmap_delete_id; @@ -459,7 +459,7 @@ PROOF extern thm finmap_delete_id; * finmap_insert key v (finmap_delete key m) == m * ``` * - * 中文说明：说明有限映射可以按指定键拆分或重组。 + * 若 `m` 在 `key` 处的值为 `v`，则删除该键后再插回 `v` 可恢复 `m`。 */ PROOF extern thm finmap_decompose; @@ -472,7 +472,7 @@ PROOF extern thm finmap_decompose; * forall m:(K,V)finmap. FINITE (finmap_dom m) * ``` * - * 中文说明：刻画有限映射定义域与键是否存在之间的关系。 + * 每个有限映射的定义域都是有限集。 */ PROOF extern thm finmap_dom_finite; @@ -481,7 +481,7 @@ PROOF extern thm finmap_dom_finite; * finmap_dom (finmap_empty:(K,V)finmap) == {} * ``` * - * 中文说明：刻画有限映射定义域与键是否存在之间的关系。 + * 空映射的定义域是空集。 */ PROOF extern thm finmap_dom_empty; @@ -491,7 +491,7 @@ PROOF extern thm finmap_dom_empty; * finmap_dom (finmap_singleton key v) == {key} * ``` * - * 中文说明：刻画有限映射定义域与键是否存在之间的关系。 + * 单点映射 `key -> v` 的定义域恰为 `{key}`。 */ PROOF extern thm finmap_dom_singleton; @@ -501,7 +501,7 @@ PROOF extern thm finmap_dom_singleton; * key IN finmap_dom m <=> ~(finmap_lookup m key == NONE) * ``` * - * 中文说明：刻画有限映射定义域与键是否存在之间的关系。 + * `key` 属于 `m` 的定义域，当且仅当在该键上的查找结果不为 `NONE`。 */ PROOF extern thm finmap_in_dom; @@ -512,7 +512,7 @@ PROOF extern thm finmap_in_dom; * exists v:V. finmap_lookup m key == SOME v * ``` * - * 中文说明：刻画有限映射定义域与键是否存在之间的关系。 + * `key` 属于 `m` 的定义域，当且仅当存在 `v` 使查找结果为 `SOME v`。 */ PROOF extern thm finmap_in_dom_some; @@ -522,7 +522,7 @@ PROOF extern thm finmap_in_dom_some; * ~(key IN finmap_dom m) <=> finmap_lookup m key == NONE * ``` * - * 中文说明：刻画有限映射定义域与键是否存在之间的关系。 + * `key` 不在 `m` 的定义域中，当且仅当在该键上查找得到 `NONE`。 */ PROOF extern thm finmap_not_in_dom; @@ -537,7 +537,7 @@ PROOF extern thm finmap_not_in_dom; * finmap_lookup m key == NONE * ``` * - * 中文说明：说明可从候选集合中选择不在有限映射中的新键。 + * 若候选键集无限，则其中必有一个键在有限映射 `m` 中缺失。 */ PROOF extern thm finmap_fresh_in; @@ -556,7 +556,7 @@ PROOF extern thm finmap_fresh_in; * finmap_lookup n key == NONE * ``` * - * 中文说明：说明可从候选集合中选择不在有限映射中的新键。 + * 若候选键集无限，则其中必有一个键同时在有限映射 `m` 和 `n` 中缺失。 */ PROOF extern thm finmap_fresh_in_pair; @@ -570,7 +570,7 @@ PROOF extern thm finmap_fresh_in_pair; * finmap_lookup m key == NONE * ``` * - * 中文说明：说明可从候选集合中选择不在有限映射中的新键。 + * 若键类型无限，则每个有限映射都有一个查找为 `NONE` 的新键。 */ PROOF extern thm finmap_fresh; @@ -587,7 +587,7 @@ PROOF extern thm finmap_fresh; * finmap_lookup n key == NONE * ``` * - * 中文说明：说明可从候选集合中选择不在有限映射中的新键。 + * 若键类型无限，则任意两个有限映射都共享一个查找为 `NONE` 的新键。 */ PROOF extern thm finmap_fresh_pair; @@ -597,7 +597,7 @@ PROOF extern thm finmap_fresh_pair; * finmap_dom m == {} <=> m == finmap_empty * ``` * - * 中文说明：刻画有限映射定义域与键是否存在之间的关系。 + * 有限映射的定义域为空，当且仅当该映射是空映射。 */ PROOF extern thm finmap_dom_eq_empty; @@ -608,7 +608,7 @@ PROOF extern thm finmap_dom_eq_empty; * key INSERT finmap_dom m * ``` * - * 中文说明：刻画有限映射定义域与键是否存在之间的关系。 + * 插入 `key -> v` 会将 `key` 加入原映射的定义域。 */ PROOF extern thm finmap_dom_insert; @@ -618,7 +618,7 @@ PROOF extern thm finmap_dom_insert; * finmap_dom (finmap_delete key m) == finmap_dom m DELETE key * ``` * - * 中文说明：刻画有限映射定义域与键是否存在之间的关系。 + * 删除 `key` 会从原映射的定义域中去掉该键。 */ PROOF extern thm finmap_dom_delete; @@ -642,6 +642,6 @@ PROOF extern thm finmap_dom_delete; * forall m:(K,V)finmap. P m * ``` * - * 中文说明：给出有限映射的结构归纳原则。 + * 要证明性质 `P` 对所有有限映射成立，只需证明空映射情形和在新键上插入的归纳步。 */ PROOF extern thm finmap_induct; diff --git a/theory/logic/frac_ra.h b/theory/logic/frac_ra.h index fdaa204..65cf067 100644 --- a/theory/logic/frac_ra.h +++ b/theory/logic/frac_ra.h @@ -20,7 +20,7 @@ * forall R. ra_unit (frac_ra R) == frac_empty * ``` * - * 中文说明：说明分数所有权的组合、有效性或更新性质。 + * 分数 RA 的 unit 是不持有份额或 payload 的 `frac_empty`。 */ PROOF extern thm frac_ra_unit; @@ -29,7 +29,7 @@ PROOF extern thm frac_ra_unit; * forall a. frac_full a == frac_own (&1) a * ``` * - * 中文说明：说明分数所有权的组合、有效性或更新性质。 + * payload `a` 的完整所有权 `frac_full a` 就是份额为 `1` 的 `frac_own`。 */ PROOF extern thm frac_ra_full; @@ -42,7 +42,7 @@ PROOF extern thm frac_ra_full; * frac_own (p + q) (ra_op R a b) * ``` * - * 中文说明：说明精确所有权如何反映 RA 的单位元、运算或有效性。 + * 对正份额 `p` 和 `q`，两个 `frac_own` 组合时份额相加，payload 则在底层 `R` 中组合。 */ PROOF extern thm frac_ra_own_op; @@ -57,7 +57,7 @@ PROOF extern thm frac_ra_own_op; * ==> (ra_valid (frac_ra R) (frac_own p a) <=> p <= &1 && ra_valid R a) * ``` * - * 中文说明：说明该资源或构造满足相应的有效性条件。 + * 对正份额 `p`，`frac_own p a` 有效，当且仅当 `p <= 1` 且 payload `a` 在底层 `R` 中有效。 */ PROOF extern thm frac_ra_valid_own; @@ -66,7 +66,7 @@ PROOF extern thm frac_ra_valid_own; * forall R a. ra_valid R a ==> ra_maximal (frac_ra R) (frac_full a) * ``` * - * 中文说明：说明 frame-maximal 资源只能与单位 frame 兼容。 + * 当 payload `a` 有效时，份额已达 `1` 的 `frac_full a` 为 maximal，不能再兼容非空份额。 */ PROOF extern thm frac_ra_maximal_full; @@ -83,7 +83,7 @@ PROOF extern thm frac_ra_maximal_full; * ==> ra_update (frac_ra R) (frac_own p a) (frac_own q b) * ``` * - * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 + * 若 `a -> b` 在底层 `R` 中成立，则可把份额 `p` 的 `a` 更新为份额不超过 `p` 的正份额 `q` 和 payload `b`。 */ PROOF extern thm frac_ra_update_weaken; @@ -97,7 +97,7 @@ PROOF extern thm frac_ra_update_weaken; * (\x. exists b. P b && x == frac_own q b) * ``` * - * 中文说明：说明谓词更新允许选择任意满足目标谓词的新资源。 + * 若 `a` 在底层 `R` 中可更新到 `P`，则可将份额 `p` 弱化为不超过它的正份额 `q`，并选择满足 `P` 的目标 payload。 */ PROOF extern thm frac_ra_updateP_weaken; @@ -108,6 +108,6 @@ PROOF extern thm frac_ra_updateP_weaken; * ra_valid R a ==> ra_valid R b * ``` * - * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 + * `frac_full a` 可更新为 `frac_full b`，当且仅当 `ra_valid R a ==> ra_valid R b`；源无效时条件真空成立。 */ PROOF extern thm frac_ra_update_full_iff; diff --git a/theory/logic/gmap_ra.h b/theory/logic/gmap_ra.h index 63015b8..90f345f 100644 --- a/theory/logic/gmap_ra.h +++ b/theory/logic/gmap_ra.h @@ -23,7 +23,7 @@ * ra_unit (gmap_ra R) == (finmap_empty:(K,V)finmap) * ``` * - * 中文说明：说明 gmap 的运算和有效性按键逐点提升自 payload RA。 + * `gmap_ra R` 的 unit 是不含任何键的空映射。 */ PROOF extern thm gmap_ra_unit; @@ -41,7 +41,7 @@ PROOF extern thm gmap_ra_unit; * (finmap_lookup n k) * ``` * - * 中文说明：说明 gmap 的运算和有效性按键逐点提升自 payload RA。 + * 两个 gmap 组合后在键 `k` 处的值，是两边查找结果在 `option_ra R` 中的组合。 */ PROOF extern thm gmap_ra_op_lookup; @@ -53,7 +53,7 @@ PROOF extern thm gmap_ra_op_lookup; * ra_valid (option_ra R) (finmap_lookup m k) * ``` * - * 中文说明：说明 gmap 的运算和有效性按键逐点提升自 payload RA。 + * gmap `m` 有效，当且仅当每个键的查找结果在 `option_ra R` 中都有效。 */ PROOF extern thm gmap_ra_valid; @@ -64,7 +64,7 @@ PROOF extern thm gmap_ra_valid; * ra_valid R a * ``` * - * 中文说明：说明 gmap 的运算和有效性按键逐点提升自 payload RA。 + * 单点 gmap `key -> a` 有效，当且仅当 payload `a` 在 `R` 中有效。 */ PROOF extern thm gmap_ra_valid_singleton; @@ -80,7 +80,7 @@ PROOF extern thm gmap_ra_valid_singleton; * ra_valid R a * ``` * - * 中文说明：说明 gmap 的运算和有效性按键逐点提升自 payload RA。 + * 若 gmap `m` 有效且在 `key` 处存有 `a`，则 payload `a` 在 `R` 中有效。 */ PROOF extern thm gmap_ra_valid_lookup; @@ -102,7 +102,7 @@ PROOF extern thm gmap_ra_valid_lookup; * (finmap_lookup n k) * ``` * - * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 + * gmap `m` 包含于 `n`，当且仅当每个键上 `m` 的查找结果都在 `option_ra R` 中包含于 `n` 的结果。 */ PROOF extern thm gmap_ra_included_lookup_iff; @@ -116,7 +116,7 @@ PROOF extern thm gmap_ra_included_lookup_iff; * finmap_dom m SUBSET finmap_dom n * ``` * - * 中文说明：刻画 gmap 的包含、查找或按键分解性质。 + * 若 gmap `m` 包含于 `n`，则 `m` 中出现的每个键也出现在 `n` 中。 */ PROOF extern thm gmap_ra_included_dom; @@ -135,7 +135,7 @@ PROOF extern thm gmap_ra_included_dom; * (finmap_delete key m) * ``` * - * 中文说明：刻画 gmap 的包含、查找或按键分解性质。 + * 若 `m` 在 `key` 处存有 `a`，则 `m` 可分解为单点资源 `key -> a` 与删去该键后余部的 RA 组合。 */ PROOF extern thm gmap_ra_decompose; @@ -161,7 +161,7 @@ PROOF extern thm gmap_ra_decompose; * (finmap_singleton key g) * ``` * - * 中文说明：说明 gmap 可在指定键处提升局部更新或谓词更新。 + * 若 `m[key] = a` 且 `(a,f) -> (b,g)` 是 payload 局部更新，则 whole map `m` 与单点片段 `key -> f` 可局部更新为插入 `key -> b` 的 map 与单点 `key -> g`。 */ PROOF extern thm gmap_ra_local_update_at; @@ -178,7 +178,7 @@ PROOF extern thm gmap_ra_local_update_at; * ra_update (gmap_ra R) m (finmap_insert key b m) * ``` * - * 中文说明：说明 gmap 可在指定键处提升局部更新或谓词更新。 + * 若 `m[key] = a` 且 `a` 可更新为 `b`，则 gmap `m` 可更新为在 `key` 处插入 `b` 的映射。 */ PROOF extern thm gmap_ra_update_at; @@ -200,7 +200,7 @@ PROOF extern thm gmap_ra_update_at; * P b && result == finmap_insert key b m) * ``` * - * 中文说明：说明 gmap 可在指定键处提升局部更新或谓词更新。 + * 若 `m[key] = a` 且 `a` 可更新到满足 `P` 的 payload，则 `m` 可更新到在 `key` 处插入某个满足 `P` 的 `b` 所得的映射。 */ PROOF extern thm gmap_ra_updateP_at; @@ -210,7 +210,7 @@ PROOF extern thm gmap_ra_updateP_at; * ra_update (gmap_ra R) m (finmap_delete key m) * ``` * - * 中文说明：说明 gmap 在指定键处删除当前片段。 + * 任意 gmap 片段 `m` 都可更新为 `finmap_delete key m`；这只删除当前片段在 `key` 处的资源，兼容 frame 保持不变。 */ PROOF extern thm gmap_ra_drop_at; @@ -240,7 +240,7 @@ PROOF extern thm gmap_ra_drop_at; * result == finmap_insert key (payload key) m) * ``` * - * 中文说明：说明 gmap 可选择新键并加入有效 payload。 + * 若无限候选集中每个当前空缺键的 `payload key` 都有效，则 `m` 可更新为在其中某个空缺键上插入该 payload 的映射。 */ PROOF extern thm gmap_ra_alloc_strong_dep; @@ -258,7 +258,7 @@ PROOF extern thm gmap_ra_alloc_strong_dep; * result == finmap_insert key a m) * ``` * - * 中文说明：说明 gmap 可选择新键并加入有效 payload。 + * 键类型无限且 `a` 有效时，`m` 可更新为在某个空缺键上插入 `a` 的映射。 */ PROOF extern thm gmap_ra_alloc; @@ -282,6 +282,6 @@ PROOF extern thm gmap_ra_alloc; * result == finmap_insert key a m) * ``` * - * 中文说明：说明 gmap 可选择新键并加入有效 payload。 + * 键类型无限、禁用集有限且 `a` 有效时，`m` 可在一个既空缺又不在禁用集中的键上分配 `a`。 */ PROOF extern thm gmap_ra_alloc_cofinite; diff --git a/theory/logic/gmap_ra_internal.h b/theory/logic/gmap_ra_internal.h index ae5f172..ba4e015 100644 --- a/theory/logic/gmap_ra_internal.h +++ b/theory/logic/gmap_ra_internal.h @@ -17,7 +17,7 @@ * finmap_singleton key (ra_op R a b) * ``` * - * 中文说明：刻画 gmap 的包含、查找或按键分解性质。 + * 同一键上两个单点 gmap 的 RA 组合，等于在该键上放置 payload 组合 `a ⋅ b` 的单点 gmap。 */ PROOF extern thm gmap_ra_singleton_op; @@ -33,7 +33,7 @@ PROOF extern thm gmap_ra_singleton_op; * finmap_insert key a m * ``` * - * 中文说明：刻画 gmap 的包含、查找或按键分解性质。 + * 若 `key` 在 `m` 中空缺，则单点资源 `key -> a` 与 `m` 组合恰等于向 `m` 插入该键值。 */ PROOF extern thm gmap_ra_singleton_op_fresh; @@ -47,7 +47,7 @@ PROOF extern thm gmap_ra_singleton_op_fresh; * (finmap_singleton key b) * ``` * - * 中文说明：说明 gmap 可在指定键处提升局部更新或谓词更新。 + * payload `a` 可更新为 `b` 时，单点 gmap `key -> a` 也可更新为 `key -> b`。 */ PROOF extern thm gmap_ra_update_singleton; @@ -63,7 +63,7 @@ PROOF extern thm gmap_ra_update_singleton; * P b && m == finmap_singleton key b) * ``` * - * 中文说明：说明 gmap 可在指定键处提升局部更新或谓词更新。 + * payload `a` 可更新到满足 `P` 的值时，单点 gmap `key -> a` 可更新到以同一键承载某个满足 `P` 的 `b`。 */ PROOF extern thm gmap_ra_updateP_singleton; @@ -86,6 +86,6 @@ PROOF extern thm gmap_ra_updateP_singleton; * result == finmap_insert key a m) * ``` * - * 中文说明：说明 gmap 可选择新键并加入有效 payload。 + * 候选键集无限且 `a` 有效时，`m` 可更新为在某个候选空缺键上插入 `a` 的映射。 */ PROOF extern thm gmap_ra_alloc_strong; diff --git a/theory/logic/local_update.h b/theory/logic/local_update.h index 298c4ea..d6e9e33 100644 --- a/theory/logic/local_update.h +++ b/theory/logic/local_update.h @@ -23,7 +23,7 @@ * ==> ra_valid R b && b == ra_op R g residual) * ``` * - * 中文说明：说明局部更新在保留同一 residual 的同时替换可见片段。 + * `(a,f)` 可局部更新为 `(b,g)`，当且仅当每种将有效 `a` 分解为 `f ⋅ residual` 的方式都能保留该 residual，并得到有效的 `b = g ⋅ residual`。 */ PROOF extern thm ra_local_update_def; @@ -36,7 +36,7 @@ PROOF extern thm ra_local_update_def; * ==> ra_valid R b && b == ra_op R g residual * ``` * - * 中文说明：说明局部更新在保留外部 residual 时替换内部片段。 + * 若局部更新 `(a,f) -> (b,g)` 成立，且有效的 `a` 等于 `f ⋅ residual`，则 `b` 有效且等于 `g ⋅ residual`。 */ PROOF extern thm ra_local_update_apply; @@ -49,7 +49,7 @@ PROOF extern thm ra_local_update_apply; * forall R a f. ra_local_update R a f a f * ``` * - * 中文说明：说明该关系具有自反性。 + * 任意 whole/local 对 `(a,f)` 都可保持不变地局部更新为自身。 */ PROOF extern thm ra_local_update_refl; @@ -61,7 +61,7 @@ PROOF extern thm ra_local_update_refl; * ==> ra_local_update R a f c h * ``` * - * 中文说明：说明该关系或变换可以传递地串联。 + * 局部更新可传递：`(a,f) -> (b,g)` 与 `(b,g) -> (c,h)` 可串联为 `(a,f) -> (c,h)`。 */ PROOF extern thm ra_local_update_trans; @@ -72,7 +72,7 @@ PROOF extern thm ra_local_update_trans; * ==> ra_local_update R a (ra_op R f extra) b (ra_op R g extra) * ``` * - * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 + * 对局部更新 `(a,f) -> (b,g)`，在新旧可见片段上同时附加 `extra` 后仍是局部更新。 */ PROOF extern thm ra_local_update_frame; @@ -85,7 +85,7 @@ PROOF extern thm ra_local_update_frame; * ==> ra_valid R b && ra_included R (ra_op R g external) b * ``` * - * 中文说明：说明局部更新在保留外部 residual 时替换内部片段。 + * 若 `(a,f) -> (b,g)` 是局部更新、`a` 有效且包含 `f ⋅ external`，则 `b` 有效且包含 `g ⋅ external`。 */ PROOF extern thm ra_local_update_preserves_included; @@ -100,7 +100,7 @@ PROOF extern thm ra_local_update_preserves_included; * ==> ra_local_update R a f (ra_op R a piece) (ra_op R f piece) * ``` * - * 中文说明：说明局部更新在保留外部 residual 时替换内部片段。 + * 若 `a ⋅ piece` 有效，则可将 whole 从 `a` 扩展为 `a ⋅ piece`，并在 local 片段 `f` 上同步分配 `piece`。 */ PROOF extern thm ra_local_update_alloc; @@ -109,7 +109,7 @@ PROOF extern thm ra_local_update_alloc; * forall R a f b. ra_maximal R f ==> ra_valid R b ==> ra_local_update R a f b b * ``` * - * 中文说明：说明局部更新在保留外部 residual 时替换内部片段。 + * 若可见片段 `f` 为 maximal 且 `b` 有效，则 whole/local 对 `(a,f)` 可局部更新为 `(b,b)`。 */ PROOF extern thm ra_local_update_maximal; @@ -120,7 +120,7 @@ PROOF extern thm ra_local_update_maximal; * ==> ra_local_update R (ra_op R common a) (ra_op R common f) a f * ``` * - * 中文说明：说明局部更新在保留外部 residual 时替换内部片段。 + * 在可消去 RA 中，可从 whole 和 local 片段中同时消去公共分量 `common`，将 `(common ⋅ a, common ⋅ f)` 更新为 `(a,f)`。 */ PROOF extern thm ra_local_update_cancel; @@ -132,6 +132,6 @@ PROOF extern thm ra_local_update_cancel; * ==> ra_local_update R (ra_op R a common) a (ra_op R b common) b * ``` * - * 中文说明：说明局部更新在保留外部 residual 时替换内部片段。 + * 在可消去 RA 中，若 `b ⋅ common` 有效，则可保留隐含的 `common` 并将 whole/local 对从 `(a ⋅ common,a)` 更新为 `(b ⋅ common,b)`。 */ PROOF extern thm ra_local_update_cancellative; diff --git a/theory/logic/max_nat_ra.h b/theory/logic/max_nat_ra.h index 4a2723d..b72a098 100644 --- a/theory/logic/max_nat_ra.h +++ b/theory/logic/max_nat_ra.h @@ -20,7 +20,7 @@ * ra_unit max_nat_ra == 0 * ``` * - * 中文说明：说明 max-nat RA 的最大值运算及其包含、更新性质。 + * max-nat RA 的 unit 是自然数 `0`。 */ PROOF extern thm max_nat_ra_unit; @@ -29,7 +29,7 @@ PROOF extern thm max_nat_ra_unit; * forall a b. ra_op max_nat_ra a b == MAX a b * ``` * - * 中文说明：说明 max-nat RA 的最大值运算及其包含、更新性质。 + * max-nat RA 中两个数的组合结果是它们的最大值。 */ PROOF extern thm max_nat_ra_op; @@ -38,7 +38,7 @@ PROOF extern thm max_nat_ra_op; * forall n. ra_valid max_nat_ra n * ``` * - * 中文说明：说明该资源或构造满足相应的有效性条件。 + * 每个自然数在 max-nat RA 中都有效。 */ PROOF extern thm max_nat_ra_valid; @@ -47,7 +47,7 @@ PROOF extern thm max_nat_ra_valid; * forall a b. ra_included max_nat_ra a b <=> a <= b * ``` * - * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 + * `a` 在 max-nat RA 中包含于 `b`，当且仅当数值上 `a <= b`。 */ PROOF extern thm max_nat_ra_included; @@ -56,7 +56,7 @@ PROOF extern thm max_nat_ra_included; * forall n. ra_op max_nat_ra n n == n * ``` * - * 中文说明：说明该运算或变换是幂等的，重复应用不会产生额外变化。 + * 任意自然数 `n` 与自身取最大值仍等于 `n`。 */ PROOF extern thm max_nat_ra_idempotent; @@ -69,6 +69,6 @@ PROOF extern thm max_nat_ra_idempotent; * forall old new. ra_update max_nat_ra old new * ``` * - * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 + * max-nat RA 中所有数及其与任意 frame 的组合都有效，因此任意 `old` 都可更新为任意 `new`。 */ PROOF extern thm max_nat_ra_update; diff --git a/theory/logic/named_logic.h b/theory/logic/named_logic.h index a99711e..44e961d 100644 --- a/theory/logic/named_logic.h +++ b/theory/logic/named_logic.h @@ -13,7 +13,7 @@ * R) (finmap_singleton name a) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `named_own R name a` 精确拥有仅在 `name` 处存放 `a` 的单点有限映射。 */ PROOF extern thm named_own_def; /** @@ -25,7 +25,7 @@ PROOF extern thm named_own_def; * name b)) * ``` * - * 中文说明：说明命名所有权在固定名字下的组合、有效性或更新规则。 + * 同一名字下 `a ⋅ b` 的所有权与该名字下 `a`、`b` 所有权的分离合取在 `r_equiv` 下等价。 */ PROOF extern thm named_own_op; /** @@ -37,7 +37,7 @@ PROOF extern thm named_own_op; * name a)) * ``` * - * 中文说明：说明命名所有权在固定名字下的组合、有效性或更新规则。 + * 从名字 `name` 下 `a` 的所有权可分离导出 exact-unit 的 `ra_valid R a` fact，同时保留该所有权。 */ PROOF extern thm named_own_valid; /** @@ -48,7 +48,7 @@ PROOF extern thm named_own_valid; * (named_ra R) (named_own R name a) (named_own R name b) * ``` * - * 中文说明：说明命名所有权在固定名字下的组合、有效性或更新规则。 + * 底层确定性更新 `a ↝ b` 可在固定名字 `name` 处把 `own(a)` 更新为 `own(b)`。 */ PROOF extern thm named_own_update; /** @@ -60,7 +60,7 @@ PROOF extern thm named_own_update; * r_sep (named_ra R) (r_fact (named_ra R) (P b)) (named_own R name b))) * ``` * - * 中文说明：说明命名所有权在固定名字下的组合、有效性或更新规则。 + * 底层谓词更新在固定名字处选择目标 `b`，并返回 exact-unit 的 `P(b)` fact 和 `b` 的命名所有权。 */ PROOF extern thm named_own_updateP; /** @@ -71,7 +71,7 @@ PROOF extern thm named_own_updateP; * name a) (r_emp (named_ra R)) * ``` * - * 中文说明：说明 drop 只丢弃当前 singleton 片段，并不声称全局不存在同名资源。 + * 单点命名所有权可更新为 `emp`，只丢弃当前 singleton 片段，并不声称全局不存在同名资源。 */ PROOF extern thm named_own_drop; /** @@ -83,6 +83,6 @@ PROOF extern thm named_own_drop; * (named_own R name a) P)) * ``` * - * 中文说明：说明可在保留原 frame 的同时分配一个新名字及其所有权。 + * `a` 有效时，可在保留原断言 `P` 的同时分配一个新名字并取得该名字下 `a` 的所有权。 */ PROOF extern thm named_own_alloc; diff --git a/theory/logic/named_ra.h b/theory/logic/named_ra.h index 633ecb2..89b555c 100644 --- a/theory/logic/named_ra.h +++ b/theory/logic/named_ra.h @@ -19,7 +19,7 @@ * named_ra (R:(A)ra) == (gmap_ra R:((num,A)finmap)ra) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `named_ra R` 就是以自然数为键、以 `R` 中资源为 payload 的 gmap RA。 */ PROOF extern thm named_ra_def; @@ -29,7 +29,7 @@ PROOF extern thm named_ra_def; * ra_unit (named_ra R) == (finmap_empty:(num,A)finmap) * ``` * - * 中文说明：说明命名 RA 将底层 payload 规则提升到固定名字。 + * `named_ra R` 的 unit 是不含任何名字的空映射。 */ PROOF extern thm named_ra_unit; @@ -43,7 +43,7 @@ PROOF extern thm named_ra_unit; * finmap_singleton name (ra_op R a b) * ``` * - * 中文说明：说明命名 RA 将底层 payload 规则提升到固定名字。 + * 同一名字下两个单点资源的组合，等于在该名字下放置 `ra_op R a b` 的单点资源。 */ PROOF extern thm named_ra_singleton_op; @@ -54,7 +54,7 @@ PROOF extern thm named_ra_singleton_op; * ra_valid R a * ``` * - * 中文说明：说明命名 RA 将底层 payload 规则提升到固定名字。 + * 名字 `name` 下的单点资源有效，当且仅当 payload `a` 在 `R` 中有效。 */ PROOF extern thm named_ra_valid_singleton; @@ -72,7 +72,7 @@ PROOF extern thm named_ra_valid_singleton; * (finmap_singleton name b) * ``` * - * 中文说明：说明命名 RA 将底层 payload 规则提升到固定名字。 + * payload `a` 可更新为 `b` 时，名字 `name` 下的单点资源也可保持名字不变地更新为 `b`。 */ PROOF extern thm named_ra_update_singleton; @@ -87,7 +87,7 @@ PROOF extern thm named_ra_update_singleton; * exists b:A. P b && m == finmap_singleton name b) * ``` * - * 中文说明：说明命名 RA 将底层 payload 规则提升到固定名字。 + * payload `a` 可更新到满足 `P` 的值时，名字 `name` 下的单点资源可更新到以同一名字承载某个满足 `P` 的 `b`。 */ PROOF extern thm named_ra_updateP_singleton; @@ -104,7 +104,7 @@ PROOF extern thm named_ra_updateP_singleton; * (finmap_empty:(num,A)finmap) * ``` * - * 中文说明：说明固定名字下的 singleton 片段可更新为命名 RA 的单位元。 + * 名字 `name` 下的 singleton 可更新为空映射；只删除当前片段，兼容 frame 保持不变且仍可能含同名资源。 */ PROOF extern thm named_ra_drop; @@ -121,6 +121,6 @@ PROOF extern thm named_ra_drop; * result == finmap_insert name a m) * ``` * - * 中文说明：说明可选择一个新名字并向命名 RA 中插入有效 payload。 + * payload `a` 有效时，`m` 可更新到在某个对 `m` 空缺的自然数名字下插入 `a` 的结果；名字可按兼容 frame 选择。 */ PROOF extern thm named_ra_alloc; diff --git a/theory/logic/option_ra.h b/theory/logic/option_ra.h index 6f45169..134f97e 100644 --- a/theory/logic/option_ra.h +++ b/theory/logic/option_ra.h @@ -19,7 +19,7 @@ * forall R. ra_unit (option_ra R) == NONE * ``` * - * 中文说明：说明 option RA 如何处理 NONE、SOME 及底层 payload。 + * `option_ra R` 把缺失值 `NONE` 作为新的 RA unit。 */ PROOF extern thm option_ra_unit; @@ -28,7 +28,7 @@ PROOF extern thm option_ra_unit; * forall R x. ra_op (option_ra R) NONE x == x * ``` * - * 中文说明：说明 option RA 如何处理 NONE、SOME 及底层 payload。 + * `NONE` 从左侧与任意 option 资源 `x` 组合都保持 `x` 不变。 */ PROOF extern thm option_ra_op_none_l; @@ -37,7 +37,7 @@ PROOF extern thm option_ra_op_none_l; * forall R a b. ra_op (option_ra R) (SOME a) (SOME b) == SOME (ra_op R a b) * ``` * - * 中文说明：说明 option RA 如何处理 NONE、SOME 及底层 payload。 + * 两个存在的 option 资源通过在底层 `R` 中组合 payload，得到 `SOME (a ⋅ b)`。 */ PROOF extern thm option_ra_op_some_some; @@ -46,7 +46,7 @@ PROOF extern thm option_ra_op_some_some; * forall R. ra_valid (option_ra R) NONE * ``` * - * 中文说明：说明该资源或构造满足相应的有效性条件。 + * 表示缺失的 `NONE` 在 option RA 中始终有效。 */ PROOF extern thm option_ra_valid_none; @@ -55,7 +55,7 @@ PROOF extern thm option_ra_valid_none; * forall R a. ra_valid (option_ra R) (SOME a) <=> ra_valid R a * ``` * - * 中文说明：说明该资源或构造满足相应的有效性条件。 + * `SOME a` 在 option RA 中有效，当且仅当 payload `a` 在底层 `R` 中有效。 */ PROOF extern thm option_ra_valid_some; @@ -68,7 +68,7 @@ PROOF extern thm option_ra_valid_some; * forall R x. ra_included (option_ra R) NONE x * ``` * - * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 + * 缺失资源 `NONE` 包含于任意 option 资源。 */ PROOF extern thm option_ra_included_none; @@ -78,7 +78,7 @@ PROOF extern thm option_ra_included_none; * ra_included (option_ra R) (SOME a) (SOME b) <=> ra_included R a b * ``` * - * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 + * `SOME a` 包含于 `SOME b`，当且仅当 payload `a` 在底层 `R` 中包含于 `b`。 */ PROOF extern thm option_ra_included_some_some; @@ -87,7 +87,7 @@ PROOF extern thm option_ra_included_some_some; * forall R a. ~ra_included (option_ra R) (SOME a) NONE * ``` * - * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 + * 任何存在的资源 `SOME a` 都不包含于缺失资源 `NONE`。 */ PROOF extern thm option_ra_not_included_some_none; @@ -96,7 +96,7 @@ PROOF extern thm option_ra_not_included_some_none; * forall R. ~(SOME (ra_unit R) == NONE) * ``` * - * 中文说明：说明该构造得到无效资源或互斥组合。 + * 存在但 payload 为底层 unit 的 `SOME (ra_unit R)` 与表示缺失的 `NONE` 不相等。 */ PROOF extern thm option_ra_some_unit_ne_none; @@ -105,7 +105,7 @@ PROOF extern thm option_ra_some_unit_ne_none; * forall R. ~ra_cancellative (option_ra R) * ``` * - * 中文说明：说明该资源代数满足或不满足消去性质。 + * option RA 始终不可消去，因为新增的 `NONE` 与 `SOME (ra_unit R)` 是不同的 unit-like 片段。 */ PROOF extern thm option_ra_not_cancellative; @@ -120,7 +120,7 @@ PROOF extern thm option_ra_not_cancellative; * ra_updateP R a P * ``` * - * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 + * `SOME a` 在 option RA 中更新到承载某个满足 `P` 的 payload，当且仅当 `a` 在底层 `R` 中可更新到 `P`。 */ PROOF extern thm option_ra_updateP_iff; @@ -129,7 +129,7 @@ PROOF extern thm option_ra_updateP_iff; * forall R a b. ra_update (option_ra R) (SOME a) (SOME b) <=> ra_update R a b * ``` * - * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 + * `SOME a -> SOME b` 在 option RA 中成立，当且仅当 `a -> b` 在底层 `R` 中成立。 */ PROOF extern thm option_ra_update_iff; @@ -140,6 +140,6 @@ PROOF extern thm option_ra_update_iff; * ra_local_update R a f b g * ``` * - * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 + * option RA 中存在值之间的局部更新，当且仅当对应 payload 之间的底层局部更新成立。 */ PROOF extern thm option_ra_local_update_iff; diff --git a/theory/logic/option_ra_internal.h b/theory/logic/option_ra_internal.h index 59263d6..264747c 100644 --- a/theory/logic/option_ra_internal.h +++ b/theory/logic/option_ra_internal.h @@ -12,7 +12,7 @@ * forall R x. ra_op (option_ra R) x NONE == x * ``` * - * 中文说明：说明 option RA 如何处理 NONE、SOME 及底层 payload。 + * `NONE` 从右侧与任意 option 资源 `x` 组合都保持 `x` 不变。 */ PROOF extern thm option_ra_op_none_r; @@ -21,7 +21,7 @@ PROOF extern thm option_ra_op_none_r; * forall R a b. ra_update R a b ==> ra_update (option_ra R) (SOME a) (SOME b) * ``` * - * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 + * 底层更新 `a -> b` 可提升为 option RA 中的 `SOME a -> SOME b`。 */ PROOF extern thm option_ra_update; @@ -32,6 +32,6 @@ PROOF extern thm option_ra_update; * ==> ra_updateP (option_ra R) (SOME a) (\x. exists b. P b && x == SOME b) * ``` * - * 中文说明：说明谓词更新允许选择任意满足目标谓词的新资源。 + * `a` 在底层 `R` 中可更新到 `P` 时，`SOME a` 可更新到承载某个满足 `P` 的 payload。 */ PROOF extern thm option_ra_updateP; diff --git a/theory/logic/prod_ra.h b/theory/logic/prod_ra.h index 3eab171..9467c78 100644 --- a/theory/logic/prod_ra.h +++ b/theory/logic/prod_ra.h @@ -20,7 +20,7 @@ * forall R1 R2. ra_unit (prod_ra R1 R2) == ra_unit R1,ra_unit R2 * ``` * - * 中文说明：说明乘积 RA 的运算、投影或更新由两个分量共同决定。 + * 乘积 RA 的 unit 由两个分量 RA 的 unit 组成。 */ PROOF extern thm prod_ra_unit; @@ -31,7 +31,7 @@ PROOF extern thm prod_ra_unit; * ra_op R1 (FST x) (FST y),ra_op R2 (SND x) (SND y) * ``` * - * 中文说明：说明乘积 RA 的运算、投影或更新由两个分量共同决定。 + * 乘积 RA 中的组合逐分量进行，结果分别为两个底层 RA 的组合。 */ PROOF extern thm prod_ra_op; @@ -41,7 +41,7 @@ PROOF extern thm prod_ra_op; * ra_valid (prod_ra R1 R2) x <=> ra_valid R1 (FST x) && ra_valid R2 (SND x) * ``` * - * 中文说明：说明该资源或构造满足相应的有效性条件。 + * 乘积资源 `x` 有效，当且仅当其两个分量在各自 RA 中都有效。 */ PROOF extern thm prod_ra_valid; @@ -52,7 +52,7 @@ PROOF extern thm prod_ra_valid; * ra_included R1 (FST x) (FST y) && ra_included R2 (SND x) (SND y) * ``` * - * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 + * 乘积资源 `x` 包含于 `y`，当且仅当 `x` 的两个分量分别包含于 `y` 的对应分量。 */ PROOF extern thm prod_ra_included; @@ -63,7 +63,7 @@ PROOF extern thm prod_ra_included; * ra_cancellative R1 && ra_cancellative R2 * ``` * - * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 + * 乘积 RA 可消去，当且仅当两个分量 RA 都可消去。 */ PROOF extern thm prod_ra_cancellative_iff; @@ -74,7 +74,7 @@ PROOF extern thm prod_ra_cancellative_iff; * ra_maximal R1 (FST x) && ra_maximal R2 (SND x) * ``` * - * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 + * 乘积资源 `x` 为 maximal，当且仅当它的两个分量在各自 RA 中都为 maximal。 */ PROOF extern thm prod_ra_maximal_iff; @@ -91,7 +91,7 @@ PROOF extern thm prod_ra_maximal_iff; * (\x. exists b1 b2. P1 b1 && P2 b2 && x == b1,b2) * ``` * - * 中文说明：说明谓词更新允许选择任意满足目标谓词的新资源。 + * 若两个分量分别可更新到 `P1` 和 `P2`，则乘积资源 `(a1,a2)` 可更新到分量分别满足两个谓词的数对。 */ PROOF extern thm prod_ra_updateP; @@ -101,7 +101,7 @@ PROOF extern thm prod_ra_updateP; * ra_update R1 a1 b1 ==> ra_update (prod_ra R1 R2) (a1,a2) (b1,a2) * ``` * - * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 + * 若第一分量可从 `a1` 更新为 `b1`，则乘积中可保留第二分量 `a2` 不变地执行该更新。 */ PROOF extern thm prod_ra_update_left; @@ -111,7 +111,7 @@ PROOF extern thm prod_ra_update_left; * ra_update R2 a2 b2 ==> ra_update (prod_ra R1 R2) (a1,a2) (a1,b2) * ``` * - * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 + * 若第二分量可从 `a2` 更新为 `b2`，则乘积中可保留第一分量 `a1` 不变地执行该更新。 */ PROOF extern thm prod_ra_update_right; @@ -123,7 +123,7 @@ PROOF extern thm prod_ra_update_right; * ==> ra_local_update (prod_ra R1 R2) (a1,a2) (f1,f2) (b1,b2) (g1,g2) * ``` * - * 中文说明：说明局部更新在保留外部 residual 时替换内部片段。 + * 两个分量上的局部更新可合并为乘积 RA 中逐分量的 whole/local 更新。 */ PROOF extern thm prod_ra_local_update; @@ -136,7 +136,7 @@ PROOF extern thm prod_ra_local_update; * forall R S a. prod_inl R S a == a,ra_unit S * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `prod_inl R S a` 将 `a` 放在左分量，并将右分量固定为 `S` 的 unit。 */ PROOF extern thm prod_inl_def; @@ -145,7 +145,7 @@ PROOF extern thm prod_inl_def; * forall R S b. prod_inr R S b == ra_unit R,b * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `prod_inr R S b` 将 `b` 放在右分量，并将左分量固定为 `R` 的 unit。 */ PROOF extern thm prod_inr_def; @@ -156,7 +156,7 @@ PROOF extern thm prod_inr_def; * ra_op (prod_ra R S) (prod_inl R S a) (prod_inl R S b) * ``` * - * 中文说明：说明乘积 RA 的运算、投影或更新由两个分量共同决定。 + * 先在 `R` 中组合 `a` 与 `b` 再左嵌入，等于分别左嵌入后在乘积 RA 中组合。 */ PROOF extern thm prod_inl_op; @@ -167,7 +167,7 @@ PROOF extern thm prod_inl_op; * ra_op (prod_ra R S) (prod_inr R S a) (prod_inr R S b) * ``` * - * 中文说明：说明乘积 RA 的运算、投影或更新由两个分量共同决定。 + * 先在 `S` 中组合 `a` 与 `b` 再右嵌入，等于分别右嵌入后在乘积 RA 中组合。 */ PROOF extern thm prod_inr_op; @@ -179,7 +179,7 @@ PROOF extern thm prod_inr_op; * (\x. exists b. P b && x == prod_inl R S b) * ``` * - * 中文说明：说明谓词更新允许选择任意满足目标谓词的新资源。 + * `a` 在 `R` 中可更新到 `P` 时，其左嵌入可更新到某个左嵌入的满足 `P` 的结果。 */ PROOF extern thm prod_inl_updateP; @@ -191,7 +191,7 @@ PROOF extern thm prod_inl_updateP; * (\x. exists b. P b && x == prod_inr R S b) * ``` * - * 中文说明：说明谓词更新允许选择任意满足目标谓词的新资源。 + * `a` 在 `S` 中可更新到 `P` 时，其右嵌入可更新到某个右嵌入的满足 `P` 的结果。 */ PROOF extern thm prod_inr_updateP; @@ -202,7 +202,7 @@ PROOF extern thm prod_inr_updateP; * ==> ra_update (prod_ra R S) (prod_inl R S a) (prod_inl R S b) * ``` * - * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 + * `a -> b` 在 `R` 中成立时，左嵌入后的 `prod_inl a -> prod_inl b` 在乘积 RA 中也成立。 */ PROOF extern thm prod_inl_update; @@ -213,6 +213,6 @@ PROOF extern thm prod_inl_update; * ==> ra_update (prod_ra R S) (prod_inr R S a) (prod_inr R S b) * ``` * - * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 + * `a -> b` 在 `S` 中成立时，右嵌入后的 `prod_inr a -> prod_inr b` 在乘积 RA 中也成立。 */ PROOF extern thm prod_inr_update; diff --git a/theory/logic/prod_ra_internal.h b/theory/logic/prod_ra_internal.h index 4d2b43c..047e8ff 100644 --- a/theory/logic/prod_ra_internal.h +++ b/theory/logic/prod_ra_internal.h @@ -15,6 +15,6 @@ * ==> ra_cancellative (prod_ra R1 R2) * ``` * - * 中文说明：说明该资源代数满足或不满足消去性质。 + * 若两个分量 RA 都可消去，则它们的乘积 RA 也可消去。 */ PROOF extern thm prod_ra_cancellative; diff --git a/theory/logic/product_resource.h b/theory/logic/product_resource.h index 00d82eb..40affbe 100644 --- a/theory/logic/product_resource.h +++ b/theory/logic/product_resource.h @@ -32,7 +32,7 @@ * resource) && SND resource == ra_unit S * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 左提升在左投影上检查 `P`，并要求未使用的右投影精确等于 `S` 的单位元。 */ PROOF extern thm r_lift_left_def; /** @@ -43,7 +43,7 @@ PROOF extern thm r_lift_left_def; * == ra_unit R && Q (SND resource) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 右提升要求未使用的左投影精确等于 `R` 的单位元，并在右投影上检查 `Q`。 */ PROOF extern thm r_lift_right_def; @@ -56,7 +56,7 @@ PROOF extern thm r_lift_right_def; * R)) (r_emp (prod_ra R S)) * ``` * - * 中文说明：说明把左侧 emp 精确提升到乘积后等价于乘积 emp。 + * 将左 RA 的 `emp` 精确提升后，在乘积 RA 上与乘积 `emp` 资源等价。 */ PROOF extern thm r_lift_left_emp; /** @@ -67,7 +67,7 @@ PROOF extern thm r_lift_left_emp; * S)) (r_emp (prod_ra R S)) * ``` * - * 中文说明：说明把右侧 emp 精确提升到乘积后等价于乘积 emp。 + * 将右 RA 的 `emp` 精确提升后，在乘积 RA 上与乘积 `emp` 资源等价。 */ PROOF extern thm r_lift_right_emp; /** @@ -79,7 +79,7 @@ PROOF extern thm r_lift_right_emp; * (r_lift_left R S Q)) * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * 左侧分离合取的精确提升，等价于分别提升两个左断言后在乘积 RA 中分离合取。 */ PROOF extern thm r_lift_left_sep; /** @@ -91,7 +91,7 @@ PROOF extern thm r_lift_left_sep; * (r_lift_right R S Q)) * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * 右侧分离合取的精确提升，等价于分别提升两个右断言后在乘积 RA 中分离合取。 */ PROOF extern thm r_lift_right_sep; /** @@ -102,7 +102,7 @@ PROOF extern thm r_lift_right_sep; * r_entails (prod_ra R S) (r_lift_left R S P) (r_lift_left R S Q) * ``` * - * 中文说明：说明逻辑蕴含的组合、改写或框架规则。 + * 左 RA 上的 `P ⊢ Q` 经精确左提升后仍是乘积 RA 上的蕴含。 */ PROOF extern thm r_lift_left_entails; /** @@ -113,7 +113,7 @@ PROOF extern thm r_lift_left_entails; * r_entails (prod_ra R S) (r_lift_right R S P) (r_lift_right R S Q) * ``` * - * 中文说明：说明逻辑蕴含的组合、改写或框架规则。 + * 右 RA 上的 `P ⊢ Q` 经精确右提升后仍是乘积 RA 上的蕴含。 */ PROOF extern thm r_lift_right_entails; @@ -126,7 +126,7 @@ PROOF extern thm r_lift_right_entails; * ra_updateP S (SND resource) (\right':B. Q (FST resource,right')) * ``` * - * 中文说明：说明右侧 basic update 只改变产品资源的右投影。 + * 右侧 basic update 仅对 `SND resource` 执行 `S` 的谓词更新，并把原左投影原样交给后置条件。 */ PROOF extern thm r_bupd_right_def; /** @@ -137,7 +137,7 @@ PROOF extern thm r_bupd_right_def; * r_entails (prod_ra R S) P (r_bupd_right R S Q) * ``` * - * 中文说明：说明右侧 view shift 是基于右投影更新的逻辑蕴含。 + * 右侧 view shift 定义为乘积 RA 上蕴含一次只更新右投影的 basic update。 */ PROOF extern thm r_viewshift_right_def; @@ -150,7 +150,7 @@ PROOF extern thm r_viewshift_right_def; * (r_bupd_right R S P) * ``` * - * 中文说明：给出该逻辑构造的引入规则。 + * 不改变右投影的自反更新把任意 `P` 引入为右侧 basic update。 */ PROOF extern thm r_bupd_right_intro; /** @@ -162,7 +162,7 @@ PROOF extern thm r_bupd_right_intro; * (r_bupd_right R S Q) * ``` * - * 中文说明：说明该构造对蕴含或底层关系保持单调。 + * 乘积断言 `P ⊢ Q` 可提升为右侧 basic update 后的 `bupd_right P ⊢ bupd_right Q`。 */ PROOF extern thm r_bupd_right_mono; /** @@ -173,7 +173,7 @@ PROOF extern thm r_bupd_right_mono; * (r_bupd_right R S (r_bupd_right R S P)) (r_bupd_right R S P) * ``` * - * 中文说明：说明该运算或变换是幂等的，重复应用不会产生额外变化。 + * 两层连续右侧 basic update 可合并为一层，而左投影始终保持不变。 */ PROOF extern thm r_bupd_right_idem; /** @@ -185,7 +185,7 @@ PROOF extern thm r_bupd_right_idem; * R S (r_sep (prod_ra R S) P Frame)) * ``` * - * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 + * 右投影更新可携带含左右资源的任意分离框架，并把框架保留到更新后的结论中。 */ PROOF extern thm r_bupd_right_frame; @@ -197,7 +197,7 @@ PROOF extern thm r_bupd_right_frame; * forall (R:(A)ra) (S:(B)ra) (P:(A#B)->bool). r_viewshift_right R S P P * ``` * - * 中文说明：说明该关系具有自反性。 + * 任意乘积断言都可经不改变右投影的更新 view shift 到自身。 */ PROOF extern thm r_viewshift_right_refl; /** @@ -208,7 +208,7 @@ PROOF extern thm r_viewshift_right_refl; * (prod_ra R S) P Q ==> r_viewshift_right R S P Q * ``` * - * 中文说明：说明逻辑蕴含的组合、改写或框架规则。 + * 乘积 RA 上的普通蕴含可提升为只更新右投影的 view shift。 */ PROOF extern thm r_viewshift_right_entails; /** @@ -220,7 +220,7 @@ PROOF extern thm r_viewshift_right_entails; * r_viewshift_right R S P U * ``` * - * 中文说明：说明该关系或变换可以传递地串联。 + * 两个首尾相接的右侧 view shift 可合成为一次右侧 view shift。 */ PROOF extern thm r_viewshift_right_trans; /** @@ -232,7 +232,7 @@ PROOF extern thm r_viewshift_right_trans; * ==> r_entails (prod_ra R S) Q Q2 ==> r_viewshift_right R S P2 Q2 * ``` * - * 中文说明：说明该构造对蕴含或底层关系保持单调。 + * 右侧 view shift 可用 `P2 ⊢ P` 加强前件、用 `Q ⊢ Q2` 放宽后件。 */ PROOF extern thm r_viewshift_right_mono; /** @@ -244,7 +244,7 @@ PROOF extern thm r_viewshift_right_mono; * (r_sep (prod_ra R S) P Frame) (r_sep (prod_ra R S) Q Frame) * ``` * - * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 + * 右侧 view shift 可在两端加入同一分离框架，且不更新乘积的左投影。 */ PROOF extern thm r_viewshift_right_frame; /** @@ -257,7 +257,7 @@ PROOF extern thm r_viewshift_right_frame; * P1 P2) (r_sep (prod_ra R S) Q1 Q2) * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * 两个右侧 view shift 可逐分量组合为分离合取整体上的右侧 view shift。 */ PROOF extern thm r_viewshift_right_sep; /** @@ -270,7 +270,7 @@ PROOF extern thm r_viewshift_right_sep; * (prod_ra R S) guard) Q) * ``` * - * 中文说明：说明 spatial fact 的构造、消去、复制或与 sep 的关系。 + * 若 `guard` 为真时 `P` 可右移到 `Q`，则把同一精确单位元事实 `fact(guard)` 分离放在两端后仍可右移。 */ PROOF extern thm r_viewshift_right_fact; /** @@ -283,7 +283,7 @@ PROOF extern thm r_viewshift_right_fact; * (prod_ra R S) (\bound:C. Q bound)) * ``` * - * 中文说明：说明存在量词的引入、消去、单调性或与 sep 的交换。 + * 若每个见证下 `P(w)` 都可只更新右投影到 `Q(w)`，则两侧取存在量词后仍可右移。 */ PROOF extern thm r_viewshift_right_exists; @@ -297,7 +297,7 @@ PROOF extern thm r_viewshift_right_exists; * (r_own S b)) * ``` * - * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 + * 右 RA 的确定性更新 `a ↝ b` 将精确提升的 `own(a)` 右移为 `own(b)`，不触及左投影。 */ PROOF extern thm r_right_own_update; /** @@ -310,6 +310,6 @@ PROOF extern thm r_right_own_update; * (r_own S b)))) * ``` * - * 中文说明：说明右侧谓词更新返回新 witness、对应 fact 和新所有权。 + * 右 RA 的谓词更新选择目标 `b`，并分离返回 exact-unit 的 `P(b)` fact 与精确提升后的 `own(b)`；左投影不变。 */ PROOF extern thm r_right_own_updateP; diff --git a/theory/logic/product_resource_internal.h b/theory/logic/product_resource_internal.h index 1e3aa3e..c52faa6 100644 --- a/theory/logic/product_resource_internal.h +++ b/theory/logic/product_resource_internal.h @@ -19,7 +19,7 @@ * (prod_ra R S) * ``` * - * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 + * 左 RA 的 `emp` 经精确提升后与乘积 `emp` 是严格相同的 HOL 断言函数。 */ PROOF extern thm r_lift_left_emp_eq; /** @@ -30,7 +30,7 @@ PROOF extern thm r_lift_left_emp_eq; * S) * ``` * - * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 + * 右 RA 的 `emp` 经精确提升后与乘积 `emp` 是严格相同的 HOL 断言函数。 */ PROOF extern thm r_lift_right_emp_eq; /** @@ -41,7 +41,7 @@ PROOF extern thm r_lift_right_emp_eq; * P Q) == r_sep (prod_ra R S) (r_lift_left R S P) (r_lift_left R S Q) * ``` * - * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 + * 精确左提升把分离合取逐分量提升，等式两侧是原始 HOL 相等而非 `r_equiv`。 */ PROOF extern thm r_lift_left_sep_eq; /** @@ -52,6 +52,6 @@ PROOF extern thm r_lift_left_sep_eq; * S P Q) == r_sep (prod_ra R S) (r_lift_right R S P) (r_lift_right R S Q) * ``` * - * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 + * 精确右提升把分离合取逐分量提升，等式两侧是原始 HOL 相等而非 `r_equiv`。 */ PROOF extern thm r_lift_right_sep_eq; diff --git a/theory/logic/ra.h b/theory/logic/ra.h index 4d02661..ef3f14a 100644 --- a/theory/logic/ra.h +++ b/theory/logic/ra.h @@ -26,7 +26,7 @@ * ra_compatible R a b <=> ra_valid R (ra_op R a b) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 资源 `a` 与 `b` 兼容，当且仅当它们的 RA 组合有效。 */ PROOF extern thm ra_compatible_def; @@ -35,7 +35,7 @@ PROOF extern thm ra_compatible_def; * ra_included R a b <=> (exists frame. b == ra_op R a frame) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `a` 包含于 `b`，当且仅当存在 frame 使 `b = a ⋅ frame`。 */ PROOF extern thm ra_included_def; @@ -47,7 +47,7 @@ PROOF extern thm ra_included_def; * ==> (exists b. result b && ra_valid R (ra_op R b frame))) * ``` * - * 中文说明：说明谓词更新要求每个兼容 frame 都存在满足目标谓词的新资源。 + * `a` 可更新到谓词 `result`，当且仅当对每个与 `a` 兼容的 frame，都能选出满足 `result` 且与该 frame 兼容的目标资源。 */ PROOF extern thm ra_updateP_def; @@ -56,7 +56,7 @@ PROOF extern thm ra_updateP_def; * ra_update R a b <=> ra_updateP R a (\x. x == b) * ``` * - * 中文说明：说明确定性更新是目标谓词为单点集合时的谓词更新。 + * 确定性更新 `a -> b` 就是目标谓词只接受 `b` 的谓词更新。 */ PROOF extern thm ra_update_def; @@ -69,7 +69,7 @@ PROOF extern thm ra_update_def; * ==> a == b) * ``` * - * 中文说明：说明可消去性允许在有效组合中消去相同的 frame。 + * RA 可消去，当且仅当在 `frame ⋅ a` 有效时，等式 `frame ⋅ a = frame ⋅ b` 总能推出 `a = b`。 */ PROOF extern thm ra_cancellative_def; @@ -80,7 +80,7 @@ PROOF extern thm ra_cancellative_def; * (forall frame. ra_valid R (ra_op R a frame) ==> frame == ra_unit R) * ``` * - * 中文说明：说明 maximal 表示源资源有效，且唯一兼容 frame 是 unit。 + * `a` 为 maximal，当且仅当 `a` 有效且与它兼容的每个 frame 都是 unit。 */ PROOF extern thm ra_maximal_def; @@ -93,7 +93,7 @@ PROOF extern thm ra_maximal_def; * forall R. ra_laws (ra_unit R) (ra_op R) (ra_valid R) * ``` * - * 中文说明：汇总资源代数的结合、交换、单位元、单位有效及向下封闭规律。 + * 每个 RA 的组合满足结合律和交换律，unit 是有效单位元，且组合有效会推出两个分量都有效。 */ PROOF extern thm ra_laws; @@ -102,7 +102,7 @@ PROOF extern thm ra_laws; * forall R a b c. ra_op R (ra_op R a b) c == ra_op R a (ra_op R b c) * ``` * - * 中文说明：说明该运算满足结合律，改变括号结构不会改变结果。 + * RA 组合满足结合律，`(a ⋅ b) ⋅ c` 与 `a ⋅ (b ⋅ c)` 相等。 */ PROOF extern thm ra_assoc; @@ -111,7 +111,7 @@ PROOF extern thm ra_assoc; * forall R a b. ra_op R a b == ra_op R b a * ``` * - * 中文说明：说明该运算满足交换律，交换两个操作数不会改变结果。 + * RA 组合满足交换律，`a ⋅ b` 与 `b ⋅ a` 相等。 */ PROOF extern thm ra_comm; @@ -120,7 +120,7 @@ PROOF extern thm ra_comm; * forall R a. ra_op R (ra_unit R) a == a * ``` * - * 中文说明：说明单位元在组合运算左侧不改变资源。 + * unit 与任意资源从左侧组合仍得到原资源。 */ PROOF extern thm ra_unit_l; @@ -129,7 +129,7 @@ PROOF extern thm ra_unit_l; * forall R a. ra_op R a (ra_unit R) == a * ``` * - * 中文说明：说明单位元在组合运算右侧不改变资源。 + * unit 与任意资源从右侧组合仍得到原资源。 */ PROOF extern thm ra_unit_r; @@ -138,7 +138,7 @@ PROOF extern thm ra_unit_r; * forall R. ra_valid R (ra_unit R) * ``` * - * 中文说明：说明该资源或构造满足相应的有效性条件。 + * 每个 RA 的 unit 都是有效资源。 */ PROOF extern thm ra_valid_unit; @@ -147,7 +147,7 @@ PROOF extern thm ra_valid_unit; * forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R a && ra_valid R b * ``` * - * 中文说明：说明该资源或构造满足相应的有效性条件。 + * 若组合资源 `a ⋅ b` 有效，则它的两个分量 `a` 和 `b` 都有效。 */ PROOF extern thm ra_valid_op; @@ -160,7 +160,7 @@ PROOF extern thm ra_valid_op; * forall R a b. ra_compatible R a b <=> ra_compatible R b a * ``` * - * 中文说明：说明资源兼容性是对称的，交换两个资源不影响兼容性。 + * RA 兼容性是对称的，`a` 与 `b` 兼容等价于 `b` 与 `a` 兼容。 */ PROOF extern thm ra_compat_comm; @@ -169,7 +169,7 @@ PROOF extern thm ra_compat_comm; * forall R a. ra_compatible R a (ra_unit R) <=> ra_valid R a * ``` * - * 中文说明：刻画两个资源能否有效组合。 + * `a` 与 unit 兼容，当且仅当 `a` 本身有效。 */ PROOF extern thm ra_compat_unit; @@ -178,7 +178,7 @@ PROOF extern thm ra_compat_unit; * forall R a. ra_included R a a * ``` * - * 中文说明：说明该关系具有自反性。 + * 任意资源都包含于自身。 */ PROOF extern thm ra_included_refl; @@ -187,7 +187,7 @@ PROOF extern thm ra_included_refl; * forall R a. ra_included R (ra_unit R) a * ``` * - * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 + * unit 包含于任意资源。 */ PROOF extern thm ra_included_unit; @@ -196,7 +196,7 @@ PROOF extern thm ra_included_unit; * forall R a b. ra_included R a (ra_op R a b) * ``` * - * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 + * 组合资源 `a ⋅ b` 总是包含左分量 `a`。 */ PROOF extern thm ra_included_op_l; @@ -205,7 +205,7 @@ PROOF extern thm ra_included_op_l; * forall R a b. ra_included R b (ra_op R a b) * ``` * - * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 + * 组合资源 `a ⋅ b` 总是包含右分量 `b`。 */ PROOF extern thm ra_included_op_r; @@ -214,7 +214,7 @@ PROOF extern thm ra_included_op_r; * forall R a b c. ra_included R a b ==> ra_included R b c ==> ra_included R a c * ``` * - * 中文说明：说明该关系或变换可以传递地串联。 + * 包含关系可传递：`a` 包含于 `b` 且 `b` 包含于 `c` 时，`a` 包含于 `c`。 */ PROOF extern thm ra_included_trans; @@ -226,7 +226,7 @@ PROOF extern thm ra_included_trans; * ==> ra_included R (ra_op R a1 b1) (ra_op R a2 b2) * ``` * - * 中文说明：说明该构造对蕴含或底层关系保持单调。 + * 若 `a1` 包含于 `a2` 且 `b1` 包含于 `b2`，则 `a1 ⋅ b1` 包含于 `a2 ⋅ b2`。 */ PROOF extern thm ra_included_op_mono; @@ -235,7 +235,7 @@ PROOF extern thm ra_included_op_mono; * forall R a b. ra_included R a b ==> ra_valid R b ==> ra_valid R a * ``` * - * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 + * 若 `a` 包含于有效资源 `b`，则片段 `a` 也有效。 */ PROOF extern thm ra_included_valid; @@ -248,7 +248,7 @@ PROOF extern thm ra_included_valid; * forall R a b. ra_updateP R a (\x. x == b) <=> ra_update R a b * ``` * - * 中文说明：说明单点目标的谓词更新与确定性更新等价。 + * 目标只接受 `b` 的谓词更新，与确定性更新 `a -> b` 等价。 */ PROOF extern thm ra_updateP_singleton; @@ -257,7 +257,7 @@ PROOF extern thm ra_updateP_singleton; * forall R a. ra_updateP R a (\x. x == a) * ``` * - * 中文说明：说明该关系具有自反性。 + * 任意资源 `a` 都可谓词更新到只接受自身的目标。 */ PROOF extern thm ra_updateP_refl; @@ -267,7 +267,7 @@ PROOF extern thm ra_updateP_refl; * ra_updateP R a P ==> (forall b. P b ==> Q b) ==> ra_updateP R a Q * ``` * - * 中文说明：说明该构造对蕴含或底层关系保持单调。 + * 若 `a` 可更新到 `P`，且 `P` 蕴含 `Q`，则可将目标放宽为 `Q`。 */ PROOF extern thm ra_updateP_mono; @@ -279,7 +279,7 @@ PROOF extern thm ra_updateP_mono; * ==> ra_updateP R a Q * ``` * - * 中文说明：说明该关系或变换可以传递地串联。 + * 若 `a` 可更新到 `P`，且每个满足 `P` 的结果都可继续更新到 `Q`，则 `a` 可直接更新到 `Q`。 */ PROOF extern thm ra_updateP_trans; @@ -289,7 +289,7 @@ PROOF extern thm ra_updateP_trans; * ra_updateP R a P ==> ra_valid R a ==> (exists b. P b && ra_valid R b) * ``` * - * 中文说明：说明有效源上的谓词更新至少产生一个有效 witness。 + * 若源 `a` 有效且可更新到 `P`，则存在一个既有效又满足 `P` 的结果。 */ PROOF extern thm ra_updateP_valid; @@ -301,7 +301,7 @@ PROOF extern thm ra_updateP_valid; * (\x. exists b. P b && x == ra_op R b extra) * ``` * - * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 + * 若 `a` 可谓词更新到 `P`，则 `a ⋅ extra` 可更新到形如 `b ⋅ extra` 的结果，其中 `P b`，而 `extra` 保持不变。 */ PROOF extern thm ra_updateP_frame; @@ -314,7 +314,7 @@ PROOF extern thm ra_updateP_frame; * (\x. exists b d. P b && Q d && x == ra_op R b d) * ``` * - * 中文说明：说明两个谓词更新可以在 RA 组合运算下同步执行。 + * `a` 更新到 `P` 且 `c` 更新到 `Q` 时，`a ⋅ c` 可更新为某个 `b ⋅ d`，其中 `P b` 与 `Q d` 同时成立。 */ PROOF extern thm ra_updateP_op; @@ -327,7 +327,7 @@ PROOF extern thm ra_updateP_op; * forall R a. ra_update R a a * ``` * - * 中文说明：说明该关系具有自反性。 + * 任意资源都可更新为自身。 */ PROOF extern thm ra_update_refl; @@ -336,7 +336,7 @@ PROOF extern thm ra_update_refl; * forall R a b c. ra_update R a b ==> ra_update R b c ==> ra_update R a c * ``` * - * 中文说明：说明该关系或变换可以传递地串联。 + * 确定性更新可传递：`a -> b` 与 `b -> c` 可串联为 `a -> c`。 */ PROOF extern thm ra_update_trans; @@ -346,7 +346,7 @@ PROOF extern thm ra_update_trans; * ra_update R a b ==> ra_update R (ra_op R a extra) (ra_op R b extra) * ``` * - * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 + * 若 `a` 可更新为 `b`，则保留 `extra` 不变可将 `a ⋅ extra` 更新为 `b ⋅ extra`。 */ PROOF extern thm ra_update_frame; @@ -358,7 +358,7 @@ PROOF extern thm ra_update_frame; * ==> ra_update R (ra_op R a c) (ra_op R b d) * ``` * - * 中文说明：说明两个确定性更新可以在 RA 组合运算下同步执行。 + * 更新 `a -> b` 与 `c -> d` 可同步执行，得到组合资源的更新 `a ⋅ c -> b ⋅ d`。 */ PROOF extern thm ra_update_op; @@ -367,7 +367,7 @@ PROOF extern thm ra_update_op; * forall R a b. ra_included R b a ==> ra_update R a b * ``` * - * 中文说明：说明资源总能更新为它已经包含的有效片段。 + * 若 `b` 是 `a` 已包含的片段，则 `a` 可通过 frame-preserving 更新丢弃余部而变为 `b`。 */ PROOF extern thm ra_update_included; @@ -376,7 +376,7 @@ PROOF extern thm ra_update_included; * forall R a b c. ra_update R a b ==> ra_included R c b ==> ra_update R a c * ``` * - * 中文说明：说明更新目标可进一步缩小为其包含的片段。 + * 若 `a` 可更新为 `b` 且 `c` 是 `b` 包含的片段，则 `a` 也可直接更新为 `c`。 */ PROOF extern thm ra_update_target_included; @@ -385,7 +385,7 @@ PROOF extern thm ra_update_target_included; * forall R a b. ra_update R a b ==> ra_valid R a ==> ra_valid R b * ``` * - * 中文说明：说明确定性更新把有效源映射为有效目标。 + * 若更新 `a -> b` 成立且源 `a` 有效，则目标 `b` 也有效。 */ PROOF extern thm ra_update_valid; @@ -399,7 +399,7 @@ PROOF extern thm ra_update_valid; * ra_maximal R a ==> ra_valid R b ==> ra_included R a b ==> a == b * ``` * - * 中文说明：说明有效资源若包含 maximal 源，则只能等于该源。 + * 若 maximal 资源 `a` 包含于有效资源 `b`，则 `b` 不能多出非 unit 片段，因而 `a = b`。 */ PROOF extern thm ra_maximal_included; @@ -408,7 +408,7 @@ PROOF extern thm ra_maximal_included; * forall R a b. ra_maximal R a ==> ra_valid R b ==> ra_update R a b * ``` * - * 中文说明：说明 maximal 源可以更新到任意有效目标。 + * maximal 资源只有 unit frame，因此它可更新为任意有效资源。 */ PROOF extern thm ra_maximal_update; @@ -421,6 +421,6 @@ PROOF extern thm ra_maximal_update; * ==> a == b * ``` * - * 中文说明：说明该资源代数满足或不满足消去性质。 + * 在可消去 RA 中，若 `frame ⋅ a` 有效且等于 `frame ⋅ b`，则可消去公共 frame 得到 `a = b`。 */ PROOF extern thm ra_cancellative_apply; diff --git a/theory/logic/ra_builder.h b/theory/logic/ra_builder.h index 3ea4a98..a5d566f 100644 --- a/theory/logic/ra_builder.h +++ b/theory/logic/ra_builder.h @@ -25,7 +25,7 @@ * (forall a b. valid (op a b) ==> valid a) * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `(e, op, valid)` 满足 RA laws，当且仅当 `op` 结合且交换、`e` 为有效左单位元，并且组合有效能推出左分量有效。 */ PROOF extern thm ra_laws_def; @@ -36,7 +36,7 @@ PROOF extern thm ra_laws_def; * ra_laws (FST r) (FST (SND r)) (SND (SND r)) <=> ra_rep (ra_abs r) == r) * ``` * - * 中文说明：说明 RA 抽象值与满足 RA laws 的表示三元组构成双射。 + * `ra_abs` 与 `ra_rep` 在 RA 抽象值和满足 `ra_laws` 的表示三元组之间构成互逆对应。 */ PROOF extern thm ra_type_bijection; @@ -46,7 +46,7 @@ PROOF extern thm ra_type_bijection; * ra_laws (FST (ra_rep R)) (FST (SND (ra_rep R))) (SND (SND (ra_rep R))) * ``` * - * 中文说明：说明任意 RA 的底层表示都满足 RA laws。 + * 任意 RA 的表示三元组所给出的 unit、组合运算和有效性谓词都满足 `ra_laws`。 */ PROOF extern thm ra_rep_laws; @@ -56,7 +56,7 @@ PROOF extern thm ra_rep_laws; * ra_laws e op valid ==> ra_rep (ra_abs (e,op,valid)) == e,op,valid * ``` * - * 中文说明：说明满足 RA laws 的表示三元组经过抽象再表示后保持不变。 + * 对满足 `ra_laws` 的三元组 `(e,op,valid)`，先抽象为 RA 再取表示会恢复该三元组。 */ PROOF extern thm ra_abs_rep; @@ -69,7 +69,7 @@ PROOF extern thm ra_abs_rep; * forall e op valid. ra_laws e op valid ==> ra_unit (ra_abs (e,op,valid)) == e * ``` * - * 中文说明：说明由合法三元组构造的 RA 具有给定单位元。 + * 对满足 `ra_laws` 的 `(e,op,valid)`，由它构造的 RA 的 unit 正是 `e`。 */ PROOF extern thm ra_unit_abs; @@ -78,7 +78,7 @@ PROOF extern thm ra_unit_abs; * forall e op valid. ra_laws e op valid ==> ra_op (ra_abs (e,op,valid)) == op * ``` * - * 中文说明：说明由合法三元组构造的 RA 具有给定组合运算。 + * 对满足 `ra_laws` 的 `(e,op,valid)`，由它构造的 RA 的组合运算正是 `op`。 */ PROOF extern thm ra_op_abs; @@ -88,7 +88,7 @@ PROOF extern thm ra_op_abs; * ra_laws e op valid ==> ra_valid (ra_abs (e,op,valid)) == valid * ``` * - * 中文说明：说明该资源或构造满足相应的有效性条件。 + * 对满足 `ra_laws` 的 `(e,op,valid)`，由它构造的 RA 的有效性谓词正是 `valid`。 */ PROOF extern thm ra_valid_abs; @@ -97,6 +97,6 @@ PROOF extern thm ra_valid_abs; * forall R. ra_abs (ra_unit R,ra_op R,ra_valid R) == R * ``` * - * 中文说明：说明从任意 RA 的三个投影重建后得到原 RA。 + * 用任意 RA 的 unit、组合运算和有效性谓词重新抽象，得到的仍是原 RA。 */ PROOF extern thm ra_abs_eta; diff --git a/theory/logic/ra_internal.h b/theory/logic/ra_internal.h index 68184e3..01799aa 100644 --- a/theory/logic/ra_internal.h +++ b/theory/logic/ra_internal.h @@ -19,7 +19,7 @@ * forall R a b c. ra_op R (ra_op R a b) c == ra_op R (ra_op R a c) b * ``` * - * 中文说明：说明可由结合律和交换律交换组合式右侧的两个分量。 + * 在保留左分量 `a` 的嵌套组合中，可交换右侧的 `b` 与 `c`。 */ PROOF extern thm ra_op_swap_right; @@ -28,7 +28,7 @@ PROOF extern thm ra_op_swap_right; * forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R a * ``` * - * 中文说明：说明该资源或构造满足相应的有效性条件。 + * 若组合资源 `a ⋅ b` 有效，则左分量 `a` 有效。 */ PROOF extern thm ra_valid_op_l; @@ -37,7 +37,7 @@ PROOF extern thm ra_valid_op_l; * forall R a b. ra_valid R (ra_op R a b) ==> ra_valid R b * ``` * - * 中文说明：说明该资源或构造满足相应的有效性条件。 + * 若组合资源 `a ⋅ b` 有效，则右分量 `b` 有效。 */ PROOF extern thm ra_valid_op_r; @@ -47,7 +47,7 @@ PROOF extern thm ra_valid_op_r; * ra_maximal R a ==> ra_valid R (ra_op R a frame) ==> frame == ra_unit R * ``` * - * 中文说明：说明 frame-maximal 资源只能与单位 frame 兼容。 + * maximal 资源 `a` 与 frame 组合后若有效，则该 frame 必为 unit。 */ PROOF extern thm ra_maximal_apply; @@ -59,7 +59,7 @@ PROOF extern thm ra_maximal_apply; * ==> ra_valid R (ra_op R b frame) * ``` * - * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 + * 若 `a -> b` 是 frame-preserving 更新，则任何使 `a ⋅ frame` 有效的 frame 也使 `b ⋅ frame` 有效。 */ PROOF extern thm ra_update_apply; @@ -71,7 +71,7 @@ PROOF extern thm ra_update_apply; * ==> (exists b. P b && ra_valid R (ra_op R b frame)) * ``` * - * 中文说明：说明谓词更新允许选择任意满足目标谓词的新资源。 + * 若 `a` 可谓词更新到 `P`，则对每个与 `a` 兼容的 frame，都存在满足 `P` 且与同一 frame 兼容的结果 `b`。 */ PROOF extern thm ra_updateP_apply; @@ -85,7 +85,7 @@ PROOF extern thm ra_updateP_apply; * ra_included R a1 a2 ==> ra_included R (ra_op R a1 b) (ra_op R a2 b) * ``` * - * 中文说明：说明该构造对蕴含或底层关系保持单调。 + * 若 `a1` 包含于 `a2`，则在两边右侧组合同一 `b` 后仍保持包含。 */ PROOF extern thm ra_included_op_mono_l; @@ -95,7 +95,7 @@ PROOF extern thm ra_included_op_mono_l; * ra_included R a1 a2 ==> ra_included R (ra_op R b a1) (ra_op R b a2) * ``` * - * 中文说明：说明该构造对蕴含或底层关系保持单调。 + * 若 `a1` 包含于 `a2`，则在两边左侧组合同一 `b` 后仍保持包含。 */ PROOF extern thm ra_included_op_mono_r; @@ -107,7 +107,7 @@ PROOF extern thm ra_included_op_mono_r; * ==> ra_valid R (ra_op R a frame) * ``` * - * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 + * 若 `a` 包含于 `b` 且 `b ⋅ frame` 有效，则替换为更小片段后的 `a ⋅ frame` 也有效。 */ PROOF extern thm ra_included_valid_frame; @@ -120,7 +120,7 @@ PROOF extern thm ra_included_valid_frame; * ==> ra_included R a b * ``` * - * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 + * 在可消去 RA 中，若 `common ⋅ b` 有效且 `common ⋅ a` 包含于它，则可消去公共分量得到 `a` 包含于 `b`。 */ PROOF extern thm ra_included_cancel_l; @@ -131,7 +131,7 @@ PROOF extern thm ra_included_cancel_l; * ==> (ra_valid R (ra_op R a frame) <=> ra_valid R a && frame == ra_unit R) * ``` * - * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 + * 对 maximal 资源 `a`，`a ⋅ frame` 有效当且仅当 `a` 有效且 `frame` 是 unit。 */ PROOF extern thm ra_maximal_valid_op_iff; @@ -144,7 +144,7 @@ PROOF extern thm ra_maximal_valid_op_iff; * forall R a b P. ra_update R a b ==> P b ==> ra_updateP R a P * ``` * - * 中文说明：说明谓词更新允许选择任意满足目标谓词的新资源。 + * 若 `a` 可确定性更新为满足 `P` 的 `b`，则 `a` 可谓词更新到 `P`。 */ PROOF extern thm ra_updateP_of_update; @@ -153,6 +153,6 @@ PROOF extern thm ra_updateP_of_update; * forall R a. ra_update R a (ra_unit R) * ``` * - * 中文说明：说明该确定性更新在所有兼容 frame 下保持有效。 + * 任意 RA 资源都可更新为 unit，即丢弃自身的全部资源。 */ PROOF extern thm ra_update_unit; diff --git a/theory/logic/resource_prop.h b/theory/logic/resource_prop.h index cfa6857..957099c 100644 --- a/theory/logic/resource_prop.h +++ b/theory/logic/resource_prop.h @@ -39,7 +39,7 @@ * R resource ==> P resource ==> Q resource * ``` * - * 中文说明：说明蕴含只需在有效资源上逐点成立。 + * `P` 蕴含 `Q`，正是指每个有效且满足 `P` 的资源也满足 `Q`。 */ PROOF extern thm r_entails_def; /** @@ -50,7 +50,7 @@ PROOF extern thm r_entails_def; * Q P * ``` * - * 中文说明：说明逻辑等价由两个方向的有效资源蕴含组成。 + * 资源断言等价定义为两个方向的有效资源蕴含，而非谓词的原始 HOL 相等。 */ PROOF extern thm r_equiv_def; @@ -61,7 +61,7 @@ PROOF extern thm r_equiv_def; * r_emp (R:(A)ra) (resource:A) <=> resource == ra_unit R * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `r_emp` 精确描述 RA 单位元：当前资源必须等于 `ra_unit R`。 */ PROOF extern thm r_emp_def; /** @@ -72,7 +72,7 @@ PROOF extern thm r_emp_def; * right:A. resource == ra_op R left right && P left && Q right * ``` * - * 中文说明：说明分离合取通过 RA 运算把当前资源拆成左右两部分。 + * 分离合取成立，当且仅当资源可拆为满足 `P`、`Q` 的两部分之 RA 乘积。 */ PROOF extern thm r_sep_def; /** @@ -84,7 +84,7 @@ PROOF extern thm r_sep_def; * frame) * ``` * - * 中文说明：说明魔法棒量化所有能与当前资源有效组合的 frame。 + * 魔杖要求：任意与当前资源组合后仍有效且满足 `P` 的框架，都使组合资源满足 `Q`。 */ PROOF extern thm r_wand_def; /** @@ -94,7 +94,7 @@ PROOF extern thm r_wand_def; * r_own (R:(A)ra) (owned:A) (resource:A) <=> resource == owned * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `r_own R owned` 只在当前资源精确等于 `owned` 时成立。 */ PROOF extern thm r_own_def; /** @@ -104,7 +104,7 @@ PROOF extern thm r_own_def; * r_top (R:(A)ra) (resource:A) <=> T * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `r_top` 对每个资源都成立。 */ PROOF extern thm r_top_def; /** @@ -114,7 +114,7 @@ PROOF extern thm r_top_def; * r_bottom (R:(A)ra) (resource:A) <=> F * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * `r_bottom` 对任何资源都不成立。 */ PROOF extern thm r_bottom_def; /** @@ -125,7 +125,7 @@ PROOF extern thm r_bottom_def; * resource * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 加法合取要求同一份当前资源同时满足 `P` 和 `Q`。 */ PROOF extern thm r_and_def; /** @@ -136,7 +136,7 @@ PROOF extern thm r_and_def; * resource * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 加法析取要求同一份当前资源至少满足 `P`、`Q` 之一。 */ PROOF extern thm r_or_def; /** @@ -147,7 +147,7 @@ PROOF extern thm r_or_def; * resource * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 加法蕴含在当前资源上把 `P resource` 蕴含 `Q resource`。 */ PROOF extern thm r_impl_def; /** @@ -158,7 +158,7 @@ PROOF extern thm r_impl_def; * witness resource * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 资源存在量词在同一资源上选择一个见证，使对应断言成立。 */ PROOF extern thm r_exists_def; /** @@ -169,7 +169,7 @@ PROOF extern thm r_exists_def; * witness resource * ``` * - * 中文说明：给出该符号的定义展开，便于按右侧表达式计算和重写。 + * 资源全称量词要求同一资源满足每个见证对应的断言。 */ PROOF extern thm r_forall_def; @@ -180,7 +180,7 @@ PROOF extern thm r_forall_def; * r_pure (R:(A)ra) (phi:bool) (resource:A) <=> phi * ``` * - * 中文说明：说明 pure 只记录命题真假，与当前资源无关。 + * `r_pure R phi` 仅取决于 `phi` 的真假，对当前资源没有任何限制。 */ PROOF extern thm r_pure_def; @@ -191,7 +191,7 @@ PROOF extern thm r_pure_def; * r_fact (R:(A)ra) (phi:bool) (resource:A) <=> phi && resource == ra_unit R * ``` * - * 中文说明：说明 fact 要求命题为真，并且当前资源精确为 unit。 + * `r_fact R phi` 同时要求 `phi` 为真且当前资源精确为 RA 单位元，因而不同于 `r_pure`。 */ PROOF extern thm r_fact_def; @@ -207,7 +207,7 @@ PROOF extern thm r_fact_def; * forall (R:(A)ra) (P:A->bool). r_entails R P P * ``` * - * 中文说明：说明该关系具有自反性。 + * 每个资源断言都蕴含自身。 */ PROOF extern thm r_entails_refl; /** @@ -218,7 +218,7 @@ PROOF extern thm r_entails_refl; * r_entails R Q S ==> r_entails R P S * ``` * - * 中文说明：说明该关系或变换可以传递地串联。 + * 资源蕴含可传递组合：`P ⊢ Q` 与 `Q ⊢ S` 推出 `P ⊢ S`。 */ PROOF extern thm r_entails_trans; /** @@ -229,7 +229,7 @@ PROOF extern thm r_entails_trans; * Q resource) ==> r_entails R P Q * ``` * - * 中文说明：给出逐点条件与整体逻辑关系之间的对应。 + * 若 `P resource` 对所有资源都推出 `Q resource`，则尤其得到有效资源上的 `P ⊢ Q`。 */ PROOF extern thm r_entails_pointwise; /** @@ -240,7 +240,7 @@ PROOF extern thm r_entails_pointwise; * resource:A. ra_valid R resource ==> (P resource <=> Q resource) * ``` * - * 中文说明：给出逐点条件与整体逻辑关系之间的对应。 + * `P` 与 `Q` 资源等价，当且仅当它们在每个有效资源上的真假一致。 */ PROOF extern thm r_equiv_pointwise; /** @@ -251,7 +251,7 @@ PROOF extern thm r_equiv_pointwise; * P ==> r_equiv R P Q * ``` * - * 中文说明：给出该逻辑构造的引入规则。 + * 两个方向的资源蕴含共同引入 `r_equiv`。 */ PROOF extern thm r_equiv_intro; /** @@ -261,7 +261,7 @@ PROOF extern thm r_equiv_intro; * forall (R:(A)ra) (P:A->bool). r_equiv R P P * ``` * - * 中文说明：说明该关系具有自反性。 + * 每个资源断言都与自身资源等价。 */ PROOF extern thm r_equiv_refl; /** @@ -271,7 +271,7 @@ PROOF extern thm r_equiv_refl; * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_equiv R P Q ==> r_equiv R Q P * ``` * - * 中文说明：说明该关系具有对称性，可交换关系两端。 + * 交换资源等价的两端仍得到资源等价。 */ PROOF extern thm r_equiv_sym; /** @@ -282,7 +282,7 @@ PROOF extern thm r_equiv_sym; * r_equiv R Q S ==> r_equiv R P S * ``` * - * 中文说明：说明该关系或变换可以传递地串联。 + * 资源等价可传递组合：`P ≡ Q` 与 `Q ≡ S` 推出 `P ≡ S`。 */ PROOF extern thm r_equiv_trans; @@ -294,7 +294,7 @@ PROOF extern thm r_equiv_trans; * forall (R:(A)ra) (P:A->bool). r_entails R P (r_top R) * ``` * - * 中文说明：给出该逻辑构造的引入规则。 + * 任意资源断言都蕴含恒真的加法断言 `r_top`。 */ PROOF extern thm r_top_intro; /** @@ -304,7 +304,7 @@ PROOF extern thm r_top_intro; * forall (R:(A)ra) (P:A->bool). r_entails R (r_bottom R) P * ``` * - * 中文说明：给出该逻辑构造的消去或投影规则。 + * 恒假的加法断言 `r_bottom` 蕴含任意资源断言。 */ PROOF extern thm r_bottom_elim; @@ -318,7 +318,7 @@ PROOF extern thm r_bottom_elim; * (r_sep R P Q) S) (r_sep R P (r_sep R Q S)) * ``` * - * 中文说明：说明该运算满足结合律，改变括号结构不会改变结果。 + * 分离合取的两种括号方式在有效资源上等价；结论是 `r_equiv` 而非原始相等。 */ PROOF extern thm r_sep_assoc; /** @@ -329,7 +329,7 @@ PROOF extern thm r_sep_assoc; * P) * ``` * - * 中文说明：说明该运算满足交换律，交换两个操作数不会改变结果。 + * 交换分离合取的左右断言在有效资源上等价；结论是 `r_equiv` 而非原始相等。 */ PROOF extern thm r_sep_comm; /** @@ -339,7 +339,7 @@ PROOF extern thm r_sep_comm; * forall (R:(A)ra) (P:A->bool). r_equiv R (r_sep R (r_emp R) P) P * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * 在 `r_equiv` 下，左侧的 `r_emp` 是分离合取单位元。 */ PROOF extern thm r_sep_emp_l; /** @@ -349,7 +349,7 @@ PROOF extern thm r_sep_emp_l; * forall (R:(A)ra) (P:A->bool). r_equiv R (r_sep R P (r_emp R)) P * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * 在 `r_equiv` 下，右侧的 `r_emp` 是分离合取单位元。 */ PROOF extern thm r_sep_emp_r; /** @@ -361,7 +361,7 @@ PROOF extern thm r_sep_emp_r; * P2 Q2) * ``` * - * 中文说明：说明该构造对蕴含或底层关系保持单调。 + * 两个分离分量分别按蕴含替换时，整个分离合取也保持同方向的蕴含。 */ PROOF extern thm r_sep_mono; /** @@ -372,7 +372,7 @@ PROOF extern thm r_sep_mono; * Q ==> r_entails R (r_sep R P frame_pred) (r_sep R Q frame_pred) * ``` * - * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 + * `P ⊢ Q` 可在右侧保留同一框架，得到 `P ** frame ⊢ Q ** frame`。 */ PROOF extern thm r_sep_frame_l; /** @@ -383,7 +383,7 @@ PROOF extern thm r_sep_frame_l; * Q ==> r_entails R (r_sep R frame_pred P) (r_sep R frame_pred Q) * ``` * - * 中文说明：说明该规则可在保留额外 frame 的情况下应用。 + * `P ⊢ Q` 可在左侧保留同一框架，得到 `frame ** P ⊢ frame ** Q`。 */ PROOF extern thm r_sep_frame_r; /** @@ -394,7 +394,7 @@ PROOF extern thm r_sep_frame_r; * (\x:B. P x)) Q) (r_exists R (\x:B. r_sep R (P x) Q)) * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * 左分量中的存在量词可穿过分离合取，见证同时作用于该左分量。 */ PROOF extern thm r_sep_exists_l; /** @@ -405,7 +405,7 @@ PROOF extern thm r_sep_exists_l; * R (\x:B. Q x))) (r_exists R (\x:B. r_sep R P (Q x))) * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * 右分量中的存在量词可穿过分离合取，见证同时作用于该右分量。 */ PROOF extern thm r_sep_exists_r; @@ -418,7 +418,7 @@ PROOF extern thm r_sep_exists_r; * Q) S <=> r_entails R P (r_impl R Q S) * ``` * - * 中文说明：说明该伴随关系可在分离合取与对应连接词之间双向转换。 + * 加法合取与加法蕴含满足伴随：`P && Q ⊢ S` 当且仅当 `P ⊢ Q → S`。 */ PROOF extern thm r_impl_adjunction; /** @@ -429,7 +429,7 @@ PROOF extern thm r_impl_adjunction; * r_entails R P S ==> r_entails R P (r_and R Q S) * ``` * - * 中文说明：给出该逻辑构造的引入规则。 + * 若 `P` 分别蕴含 `Q` 和 `S`，则 `P` 蕴含二者的加法合取。 */ PROOF extern thm r_and_intro; /** @@ -439,7 +439,7 @@ PROOF extern thm r_and_intro; * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R (r_and R P Q) P * ``` * - * 中文说明：给出该逻辑构造的消去或投影规则。 + * 加法合取蕴含其左分量。 */ PROOF extern thm r_and_elim_l; /** @@ -449,7 +449,7 @@ PROOF extern thm r_and_elim_l; * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R (r_and R P Q) Q * ``` * - * 中文说明：给出该逻辑构造的消去或投影规则。 + * 加法合取蕴含其右分量。 */ PROOF extern thm r_and_elim_r; /** @@ -459,7 +459,7 @@ PROOF extern thm r_and_elim_r; * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R P (r_or R P Q) * ``` * - * 中文说明：给出该逻辑构造的引入规则。 + * 左断言 `P` 蕴含包含它的加法析取 `P || Q`。 */ PROOF extern thm r_or_intro_l; /** @@ -469,7 +469,7 @@ PROOF extern thm r_or_intro_l; * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_entails R Q (r_or R P Q) * ``` * - * 中文说明：给出该逻辑构造的引入规则。 + * 右断言 `Q` 蕴含包含它的加法析取 `P || Q`。 */ PROOF extern thm r_or_intro_r; /** @@ -480,7 +480,7 @@ PROOF extern thm r_or_intro_r; * r_entails R Q S ==> r_entails R (r_or R P Q) S * ``` * - * 中文说明：给出该逻辑构造的消去或投影规则。 + * 若析取的两个分支都蕴含 `S`，则整个加法析取蕴含 `S`。 */ PROOF extern thm r_or_elim; /** @@ -491,7 +491,7 @@ PROOF extern thm r_or_elim; * (r_exists R (\bound:B. P bound)) * ``` * - * 中文说明：给出该逻辑构造的引入规则。 + * 任一具体见证的断言都蕴含对应的资源存在量词。 */ PROOF extern thm r_exists_intro; /** @@ -502,7 +502,7 @@ PROOF extern thm r_exists_intro; * (P witness) Q) ==> r_entails R (r_exists R (\bound:B. P bound)) Q * ``` * - * 中文说明：给出该逻辑构造的消去或投影规则。 + * 若每个见证对应的断言都蕴含 `Q`，则资源存在量词也蕴含 `Q`。 */ PROOF extern thm r_exists_elim; /** @@ -514,7 +514,7 @@ PROOF extern thm r_exists_elim; * (r_exists R (\bound:B. Q bound)) * ``` * - * 中文说明：说明该构造对蕴含或底层关系保持单调。 + * 若每个见证下 `P` 都蕴含 `Q`，则对二者取资源存在量词后仍保持蕴含。 */ PROOF extern thm r_exists_mono; /** @@ -525,7 +525,7 @@ PROOF extern thm r_exists_mono; * P (Q witness)) ==> r_entails R P (r_forall R (\bound:B. Q bound)) * ``` * - * 中文说明：给出该逻辑构造的引入规则。 + * 若 `P` 蕴含每个见证对应的 `Q`，则 `P` 蕴含这些断言的资源全称量词。 */ PROOF extern thm r_forall_intro; /** @@ -536,7 +536,7 @@ PROOF extern thm r_forall_intro; * witness) * ``` * - * 中文说明：给出该逻辑构造的消去或投影规则。 + * 资源全称量词可实例化为任意给定见证对应的断言。 */ PROOF extern thm r_forall_elim; @@ -549,7 +549,7 @@ PROOF extern thm r_forall_elim; * Q) S <=> r_entails R P (r_wand R Q S) * ``` * - * 中文说明：说明该伴随关系可在分离合取与对应连接词之间双向转换。 + * 分离合取与魔杖满足伴随：`P ** Q ⊢ S` 当且仅当 `P ⊢ Q -* S`。 */ PROOF extern thm r_wand_adjunction; /** @@ -560,7 +560,7 @@ PROOF extern thm r_wand_adjunction; * Q) P) Q * ``` * - * 中文说明：给出该逻辑构造的消去或投影规则。 + * 将 `P -* Q` 与 `P` 分离合取即可消去魔杖并推出 `Q`。 */ PROOF extern thm r_wand_elim; /** @@ -572,7 +572,7 @@ PROOF extern thm r_wand_elim; * R P2 Q2) * ``` * - * 中文说明：说明该构造对蕴含或底层关系保持单调。 + * 魔杖对前件逆变、对后件协变：`P2 ⊢ P` 且 `Q ⊢ Q2` 推出 `(P -* Q) ⊢ (P2 -* Q2)`。 */ PROOF extern thm r_wand_mono; @@ -585,7 +585,7 @@ PROOF extern thm r_wand_mono; * ==> r_entails R P (r_and R (r_pure R phi) Q) * ``` * - * 中文说明：给出该逻辑构造的引入规则。 + * 当 `phi` 为真且 `P ⊢ Q` 时，可在结论中加入资源无关的 `pure(phi)` 加法合取。 */ PROOF extern thm r_pure_and_intro; /** @@ -596,7 +596,7 @@ PROOF extern thm r_pure_and_intro; * Q) ==> r_entails R (r_and R (r_pure R phi) P) Q * ``` * - * 中文说明：给出该逻辑构造的消去或投影规则。 + * 若假设 `phi` 后可由 `P` 推出 `Q`，则可从 `pure(phi) && P` 直接推出 `Q`。 */ PROOF extern thm r_pure_and_elim; @@ -609,7 +609,7 @@ PROOF extern thm r_pure_and_elim; * phi) (r_emp R)) * ``` * - * 中文说明：说明 fact 等价于资源无关的 pure 与精确 emp 的合取。 + * 在 `r_equiv` 下，精确单位元事实 `fact(phi)` 等于 `pure(phi)` 与 `emp` 的加法合取。 */ PROOF extern thm r_fact_as_pure_and_emp; /** @@ -619,7 +619,7 @@ PROOF extern thm r_fact_as_pure_and_emp; * forall R:(A)ra. r_equiv R (r_fact R T) (r_emp R) * ``` * - * 中文说明：说明 spatial fact 的构造、消去、复制或与 sep 的关系。 + * 真命题的精确单位元事实在 `r_equiv` 下就是 `emp`。 */ PROOF extern thm r_fact_true; /** @@ -629,7 +629,7 @@ PROOF extern thm r_fact_true; * forall R:(A)ra. r_equiv R (r_fact R F) (r_bottom R) * ``` * - * 中文说明：说明 spatial fact 的构造、消去、复制或与 sep 的关系。 + * 假命题的精确单位元事实在 `r_equiv` 下就是 `r_bottom`。 */ PROOF extern thm r_fact_false; /** @@ -640,7 +640,7 @@ PROOF extern thm r_fact_false; * P) (r_and R (r_pure R phi) P) * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * 左侧精确事实与 `P` 分离合取，等价于资源无关的 `pure(phi)` 与 `P` 加法合取。 */ PROOF extern thm r_fact_sep_l; /** @@ -651,7 +651,7 @@ PROOF extern thm r_fact_sep_l; * phi)) (r_and R (r_pure R phi) P) * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * 右侧精确事实与 `P` 分离合取，等价于资源无关的 `pure(phi)` 与 `P` 加法合取。 */ PROOF extern thm r_fact_sep_r; /** @@ -662,7 +662,7 @@ PROOF extern thm r_fact_sep_r; * ==> r_entails R P (r_sep R (r_fact R phi) Q) * ``` * - * 中文说明：给出该逻辑构造的引入规则。 + * 当 `phi` 为真且 `P ⊢ Q` 时，可把精确单位元事实 `fact(phi)` 分离加入结论。 */ PROOF extern thm r_fact_intro; /** @@ -673,7 +673,7 @@ PROOF extern thm r_fact_intro; * Q) ==> r_entails R (r_sep R (r_fact R phi) P) Q * ``` * - * 中文说明：给出该逻辑构造的消去或投影规则。 + * 若在 `phi` 为真时 `P ⊢ Q`，则可消去前件中的 `fact(phi)` 并推出 `Q`。 */ PROOF extern thm r_fact_elim; /** @@ -684,7 +684,7 @@ PROOF extern thm r_fact_elim; * phi) (r_fact R phi)) * ``` * - * 中文说明：说明 spatial fact 的构造、消去、复制或与 sep 的关系。 + * 精确单位元事实可复制为两个相同事实的分离合取。 */ PROOF extern thm r_fact_dup; @@ -696,7 +696,7 @@ PROOF extern thm r_fact_dup; * forall R:(A)ra. r_equiv R (r_own R (ra_unit R)) (r_emp R) * ``` * - * 中文说明：说明精确所有权如何反映 RA 的单位元、运算或有效性。 + * RA 单位元的精确所有权在 `r_equiv` 下等价于 `r_emp`。 */ PROOF extern thm r_own_unit; /** @@ -707,7 +707,7 @@ PROOF extern thm r_own_unit; * (r_own R a) (r_own R b)) * ``` * - * 中文说明：说明精确所有权如何反映 RA 的单位元、运算或有效性。 + * RA 乘积 `a ⋅ b` 的精确所有权等价于 `a` 与 `b` 的所有权之分离合取。 */ PROOF extern thm r_own_op; /** @@ -718,7 +718,7 @@ PROOF extern thm r_own_op; * R a)) (r_own R a)) * ``` * - * 中文说明：说明精确所有权可导出资源有效性，同时保留原所有权。 + * 从 `a` 的精确所有权可分离导出 exact-unit 的 `ra_valid R a` fact，同时保留原所有权。 */ PROOF extern thm r_own_valid; @@ -731,7 +731,7 @@ PROOF extern thm r_own_valid; * (r_and R Q S)) (r_and R (r_sep R P Q) (r_sep R P S)) * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * `P ** (Q && S)` 单向蕴含 `(P ** Q) && (P ** S)`，把同一左分量投影到两个加法分支。 */ PROOF extern thm r_sep_and_forward_r; /** @@ -742,6 +742,6 @@ PROOF extern thm r_sep_and_forward_r; * (r_and R Q S) P) (r_and R (r_sep R Q P) (r_sep R S P)) * ``` * - * 中文说明：说明分离合取如何组合、拆分或重排资源。 + * `(Q && S) ** P` 单向蕴含 `(Q ** P) && (S ** P)`，把同一右分量投影到两个加法分支。 */ PROOF extern thm r_sep_and_forward_l; diff --git a/theory/logic/resource_prop_internal.h b/theory/logic/resource_prop_internal.h index 037a3e6..2f4ea05 100644 --- a/theory/logic/resource_prop_internal.h +++ b/theory/logic/resource_prop_internal.h @@ -21,7 +21,7 @@ * forall (R:(A)ra) (P:A->bool) (Q:A->bool). r_sep R P Q == r_sep R Q P * ``` * - * 中文说明：说明该运算满足交换律，交换两个操作数不会改变结果。 + * 交换分离合取两端得到相同的断言函数；这里是原始 HOL 相等而非 `r_equiv`。 */ PROOF extern thm r_sep_comm_eq; /** @@ -31,7 +31,7 @@ PROOF extern thm r_sep_comm_eq; * forall (R:(A)ra) (P:A->bool). r_sep R (r_emp R) P == P * ``` * - * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 + * 左侧加入 `r_emp` 后的分离合取与原断言函数在 HOL 中严格相等。 */ PROOF extern thm r_sep_emp_l_eq; /** @@ -41,7 +41,7 @@ PROOF extern thm r_sep_emp_l_eq; * forall (R:(A)ra) (P:A->bool). r_sep R P (r_emp R) == P * ``` * - * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 + * 右侧加入 `r_emp` 后的分离合取与原断言函数在 HOL 中严格相等。 */ PROOF extern thm r_sep_emp_r_eq; /** @@ -52,7 +52,7 @@ PROOF extern thm r_sep_emp_r_eq; * S == r_sep R P (r_sep R Q S) * ``` * - * 中文说明：说明该运算满足结合律，改变括号结构不会改变结果。 + * 分离合取的两种括号方式给出严格相同的 HOL 断言函数。 */ PROOF extern thm r_sep_assoc_eq; /** @@ -63,7 +63,7 @@ PROOF extern thm r_sep_assoc_eq; * x)) Q == r_exists R (\witness:B. r_sep R (P witness) Q) * ``` * - * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 + * 左分量上的存在量词可移到分离合取外，且两侧断言函数在 HOL 中严格相等。 */ PROOF extern thm r_sep_exists_l_eq; /** @@ -74,7 +74,7 @@ PROOF extern thm r_sep_exists_l_eq; * x)) == r_exists R (\witness:B. r_sep R P (Q witness)) * ``` * - * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 + * 右分量上的存在量词可移到分离合取外，且两侧断言函数在 HOL 中严格相等。 */ PROOF extern thm r_sep_exists_r_eq; @@ -87,7 +87,7 @@ PROOF extern thm r_sep_exists_r_eq; * witness) Q ==> r_entails R (r_forall R (\x:B. P x)) Q * ``` * - * 中文说明：给出该逻辑构造的消去或投影规则。 + * 若某个实例 `P(witness)` 蕴含 `Q`，则更强的全称断言也蕴含 `Q`。 */ PROOF extern thm r_forall_elim_cont; @@ -100,7 +100,7 @@ PROOF extern thm r_forall_elim_cont; * R) * ``` * - * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 + * `fact(phi)` 与 `pure(phi) && emp` 是严格相同的 HOL 断言函数。 */ PROOF extern thm r_fact_as_pure_and_emp_eq; /** @@ -110,7 +110,7 @@ PROOF extern thm r_fact_as_pure_and_emp_eq; * forall R:(A)ra. r_fact R T == r_emp R * ``` * - * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 + * 真命题的精确单位元事实与 `r_emp` 在 HOL 中严格相等。 */ PROOF extern thm r_fact_true_eq; /** @@ -120,7 +120,7 @@ PROOF extern thm r_fact_true_eq; * forall R:(A)ra. r_fact R F == r_bottom R * ``` * - * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 + * 假命题的精确单位元事实与 `r_bottom` 在 HOL 中严格相等。 */ PROOF extern thm r_fact_false_eq; /** @@ -131,7 +131,7 @@ PROOF extern thm r_fact_false_eq; * (r_pure R phi) P * ``` * - * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 + * 左侧 `fact(phi)` 与 `P` 的分离合取严格等于 `pure(phi) && P`。 */ PROOF extern thm r_fact_sep_l_eq; /** @@ -142,7 +142,7 @@ PROOF extern thm r_fact_sep_l_eq; * (r_pure R phi) P * ``` * - * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 + * 右侧 `fact(phi)` 与 `P` 的分离合取严格等于 `pure(phi) && P`。 */ PROOF extern thm r_fact_sep_r_eq; @@ -154,7 +154,7 @@ PROOF extern thm r_fact_sep_r_eq; * forall R:(A)ra. r_own R (ra_unit R) == r_emp R * ``` * - * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 + * RA 单位元的精确所有权与 `r_emp` 是严格相同的 HOL 断言函数。 */ PROOF extern thm r_own_unit_eq; /** @@ -165,6 +165,6 @@ PROOF extern thm r_own_unit_eq; * (r_own R b) * ``` * - * 中文说明：给出该对象的原始 HOL 等式，供实现层规范化重写。 + * 组合资源的精确所有权严格等于两个分量所有权的分离合取。 */ PROOF extern thm r_own_op_eq; diff --git a/theory/logic/unit_ra.h b/theory/logic/unit_ra.h index 511a27b..c297a4b 100644 --- a/theory/logic/unit_ra.h +++ b/theory/logic/unit_ra.h @@ -16,7 +16,7 @@ * ra_unit unit_ra == one * ``` * - * 中文说明：说明单位 RA 只有一个资源值，因此相应关系均退化为单位情形。 + * `unit_ra` 的 unit 是单元类型中唯一的值 `one`。 */ PROOF extern thm unit_ra_unit; @@ -25,7 +25,7 @@ PROOF extern thm unit_ra_unit; * forall a b. ra_op unit_ra a b == one * ``` * - * 中文说明：说明单位 RA 只有一个资源值，因此相应关系均退化为单位情形。 + * `unit_ra` 中任意两个载体值的组合结果都是 `one`。 */ PROOF extern thm unit_ra_op; @@ -34,7 +34,7 @@ PROOF extern thm unit_ra_op; * forall a. ra_valid unit_ra a * ``` * - * 中文说明：说明该资源或构造满足相应的有效性条件。 + * `unit_ra` 的任意载体值都有效。 */ PROOF extern thm unit_ra_valid; @@ -43,7 +43,7 @@ PROOF extern thm unit_ra_valid; * forall a b. ra_included unit_ra a b * ``` * - * 中文说明：刻画资源片段包含关系及其与运算、有效性的联系。 + * `unit_ra` 中任意资源都包含于任意其他资源。 */ PROOF extern thm unit_ra_included; @@ -52,7 +52,7 @@ PROOF extern thm unit_ra_included; * forall a. ra_maximal unit_ra a * ``` * - * 中文说明：说明 frame-maximal 资源只能与单位 frame 兼容。 + * `unit_ra` 中的任意资源都是 maximal，因为唯一可能的 frame 就是 unit。 */ PROOF extern thm unit_ra_maximal; @@ -65,7 +65,7 @@ PROOF extern thm unit_ra_maximal; * forall a P. ra_updateP unit_ra a P <=> P one * ``` * - * 中文说明：给出该性质成立的充要条件，可从任一方向进行改写。 + * `unit_ra` 中从任意源更新到谓词 `P` 可行，当且仅当 `P one` 成立。 */ PROOF extern thm unit_ra_updateP_iff; @@ -74,6 +74,6 @@ PROOF extern thm unit_ra_updateP_iff; * forall a f b g. ra_local_update unit_ra a f b g * ``` * - * 中文说明：说明局部更新在保留外部 residual 时替换内部片段。 + * `unit_ra` 只有一个资源值，因此任意 whole/local 对之间的局部更新都成立。 */ PROOF extern thm unit_ra_local_update; -- Gitee